OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Ongoing work for unnamed and named container aggregates

Browse Source 
gcc/ada/

	* sem_aggr.adb (Resolve_Iterated_Component_Association): New
	procedure, internal to Resolve_Container_Aggregate, to complete
	semantic analysis of Iterated_Component_Associations.
	* exp_aggr.adb (Expand_Iterated_Component): New procedure,
	internal to Expand_Container_Aggregate, to expand the construct
	into an implicit loop that performs individual insertions into
	the target aggregate.
This commit is contained in:
Ed Schonberg 2020-05-31 16:01:41 -04:00 committed by Pierre-Marie de Rodat
parent 3c30eac83c
commit 4f6ebe2a51
2 changed files with 288 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
gcc/ada/exp_aggr.adb
View File

@ -6889,12 +6889,69 @@ 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);
Comp : Node_Id;
Decl : Node_Id;
Init_Stat : Node_Id;
-------------------------------
-- Expand_Iterated_Component --
-------------------------------
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)));
L_Range : Node_Id;
L_Iteration_Scheme : Node_Id;
Loop_Stat : Node_Id;
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));
-- Build insertion statement. for a positional aggregate only
-- the 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 Present (Add_Unnamed_Subp) then
Stats := New_List
(Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Entity (Add_Unnamed_Subp), Loc),
Parameter_Associations =>
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))));
end if;
Loop_Stat := Make_Implicit_Loop_Statement
(Node => N,
Identifier => Empty,
Iteration_Scheme => L_Iteration_Scheme,
Statements => Stats);
Append (Loop_Stat, Aggr_Code);
end Expand_Iterated_Component;
begin
Parse_Aspect_Aggregate (Asp,
Empty_Subp, Add_Named_Subp, Add_Unnamed_Subp,
@ -6905,7 +6962,7 @@ package body Exp_Aggr is
Object_Definition => New_Occurrence_Of (Typ, Loc));
Insert_Action (N, Decl);
if Ekind (Entity (Empty_Subp)) = E_Constant then
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,
@ -6919,24 +6976,70 @@ package body Exp_Aggr is
-- First case: positional aggregate
if Present (Expressions (N)) then
if Present (Add_Unnamed_Subp) then
if Present (Expressions (N)) then
declare
Insert : constant Entity_Id := Entity (Add_Unnamed_Subp);
Comp : Node_Id;
Stat : Node_Id;
begin
Comp := First (Expressions (N));
while Present (Comp) loop
Stat := Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Insert, Loc),
Parameter_Associations =>
New_List (New_Occurrence_Of (Temp, Loc),
New_Copy_Tree (Comp)));
Append (Stat, Aggr_Code);
Next (Comp);
end loop;
end;
end if;
-- iterated component associations may be present.
Comp := First (Component_Associations (N));
while Present (Comp) loop
Expand_Iterated_Component (Comp);
Next (Comp);
end loop;
elsif Present (Add_Named_Subp) then
declare
Insert : constant Entity_Id := Entity (Add_Unnamed_Subp);
Comp : Node_Id;
Insert : constant Entity_Id := Entity (Add_Named_Subp);
Stat : Node_Id;
Key : Node_Id;
begin
Comp := First (Expressions (N));
Comp := First (Component_Associations (N));
-- Each component association may contain several choices,
-- generate an insertion statement for each.
while Present (Comp) loop
Stat := Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Insert, Loc),
Parameter_Associations =>
New_List (New_Occurrence_Of (Temp, Loc),
New_Copy_Tree (Comp)));
Append (Stat, Aggr_Code);
if Nkind (Comp) = N_Iterated_Component_Association then
Expand_Iterated_Component (Comp);
else
Key := First (Choices (Comp));
while Present (Key) loop
Stat := Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Insert, Loc),
Parameter_Associations =>
New_List (New_Occurrence_Of (Temp, Loc),
New_Copy_Tree (Key),
New_Copy_Tree (Expression (Comp))));
Append (Stat, Aggr_Code);
Next (Key);
end loop;
end if;
Next (Comp);
end loop;
end;
end if;
Insert_Actions (N, Aggr_Code);
Rewrite (N, New_Occurrence_Of (Temp, Loc));
Analyze_And_Resolve (N, Typ);

201
gcc/ada/sem_aggr.adb
View File

@ -2644,6 +2644,18 @@ package body Sem_Aggr is
---------------------------------
procedure Resolve_Container_Aggregate (N : Node_Id; Typ : Entity_Id) is
procedure Resolve_Iterated_Component_Association
(Comp : Node_Id;
Key_Type : Entity_Id;
Elmt_Type : Entity_Id);
-- Resolve choices and expression in an iterated component
-- association. 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
-- with the key type. For a positional container the choice must be
-- a subtype indication or an iterator specification that determines
-- an element type.
Asp : constant Node_Id := Find_Value_Of_Aspect (Typ, Aspect_Aggregate);
Empty_Subp : Node_Id := Empty;
@ -2652,41 +2664,176 @@ package body Sem_Aggr is
New_Indexed_Subp : Node_Id := Empty;
Assign_Indexed_Subp : Node_Id := Empty;
--------------------------------------------
-- Resolve_Iterated_Component_Association --
--------------------------------------------
procedure Resolve_Iterated_Component_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;
Typ : Entity_Id;
begin
if Present (Iterator_Specification (Comp)) then
Error_Msg_N ("element iterator ins aggregate Forthcoming", N);
return;
end if;
Choice := First (Discrete_Choices (Comp));
while Present (Choice) loop
Analyze (Choice);
-- 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;
elsif Present (Key_Type) then
Analyze_And_Resolve (Choice, Key_Type);
else
Typ := Etype (Choice); -- assume unique for now
end if;
Next (Choice);
end loop;
-- Create a scope in which to introduce an index, which is usually
-- visible in the expression for the component, and needed for its
-- analysis.
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
-- directly visible. Mark the variable as referenced to prevent
-- spurious warnings, given that subsequent uses of its name in the
-- expression will reference the internal (synonym) loop variable.
Enter_Name (Id);
if No (Key_Type) then
Set_Etype (Id, Typ);
else
Set_Etype (Id, Key_Type);
end if;
Set_Ekind (Id, E_Variable);
Set_Scope (Id, Ent);
Set_Referenced (Id);
-- Analyze a copy of the expression, to verify legality. We use
-- a copy because the expression will be analyzed anew when the
-- enclosing aggregate is expanded, and the construct is rewritten
-- as a loop with a new index variable.
Expr := New_Copy_Tree (Expression (Comp));
Preanalyze_And_Resolve (Expr, Elmt_Type);
End_Scope;
end Resolve_Iterated_Component_Association;
begin
if Nkind (Asp) /= N_Aggregate then
pragma Assert (False);
return;
else
Set_Etype (N, Typ);
Parse_Aspect_Aggregate (Asp,
Empty_Subp, Add_Named_Subp, Add_Unnamed_Subp,
New_Indexed_Subp, Assign_Indexed_Subp);
pragma Assert (Nkind (Asp) = N_Aggregate);
if Present (Add_Unnamed_Subp) then
declare
Elmt_Type : constant Entity_Id :=
Etype (Next_Formal
(First_Formal (Entity (Add_Unnamed_Subp))));
Comp : Node_Id;
begin
if Present (Expressions (N)) then
-- positional aggregate
Set_Etype (N, Typ);
Parse_Aspect_Aggregate (Asp,
Empty_Subp, Add_Named_Subp, Add_Unnamed_Subp,
New_Indexed_Subp, Assign_Indexed_Subp);
Comp := First (Expressions (N));
if Present (Add_Unnamed_Subp) then
declare
Elmt_Type : constant Entity_Id :=
Etype (Next_Formal
(First_Formal (Entity (Add_Unnamed_Subp))));
Comp : Node_Id;
begin
if Present (Expressions (N)) then
-- positional aggregate
Comp := First (Expressions (N));
while Present (Comp) loop
Analyze_And_Resolve (Comp, Elmt_Type);
Next (Comp);
end loop;
end if;
-- Empty aggregate, to be replaced by Empty during
-- expansion, or iterated component association.
if Present (Component_Associations (N)) then
declare
Comp : Node_Id := First (Component_Associations (N));
begin
while Present (Comp) loop
Analyze_And_Resolve (Comp, Elmt_Type);
if Nkind (Comp) /=
N_Iterated_Component_Association
then
Error_Msg_N ("illegal component association "
& "for unnamed container aggregate", Comp);
return;
else
Resolve_Iterated_Component_Association
(Comp, Empty, Elmt_Type);
end if;
Next (Comp);
end loop;
else
end;
end if;
end;
-- Empty aggregate, to be replaced by Empty during
-- expansion.
null;
elsif Present (Add_Named_Subp) then
declare
-- Retrieves types of container, key, and element from the
-- specified insertion procedure.
Container : constant Entity_Id :=
First_Formal (Entity (Add_Named_Subp));
Key_Type : constant Entity_Id := Etype (Next_Formal (Container));
Elmt_Type : constant Entity_Id :=
Etype (Next_Formal (Next_Formal (Container)));
Comp : Node_Id;
Choice : Node_Id;
begin
Comp := First (Component_Associations (N));
while Present (Comp) loop
if Nkind (Comp) = N_Component_Association then
Choice := First (Choices (Comp));
while Present (Choice) loop
Analyze_And_Resolve (Choice, Key_Type);
Next (Choice);
end loop;
Analyze_And_Resolve (Expression (Comp), Elmt_Type);
elsif Nkind (Comp) = N_Iterated_Component_Association then
Resolve_Iterated_Component_Association
(Comp, Key_Type, Elmt_Type);
end if;
end;
else
Error_Msg_N ("indexed aggregates are forthcoming", N);
end if;
Next (Comp);
end loop;
end;
else
Error_Msg_N ("indexed aggregates are forthcoming", N);
end if;
end Resolve_Container_Aggregate;