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

with SLI;

separate (Sem)
procedure Wf_Generic_Formal_Part
  (Node                         : in STree.SyntaxNode;
   Generic_Ident_Node_Pos       : in LexTokenManager.Token_Position;
   Generic_Unit                 : in Dictionary.Symbol;
   Package_Or_Subprogram_Symbol : in Dictionary.Symbol)
is
   Object_Or_Type_Node : STree.SyntaxNode;

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

   procedure Wf_Formal_Object
     (Node                         : in STree.SyntaxNode;
      Generic_Ident_Node_Pos       : in LexTokenManager.Token_Position;
      Generic_Unit                 : in Dictionary.Symbol;
      Package_Or_Subprogram_Symbol : in 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,
   --#         STree.Table                from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         Generic_Unit,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Package_Or_Subprogram_Symbol,
   --#                                         STree.Table &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Generic_Ident_Node_Pos,
   --#                                         Generic_Unit,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Package_Or_Subprogram_Symbol,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.formal_object_declaration;
   --# post STree.Table = STree.Table~;
   is
      Ident_List_Node : STree.SyntaxNode;
      Mode_Node       : STree.SyntaxNode;
      Type_Node       : STree.SyntaxNode;
      Formal_Type     : Dictionary.Symbol;

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

      procedure Process_Identifiers
        (Node                         : in STree.SyntaxNode;
         Type_Sym                     : in Dictionary.Symbol;
         Generic_Ident_Node_Pos       : in LexTokenManager.Token_Position;
         Generic_Unit                 : in Dictionary.Symbol;
         Package_Or_Subprogram_Symbol : in 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,
      --#         STree.Table                from CommandLineData.Content,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Dictionary.Dict,
      --#                                         Generic_Unit,
      --#                                         LexTokenManager.State,
      --#                                         Node,
      --#                                         Package_Or_Subprogram_Symbol,
      --#                                         STree.Table,
      --#                                         Type_Sym &
      --#         ErrorHandler.Error_Context,
      --#         SPARK_IO.File_Sys          from CommandLineData.Content,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         Generic_Ident_Node_Pos,
      --#                                         Generic_Unit,
      --#                                         LexTokenManager.State,
      --#                                         Node,
      --#                                         Package_Or_Subprogram_Symbol,
      --#                                         SPARK_IO.File_Sys,
      --#                                         STree.Table,
      --#                                         Type_Sym;
      --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.identifier_list;
      --# post STree.Table = STree.Table~;
      is
         It            : STree.Iterator;
         Next_Node     : STree.SyntaxNode;
         Ident_Str     : LexTokenManager.Lex_String;
         The_Object    : Dictionary.Symbol;
         The_Duplicate : Dictionary.Symbol;
      begin
         It := Find_First_Node (Node_Kind    => SP_Symbols.identifier,
                                From_Root    => Node,
                                In_Direction => STree.Down);
         while not STree.IsNull (It) loop
            Next_Node := Get_Node (It => It);
            --# assert Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.identifier and
            --#   Next_Node = Get_Node (It) and
            --#   STree.Table = STree.Table~;
            Ident_Str     := Node_Lex_String (Node => Next_Node);
            The_Duplicate :=
              Dictionary.LookupItem
              (Name              => Ident_Str,
               Scope             => Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                                               The_Unit       => Package_Or_Subprogram_Symbol),
               Context           => Dictionary.ProofContext,
               Full_Package_Name => False);
            if The_Duplicate = Package_Or_Subprogram_Symbol then
               ErrorHandler.Semantic_Error
                 (Err_Num   => 10,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Generic_Ident_Node_Pos,
                  Id_Str    => Ident_Str);
            elsif not Dictionary.Is_Null_Symbol (The_Duplicate) then
               ErrorHandler.Semantic_Error
                 (Err_Num   => 10,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Next_Node),
                  Id_Str    => Ident_Str);
            else
               Dictionary.Add_Generic_Object
                 (Name           => Ident_Str,
                  Comp_Unit      => ContextManager.Ops.Current_Unit,
                  Declaration    => Dictionary.Location'(Start_Position => Node_Position (Node => Next_Node),
                                                         End_Position   => Node_Position (Node => Next_Node)),
                  Scope          => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                               The_Unit       => Generic_Unit),
                  The_Type       => Type_Sym,
                  The_Object_Sym => The_Object);
               STree.Add_Node_Symbol (Node => Next_Node,
                                      Sym  => The_Object);
               Dictionary.Add_Generic_Formal_Parameter
                 (Comp_Unit    => ContextManager.Ops.Current_Unit,
                  Declaration  => Dictionary.Location'(Start_Position => Node_Position (Node => Next_Node),
                                                       End_Position   => Node_Position (Node => Next_Node)),
                  Generic_Unit => Generic_Unit,
                  The_Type     => Dictionary.NullSymbol,
                  The_Object   => The_Object);
            end if;
            It := STree.NextNode (It);
         end loop;
      end Process_Identifiers;

   begin -- Wf_Formal_Object
      Ident_List_Node := Child_Node (Current_Node => Node);

      -- ASSUME Ident_List_Node = identifier_list
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Ident_List_Node) = SP_Symbols.identifier_list,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Ident_List_Node = identifier_list in Wf_Formal_Object");

      Mode_Node := Child_Node (Current_Node => Next_Sibling (Current_Node => Ident_List_Node));

      -- ASSUME Mode_Node = in_mode OR inout_mode OR out_mode OR NULL
      SystemErrors.RT_Assert
        (C       => Mode_Node = STree.NullNode
           or else Syntax_Node_Type (Node => Mode_Node) = SP_Symbols.in_mode
           or else Syntax_Node_Type (Node => Mode_Node) = SP_Symbols.inout_mode
           or else Syntax_Node_Type (Node => Mode_Node) = SP_Symbols.out_mode,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Mode_Node = in_mode OR inout_mode OR out_mode OR NULL in Wf_Formal_Object");

      Type_Node := Next_Sibling (Current_Node => Next_Sibling (Current_Node => Ident_List_Node));
      -- ASSUME Type_Node = type_mark
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Type_Node) = SP_Symbols.type_mark,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Type_Node = type_mark in Wf_Formal_Object");

      if Syntax_Node_Type (Node => Mode_Node) = SP_Symbols.inout_mode
        or else Syntax_Node_Type (Node => Mode_Node) = SP_Symbols.out_mode then
         ErrorHandler.Semantic_Error
           (Err_Num   => 639,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Ident_List_Node),
            Id_Str    => LexTokenManager.Null_String);
      end if;

      Wf_Type_Mark
        (Node          => Type_Node,
         Current_Scope => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                     The_Unit       => Generic_Unit),
         Context       => Dictionary.ProgramContext,
         Type_Sym      => Formal_Type);
      if not Dictionary.IsUnknownTypeMark (Formal_Type) then
         Process_Identifiers
           (Node                         => Ident_List_Node,
            Type_Sym                     => Formal_Type,
            Generic_Ident_Node_Pos       => Generic_Ident_Node_Pos,
            Generic_Unit                 => Generic_Unit,
            Package_Or_Subprogram_Symbol => Package_Or_Subprogram_Symbol);
      end if;
   end Wf_Formal_Object;

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

   procedure Wf_Formal_Type
     (Node                         : in STree.SyntaxNode;
      Generic_Ident_Node_Pos       : in LexTokenManager.Token_Position;
      Generic_Unit                 : in Dictionary.Symbol;
      Package_Or_Subprogram_Symbol : in Dictionary.Symbol)
   --# 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 CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         Generic_Unit,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Package_Or_Subprogram_Symbol,
   --#                                         STree.Table &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Generic_Ident_Node_Pos,
   --#                                         Generic_Unit,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Package_Or_Subprogram_Symbol,
   --#                                         SLI.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table &
   --#         SLI.State                  from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Generic_Unit,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Package_Or_Subprogram_Symbol,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.formal_type_declaration;
   --# post STree.Table = STree.Table~;
   is
      Ident_Node    : STree.SyntaxNode;
      Type_Node     : STree.SyntaxNode;
      Ident_Str     : LexTokenManager.Lex_String;
      Declaration   : Dictionary.Location;
      Type_Mark     : Dictionary.Symbol;
      The_Duplicate : Dictionary.Symbol;
   begin
      Ident_Node := Child_Node (Current_Node => Node);
      -- ASSUME Ident_Node = indentifier
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.identifier,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Ident_Node = indentifier in Wf_Formal_Type");
      Ident_Str := Node_Lex_String (Node => Ident_Node);
      -- check whether name already in use
      The_Duplicate :=
        Dictionary.LookupItem
        (Name              => Ident_Str,
         Scope             => Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                                         The_Unit       => Package_Or_Subprogram_Symbol),
         Context           => Dictionary.ProofContext,
         Full_Package_Name => False);
      if The_Duplicate = Package_Or_Subprogram_Symbol then
         ErrorHandler.Semantic_Error
           (Err_Num   => 10,
            Reference => ErrorHandler.No_Reference,
            Position  => Generic_Ident_Node_Pos,
            Id_Str    => Ident_Str);
      elsif not Dictionary.Is_Null_Symbol (The_Duplicate) then
         ErrorHandler.Semantic_Error
           (Err_Num   => 10,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Ident_Node),
            Id_Str    => Ident_Str);
      else
         Type_Node := Child_Node (Current_Node => Next_Sibling (Current_Node => Ident_Node));
         -- ASSUME Type_Node = formal_private_type_definition OR formal_discrete_type_definition OR
         --                    formal_signed_integer_type_definition OR formal_modular_type_definition OR
         --                    formal_floating_point_definition OR formal_ordinary_fixed_point_definition OR
         --                    formal_array_type_definition
         Declaration :=
           Dictionary.Location'
           (Start_Position => Node_Position (Node => Ident_Node),
            End_Position   => Node_Position (Node => Ident_Node));
         case Syntax_Node_Type (Node => Type_Node) is
            when SP_Symbols.formal_private_type_definition =>
               -- ASSUME Type_Node = formal_private_type_definition
               Dictionary.Add_Generic_Type
                 (Name        => Ident_Str,
                  Comp_Unit   => ContextManager.Ops.Current_Unit,
                  Declaration => Declaration,
                  Scope       => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                            The_Unit       => Generic_Unit),
                  The_Type    => Type_Mark);
               STree.Add_Node_Symbol (Node => Ident_Node,
                                      Sym  => Type_Mark);
               Dictionary.Set_Generic_Private_Type
                 (The_Type   => Type_Mark,
                  Is_Limited => (Syntax_Node_Type (Node => Child_Node (Current_Node => Type_Node)) = SP_Symbols.RWlimited));
            when SP_Symbols.formal_discrete_type_definition =>
               -- ASSUME Type_Node = formal_discrete_type_definition
               Dictionary.Add_Generic_Type
                 (Name        => Ident_Str,
                  Comp_Unit   => ContextManager.Ops.Current_Unit,
                  Declaration => Declaration,
                  Scope       => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                            The_Unit       => Generic_Unit),
                  The_Type    => Type_Mark);
               STree.Add_Node_Symbol (Node => Ident_Node,
                                      Sym  => Type_Mark);
               Dictionary.Set_Generic_Discrete_Type (The_Type => Type_Mark);
            when SP_Symbols.formal_signed_integer_type_definition =>
               -- ASSUME Type_Node = formal_signed_integer_type_definition
               Dictionary.Add_Generic_Type
                 (Name        => Ident_Str,
                  Comp_Unit   => ContextManager.Ops.Current_Unit,
                  Declaration => Declaration,
                  Scope       => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                            The_Unit       => Generic_Unit),
                  The_Type    => Type_Mark);
               STree.Add_Node_Symbol (Node => Ident_Node,
                                      Sym  => Type_Mark);
               Dictionary.Set_Generic_Integer_Type (The_Type => Type_Mark);
            when SP_Symbols.formal_modular_type_definition =>
               -- ASSUME Type_Node = formal_modular_type_definition
               Dictionary.Add_Generic_Type
                 (Name        => Ident_Str,
                  Comp_Unit   => ContextManager.Ops.Current_Unit,
                  Declaration => Declaration,
                  Scope       => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                            The_Unit       => Generic_Unit),
                  The_Type    => Type_Mark);
               STree.Add_Node_Symbol (Node => Ident_Node,
                                      Sym  => Type_Mark);
               Dictionary.Set_Generic_Modular_Type (The_Type => Type_Mark);
            when SP_Symbols.formal_floating_point_definition =>
               -- ASSUME Type_Node = formal_floating_point_definition
               Dictionary.Add_Generic_Type
                 (Name        => Ident_Str,
                  Comp_Unit   => ContextManager.Ops.Current_Unit,
                  Declaration => Declaration,
                  Scope       => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                            The_Unit       => Generic_Unit),
                  The_Type    => Type_Mark);
               STree.Add_Node_Symbol (Node => Ident_Node,
                                      Sym  => Type_Mark);
               Dictionary.Set_Generic_Floating_Point_Type (The_Type => Type_Mark);
            when SP_Symbols.formal_ordinary_fixed_point_definition =>
               -- ASSUME Type_Node = formal_ordinary_fixed_point_definition
               Dictionary.Add_Generic_Type
                 (Name        => Ident_Str,
                  Comp_Unit   => ContextManager.Ops.Current_Unit,
                  Declaration => Declaration,
                  Scope       => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                            The_Unit       => Generic_Unit),
                  The_Type    => Type_Mark);
               STree.Add_Node_Symbol (Node => Ident_Node,
                                      Sym  => Type_Mark);
               Dictionary.Set_Generic_Fixed_Point_Type (The_Type => Type_Mark);
            when SP_Symbols.formal_array_type_definition =>
               -- ASSUME Type_Node = formal_array_type_definition
               Type_Node := Child_Node (Current_Node => Type_Node);
               -- ASSUME Type_Node = array_type_definition
               SystemErrors.RT_Assert
                 (C       => Syntax_Node_Type (Node => Type_Node) = SP_Symbols.array_type_definition,
                  Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect Type_Node = array_type_definition in Wf_Formal_Type");
               Wf_Array_Type_Definition
                 (Node       => Type_Node,
                  Scope      => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                           The_Unit       => Generic_Unit),
                  Ident_Node => Ident_Node,
                  Dec_Loc    => Node_Position (Node => Node),
                  The_Array  => Type_Mark);
               Dictionary.Set_Generic_Array_Type (The_Type => Type_Mark);
            when others =>
               Type_Mark := Dictionary.GetUnknownTypeMark; -- just to avoid data flow error
               SystemErrors.Fatal_Error
                 (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect Type_Node = formal_private_type_definition OR formal_discrete_type_definition OR " &
                    "formal_signed_integer_type_definition OR formal_modular_type_definition OR " &
                    "formal_floating_point_definition OR formal_ordinary_fixed_point_definition OR " &
                    "formal_array_type_definition in Wf_Formal_Type");
         end case;
         if ErrorHandler.Generate_SLI then
            SLI.Generate_Xref_Symbol
              (Comp_Unit      => ContextManager.Ops.Current_Unit,
               Parse_Tree     => Ident_Node,
               Symbol         => Type_Mark,
               Is_Declaration => True);
         end if;
         Dictionary.Add_Generic_Formal_Parameter
           (Comp_Unit    => ContextManager.Ops.Current_Unit,
            Declaration  => Declaration,
            Generic_Unit => Generic_Unit,
            The_Type     => Type_Mark,
            The_Object   => Dictionary.NullSymbol);
      end if;
   end Wf_Formal_Type;

begin -- Wf_Generic_Formal_Part
   Object_Or_Type_Node := Next_Sibling (Current_Node => Last_Child_Of (Start_Node => Node));
   while Syntax_Node_Type (Node => Object_Or_Type_Node) = SP_Symbols.formal_object_declaration
     or else Syntax_Node_Type (Node => Object_Or_Type_Node) = SP_Symbols.formal_type_declaration loop
      --# assert STree.Table = STree.Table~ and
      --#   (Syntax_Node_Type (Object_Or_Type_Node, STree.Table) = SP_Symbols.formal_object_declaration or
      --#      Syntax_Node_Type (Object_Or_Type_Node, STree.Table) = SP_Symbols.formal_type_declaration);
      case Syntax_Node_Type (Node => Object_Or_Type_Node) is
         when SP_Symbols.formal_object_declaration =>
            -- ASSUME Object_Or_Type_Node = formal_object_declaration
            Wf_Formal_Object
              (Node                         => Object_Or_Type_Node,
               Generic_Ident_Node_Pos       => Generic_Ident_Node_Pos,
               Generic_Unit                 => Generic_Unit,
               Package_Or_Subprogram_Symbol => Package_Or_Subprogram_Symbol);
         when SP_Symbols.formal_type_declaration =>
            -- ASSUME Object_Or_Type_Node = formal_type_declaration
            Wf_Formal_Type
              (Node                         => Object_Or_Type_Node,
               Generic_Ident_Node_Pos       => Generic_Ident_Node_Pos,
               Generic_Unit                 => Generic_Unit,
               Package_Or_Subprogram_Symbol => Package_Or_Subprogram_Symbol);
         when others =>
            null;
      end case;
      Object_Or_Type_Node := Next_Sibling (Current_Node => Parent_Node (Current_Node => Object_Or_Type_Node));
   end loop;
end Wf_Generic_Formal_Part;
