public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-7851] ada: Use accumulator type in expansion of 'Reduce attribute
@ 2023-09-27  8:23 Eric Botcazou
  0 siblings, 0 replies; only message in thread
From: Eric Botcazou @ 2023-09-27  8:23 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:37c502489a29dcf2ff62d89f57798987581b2aad

commit r13-7851-g37c502489a29dcf2ff62d89f57798987581b2aad
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Thu Jan 26 15:59:37 2023 +0100

    ada: Use accumulator type in expansion of 'Reduce attribute
    
    The current expansion of the 'Reduce attribute uses the resolution type of
    the expression for the accumulator. Now this type can be unresolved or set
    to a universal type, for example if it is itself the prefix of the 'Image
    attribute, and this may yield a spurious type mismatch error in that case.
    
    This changes the expansion to use the accumulator type instead as defined
    by the RM 4.5.10 clause, albeit only in the prefixed case for now.
    
    gcc/ada/
    
            * exp_attr.adb (Expand_N_Attribute_Reference) <Attribute_Reduce>:
            Use the canonical accumulator type as the type of the accumulator
            in the prefixed case.

Diff:
---
 gcc/ada/exp_attr.adb | 72 ++++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 62 insertions(+), 10 deletions(-)

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index aababd516d5..7e71422eba3 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -5978,27 +5978,30 @@ package body Exp_Attr is
       when Attribute_Reduce =>
          declare
             Loc : constant Source_Ptr := Sloc (N);
-            E1  : constant Node_Id := First (Expressions (N));
-            E2  : constant Node_Id := Next (E1);
-            Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
-            Typ : constant Entity_Id := Etype (N);
+            E1  : constant Node_Id    := First (Expressions (N));
+            E2  : constant Node_Id    := Next (E1);
+            Bnn : constant Entity_Id  := Make_Temporary (Loc, 'B', N);
 
-            New_Loop : Node_Id;
-            Stat     : Node_Id;
+            Accum_Typ : Entity_Id;
+            New_Loop  : 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.
+            --  builds the corresponding computation for the generated loop
+            --  and retrieves the accumulator type as per RM 4.5.10(19/5).
 
             ----------------
             -- Build_Stat --
             ----------------
 
             function Build_Stat (Comp : Node_Id) return Node_Id is
+               Stat : Node_Id;
+
             begin
                if Nkind (E1) = N_Attribute_Reference then
+                  Accum_Typ := Entity (Prefix (E1));
                   Stat := Make_Assignment_Statement (Loc,
                             Name => New_Occurrence_Of (Bnn, Loc),
                             Expression => Make_Attribute_Reference (Loc,
@@ -6009,12 +6012,14 @@ package body Exp_Attr is
                                 Comp)));
 
                elsif Ekind (Entity (E1)) = E_Procedure then
+                  Accum_Typ := Etype (First_Formal (Entity (E1)));
                   Stat := Make_Procedure_Call_Statement (Loc,
                             Name => New_Occurrence_Of (Entity (E1), Loc),
                                Parameter_Associations => New_List (
                                  New_Occurrence_Of (Bnn, Loc),
                                  Comp));
                else
+                  Accum_Typ := Etype (Entity (E1));
                   Stat := Make_Assignment_Statement (Loc,
                             Name => New_Occurrence_Of (Bnn, Loc),
                             Expression => Make_Function_Call (Loc,
@@ -6074,6 +6079,13 @@ package body Exp_Attr is
                       End_Label => Empty,
                       Statements =>
                         New_List (Build_Stat (Relocate_Node (Expr))));
+
+                  --  If the reducer subprogram is a universal operator, then
+                  --  we still look at the context to find the type for now.
+
+                  if Is_Universal_Numeric_Type (Accum_Typ) then
+                     Accum_Typ := Etype (N);
+                  end if;
                end;
 
             else
@@ -6082,9 +6094,10 @@ package body Exp_Attr is
                --  a container with the proper aspects.
 
                declare
-                  Iter : Node_Id;
                   Elem : constant Entity_Id := Make_Temporary (Loc, 'E', N);
 
+                  Iter : Node_Id;
+
                begin
                   Iter :=
                     Make_Iterator_Specification (Loc,
@@ -6101,6 +6114,44 @@ package body Exp_Attr is
                       End_Label => Empty,
                       Statements => New_List (
                         Build_Stat (New_Occurrence_Of (Elem, Loc))));
+
+                  --  If the reducer subprogram is a universal operator, then
+                  --  we need to look at the prefix to find the type. This is
+                  --  modeled on Analyze_Iterator_Specification in Sem_Ch5.
+
+                  if Is_Universal_Numeric_Type (Accum_Typ) then
+                     declare
+                        Ptyp : constant Entity_Id :=
+                                 Base_Type (Etype (Prefix (N)));
+
+                     begin
+                        if Is_Array_Type (Ptyp) then
+                           Accum_Typ := Component_Type (Ptyp);
+
+                        elsif Has_Aspect (Ptyp, Aspect_Iterable) then
+                           declare
+                              Element : constant Entity_Id :=
+                                          Get_Iterable_Type_Primitive
+                                            (Ptyp, Name_Element);
+                           begin
+                              if Present (Element) then
+                                 Accum_Typ := Etype (Element);
+                              end if;
+                           end;
+
+                        else
+                           declare
+                              Element : constant Node_Id :=
+                                          Find_Value_Of_Aspect
+                                            (Ptyp, Aspect_Iterator_Element);
+                           begin
+                              if Present (Element) then
+                                 Accum_Typ := Entity (Element);
+                              end if;
+                           end;
+                        end if;
+                     end;
+                  end if;
                end;
             end if;
 
@@ -6110,10 +6161,11 @@ package body Exp_Attr is
                    Make_Object_Declaration (Loc,
                      Defining_Identifier => Bnn,
                      Object_Definition   =>
-                       New_Occurrence_Of (Typ, Loc),
+                       New_Occurrence_Of (Accum_Typ, Loc),
                      Expression => Relocate_Node (E2)), New_Loop),
                  Expression => New_Occurrence_Of (Bnn, Loc)));
-            Analyze_And_Resolve (N, Typ);
+
+            Analyze_And_Resolve (N, Accum_Typ);
          end;
 
       ----------

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2023-09-27  8:23 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-09-27  8:23 [gcc r13-7851] ada: Use accumulator type in expansion of 'Reduce attribute Eric Botcazou

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).