Patchwork [Ada] Simplify expansion of conditional expressions

login
register
mail settings
Submitter Arnaud Charlet
Date June 18, 2010, 9:30 a.m.
Message ID <20100618093019.GA17827@adacore.com>
Download mbox | patch
Permalink /patch/56155/
State New
Headers show

Comments

Arnaud Charlet - June 18, 2010, 9:30 a.m.
This patch does two things. First, if Use_Expressions_With_Actions is
set, then the normal case expansion of conditional actions is simplified
by using this node. Second if Back_End_Handles_Limited_Types is set,
then the special case expansion for limited types is eliminated.

The following test:

function EA_Cond_Expr
  (a, b, c : Integer; s : String) return Boolean
is
begin
   return (if b <= c then s (a .. b) = s (b .. c)
                     else s (a .. b) = s (c .. b));
end;

compiled with -gnatd.X to force use of Expression_With_Actions
(and also -gnatX -gnatpG) generates the following -gnatG output:

function ea_cond_expr (a : integer; b : integer; c : integer; s :
  string) return boolean is
   subtype ea_cond_expr__S1b is string (s'first(1) .. s'last(1));
begin
   return (if b <= c then
      do
         [subtype ea_cond_expr__T3b is integer range a .. b]
         [subtype ea_cond_expr__T4b is string (ea_cond_expr__T3b)]
         reference ea_cond_expr__T4b
         [subtype ea_cond_expr__T5b is integer range b .. c]
         [subtype ea_cond_expr__T6b is string (ea_cond_expr__T5b)]
         reference ea_cond_expr__T6b
      in s (a .. b) = s (b .. c) end
    else
      do
         [subtype ea_cond_expr__T7b is integer range a .. b]
         [subtype ea_cond_expr__T8b is string (ea_cond_expr__T7b)]
         reference ea_cond_expr__T8b
         [subtype ea_cond_expr__T9b is integer range c .. b]
         [subtype ea_cond_expr__T10b is string (ea_cond_expr__T9b)]
         reference ea_cond_expr__T10b
      in s (a .. b) = s (c .. b) end
   );
end ea_cond_expr;

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

2010-06-18  Robert Dewar  <dewar@adacore.com>

	* debug.adb: New debug flag -gnatd.L to control
	Back_End_Handles_Limited_Types.
	* exp_ch4.adb (Expand_N_Conditional_Expression): Let back end handle
	limited case if Back_End_Handles_Limited_Types is True.
	(Expand_N_Conditional_Expression): Use N_Expression_With_Actions to
	simplify expansion if Use_Expression_With_Actions is True.
	* gnat1drv.adb (Adjust_Global_Switches): Set
	Back_End_Handles_Limited_Types.
	* opt.ads (Back_End_Handles_Limited_Types): New flag.

Patch

Index: debug.adb
===================================================================
--- debug.adb	(revision 160959)
+++ debug.adb	(working copy)
@@ -76,7 +76,7 @@  package body Debug is
    --  dJ   Output debugging trace info for JGNAT (Java VM version of GNAT)
    --  dK   Kill all error messages
    --  dL   Output trace information on elaboration checking
-   --  dM   Asssume all variables are modified (no current values)
+   --  dM   Assume all variables are modified (no current values)
    --  dN   No file name information in exception messages
    --  dO   Output immediate error messages
    --  dP   Do not check for controlled objects in preelaborable packages
@@ -129,7 +129,7 @@  package body Debug is
    --  d.I  SCIL generation mode
    --  d.J  Parallel SCIL generation mode
    --  d.K
-   --  d.L
+   --  d.L  Depend on back end for limited types in conditional expressions
    --  d.M
    --  d.N
    --  d.O  Dump internal SCO tables
@@ -567,6 +567,11 @@  package body Debug is
    --       This means in particular not writing the same files under the
    --       same directory.
 
+   --  d.L  Normally the front end generates special expansion for conditional
+   --       expressions of a limited type. This debug flag removes this special
+   --       case expansion, leaving it up to the back end to handle conditional
+   --       expressions correctly.
+
    --  d.O  Dump internal SCO tables. Before outputting the SCO information to
    --       the ALI file, the internal SCO tables (SCO_Table/SCO_Unit_Table)
    --       are dumped for debugging purposes.
Index: gnat1drv.adb
===================================================================
--- gnat1drv.adb	(revision 160959)
+++ gnat1drv.adb	(working copy)
@@ -359,6 +359,30 @@  procedure Gnat1drv is
       else
          Use_Expression_With_Actions := False;
       end if;
+
+      --  Set switch indicating if back end can handle limited types, and
+      --  guarantee that no incorrect copies are made (e.g. in the context
+      --  of a conditional expression).
+
+      --  Debug flag -gnatd.L decisively sets usage on
+
+      if Debug_Flag_Dot_XX then
+         Back_End_Handles_Limited_Types := True;
+
+      --  If no debug flag, usage off for AAMP, VM, SCIL cases
+
+      elsif AAMP_On_Target
+        or else VM_Target /= No_VM
+        or else Generate_SCIL
+      then
+         Back_End_Handles_Limited_Types := False;
+
+         --  Otherwise normal gcc back end, for now still turn flag off by
+         --  default, since we have not verified proper back end handling.
+
+      else
+         Back_End_Handles_Limited_Types := False;
+      end if;
    end Adjust_Global_Switches;
 
    --------------------
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 160959)
+++ exp_ch4.adb	(working copy)
@@ -3882,7 +3882,7 @@  package body Exp_Ch4 is
    -- Expand_N_Conditional_Expression --
    -------------------------------------
 
-   --  Expand into expression actions if then/else actions present
+   --  Deal with limited types and expression actions
 
    procedure Expand_N_Conditional_Expression (N : Node_Id) is
       Loc    : constant Source_Ptr := Sloc (N);
@@ -3898,26 +3898,11 @@  package body Exp_Ch4 is
       P_Decl : Node_Id;
 
    begin
-      --  If either then or else actions are present, then given:
+      --  If the type is limited or unconstrained, we expand as follows to
+      --  avoid any possibility of improper copies.
 
-      --     if cond then then-expr else else-expr end
-
-      --  we insert the following sequence of actions (using Insert_Actions):
-
-      --      Cnn : typ;
-      --      if cond then
-      --         <<then actions>>
-      --         Cnn := then-expr;
-      --      else
-      --         <<else actions>>
-      --         Cnn := else-expr
-      --      end if;
-
-      --  and replace the conditional expression by a reference to Cnn
-
-      --  If the type is limited or unconstrained, the above expansion is
-      --  not legal, because it involves either an uninitialized object
-      --  or an illegal assignment. Instead, we generate:
+      --  Note: it may be possible to avoid this special processing if the
+      --  back end uses its own mechanisms for handling by-reference types ???
 
       --      type Ptr is access all Typ;
       --      Cnn : Ptr;
@@ -3931,7 +3916,12 @@  package body Exp_Ch4 is
 
       --  and replace the conditional expresion by a reference to Cnn.all.
 
-      if Is_By_Reference_Type (Typ) then
+      --  This special case can be skipped if the back end handles limited
+      --  types properly and ensures that no incorrect copies are made.
+
+      if Is_By_Reference_Type (Typ)
+        and then not Back_End_Handles_Limited_Types
+      then
          Cnn := Make_Temporary (Loc, 'C', N);
 
          P_Decl :=
@@ -3979,40 +3969,82 @@  package body Exp_Ch4 is
       --  associated with either branch.
 
       elsif Present (Then_Actions (N)) or else Present (Else_Actions (N)) then
-         Cnn := Make_Temporary (Loc, 'C', N);
 
-         Decl :=
-           Make_Object_Declaration (Loc,
-             Defining_Identifier => Cnn,
-             Object_Definition   => New_Occurrence_Of (Typ, Loc));
+         --  We have two approaches to handling this. If we are allowed to use
+         --  N_Expression_With_Actions, then we can just wrap the actions into
+         --  the appropriate expression.
+
+         if Use_Expression_With_Actions then
+            if Present (Then_Actions (N)) then
+               Rewrite (Thenx,
+                 Make_Expression_With_Actions (Sloc (Thenx),
+                   Actions    => Then_Actions (N),
+                   Expression => Relocate_Node (Thenx)));
+               Analyze_And_Resolve (Thenx, Typ);
+            end if;
 
-         New_If :=
-           Make_Implicit_If_Statement (N,
-             Condition => Relocate_Node (Cond),
+            if Present (Else_Actions (N)) then
+               Rewrite (Elsex,
+                 Make_Expression_With_Actions (Sloc (Elsex),
+                   Actions    => Else_Actions (N),
+                   Expression => Relocate_Node (Elsex)));
+               Analyze_And_Resolve (Elsex, Typ);
+            end if;
 
-             Then_Statements => New_List (
-               Make_Assignment_Statement (Sloc (Thenx),
-                 Name       => New_Occurrence_Of (Cnn, Sloc (Thenx)),
-                 Expression => Relocate_Node (Thenx))),
+            return;
 
-             Else_Statements => New_List (
-               Make_Assignment_Statement (Sloc (Elsex),
-                 Name       => New_Occurrence_Of (Cnn, Sloc (Elsex)),
-                 Expression => Relocate_Node (Elsex))));
+            --  if we can't use N_Expression_With_Actions nodes, then we insert
+            --  the following sequence of actions (using Insert_Actions):
 
-         Set_Assignment_OK (Name (First (Then_Statements (New_If))));
-         Set_Assignment_OK (Name (First (Else_Statements (New_If))));
+            --      Cnn : typ;
+            --      if cond then
+            --         <<then actions>>
+            --         Cnn := then-expr;
+            --      else
+            --         <<else actions>>
+            --         Cnn := else-expr
+            --      end if;
 
-         New_N := New_Occurrence_Of (Cnn, Loc);
+            --  and replace the conditional expression by a reference to Cnn
 
-      else
-         --  No expansion needed, gigi handles it like a C conditional
-         --  expression.
+         else
+            Cnn := Make_Temporary (Loc, 'C', N);
+
+            Decl :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Cnn,
+                Object_Definition   => New_Occurrence_Of (Typ, Loc));
 
+            New_If :=
+              Make_Implicit_If_Statement (N,
+                Condition       => Relocate_Node (Cond),
+
+                Then_Statements => New_List (
+                  Make_Assignment_Statement (Sloc (Thenx),
+                    Name       => New_Occurrence_Of (Cnn, Sloc (Thenx)),
+                    Expression => Relocate_Node (Thenx))),
+
+                Else_Statements => New_List (
+                  Make_Assignment_Statement (Sloc (Elsex),
+                    Name       => New_Occurrence_Of (Cnn, Sloc (Elsex)),
+                    Expression => Relocate_Node (Elsex))));
+
+            Set_Assignment_OK (Name (First (Then_Statements (New_If))));
+            Set_Assignment_OK (Name (First (Else_Statements (New_If))));
+
+            New_N := New_Occurrence_Of (Cnn, Loc);
+         end if;
+
+         --  If no actions then no expansion needed, gigi will handle it using
+         --  the same approach as a C conditional expression.
+
+      else
          return;
       end if;
 
-      --  Move the SLOC of the parent If statement to the newly created one and
+      --  Fall through here for either the limited expansion, or the case of
+      --  inserting actions for non-limited types. In both these cases, we must
+      --  move the SLOC of the parent If statement to the newly created one and
       --  change it to the SLOC of the expression which, after expansion, will
       --  correspond to what is being evaluated.
 
Index: opt.ads
===================================================================
--- opt.ads	(revision 160959)
+++ opt.ads	(working copy)
@@ -172,6 +172,15 @@  package Opt is
    --  also set true if certain Unchecked_Conversion instantiations require
    --  checking based on annotated values.
 
+   Back_End_Handles_Limited_Types : Boolean;
+   --  This flag is set true if the back end can properly handle limited or
+   --  other by reference types, and avoid copies. If this flag is False, then
+   --  the front end does special expansion for conditional expressions to make
+   --  sure that no copy occurs. If the flag is True, then the expansion for
+   --  conditional expressions relies on the back end properly handling things.
+   --  Currently the default is False for all cases (set in gnat1drv). The
+   --  default can be modified using -gnatd.L (sets the flag True).
+
    Bind_Alternate_Main_Name : Boolean := False;
    --  GNATBIND
    --  True if main should be called Alternate_Main_Name.all.
@@ -1239,12 +1248,12 @@  package Opt is
    --  Set to True if -h (-gnath for the compiler) switch encountered
    --  requesting usage information
 
-   Use_Expression_With_Actions : Boolean := False;
+   Use_Expression_With_Actions : Boolean;
    --  The N_Expression_With_Actions node has been introduced relatively
    --  recently, and not all back ends are prepared to handle it yet. So
    --  we use this flag to suppress its use during a transitional period.
-   --  Currently the default is False for all cases except the standard
-   --  GCC back end. The default can be modified using -gnatd.X/-gnatd.Y.
+   --  Currently the default is False for all cases (set in gnat1drv).
+   --  The default can be modified using -gnatd.X/-gnatd.Y.
 
    Use_Pragma_Linker_Constructor : Boolean := False;
    --  GNATBIND