-------------------------------------------------------------------------------
-- (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_Array_Type_Definition
  (Node       : in     STree.SyntaxNode;
   Scope      : in     Dictionary.Scopes;
   Ident_Node : in     STree.SyntaxNode;
   Dec_Loc    : in     LexTokenManager.Token_Position;
   The_Array  :    out Dictionary.Symbol)
is
   Root_Node, Type_Node, Next_Node : STree.SyntaxNode;
   It                              : STree.Iterator;
   Constrained                     : Boolean;
   Type_Sym, The_Array_Index       : Dictionary.Symbol;
   Type_Pos                        : LexTokenManager.Token_Position;
begin
   Root_Node := Child_Node (Current_Node => Node);
   -- ASSUME Root_Node = unconstrained_array_definition OR constrained_array_definition
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Root_Node) = SP_Symbols.unconstrained_array_definition
        or else Syntax_Node_Type (Node => Root_Node) = SP_Symbols.constrained_array_definition,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Root_Node = unconstrained_array_definition OR constrained_array_definition in Wf_Array_Type_Definition");
   Constrained := Syntax_Node_Type (Node => Root_Node) = SP_Symbols.constrained_array_definition;
   Root_Node   := Child_Node (Current_Node => Root_Node);
   -- ASSUME Root_Node = unconstrained_array_definition_rep OR index_constraint
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Root_Node) = SP_Symbols.unconstrained_array_definition_rep
        or else Syntax_Node_Type (Node => Root_Node) = SP_Symbols.index_constraint,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Root_Node = unconstrained_array_definition_rep OR index_constraint in Wf_Array_Type_Definition");
   Type_Node := Next_Sibling (Current_Node => Root_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_Array_Type_Definition");
   Type_Pos  := Node_Position (Node => Type_Node);
   The_Array := Dictionary.GetUnknownTypeMark; -- default answer in case of errors
   Wf_Type_Mark (Node          => Type_Node,
                 Current_Scope => Scope,
                 Context       => Dictionary.ProgramContext,
                 Type_Sym      => Type_Sym);
   if Dictionary.Is_Unconstrained_Array_Type_Mark (Type_Sym, Scope) then
      ErrorHandler.Semantic_Error
        (Err_Num   => 39,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Type_Node),
         Id_Str    => LexTokenManager.Null_String);
   end if;

   -- Check that the type is not a suspension object or protected type
   if Dictionary.IsPredefinedSuspensionObjectType (Type_Sym) or else Dictionary.IsProtectedTypeMark (Type_Sym) then
      ErrorHandler.Semantic_Error
        (Err_Num   => 906,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Type_Node),
         Id_Str    => LexTokenManager.Null_String);
   else
      Dictionary.Add_Array_Type
        (Name                     => Node_Lex_String (Node => Ident_Node),
         Comp_Unit                => ContextManager.Ops.Current_Unit,
         Declaration              => Dictionary.Location'(Start_Position => Dec_Loc,
                                                          End_Position   => Dec_Loc),
         Scope                    => Scope,
         Context                  => Dictionary.ProgramContext,
         Constrained              => Constrained,
         Component_Type           => Type_Sym,
         Component_Type_Reference => Dictionary.Location'(Start_Position => Type_Pos,
                                                          End_Position   => Type_Pos),
         The_Type                 => The_Array);
      STree.Add_Node_Symbol (Node => Ident_Node,
                             Sym  => The_Array);
      if ErrorHandler.Generate_SLI then
         SLI.Generate_Xref_Symbol
           (Comp_Unit      => ContextManager.Ops.Current_Unit,
            Parse_Tree     => Ident_Node,
            Symbol         => The_Array,
            Is_Declaration => True);
      end if;
      -- now loop through all the index type marks
      It := Find_First_Node (Node_Kind    => SP_Symbols.type_mark,
                             From_Root    => Root_Node,
                             In_Direction => STree.Down);
      while not STree.IsNull (It) loop
         Next_Node := Get_Node (It => It);
         --# assert STree.Table = STree.Table~ and
         --#   Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.type_mark and
         --#   Next_Node = Get_Node (It);
         Wf_Type_Mark (Node          => Next_Node,
                       Current_Scope => Scope,
                       Context       => Dictionary.ProgramContext,
                       Type_Sym      => Type_Sym);
         if not Dictionary.IsUnknownTypeMark (Type_Sym) then
            if Dictionary.Types_Are_Equal (Left_Symbol        => Type_Sym,
                                           Right_Symbol       => The_Array,
                                           Full_Range_Subtype => False) then
               -- Type of index is same as type of array being declared
               ErrorHandler.Semantic_Error
                 (Err_Num   => 750,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Next_Node),
                  Id_Str    => Dictionary.GetSimpleName (Type_Sym));
            else -- no self-reference attempted
               if not Dictionary.IsDiscreteTypeMark (Type_Sym, Scope) then
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 46,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Position (Node => Next_Node),
                     Id_Str    => LexTokenManager.Null_String);
               end if;
               if not Dictionary.TypeIsWellformed (Type_Sym) then
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 47,
                     Reference => 1,
                     Position  => Node_Position (Node => Next_Node),
                     Id_Str    => LexTokenManager.Null_String);
               end if;
            end if;
         end if;
         Dictionary.AddArrayIndex
           (TheArrayType  => The_Array,
            IndexType     => Type_Sym,
            Comp_Unit     => ContextManager.Ops.Current_Unit,
            Declaration   => Dictionary.Location'(Start_Position => Node_Position (Node => Next_Node),
                                                  End_Position   => Node_Position (Node => Next_Node)),
            TheArrayIndex => The_Array_Index);
         STree.Add_Node_Symbol (Node => Next_Node,
                                Sym  => The_Array_Index);
         It := STree.NextNode (It);
      end loop;
   end if;
end Wf_Array_Type_Definition;
