@@ -3868,13 +3868,20 @@ package body Exp_Ch5 is
Array_Dim : constant Pos := Number_Dimensions (Array_Typ);
Id : constant Entity_Id := Defining_Identifier (I_Spec);
Loc : constant Source_Ptr := Sloc (Isc);
- Stats : constant List_Id := Statements (N);
+ Stats : List_Id := Statements (N);
Core_Loop : Node_Id;
Dim1 : Int;
Ind_Comp : Node_Id;
Iterator : Entity_Id;
begin
+ if Present (Iterator_Filter (I_Spec)) then
+ pragma Assert (Ada_Version >= Ada_2020);
+ Stats := New_List (Make_If_Statement (Loc,
+ Condition => Iterator_Filter (I_Spec),
+ Then_Statements => Stats));
+ end if;
+
-- for Element of Array loop
-- It requires an internally generated cursor to iterate over the array
@@ -4145,7 +4152,9 @@ package body Exp_Ch5 is
Elem_Typ : constant Entity_Id := Etype (Id);
Id_Kind : constant Entity_Kind := Ekind (Id);
Loc : constant Source_Ptr := Sloc (N);
- Stats : constant List_Id := Statements (N);
+
+ Stats : List_Id := Statements (N);
+ -- Maybe wrapped in a conditional if a filter is present
Cursor : Entity_Id;
Decl : Node_Id;
@@ -4167,6 +4176,13 @@ package body Exp_Ch5 is
-- The package in which the container type is declared
begin
+ if Present (Iterator_Filter (I_Spec)) then
+ pragma Assert (Ada_Version >= Ada_2020);
+ Stats := New_List (Make_If_Statement (Loc,
+ Condition => Iterator_Filter (I_Spec),
+ Then_Statements => Stats));
+ end if;
+
-- Determine the advancement and initialization steps for the cursor.
-- Analysis of the expanded loop will verify that the container has a
-- reverse iterator.
@@ -4640,11 +4656,20 @@ package body Exp_Ch5 is
Loop_Id : constant Entity_Id := Defining_Identifier (LPS);
Ltype : constant Entity_Id := Etype (Loop_Id);
Btype : constant Entity_Id := Base_Type (Ltype);
+ Stats : constant List_Id := Statements (N);
Expr : Node_Id;
Decls : List_Id;
New_Id : Entity_Id;
begin
+ if Present (Iterator_Filter (LPS)) then
+ pragma Assert (Ada_Version >= Ada_2020);
+ Set_Statements (N,
+ New_List (Make_If_Statement (Loc,
+ Condition => Iterator_Filter (LPS),
+ Then_Statements => Stats)));
+ end if;
+
-- Deal with loop over predicates
if Is_Discrete_Type (Ltype)
@@ -4761,7 +4786,7 @@ package body Exp_Ch5 is
Declarations => Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
- Statements => Statements (N)))),
+ Statements => Stats))),
End_Label => End_Label (N)));
@@ -4863,7 +4888,7 @@ package body Exp_Ch5 is
end if;
end if;
- -- When the iteration scheme mentiones attribute 'Loop_Entry, the loop
+ -- When the iteration scheme mentions attribute 'Loop_Entry, the loop
-- is transformed into a conditional block where the original loop is
-- the sole statement. Inspect the statements of the nested loop for
-- controlled objects.
@@ -3402,22 +3402,50 @@ package body Ch4 is
-- ITERATED_COMPONENT_ASSOCIATION ::=
-- for DEFINING_IDENTIFIER in DISCRETE_CHOICE_LIST => EXPRESSION
+ -- for ITERATOR_SPECIFICATION => EXPRESSION
function P_Iterated_Component_Association return Node_Id is
Assoc_Node : Node_Id;
+ Id : Node_Id;
+ State : Saved_Scan_State;
-- Start of processing for P_Iterated_Component_Association
begin
Scan; -- past FOR
+ Save_Scan_State (State);
+
+ -- A lookahead is necessary to differentiate between the
+ -- Ada2012 form with a choice list, and the Ada2020 element
+ -- iterator form, recognized by the presence of "OF". Other
+ -- disambiguation requires context and is done during semantc
+ -- analysis. Note that "for X in E" is syntactically ambiguous:
+ -- if E is a subypte 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.
+
+ Id := P_Defining_Identifier;
Assoc_Node :=
New_Node (N_Iterated_Component_Association, Prev_Token_Ptr);
- Set_Defining_Identifier (Assoc_Node, P_Defining_Identifier);
- T_In;
- Set_Discrete_Choices (Assoc_Node, P_Discrete_Choice_List);
- TF_Arrow;
- Set_Expression (Assoc_Node, P_Expression);
+ if Token = Tok_In then
+ Set_Defining_Identifier (Assoc_Node, Id);
+ T_In;
+ Set_Discrete_Choices (Assoc_Node, P_Discrete_Choice_List);
+ TF_Arrow;
+ Set_Expression (Assoc_Node, P_Expression);
+
+ elsif Ada_Version >= Ada_2020
+ and then Token = Tok_Of
+ then
+ Restore_Scan_State (State);
+ Scan; -- past OF
+ Set_Defining_Identifier (Assoc_Node, Id);
+ Set_Iterator_Specification
+ (Assoc_Node, P_Iterator_Specification (Id));
+ TF_Arrow;
+ Set_Expression (Assoc_Node, P_Expression);
+ end if;
if Ada_Version < Ada_2020 then
Error_Msg_SC ("iterated component is an Ada 202x feature");
@@ -62,11 +62,6 @@ package body Ch5 is
-- the N_Identifier node for the label on the loop. If Loop_Name is
-- Empty on entry (the default), then the for statement is unlabeled.
- function P_Iterator_Specification (Def_Id : Node_Id) return Node_Id;
- -- Parse an iterator specification. The defining identifier has already
- -- been scanned, as it is the common prefix between loop and iterator
- -- specification.
-
function P_Loop_Statement (Loop_Name : Node_Id := Empty) return Node_Id;
-- Parse loop statement. If Loop_Name is non-Empty on entry, it is
-- the N_Identifier node for the label on the loop. If Loop_Name is
@@ -1660,6 +1655,7 @@ package body Ch5 is
-- LOOP_PARAMETER_SPECIFICATION ::=
-- DEFINING_IDENTIFIER in [reverse] DISCRETE_SUBTYPE_DEFINITION
+ -- [Iterator_Filter]
-- Error recovery: cannot raise Error_Resync
@@ -1715,6 +1711,15 @@ package body Ch5 is
Set_Discrete_Subtype_Definition
(Loop_Param_Specification_Node, P_Discrete_Subtype_Definition);
+
+ if Ada_Version >= Ada_2020
+ and then Token = Tok_When
+ then
+ Scan; -- past WHEN
+ Set_Iterator_Filter
+ (Loop_Param_Specification_Node, P_Condition);
+ end if;
+
return Loop_Param_Specification_Node;
exception
@@ -1767,6 +1772,15 @@ package body Ch5 is
end if;
Set_Name (Node1, P_Name);
+
+ if Ada_Version >= Ada_2020
+ and then Token = Tok_When
+ then
+ Scan; -- past WHEN
+ Set_Iterator_Filter
+ (Node1, P_Condition);
+ end if;
+
return Node1;
end P_Iterator_Specification;
@@ -842,6 +842,11 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
-- conditional expression and passes it as an argument. This form of
-- the call does not check for a following right parenthesis.
+ function P_Iterator_Specification (Def_Id : Node_Id) return Node_Id;
+ -- Parse an iterator specification. The defining identifier has already
+ -- been scanned, as it is the common prefix between loop and iterator
+ -- specification.
+
function P_Loop_Parameter_Specification return Node_Id;
-- Used in loop constructs and quantified expressions.
@@ -1545,6 +1545,18 @@ package body Sem_Aggr is
Id : Entity_Id;
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;
+
Choice := First (Discrete_Choices (N));
while Present (Choice) loop
@@ -2628,6 +2628,10 @@ package body Sem_Ch5 is
end if;
end if;
+
+ if Present (Iterator_Filter (N)) then
+ Analyze_And_Resolve (Iterator_Filter (N), Standard_Boolean);
+ end if;
end Analyze_Iterator_Specification;
-------------------
@@ -3311,6 +3315,10 @@ package body Sem_Ch5 is
end;
end if;
+ if Present (Iterator_Filter (N)) then
+ Analyze_And_Resolve (Iterator_Filter (N), Standard_Boolean);
+ end if;
+
-- A loop parameter cannot be effectively volatile (SPARK RM 7.1.3(4)).
-- This check is relevant only when SPARK_Mode is on as it is not a
-- standard Ada legality check.
@@ -2223,6 +2223,15 @@ package body Sinfo is
return Flag5 (N);
end Is_Write;
+ function Iterator_Filter
+ (N : Node_Id) return Node_Id is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Iterator_Specification
+ or else NT (N).Nkind = N_Loop_Parameter_Specification);
+ return Node3 (N);
+ end Iterator_Filter;
+
function Iteration_Scheme
(N : Node_Id) return Node_Id is
begin
@@ -2235,6 +2244,7 @@ package body Sinfo is
(N : Node_Id) return Node_Id is
begin
pragma Assert (False
+ or else NT (N).Nkind = N_Iterated_Component_Association
or else NT (N).Nkind = N_Iteration_Scheme
or else NT (N).Nkind = N_Quantified_Expression);
return Node2 (N);
@@ -2358,7 +2368,7 @@ package body Sinfo is
pragma Assert (False
or else NT (N).Nkind = N_Component_Association
or else NT (N).Nkind = N_Iterated_Component_Association);
- return List2 (N);
+ return List5 (N);
end Loop_Actions;
function Loop_Parameter_Specification
@@ -5700,6 +5710,15 @@ package body Sinfo is
Set_Flag5 (N, Val);
end Set_Is_Write;
+ procedure Set_Iterator_Filter
+ (N : Node_Id; Val : Node_Id) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Iterator_Specification
+ or else NT (N).Nkind = N_Loop_Parameter_Specification);
+ Set_Node3_With_Parent (N, Val);
+ end Set_Iterator_Filter;
+
procedure Set_Iteration_Scheme
(N : Node_Id; Val : Node_Id) is
begin
@@ -5712,6 +5731,7 @@ package body Sinfo is
(N : Node_Id; Val : Node_Id) is
begin
pragma Assert (False
+ or else NT (N).Nkind = N_Iterated_Component_Association
or else NT (N).Nkind = N_Iteration_Scheme
or else NT (N).Nkind = N_Quantified_Expression);
Set_Node2_With_Parent (N, Val);
@@ -5835,7 +5855,7 @@ package body Sinfo is
pragma Assert (False
or else NT (N).Nkind = N_Component_Association
or else NT (N).Nkind = N_Iterated_Component_Association);
- Set_List2 (N, Val); -- semantic field, no parent set
+ Set_List5 (N, Val); -- semantic field, no parent set
end Set_Loop_Actions;
procedure Set_Loop_Parameter_Specification
@@ -1993,7 +1993,7 @@ package Sinfo is
-- N_Raise_xxx_Error nodes since the transformation of these nodes is
-- handled by the back end (using the N_Push/N_Pop mechanism).
- -- Loop_Actions (List2-Sem)
+ -- Loop_Actions (List5-Sem)
-- A list present in Component_Association nodes in array aggregates.
-- Used to collect actions that must be executed within the loop because
-- they may need to be evaluated anew each time through.
@@ -4123,8 +4123,8 @@ package Sinfo is
-- N_Component_Association
-- Sloc points to first selector name
-- Choices (List1)
- -- Loop_Actions (List2-Sem)
-- Expression (Node3) (empty if Box_Present)
+ -- Loop_Actions (List5-Sem)
-- Box_Present (Flag15)
-- Inherited_Discriminant (Flag13)
@@ -4222,9 +4222,10 @@ package Sinfo is
-- N_Iterated_Component_Association
-- Sloc points to FOR
-- Defining_Identifier (Node1)
- -- Loop_Actions (List2-Sem)
+ -- Iterator_Specification (Node2) (set to Empty if no Iterator_Spec)
-- Expression (Node3)
-- Discrete_Choices (List4)
+ -- Loop_Actions (List5-Sem)
-- Box_Present (Flag15)
-- Note that Box_Present is always False, but it is intentionally added
@@ -5081,11 +5082,15 @@ package Sinfo is
-- LOOP_PARAMETER_SPECIFICATION ::=
-- DEFINING_IDENTIFIER in [reverse] DISCRETE_SUBTYPE_DEFINITION
+ -- [Iterator_Filter]
+
+ -- Note; the optional Iterator_Filter is an Ada_2020 construct.
-- N_Loop_Parameter_Specification
-- Sloc points to first identifier
-- Defining_Identifier (Node1)
-- Reverse_Present (Flag15)
+ -- Iterator_Filter (Node3) (set to Empty if not present)
-- Discrete_Subtype_Definition (Node4)
-----------------------------------
@@ -5102,6 +5107,7 @@ package Sinfo is
-- Name (Node2)
-- Reverse_Present (Flag15)
-- Of_Present (Flag16)
+ -- Iterator_Filter (Node3) (set to Empty if not present)
-- Subtype_Indication (Node5)
-- Note: The Of_Present flag distinguishes the two forms
@@ -9826,6 +9832,9 @@ package Sinfo is
function Iteration_Scheme
(N : Node_Id) return Node_Id; -- Node2
+ function Iterator_Filter
+ (N : Node_Id) return Node_Id; -- Node3
+
function Iterator_Specification
(N : Node_Id) return Node_Id; -- Node2
@@ -9866,7 +9875,7 @@ package Sinfo is
(N : Node_Id) return Elist_Id; -- Elist1
function Loop_Actions
- (N : Node_Id) return List_Id; -- List2
+ (N : Node_Id) return List_Id; -- List5
function Loop_Parameter_Specification
(N : Node_Id) return Node_Id; -- Node4
@@ -10929,6 +10938,9 @@ package Sinfo is
procedure Set_Is_Write
(N : Node_Id; Val : Boolean := True); -- Flag5
+ procedure Set_Iterator_Filter
+ (N : Node_Id; Val : Node_Id); -- Node3
+
procedure Set_Iteration_Scheme
(N : Node_Id; Val : Node_Id); -- Node2
@@ -10972,7 +10984,7 @@ package Sinfo is
(N : Node_Id; Val : Elist_Id); -- Elist1
procedure Set_Loop_Actions
- (N : Node_Id; Val : List_Id); -- List2
+ (N : Node_Id; Val : List_Id); -- List5
procedure Set_Loop_Parameter_Specification
(N : Node_Id; Val : Node_Id); -- Node4
@@ -11876,17 +11888,17 @@ package Sinfo is
N_Component_Association =>
(1 => True, -- Choices (List1)
- 2 => False, -- Loop_Actions (List2-Sem)
+ 2 => False, -- unused
3 => True, -- Expression (Node3)
4 => False, -- unused
- 5 => False), -- unused
+ 5 => True), -- Loop_Actions (List5-Sem);
N_Iterated_Component_Association =>
(1 => True, -- Defining_Identifier (Node1)
- 2 => True, -- Loop_Actions (List2-Sem)
+ 2 => True, -- Iterator_Specification
3 => True, -- Expression (Node3)
4 => True, -- Discrete_Choices (List4)
- 5 => False), -- unused
+ 5 => True), -- Loop_Actions (List5-Sem);
N_Delta_Aggregate =>
(1 => False, -- Unused
@@ -12201,7 +12213,7 @@ package Sinfo is
2 => False, -- unused
3 => False, -- unused
4 => True, -- Discrete_Subtype_Definition (Node4)
- 5 => False), -- unused
+ 5 => True), -- Iterator_Filter (Node5)
N_Iterator_Specification =>
(1 => True, -- Defining_Identifier (Node1)
@@ -13430,6 +13442,7 @@ package Sinfo is
pragma Inline (Is_Task_Body_Procedure);
pragma Inline (Is_Task_Master);
pragma Inline (Is_Write);
+ pragma Inline (Iterator_Filter);
pragma Inline (Iteration_Scheme);
pragma Inline (Itype);
pragma Inline (Kill_Range_Check);
@@ -13794,6 +13807,7 @@ package Sinfo is
pragma Inline (Set_Is_Task_Body_Procedure);
pragma Inline (Set_Is_Task_Master);
pragma Inline (Set_Is_Write);
+ pragma Inline (Set_Iterator_Filter);
pragma Inline (Set_Iteration_Scheme);
pragma Inline (Set_Iterator_Specification);
pragma Inline (Set_Itype);