[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) <Reduce>: Handle properly the presence of a
	procedure or an attribute reference Min/Max as a reducer.
	* exp_attr.adb (Expand_Attribute_Reference) <Reduce>: 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

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 75915a9d3a4143347a4b6c1b2288d77135eb9115..6f1f3682b019d67cf0a4618840b2bdb39795b4d7 100644 (file)
--- 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 2890c0a424dddaac42888c76f5a92b806c599b66..15d47386a0338c8b6be6d83394b7e8c515db52e0 100644 (file)
--- 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;