-------------------------------------------------------------------------------
-- (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.
--
--=============================================================================

separate (Sem.CompUnit)
procedure Wf_Package_Body (Node              : in     STree.SyntaxNode;
                           Scope             : in out Dictionary.Scopes;
                           With_Public_Child :    out Boolean) is
   Ident_Str                                                : LexTokenManager.Lex_String;
   Sym                                                      : Dictionary.Symbol;
   Ident_Node, With_Node, Ref_Node, Next_Node, Grand_Parent : STree.SyntaxNode;
   Spec_Found, Ok_To_Add_Body, Body_Is_Hidden               : Boolean;
   Pack_Scope                                               : Dictionary.Scopes;

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

   procedure Find_Package
     (Ident_Node  : in out STree.SyntaxNode;
      Ident_Str   : in out LexTokenManager.Lex_String;
      Scope       : in     Dictionary.Scopes;
      Found       :    out Boolean;
      The_Package :    out Dictionary.Symbol)
   --# 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 Dictionary.Dict,
   --#         Found,
   --#         Ident_Node,
   --#         Ident_Str,
   --#         STree.Table,
   --#         The_Package                from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         Ident_Node,
   --#                                         Ident_Str,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         STree.Table &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Ident_Node,
   --#                                         Ident_Str,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table;
   --# pre Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier;
   --# post Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier and
   --#   STree.Table = STree.Table~;
   is
      Sym, Parent_Sym : Dictionary.Symbol;
      Ok              : Boolean;
   begin
      Sym := Dictionary.LookupImmediateScope (Name    => Ident_Str,
                                              Scope   => Scope,
                                              Context => Dictionary.ProgramContext);

      Ok := not Dictionary.Is_Null_Symbol (Sym) and then Dictionary.IsPackage (Sym);
      if not Ok then
         ErrorHandler.Semantic_Error
           (Err_Num   => 11,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Ident_Node),
            Id_Str    => Ident_Str);
         -- there is no spec, must create one for Dict to add body to later
         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         => Scope,
            ThePackage    => Sym);
      else
         STree.Set_Node_Lex_String (Sym  => Sym,
                                    Node => Ident_Node);
      end if;
      if Syntax_Node_Type (Node => Next_Sibling (Current_Node => Parent_Node (Current_Node => Ident_Node))) =
        SP_Symbols.identifier then
         -- child package form
         if CommandLineData.Content.Language_Profile = CommandLineData.SPARK83 then
            ErrorHandler.Semantic_Error
              (Err_Num   => 610,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Next_Sibling (Current_Node => Parent_Node (Current_Node => Ident_Node))),
               Id_Str    => LexTokenManager.Null_String);
         elsif Ok then
            loop
               -- to handle multiple prefixes
               Ident_Node := Next_Sibling (Current_Node => Parent_Node (Current_Node => Ident_Node));
               --# assert Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier and
               --#   STree.Table = STree.Table~;
               Ident_Str  := Node_Lex_String (Node => Ident_Node);
               Parent_Sym := Sym;
               Sym        :=
                 Dictionary.LookupSelectedItem
                 (Prefix   => Parent_Sym,
                  Selector => Ident_Str,
                  Scope    => Scope,
                  Context  => Dictionary.ProofContext);
               if Dictionary.Is_Null_Symbol (Sym) or else not Dictionary.IsPackage (Sym) then
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 11,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Position (Node => Ident_Node),
                     Id_Str    => Ident_Str);
                  -- there is no spec, must create one for Dict to add body to later
                  Dictionary.AddChildPackage
                    (TheParent     => Parent_Sym,
                     Sort          => Dictionary.Public,
                     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         => Scope,
                     ThePackage    => Sym);
                  Ok := False;
                  exit;
               end if;
               STree.Set_Node_Lex_String (Sym  => Sym,
                                          Node => Ident_Node);
               exit when Syntax_Node_Type (Node => Next_Sibling (Current_Node => Parent_Node (Current_Node => Ident_Node))) /=
                 SP_Symbols.identifier;
               -- when no more identifier (s) to right
            end loop;
         end if;
      end if;
      Found       := Ok;
      The_Package := Sym;
   end Find_Package;

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

   -- check that all own variables of private children (and their public
   -- descendents) have appeared as refinement constituents
   procedure Check_Owned_Packages (Owner : in Dictionary.Symbol;
                                   Node  : in STree.SyntaxNode)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     STree.Table;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --# derives ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Owner,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.package_body;
   is
      Owned_Packages : Dictionary.Iterator;
      Own_Vars       : Dictionary.Iterator;
      Pack_Sym       : Dictionary.Symbol;
      Var_Sym        : Dictionary.Symbol;

      function Get_Error_Pos (Node : STree.SyntaxNode) return LexTokenManager.Token_Position
      --# global in STree.Table;
      --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.package_body;
      is
         Err_Node : STree.SyntaxNode;
      begin
         Err_Node := Next_Sibling (Current_Node => Child_Node (Current_Node => Node));
         -- ASSUME Err_Node = refinement_definition OR package_implementation
         if Syntax_Node_Type (Node => Err_Node) = SP_Symbols.refinement_definition then
            -- ASSUME Err_Node = refinement_definition
            Err_Node := Child_Node (Current_Node => Child_Node (Current_Node => Err_Node));
            -- ASSUME Err_Node = refinement_clause_rep OR refinement_clause
            if Syntax_Node_Type (Node => Err_Node) = SP_Symbols.refinement_clause_rep then
               -- ASSUME Err_Node = refinement_clause_rep
               Err_Node := Next_Sibling (Current_Node => Next_Sibling (Current_Node => Err_Node));
            end if;
            -- ASSUME Err_Node = refinement_clause
            SystemErrors.RT_Assert
              (C       => Syntax_Node_Type (Node => Err_Node) = SP_Symbols.refinement_clause,
               Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Err_Node = refinement_clause in Get_Error_Pos");
            Err_Node := Next_Sibling (Current_Node => Child_Node (Current_Node => Err_Node));
            -- ASSUME Err_Node = constituent_list
            if Syntax_Node_Type (Node => Err_Node) = SP_Symbols.constituent_list then
               -- ASSUME Err_Node = constituent_list
               Err_Node := Last_Sibling_Of (Start_Node => Child_Node (Current_Node => Err_Node));
               -- ASSUME Err_Node = entire_variable
               SystemErrors.RT_Assert
                 (C       => Syntax_Node_Type (Node => Err_Node) = SP_Symbols.entire_variable,
                  Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect Err_Node = entire_variable in Get_Error_Pos");
            else
               SystemErrors.Fatal_Error
                 (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect Err_Node = constituent_list in Get_Error_Pos");
            end if;
         elsif Syntax_Node_Type (Node => Err_Node) = SP_Symbols.package_implementation then
            -- ASSUME Err_Node = package_implementation
            -- no refinement definition - report at package name
            Err_Node := Last_Child_Of (Start_Node => Node);
         else
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Err_Node = refinement_definition OR package_implementation in Get_Error_Pos");
         end if;
         return Node_Position (Node => Err_Node);
      end Get_Error_Pos;

   begin -- Check_Owned_Packages
      Owned_Packages := Dictionary.FirstOwnedPackage (Owner);
      while not Dictionary.IsNullIterator (Owned_Packages) loop
         Pack_Sym := Dictionary.CurrentSymbol (Owned_Packages);
         Own_Vars := Dictionary.FirstOwnVariable (Pack_Sym);

         while not Dictionary.IsNullIterator (Own_Vars) loop
            Var_Sym := Dictionary.CurrentSymbol (Own_Vars);
            if not Dictionary.IsRefinementConstituent (Owner, Var_Sym) then
               -- missing own variable
               ErrorHandler.Semantic_Error_Sym
                 (Err_Num   => 621,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Get_Error_Pos (Node => Node),
                  Sym       => Var_Sym,
                  Scope     => Dictionary.GlobalScope);
            end if;
            Own_Vars := Dictionary.NextSymbol (Own_Vars);
         end loop;
         Owned_Packages := Dictionary.NextSymbol (Owned_Packages);
      end loop;
   end Check_Owned_Packages;

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

   procedure Wf_Refine (Node  : in STree.SyntaxNode;
                        Scope : in Dictionary.Scopes)
   --# 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 Dictionary.Dict,
   --#         STree.Table                from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         STree.Table &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.refinement_definition;
   --# post STree.Table = STree.Table~;
      is separate;

begin -- Wf_Package_Body
   With_Public_Child := False;
   Ident_Node        := Last_Child_Of (Start_Node => Node);
   -- ASSUME Ident_Node = identifier
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.identifier,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Ident_Node = identifier in Wf_Package_Body");
   Ident_Str    := Node_Lex_String (Node => Ident_Node);
   Grand_Parent := Parent_Node (Current_Node => Parent_Node (Current_Node => Node));
   -- ASSUME Grand_Parent = abody OR subunit OR secondary_unit
   if Syntax_Node_Type (Node => Grand_Parent) = SP_Symbols.abody then
      -- ASSUME Grand_Parent = abody
      With_Node := STree.NullNode;
   elsif Syntax_Node_Type (Node => Grand_Parent) = SP_Symbols.subunit
     or else Syntax_Node_Type (Node => Grand_Parent) = SP_Symbols.secondary_unit then
      -- ASSUME Grand_Parent = subunit OR secondary_unit
      if Syntax_Node_Type (Node => Grand_Parent) = SP_Symbols.subunit then
         With_Node := Parent_Node (Current_Node => Grand_Parent);
      else
         With_Node := Grand_Parent;
      end if;
      -- ASSUME With_Node = secondary_unit
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => With_Node) = SP_Symbols.secondary_unit,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect with_Node = secondary_unit in Wf_Package_Body");
      With_Node := Child_Node (Current_Node => Parent_Node (Current_Node => With_Node));
      -- ASSUME With_Node = secondary_unit OR context_clause
      if Syntax_Node_Type (Node => With_Node) = SP_Symbols.secondary_unit then
         -- ASSUME With_Node = secondary_unit
         With_Node := STree.NullNode;
      elsif Syntax_Node_Type (Node => With_Node) /= SP_Symbols.context_clause then
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect With_Node = secondary_unit OR context_clause in Wf_Package_Body");
      end if;
   else
      With_Node := STree.NullNode;
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Grand_Parent = abody OR subunit OR secondary_unit in Wf_Package_Body");
   end if;
   -- ASSUME With_Node = context_clause OR NULL

   Ok_To_Add_Body := False;
   Find_Package (Ident_Node  => Ident_Node,
                 Ident_Str   => Ident_Str,
                 Scope       => Scope,
                 Found       => Spec_Found,
                 The_Package => Sym);

   --# assert Syntax_Node_Type (Node, STree.Table) = SP_Symbols.package_body and
   --#   Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier and
   --#   (Syntax_Node_Type (Grand_Parent, STree.Table) = SP_Symbols.abody or
   --#      Syntax_Node_Type (Grand_Parent, STree.Table) = SP_Symbols.subunit or
   --#      Syntax_Node_Type (Grand_Parent, STree.Table) = SP_Symbols.secondary_unit) and
   --#   (Syntax_Node_Type (With_Node, STree.Table) = SP_Symbols.context_clause or With_Node = STree.NullNode) and
   --#   STree.Table = STree.Table~;
   if not Spec_Found then
      Ok_To_Add_Body := True;
   elsif Syntax_Node_Type (Node => Grand_Parent) = SP_Symbols.abody and then Dictionary.HasBodyStub (Sym) then
      -- ASSUME Grand_Parent = abody
      ErrorHandler.Semantic_Error
        (Err_Num   => 17,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Ident_Node),
         Id_Str    => Ident_Str);
   elsif Syntax_Node_Type (Node => Grand_Parent) = SP_Symbols.subunit then
      -- ASSUME Grand_Parent = subunit
      -- additional if clause to ensure extra package body subunits reported
      if not Dictionary.HasBodyStub (Sym) then
         ErrorHandler.Semantic_Error
           (Err_Num   => 15,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Ident_Node),
            Id_Str    => Ident_Str);
      elsif Dictionary.HasBody (Sym) then
         ErrorHandler.Semantic_Error
           (Err_Num   => 16,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Ident_Node),
            Id_Str    => Ident_Str);
      else
         Ok_To_Add_Body := True;
      end if;
   elsif Dictionary.HasBody (Sym) then
      ErrorHandler.Semantic_Error
        (Err_Num   => 16,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Ident_Node),
         Id_Str    => Ident_Str);
   else -- no errors found
      CheckPackageNeedsBody (Node_Pos => Node_Position (Node => Ident_Node),
                             Pack_Sym => Sym);
      Ok_To_Add_Body := True;
   end if;

   Next_Node := Child_Node (Current_Node => Last_Sibling_Of (Start_Node => Child_Node (Current_Node => Node)));
   -- ASSUME Next_Node = pragma_rep OR hidden_part
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Next_Node) = SP_Symbols.pragma_rep
        or else Syntax_Node_Type (Node => Next_Node) = SP_Symbols.hidden_part,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Next_Node = pragma_rep OR hidden_part in Wf_Package_Body");
   Body_Is_Hidden := Syntax_Node_Type (Node => Next_Node) = SP_Symbols.hidden_part;

   --# assert Syntax_Node_Type (Node, STree.Table) = SP_Symbols.package_body and
   --#   Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier and
   --#   (Syntax_Node_Type (With_Node, STree.Table) = SP_Symbols.context_clause or With_Node = STree.NullNode) and
   --#   (Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.pragma_rep or
   --#      Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.hidden_part) and
   --#   STree.Table = STree.Table~;
   if Ok_To_Add_Body then
      Dictionary.AddBody
        (CompilationUnit => Sym,
         Comp_Unit       => ContextManager.Ops.Current_Unit,
         TheBody         => Dictionary.Location'(Start_Position => Node_Position (Node => Ident_Node),
                                                 End_Position   => Node_Position (Node => Ident_Node)),
         Hidden          => Body_Is_Hidden);
   end if;
   Pack_Scope := Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                            The_Unit       => Sym);

   --# assert Syntax_Node_Type (Node, STree.Table) = SP_Symbols.package_body and
   --#   (Syntax_Node_Type (With_Node, STree.Table) = SP_Symbols.context_clause or With_Node = STree.NullNode) and
   --#   (Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.pragma_rep or
   --#      Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.hidden_part) and
   --#   STree.Table = STree.Table~;
   if Syntax_Node_Type (Node => With_Node) = SP_Symbols.context_clause then
      -- ASSUME With_Node = context_clause
      Wf_Context_Clause_Package_Body
        (Node              => With_Node,
         Comp_Sym          => Sym,
         Scope             => Pack_Scope,
         With_Public_Child => With_Public_Child);
   end if;

   --# assert Syntax_Node_Type (Node, STree.Table) = SP_Symbols.package_body and
   --#   (Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.pragma_rep or
   --#      Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.hidden_part) and
   --#   STree.Table = STree.Table~;
   Ref_Node := Next_Sibling (Current_Node => Child_Node (Current_Node => Node));
   -- ASSUME Ref_Node = refinement_definition OR package_implementation
   if Syntax_Node_Type (Node => Ref_Node) = SP_Symbols.package_implementation then
      -- ASSUME Ref_Node = package_implementation
      Ref_Node := STree.NullNode;
   elsif Syntax_Node_Type (Node => Ref_Node) /= SP_Symbols.refinement_definition then
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Ref_Node = refinement_definition OR package_implementation in Wf_Package_Body");
   end if;
   --# check Syntax_Node_Type (Ref_Node, STree.Table) = SP_Symbols.refinement_definition or Ref_Node = STree.NullNode;
   if Syntax_Node_Type (Node => Ref_Node) = SP_Symbols.refinement_definition then
      -- ASSUME Ref_Node = refinement_definition
      Dictionary.AddRefinementDefinition
        (Sym,
         Dictionary.Location'(Start_Position => Node_Position (Node => Ref_Node),
                              End_Position   => Node_Position (Node => Ref_Node)));
      Wf_Refine (Node  => Ref_Node,
                 Scope => Pack_Scope);
   end if;

   --# assert Syntax_Node_Type (Node, STree.Table) = SP_Symbols.package_body and
   --#   (Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.pragma_rep or
   --#      Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.hidden_part) and
   --#   STree.Table = STree.Table~;
   if CommandLineData.Content.Language_Profile /= CommandLineData.SPARK83 then
      Check_Owned_Packages (Owner => Sym,
                            Node  => Node);
   end if;

   --# assert (Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.pragma_rep or
   --#           Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.hidden_part) and
   --#   STree.Table = STree.Table~;
   if Body_Is_Hidden then
      ErrorHandler.Hidden_Text
        (Position => Node_Position (Node => Next_Node),
         Unit_Str => Ident_Str,
         Unit_Typ => SP_Symbols.package_implementation);
   end if;

   Scope := Pack_Scope;

end Wf_Package_Body;
