From: Arnaud Charlet Date: Wed, 3 Jun 2020 07:42:19 +0000 (-0400) Subject: [Ada] Ongoing work for AI12-0212: container aggregates X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8092c19930b6cdf3087825f9063cb830cd2de479;p=gcc.git [Ada] Ongoing work for AI12-0212: container aggregates gcc/ada/ * par-ch4.adb (P_Iterated_Component_Association): Extended to recognzize the similar Iterated_Element_Association. This node is only generated when an explicit Key_Expression is given. Otherwise the distinction between the two iterated forms is done during semantic analysis. * sinfo.ads: New node N_Iterated_Element_Association, for Ada202x container aggregates. New field Key_Expression. * sinfo.adb: Subprograms for new node and newn field. * sem_aggr.adb (Resolve_Iterated_Component_Association): Handle the case where the Iteration_Scheme is an Iterator_Specification. * exp_aggr.adb (Wxpand_Iterated_Component): Handle a component with an Iterated_Component_Association, generate proper loop using given Iterator_Specification. * exp_util.adb (Insert_Axtions): Handle new node as other aggregate components. * sem.adb, sprint.adb: Handle new node. * tbuild.adb (Make_Implicit_Loop_Statement): Handle properly a loop with an Iterator_ specification. --- diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 6d58c8c5913..6d8919127d9 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -6914,13 +6914,20 @@ package body Exp_Aggr is Stats : List_Id; begin - L_Range := Relocate_Node (First (Discrete_Choices (Comp))); - L_Iteration_Scheme := - Make_Iteration_Scheme (Loc, - Loop_Parameter_Specification => - Make_Loop_Parameter_Specification (Loc, - Defining_Identifier => Loop_Id, - Discrete_Subtype_Definition => L_Range)); + if 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))); + L_Iteration_Scheme := + Make_Iteration_Scheme (Loc, + Loop_Parameter_Specification => + Make_Loop_Parameter_Specification (Loc, + Defining_Identifier => Loop_Id, + Discrete_Subtype_Definition => L_Range)); + end if; -- Build insertion statement. For a positional aggregate, only the -- expression is needed. For a named aggregate, the loop variable, diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 27609c78363..0bbab9cd74e 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -7346,6 +7346,7 @@ package body Exp_Util is when N_Component_Association | N_Iterated_Component_Association + | N_Iterated_Element_Association => if Nkind (Parent (P)) = N_Aggregate and then Present (Loop_Actions (P)) diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 4e48a492b5e..2c74cd7cd86 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -3407,6 +3407,8 @@ package body Ch4 is function P_Iterated_Component_Association return Node_Id is Assoc_Node : Node_Id; Id : Node_Id; + Iter_Spec : Node_Id; + Loop_Spec : Node_Id; State : Saved_Scan_State; -- Start of processing for P_Iterated_Component_Association @@ -3423,6 +3425,9 @@ package body Ch4 is -- if E is a subtype 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. + -- In addition, if "use" is present after the specification, + -- this is an Iterated_Element_Association that carries a + -- key_expression, and we generate the appropriate node. Id := P_Defining_Identifier; Assoc_Node := @@ -3432,6 +3437,22 @@ package body Ch4 is Set_Defining_Identifier (Assoc_Node, Id); T_In; Set_Discrete_Choices (Assoc_Node, P_Discrete_Choice_List); + + if Token = Tok_Use then + + -- 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))); + Set_Loop_Parameter_Specification (Assoc_Node, Loop_Spec); + Set_Key_Expression (Assoc_Node, P_Expression); + end if; + TF_Arrow; Set_Expression (Assoc_Node, P_Expression); @@ -3441,8 +3462,19 @@ package body Ch4 is Restore_Scan_State (State); Scan; -- past OF Set_Defining_Identifier (Assoc_Node, Id); - Set_Iterator_Specification - (Assoc_Node, P_Iterator_Specification (Id)); + Iter_Spec := P_Iterator_Specification (Id); + Set_Iterator_Specification (Assoc_Node, Iter_Spec); + + if Token = Tok_Use then + Scan; -- past USE + -- This is an iterated_elenent_qssociation. + + Assoc_Node := + New_Node (N_Iterated_Element_Association, Prev_Token_Ptr); + Set_Iterator_Specification (Assoc_Node, Iter_Spec); + Set_Key_Expression (Assoc_Node, P_Expression); + end if; + TF_Arrow; Set_Expression (Assoc_Node, P_Expression); end if; diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 425dafa55d3..5474e081393 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -670,6 +670,9 @@ package body Sem is when N_Iterated_Component_Association => Diagnose_Iterated_Component_Association (N); + when N_Iterated_Element_Association => + null; -- May require a more precise error if misplaced. + -- For the remaining node types, we generate compiler abort, because -- these nodes are always analyzed within the Sem_Chn routines and -- there should never be a case of making a call to the main Analyze diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index d2419d9bde5..a89d55a5cc1 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -2677,36 +2677,39 @@ package body Sem_Aggr is Ent : Entity_Id; Expr : Node_Id; Id : Entity_Id; + Iter : Node_Id; Typ : Entity_Id := Empty; begin if Present (Iterator_Specification (Comp)) then - Error_Msg_N ("element iterator ins aggregate Forthcoming", N); - return; - end if; + Iter := Copy_Separate_Tree (Iterator_Specification (Comp)); + Analyze (Iter); + Typ := Etype (Defining_Identifier (Iter)); - Choice := First (Discrete_Choices (Comp)); + else + Choice := First (Discrete_Choices (Comp)); - while Present (Choice) loop - Analyze (Choice); + while Present (Choice) loop + Analyze (Choice); - -- Choice can be a subtype name, a range, or an expression + -- 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 (Key_Type) - then - null; + if Is_Entity_Name (Choice) + and then Is_Type (Entity (Choice)) + and then Base_Type (Entity (Choice)) = Base_Type (Key_Type) + then + null; - elsif Present (Key_Type) then - Analyze_And_Resolve (Choice, Key_Type); + elsif Present (Key_Type) then + Analyze_And_Resolve (Choice, Key_Type); - else - Typ := Etype (Choice); -- assume unique for now - end if; + else + Typ := Etype (Choice); -- assume unique for now + 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 diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 9199af4e6ad..2d4b93ec52e 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -1278,6 +1278,7 @@ package body Sinfo is or else NT (N).Nkind = N_Expression_With_Actions or else NT (N).Nkind = N_Free_Statement or else NT (N).Nkind = N_Iterated_Component_Association + or else NT (N).Nkind = N_Iterated_Element_Association or else NT (N).Nkind = N_Mod_Clause or else NT (N).Nkind = N_Modular_Type_Definition or else NT (N).Nkind = N_Number_Declaration @@ -2245,6 +2246,7 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Iterated_Component_Association + or else NT (N).Nkind = N_Iterated_Element_Association or else NT (N).Nkind = N_Iteration_Scheme or else NT (N).Nkind = N_Quantified_Expression); return Node2 (N); @@ -2258,6 +2260,14 @@ package body Sinfo is return Node1 (N); end Itype; + function Key_Expression + (N : Node_Id) return Node_Id is + begin + pragma Assert (False + or else NT (N).Nkind = N_Iterated_Element_Association); + return Node1 (N); + end Key_Expression; + function Kill_Range_Check (N : Node_Id) return Boolean is begin @@ -2367,7 +2377,8 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Component_Association - or else NT (N).Nkind = N_Iterated_Component_Association); + or else NT (N).Nkind = N_Iterated_Component_Association + or else NT (N).Nkind = N_Iterated_Element_Association); return List5 (N); end Loop_Actions; @@ -2375,6 +2386,7 @@ package body Sinfo is (N : Node_Id) return Node_Id is begin pragma Assert (False + or else NT (N).Nkind = N_Iterated_Element_Association or else NT (N).Nkind = N_Iteration_Scheme or else NT (N).Nkind = N_Quantified_Expression); return Node4 (N); @@ -4762,6 +4774,7 @@ package body Sinfo is or else NT (N).Nkind = N_Expression_With_Actions or else NT (N).Nkind = N_Free_Statement or else NT (N).Nkind = N_Iterated_Component_Association + or else NT (N).Nkind = N_Iterated_Element_Association or else NT (N).Nkind = N_Mod_Clause or else NT (N).Nkind = N_Modular_Type_Definition or else NT (N).Nkind = N_Number_Declaration @@ -5733,6 +5746,7 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Iterated_Component_Association + or else NT (N).Nkind = N_Iterated_Element_Association or else NT (N).Nkind = N_Iteration_Scheme or else NT (N).Nkind = N_Quantified_Expression); Set_Node2_With_Parent (N, Val); @@ -5746,6 +5760,14 @@ package body Sinfo is Set_Node1 (N, Val); -- no parent, semantic field end Set_Itype; + procedure Set_Key_Expression + (N : Node_Id; Val : Entity_Id) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Iterated_Element_Association); + Set_Node1_With_Parent (N, Val); + end Set_Key_Expression; + procedure Set_Kill_Range_Check (N : Node_Id; Val : Boolean := True) is begin @@ -5855,7 +5877,8 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Component_Association - or else NT (N).Nkind = N_Iterated_Component_Association); + or else NT (N).Nkind = N_Iterated_Component_Association + or else NT (N).Nkind = N_Iterated_Element_Association); Set_List5 (N, Val); -- semantic field, no parent set end Set_Loop_Actions; @@ -5863,6 +5886,7 @@ package body Sinfo is (N : Node_Id; Val : Node_Id) is begin pragma Assert (False + or else NT (N).Nkind = N_Iterated_Element_Association or else NT (N).Nkind = N_Iteration_Scheme or else NT (N).Nkind = N_Quantified_Expression); Set_Node4_With_Parent (N, Val); diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 9ae8ce790bc..98dd462a859 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -4241,6 +4241,26 @@ package Sinfo is -- Component_Associations (List2) -- Etype (Node5-Sem) + --------------------------------- + -- 3.4.5 Comtainer_Aggregates -- + --------------------------------- + + -- N_Iterated_Element_Association + -- Key_Expression (Node1) + -- Iterator_Specification (Node2) + -- Expression (Node3) + -- Loop_Parameter_Specification (Node4) + -- Loop_Actions (List5-Sem) + + -- Exactly one of Iterator_Specification or Loop_Parameter_ + -- specification is present. If the Key_Expression is absent, + -- the construct is parsed as an Iterated_Component_Association, + -- and legality checks are performed during semantic analysis. + + -- Both iterated associations are Ada2020 features that are + -- expanded during aggregate construction, and do not appear in + -- expanded code. + -------------------------------------------------- -- 4.4 Expression/Relation/Term/Factor/Primary -- -------------------------------------------------- @@ -8917,6 +8937,7 @@ package Sinfo is N_Handled_Sequence_Of_Statements, N_Index_Or_Discriminant_Constraint, N_Iterated_Component_Association, + N_Iterated_Element_Association, N_Itype_Reference, N_Label, N_Modular_Type_Definition, @@ -9842,6 +9863,9 @@ package Sinfo is function Itype (N : Node_Id) return Entity_Id; -- Node1 + function Key_Expression + (N : Node_Id) return Node_Id; -- Node1 + function Kill_Range_Check (N : Node_Id) return Boolean; -- Flag11 @@ -10951,6 +10975,9 @@ package Sinfo is procedure Set_Itype (N : Node_Id; Val : Entity_Id); -- Node1 + procedure Set_Key_Expression + (N : Node_Id; Val : Node_Id); -- Node1 + procedure Set_Kill_Range_Check (N : Node_Id; Val : Boolean := True); -- Flag11 @@ -11901,6 +11928,13 @@ package Sinfo is 4 => True, -- Discrete_Choices (List4) 5 => True), -- Loop_Actions (List5-Sem); + N_Iterated_Element_Association => + (1 => True, -- Key_expression + 2 => True, -- Iterator_Specification + 3 => True, -- Expression (Node3) + 4 => True, -- Loop_Parameter_Specification + 5 => True), -- Loop_Actions (List5-Sem); + N_Delta_Aggregate => (1 => False, -- Unused 2 => True, -- Component_Associations (List2) @@ -13446,6 +13480,7 @@ package Sinfo is pragma Inline (Iterator_Filter); pragma Inline (Iteration_Scheme); pragma Inline (Itype); + pragma Inline (Key_Expression); pragma Inline (Kill_Range_Check); pragma Inline (Last_Bit); pragma Inline (Last_Name); @@ -13812,6 +13847,7 @@ package Sinfo is pragma Inline (Set_Iteration_Scheme); pragma Inline (Set_Iterator_Specification); pragma Inline (Set_Itype); + pragma Inline (Set_Key_Expression); pragma Inline (Set_Kill_Range_Check); pragma Inline (Set_Label_Construct); pragma Inline (Set_Last_Bit); diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 8fc91fdc39f..a76b62e219a 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -1325,6 +1325,22 @@ package body Sprint is Write_Str (" => "); Sprint_Node (Expression (Node)); + when N_Iterated_Element_Association => + Set_Debug_Sloc; + if Present (Iterator_Specification (Node)) then + Sprint_Node (Iterator_Specification (Node)); + else + Sprint_Node (Loop_Parameter_Specification (Node)); + end if; + + if Present (Key_Expression (Node)) then + Write_Str (" use "); + Sprint_Node (Key_Expression (Node)); + end if; + + Write_Str (" => "); + Sprint_Node (Expression (Node)); + when N_Component_Clause => Write_Indent; Sprint_Node (Component_Name (Node)); diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb index 140cb215d4f..212d31553dc 100644 --- a/gcc/ada/tbuild.adb +++ b/gcc/ada/tbuild.adb @@ -352,6 +352,7 @@ package body Tbuild is Check_Restriction (No_Implicit_Loops, Node); if Present (Iteration_Scheme) + and then Nkind (Iteration_Scheme) /= N_Iterator_Specification and then Present (Condition (Iteration_Scheme)) then Check_Restriction (No_Implicit_Conditionals, Node);