From ff49b8053d16b0a565a02400ac0db81e5fd8f2cd Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Sun, 17 May 2020 21:02:59 -0400 Subject: [PATCH] [Ada] Ada_2020 AI12-0250 : Implement Iterator filters. gcc/ada/ * par.adb (P_Iterator_Specification): Make public for use in other parser subprograms. * par-ch4.adb (P_Iterated_Component_Association): In Ada_2020, recognize use of Iterator_Specification in an element iterator. To simplify disambiguation between the two iterator forms, mark the component association as carrying an Iterator_Specification only when the element iterator (using "OF") is used. * par-ch5.adb (P_Loop_Parameter_Specification): In Ada_2020, parse iterator filter when present. (P_Iterator_Specification): Ditto. Remove declaration of P_Iterator_Specification, now in parent unit. * exp_ch5.adb (Expand_N_Loop_Statement): Apply Iterator filter when present. (Expand_Iterator_Loop_Over_Array): Ditto. (Expand_Iterator_Loop_Over_Container): Ditto. * sem_aggr.adb (Resolve_Array_Aggregate): Emit error nessage if an iterated component association includes a iterator specificcation with an element iterator, i.e. one that uses the OF keyword. * sem_ch5.adb (Analyze_Iterator_Specification): Analyze Iterator filter when present. (Analyze_Loop_Parameter_Specification): Ditto. * sinfo.adb: Suprogram bodies for new syntactic element Iterator_Filter. * sinfo.ads: Add Iterator_Filter to relevant nodes. Structure of Component_Association and Iteroted_Component_Association nodes is modified to take into account the possible presence of an iterator specification in the latter. --- gcc/ada/exp_ch5.adb | 33 +++++++++++++++++++++++++++++---- gcc/ada/par-ch4.adb | 38 +++++++++++++++++++++++++++++++++----- gcc/ada/par-ch5.adb | 24 +++++++++++++++++++----- gcc/ada/par.adb | 5 +++++ gcc/ada/sem_aggr.adb | 12 ++++++++++++ gcc/ada/sem_ch5.adb | 8 ++++++++ gcc/ada/sinfo.adb | 24 ++++++++++++++++++++++-- gcc/ada/sinfo.ads | 34 ++++++++++++++++++++++++---------- 8 files changed, 152 insertions(+), 26 deletions(-) diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 699252844da..e98fcf778ee 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -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. diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 0360212934c..e79abd1a8cf 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -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"); diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb index dd18ab0ff82..49ecb938ef1 100644 --- a/gcc/ada/par-ch5.adb +++ b/gcc/ada/par-ch5.adb @@ -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; diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 4978dc5b983..1dee1e7dfae 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -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. diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 9e2801adfcb..63cb7143c38 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -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 diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 4664df83aba..74ebc6a88d4 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -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. diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 7368db64ddd..7284a06b1da 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -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 diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 24149b6a624..1dd31b06c7d 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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); -- 2.30.2