-------------------------------------------------------------------------------
-- (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.Walk_Expression_P)
procedure Wf_Aggregate_Choice_Rep
  (Node       : in     STree.SyntaxNode;
   Scope      : in     Dictionary.Scopes;
   E_Stack    : in out Exp_Stack.Exp_Stack_Type;
   Heap_Param : in out Lists.List_Heap;
   Next_Node  :    out STree.SyntaxNode)
is
   Name_Exp, Field_Info : Sem.Exp_Record;
   Field_Ident_Node     : STree.SyntaxNode;
   Field_Ident          : LexTokenManager.Lex_String;
   Field_Symbol         : Dictionary.Symbol;
   Already_Present      : Boolean;

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

   function Range_Found (Node : STree.SyntaxNode) return Boolean
   --# global in STree.Table;
   --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.aggregate_choice_rep or
   --#   STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_aggregate_choice_rep;
   is
      Next_Node : STree.SyntaxNode;
      Result    : Boolean;
   begin
      Next_Node := STree.Child_Node (Current_Node => Node);
      -- ASSUME Next_Node = aggregate_choice_rep            OR aggregate_choice OR
      --                    annotation_aggregate_choice_rep OR annotation_aggregate_choice
      if STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.aggregate_choice_rep
        or else STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.annotation_aggregate_choice_rep then
         -- ASSUME Next_Node = aggregate_choice_rep OR annotation_aggregate_choice_rep
         Result := True;
      elsif STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.aggregate_choice
        or else STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.annotation_aggregate_choice then
         -- ASSUME Next_Node = aggregate_choice OR annotation_aggregate_choice
         Next_Node := STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Next_Node));
         -- ASSUME Next_Node = range_constraint            OR simple_expression OR NULL OR
         --                    annotation_range_constraint OR annotation_simple_expression
         if Next_Node = STree.NullNode then
            -- ASSUME Next_Node = NULL
            Result := False;
         elsif STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.range_constraint
           or else STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.simple_expression
           or else STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.annotation_range_constraint
           or else STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.annotation_simple_expression then
            -- ASSUME Next_Node = range_constraint            OR simple_expression OR
            --                    annotation_range_constraint OR annotation_simple_expression
            Result := True;
         else
            Result := False;
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Next_Node = range_constraint OR simple_expression " &
                 "annotation_range_constraint OR annotation_simple_expression in Range_Found");
         end if;
      else
         Result := False;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Next_Node = aggregate_choice_rep OR aggregate_choice " &
              "annotation_aggregate_choice_rep OR annotation_aggregate_choice in Range_Found");
      end if;
      return Result;
   end Range_Found;

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

   procedure Check_For_Branches (Start_Node, End_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,
   --#                                         End_Node,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         Start_Node,
   --#                                         STree.Table;
   --# pre (STree.Syntax_Node_Type (End_Node, STree.Table) = SP_Symbols.aggregate_choice_rep or
   --#        STree.Syntax_Node_Type (End_Node, STree.Table) = SP_Symbols.annotation_aggregate_choice_rep) and
   --#   Start_Node = STree.Last_Child_Of (End_Node, STree.Table);
   is
      Next_Node : STree.SyntaxNode;
   begin
      Next_Node := Start_Node;
      while Next_Node /= End_Node loop
         if STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.aggregate_choice_rep
           or else STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.annotation_aggregate_choice_rep then
            Next_Node := STree.Next_Sibling (Current_Node => Next_Node);
            -- ASSUME Next_Node = aggregate_choice OR annotation_aggregate_choice
            SystemErrors.RT_Assert
              (C       => STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.aggregate_choice
                 or else STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.annotation_aggregate_choice,
               Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Next_Node = aggregate_choice OR annotation_aggregate_choice in Check_For_Branches");
            ErrorHandler.Semantic_Error
              (Err_Num   => 60,
               Reference => ErrorHandler.No_Reference,
               Position  => STree.Node_Position (Node => Next_Node),
               Id_Str    => LexTokenManager.Null_String);
         end if;
         Next_Node := STree.Parent_Node (Current_Node => Next_Node);
      end loop;
   end Check_For_Branches;

begin -- Wf_Aggregate_Choice_Rep
   Exp_Stack.Pop (Item  => Name_Exp,
                  Stack => E_Stack);
   if Dictionary.IsUnknownTypeMark (Name_Exp.Type_Symbol) then
      Exp_Stack.Push (X     => Name_Exp,
                      Stack => E_Stack);
      Next_Node := STree.NullNode;
   elsif Dictionary.TypeIsArray (Name_Exp.Type_Symbol) then
      Exp_Stack.Push (X     => Name_Exp,
                      Stack => E_Stack);
      Next_Node := STree.Child_Node (Current_Node => Node);
      -- ASSUME Next_Node = aggregate_choice_rep            OR aggregate_choice OR
      --                    annotation_aggregate_choice_rep OR annotation_aggregate_choice
      SystemErrors.RT_Assert
        (C       => STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.aggregate_choice_rep
           or else STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.aggregate_choice
           or else STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.annotation_aggregate_choice_rep
           or else STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.annotation_aggregate_choice,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Next_Node = aggregate_choice_rep OR aggregate_choice " &
           "annotation_aggregate_choice_rep OR annotation_aggregate_choice in Wf_Aggregate_Choice_Rep");
   else -- must be a record
      if Range_Found (Node => Node) then
         Exp_Stack.Push (X     => Name_Exp,
                         Stack => E_Stack);
         Exp_Stack.Push (X     => Null_Parameter_Record,
                         Stack => E_Stack);
         ErrorHandler.Semantic_Error
           (Err_Num   => 60,
            Reference => ErrorHandler.No_Reference,
            Position  => STree.Node_Position (Node => Node),
            Id_Str    => LexTokenManager.Null_String);
      else
         Field_Ident_Node := STree.Last_Child_Of (Start_Node => Node);
         if STree.Syntax_Node_Type (Node => Field_Ident_Node) = SP_Symbols.identifier then
            -- ASSUME Field_Ident_Node = identifier
            Field_Ident  := STree.Node_Lex_String (Node => Field_Ident_Node);
            Field_Symbol :=
              Dictionary.LookupSelectedItem
              (Prefix   => Name_Exp.Type_Symbol,
               Selector => Field_Ident,
               Scope    => Scope,
               Context  => Dictionary.ProgramContext);
            if Dictionary.Is_Null_Symbol (Field_Symbol) then -- no such field
               Exp_Stack.Push (X     => Name_Exp,
                               Stack => E_Stack);
               Exp_Stack.Push (X     => Null_Parameter_Record,
                               Stack => E_Stack);
               ErrorHandler.Semantic_Error
                 (Err_Num   => 8,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Field_Ident_Node),
                  Id_Str    => Field_Ident);
            else -- field name exists
               Add_Name (Name       => Field_Ident,
                         List       => Name_Exp.Param_List,
                         Heap_Param => Heap_Param,
                         Present    => Already_Present);
               if Already_Present then
                  Exp_Stack.Push (X     => Name_Exp,
                                  Stack => E_Stack);
                  Exp_Stack.Push (X     => Null_Parameter_Record,
                                  Stack => E_Stack);
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 103,
                     Reference => ErrorHandler.No_Reference,
                     Position  => STree.Node_Position (Node => Field_Ident_Node),
                     Id_Str    => Field_Ident);
               else -- no value thus far assigned
                  STree.Set_Node_Lex_String (Sym  => Field_Symbol,
                                             Node => Field_Ident_Node);
                  Field_Info              := Null_Parameter_Record;
                  Field_Info.Other_Symbol := Field_Symbol;
                  Exp_Stack.Push (X     => Name_Exp,
                                  Stack => E_Stack);
                  Exp_Stack.Push (X     => Field_Info,
                                  Stack => E_Stack);
               end if;
            end if;
         else -- identifier not found
            Exp_Stack.Push (X     => Name_Exp,
                            Stack => E_Stack);
            Exp_Stack.Push (X     => Null_Parameter_Record,
                            Stack => E_Stack);
            ErrorHandler.Semantic_Error
              (Err_Num   => 102,
               Reference => ErrorHandler.No_Reference,
               Position  => STree.Node_Position (Node => Field_Ident_Node),
               Id_Str    => Dictionary.GetSimpleName (Name_Exp.Other_Symbol));
         end if;
         Check_For_Branches (Start_Node => Field_Ident_Node,
                             End_Node   => Node);
      end if;
      Next_Node := STree.NullNode;
   end if;
end Wf_Aggregate_Choice_Rep;
