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

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

Browse source 
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.
This commit is contained in:
Arnaud Charlet 2020-06-03 03:42:19 -04:00 • committed by Pierre-Marie de Rodat
parent 1c5f82019a
commit 8092c19930
9 changed files with 159 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
gcc/ada/exp_aggr.adb
View file

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

1
gcc/ada/exp_util.adb
View file

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

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

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

3
gcc/ada/sem.adb
View file

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

53
gcc/ada/sem_aggr.adb
View file

@ -2677,37 +2677,40 @@ 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;
Iter := Copy_Separate_Tree (Iterator_Specification (Comp));
Analyze (Iter);
Typ := Etype (Defining_Identifier (Iter));
else
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;
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.

28
gcc/ada/sinfo.adb
View file

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

36
gcc/ada/sinfo.ads
View file

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

16
gcc/ada/sprint.adb
View file

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

1
gcc/ada/tbuild.adb
View file

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