-------------------------------------------------------------------------------
-- (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 Down_Wf_Aggregate_Or_Expression
  (Node      : in     STree.SyntaxNode;
   E_Stack   : in out Exp_Stack.Exp_Stack_Type;
   Next_Node :    out STree.SyntaxNode)
is
   Name_Exp, Field_Name                                                 : Sem.Exp_Record;
   Record_Field_Found, Reached_Last_Dimension, Doing_Embedded_Aggregate : Boolean;
   Parent, Child                                                        : STree.SyntaxNode;
begin
   Exp_Stack.Pop (Item  => Name_Exp,
                  Stack => E_Stack);
   if Name_Exp.Sort = Sem.Is_Parameter_Name then
      Record_Field_Found := True;
      Field_Name         := Name_Exp;
      Exp_Stack.Pop (Item  => Name_Exp,
                     Stack => E_Stack);
   else
      Record_Field_Found := False;
   end if;
   Child := STree.Child_Node (Current_Node => Node);
   -- ASSUME Child = aggregate            OR expression OR
   --                annotation_aggregate OR annotation_expression
   SystemErrors.RT_Assert
     (C       => STree.Syntax_Node_Type (Node => Child) = SP_Symbols.aggregate
        or else STree.Syntax_Node_Type (Node => Child) = SP_Symbols.expression
        or else STree.Syntax_Node_Type (Node => Child) = SP_Symbols.annotation_aggregate
        or else STree.Syntax_Node_Type (Node => Child) = SP_Symbols.annotation_expression,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Child = aggregate OR expression OR " &
        "annotation_aggregate OR annotation_expression in Down_Wf_Aggregate_Or_Expression");
   Doing_Embedded_Aggregate := STree.Syntax_Node_Type (Node => Child) = SP_Symbols.aggregate
     or else STree.Syntax_Node_Type (Node => Child) = SP_Symbols.annotation_aggregate;

   if Dictionary.IsUnknownTypeMark (Name_Exp.Type_Symbol) then
      Exp_Stack.Push (X     => Name_Exp,
                      Stack => E_Stack);
      if Doing_Embedded_Aggregate then
         Next_Node := STree.NullNode;
      else
         Next_Node := Child;
      end if;
   elsif Dictionary.TypeIsArray (Name_Exp.Type_Symbol) then
      Exp_Stack.Push (X     => Name_Exp,
                      Stack => E_Stack);
      Reached_Last_Dimension := Name_Exp.Param_Count = Dictionary.GetNumberOfDimensions (Name_Exp.Type_Symbol);
      if Reached_Last_Dimension = Doing_Embedded_Aggregate then
         Next_Node := STree.NullNode;
         ErrorHandler.Semantic_Error
           (Err_Num   => 38,
            Reference => ErrorHandler.No_Reference,
            Position  => STree.Node_Position (Node => Child),
            Id_Str    => LexTokenManager.Null_String);
         -- Clause below covers the case where not enough dimensions have been supplied.
         -- Because the tree walk has been pruned as a result of this error the expression
         -- is not traversed and not stacked; this is fine for positional association but
         -- in named association gives a stack underflow later on in either
         -- up_wf_named_association_rep or up_wf_component_association.  To cover these cases
         -- we must put something on the stack.  An Sem.Unknown_Type_Record seems appropriate.
         -- We only do this if the association is not positional
         if not Reached_Last_Dimension then
            Parent := STree.Parent_Node (Current_Node => Node);
            -- ASSUME Parent = component_association            OR
            --                 annotation_component_association OR name_value_property OR
            --                 named_association            OR named_association_rep            OR
            --                 annotation_named_association OR annotation_named_association_rep OR
            --                 positional_association            OR positional_association_rep OR
            --                 annotation_positional_association OR annotation_positional_association_rep
            if STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.component_association
              or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.named_association
              or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.named_association_rep
              or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.annotation_component_association
              or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.annotation_named_association
              or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.annotation_positional_association_rep
              or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.name_value_property then
               Exp_Stack.Push (X     => Sem.Unknown_Type_Record,
                               Stack => E_Stack);
            elsif STree.Syntax_Node_Type (Node => Parent) /= SP_Symbols.positional_association_rep
              and then STree.Syntax_Node_Type (Node => Parent) /= SP_Symbols.annotation_positional_association_rep
              and then STree.Syntax_Node_Type (Node => Parent) /= SP_Symbols.positional_association
              and then STree.Syntax_Node_Type (Node => Parent) /= SP_Symbols.annotation_positional_association then
               SystemErrors.Fatal_Error
                 (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect Parent = component_association OR " &
                    "annotation_component_association OR name_value_property OR " &
                    "named_association OR named_association_rep OR " &
                    "annotation_named_association OR annotation_named_association_rep OR " &
                    "positional_association OR positional_association_rep OR " &
                    "annotation_positional_association OR annotation_positional_association_rep " &
                    "in Down_Wf_Aggregate_Or_Expression");
            end if;
         end if;
      else
         Next_Node := Child;
      end if;
   else -- must be record
      Exp_Stack.Push (X     => Name_Exp,
                      Stack => E_Stack);
      if Doing_Embedded_Aggregate then
         Next_Node := STree.NullNode;
         ErrorHandler.Semantic_Error
           (Err_Num   => 38,
            Reference => ErrorHandler.No_Reference,
            Position  => STree.Node_Position (Node => Child),
            Id_Str    => LexTokenManager.Null_String);
      else
         if Record_Field_Found then
            --# accept Flow, 504, Field_Name, "Expected Fieldname to have undefined value";
            Exp_Stack.Push (X     => Field_Name,
                            Stack => E_Stack);
            --# end accept;
         end if;
         Next_Node := Child;
      end if;
   end if;
   --# accept Flow, 602, E_Stack, Field_Name, "Fieldname always defined if needed";
end Down_Wf_Aggregate_Or_Expression;
