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.
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);