Skip to content

R
riscv-gcc-1
Commit af02a866 by Robert Dewar Committed by Arnaud Charlet
Options

sem_attr.adb (Eval_Attribute, [...]): Catch more cases where this attribute can… 

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
parent fed5ae11
Showing with 109 additions and 10 deletions
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 --
---------------
......
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;
......
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.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment