-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
-- Public License for more details. You should have received a copy of the GNU
-- General Public License distributed with the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

-- Overview:
-- Checks a Package Declaration for Sem on down pass through
-- TreeProcessor.  Starts at node package_declaration.  May directly raise
-- errors for: re-declaration of package identifier.  Other errors may be raised
-- indirectly by wf_package_specification, wf_inherit_clause and
-- wf_context_clause which are called from here.
--------------------------------------------------------------------------------

separate (Sem)
procedure Wf_Package_Declaration
  (Node           : in     STree.SyntaxNode;
   Current_Scope  : in     Dictionary.Scopes;
   Component_Data : in out ComponentManager.ComponentData;
   The_Heap       : in out Heap.HeapRecord)
is
   type Enclosing_Scope_Types is (In_Library, In_Package, In_Procedure);
   Enclosing_Scope_Type                                                        : Enclosing_Scope_Types;
   Ident_Str                                                                   : LexTokenManager.Lex_String;
   Context_Node, Inherit_Node, Generic_Formal_Part_Node, Spec_Node, Ident_Node : STree.SyntaxNode;
   Pack_Sym                                                                    : Dictionary.Symbol := Dictionary.NullSymbol;
   Generic_Unit                                                                : Dictionary.Symbol;
   Private_Package_Declaration, Child_Package_Declaration                      : Boolean;
   Valid_Name                                                                  : Boolean           := True;

   ---------------------------------------------------------------

   procedure Get_Package_Declaration_Key_Nodes
     (Node                        : in     STree.SyntaxNode;
      Context_Node                :    out STree.SyntaxNode;
      Inherit_Node                :    out STree.SyntaxNode;
      Generic_Formal_Part_Node    :    out STree.SyntaxNode;
      Spec_Node                   :    out STree.SyntaxNode;
      Ident_Node                  :    out STree.SyntaxNode;
      Private_Package_Declaration :    out Boolean;
      Child_Package_Declaration   :    out Boolean)
   --# global in STree.Table;
   --# derives Child_Package_Declaration,
   --#         Context_Node,
   --#         Generic_Formal_Part_Node,
   --#         Ident_Node,
   --#         Inherit_Node,
   --#         Private_Package_Declaration,
   --#         Spec_Node                   from Node,
   --#                                          STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.package_declaration or
   --#   Syntax_Node_Type (Node, STree.Table) = SP_Symbols.private_package_declaration or
   --#   Syntax_Node_Type (Node, STree.Table) = SP_Symbols.generic_package_declaration;
   --# post (Syntax_Node_Type (Context_Node, STree.Table) = SP_Symbols.context_clause or Context_Node = STree.NullNode) and
   --#   (Syntax_Node_Type (Inherit_Node, STree.Table) = SP_Symbols.inherit_clause or Inherit_Node = STree.NullNode) and
   --#   (Syntax_Node_Type (Generic_Formal_Part_Node, STree.Table) = SP_Symbols.generic_formal_part
   --#      or Generic_Formal_Part_Node = STree.NullNode) and
   --#   Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.package_specification and
   --#   Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier;
      is separate;

   ---------------------------------------------------------------

   procedure Find_Enclosing_Scope_Type (Scope                : in     Dictionary.Scopes;
                                        Enclosing_Scope_Type :    out Enclosing_Scope_Types)
   --# global in Dictionary.Dict;
   --# derives Enclosing_Scope_Type from Dictionary.Dict,
   --#                                   Scope;
   is
   begin
      if Dictionary.IsGlobalScope (Scope) then
         Enclosing_Scope_Type := In_Library;
      elsif Dictionary.IsPackage (Dictionary.GetRegion (Scope)) then
         Enclosing_Scope_Type := In_Package;
      else
         Enclosing_Scope_Type := In_Procedure;
      end if;
   end Find_Enclosing_Scope_Type;

   ---------------------------------------------------------------

   function Is_Not_Refinement_Announcement
     (Sym                  : Dictionary.Symbol;
      Enclosing_Scope_Type : Enclosing_Scope_Types)
     return                 Boolean
   --# global in Dictionary.Dict;
   is
   begin
      return Enclosing_Scope_Type /= In_Package or else Dictionary.GetContext (Sym) /= Dictionary.ProofContext;
   end Is_Not_Refinement_Announcement;

   ---------------------------------------------------------------

   procedure Add_Child
     (Root_Id_Node : in     STree.SyntaxNode;
      Is_Private   : in     Boolean;
      Scope        : in     Dictionary.Scopes;
      Child_Sym    :    out Dictionary.Symbol;
      Child_Str    :    out LexTokenManager.Lex_String)
   --# global in     CommandLineData.Content;
   --#        in     ContextManager.Ops.Unit_Stack;
   --#        in     LexTokenManager.State;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --#        in out STree.Table;
   --# derives Child_Str                  from CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Root_Id_Node,
   --#                                         Scope,
   --#                                         STree.Table &
   --#         Child_Sym,
   --#         Dictionary.Dict            from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         Is_Private,
   --#                                         LexTokenManager.State,
   --#                                         Root_Id_Node,
   --#                                         Scope,
   --#                                         STree.Table &
   --#         ErrorHandler.Error_Context from *,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         Is_Private,
   --#                                         LexTokenManager.State,
   --#                                         Root_Id_Node,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table &
   --#         SPARK_IO.File_Sys          from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Is_Private,
   --#                                         LexTokenManager.State,
   --#                                         Root_Id_Node,
   --#                                         Scope,
   --#                                         STree.Table &
   --#         STree.Table                from *,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         Is_Private,
   --#                                         LexTokenManager.State,
   --#                                         Root_Id_Node,
   --#                                         Scope;
   --# pre Syntax_Node_Type (Root_Id_Node, STree.Table) = SP_Symbols.identifier;
   --# post STree.Table = STree.Table~;
      is separate;

   ----------------------------------------------------------------------

   procedure Wf_Package_Specification
     (Node           : in     STree.SyntaxNode;
      Ident_Str      : in     LexTokenManager.Lex_String;
      Pack_Sym       : in     Dictionary.Symbol;
      Current_Scope  : in     Dictionary.Scopes;
      Component_Data : in out ComponentManager.ComponentData;
      The_Heap       : in out Heap.HeapRecord)
   --# global in     CommandLineData.Content;
   --#        in     ContextManager.Ops.File_Heap;
   --#        in     ContextManager.Ops.Unit_Heap;
   --#        in     ContextManager.Ops.Unit_Stack;
   --#        in out Aggregate_Stack.State;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out LexTokenManager.State;
   --#        in out SLI.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out STree.Table;
   --# derives Aggregate_Stack.State,
   --#         Component_Data,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         Statistics.TableUsage,
   --#         STree.Table,
   --#         The_Heap                   from *,
   --#                                         CommandLineData.Content,
   --#                                         Component_Data,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Current_Scope,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Pack_Sym,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         ErrorHandler.Error_Context,
   --#         SLI.State,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Component_Data,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Current_Scope,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Ident_Str,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Pack_Sym,
   --#                                         SLI.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         The_Heap;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.package_specification;
   --# post STree.Table = STree.Table~;
      is separate;

begin -- Wf_Package_Declaration
   Get_Package_Declaration_Key_Nodes
     (Node                        => Node,
      Context_Node                => Context_Node,
      Inherit_Node                => Inherit_Node,
      Generic_Formal_Part_Node    => Generic_Formal_Part_Node,
      Spec_Node                   => Spec_Node,
      Ident_Node                  => Ident_Node,
      Private_Package_Declaration => Private_Package_Declaration,
      Child_Package_Declaration   => Child_Package_Declaration);
   Ident_Str := Node_Lex_String (Node => Ident_Node);
   -- tells us where package is being declared
   Find_Enclosing_Scope_Type (Scope                => Current_Scope,
                              Enclosing_Scope_Type => Enclosing_Scope_Type);
   if CommandLineData.Content.Language_Profile /= CommandLineData.SPARK83
     and then Child_Package_Declaration
     and then Enclosing_Scope_Type = In_Library then
      if Syntax_Node_Type (Node => Node) = SP_Symbols.generic_package_declaration then
         -- ASSUME Node = generic_package_declaration
         ErrorHandler.Semantic_Error
           (Err_Num   => 610,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Ident_Node),
            Id_Str    => LexTokenManager.Null_String);
      elsif Syntax_Node_Type (Node => Node) = SP_Symbols.package_declaration
        or else Syntax_Node_Type (Node => Node) = SP_Symbols.private_package_declaration then
         -- ASSUME Node = package_declaration OR private_package_declaration
         Add_Child
           (Root_Id_Node => Ident_Node,
            Is_Private   => Private_Package_Declaration,
            Scope        => Current_Scope,
            Child_Sym    => Pack_Sym,
            Child_Str    => Ident_Str);
      end if;
      -- if Pack_Sym is null then something went wrong when we added the child so we need to supress
      -- any further analysis of the package specification
      Valid_Name := not Dictionary.Is_Null_Symbol (Pack_Sym);
   else
      if CommandLineData.Content.Language_Profile = CommandLineData.SPARK83 then
         -- check that syntax conforms
         if Child_Package_Declaration
           or else Private_Package_Declaration
           or else Syntax_Node_Type (Node => Node) = SP_Symbols.generic_package_declaration then
            ErrorHandler.Semantic_Error
              (Err_Num   => 610,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Ident_Node),
               Id_Str    => LexTokenManager.Null_String);
            Private_Package_Declaration := False;
         end if;
      elsif Child_Package_Declaration and then Enclosing_Scope_Type /= In_Library then
         ErrorHandler.Semantic_Error
           (Err_Num   => 614,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Ident_Node),
            Id_Str    => LexTokenManager.Null_String);
      end if;
      Pack_Sym :=
        Dictionary.LookupItem
        (Name              => Ident_Str,
         Scope             => Current_Scope,
         Context           => Dictionary.ProofContext,
         Full_Package_Name => False);
      --# assert STree.Table = STree.Table~ and
      --#   (Syntax_Node_Type (Context_Node, STree.Table) = SP_Symbols.context_clause or Context_Node = STree.NullNode) and
      --#   (Syntax_Node_Type (Inherit_Node, STree.Table) = SP_Symbols.inherit_clause or Inherit_Node = STree.NullNode) and
      --#   (Syntax_Node_Type (Generic_Formal_Part_Node, STree.Table) = SP_Symbols.generic_formal_part
      --#      or Generic_Formal_Part_Node = STree.NullNode) and
      --#   Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.package_specification and
      --#   Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier;
      if not Dictionary.Is_Null_Symbol (Pack_Sym)
        and then Is_Not_Refinement_Announcement (Sym                  => Pack_Sym,
                                                 Enclosing_Scope_Type => Enclosing_Scope_Type) then
         ErrorHandler.Semantic_Error
           (Err_Num   => 10,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Ident_Node),
            Id_Str    => Ident_Str);
         Valid_Name := False;
      else
         if not Dictionary.Is_Null_Symbol (Pack_Sym) then
            STree.Set_Node_Lex_String (Sym  => Pack_Sym,
                                       Node => Ident_Node);
         end if;
         --# assert STree.Table = STree.Table~ and
         --#   (Syntax_Node_Type (Context_Node, STree.Table) = SP_Symbols.context_clause or Context_Node = STree.NullNode) and
         --#   (Syntax_Node_Type (Inherit_Node, STree.Table) = SP_Symbols.inherit_clause or Inherit_Node = STree.NullNode) and
         --#   (Syntax_Node_Type (Generic_Formal_Part_Node, STree.Table) = SP_Symbols.generic_formal_part
         --#      or Generic_Formal_Part_Node = STree.NullNode) and
         --#   Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.package_specification and
         --#   Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier;
         if Private_Package_Declaration then -- root level private package
            Dictionary.AddPrivatePackage
              (Name          => Ident_Str,
               Comp_Unit     => ContextManager.Ops.Current_Unit,
               Specification => Dictionary.Location'(Start_Position => Node_Position (Node => Ident_Node),
                                                     End_Position   => Node_Position (Node => Ident_Node)),
               Scope         => Current_Scope,
               ThePackage    => Pack_Sym);
         else
            Dictionary.Add_Package
              (Name          => Ident_Str,
               Comp_Unit     => ContextManager.Ops.Current_Unit,
               Specification => Dictionary.Location'(Start_Position => Node_Position (Node => Ident_Node),
                                                     End_Position   => Node_Position (Node => Ident_Node)),
               Scope         => Current_Scope,
               ThePackage    => Pack_Sym);
         end if;
      end if;
   end if;

   -- wff the package specification iff its declaration is valid
   if Valid_Name then
      -- ASSUME Inherit_Node = inherit_clause OR NULL
      if Syntax_Node_Type (Node => Inherit_Node) = SP_Symbols.inherit_clause then
         -- ASSUME Inherit_Node = inherit_clause
         Wf_Inherit_Clause (Node     => Inherit_Node,
                            Comp_Sym => Pack_Sym,
                            Scope    => Current_Scope);
      end if;

      --# assert STree.Table = STree.Table~ and
      --#   (Syntax_Node_Type (Context_Node, STree.Table) = SP_Symbols.context_clause or Context_Node = STree.NullNode) and
      --#   (Syntax_Node_Type (Generic_Formal_Part_Node, STree.Table) = SP_Symbols.generic_formal_part
      --#      or Generic_Formal_Part_Node = STree.NullNode) and
      --#   Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.package_specification;

      -- ASSUME Context_Node = context_clause OR NULL
      if Syntax_Node_Type (Node => Context_Node) = SP_Symbols.context_clause then
         -- ASSUME Context_Node = context_clause
         Wf_Context_Clause
           (Node     => Context_Node,
            Comp_Sym => Pack_Sym,
            Scope    => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                   The_Unit       => Pack_Sym));
      end if;

      if Syntax_Node_Type (Node => Generic_Formal_Part_Node) = SP_Symbols.generic_formal_part then
         -- ASSUME Generic_Formal_Part_Node = generic_formal_part
         Dictionary.Add_Generic_Unit
           (Kind         => Dictionary.Generic_Of_Package,
            Comp_Unit    => ContextManager.Ops.Current_Unit,
            Declaration  => Dictionary.Location'(Start_Position => Node_Position (Node => Ident_Node),
                                                 End_Position   => Node_Position (Node => Ident_Node)),
            Scope        => Current_Scope,
            Generic_Unit => Generic_Unit);
         Dictionary.Set_Package_Generic_Unit (Pack_Sym     => Pack_Sym,
                                              Generic_Unit => Generic_Unit);
         Dictionary.Set_Generic_Unit_Owning_Package (Generic_Unit => Generic_Unit,
                                                     Pack_Sym     => Pack_Sym);
         Wf_Generic_Formal_Part
           (Node                         => Generic_Formal_Part_Node,
            Generic_Ident_Node_Pos       => Node_Position (Node => Ident_Node),
            Generic_Unit                 => Generic_Unit,
            Package_Or_Subprogram_Symbol => Pack_Sym);
      end if;

      --# assert STree.Table = STree.Table~ and
      --#   Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.package_specification;

      Wf_Package_Specification
        (Node           => Spec_Node,
         Ident_Str      => Ident_Str,
         Pack_Sym       => Pack_Sym,
         Current_Scope  => Current_Scope,
         Component_Data => Component_Data,
         The_Heap       => The_Heap);
   end if;
end Wf_Package_Declaration;
