This patch implements the Key_Expression mechanism for container
aggregates. A Key_Expression specifies a mapping between the loop
variable in an iterated element association, and the value of the key
to be used for insertion of successive components into the container
being populated. The parser creates an Iterated_Element_Association only
when the key_expression appears, as indicated by the presence of a "use"
keyword. If the key_expression is not present, the parser generates
an Iterated_Component_Association.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* par-ch4.adb: (P_Aggregate_Or_Paren_Expr): Recognize
Iterated_Element_Component.
(P_Iterated_Component_Association): Rebuild node as an Iterated_
Element_Association when Key_Expression is present, and attach
either the Loop_Parameter_Specification or the
Iterator_Specification to the new node.
* sem_aggr.adb: (Resolve_Container_Aggregate):
Resolve_Iterated_Association handles bota Iterated_Component_
and Iterated_Element_Associations, in which case it analyzes and
resoles the orresponding Key_Expression.
* exp_aggr.adb (Expand_Iterated_Component): If a Key_Expression
is present, use it as the required parameter in the call to the
insertion routine for the destination container aggregate. Call
this routine for both kinds of Iterated_Associations.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
@@ -6899,23 +6899,62 @@ package body Exp_Aggr is
procedure Expand_Iterated_Component (Comp : Node_Id) is
Expr : constant Node_Id := Expression (Comp);
- Loop_Id : constant Entity_Id :=
- Make_Defining_Identifier (Loc,
- Chars => Chars (Defining_Identifier (Comp)));
+ Key_Expr : Node_Id := Empty;
+ Loop_Id : Entity_Id;
L_Range : Node_Id;
L_Iteration_Scheme : Node_Id;
Loop_Stat : Node_Id;
Stats : List_Id;
begin
- if Present (Iterator_Specification (Comp)) then
+ if Nkind (Comp) = N_Iterated_Element_Association then
+ Key_Expr := Key_Expression (Comp);
+
+ -- We create a new entity as loop identifier in all cases,
+ -- as is done for generated loops elsewhere, as the loop
+ -- structure has been previously analyzed.
+
+ if Present (Iterator_Specification (Comp)) then
+
+ -- Either an Iterator_Specification of a Loop_Parameter_
+ -- Specification is present.
+
+ L_Iteration_Scheme :=
+ Make_Iteration_Scheme (Loc,
+ Iterator_Specification => Iterator_Specification (Comp));
+ Loop_Id :=
+ Make_Defining_Identifier (Loc,
+ Chars => Chars (Defining_Identifier
+ (Iterator_Specification (Comp))));
+ Set_Defining_Identifier
+ (Iterator_Specification (L_Iteration_Scheme), Loop_Id);
+
+ else
+ L_Iteration_Scheme :=
+ Make_Iteration_Scheme (Loc,
+ Loop_Parameter_Specification =>
+ Loop_Parameter_Specification (Comp));
+ Loop_Id :=
+ Make_Defining_Identifier (Loc,
+ Chars => Chars (Defining_Identifier
+ (Loop_Parameter_Specification (Comp))));
+ Set_Defining_Identifier
+ (Loop_Parameter_Specification
+ (L_Iteration_Scheme), Loop_Id);
+ end if;
+
+ elsif 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)));
+ Loop_Id :=
+ Make_Defining_Identifier (Loc,
+ Chars => Chars (Defining_Identifier (Comp)));
+
L_Iteration_Scheme :=
Make_Iteration_Scheme (Loc,
Loop_Parameter_Specification =>
@@ -6928,6 +6967,9 @@ package body Exp_Aggr is
-- expression is needed. For a named aggregate, the loop variable,
-- whose type is that of the key, is an additional parameter for
-- the insertion operation.
+ -- If a Key_Expression is present, it serves as the additional
+ -- parameter. Otherwise the key is given by the loop parameter
+ -- itself.
if Present (Add_Unnamed_Subp) then
Stats := New_List
@@ -6937,13 +6979,27 @@ package body Exp_Aggr is
New_List (New_Occurrence_Of (Temp, Loc),
New_Copy_Tree (Expr))));
else
- Stats := New_List
- (Make_Procedure_Call_Statement (Loc,
- Name => New_Occurrence_Of (Entity (Add_Named_Subp), Loc),
- Parameter_Associations =>
- New_List (New_Occurrence_Of (Temp, Loc),
- New_Occurrence_Of (Loop_Id, Loc),
- New_Copy_Tree (Expr))));
+ -- Named or indexed aggregate, for which a key is present,
+ -- possibly with a specified key_expression.
+
+ if Present (Key_Expr) then
+ Stats := New_List
+ (Make_Procedure_Call_Statement (Loc,
+ Name => New_Occurrence_Of (Entity (Add_Named_Subp), Loc),
+ Parameter_Associations =>
+ New_List (New_Occurrence_Of (Temp, Loc),
+ New_Copy_Tree (Key_Expr),
+ New_Copy_Tree (Expr))));
+
+ else
+ Stats := New_List
+ (Make_Procedure_Call_Statement (Loc,
+ Name => New_Occurrence_Of (Entity (Add_Named_Subp), Loc),
+ Parameter_Associations =>
+ New_List (New_Occurrence_Of (Temp, Loc),
+ New_Occurrence_Of (Loop_Id, Loc),
+ New_Copy_Tree (Expr))));
+ end if;
end if;
Loop_Stat := Make_Implicit_Loop_Statement
@@ -7029,7 +7085,9 @@ package body Exp_Aggr is
-- generate an insertion statement for each.
while Present (Comp) loop
- if Nkind (Comp) = N_Iterated_Component_Association then
+ if Nkind (Comp) in N_Iterated_Component_Association
+ | N_Iterated_Element_Association
+ then
Expand_Iterated_Component (Comp);
else
Key := First (Choices (Comp));
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
@@ -1607,8 +1607,11 @@ package body Ch4 is
-- identifier or OTHERS follows (the latter cases are missing
-- comma cases). Also assume positional if a semicolon follows,
-- which can happen if there are missing parens.
+ -- In Ada_2012 and Ada_2020 an iterated association can appear.
- elsif Nkind (Expr_Node) = N_Iterated_Component_Association then
+ elsif Nkind (Expr_Node) in
+ N_Iterated_Component_Association | N_Iterated_Element_Association
+ then
if No (Assoc_List) then
Assoc_List := New_List (Expr_Node);
else
@@ -3417,6 +3420,7 @@ package body Ch4 is
function P_Iterated_Component_Association return Node_Id is
Assoc_Node : Node_Id;
+ Choice : Node_Id;
Id : Node_Id;
Iter_Spec : Node_Id;
Loop_Spec : Node_Id;
@@ -3451,15 +3455,25 @@ package body Ch4 is
if Token = Tok_Use then
- -- Key-expression is present, rewrite node as an
+ -- Ada_2020 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)));
+
+ Choice := First (Discrete_Choices (Assoc_Node));
+
+ if Present (Next (Choice)) then
+ Error_Msg_N ("expect loop parameter specification", Choice);
+ end if;
+
+ Remove (Choice);
+ Set_Discrete_Subtype_Definition (Loop_Spec, Choice);
+
+ Assoc_Node :=
+ New_Node (N_Iterated_Element_Association, Prev_Token_Ptr);
Set_Loop_Parameter_Specification (Assoc_Node, Loop_Spec);
Set_Key_Expression (Assoc_Node, P_Expression);
end if;
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
@@ -48,6 +48,7 @@ with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
+with Sem_Ch5; use Sem_Ch5;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch13; use Sem_Ch13;
with Sem_Dim; use Sem_Dim;
@@ -2646,11 +2647,12 @@ package body Sem_Aggr is
---------------------------------
procedure Resolve_Container_Aggregate (N : Node_Id; Typ : Entity_Id) is
- procedure Resolve_Iterated_Component_Association
+ procedure Resolve_Iterated_Association
(Comp : Node_Id;
Key_Type : Entity_Id;
Elmt_Type : Entity_Id);
- -- Resolve choices and expression in an iterated component association.
+ -- Resolve choices and expression in an iterated component association
+ -- or an iterated element association, which has a key_expression.
-- This is similar but not identical to the handling of this construct
-- in an array aggregate.
-- For a named container, the type of each choice must be compatible
@@ -2666,25 +2668,54 @@ package body Sem_Aggr is
New_Indexed_Subp : Node_Id := Empty;
Assign_Indexed_Subp : Node_Id := Empty;
- --------------------------------------------
- -- Resolve_Iterated_Component_Association --
- --------------------------------------------
+ ----------------------------------
+ -- Resolve_Iterated_Association --
+ ----------------------------------
- procedure Resolve_Iterated_Component_Association
+ procedure Resolve_Iterated_Association
(Comp : Node_Id;
Key_Type : Entity_Id;
Elmt_Type : Entity_Id)
is
- Choice : Node_Id;
- Ent : Entity_Id;
- Expr : Node_Id;
- Id : Entity_Id;
- Iter : Node_Id;
- Typ : Entity_Id := Empty;
+ Choice : Node_Id;
+ Ent : Entity_Id;
+ Expr : Node_Id;
+ Key_Expr : Node_Id;
+ Id : Entity_Id;
+ Id_Name : Name_Id;
+ Iter : Node_Id;
+ Typ : Entity_Id := Empty;
begin
- if Present (Iterator_Specification (Comp)) then
- Iter := Copy_Separate_Tree (Iterator_Specification (Comp));
+ -- If this is an Iterated_Element_Association then either a
+ -- an Iterator_Specification or a Loop_Parameter specification
+ -- is present. In both cases a Key_Expression is present.
+
+ if Nkind (Comp) = N_Iterated_Element_Association then
+ if Present (Loop_Parameter_Specification (Comp)) then
+ Analyze_Loop_Parameter_Specification
+ (Loop_Parameter_Specification (Comp));
+ Id_Name := Chars (Defining_Identifier
+ (Loop_Parameter_Specification (Comp)));
+ else
+ Iter := Copy_Separate_Tree (Iterator_Specification (Comp));
+ Analyze (Iter);
+ Typ := Etype (Defining_Identifier (Iter));
+ Id_Name := Chars (Defining_Identifier
+ (Iterator_Specification (Comp)));
+ end if;
+
+ -- Key expression must have the type of the key. We analyze
+ -- a copy of the original expression, because it will be
+ -- reanalyzed and copied as needed during expansion of the
+ -- corresponding loop.
+
+ Key_Expr := Key_Expression (Comp);
+ Analyze_And_Resolve (New_Copy_Tree (Key_Expr), Key_Type);
+
+ elsif Present (Iterator_Specification (Comp)) then
+ Iter := Copy_Separate_Tree (Iterator_Specification (Comp));
+ Id_Name := Chars (Defining_Identifier (Comp));
Analyze (Iter);
Typ := Etype (Defining_Identifier (Iter));
@@ -2711,19 +2742,19 @@ package body Sem_Aggr is
Next (Choice);
end loop;
+
+ Id_Name := Chars (Defining_Identifier (Comp));
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
-- analysis.
+ Id := Make_Defining_Identifier (Sloc (Comp), Id_Name);
Ent := New_Internal_Entity (E_Loop, Current_Scope, Sloc (Comp), 'L');
Set_Etype (Ent, Standard_Void_Type);
Set_Parent (Ent, Parent (Comp));
Push_Scope (Ent);
- Id :=
- Make_Defining_Identifier (Sloc (Comp),
- Chars => Chars (Defining_Identifier (Comp)));
-- Insert and decorate the loop variable in the current scope.
-- The expression has to be analyzed once the loop variable is
@@ -2752,7 +2783,8 @@ package body Sem_Aggr is
Expr := New_Copy_Tree (Expression (Comp));
Preanalyze_And_Resolve (Expr, Elmt_Type);
End_Scope;
- end Resolve_Iterated_Component_Association;
+
+ end Resolve_Iterated_Association;
begin
pragma Assert (Nkind (Asp) = N_Aggregate);
@@ -2797,7 +2829,7 @@ package body Sem_Aggr is
& "for unnamed container aggregate", Comp);
return;
else
- Resolve_Iterated_Component_Association
+ Resolve_Iterated_Association
(Comp, Empty, Elmt_Type);
end if;
@@ -2837,8 +2869,11 @@ package body Sem_Aggr is
Analyze_And_Resolve (Expression (Comp), Elmt_Type);
- elsif Nkind (Comp) = N_Iterated_Component_Association then
- Resolve_Iterated_Component_Association
+ elsif Nkind (Comp) in
+ N_Iterated_Component_Association |
+ N_Iterated_Element_Association
+ then
+ Resolve_Iterated_Association
(Comp, Key_Type, Elmt_Type);
end if;
@@ -2883,8 +2918,11 @@ package body Sem_Aggr is
Analyze_And_Resolve (Expression (Comp), Comp_Type);
- elsif Nkind (Comp) = N_Iterated_Component_Association then
- Resolve_Iterated_Component_Association
+ elsif Nkind (Comp) in
+ N_Iterated_Component_Association |
+ N_Iterated_Element_Association
+ then
+ Resolve_Iterated_Association
(Comp, Index_Type, Comp_Type);
end if;
