public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Ada] Ongoing work for AI12-0212: container aggregates
@ 2021-05-05  8:20 Pierre-Marie de Rodat
  0 siblings, 0 replies; 4+ messages in thread
From: Pierre-Marie de Rodat @ 2021-05-05  8:20 UTC (permalink / raw)
  To: gcc-patches; +Cc: Ed Schonberg

[-- Attachment #1: Type: text/plain, Size: 710 bytes --]

Add legality checks for indexed aggregates with component associations.

RN 4.3.5 (28/5 - 30/5) specifies validity rules for indexed aggregates,
intended to simplify implementation as well as the computation of the
expected size of an indexed aggregate, such for an aggregaate of a
vector type.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* sem_aggr.adb (Resolve_Indexed_Aggregate): For indexed
	aggregates with component associations verify that if there is
	more than one component association then all the choices are
	static, that the set of choices define a continuous sequence of
	values, and that if loop specfications appear, they do not
	include iterator filters or key expressions.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 6037 bytes --]

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2980,9 +2980,12 @@ package body Sem_Aggr is
             Index_Type : constant Entity_Id := Etype (Next_Formal (Container));
             Comp_Type  : constant Entity_Id :=
                                  Etype (Next_Formal (Next_Formal (Container)));
-            Comp   : Node_Id;
-            Choice : Node_Id;
+            Comp        : Node_Id;
+            Choice      : Node_Id;
+            Num_Choices : Nat := 0;
 
+            Hi_Val : Uint;
+            Lo_Val : Uint;
          begin
             if Present (Expressions (N)) then
                Comp := First (Expressions (N));
@@ -2999,7 +3002,7 @@ package body Sem_Aggr is
                   return;
                end if;
 
-               Comp := First (Expressions (N));
+               Comp := First (Component_Associations (N));
 
                while Present (Comp) loop
                   if Nkind (Comp) = N_Component_Association then
@@ -3007,6 +3010,7 @@ package body Sem_Aggr is
 
                      while Present (Choice) loop
                         Analyze_And_Resolve (Choice, Index_Type);
+                        Num_Choices := Num_Choices + 1;
                         Next (Choice);
                      end loop;
 
@@ -3018,10 +3022,107 @@ package body Sem_Aggr is
                   then
                      Resolve_Iterated_Association
                        (Comp, Index_Type, Comp_Type);
+                     Num_Choices := Num_Choices + 1;
                   end if;
 
                   Next (Comp);
                end loop;
+
+               --  The component associations in an indexed aggregate
+               --  must denote a contiguous set of static values. We
+               --  build a table of values/ranges and sort it, as is done
+               --  elsewhere for case statements and array aggregates.
+               --  If the aggregate has a single iterated association it
+               --  is allowed to be nonstatic and there is nothing to check.
+
+               if Num_Choices > 1 then
+                  declare
+                     Table     : Case_Table_Type (1 .. Num_Choices);
+                     No_Choice : Pos := 1;
+                     Lo, Hi    : Node_Id;
+
+                  --  Traverse aggregate to determine size of needed table.
+                  --  Verify that bounds are static and that loops have no
+                  --  filters or key expressions.
+
+                  begin
+                     Comp := First (Component_Associations (N));
+                     while Present (Comp) loop
+                        if Nkind (Comp) = N_Iterated_Element_Association then
+                           if Present
+                             (Loop_Parameter_Specification (Comp))
+                           then
+                              if Present (Iterator_Filter
+                                (Loop_Parameter_Specification (Comp)))
+                              then
+                                 Error_Msg_N
+                                   ("iterator filter not allowed " &
+                                     "in indexed aggregate", Comp);
+                                 return;
+
+                              elsif Present (Key_Expression
+                                (Loop_Parameter_Specification (Comp)))
+                              then
+                                 Error_Msg_N
+                                   ("key expression not allowed " &
+                                     "in indexed aggregate", Comp);
+                                 return;
+                              end if;
+                           end if;
+                        else
+                           Choice := First (Choices (Comp));
+
+                           while Present (Choice) loop
+                              Get_Index_Bounds (Choice, Lo, Hi);
+                              Table (No_Choice).Choice := Choice;
+                              Table (No_Choice).Lo := Lo;
+                              Table (No_Choice).Hi := Hi;
+
+                              --  Verify staticness of value or range
+
+                              if not Is_Static_Expression (Lo)
+                                or else not Is_Static_Expression (Hi)
+                              then
+                                 Error_Msg_N
+                                   ("nonstatic expression for index " &
+                                     "for indexed aggregate", Choice);
+                                 return;
+                              end if;
+
+                              No_Choice := No_Choice + 1;
+                              Next (Choice);
+                           end loop;
+                        end if;
+
+                        Next (Comp);
+                     end loop;
+
+                     Sort_Case_Table (Table);
+
+                     for J in 1 .. Num_Choices - 1 loop
+                        Hi_Val := Expr_Value (Table (J).Hi);
+                        Lo_Val := Expr_Value (Table (J + 1).Lo);
+
+                        if Lo_Val = Hi_Val then
+                           Error_Msg_N
+                             ("duplicate index in indexed aggregate",
+                               Table (J + 1).Choice);
+                           exit;
+
+                        elsif Lo_Val < Hi_Val then
+                           Error_Msg_N
+                             ("overlapping indices in indexed aggregate",
+                               Table (J + 1).Choice);
+                           exit;
+
+                        elsif Lo_Val > Hi_Val + 1 then
+                           Error_Msg_N
+                             ("missing index values", Table (J + 1).Choice);
+                           exit;
+                        end if;
+                     end loop;
+                  end;
+               end if;
             end if;
          end;
       end if;



^ permalink raw reply	[flat|nested] 4+ messages in thread

* [Ada] Ongoing work for AI12-0212: container aggregates
@ 2021-05-04  9:52 Pierre-Marie de Rodat
  0 siblings, 0 replies; 4+ messages in thread
From: Pierre-Marie de Rodat @ 2021-05-04  9:52 UTC (permalink / raw)
  To: gcc-patches; +Cc: Ed Schonberg

[-- Attachment #1: Type: text/plain, Size: 775 bytes --]

This patch refines the handling of container aggregates with non-static
sizes given with iterated component associations and iterated element
associations. When necessary we construct an expression to be evaluated
dynamically to guide the allocation of the container, prior to inserting
elements.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* exp_aggr.adb (Build_Siz_Exp): new function, subsidiary of
	Expand_Container_Aggregate, to create an expression to be used
	in the dynamic allocation of a container with a single container
	element association.
	(Add_Range): Handle static bounds of ranges over enumerations.
	(Expand_Container_Aggregate): Add declaration for size
	expression when needed, and use it in container object
	declaration for container.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 14182 bytes --]

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6982,11 +6982,24 @@ package body Exp_Aggr is
       Init_Stat : Node_Id;
       Siz       : Int;
 
+      --  The following are used when the size of the aggregate is not
+      --  static and requires a dynamic evaluation.
+      Siz_Decl   : Node_Id;
+      Siz_Exp    : Node_Id := Empty;
+      Count_Type : Entity_Id;
+
       function Aggregate_Size return Int;
       --  Compute number of entries in aggregate, including choices
-      --  that cover a range, as well as iterated constructs.
+      --  that cover a range or subtype, as well as iterated constructs.
       --  Return -1 if the size is not known statically, in which case
-      --  we allocate a default size for the aggregate.
+      --  allocate a default size for the aggregate, or build an expression
+      --  to estimate the size dynamically.
+
+      function Build_Siz_Exp (Comp : Node_Id) return Int;
+      --  When the aggregate contains a single Iterated_Component_Association
+      --  or Element_Association with non-static bounds, build an expression
+      --  to be used as the allocated size of the container. This may be an
+      --  overestimate if a filter is present, but is a safe approximation.
 
       procedure Expand_Iterated_Component (Comp : Node_Id);
       --  Handle iterated_component_association and iterated_Element
@@ -7005,34 +7018,54 @@ package body Exp_Aggr is
          Siz     : Int := 0;
 
          procedure Add_Range_Size;
-         --  Compute size of component association given by
-         --  range or subtype name.
+         --  Compute number of components specified by a component association
+         --  given by a range or subtype name.
+
+         --------------------
+         -- Add_Range_Size --
+         --------------------
 
          procedure Add_Range_Size is
          begin
+            --  The bounds of the discrete range are integers or enumeration
+            --  literals
+
             if Nkind (Lo) = N_Integer_Literal then
                Siz := Siz + UI_To_Int (Intval (Hi))
-                 - UI_To_Int (Intval (Lo)) + 1;
+                          - UI_To_Int (Intval (Lo)) + 1;
+            else
+               Siz := Siz + UI_To_Int (Enumeration_Pos (Hi))
+                          - UI_To_Int (Enumeration_Pos (Lo)) + 1;
             end if;
          end Add_Range_Size;
 
       begin
+         --  Aggregate is either all positional or all named.
+
          if Present (Expressions (N)) then
             Siz := List_Length (Expressions (N));
          end if;
 
          if Present (Component_Associations (N)) then
             Comp := First (Component_Associations (N));
-
-            --  If the component is an Iterated_Element_Association
-            --  it includes an iterator or a loop parameter, possibly
-            --  with a filter, so we do not attempt to compute its
-            --  size. Room for future optimization ???
-
-            if Nkind (Comp) = N_Iterated_Element_Association then
-               return -1;
+            --  If there is a single component association it can be
+            --  an iterated component with dynamic bounds or an element
+            --  iterator over an iterable object. If it is an array
+            --  we can use the attribute Length to get its size;
+            --  for a predefined container the function Length plays
+            --  the same role. There is no available mechanism for
+            --  user-defined containers. For now we treat all of these
+            --  as dynamic.
+
+            if List_Length (Component_Associations (N)) = 1
+              and then Nkind (Comp) in N_Iterated_Component_Association |
+                                       N_Iterated_Element_Association
+            then
+               return Build_Siz_Exp (Comp);
             end if;
 
+            --  Otherwise all associations must specify static sizes.
+
             while Present (Comp) loop
                Choice := First (Choice_List (Comp));
 
@@ -7042,26 +7075,14 @@ package body Exp_Aggr is
                   if Nkind (Choice) = N_Range then
                      Lo := Low_Bound (Choice);
                      Hi := High_Bound (Choice);
-                     if Nkind (Lo) /= N_Integer_Literal
-                       or else Nkind (Hi) /= N_Integer_Literal
-                     then
-                        return -1;
-                     else
-                        Add_Range_Size;
-                     end if;
+                     Add_Range_Size;
 
                   elsif Is_Entity_Name (Choice)
                     and then Is_Type (Entity (Choice))
                   then
                      Lo := Type_Low_Bound (Entity (Choice));
                      Hi := Type_High_Bound (Entity (Choice));
-                     if Nkind (Lo) /= N_Integer_Literal
-                       or else Nkind (Hi) /= N_Integer_Literal
-                     then
-                        return -1;
-                     else
-                        Add_Range_Size;
-                     end if;
+                     Add_Range_Size;
 
                      Rewrite (Choice,
                        Make_Range (Loc,
@@ -7084,6 +7105,55 @@ package body Exp_Aggr is
          return Siz;
       end Aggregate_Size;
 
+      -------------------
+      -- Build_Siz_Exp --
+      -------------------
+
+      function Build_Siz_Exp (Comp : Node_Id) return Int is
+         Lo, Hi : Node_Id;
+      begin
+         if Nkind (Comp) = N_Range then
+            Lo := Low_Bound (Comp);
+            Hi := High_Bound (Comp);
+            Analyze (Lo);
+            Analyze (Hi);
+
+            --  Compute static size when possible.
+
+            if Is_Static_Expression (Lo)
+              and then Is_Static_Expression (Hi)
+            then
+               if Nkind (Lo) = N_Integer_Literal then
+                  Siz := UI_To_Int (Intval (Hi)) - UI_To_Int (Intval (Lo)) + 1;
+               else
+                  Siz := UI_To_Int (Enumeration_Pos (Hi))
+                       - UI_To_Int (Enumeration_Pos (Lo)) + 1;
+               end if;
+               return Siz;
+
+            else
+               Siz_Exp :=
+                 Make_Op_Add (Sloc (Comp),
+                   Left_Opnd =>
+                     Make_Op_Subtract (Sloc (Comp),
+                       Left_Opnd => New_Copy_Tree (Hi),
+                       Right_Opnd => New_Copy_Tree (Lo)),
+                   Right_Opnd =>
+                     Make_Integer_Literal (Loc, 1));
+               return -1;
+            end if;
+
+         elsif Nkind (Comp) = N_Iterated_Component_Association then
+            return Build_Siz_Exp (First (Discrete_Choices (Comp)));
+
+         elsif Nkind (Comp) = N_Iterated_Element_Association then
+            return -1;    --  TBD, build expression for size of the domain
+
+         else
+            return -1;
+         end if;
+      end Build_Siz_Exp;
+
       -------------------------------
       -- Expand_Iterated_Component --
       -------------------------------
@@ -7171,7 +7241,9 @@ package body Exp_Aggr is
          --  parameter. Otherwise the key is given by the loop parameter
          --  itself.
 
-         if Present (Add_Unnamed_Subp) then
+         if Present (Add_Unnamed_Subp)
+           and then No (Add_Named_Subp)
+         then
             Stats := New_List
               (Make_Procedure_Call_Statement (Loc,
                  Name => New_Occurrence_Of (Entity (Add_Unnamed_Subp), Loc),
@@ -7216,38 +7288,80 @@ package body Exp_Aggr is
 
       --  The constructor for bounded containers is a function with
       --  a parameter that sets the size of the container. If the
-      --  size cannot be determined statically we use a default value.
+      --  size cannot be determined statically we use a default value
+      --  or a dynamic expression.
 
       Siz := Aggregate_Size;
-      if Siz < 0 then
-         Siz := 10;
-      end if;
 
       if Ekind (Entity (Empty_Subp)) = E_Function
         and then Present (First_Formal (Entity (Empty_Subp)))
       then
          Default := Default_Value (First_Formal (Entity (Empty_Subp)));
-         --  If aggregate size is not static, use default value of
-         --  formal parameter for allocation. We assume that this
+
+         --  If aggregate size is not static, we can use default value
+         --  of formal parameter for allocation. We assume that this
          --  (implementation-dependent) value is static, even though
-         --   the AI does not require it ???.
+         --   the AI does not require it.
 
-         if Siz < 0 then
-            Siz := UI_To_Int (Intval (Default));
-         end if;
+         --  Create declaration for size: a constant literal in the simple
+         --  case, an expression if iterated component associations may be
+         --  involved, the default otherwise.
 
-         Init_Stat :=
-           Make_Object_Declaration (Loc,
-             Defining_Identifier => Temp,
-             Object_Definition   => New_Occurrence_Of (Typ, Loc),
-             Expression => Make_Function_Call (Loc,
-               Name => New_Occurrence_Of (Entity (Empty_Subp), Loc),
-               Parameter_Associations =>
-                 New_List (Make_Integer_Literal (Loc, Siz))));
+         Count_Type := Etype (First_Formal (Entity (Empty_Subp)));
+         if Siz = -1 then
+            if No (Siz_Exp) then
+               Siz := UI_To_Int (Intval (Default));
+               Siz_Exp := Make_Integer_Literal (Loc, Siz);
+
+            else
+               Siz_Exp := Make_Type_Conversion (Loc,
+                  Subtype_Mark =>
+                    New_Occurrence_Of (Count_Type, Loc),
+                  Expression => Siz_Exp);
+            end if;
+
+         else
+            Siz_Exp := Make_Integer_Literal (Loc, Siz);
+         end if;
+
+         Siz_Decl := Make_Object_Declaration (Loc,
+            Defining_Identifier => Make_Temporary (Loc, 'S', N),
+            Object_Definition =>
+               New_Occurrence_Of (Count_Type, Loc),
+               Expression => Siz_Exp);
+         Append (Siz_Decl, Aggr_Code);
+
+         if Nkind (Siz_Exp) = N_Integer_Literal then
+            Init_Stat :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Temp,
+                Object_Definition   => New_Occurrence_Of (Typ, Loc),
+                Expression => Make_Function_Call (Loc,
+                  Name => New_Occurrence_Of (Entity (Empty_Subp), Loc),
+                  Parameter_Associations =>
+                    New_List
+                      (New_Occurrence_Of
+                        (Defining_Identifier (Siz_Decl), Loc))));
+
+         else
+            Init_Stat :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Temp,
+                Object_Definition   => New_Occurrence_Of (Typ, Loc),
+                Expression => Make_Function_Call (Loc,
+                  Name =>
+                    New_Occurrence_Of (Entity (New_Indexed_Subp), Loc),
+                  Parameter_Associations =>
+                    New_List (
+                      Make_Integer_Literal (Loc, 1),
+                      New_Occurrence_Of
+                        (Defining_Identifier (Siz_Decl), Loc))));
+         end if;
 
          Append (Init_Stat, Aggr_Code);
 
-         --  Use default value when aggregate size is not static.
+         --  Size is dynamic: Create declaration for object, and intitialize
+         --  with a call to the null container, or an assignment to it.
 
       else
          Decl :=
@@ -7256,11 +7370,16 @@ package body Exp_Aggr is
              Object_Definition   => New_Occurrence_Of (Typ, Loc));
 
          Insert_Action (N, Decl);
+
+         --  The Empty entity is either a parameterless function, or
+         --  a constant.
+
          if Ekind (Entity (Empty_Subp)) = E_Function then
             Init_Stat := Make_Assignment_Statement (Loc,
               Name => New_Occurrence_Of (Temp, Loc),
               Expression => Make_Function_Call (Loc,
                 Name => New_Occurrence_Of (Entity (Empty_Subp), Loc)));
+
          else
             Init_Stat := Make_Assignment_Statement (Loc,
               Name => New_Occurrence_Of (Temp, Loc),
@@ -7277,9 +7396,7 @@ package body Exp_Aggr is
       --  If the aggregate is positional the aspect must include
       --  an Add_Unnamed subprogram.
 
-      if Present (Add_Unnamed_Subp)
-        and then No (Component_Associations (N))
-      then
+      if Present (Add_Unnamed_Subp) then
          if Present (Expressions (N)) then
             declare
                Insert : constant Entity_Id := Entity (Add_Unnamed_Subp);
@@ -7300,13 +7417,18 @@ package body Exp_Aggr is
             end;
          end if;
 
-         --  Iterated component associations may also be present.
+         --  Indexed aggregates are handled below. Unnamed aggregates
+         --  such as sets may include iterated component associations.
 
-         Comp := First (Component_Associations (N));
-         while Present (Comp) loop
-            Expand_Iterated_Component (Comp);
-            Next (Comp);
-         end loop;
+         if No (New_Indexed_Subp) then
+            Comp := First (Component_Associations (N));
+            while Present (Comp) loop
+               if Nkind (Comp) = N_Iterated_Component_Association then
+                  Expand_Iterated_Component (Comp);
+               end if;
+               Next (Comp);
+            end loop;
+         end if;
 
       ---------------------
       -- Named_Aggregate --
@@ -7357,6 +7479,8 @@ package body Exp_Aggr is
       --  subprogram. Note that unlike array aggregates, a container
       --  aggregate must be fully positional or fully indexed. In the
       --  first case the expansion has already taken place.
+      --  TBA: the keys for an indexed aggregate must provide a dense
+      --  range with no repetitions.
 
       if Present (Assign_Indexed_Subp)
         and then Present (Component_Associations (N))



^ permalink raw reply	[flat|nested] 4+ messages in thread

* [Ada] Ongoing work for AI12-0212 : container aggregates
@ 2020-07-16  9:20 Pierre-Marie de Rodat
  0 siblings, 0 replies; 4+ messages in thread
From: Pierre-Marie de Rodat @ 2020-07-16  9:20 UTC (permalink / raw)
  To: gcc-patches; +Cc: Ed Schonberg

[-- Attachment #1: Type: text/plain, Size: 1029 bytes --]

This patch adds support for indexed aggregates with both positional
components and component associations that include multiple choices and
range specifications. For indexed aggregates the expansion uses a
separate pass, as suggested in AI12-0212, to compute the size of the
resulting object and preallocate that size before expanding the
aggregate into individual indexed assignments.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* sem_aggr.adb (Resolve_Container_Aggregate): Add semantic
	checks for indexed aggregates, including component associations
	and iterated component associations.
	* exp_aggr.adb (Expand_Iterated_Component): New subprogram,
	subsidiary of Expand_Container_Aggreggate, used for positional,
	named, and indexed aggregates.
	(Aggregate_Size): New subprogram to precompute the size of an
	indexed aggregate prior to call to allocate it.
	(Expand_Range_Component): New subprogram so generate loop for a
	component association given by a range or a subtype name in an
	indexed aggregate.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 14354 bytes --]

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6878,8 +6878,6 @@ package body Exp_Aggr is
       New_Indexed_Subp    : Node_Id := Empty;
       Assign_Indexed_Subp : Node_Id := Empty;
 
-      procedure Expand_Iterated_Component (Comp : Node_Id);
-
       Aggr_Code : constant List_Id   := New_List;
       Temp      : constant Entity_Id := Make_Temporary (Loc, 'C', N);
 
@@ -6887,6 +6885,12 @@ package body Exp_Aggr is
       Decl      : Node_Id;
       Init_Stat : Node_Id;
 
+      procedure Expand_Iterated_Component (Comp : Node_Id);
+      --  Handle iterated_component_association and iterated_Element
+      --  association by generating a loop over the specified range,
+      --  given either by a loop parameter specification or an iterator
+      --  specification.
+
       -------------------------------
       -- Expand_Iterated_Component --
       -------------------------------
@@ -6946,6 +6950,7 @@ package body Exp_Aggr is
                           Iteration_Scheme => L_Iteration_Scheme,
                           Statements       => Stats);
          Append (Loop_Stat, Aggr_Code);
+
       end Expand_Iterated_Component;
 
    begin
@@ -6968,11 +6973,16 @@ package body Exp_Aggr is
            Name => New_Occurrence_Of (Temp, Loc),
            Expression => New_Occurrence_Of (Entity (Empty_Subp), Loc));
       end if;
+
       Append (Init_Stat, Aggr_Code);
 
-      --  First case: positional aggregate
+      ---------------------------
+      --  Positional aggregate --
+      ---------------------------
 
-      if Present (Add_Unnamed_Subp) then
+      if Present (Add_Unnamed_Subp)
+        and then No (Assign_Indexed_Subp)
+      then
          if Present (Expressions (N)) then
             declare
                Insert : constant Entity_Id := Entity (Add_Unnamed_Subp);
@@ -6993,7 +7003,7 @@ package body Exp_Aggr is
             end;
          end if;
 
-         --  iterated component associations may be present.
+         --  Iterated component associations may also be present.
 
          Comp := First (Component_Associations (N));
          while Present (Comp) loop
@@ -7001,6 +7011,10 @@ package body Exp_Aggr is
             Next (Comp);
          end loop;
 
+      ---------------------
+      -- Named_Aggregate --
+      ---------------------
+
       elsif Present (Add_Named_Subp) then
          declare
             Insert : constant Entity_Id := Entity (Add_Named_Subp);
@@ -7034,6 +7048,235 @@ package body Exp_Aggr is
                Next (Comp);
             end loop;
          end;
+
+      -----------------------
+      -- Indexed_Aggregate --
+      -----------------------
+
+      elsif Present (Assign_Indexed_Subp) then
+         declare
+            Insert : constant Entity_Id := Entity (Assign_Indexed_Subp);
+            Index_Type : constant Entity_Id :=
+               Etype (Next_Formal (First_Formal (Insert)));
+
+            function Aggregate_Size return Int;
+            --  Compute number of entries in aggregate, including choices
+            --  that cover a range, as well as iterated constructs.
+
+            function  Expand_Range_Component
+              (Rng  : Node_Id;
+               Expr : Node_Id) return Node_Id;
+            --  Transform a component assoication with a range into an
+            --  explicit loop. If the choice is a subtype name, it is
+            --  rewritten as a range with the corresponding bounds, which
+            --  are known to be static.
+
+            Comp   : Node_Id;
+            Index  : Node_Id;
+            Pos    : Int := 0;
+            Stat   : Node_Id;
+            Key    : Node_Id;
+            Size   : Int := 0;
+
+            -----------------------------
+            -- Expand_Raange_Component --
+            -----------------------------
+
+            function Expand_Range_Component
+              (Rng  : Node_Id;
+               Expr : Node_Id) return Node_Id
+            is
+               Loop_Id : constant Entity_Id :=
+                 Make_Temporary (Loc, 'T');
+
+               L_Iteration_Scheme : Node_Id;
+               Stats              : List_Id;
+
+            begin
+               L_Iteration_Scheme :=
+                 Make_Iteration_Scheme (Loc,
+                   Loop_Parameter_Specification =>
+                     Make_Loop_Parameter_Specification (Loc,
+                       Defining_Identifier => Loop_Id,
+                       Discrete_Subtype_Definition => New_Copy_Tree (Rng)));
+
+               Stats := New_List
+                 (Make_Procedure_Call_Statement (Loc,
+                    Name =>
+                      New_Occurrence_Of (Entity (Assign_Indexed_Subp), Loc),
+                    Parameter_Associations =>
+                      New_List (New_Occurrence_Of (Temp, Loc),
+                        New_Occurrence_Of (Loop_Id, Loc),
+                        New_Copy_Tree (Expr))));
+
+               return  Make_Implicit_Loop_Statement
+                         (Node             => N,
+                          Identifier       => Empty,
+                          Iteration_Scheme => L_Iteration_Scheme,
+                          Statements       => Stats);
+            end Expand_Range_Component;
+
+            --------------------
+            -- Aggregate_Size --
+            --------------------
+
+            function Aggregate_Size return Int is
+               Comp   : Node_Id;
+               Choice : Node_Id;
+               Lo, Hi : Node_Id;
+               Siz     : Int := 0;
+
+               procedure Add_Range_Size;
+               --  Compute size of component association given by
+               --  range or subtype name.
+
+               procedure Add_Range_Size is
+               begin
+                  if Nkind (Lo) = N_Integer_Literal then
+                     Siz := Siz + UI_To_Int (Intval (Hi))
+                       - UI_To_Int (Intval (Lo)) + 1;
+                  end if;
+               end Add_Range_Size;
+
+            begin
+               if Present (Expressions (N)) then
+                  Siz := List_Length (Expressions (N));
+               end if;
+
+               if Present (Component_Associations (N)) then
+                  Comp := First (Component_Associations (N));
+                  while Present (Comp) loop
+                     Choice := First (Choices (Comp));
+
+                     while Present (Choice) loop
+                        Analyze (Choice);
+
+                        if Nkind (Choice) = N_Range then
+                           Lo := Low_Bound (Choice);
+                           Hi := High_Bound (Choice);
+                           Add_Range_Size;
+
+                        elsif Is_Entity_Name (Choice)
+                          and then Is_Type (Entity (Choice))
+                        then
+                           Lo := Type_Low_Bound (Entity (Choice));
+                           Hi := Type_High_Bound (Entity (Choice));
+                           Add_Range_Size;
+                           Rewrite (Choice,
+                             Make_Range (Loc,
+                               New_Copy_Tree (Lo),
+                               New_Copy_Tree (Hi)));
+
+                        else
+                           Resolve (Choice, Index_Type);
+                           Siz := Siz + 1;
+                        end if;
+
+                        Next (Choice);
+                     end loop;
+                     Next (Comp);
+                  end loop;
+               end if;
+
+               return Siz;
+            end Aggregate_Size;
+
+         begin
+            Size := Aggregate_Size;
+            if Size > 0 then
+
+               --  Modify the call to the constructor to allocate the
+               --  required size for the aggregwte : call the provided
+               --  constructor rather than the Empty aggregate.
+
+               Index :=  Make_Op_Add (Loc,
+                 Left_Opnd => New_Copy_Tree (Type_Low_Bound (Index_Type)),
+                 Right_Opnd => Make_Integer_Literal (Loc, Size - 1));
+
+               Set_Expression (Init_Stat,
+                  Make_Function_Call (Loc,
+                    Name =>
+                      New_Occurrence_Of (Entity (New_Indexed_Subp), Loc),
+                    Parameter_Associations =>
+                      New_List (
+                         New_Copy_Tree (Type_Low_Bound (Index_Type)),
+                         Index)));
+            end if;
+
+            if Present (Expressions (N)) then
+               Comp := First (Expressions (N));
+
+               while Present (Comp) loop
+
+                  --  Compute index position for successive components
+                  --  in the list of expressions, and use the indexed
+                  --  assignment procedure for each.
+
+                  Index := Make_Op_Add (Loc,
+                    Left_Opnd => Type_Low_Bound (Index_Type),
+                    Right_Opnd => Make_Integer_Literal (Loc, Pos));
+
+                  Stat := Make_Procedure_Call_Statement (Loc,
+                    Name => New_Occurrence_Of (Insert, Loc),
+                    Parameter_Associations =>
+                      New_List (New_Occurrence_Of (Temp, Loc),
+                      Index,
+                      New_Copy_Tree (Comp)));
+
+                  Pos := Pos + 1;
+
+                  Append (Stat, Aggr_Code);
+                  Next (Comp);
+               end loop;
+            end if;
+
+            if Present (Component_Associations (N)) then
+               Comp := First (Component_Associations (N));
+
+               --  The choice may be a static value, or a range with
+               --  static bounds.
+
+               while Present (Comp) loop
+                  if Nkind (Comp) = N_Component_Association then
+                     Key := First (Choices (Comp));
+                     while Present (Key) loop
+
+                        --  If the expression is a box, the corresponding
+                        --  component (s) is left uninitialized.
+
+                        if Box_Present (Comp) then
+                           goto Next_Key;
+
+                        elsif Nkind (Key) = N_Range then
+
+                           --  Create loop for tne specified range,
+                           --  with copies of the expression.
+
+                           Stat :=
+                             Expand_Range_Component (Key, Expression (Comp));
+
+                        else
+                           Stat := Make_Procedure_Call_Statement (Loc,
+                             Name => New_Occurrence_Of
+                                (Entity (Assign_Indexed_Subp), Loc),
+                                Parameter_Associations =>
+                                  New_List (New_Occurrence_Of (Temp, Loc),
+                                  New_Copy_Tree (Key),
+                                  New_Copy_Tree (Expression (Comp))));
+                        end if;
+
+                        Append (Stat, Aggr_Code);
+
+                        <<Next_Key>>
+                        Next (Key);
+                     end loop;
+                  else
+                     Error_Msg_N ("iterated associations peding", N);
+                  end if;
+                  Next (Comp);
+               end loop;
+            end if;
+         end;
       end if;
 
       Insert_Actions (N, Aggr_Code);


diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2760,7 +2760,9 @@ package body Sem_Aggr is
         Empty_Subp, Add_Named_Subp, Add_Unnamed_Subp,
         New_Indexed_Subp, Assign_Indexed_Subp);
 
-      if Present (Add_Unnamed_Subp) then
+      if Present (Add_Unnamed_Subp)
+        and then No (New_Indexed_Subp)
+      then
          declare
             Elmt_Type : constant Entity_Id :=
               Etype (Next_Formal
@@ -2824,6 +2826,10 @@ package body Sem_Aggr is
 
                   while Present (Choice) loop
                      Analyze_And_Resolve (Choice, Key_Type);
+                     if not Is_Static_Expression (Choice) then
+                        Error_Msg_N ("Choice must be static", Choice);
+                     end if;
+
                      Next (Choice);
                   end loop;
 
@@ -2837,8 +2843,53 @@ package body Sem_Aggr is
                Next (Comp);
             end loop;
          end;
+
       else
-         Error_Msg_N ("indexed aggregates are forthcoming", N);
+         --  Indexed Aggregate. Both positional and indexed component
+         --  can be present. Choices must be static values or ranges
+         --  with static bounds.
+
+         declare
+            Container : constant Entity_Id :=
+              First_Formal (Entity (Assign_Indexed_Subp));
+            Index_Type : constant Entity_Id := Etype (Next_Formal (Container));
+            Comp_Type  : constant Entity_Id :=
+                                 Etype (Next_Formal (Next_Formal (Container)));
+            Comp   : Node_Id;
+            Choice : Node_Id;
+
+         begin
+            if Present (Expressions (N)) then
+               Comp := First (Expressions (N));
+               while Present (Comp) loop
+                  Analyze_And_Resolve (Comp, Comp_Type);
+                  Next (Comp);
+               end loop;
+            end if;
+
+            if Present (Component_Associations (N)) then
+               Comp := First (Expressions (N));
+
+               while Present (Comp) loop
+                  if Nkind (Comp) = N_Component_Association then
+                     Choice := First (Choices (Comp));
+
+                     while Present (Choice) loop
+                        Analyze_And_Resolve (Choice, Index_Type);
+                        Next (Choice);
+                     end loop;
+
+                     Analyze_And_Resolve (Expression (Comp), Comp_Type);
+
+                  elsif Nkind (Comp) = N_Iterated_Component_Association then
+                     Resolve_Iterated_Component_Association
+                       (Comp, Index_Type, Comp_Type);
+                  end if;
+
+                  Next (Comp);
+               end loop;
+            end if;
+         end;
       end if;
    end Resolve_Container_Aggregate;
 



^ permalink raw reply	[flat|nested] 4+ messages in thread

* [Ada] Ongoing work for AI12-0212: container aggregates
@ 2020-07-15 13:45 Pierre-Marie de Rodat
  0 siblings, 0 replies; 4+ messages in thread
From: Pierre-Marie de Rodat @ 2020-07-15 13:45 UTC (permalink / raw)
  To: gcc-patches; +Cc: Arnaud Charlet

[-- Attachment #1: Type: text/plain, Size: 1450 bytes --]

This patch modifies the parser to recognize
iterated_element_associations, which may include a key_exprewsion to be
used in a named aggregate such as a map. The new syntactic node
N_Iterated_Element_Association is recognized throughout the compiler.
The patch also extends the analysis and expansion of positional and
named aggregates that include iterated_element_associations, (for now
without key_expressions).

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* par-ch4.adb (P_Iterated_Component_Association): Extended to
	recognzize the similar Iterated_Element_Association. This node
	is only generated when an explicit Key_Expression is given.
	Otherwise the distinction between the two iterated forms is done
	during semantic analysis.
	* sinfo.ads: New node N_Iterated_Element_Association, for
	Ada202x container aggregates.  New field Key_Expression.
	* sinfo.adb: Subprograms for new node and newn field.
	* sem_aggr.adb (Resolve_Iterated_Component_Association): Handle
	the case where the Iteration_Scheme is an
	Iterator_Specification.
	* exp_aggr.adb (Wxpand_Iterated_Component): Handle a component
	with an Iterated_Component_Association, generate proper loop
	using given Iterator_Specification.
	* exp_util.adb (Insert_Axtions): Handle new node as other
	aggregate components.
	* sem.adb, sprint.adb: Handle new node.
	* tbuild.adb (Make_Implicit_Loop_Statement): Handle properly a
	loop with an Iterator_ specification.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 15753 bytes --]

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6914,13 +6914,20 @@ package body Exp_Aggr is
          Stats              : List_Id;
 
       begin
-         L_Range := Relocate_Node (First (Discrete_Choices (Comp)));
-         L_Iteration_Scheme :=
-           Make_Iteration_Scheme (Loc,
-             Loop_Parameter_Specification =>
-               Make_Loop_Parameter_Specification (Loc,
-                 Defining_Identifier => Loop_Id,
-                 Discrete_Subtype_Definition => L_Range));
+         if Present (Iterator_Specification (Comp)) then
+            L_Iteration_Scheme :=
+              Make_Iteration_Scheme (Loc,
+                Iterator_Specification => Iterator_Specification (Comp));
+
+         else
+            L_Range := Relocate_Node (First (Discrete_Choices (Comp)));
+            L_Iteration_Scheme :=
+              Make_Iteration_Scheme (Loc,
+                Loop_Parameter_Specification =>
+                  Make_Loop_Parameter_Specification (Loc,
+                    Defining_Identifier => Loop_Id,
+                    Discrete_Subtype_Definition => L_Range));
+         end if;
 
          --  Build insertion statement. For a positional aggregate, only the
          --  expression is needed. For a named aggregate, the loop variable,


diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -7346,6 +7346,7 @@ package body Exp_Util is
 
             when N_Component_Association
                | N_Iterated_Component_Association
+               | N_Iterated_Element_Association
             =>
                if Nkind (Parent (P)) = N_Aggregate
                  and then Present (Loop_Actions (P))


diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -3407,6 +3407,8 @@ package body Ch4 is
    function P_Iterated_Component_Association return Node_Id is
       Assoc_Node : Node_Id;
       Id         : Node_Id;
+      Iter_Spec  : Node_Id;
+      Loop_Spec  : Node_Id;
       State      : Saved_Scan_State;
 
    --  Start of processing for P_Iterated_Component_Association
@@ -3423,6 +3425,9 @@ package body Ch4 is
       --  if E is a subtype indication this is a loop parameter spec,
       --  while if E a name it is an iterator_specification, and the
       --  disambiguation takes place during semantic analysis.
+      --  In addition, if "use" is present after the specification,
+      --  this is an Iterated_Element_Association that carries a
+      --  key_expression, and we generate the appropriate node.
 
       Id := P_Defining_Identifier;
       Assoc_Node :=
@@ -3432,6 +3437,22 @@ package body Ch4 is
          Set_Defining_Identifier (Assoc_Node, Id);
          T_In;
          Set_Discrete_Choices (Assoc_Node, P_Discrete_Choice_List);
+
+         if Token = Tok_Use then
+
+            --  Key-expression is present, rewrite node as an
+            --  iterated_Element_Awwoiation.
+
+            Scan;  --  past USE
+            Loop_Spec :=
+              New_Node (N_Loop_Parameter_Specification, Prev_Token_Ptr);
+            Set_Defining_Identifier (Loop_Spec, Id);
+            Set_Discrete_Subtype_Definition (Loop_Spec,
+               First (Discrete_Choices (Assoc_Node)));
+            Set_Loop_Parameter_Specification (Assoc_Node, Loop_Spec);
+            Set_Key_Expression (Assoc_Node, P_Expression);
+         end if;
+
          TF_Arrow;
          Set_Expression (Assoc_Node, P_Expression);
 
@@ -3441,8 +3462,19 @@ package body Ch4 is
          Restore_Scan_State (State);
          Scan;  -- past OF
          Set_Defining_Identifier (Assoc_Node, Id);
-         Set_Iterator_Specification
-           (Assoc_Node, P_Iterator_Specification (Id));
+         Iter_Spec := P_Iterator_Specification (Id);
+         Set_Iterator_Specification (Assoc_Node, Iter_Spec);
+
+         if Token = Tok_Use then
+            Scan;  -- past USE
+            --  This is an iterated_elenent_qssociation.
+
+            Assoc_Node :=
+              New_Node (N_Iterated_Element_Association, Prev_Token_Ptr);
+            Set_Iterator_Specification (Assoc_Node, Iter_Spec);
+            Set_Key_Expression (Assoc_Node, P_Expression);
+         end if;
+
          TF_Arrow;
          Set_Expression (Assoc_Node, P_Expression);
       end if;


diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -670,6 +670,9 @@ package body Sem is
          when N_Iterated_Component_Association =>
             Diagnose_Iterated_Component_Association (N);
 
+         when N_Iterated_Element_Association =>
+            null;   --  May require a more precise error if misplaced.
+
          --  For the remaining node types, we generate compiler abort, because
          --  these nodes are always analyzed within the Sem_Chn routines and
          --  there should never be a case of making a call to the main Analyze


diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2677,36 +2677,39 @@ package body Sem_Aggr is
          Ent    : Entity_Id;
          Expr   : Node_Id;
          Id     : Entity_Id;
+         Iter   : Node_Id;
          Typ    : Entity_Id := Empty;
 
       begin
          if Present (Iterator_Specification (Comp)) then
-            Error_Msg_N ("element iterator ins aggregate Forthcoming", N);
-            return;
-         end if;
+            Iter := Copy_Separate_Tree (Iterator_Specification (Comp));
+            Analyze (Iter);
+            Typ := Etype (Defining_Identifier (Iter));
 
-         Choice := First (Discrete_Choices (Comp));
+         else
+            Choice := First (Discrete_Choices (Comp));
 
-         while Present (Choice) loop
-            Analyze (Choice);
+            while Present (Choice) loop
+               Analyze (Choice);
 
-            --  Choice can be a subtype name, a range, or an expression
+               --  Choice can be a subtype name, a range, or an expression
 
-            if Is_Entity_Name (Choice)
-              and then Is_Type (Entity (Choice))
-              and then Base_Type (Entity (Choice)) = Base_Type (Key_Type)
-            then
-               null;
+               if Is_Entity_Name (Choice)
+                 and then Is_Type (Entity (Choice))
+                 and then Base_Type (Entity (Choice)) = Base_Type (Key_Type)
+               then
+                  null;
 
-            elsif Present (Key_Type) then
-               Analyze_And_Resolve (Choice, Key_Type);
+               elsif Present (Key_Type) then
+                  Analyze_And_Resolve (Choice, Key_Type);
 
-            else
-               Typ := Etype (Choice);  --  assume unique for now
-            end if;
+               else
+                  Typ := Etype (Choice);  --  assume unique for now
+               end if;
 
-            Next (Choice);
-         end loop;
+               Next (Choice);
+            end loop;
+         end if;
 
          --  Create a scope in which to introduce an index, which is usually
          --  visible in the expression for the component, and needed for its


diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -1278,6 +1278,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Expression_With_Actions
         or else NT (N).Nkind = N_Free_Statement
         or else NT (N).Nkind = N_Iterated_Component_Association
+        or else NT (N).Nkind = N_Iterated_Element_Association
         or else NT (N).Nkind = N_Mod_Clause
         or else NT (N).Nkind = N_Modular_Type_Definition
         or else NT (N).Nkind = N_Number_Declaration
@@ -2245,6 +2246,7 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Iterated_Component_Association
+        or else NT (N).Nkind = N_Iterated_Element_Association
         or else NT (N).Nkind = N_Iteration_Scheme
         or else NT (N).Nkind = N_Quantified_Expression);
       return Node2 (N);
@@ -2258,6 +2260,14 @@ package body Sinfo is
       return Node1 (N);
    end Itype;
 
+   function Key_Expression
+      (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+      or else NT (N).Nkind = N_Iterated_Element_Association);
+      return Node1 (N);
+   end Key_Expression;
+
    function Kill_Range_Check
       (N : Node_Id) return Boolean is
    begin
@@ -2367,7 +2377,8 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Component_Association
-        or else NT (N).Nkind = N_Iterated_Component_Association);
+        or else NT (N).Nkind = N_Iterated_Component_Association
+        or else NT (N).Nkind = N_Iterated_Element_Association);
       return List5 (N);
    end Loop_Actions;
 
@@ -2375,6 +2386,7 @@ package body Sinfo is
       (N : Node_Id) return Node_Id is
    begin
       pragma Assert (False
+        or else NT (N).Nkind = N_Iterated_Element_Association
         or else NT (N).Nkind = N_Iteration_Scheme
         or else NT (N).Nkind = N_Quantified_Expression);
       return Node4 (N);
@@ -4762,6 +4774,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Expression_With_Actions
         or else NT (N).Nkind = N_Free_Statement
         or else NT (N).Nkind = N_Iterated_Component_Association
+        or else NT (N).Nkind = N_Iterated_Element_Association
         or else NT (N).Nkind = N_Mod_Clause
         or else NT (N).Nkind = N_Modular_Type_Definition
         or else NT (N).Nkind = N_Number_Declaration
@@ -5733,6 +5746,7 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Iterated_Component_Association
+        or else NT (N).Nkind = N_Iterated_Element_Association
         or else NT (N).Nkind = N_Iteration_Scheme
         or else NT (N).Nkind = N_Quantified_Expression);
       Set_Node2_With_Parent (N, Val);
@@ -5746,6 +5760,14 @@ package body Sinfo is
       Set_Node1 (N, Val); -- no parent, semantic field
    end Set_Itype;
 
+   procedure Set_Key_Expression
+      (N : Node_Id; Val : Entity_Id) is
+   begin
+      pragma Assert (False
+      or else NT (N).Nkind = N_Iterated_Element_Association);
+      Set_Node1_With_Parent (N, Val);
+   end Set_Key_Expression;
+
    procedure Set_Kill_Range_Check
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -5855,7 +5877,8 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Component_Association
-        or else NT (N).Nkind = N_Iterated_Component_Association);
+        or else NT (N).Nkind = N_Iterated_Component_Association
+        or else NT (N).Nkind = N_Iterated_Element_Association);
       Set_List5 (N, Val); -- semantic field, no parent set
    end Set_Loop_Actions;
 
@@ -5863,6 +5886,7 @@ package body Sinfo is
       (N : Node_Id; Val : Node_Id) is
    begin
       pragma Assert (False
+        or else NT (N).Nkind = N_Iterated_Element_Association
         or else NT (N).Nkind = N_Iteration_Scheme
         or else NT (N).Nkind = N_Quantified_Expression);
       Set_Node4_With_Parent (N, Val);


diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -4241,6 +4241,26 @@ package Sinfo is
       --  Component_Associations (List2)
       --  Etype (Node5-Sem)
 
+      ---------------------------------
+      --  3.4.5 Comtainer_Aggregates --
+      ---------------------------------
+
+      --  N_Iterated_Element_Association
+      --  Key_Expression (Node1)
+      --  Iterator_Specification (Node2)
+      --  Expression (Node3)
+      --  Loop_Parameter_Specification (Node4)
+      --  Loop_Actions (List5-Sem)
+
+      --  Exactly one of Iterator_Specification or Loop_Parameter_
+      --  specification is present. If the Key_Expression is absent,
+      --  the construct is parsed as an Iterated_Component_Association,
+      --  and legality checks are performed during semantic analysis.
+
+      --  Both iterated associations are Ada2020 features that are
+      --  expanded during aggregate construction, and do not appear in
+      --  expanded code.
+
       --------------------------------------------------
       -- 4.4  Expression/Relation/Term/Factor/Primary --
       --------------------------------------------------
@@ -8917,6 +8937,7 @@ package Sinfo is
       N_Handled_Sequence_Of_Statements,
       N_Index_Or_Discriminant_Constraint,
       N_Iterated_Component_Association,
+      N_Iterated_Element_Association,
       N_Itype_Reference,
       N_Label,
       N_Modular_Type_Definition,
@@ -9842,6 +9863,9 @@ package Sinfo is
    function Itype
      (N : Node_Id) return Entity_Id;  -- Node1
 
+   function Key_Expression
+     (N : Node_Id) return Node_Id;    -- Node1
+
    function Kill_Range_Check
      (N : Node_Id) return Boolean;    -- Flag11
 
@@ -10951,6 +10975,9 @@ package Sinfo is
    procedure Set_Itype
      (N : Node_Id; Val : Entity_Id);          -- Node1
 
+   procedure Set_Key_Expression
+     (N : Node_Id; Val : Node_Id);            -- Node1
+
    procedure Set_Kill_Range_Check
      (N : Node_Id; Val : Boolean := True);    -- Flag11
 
@@ -11901,6 +11928,13 @@ package Sinfo is
         4 => True,    --  Discrete_Choices (List4)
         5 => True),   --  Loop_Actions (List5-Sem);
 
+     N_Iterated_Element_Association =>
+       (1 => True,    --  Key_expression
+        2 => True,    --  Iterator_Specification
+        3 => True,    --  Expression (Node3)
+        4 => True,    --  Loop_Parameter_Specification
+        5 => True),   --  Loop_Actions (List5-Sem);
+
      N_Delta_Aggregate =>
        (1 => False,   --  Unused
         2 => True,    --  Component_Associations (List2)
@@ -13446,6 +13480,7 @@ package Sinfo is
    pragma Inline (Iterator_Filter);
    pragma Inline (Iteration_Scheme);
    pragma Inline (Itype);
+   pragma Inline (Key_Expression);
    pragma Inline (Kill_Range_Check);
    pragma Inline (Last_Bit);
    pragma Inline (Last_Name);
@@ -13812,6 +13847,7 @@ package Sinfo is
    pragma Inline (Set_Iteration_Scheme);
    pragma Inline (Set_Iterator_Specification);
    pragma Inline (Set_Itype);
+   pragma Inline (Set_Key_Expression);
    pragma Inline (Set_Kill_Range_Check);
    pragma Inline (Set_Label_Construct);
    pragma Inline (Set_Last_Bit);


diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -1325,6 +1325,22 @@ package body Sprint is
             Write_Str (" => ");
             Sprint_Node (Expression (Node));
 
+         when N_Iterated_Element_Association =>
+            Set_Debug_Sloc;
+            if Present (Iterator_Specification (Node)) then
+               Sprint_Node (Iterator_Specification (Node));
+            else
+               Sprint_Node (Loop_Parameter_Specification (Node));
+            end if;
+
+            if Present (Key_Expression (Node)) then
+               Write_Str (" use ");
+               Sprint_Node (Key_Expression (Node));
+            end if;
+
+            Write_Str (" => ");
+            Sprint_Node (Expression (Node));
+
          when N_Component_Clause =>
             Write_Indent;
             Sprint_Node (Component_Name (Node));


diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb
--- a/gcc/ada/tbuild.adb
+++ b/gcc/ada/tbuild.adb
@@ -352,6 +352,7 @@ package body Tbuild is
       Check_Restriction (No_Implicit_Loops, Node);
 
       if Present (Iteration_Scheme)
+        and then Nkind (Iteration_Scheme) /= N_Iterator_Specification
         and then Present (Condition (Iteration_Scheme))
       then
          Check_Restriction (No_Implicit_Conditionals, Node);



^ permalink raw reply	[flat|nested] 4+ messages in thread

end of thread, other threads:[~2021-05-05  8:20 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-05-05  8:20 [Ada] Ongoing work for AI12-0212: container aggregates Pierre-Marie de Rodat
  -- strict thread matches above, loose matches on Subject: below --
2021-05-04  9:52 Pierre-Marie de Rodat
2020-07-16  9:20 [Ada] Ongoing work for AI12-0212 : " Pierre-Marie de Rodat
2020-07-15 13:45 [Ada] Ongoing work for AI12-0212: " Pierre-Marie de Rodat

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).