-------------------------------------------------------------------------------
-- (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 Up_Wf_Aggregate_Or_Expression
  (Node    : in out STree.SyntaxNode;
   Scope   : in     Dictionary.Scopes;
   E_Stack : in out Exp_Stack.Exp_Stack_Type) is
   Parent, Child        : STree.SyntaxNode;
   Name_Exp, Exp_Result : Sem.Exp_Record;
   Expected_Type        : Dictionary.Symbol;
   Index_Type_Symbol    : Dictionary.Symbol;
   Type_Lower_Bound     : Sem.Typ_Type_Bound;
   Type_Upper_Bound     : Sem.Typ_Type_Bound;
   Aggregate_Flags      : Sem.Typ_Agg_Flags;
   Entry_Counter        : Natural;
   Complete_Rec         : CompleteCheck.T;

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

   procedure Chain_Up_To_Component_Association (Node : in out STree.SyntaxNode)
   --# global in STree.Table;
   --# derives Node from *,
   --#                   STree.Table;
   --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.aggregate_or_expression or
   --#   STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_aggregate_or_expression;
   --# post STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.component_association or
   --#   STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_component_association;
   is
   begin
      while STree.Syntax_Node_Type (Node => Node) /= SP_Symbols.component_association
        and then STree.Syntax_Node_Type (Node => Node) /= SP_Symbols.annotation_component_association loop
         Node := STree.Parent_Node (Current_Node => Node);
      end loop;
   end Chain_Up_To_Component_Association;

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

   -- type is needed at aggregate_or_expression node except if it associated
   -- with an "others" clause in which case it is needed at component_association
   -- node; this procedure puts it in the right place
   procedure Plant_Type (Node          : in STree.SyntaxNode;
                         Expected_Type : in Dictionary.Symbol;
                         Parent        : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in out STree.Table;
   --# derives STree.Table from *,
   --#                          Expected_Type,
   --#                          Node,
   --#                          Parent &
   --#         null        from Dictionary.Dict;
   --# pre (STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.aggregate_or_expression or
   --#        STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_aggregate_or_expression) and
   --#   (STree.Syntax_Node_Type (Parent, STree.Table) = SP_Symbols.positional_association or
   --#      STree.Syntax_Node_Type (Parent, STree.Table) = SP_Symbols.positional_association_rep or
   --#      STree.Syntax_Node_Type (Parent, STree.Table) = SP_Symbols.annotation_positional_association or
   --#      STree.Syntax_Node_Type (Parent, STree.Table) = SP_Symbols.annotation_positional_association_rep) and
   --#   Parent = STree.Parent_Node (Node, STree.Table) and
   --#   (Dictionary.Is_Null_Symbol (Expected_Type) or Dictionary.IsTypeMark (Expected_Type, Dictionary.Dict));
   --# post STree.Table = STree.Table~;
   is
      Next_Node, Grand_Parent : STree.SyntaxNode;
   begin
      if STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.positional_association
        or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.annotation_positional_association then
         -- ASSUME Parent = positional_association OR annotation_positional_association
         Next_Node := STree.Next_Sibling (Current_Node => Node);
         -- ASSUME Next_Node = aggregate_or_expression OR annotation_aggregate_or_expression OR NULL
         if Next_Node = STree.NullNode then
            -- ASSUME Next_Node = NULL
            -- we are dealing with an others clause
            Grand_Parent := STree.Parent_Node (Current_Node => Parent);
            -- ASSUME Grand_Parent = component_association            OR positional_association            OR positional_association_rep OR
            --                       annotation_component_association OR annotation_positional_association OR annotation_positional_association_rep
            SystemErrors.RT_Assert
              (C       => STree.Syntax_Node_Type (Node => Grand_Parent) = SP_Symbols.component_association
                 or else STree.Syntax_Node_Type (Node => Grand_Parent) = SP_Symbols.positional_association
                 or else STree.Syntax_Node_Type (Node => Grand_Parent) = SP_Symbols.positional_association_rep
                 or else STree.Syntax_Node_Type (Node => Grand_Parent) = SP_Symbols.annotation_component_association
                 or else STree.Syntax_Node_Type (Node => Grand_Parent) = SP_Symbols.annotation_positional_association
                 or else STree.Syntax_Node_Type (Node => Grand_Parent) = SP_Symbols.annotation_positional_association_rep,
               Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Parent = component_association OR positional_association OR positional_association_rep OR " &
                 "annotation_component_association OR annotation_positional_association OR annotation_positional_association_rep " &
                 " in Plant_Type");
            STree.Add_Node_Symbol (Node => Grand_Parent,
                                   Sym  => Expected_Type);
         elsif STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.aggregate_or_expression
           or else STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.annotation_aggregate_or_expression then
            -- ASSUME Next_Node = aggregate_or_expression OR annotation_aggregate_or_expression
            STree.Add_Node_Symbol (Node => Node,
                                   Sym  => Expected_Type);
         else
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Next_Node = aggregate_or_expression OR annotation_aggregate_or_expression OR " &
                 "NULL in Plant_Type");
         end if;
      elsif STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.positional_association_rep
        or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.annotation_positional_association_rep then
         -- ASSUME Parent = positional_association_rep OR annotation_positional_association_rep
         STree.Add_Node_Symbol (Node => Node,
                                Sym  => Expected_Type);
      end if;
   end Plant_Type;

begin -- Up_Wf_Aggregate_Or_Expression
   Parent := STree.Parent_Node (Current_Node => Node);
   -- ASSUME Parent = component_association OR named_association      OR named_association_rep      OR
   --                 name_value_property   OR positional_association OR positional_association_rep OR
   --                 annotation_named_association      OR annotation_named_association_rep OR annotation_component_association OR
   --                 annotation_positional_association OR annotation_positional_association_rep
   SystemErrors.RT_Assert
     (C       => 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.name_value_property
        or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.positional_association
        or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.positional_association_rep
        or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.annotation_named_association
        or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.annotation_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_positional_association
        or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.annotation_positional_association_rep,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Parent = component_association OR named_association OR named_association_rep OR " &
        "name_value_property OR positional_association OR positional_association_rep OR " &
        "annotation_named_association OR annotation_named_association_rep OR annotation_component_association OR " &
        "annotation_positional_association OR annotation_positional_association_rep in Up_Wf_Aggregate_Or_Expression");
   Child := STree.Child_Node (Current_Node => Node);
   -- ASSUME Child = aggregate            OR expression OR
   --                annotation_aggregate OR annotation_expression
   if STree.Syntax_Node_Type (Node => Child) = SP_Symbols.expression
     or else STree.Syntax_Node_Type (Node => Child) = SP_Symbols.annotation_expression then
      -- ASSUME Child = expression OR annotation_expression
      if STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.positional_association_rep
        or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.annotation_positional_association_rep
        or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.positional_association
        or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.annotation_positional_association then
         -- ASSUME Parent = positional_association            OR positional_association_rep OR
         --                 annotation_positional_association OR annotation_positional_association_rep
         Exp_Stack.Pop (Item  => Exp_Result,
                        Stack => E_Stack);
         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);
         elsif Dictionary.TypeIsArray (Name_Exp.Type_Symbol) then
            Expected_Type := Dictionary.GetArrayComponent (Name_Exp.Type_Symbol);
            Plant_Type (Node          => Node,
                        Expected_Type => Expected_Type,
                        Parent        => Parent);
            Sem.Assignment_Check
              (Position    => STree.Node_Position (Node => Child),
               Scope       => Scope,
               Target_Type => Expected_Type,
               Exp_Result  => Exp_Result);
            Name_Exp.Is_Constant := Name_Exp.Is_Constant and then Exp_Result.Is_Constant;

            -- if this is not the others clause
            -- increment the entry counter on the aggregate stack
            -- nb: we already know that it's positional association here
            if STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.positional_association_rep
              or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.annotation_positional_association_rep then
               -- ASSUME Parent = positional_association_rep OR annotation_positional_association_rep
               Aggregate_Stack.Pop
                 (Type_Sym     => Index_Type_Symbol,
                  Lower_Bound  => Type_Lower_Bound,
                  Upper_Bound  => Type_Upper_Bound,
                  Agg_Flags    => Aggregate_Flags,
                  Counter      => Entry_Counter,
                  Complete_Rec => Complete_Rec);
               if Entry_Counter < Natural'Last then
                  Entry_Counter := Entry_Counter + 1;
               else
                  Aggregate_Flags.More_Entries_Than_Natural := True;
               end if;
               Aggregate_Stack.Push
                 (Type_Sym     => Index_Type_Symbol,
                  Lower_Bound  => Type_Lower_Bound,
                  Upper_Bound  => Type_Upper_Bound,
                  Agg_Flags    => Aggregate_Flags,
                  Counter      => Entry_Counter,
                  Complete_Rec => Complete_Rec);
            end if;
            Name_Exp.Errors_In_Expression := Name_Exp.Errors_In_Expression or else Exp_Result.Errors_In_Expression;
            Exp_Stack.Push (X     => Name_Exp,
                            Stack => E_Stack);
         elsif Dictionary.TypeIsRecord (Name_Exp.Type_Symbol) then
            if Name_Exp.Param_Count = Dictionary.GetNumberOfComponents (Name_Exp.Type_Symbol) then
               Exp_Stack.Push (X     => Sem.Unknown_Type_Record,
                               Stack => E_Stack);
               ErrorHandler.Semantic_Error
                 (Err_Num   => 105,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Child),
                  Id_Str    => Dictionary.GetSimpleName (Name_Exp.Other_Symbol));
               Chain_Up_To_Component_Association (Node => Node);
            elsif Name_Exp.Param_Count < Dictionary.GetNumberOfComponents (Name_Exp.Type_Symbol) then
               Name_Exp.Param_Count := Name_Exp.Param_Count + 1;
               Expected_Type        :=
                 Dictionary.GetType (Dictionary.GetRecordComponent (Name_Exp.Type_Symbol, Name_Exp.Param_Count));
               Plant_Type (Node          => Node,
                           Expected_Type => Expected_Type,
                           Parent        => Parent);
               Sem.Assignment_Check
                 (Position    => STree.Node_Position (Node => Child),
                  Scope       => Scope,
                  Target_Type => Expected_Type,
                  Exp_Result  => Exp_Result);
               Name_Exp.Is_Constant := Name_Exp.Is_Constant and then Exp_Result.Is_Constant;
               Exp_Stack.Push (X     => Name_Exp,
                               Stack => E_Stack);
            end if;
         end if;
      end if;
   elsif STree.Syntax_Node_Type (Node => Child) = SP_Symbols.aggregate
     or else STree.Syntax_Node_Type (Node => Child) = SP_Symbols.annotation_aggregate then
      -- ASSUME Child = aggregate OR annotation_aggregate
      if STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.positional_association_rep
        or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.annotation_positional_association_rep then
         -- ASSUME Parent = positional_association_rep OR annotation_positional_association_rep
         Exp_Stack.Pop (Item  => Name_Exp,
                        Stack => E_Stack);
         if Dictionary.TypeIsArray (Name_Exp.Type_Symbol) then
            Aggregate_Stack.Pop
              (Type_Sym     => Index_Type_Symbol,
               Lower_Bound  => Type_Lower_Bound,
               Upper_Bound  => Type_Upper_Bound,
               Agg_Flags    => Aggregate_Flags,
               Counter      => Entry_Counter,
               Complete_Rec => Complete_Rec);
            if Entry_Counter < Natural'Last then
               Entry_Counter := Entry_Counter + 1;
            else
               Aggregate_Flags.More_Entries_Than_Natural := True;
            end if;
            Aggregate_Stack.Push
              (Type_Sym     => Index_Type_Symbol,
               Lower_Bound  => Type_Lower_Bound,
               Upper_Bound  => Type_Upper_Bound,
               Agg_Flags    => Aggregate_Flags,
               Counter      => Entry_Counter,
               Complete_Rec => Complete_Rec);
         end if;
         Exp_Stack.Push (X     => Name_Exp,
                         Stack => E_Stack);
      end if;
   else
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Child = aggregate OR expression OR " &
           "annotation_aggregate OR annotation_expression in Up_Wf_Aggregate_Or_Expression");
   end if;
end Up_Wf_Aggregate_Or_Expression;
