-- 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
-- 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).
else
return GT;
end if;
+ end if;
+ end;
+
+ -- 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
- -- If the expressions are different, we cannot say at compile
- -- time how they compare, so we return the Unknown indication.
+ 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;
-- 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.
and then Is_Enumeration_Type (Base_Type (Typ))
then
Lit := Alias (Entity (Name (N)));
-
while Present (Alias (Lit)) loop
Lit := Alias (Lit);
end loop;
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));
"('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);
projects / gcc.git / commitdiff