[Ada] Ongoing work for AI12-0212: container aggregates

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.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 6d58c8c..6d89191 100644 (file)
--- 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
index 27609c7..0bbab9c 100644 (file)
--- 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
index 4e48a49..2c74cd7 100644 (file)
--- 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
index 425dafa..5474e08 100644 (file)
--- 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
index d2419d9..a89d55a 100644 (file)
--- 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
index 9199af4..2d4b93e 100644 (file)
--- 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
index 9ae8ce7..98dd462 100644 (file)
--- 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
index 8fc91fd..a76b62e 100644 (file)
--- 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
index 140cb21..212d315 100644 (file)
--- 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);