From: Ed Schonberg Date: Tue, 27 Jul 2021 14:55:07 +0000 (-0400) Subject: [Ada] Ada2022: implementation of AI12-0212 : iterator specs in array aggregates X-Git-Tag: upstream/12.2.0~4846 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=fe43084ca31636ee5c997cc9c37f88e71a59293c;p=platform%2Fupstream%2Fgcc.git [Ada] Ada2022: implementation of AI12-0212 : iterator specs in array aggregates gcc/ada/ * sem_aggr.adb (Resolve_Array_Aggregate): Check the validity of an array aggregate all of whose components are iterated component associations. * exp_aggr.adb (Expand_Array_Aggregate, Two_Pass_Aggregate_Expansion): implement two-pass algorithm and replace original aggregate with resulting temporary, to ensure that a proper length check is performed if context is constrained. Use attributes Pos and Val to handle index types of any discrete type. --- diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 63a0666..a16ee9e 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -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 := diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 23d5ba2..732f0f3 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -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