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 =>
-- 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
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
-- 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));
-- 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
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;
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;
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;
---------------------------------
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
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));
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
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);
& "for unnamed container aggregate", Comp);
return;
else
- Resolve_Iterated_Component_Association
+ Resolve_Iterated_Association
(Comp, Empty, Elmt_Type);
end if;
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;
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;
projects / gcc.git / commitdiff