-------------------------------------------------------------------------------
-- (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.Wf_Package_Declaration.Wf_Package_Specification)
procedure Wf_Anno
  (Node       : in     STree.SyntaxNode;
   Pack_Sym   : in     Dictionary.Symbol;
   Scope_Type : in     Enclosing_Scope_Types;
   Scope      : in     Dictionary.Scopes;
   The_Heap   : in out Heap.HeapRecord)
is
   -- ASSUME Scope is VisibleScope of Pack_Sym

   Own_Var_Clause_Node, Init_Spec_Node : STree.SyntaxNode;

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

   procedure Wf_Own
     (Node       : in     STree.SyntaxNode;
      Pack_Sym   : in     Dictionary.Symbol;
      Scope_Type : in     Enclosing_Scope_Types;
      Scope      : in     Dictionary.Scopes;
      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,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         Statistics.TableUsage,
   --#         STree.Table,
   --#         The_Heap                   from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Pack_Sym,
   --#                                         Scope,
   --#                                         Scope_Type,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         ErrorHandler.Error_Context,
   --#         SLI.State,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Pack_Sym,
   --#                                         Scope,
   --#                                         Scope_Type,
   --#                                         SLI.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         The_Heap;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.own_variable_clause;
   --# post STree.Table = STree.Table~;
      is separate;

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

   procedure Wf_Init_Spec
     (Node       : in STree.SyntaxNode;
      Pack_Sym   : in Dictionary.Symbol;
      Scope_Type : in Enclosing_Scope_Types;
      Scope      : in Dictionary.Scopes)
   --# global in     CommandLineData.Content;
   --#        in     ContextManager.Ops.File_Heap;
   --#        in     ContextManager.Ops.Unit_Heap;
   --#        in     ContextManager.Ops.Unit_Stack;
   --#        in     LexTokenManager.State;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SLI.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out STree.Table;
   --# derives Dictionary.Dict,
   --#         STree.Table                from Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         Scope_Type,
   --#                                         STree.Table &
   --#         ErrorHandler.Error_Context from *,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Pack_Sym,
   --#                                         Scope,
   --#                                         Scope_Type,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table &
   --#         SLI.State                  from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Pack_Sym,
   --#                                         Scope,
   --#                                         Scope_Type,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table &
   --#         SPARK_IO.File_Sys          from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Pack_Sym,
   --#                                         Scope,
   --#                                         Scope_Type,
   --#                                         SLI.State,
   --#                                         STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.initialization_specification;
   --# post STree.Table = STree.Table~;
      is separate;

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

   procedure Do_Embedded_Package
     (Anno_Node, Own_Var_Clause_Node, Init_Spec_Node : in     STree.SyntaxNode;
      Pack_Sym                                       : in     Dictionary.Symbol;
      Scope                                          : in     Dictionary.Scopes;
      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,
   --#         LexTokenManager.State,
   --#         Statistics.TableUsage,
   --#         The_Heap                   from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Own_Var_Clause_Node,
   --#                                         Pack_Sym,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         Dictionary.Dict,
   --#         STree.Table                from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         Init_Spec_Node,
   --#                                         LexTokenManager.State,
   --#                                         Own_Var_Clause_Node,
   --#                                         Pack_Sym,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from Anno_Node,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Init_Spec_Node,
   --#                                         LexTokenManager.State,
   --#                                         Own_Var_Clause_Node,
   --#                                         Pack_Sym,
   --#                                         Scope,
   --#                                         SLI.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         SLI.State                  from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Init_Spec_Node,
   --#                                         LexTokenManager.State,
   --#                                         Own_Var_Clause_Node,
   --#                                         Pack_Sym,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         The_Heap;
   --# pre Syntax_Node_Type (Anno_Node, STree.Table) = SP_Symbols.package_annotation and
   --#   (Syntax_Node_Type (Own_Var_Clause_Node, STree.Table) = SP_Symbols.own_variable_clause or
   --#      Own_Var_Clause_Node = STree.NullNode) and
   --#   (Syntax_Node_Type (Init_Spec_Node, STree.Table) = SP_Symbols.initialization_specification or
   --#      Init_Spec_Node = STree.NullNode);
   --# post STree.Table = STree.Table~;
   is
      type Init_Expected is (Yes, No, No_Protected);

      function Initialization_Expected (Pack_Sym : Dictionary.Symbol) return Init_Expected
      --# global in Dictionary.Dict;
      is
         Own_Var_List : Dictionary.Iterator;
         Expected     : Init_Expected;
      begin
         Own_Var_List := Dictionary.FirstOwnVariable (Pack_Sym);
         Expected     := No;
         while not Dictionary.IsNullIterator (Own_Var_List) loop
            if not Dictionary.IsOwnVariableOrConstituentWithMode (Dictionary.CurrentSymbol (Own_Var_List))
              and then Dictionary.OwnVariableIsInitialized (Dictionary.GetSubject (Dictionary.CurrentSymbol (Own_Var_List)))
              and then not Dictionary.GetOwnVariableProtected (Dictionary.CurrentSymbol (Own_Var_List)) then
               Expected := Yes;
               exit;
            end if;
            --# assert True;
            if Dictionary.GetOwnVariableProtected (Dictionary.CurrentSymbol (Own_Var_List)) then
               if Expected = No then
                  Expected := No_Protected;
               end if;
            end if;
            Own_Var_List := Dictionary.NextSymbol (Own_Var_List);
         end loop;
         return Expected;
      end Initialization_Expected;

   begin -- Do_Embedded_Package
      if Dictionary.FirstOwnVariable (Pack_Sym) = Dictionary.NullIterator then
         -- no refines announcements found
         -- ASSUME Own_Var_Clause_Node = own_variable_clause OR NULL
         if Syntax_Node_Type (Node => Own_Var_Clause_Node) = SP_Symbols.own_variable_clause then
            -- ASSUME Own_Var_Clause_Node = own_variable_clause
            -- unexpected own var clause
            ErrorHandler.Semantic_Error
              (Err_Num   => 80,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Own_Var_Clause_Node),
               Id_Str    => LexTokenManager.Null_String);
         end if;
      else
         -- at least one announcement found so there must be an own var clause
         -- ASSUME Own_Var_Clause_Node = own_variable_clause OR NULL
         if Own_Var_Clause_Node = STree.NullNode then
            -- required own var clause is missing
            -- ASSUME Own_Var_Clause_Node = NULL
            ErrorHandler.Semantic_Error
              (Err_Num   => 81,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Parent_Node (Current_Node => Anno_Node)),
               Id_Str    => LexTokenManager.Null_String);
         elsif Syntax_Node_Type (Node => Own_Var_Clause_Node) = SP_Symbols.own_variable_clause then
            -- ASSUME Own_Var_Clause_Node = own_variable_clause
            -- own var clause both needed and present
            Wf_Own
              (Node       => Own_Var_Clause_Node,
               Pack_Sym   => Pack_Sym,
               Scope_Type => In_Package,
               Scope      => Scope,
               The_Heap   => The_Heap);
            -- now check for required or superfluous initializations
            case Initialization_Expected (Pack_Sym => Pack_Sym) is
               when Yes =>
                  -- ASSUME Init_Spec_Node = initialization_specification OR NULL
                  if Init_Spec_Node = STree.NullNode then
                     -- ASSUME Init_Spec_Node = NULL
                     -- initialization missing from inner package
                     ErrorHandler.Semantic_Error
                       (Err_Num   => 83,
                        Reference => ErrorHandler.No_Reference,
                        Position  => Node_Position (Node => Own_Var_Clause_Node),
                        Id_Str    => LexTokenManager.Null_String);
                  elsif Syntax_Node_Type (Node => Init_Spec_Node) = SP_Symbols.initialization_specification then
                     -- ASSUME Init_Spec_Node = initialization_specification
                     -- initialization both required and present
                     Wf_Init_Spec (Node       => Init_Spec_Node,
                                   Pack_Sym   => Pack_Sym,
                                   Scope_Type => In_Package,
                                   Scope      => Scope);
                  end if;
               when No =>
                  -- ASSUME Init_Spec_Node = initialization_specification OR NULL
                  if Syntax_Node_Type (Node => Init_Spec_Node) = SP_Symbols.initialization_specification then
                     -- ASSUME Init_Spec_Node = initialization_specification
                     -- unexpected init
                     ErrorHandler.Semantic_Error
                       (Err_Num   => 82,
                        Reference => ErrorHandler.No_Reference,
                        Position  => Node_Position (Node => Init_Spec_Node),
                        Id_Str    => LexTokenManager.Null_String);
                  end if;
               when No_Protected =>
                  -- ASSUME Init_Spec_Node = initialization_specification OR NULL
                  if Syntax_Node_Type (Node => Init_Spec_Node) = SP_Symbols.initialization_specification then
                     -- ASSUME Init_Spec_Node = initialization_specification
                     -- unexpected init on protected state
                     ErrorHandler.Semantic_Error
                       (Err_Num   => 864,
                        Reference => ErrorHandler.No_Reference,
                        Position  => Node_Position (Node => Init_Spec_Node),
                        Id_Str    => LexTokenManager.Null_String);
                  end if;
            end case;
         end if;
      end if;
   end Do_Embedded_Package;

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

   procedure Do_Library_Package
     (Anno_Node, Own_Var_Clause_Node, Init_Spec_Node : in     STree.SyntaxNode;
      Pack_Sym                                       : in     Dictionary.Symbol;
      Scope                                          : in     Dictionary.Scopes;
      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,
   --#         LexTokenManager.State,
   --#         Statistics.TableUsage,
   --#         The_Heap                   from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Own_Var_Clause_Node,
   --#                                         Pack_Sym,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         Dictionary.Dict,
   --#         STree.Table                from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         Init_Spec_Node,
   --#                                         LexTokenManager.State,
   --#                                         Own_Var_Clause_Node,
   --#                                         Pack_Sym,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from Anno_Node,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Init_Spec_Node,
   --#                                         LexTokenManager.State,
   --#                                         Own_Var_Clause_Node,
   --#                                         Pack_Sym,
   --#                                         Scope,
   --#                                         SLI.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         SLI.State                  from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Init_Spec_Node,
   --#                                         LexTokenManager.State,
   --#                                         Own_Var_Clause_Node,
   --#                                         Pack_Sym,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         The_Heap;
   --# pre Syntax_Node_Type (Anno_Node, STree.Table) = SP_Symbols.package_annotation and
   --#   (Syntax_Node_Type (Own_Var_Clause_Node, STree.Table) = SP_Symbols.own_variable_clause or
   --#      Own_Var_Clause_Node = STree.NullNode) and
   --#   (Syntax_Node_Type (Init_Spec_Node, STree.Table) = SP_Symbols.initialization_specification or
   --#      Init_Spec_Node = STree.NullNode);
   --# post STree.Table = STree.Table~;
   is
      It             : Dictionary.Iterator;
      Var_Sym        : Dictionary.Symbol;
      Error_Node_Pos : LexTokenManager.Token_Position;
   begin
      Error_Node_Pos := Node_Position (Node => Anno_Node);
      -- ASSUME Own_Var_Clause_Node = own_variable_clause OR NULL
      if Syntax_Node_Type (Node => Own_Var_Clause_Node) = SP_Symbols.own_variable_clause then
         -- ASSUME Own_Var_Clause_Node = own_variable_clause
         Error_Node_Pos := Node_Position (Node => Own_Var_Clause_Node);
         Wf_Own
           (Node       => Own_Var_Clause_Node,
            Pack_Sym   => Pack_Sym,
            Scope_Type => In_Library,
            Scope      => Scope,
            The_Heap   => The_Heap);
      end if;

      -- ASSUME Init_Spec_Node = initialization_specification OR NULL
      if Syntax_Node_Type (Node => Init_Spec_Node) = SP_Symbols.initialization_specification then
         -- ASSUME Init_Spec_Node = initialization_specification
         Error_Node_Pos := Node_Position (Node => Init_Spec_Node);
         Dictionary.AddInitializationSpecification
           (Pack_Sym,
            Dictionary.Location'(Start_Position => Node_Position (Node => Init_Spec_Node),
                                 End_Position   => Node_Position (Node => Init_Spec_Node)));
         Wf_Init_Spec (Node       => Init_Spec_Node,
                       Pack_Sym   => Pack_Sym,
                       Scope_Type => In_Library,
                       Scope      => Scope);
      end if;

      It := Dictionary.FirstOwnVariable (Pack_Sym);
      while not Dictionary.IsNullIterator (It) loop
         --# assert STree.Table = STree.Table~;
         Var_Sym := Dictionary.CurrentSymbol (It);
         if Dictionary.IsVirtualElement (Var_Sym)
           and then not Dictionary.IsOwnVariableOrConstituentWithMode (Var_Sym)
           and then not Dictionary.OwnVariableIsInitialized (Var_Sym) then
            -- Unmoded own variables that appear in a protects list MUST appear in
            -- an intializes clause.
            ErrorHandler.Semantic_Error
              (Err_Num   => 860,
               Reference => ErrorHandler.No_Reference,
               Position  => Error_Node_Pos,
               Id_Str    => Dictionary.GetSimpleName (Var_Sym));
         end if;
         It := Dictionary.NextSymbol (It);
      end loop;
   end Do_Library_Package;

begin -- Wf_Anno
   Own_Var_Clause_Node := Child_Node (Current_Node => Node);
   -- ASSUME Own_Var_Clause_Node = own_variable_clause OR NULL
   if Own_Var_Clause_Node = STree.NullNode then
      Init_Spec_Node := STree.NullNode;
   elsif Syntax_Node_Type (Node => Own_Var_Clause_Node) = SP_Symbols.own_variable_clause then
      Init_Spec_Node := Next_Sibling (Current_Node => Own_Var_Clause_Node);
      Dictionary.AddOwnAnnotation
        (Pack_Sym,
         Dictionary.Location'(Start_Position => Node_Position (Node => Node),
                              End_Position   => Node_Position (Node => Node)));
   else
      Init_Spec_Node := STree.NullNode;
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Own_Var_Clause_Node = own_variable_clause OR NULL in Wf_Anno");
   end if;
   -- ASSUME Init_Spec_Node = initialization_specification OR NULL
   SystemErrors.RT_Assert
     (C       => Init_Spec_Node = STree.NullNode
        or else Syntax_Node_Type (Node => Init_Spec_Node) = SP_Symbols.initialization_specification,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Init_Spec_Node = initialization_specification OR NULL in Wf_Anno");

   if Scope_Type = In_Package then
      -- package embedded in package
      Do_Embedded_Package
        (Anno_Node           => Node,
         Own_Var_Clause_Node => Own_Var_Clause_Node,
         Init_Spec_Node      => Init_Spec_Node,
         Pack_Sym            => Pack_Sym,
         Scope               => Scope,
         The_Heap            => The_Heap);
   else
      -- library unit or package embedded in procedure.
      Do_Library_Package
        (Anno_Node           => Node,
         Own_Var_Clause_Node => Own_Var_Clause_Node,
         Init_Spec_Node      => Init_Spec_Node,
         Pack_Sym            => Pack_Sym,
         Scope               => Scope,
         The_Heap            => The_Heap);
   end if;
end Wf_Anno;
