-------------------------------------------------------------------------------
-- (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_Generic_Declaration (Node          : in STree.SyntaxNode;
                                  Current_Scope : in Dictionary.Scopes) is
   Current_Node : STree.SyntaxNode;

   procedure Process_Generic_Subprogram_Declaration
     (Node           : in     STree.SyntaxNode;
      Component_Data : in out ComponentManager.ComponentData)
   --# 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;
   --#        in out TheHeap;
   --# derives Aggregate_Stack.State,
   --#         Component_Data,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         Statistics.TableUsage,
   --#         STree.Table,
   --#         TheHeap                    from *,
   --#                                         CommandLineData.Content,
   --#                                         Component_Data,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         STree.Table,
   --#                                         TheHeap &
   --#         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,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         SLI.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         TheHeap;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.generic_subprogram_declaration;
   --# post STree.Table = STree.Table~;
   is
      Context_Node                : STree.SyntaxNode;
      Inherit_Node                : STree.SyntaxNode;
      Ident_Node                  : STree.SyntaxNode;
      Generic_Formal_Part_Node    : STree.SyntaxNode;
      Subprogram_Declaration_Node : STree.SyntaxNode;
      Generic_Unit, Subprog_Sym   : Dictionary.Symbol;

      procedure Check_And_Add_Generic_Unit
        (Node         : in     STree.SyntaxNode;
         Ident_Node   : in     STree.SyntaxNode;
         Generic_Unit :    out Dictionary.Symbol)
      --# global in     CommandLineData.Content;
      --#        in     ContextManager.Ops.Unit_Stack;
      --#        in     LexTokenManager.State;
      --#        in     STree.Table;
      --#        in out Dictionary.Dict;
      --#        in out ErrorHandler.Error_Context;
      --#        in out SPARK_IO.File_Sys;
      --# derives Dictionary.Dict,
      --#         Generic_Unit               from CommandLineData.Content,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Dictionary.Dict,
      --#                                         Ident_Node,
      --#                                         LexTokenManager.State,
      --#                                         STree.Table &
      --#         ErrorHandler.Error_Context,
      --#         SPARK_IO.File_Sys          from CommandLineData.Content,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         Ident_Node,
      --#                                         LexTokenManager.State,
      --#                                         Node,
      --#                                         SPARK_IO.File_Sys,
      --#                                         STree.Table;
      --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.not_overriding_subprogram_declaration and
      --#   Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier;
      is
      begin
         if Dictionary.Is_Null_Symbol
           (Dictionary.LookupItem
              (Name              => Node_Lex_String (Node => Ident_Node),
               Scope             => Dictionary.GlobalScope,
               Context           => Dictionary.ProofContext,
               Full_Package_Name => False)) then
            Dictionary.Add_Generic_Unit
              (Kind         => Dictionary.Generic_Of_Subprogram,
               Comp_Unit    => ContextManager.Ops.Current_Unit,
               Declaration  => Dictionary.Location'(Start_Position => Node_Position (Node => Ident_Node),
                                                    End_Position   => Node_Position (Node => Ident_Node)),
               Scope        => Dictionary.GlobalScope,
               Generic_Unit => Generic_Unit);
         else
            Generic_Unit := Dictionary.NullSymbol;
            ErrorHandler.Semantic_Error
              (Err_Num   => 10,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Node),
               Id_Str    => Node_Lex_String (Node => Ident_Node));
         end if;
      end Check_And_Add_Generic_Unit;

   begin -- Process_Generic_Subprogram_Declaration
      Context_Node := Parent_Node (Current_Node => Parent_Node (Current_Node => Node));
      -- ASSUME Context_Node = library_unit
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Context_Node) = SP_Symbols.library_unit,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Context_Node = library_unit in Process_Generic_Subprogram_Declaration");
      Context_Node := Child_Node (Current_Node => Parent_Node (Current_Node => Context_Node));
      -- ASSUME Context_Node = context_clause OR library_unit
      if Syntax_Node_Type (Node => Context_Node) = SP_Symbols.library_unit then
         -- ASSUME Context_Node = library_unit
         Context_Node := STree.NullNode;
      elsif Syntax_Node_Type (Node => Context_Node) /= SP_Symbols.context_clause then
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Context_Node = context_clause OR library_unit in Process_Generic_Subprogram_Declaration");
      end if;
      Inherit_Node := Child_Node (Current_Node => Node);
      -- ASSUME Inherit_Node = inherit_clause OR generic_formal_part
      if Syntax_Node_Type (Node => Inherit_Node) = SP_Symbols.inherit_clause then
         -- ASSUME Inherit_Node = inherit_clause
         Generic_Formal_Part_Node := Next_Sibling (Current_Node => Inherit_Node);
      elsif Syntax_Node_Type (Node => Inherit_Node) = SP_Symbols.generic_formal_part then
         -- ASSUME Inherit_Node = generic_formal_part
         Generic_Formal_Part_Node := Inherit_Node;
         Inherit_Node             := STree.NullNode;
      else
         Generic_Formal_Part_Node := STree.NullNode;
         Inherit_Node             := STree.NullNode;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Inherit_Node = inherit_clause OR generic_formal_part in Process_Generic_Subprogram_Declaration");
      end if;
      -- ASSUME Generic_Formal_Part_Node = generic_formal_part
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Generic_Formal_Part_Node) = SP_Symbols.generic_formal_part,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Generic_Formal_Part_Node = generic_formal_part in Process_Generic_Subprogram_Declaration");

      Subprogram_Declaration_Node := Next_Sibling (Current_Node => Generic_Formal_Part_Node);
      -- ASSUME Subprogram_Declaration_Node = not_overriding_subprogram_declaration
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Subprogram_Declaration_Node) = SP_Symbols.not_overriding_subprogram_declaration,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Subprogram_Declaration_Node = not_overriding_subprogram_declaration " &
           "in Process_Generic_Subprogram_Declaration");

      Ident_Node := Child_Node (Current_Node => Subprogram_Declaration_Node);
      -- ASSUME Ident_Node = function_specification OR procedure_specification OR proof_function_declaration
      if Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.proof_function_declaration then
         -- ASSUME Ident_Node = proof_function_declaration
         Ident_Node := Child_Node (Current_Node => Ident_Node);
         -- ASSUME Ident_Node = function_specification
      elsif Syntax_Node_Type (Node => Ident_Node) /= SP_Symbols.function_specification
        and then Syntax_Node_Type (Node => Ident_Node) /= SP_Symbols.procedure_specification then
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Ident_Node = function_specification OR procedure_specification OR " &
              "proof_function_declaration in Process_Generic_Subprogram_Declaration");
      end if;
      -- ASSUME Ident_Node = function_specification OR procedure_specification
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.function_specification
           or else Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.procedure_specification,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect ident_Node = function_specification OR procedure_specification " &
           "in Process_Generic_Subprogram_Declaration");
      -- find identifier
      Ident_Node := Child_Node (Current_Node => Child_Node (Current_Node => Ident_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 Process_Generic_Subprogram_Declaration");

      Check_And_Add_Generic_Unit (Node         => Subprogram_Declaration_Node,
                                  Ident_Node   => Ident_Node,
                                  Generic_Unit => Generic_Unit);

      if not Dictionary.Is_Null_Symbol (Generic_Unit) then
         Wf_Subprogram_Declaration
           (Node                     => Subprogram_Declaration_Node,
            Inherit_Node             => Inherit_Node,
            Context_Node             => Context_Node,
            Generic_Formal_Part_Node => Generic_Formal_Part_Node,
            Current_Scope            => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                                   The_Unit       => Generic_Unit),
            Generic_Unit             => Generic_Unit,
            Component_Data           => Component_Data,
            The_Heap                 => TheHeap,
            Subprog_Sym              => Subprog_Sym);
         if not Dictionary.Is_Null_Symbol (Subprog_Sym)
           and then Dictionary.FirstGenericFormalParameter (TheGeneric => Subprog_Sym) = Dictionary.NullIterator then
            ErrorHandler.Semantic_Error
              (Err_Num   => 629,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Subprogram_Declaration_Node),
               Id_Str    => Node_Lex_String (Node => Ident_Node));
         end if;
      end if;
   end Process_Generic_Subprogram_Declaration;

begin -- Wf_Generic_Declaration
   case CommandLineData.Content.Language_Profile is
      when CommandLineData.SPARK83 =>
         -- not allowed in SPARK 83
         ErrorHandler.Semantic_Error
           (Err_Num   => 637,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Node),
            Id_Str    => LexTokenManager.Null_String);
      when CommandLineData.SPARK95_Onwards =>
         -- ASSUME Node = generic_declaration
         Current_Node := Child_Node (Current_Node => Node);
         -- ASSUME Current_Node = generic_subprogram_declaration OR generic_package_declaration
         if Syntax_Node_Type (Node => Current_Node) = SP_Symbols.generic_subprogram_declaration then
            -- ASSUME Current_Node = generic_subprogram_declaration
            Process_Generic_Subprogram_Declaration (Node           => Current_Node,
                                                    Component_Data => GlobalComponentData);
         elsif Syntax_Node_Type (Node => Current_Node) = SP_Symbols.generic_package_declaration then
            -- ASSUME Current_Node = generic_package_declaration
            ErrorHandler.Semantic_Warning
              (Err_Num  => 415,
               Position => Node_Position (Node => Current_Node),
               Id_Str   => LexTokenManager.Null_String);
            Wf_Package_Declaration
              (Node           => Current_Node,
               Current_Scope  => Current_Scope,
               Component_Data => GlobalComponentData,
               The_Heap       => TheHeap);
         else
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Current_Node = generic_subprogram_declaration OR generic_package_declaration OR " &
                 "in Wf_Generic_Declaration");
         end if;
   end case;
end Wf_Generic_Declaration;
