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