sem_attr.adb (Eval_Attribute, [...]): Catch more cases where this attribute can be evaluated at compile time.

2009-04-20  Robert Dewar  <dewar@adacore.com>

	* sem_attr.adb (Eval_Attribute, case Length): Catch more cases where
	this attribute can be evaluated at compile time.
	(Eval_Attribute, case Range_Length): Same improvement

	* sem_eval.ads, sem_eval.adb (Compile_Time_Compare): New procedure

From-SVN: r146420

3 files changed, 109 insertions, 10 deletions

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index a4478ac..d4545c0 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6168,6 +6168,8 @@ package body Sem_Attr is
 
          Set_Bounds;
 
+         --  For two compile time values, we can compute length
+
          if Compile_Time_Known_Value (Lo_Bound)
            and then Compile_Time_Known_Value (Hi_Bound)
          then
@@ -6175,6 +6177,33 @@ package body Sem_Attr is
               UI_Max (0, 1 + (Expr_Value (Hi_Bound) - Expr_Value (Lo_Bound))),
               True);
          end if;
+
+         --  One more case is where Hi_Bound and Lo_Bound are compile-time
+         --  comparable, and we can figure out the difference between them.
+
+         declare
+            Diff : aliased Uint;
+
+         begin
+            case
+              Compile_Time_Compare
+                (Lo_Bound, Hi_Bound, Diff'Access, Assume_Valid => False)
+            is
+               when EQ =>
+                  Fold_Uint (N, Uint_1, False);
+
+               when GT =>
+                  Fold_Uint (N, Uint_0, False);
+
+               when LT =>
+                  if Diff /= No_Uint then
+                     Fold_Uint (N, Diff + 1, False);
+                  end if;
+
+               when others =>
+                  null;
+            end case;
+         end;
       end Length;
 
       -------------
@@ -6666,6 +6695,8 @@ package body Sem_Attr is
       when Attribute_Range_Length =>
          Set_Bounds;
 
+         --  Can fold if both bounds are compile time known
+
          if Compile_Time_Known_Value (Hi_Bound)
            and then Compile_Time_Known_Value (Lo_Bound)
          then
@@ -6675,6 +6706,33 @@ package body Sem_Attr is
                  Static);
          end if;
 
+         --  One more case is where Hi_Bound and Lo_Bound are compile-time
+         --  comparable, and we can figure out the difference between them.
+
+         declare
+            Diff : aliased Uint;
+
+         begin
+            case
+              Compile_Time_Compare
+                (Lo_Bound, Hi_Bound, Diff'Access, Assume_Valid => False)
+            is
+               when EQ =>
+                  Fold_Uint (N, Uint_1, False);
+
+               when GT =>
+                  Fold_Uint (N, Uint_0, False);
+
+               when LT =>
+                  if Diff /= No_Uint then
+                     Fold_Uint (N, Diff + 1, False);
+                  end if;
+
+               when others =>
+                  null;
+            end case;
+         end;
+
       ---------------
       -- Remainder --
       ---------------
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 627ea5b..b659853 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -380,6 +380,16 @@ package body Sem_Eval is
 
    function Compile_Time_Compare
      (L, R         : Node_Id;
+      Assume_Valid : Boolean) return Compare_Result
+   is
+      Discard : aliased Uint;
+   begin
+      return Compile_Time_Compare (L, R, Discard'Access, Assume_Valid);
+   end Compile_Time_Compare;
+
+   function Compile_Time_Compare
+     (L, R         : Node_Id;
+      Diff         : access Uint;
       Assume_Valid : Boolean;
       Rec          : Boolean := False) return Compare_Result
    is
@@ -390,6 +400,8 @@ package body Sem_Eval is
       --  invalid representations using the value of the base type, in
       --  accordance with RM 13.9.1(10).
 
+      Discard : aliased Uint;
+
       procedure Compare_Decompose
         (N : Node_Id;
          R : out Node_Id;
@@ -654,6 +666,8 @@ package body Sem_Eval is
    --  Start of processing for Compile_Time_Compare
 
    begin
+      Diff.all := No_Uint;
+
       --  If either operand could raise constraint error, then we cannot
       --  know the result at compile time (since CE may be raised!)
 
@@ -724,10 +738,14 @@ package body Sem_Eval is
 
             begin
                if Lo < Hi then
+                  Diff.all := Hi - Lo;
                   return LT;
+
                elsif Lo = Hi then
                   return EQ;
+
                else
+                  Diff.all := Lo - Hi;
                   return GT;
                end if;
             end;
@@ -813,7 +831,9 @@ package body Sem_Eval is
             --  a bound of the other operand (four possible tests here).
 
             case Compile_Time_Compare (L, Type_Low_Bound (Rtyp),
-                                       Assume_Valid, Rec => True) is
+                                       Discard'Access,
+                                       Assume_Valid, Rec => True)
+            is
                when LT => return LT;
                when LE => return LE;
                when EQ => return LE;
@@ -821,7 +841,9 @@ package body Sem_Eval is
             end case;
 
             case Compile_Time_Compare (L, Type_High_Bound (Rtyp),
-                                       Assume_Valid, Rec => True) is
+                                       Discard'Access,
+                                       Assume_Valid, Rec => True)
+            is
                when GT => return GT;
                when GE => return GE;
                when EQ => return GE;
@@ -829,7 +851,9 @@ package body Sem_Eval is
             end case;
 
             case Compile_Time_Compare (Type_Low_Bound (Ltyp), R,
-                                       Assume_Valid, Rec => True) is
+                                       Discard'Access,
+                                       Assume_Valid, Rec => True)
+            is
                when GT => return GT;
                when GE => return GE;
                when EQ => return GE;
@@ -837,7 +861,9 @@ package body Sem_Eval is
             end case;
 
             case Compile_Time_Compare (Type_High_Bound (Ltyp), R,
-                                       Assume_Valid, Rec => True) is
+                                       Discard'Access,
+                                       Assume_Valid, Rec => True)
+            is
                when LT => return LT;
                when LE => return LE;
                when EQ => return LE;
@@ -871,9 +897,11 @@ package body Sem_Eval is
                   return EQ;
 
                elsif Loffs < Roffs then
+                  Diff.all := Roffs - Loffs;
                   return LT;
 
                else
+                  Diff.all := Loffs - Roffs;
                   return GT;
                end if;
             end if;
@@ -943,6 +971,7 @@ package body Sem_Eval is
             if Op = N_Op_Le then
                Op := N_Op_Lt;
                Opv := Opv + 1;
+
             elsif Op = N_Op_Ge then
                Op := N_Op_Gt;
                Opv := Opv - 1;
diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads
index 53953d1..565ce67 100644
--- a/gcc/ada/sem_eval.ads
+++ b/gcc/ada/sem_eval.ads
@@ -132,10 +132,12 @@ package Sem_Eval is
    type Compare_Result is (LT, LE, EQ, GT, GE, NE, Unknown);
    subtype Compare_GE is Compare_Result range EQ .. GE;
    subtype Compare_LE is Compare_Result range LT .. EQ;
+   --  Result subtypes for Compile_Time_Compare subprograms
+
    function Compile_Time_Compare
      (L, R         : Node_Id;
-      Assume_Valid : Boolean;
-      Rec          : Boolean := False) return Compare_Result;
+      Assume_Valid : Boolean) return Compare_Result;
+   pragma Inline (Compile_Time_Compare);
    --  Given two expression nodes, finds out whether it can be determined at
    --  compile time how the runtime values will compare. An Unknown result
    --  means that the result of a comparison cannot be determined at compile
@@ -145,9 +147,19 @@ package Sem_Eval is
    --  the result of assuming that entities involved in the comparison have
    --  valid representations. If Assume_Valid is false, then the base type of
    --  any involved entity is used so that no assumption of validity is made.
-   --  Rec is a parameter that is set True for a recursive call from within
-   --  Compile_Time_Compare to avoid some infinite recursion cases. It should
-   --  never be set by a client.
+
+   function Compile_Time_Compare
+     (L, R         : Node_Id;
+      Diff         : access Uint;
+      Assume_Valid : Boolean;
+      Rec          : Boolean := False) return Compare_Result;
+   --  This version of Compile_Time_Compare returns extra information if the
+   --  result is GT or LT. In these cases, if the magnitude of the difference
+   --  can be determined at compile time, this (positive) magnitude is returned
+   --  in Diff.all. If the magnitude of the difference cannot be determined
+   --  then Diff.all contains No_Uint on return. Rec is a parameter that is set
+   --  True for a recursive call from within Compile_Time_Compare to avoid some
+   --  infinite recursion cases. It should never be set by a client.
 
    procedure Flag_Non_Static_Expr (Msg : String; Expr : Node_Id);
    --  This procedure is called after it has been determined that Expr is not
@@ -311,7 +323,7 @@ package Sem_Eval is
    --  literals list for the enumeration case. Is_Static_Expression is set True
    --  in the result node. The result is fully analyzed/resolved. Static
    --  indicates whether the result should be considered static or not (True =
-   --  consider static). The point here is that normally all string literals
+   --  consider static). The point here is that normally all integer literals
    --  are static, but if this was the result of some sequence of evaluation
    --  where values were known at compile time but not static, then the result
    --  is not static.