mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-20 11:00:57 +08:00
Code Issues Packages Projects Releases Wiki Activity

sem_eval.adb (Compile_Time_Compare): Make use of information from Current_Value in the conditional case...

Browse Source 
2006-10-31  Robert Dewar  <dewar@adacore.com>

	* sem_eval.adb (Compile_Time_Compare): Make use of information from
	Current_Value in the conditional case, to evaluate additional
	comparisons at compile time.

From-SVN: r118310
This commit is contained in:
Robert Dewar 2006-10-31 19:09:38 +01:00 committed by Arnaud Charlet
parent a5abb241f3
commit 29797f340d
1 changed files with 138 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

150
gcc/ada/sem_eval.adb
View File

@ -702,6 +702,16 @@ package body Sem_Eval is
-- Cases where at least one operand is not known at compile time
else
-- Remaining checks apply only for non-generic discrete types
if not Is_Discrete_Type (Ltyp)
or else not Is_Discrete_Type (Rtyp)
or else Is_Generic_Type (Ltyp)
or else Is_Generic_Type (Rtyp)
then
return Unknown;
end if;
-- Here is where we check for comparisons against maximum bounds of
-- types, where we know that no value can be outside the bounds of
-- the subtype. Note that this routine is allowed to assume that all
@ -712,16 +722,12 @@ package body Sem_Eval is
-- attempt this optimization with generic types, since the type
-- bounds may not be meaningful in this case.
-- We are in danger of an infinite recursion here. It does not seem
-- We are in danger of an infinite recursion here. It does not seem
-- useful to go more than one level deep, so the parameter Rec is
-- used to protect ourselves against this infinite recursion.
if not Rec
and then Is_Discrete_Type (Ltyp)
and then Is_Discrete_Type (Rtyp)
and then not Is_Generic_Type (Ltyp)
and then not Is_Generic_Type (Rtyp)
then
if not Rec then
-- See if we can get a decisive check against one operand and
-- a bound of the other operand (four possible tests here).
@ -785,13 +791,134 @@ package body Sem_Eval is
else
return GT;
end if;
end if;
end;
-- If the expressions are different, we cannot say at compile
-- time how they compare, so we return the Unknown indication.
-- Next attempt is to see if we have an entity compared with a
-- compile time known value, where there is a current value
-- conditional for the entity which can tell us the result.
declare
Var : Node_Id;
-- Entity variable (left operand)
Val : Uint;
-- Value (right operand)
Inv : Boolean;
-- If False, we have reversed the operands
Op : Node_Kind;
-- Comparison operator kind from Get_Current_Value_Condition call
Opn : Node_Id;
-- Value from Get_Current_Value_Condition call
Opv : Uint;
-- Value of Opn
Result : Compare_Result;
-- Known result before inversion
begin
if Is_Entity_Name (L)
and then Compile_Time_Known_Value (R)
then
Var := L;
Val := Expr_Value (R);
Inv := False;
elsif Is_Entity_Name (R)
and then Compile_Time_Known_Value (L)
then
Var := R;
Val := Expr_Value (L);
Inv := True;
-- That was the last chance at finding a compile time result
else
return Unknown;
end if;
Get_Current_Value_Condition (Var, Op, Opn);
-- That was the last chance, so if we got nothing return
if No (Opn) then
return Unknown;
end if;
Opv := Expr_Value (Opn);
-- We got a comparison, so we might have something interesting
-- Convert LE to LT and GE to GT, just so we have fewer cases
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;
end if;
-- Deal with equality case
if Op = N_Op_Eq then
if Val = Opv then
Result := EQ;
elsif Opv < Val then
Result := LT;
else
Result := GT;
end if;
-- Deal with inequality case
elsif Op = N_Op_Ne then
if Val = Opv then
Result := NE;
else
return Unknown;
end if;
-- Deal with greater than case
elsif Op = N_Op_Gt then
if Opv >= Val then
Result := GT;
elsif Opv = Val - 1 then
Result := GE;
else
return Unknown;
end if;
-- Deal with less than case
else pragma Assert (Op = N_Op_Lt);
if Opv <= Val then
Result := LT;
elsif Opv = Val + 1 then
Result := LE;
else
return Unknown;
end if;
end if;
-- Deal with inverting result
if Inv then
case Result is
when GT => return LT;
when GE => return LE;
when LT => return GT;
when LE => return GE;
when others => return Result;
end case;
end if;
return Result;
end;
end if;
end Compile_Time_Compare;
@ -1235,6 +1362,7 @@ package body Sem_Eval is
-- with static arguments, or calls to functions that rename a literal.
-- Only the latter case is handled here, predefined operators are
-- constant-folded elsewhere.
-- If the function is itself inherited (see 7423-001) the literal of
-- the parent type must be explicitly converted to the return type
-- of the function.
@ -1252,7 +1380,6 @@ package body Sem_Eval is
and then Is_Enumeration_Type (Base_Type (Typ))
then
Lit := Alias (Entity (Name (N)));
while Present (Alias (Lit)) loop
Lit := Alias (Lit);
end loop;
@ -2421,7 +2548,6 @@ package body Sem_Eval is
procedure Eval_Slice (N : Node_Id) is
Drange : constant Node_Id := Discrete_Range (N);
begin
if Nkind (Drange) = N_Range then
Check_Non_Static_Context (Low_Bound (Drange));
@ -4358,7 +4484,7 @@ package body Sem_Eval is
"('R'M 4.9(5))!", N, E);
end if;
when N_Binary_Op | N_And_Then | N_Or_Else | N_In | N_Not_In =>
when N_Binary_Op | N_And_Then | N_Or_Else | N_Membership_Test =>
if Nkind (N) in N_Op_Shift then
Error_Msg_N
("shift functions are never static ('R'M 4.9(6,18))!", N);