This patch implements the two-pass algorithm described in RM 4.3.3
(20.2/5), for the construction of an array aggregate all of whose
component associations are iterated component associations with iterator
specifications. Each iterator specification is executed twice: once to
compute the number of elements it will generate, and build the run-time
code to evaluate the full length of the declared array, and the second
pass to generate the elements and insert them in their proper position
in the resulting aggregate.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_aggr.adb (Resolve_Array_Aggregate): Check the validity of
an array aggregate all of whose components are iterated
component associations.
* exp_aggr.adb (Expand_Array_Aggregate,
Two_Pass_Aggregate_Expansion): implement two-pass algorithm and
replace original aggregate with resulting temporary, to ensure
that a proper length check is performed if context is
constrained. Use attributes Pos and Val to handle index types of
any discrete type.
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
@@ -5718,6 +5718,15 @@ package body Exp_Aggr is
-- built directly into the target of the assignment it must be free
-- of side effects. N is the LHS of an assignment.
+ procedure Two_Pass_Aggregate_Expansion (N : Node_Id);
+ -- If the aggregate consists only of iterated associations then the
+ -- aggregate is constructed in two steps:
+ -- a) Build an expression to compute the number of elements
+ -- generated by each iterator, and use the expression to allocate
+ -- the destination aggregate.
+ -- b) Generate the loops corresponding to each iterator to insert
+ -- the elements in their proper positions.
+
----------------------------
-- Build_Constrained_Type --
----------------------------
@@ -6334,6 +6343,185 @@ package body Exp_Aggr is
end if;
end Safe_Left_Hand_Side;
+ ----------------------------------
+ -- Two_Pass_Aggregate_Expansion --
+ ----------------------------------
+
+ procedure Two_Pass_Aggregate_Expansion (N : Node_Id) is
+ Loc : constant Source_Ptr := Sloc (N);
+ Comp_Type : constant Entity_Id := Etype (N);
+ Index_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N);
+ Index_Type : constant Entity_Id := Etype (First_Index (Etype (N)));
+ Size_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N);
+ TmpE : constant Entity_Id := Make_Temporary (Loc, 'A', N);
+
+ Assoc : Node_Id := First (Component_Associations (N));
+ Incr : Node_Id;
+ Iter : Node_Id;
+ New_Comp : Node_Id;
+ One_Loop : Node_Id;
+
+ Size_Expr_Code : List_Id;
+ Insertion_Code : List_Id := New_List;
+
+ begin
+ Size_Expr_Code := New_List (
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Size_Id,
+ Object_Definition => New_Occurrence_Of (Standard_Integer, Loc),
+ Expression => Make_Integer_Literal (Loc, 0)));
+
+ -- First pass: execute the iterators to count the number of elements
+ -- that will be generated.
+
+ while Present (Assoc) loop
+ Iter := Iterator_Specification (Assoc);
+ Incr := Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Size_Id, Loc),
+ Expression =>
+ Make_Op_Add (Loc,
+ Left_Opnd => New_Occurrence_Of (Size_Id, Loc),
+ Right_Opnd => Make_Integer_Literal (Loc, 1)));
+
+ One_Loop := Make_Loop_Statement (Loc,
+ Iteration_Scheme =>
+ Make_Iteration_Scheme (Loc,
+ Iterator_Specification => New_Copy_Tree (Iter)),
+ Statements => New_List (Incr));
+
+ Append (One_Loop, Size_Expr_Code);
+ Next (Assoc);
+ end loop;
+
+ Insert_Actions (N, Size_Expr_Code);
+
+ -- Build a constrained subtype with the calculated length
+ -- and declare the proper bounded aggregate object.
+ -- The index type is some discrete type, so the bounds of the
+ -- constructed array are computed as T'Val (T'Pos (ineger bound));
+
+ declare
+ Pos_Lo : constant Node_Id :=
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Index_Type, Loc),
+ Attribute_Name => Name_Pos,
+ Expressions => New_List (
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Index_Type, Loc),
+ Attribute_Name => Name_First)));
+
+ Aggr_Lo : constant Node_Id :=
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Index_Type, Loc),
+ Attribute_Name => Name_Val,
+ Expressions => New_List (New_Copy_Tree (Pos_Lo)));
+
+ -- Hi = Index_type'Pos (Lo + Size -1).
+
+ Pos_Hi : constant Node_Id :=
+ Make_Op_Add (Loc,
+ Left_Opnd => New_Copy_Tree (Pos_Lo),
+ Right_Opnd =>
+ Make_Op_Subtract (Loc,
+ Left_Opnd => New_Occurrence_Of (Size_Id, Loc),
+ Right_Opnd => Make_Integer_Literal (Loc, 1)));
+
+ -- Corresponding index value
+
+ Aggr_Hi : constant Node_Id :=
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Index_Type, Loc),
+ Attribute_Name => Name_Val,
+ Expressions => New_List (New_Copy_Tree (Pos_Hi)));
+
+ SubE : constant Entity_Id := Make_Temporary (Loc, 'T');
+ SubD : constant Node_Id :=
+ Make_Subtype_Declaration (Loc,
+ Defining_Identifier => SubE,
+ Subtype_Indication =>
+ Make_Subtype_Indication (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of (Etype (Comp_Type), Loc),
+ Constraint =>
+ Make_Index_Or_Discriminant_Constraint
+ (Loc,
+ Constraints =>
+ New_List (Make_Range (Loc, Aggr_Lo, Aggr_Hi)))));
+
+ -- Create a temporary array of the above subtype which
+ -- will be used to capture the aggregate assignments.
+
+ TmpD : constant Node_Id :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => TmpE,
+ Object_Definition => New_Occurrence_Of (SubE, Loc));
+ begin
+ Insert_Actions (N, New_List (SubD, TmpD));
+ end;
+
+ -- Second pass: use the iterators to generate the elements of the
+ -- aggregate. Insertion index starts at Index_Type'First. We
+ -- assume that the second evaluation of each iterator generates
+ -- the same number of elements as the first pass, and consider
+ -- that the execution is erroneous (even if the RM does not state
+ -- this explicitly) if the number of elements generated differs
+ -- between first and second pass.
+
+ Assoc := First (Component_Associations (N));
+
+ -- Initialize insertion position to first array component.
+
+ Insertion_Code := New_List (
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Index_Id,
+ Object_Definition =>
+ New_Occurrence_Of (Index_Type, Loc),
+ Expression =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Index_Type, Loc),
+ Attribute_Name => Name_First)));
+
+ while Present (Assoc) loop
+ Iter := Iterator_Specification (Assoc);
+ New_Comp := Make_Assignment_Statement (Loc,
+ Name =>
+ Make_Indexed_Component (Loc,
+ Prefix => New_Occurrence_Of (TmpE, Loc),
+ Expressions =>
+ New_List (New_Occurrence_Of (Index_Id, Loc))),
+ Expression => New_Copy_Tree (Expression (Assoc)));
+
+ -- Advance index position for insertion.
+
+ Incr := Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Index_Id, Loc),
+ Expression =>
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Occurrence_Of (Index_Type, Loc),
+ Attribute_Name => Name_Succ,
+ Expressions =>
+ New_List (New_Occurrence_Of (Index_Id, Loc))));
+
+ One_Loop := Make_Loop_Statement (Loc,
+ Iteration_Scheme =>
+ Make_Iteration_Scheme (Loc,
+ Iterator_Specification => Copy_Separate_Tree (Iter)),
+ Statements => New_List (New_Comp, Incr));
+
+ Append (One_Loop, Insertion_Code);
+ Next (Assoc);
+ end loop;
+
+ Insert_Actions (N, Insertion_Code);
+
+ -- Depending on context this may not work for build-in-place
+ -- arrays ???
+
+ Rewrite (N, New_Occurrence_Of (TmpE, Loc));
+
+ end Two_Pass_Aggregate_Expansion;
+
-- Local variables
Tmp : Entity_Id;
@@ -6371,6 +6559,16 @@ package body Exp_Aggr is
then
return;
+ elsif Present (Component_Associations (N))
+ and then
+ Nkind (First (Component_Associations (N)))
+ = N_Iterated_Component_Association
+ and then Present
+ (Iterator_Specification (First (Component_Associations (N))))
+ then
+ Two_Pass_Aggregate_Expansion (N);
+ return;
+
-- Do not attempt expansion if error already detected. We may reach this
-- point in spite of previous errors when compiling with -gnatq, to
-- force all possible errors (this is the usual ACATS mode).
@@ -7038,6 +7236,9 @@ package body Exp_Aggr is
-- or Element_Association with non-static bounds, build an expression
-- to be used as the allocated size of the container. This may be an
-- overestimate if a filter is present, but is a safe approximation.
+ -- If bounds are dynamic the aggregate is created in two passes, and
+ -- the first generates a loop for the sole purpose of computing the
+ -- number of elements that will be generated on the seocnd pass.
procedure Expand_Iterated_Component (Comp : Node_Id);
-- Handle iterated_component_association and iterated_Element
@@ -7185,7 +7386,11 @@ package body Exp_Aggr is
return Build_Siz_Exp (First (Discrete_Choices (Comp)));
elsif Nkind (Comp) = N_Iterated_Element_Association then
- return -1; -- ??? build expression for size of the domain
+ return -1;
+
+ -- TBD : Create code for a loop and add to generated code,
+ -- as is done for array aggregates with iterated element
+ -- associations, instead of using Append operations.
else
return -1;
@@ -7217,7 +7422,7 @@ package body Exp_Aggr is
if Present (Iterator_Specification (Comp)) then
- -- Either an Iterator_Specification of a Loop_Parameter_
+ -- Either an Iterator_Specification or a Loop_Parameter_
-- Specification is present.
L_Iteration_Scheme :=
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
@@ -545,6 +545,14 @@ package body Sem_Aggr is
-- Make sure that the list of index constraints is properly attached to
-- the tree, and then collect the aggregate bounds.
+ -- If no aggregaate bounds have been set, this is an aggregate with
+ -- iterator specifications and a dynamic size to be determined by
+ -- first pass of expanded code.
+
+ if No (Aggregate_Bounds (N)) then
+ return Typ;
+ end if;
+
Set_Parent (Index_Constraints, N);
Collect_Aggr_Bounds (N, 1);
@@ -1597,6 +1605,8 @@ package body Sem_Aggr is
Loc : constant Source_Ptr := Sloc (N);
Id : constant Entity_Id := Defining_Identifier (N);
+ Id_Typ : Entity_Id;
+
-----------------------
-- Remove_References --
-----------------------
@@ -1630,42 +1640,63 @@ package body Sem_Aggr is
-- Start of processing for Resolve_Iterated_Component_Association
begin
- -- An element iterator specification cannot appear in
- -- an array aggregate because it does not provide index
- -- values for the association. This must be a semantic
- -- check because the parser cannot tell whether this is
- -- an array aggregate or a container aggregate.
-
if Present (Iterator_Specification (N)) then
- Error_Msg_N ("container element Iterator cannot appear "
- & "in an array aggregate", N);
- return;
- end if;
+ Analyze (Name (Iterator_Specification (N)));
- Choice := First (Discrete_Choices (N));
+ -- We assume that the domain of iteration cannot be overloaded.
- while Present (Choice) loop
- if Nkind (Choice) = N_Others_Choice then
- Others_Present := True;
+ declare
+ Domain : constant Node_Id := Name (Iterator_Specification (N));
+ D_Type : constant Entity_Id := Etype (Domain);
+ Elt : Entity_Id;
+ begin
+ if Is_Array_Type (D_Type) then
+ Id_Typ := Component_Type (D_Type);
- else
- Analyze (Choice);
+ else
+ if Has_Aspect (D_Type, Aspect_Iterable) then
+ Elt :=
+ Get_Iterable_Type_Primitive (D_Type, Name_Element);
+ if No (Elt) then
+ Error_Msg_N
+ ("missing Element primitive for iteration", Domain);
+ else
+ Id_Typ := Etype (Elt);
+ end if;
+ else
+ Error_Msg_N ("cannot iterate over", Domain);
+ end if;
+ end if;
+ end;
- -- Choice can be a subtype name, a range, or an expression
+ else
+ Id_Typ := Index_Typ;
+ Choice := First (Discrete_Choices (N));
- if Is_Entity_Name (Choice)
- and then Is_Type (Entity (Choice))
- and then Base_Type (Entity (Choice)) = Base_Type (Index_Typ)
- then
- null;
+ while Present (Choice) loop
+ if Nkind (Choice) = N_Others_Choice then
+ Others_Present := True;
else
- Analyze_And_Resolve (Choice, Index_Typ);
+ 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 (Index_Typ)
+ then
+ null;
+
+ else
+ Analyze_And_Resolve (Choice, Index_Typ);
+ end if;
end if;
- 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
@@ -1681,7 +1712,7 @@ package body Sem_Aggr is
-- directly visible.
Enter_Name (Id);
- Set_Etype (Id, Index_Typ);
+ Set_Etype (Id, Id_Typ);
Mutate_Ekind (Id, E_Variable);
Set_Scope (Id, Ent);
@@ -1735,6 +1766,12 @@ package body Sem_Aggr is
Delete_Choice : Boolean;
-- Used when replacing a subtype choice with predicate by a list
+ Has_Iterator_Specifications : Boolean := False;
+ -- Flag to indicate that all named associations are iterated component
+ -- associations with iterator specifications, in which case the
+ -- expansion will create two loops: one to evaluate the size and one
+ -- to generate the elements (4.3.3 (20.2/5)).
+
Nb_Elements : Uint := Uint_0;
-- The number of elements in a positional aggregate
@@ -1756,6 +1793,54 @@ package body Sem_Aggr is
-- STEP 1: make sure the aggregate is correctly formatted
if Present (Component_Associations (N)) then
+
+ -- Verify that all or none of the component associations
+ -- include an iterator specification.
+
+ Assoc := First (Component_Associations (N));
+ if Nkind (Assoc) = N_Iterated_Component_Association
+ and then Present (Iterator_Specification (Assoc))
+ then
+ -- All other component associations must have an iterator spec.
+
+ Next (Assoc);
+ while Present (Assoc) loop
+ if Nkind (Assoc) /= N_Iterated_Component_Association
+ or else No (Iterator_Specification (Assoc))
+ then
+ Error_Msg_N ("mixed iterated component association"
+ & " (RM 4.4.3 (17.1/5))",
+ Assoc);
+ return False;
+ end if;
+
+ Next (Assoc);
+ end loop;
+
+ Has_Iterator_Specifications := True;
+
+ else
+ -- or none of them do.
+
+ Next (Assoc);
+ while Present (Assoc) loop
+ if Nkind (Assoc) = N_Iterated_Component_Association
+ and then Present (Iterator_Specification (Assoc))
+ then
+ Error_Msg_N ("mixed iterated component association"
+ & " (RM 4.4.3 (17.1/5))",
+ Assoc);
+ return False;
+ end if;
+
+ Next (Assoc);
+ end loop;
+
+ while Present (Assoc) loop
+ Next (Assoc);
+ end loop;
+ end if;
+
Assoc := First (Component_Associations (N));
while Present (Assoc) loop
if Nkind (Assoc) = N_Iterated_Component_Association then
@@ -1948,9 +2033,12 @@ package body Sem_Aggr is
begin
-- STEP 2 (A): Check discrete choices validity
+ -- No need if this is an element iteration.
Assoc := First (Component_Associations (N));
- while Present (Assoc) loop
+ while Present (Assoc)
+ and then Present (Choice_List (Assoc))
+ loop
Prev_Nb_Discrete_Choices := Nb_Discrete_Choices;
Choice := First (Choice_List (Assoc));
@@ -2391,6 +2479,12 @@ package body Sem_Aggr is
end Check_Choices;
end if;
+ if Has_Iterator_Specifications then
+ -- Bounds will be determined dynamically.
+
+ return Success;
+ end if;
+
-- STEP 2 (B): Compute aggregate bounds and min/max choices values
if Nb_Discrete_Choices > 0 then