procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[Ada] Ada_2020: Implement Key_Expression for named container aggregates

Browse source 
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.
This commit is contained in:
Ed Schonberg 2020-07-10 11:13:57 -04:00 • committed by Pierre-Marie de Rodat
parent 86b3d0d55f
commit c0bab60bb9
3 changed files with 149 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

82
gcc/ada/exp_aggr.adb
View file

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

22
gcc/ada/par-ch4.adb
View file

@ -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;

84
gcc/ada/sem_aggr.adb
View file

@ -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;