From 6d0dedfa0b2141a7f6fa94ebec3f2d7249593a0d Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Sun, 28 Jun 2020 15:11:33 -0400 Subject: [PATCH] [Ada] Improvements to implementation of Ada_2020 attribute Reduce gcc/ada/ * sem_attr.adb (Min_Max): Handle the case where attribute name (qualified by required type) appears as the reducer of a 'Reduce attribute reference. (Resolve_Attribute) : Handle properly the presence of a procedure or an attribute reference Min/Max as a reducer. * exp_attr.adb (Expand_Attribute_Reference) : New subprogram Build_Stat, to construct the combining statement which appears in the generated loop for Reduce, and which is either a function call when the reducer is a function or an attribute, or a procedure call when reducer is an appropriate procedure. BuilD_Stat is used both when the prefix of 'Reduce is a value sequence and when it is an object --- gcc/ada/exp_attr.adb | 97 ++++++++++++++++++++++++++++++++++++++++------------ gcc/ada/sem_attr.adb | 23 ++++++++++++- 2 files changed, 98 insertions(+), 22 deletions(-) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 75915a9..6f1f368 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -5619,40 +5619,101 @@ package body Exp_Attr is E2 : constant Node_Id := Next (E1); Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N); Typ : constant Entity_Id := Etype (N); + New_Loop : Node_Id; + Stat : Node_Id; + + function Build_Stat (Comp : Node_Id) return Node_Id; + -- The reducer can be a function, a procedure whose first + -- parameter is in-out, or an attribute that is a function, + -- which (for now) can only be Min/Max. This subprogram + -- builds the corresponding computation for the generated loop. + + ---------------- + -- Build_Stat -- + ---------------- + + function Build_Stat (Comp : Node_Id) return Node_Id is + begin + if Nkind (E1) = N_Attribute_Reference then + Stat := Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Bnn, Loc), + Expression => Make_Attribute_Reference (Loc, + Attribute_Name => Attribute_Name (E1), + Prefix => New_Copy (Prefix (E1)), + Expressions => New_List ( + New_Occurrence_Of (Bnn, Loc), + Comp))); + + elsif Ekind (Entity (E1)) = E_Procedure then + Stat := Make_Procedure_Call_Statement (Loc, + Name => New_Occurrence_Of (Entity (E1), Loc), + Parameter_Associations => New_List ( + New_Occurrence_Of (Bnn, Loc), + Comp)); + else + Stat := Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Bnn, Loc), + Expression => Make_Function_Call (Loc, + Name => New_Occurrence_Of (Entity (E1), Loc), + Parameter_Associations => New_List ( + New_Occurrence_Of (Bnn, Loc), + Comp))); + end if; + + return Stat; + end Build_Stat; -- If the prefix is an aggregate, its unique component is an -- Iterated_Element, and we create a loop out of its iterator. + -- The iterated_component_Association is parsed as a loop + -- parameter specification with "in" or as a container + -- iterator with "of". begin if Nkind (Prefix (N)) = N_Aggregate then declare Stream : constant Node_Id := First (Component_Associations (Prefix (N))); - Id : constant Node_Id := Defining_Identifier (Stream); Expr : constant Node_Id := Expression (Stream); - Ch : constant Node_Id := - First (Discrete_Choices (Stream)); + Id : constant Node_Id := Defining_Identifier (Stream); + It_Spec : constant Node_Id := + Iterator_Specification (Stream); + Ch : Node_Id; + Iter : Node_Id; + begin - New_Loop := Make_Loop_Statement (Loc, - Iteration_Scheme => + -- Iteration may be given by an element iterator: + + if Nkind (Stream) = N_Iterated_Component_Association + and then Present (It_Spec) + and then Of_Present (It_Spec) + then + Iter := + Make_Iteration_Scheme (Loc, + Iterator_Specification => + Relocate_Node (It_Spec), + Loop_Parameter_Specification => Empty); + + else + Ch := First (Discrete_Choices (Stream)); + Iter := Make_Iteration_Scheme (Loc, Iterator_Specification => Empty, Loop_Parameter_Specification => Make_Loop_Parameter_Specification (Loc, Defining_Identifier => New_Copy (Id), Discrete_Subtype_Definition => - Relocate_Node (Ch))), + Relocate_Node (Ch))); + end if; + + New_Loop := Make_Loop_Statement (Loc, + Iteration_Scheme => Iter, End_Label => Empty, - Statements => New_List ( - Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Bnn, Loc), - Expression => Make_Function_Call (Loc, - Name => New_Occurrence_Of (Entity (E1), Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (Bnn, Loc), - Relocate_Node (Expr)))))); + Statements => + New_List (Build_Stat (Relocate_Node (Expr)))); end; + else -- If the prefix is a name, we construct an element iterator -- over it. Its expansion will verify that it is an array or @@ -5677,13 +5738,7 @@ package body Exp_Attr is Loop_Parameter_Specification => Empty), End_Label => Empty, Statements => New_List ( - Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Bnn, Loc), - Expression => Make_Function_Call (Loc, - Name => New_Occurrence_Of (Entity (E1), Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (Bnn, Loc), - New_Occurrence_Of (Elem, Loc)))))); + Build_Stat (New_Occurrence_Of (Elem, Loc)))); end; end if; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 2890c0a..15d4738 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -2748,6 +2748,16 @@ package body Sem_Attr is procedure Min_Max is begin + -- Attribute can appear as function name in a reduction. + -- Semantic checks are performed later. + + if Nkind (Parent (N)) = N_Attribute_Reference + and then Attribute_Name (Parent (N)) = Name_Reduce + then + Set_Etype (N, P_Base_Type); + return; + end if; + Check_E2; Check_Scalar_Type; Resolve (E1, P_Base_Type); @@ -12019,6 +12029,11 @@ package body Sem_Attr is or else Present (Next_Formal (F2)) then return False; + + elsif Ekind (Op) = E_Procedure then + return Ekind (F1) = E_In_Out_Parameter + and then Covers (Typ, Etype (F1)); + else return (Ekind (Op) = E_Operator @@ -12042,13 +12057,19 @@ package body Sem_Attr is Get_Next_Interp (Index, It); end loop; + elsif Nkind (E1) = N_Attribute_Reference + and then (Attribute_Name (E1) = Name_Max + or else Attribute_Name (E1) = Name_Min) + then + Op := E1; + elsif Proper_Op (Entity (E1)) then Op := Entity (E1); Set_Etype (N, Typ); end if; if No (Op) then - Error_Msg_N ("No visible function for reduction", E1); + Error_Msg_N ("No visible subprogram for reduction", E1); end if; end; -- 2.7.4