Patchwork [Ada] Optimization of array aggregates

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 21, 2010, 10:06 a.m.
Message ID <20101021100611.GA18228@adacore.com>
Download mbox | patch
Permalink /patch/68563/
State New
Headers show

Comments

Arnaud Charlet - Oct. 21, 2010, 10:06 a.m.
This patch improves the handling of array aggregates with static components.
It allows constant folding of aggregates with a single association given by
an expanded name, and it allows in-place assignments for aggregates when the
array type has an index type that has a non-standard representation.

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-10-21  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Flatten): An association for a subtype may be an
	expanded name.
	(Safe_Left_Hand_Side): An unchecked conversion is part of a safe
	left-hand side if the expression is.
	(Is_Safe_Index): new predicate
	Minor clean up in identier names (Indices -> Indexes).
	* exp_ch3.adb (Expand_Freeze_Enumeration_Type): Indicate that the
	generated Rep_To_Pos function is a Pure_Function.
Duncan Sands - Oct. 21, 2010, 11:12 a.m.
Hi Arnaud,

> +      --  The Pure flag will be reset is the current context is not pure.

is the current context -> if the current context

> +      --  For optimization purposes and constant-folding, indicate that the
> +      --  Rep_To_Pos function can be considered free of side effects.


Ciao,

Duncan.
Robert Dewar - Oct. 21, 2010, 12:51 p.m.
On 10/21/2010 7:12 AM, Duncan Sands wrote:
> Hi Arnaud,
>
>> +      --  The Pure flag will be reset is the current context is not pure.
>
> is the current context ->  if the current context
>
>> +      --  For optimization purposes and constant-folding, indicate that the
>> +      --  Rep_To_Pos function can be considered free of side effects.
>
>
> Ciao,
>
> Duncan.

thanks for note, I actually did a bit more extensive surgery on
the comments in that area, we will check in patch later.

Patch

Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb	(revision 165755)
+++ exp_aggr.adb	(working copy)
@@ -227,7 +227,7 @@  package body Exp_Aggr is
       Index       : Node_Id;
       Into        : Node_Id;
       Scalar_Comp : Boolean;
-      Indices     : List_Id := No_List;
+      Indexes     : List_Id := No_List;
       Flist       : Node_Id := Empty) return List_Id;
    --  This recursive routine returns a list of statements containing the
    --  loops and assignments that are needed for the expansion of the array
@@ -244,7 +244,7 @@  package body Exp_Aggr is
    --
    --    Scalar_Comp is True if the component type of the aggregate is scalar.
    --
-   --    Indices is the current list of expressions used to index the
+   --    Indexes is the current list of expressions used to index the
    --    object we are writing into.
    --
    --    Flist is an expression representing the finalization list on which
@@ -701,7 +701,7 @@  package body Exp_Aggr is
       Index       : Node_Id;
       Into        : Node_Id;
       Scalar_Comp : Boolean;
-      Indices     : List_Id := No_List;
+      Indexes     : List_Id := No_List;
       Flist       : Node_Id := Empty) return List_Id
    is
       Loc          : constant Source_Ptr := Sloc (N);
@@ -728,7 +728,7 @@  package body Exp_Aggr is
       --  N to Build_Loop contains no sub-aggregates, then this function
       --  returns the assignment statement:
       --
-      --     Into (Indices, Ind) := Expr;
+      --     Into (Indexes, Ind) := Expr;
       --
       --  Otherwise we call Build_Code recursively
       --
@@ -741,7 +741,7 @@  package body Exp_Aggr is
       --  This routine returns the for loop statement
       --
       --     for J in Index_Base'(L) .. Index_Base'(H) loop
-      --        Into (Indices, J) := Expr;
+      --        Into (Indexes, J) := Expr;
       --     end loop;
       --
       --  Otherwise we call Build_Code recursively.
@@ -756,7 +756,7 @@  package body Exp_Aggr is
       --     J : Index_Base := L;
       --     while J < H loop
       --        J := Index_Base'Succ (J);
-      --        Into (Indices, J) := Expr;
+      --        Into (Indexes, J) := Expr;
       --     end loop;
       --
       --  Otherwise we call Build_Code recursively
@@ -942,7 +942,7 @@  package body Exp_Aggr is
          F : Entity_Id;
          A : Node_Id;
 
-         New_Indices  : List_Id;
+         New_Indexes  : List_Id;
          Indexed_Comp : Node_Id;
          Expr_Q       : Node_Id;
          Comp_Type    : Entity_Id := Empty;
@@ -982,13 +982,13 @@  package body Exp_Aggr is
       --  Start of processing for Gen_Assign
 
       begin
-         if No (Indices) then
-            New_Indices := New_List;
+         if No (Indexes) then
+            New_Indexes := New_List;
          else
-            New_Indices := New_Copy_List_Tree (Indices);
+            New_Indexes := New_Copy_List_Tree (Indexes);
          end if;
 
-         Append_To (New_Indices, Ind);
+         Append_To (New_Indexes, Ind);
 
          if Present (Flist) then
             F := New_Copy_Tree (Flist);
@@ -1014,7 +1014,7 @@  package body Exp_Aggr is
                    Index       => Next_Index (Index),
                    Into        => Into,
                    Scalar_Comp => Scalar_Comp,
-                   Indices     => New_Indices,
+                   Indexes     => New_Indexes,
                    Flist       => F));
          end if;
 
@@ -1024,7 +1024,7 @@  package body Exp_Aggr is
            Checks_Off
              (Make_Indexed_Component (Loc,
                 Prefix      => New_Copy_Tree (Into),
-                Expressions => New_Indices));
+                Expressions => New_Indexes));
 
          Set_Assignment_OK (Indexed_Comp);
 
@@ -1045,7 +1045,7 @@  package body Exp_Aggr is
             Comp_Type := Component_Type (Etype (N));
             pragma Assert (Comp_Type = Ctype); --  AI-287
 
-         elsif Present (Next (First (New_Indices))) then
+         elsif Present (Next (First (New_Indexes))) then
 
             --  Ada 2005 (AI-287): Do nothing in case of default initialized
             --  component because we have received the component type in
@@ -3946,9 +3946,9 @@  package body Exp_Aggr is
 
                      exit Component_Loop;
 
-                  --  Case of a subtype mark
+                  --  Case of a subtype mark, identifier or expanded name
 
-                  elsif Nkind (Choice) = N_Identifier
+                  elsif Is_Entity_Name (Choice)
                     and then Is_Type (Entity (Choice))
                   then
                      Lo := Type_Low_Bound  (Etype (Choice));
@@ -4217,7 +4217,7 @@  package body Exp_Aggr is
          Comp     : Node_Id;
          Decl     : Node_Id;
          Typ      : constant Entity_Id := Etype (N);
-         Indices  : constant List_Id   := New_List;
+         Indexes  : constant List_Id   := New_List;
          Num      : Int;
          Sub_Agg  : Node_Id;
 
@@ -4239,7 +4239,7 @@  package body Exp_Aggr is
                   Next (Comp);
                end loop;
 
-               Append_To (Indices,
+               Append_To (Indexes,
                  Make_Range (Loc,
                    Low_Bound =>  Make_Integer_Literal (Loc, 1),
                    High_Bound => Make_Integer_Literal (Loc, Num)));
@@ -4255,7 +4255,7 @@  package body Exp_Aggr is
                  Make_Range (Loc,
                     Low_Bound  => Aggr_Low  (D),
                     High_Bound => Aggr_High (D)),
-                 Indices);
+                 Indexes);
             end loop;
          end if;
 
@@ -4264,10 +4264,10 @@  package body Exp_Aggr is
                Defining_Identifier => Agg_Type,
                Type_Definition =>
                  Make_Constrained_Array_Definition (Loc,
-                   Discrete_Subtype_Definitions => Indices,
-                   Component_Definition =>
+                   Discrete_Subtype_Definitions => Indexes,
+                   Component_Definition         =>
                      Make_Component_Definition (Loc,
-                       Aliased_Present => False,
+                       Aliased_Present    => False,
                        Subtype_Indication =>
                          New_Occurrence_Of (Component_Type (Typ), Loc))));
 
@@ -4940,6 +4940,41 @@  package body Exp_Aggr is
       -------------------------
 
       function Safe_Left_Hand_Side (N : Node_Id) return Boolean is
+         function Is_Safe_Index (Indx : Node_Id) return Boolean;
+         --  If the left-hand side includes an indexed component, check that
+         --  the indexes are free of side-effect.
+
+         -------------------
+         -- Is_Safe_Index --
+         -------------------
+
+         function Is_Safe_Index (Indx : Node_Id) return Boolean is
+         begin
+            if Is_Entity_Name (Indx) then
+               return True;
+
+            elsif Nkind (Indx) = N_Integer_Literal then
+               return True;
+
+            elsif Nkind (Indx) = N_Function_Call
+              and then Is_Entity_Name (Name (Indx))
+              and then
+                Has_Pragma_Pure_Function (Entity (Name (Indx)))
+            then
+               return True;
+
+            elsif Nkind (Indx) = N_Type_Conversion
+              and then Is_Safe_Index (Expression (Indx))
+            then
+               return True;
+
+            else
+               return False;
+            end if;
+         end Is_Safe_Index;
+
+      --  Start of processing for Safe_Left_Hand_Side
+
       begin
          if Is_Entity_Name (N) then
             return True;
@@ -4952,10 +4987,13 @@  package body Exp_Aggr is
          elsif Nkind (N) = N_Indexed_Component
            and then Safe_Left_Hand_Side (Prefix (N))
            and then
-             (Is_Entity_Name (First (Expressions (N)))
-               or else Nkind (First (Expressions (N))) = N_Integer_Literal)
+             Is_Safe_Index (First (Expressions (N)))
          then
             return True;
+
+         elsif Nkind (N) = N_Unchecked_Type_Conversion then
+            return Safe_Left_Hand_Side (Expression (N));
+
          else
             return False;
          end if;
@@ -6101,7 +6139,7 @@  package body Exp_Aggr is
               Index       => First_Index (Typ),
               Into        => Target,
               Scalar_Comp => Is_Scalar_Type (Component_Type (Typ)),
-              Indices     => No_List,
+              Indexes     => No_List,
               Flist       => Flist);
       end if;
    end Late_Expansion;
Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb	(revision 165755)
+++ exp_ch3.adb	(working copy)
@@ -5858,6 +5858,11 @@  package body Exp_Ch3 is
 
       Set_TSS (Typ, Fent);
       Set_Is_Pure (Fent);
+      --  The Pure flag will be reset is the current context is not pure.
+      --  For optimization purposes and constant-folding, indicate that the
+      --  Rep_To_Pos function can be considered free of side effects.
+
+      Set_Has_Pragma_Pure_Function (Fent);
 
       if not Debug_Generated_Code then
          Set_Debug_Info_Off (Fent);