Patchwork [Ada] Constant-folding and mutable discriminants

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 5, 2010, 9:27 a.m.
Message ID <20100805092702.GA1458@adacore.com>
Download mbox | patch
Permalink /patch/60942/
State New
Headers show

Comments

Arnaud Charlet - Aug. 5, 2010, 9:27 a.m.
If a selected component denotes the discriminant of a constrained object it is
some times possible to replace the reference with the known discriminant value.
This optimization is disabled if the discriminant is in any way mutable, for
example the discriminant of a type with default discriminants, and when the
reference is the name in a renaming declaration. With this patch the compiler
also handles properly the case where the reference denotes the discriminant of
a constrained component of a record, where the inner discriminant may be
constrained by the outer one, and the outer one may be mutable.

The following must execute quietly:

---
procedure Mutable_Discrim is
   subtype Index is Integer range 0 .. 255;

   type T1 (Hi1 : Index) is
     record F1 : String (1 .. Hi1); end record;

   type T2 (Hi2 : Index := 0) is
      record F2 : T1 (Hi1 => Hi2); end record;

   X : T2 := (3, (3, "cat"));

   Hi1_Ren : Natural renames X.F2.Hi1;
begin
   pragma Assert (Hi1_Ren = 3);
   X := (4, (4, "goat"));
   pragma Assert (Hi1_Ren = 4);
end Mutable_Discrim;

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

2010-08-05  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_N_Selected_Component): Do not constant-fold a
	selected component that denotes a discriminant if it is the
	discriminant of a component of an unconstrained record type.

Patch

Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 162907)
+++ exp_ch4.adb	(working copy)
@@ -7463,7 +7463,7 @@  package body Exp_Ch4 is
                null;
 
             --  Don't do this optimization for the prefix of an attribute or
-            --  the operand of an object renaming declaration since these are
+            --  the name of an object renaming declaration since these are
             --  contexts where we do not want the value anyway.
 
             elsif (Nkind (Par) = N_Attribute_Reference
@@ -7472,6 +7472,18 @@  package body Exp_Ch4 is
             then
                null;
 
+            --  If this is a discriminant of a component of a mutable record,
+            --  or a renaming of such, no optimization is possible, and value
+            --  must be retrieved anew. Note that in the previous case we may
+            --  be dealing with a renaming declaration, while here we may have
+            --  a use of a renaming.
+
+            elsif Nkind (P) = N_Selected_Component
+              and then Is_Record_Type (Etype (Prefix (P)))
+              and then not Is_Constrained (Etype (Prefix (P)))
+            then
+               null;
+
             --  Don't do this optimization if we are within the code for a
             --  discriminant check, since the whole point of such a check may
             --  be to verify the condition on which the code below depends!