From 994fba58527fd0a8a041b50bb352fb33e455a959 Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 20 Apr 2009 13:28:50 +0000 Subject: [PATCH] 2009-04-20 Robert Dewar * 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 git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@146420 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/sem_attr.adb | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/sem_eval.adb | 37 +++++++++++++++++++++++++++++---- gcc/ada/sem_eval.ads | 24 ++++++++++++++++------ 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. -- 2.7.4