let eval_predicate ~result ~old state pred =
let rec do_eval state p =
match p.content with
| Ptrue -> True
| Pfalse -> False
| Pand (p1,p2 ) ->
begin match do_eval state p1 with
| True -> do_eval state p2
| False -> False
| Unknown ->
( match do_eval (reduce_by_predicate ~result ~old state true p1) p2 with
False -> False
| _ -> Unknown )
end
| Por (p1,p2 ) ->
let val_p1 = do_eval state p1 in
begin match val_p1 with
| True ->
True
| False ->
do_eval state p2
| Unknown -> begin
let reduced_state = reduce_by_predicate ~result ~old state false p1 in
match do_eval reduced_state p2 with
True -> True
| _ -> Unknown
end
end
| Pxor (p1,p2) ->
begin match do_eval state p1, do_eval state p2 with
| True, True -> False
| False, False -> False
| True, False | False, True -> True
| Unknown, _ | _, Unknown -> Unknown
end
| Piff (p1,p2 ) ->
begin match do_eval state p1,do_eval state p2 with
| True, True | False, False -> True
| Unknown, _ | _, Unknown -> Unknown
| _ -> False
end
| Papp _ | Pold _ | Pat _ -> Unknown
| Pvalid tsets -> begin
try
let cexps = !Db.Properties.Interp.loc_to_exp ~result tsets in
List.iter
( fun cexp ->
let typ = typeOf cexp in
if not (isPointerType typ)
then raise Predicate_alarm;
let evaled =
loc_bytes_to_loc_bits
(eval_expr ~with_alarms:warn_raise_mode state cexp)
in
let size = sizeof_pointed typ in
let loc = Locations.make_loc evaled size in
if not (Locations.is_valid loc)
then raise Predicate_alarm)
cexps;
True
with
Invalid_argument "not an lvalue" -> Unknown
| Predicate_alarm -> Unknown
end
| Prel (op,t1,t2) ->
begin
try
let cexp1 = !Db.Properties.Interp.term_to_exp ~result t1 in
let cexp2 = !Db.Properties.Interp.term_to_exp ~result t2 in
let cops =
dummy_exp (BinOp(lop_to_cop op,
cexp1,
cexp2,
intType))
in
let evaled = eval_expr ~with_alarms:warn_raise_mode state cops in
if Location_Bytes.equal
evaled
Location_Bytes.singleton_zero
then
False
else if Location_Bytes.equal
evaled
Location_Bytes.singleton_one
then
True
else Unknown
with
Invalid_argument "not an lvalue" -> Unknown
| Predicate_alarm -> Unknown
end
| Pexists (varl, p1) | Pforall (varl, p1) ->
let result =
begin try
let state = List.fold_left
(fun acc var ->
match var.lv_origin with
None -> raise Exit
| Some vi ->
let loc = loc_of_varinfo vi in
Relations_type.Model.add_binding
~with_alarms:warn_raise_mode ~exact:true
acc loc Location_Bytes.top)
state
varl
in
do_eval state p1
with
Exit -> Unknown
| Predicate_alarm -> Unknown
end
in
begin match p.content with
| Pexists _ -> if result = False then False else Unknown
| Pforall _ -> if result = True then True else Unknown
| _ -> assert false
end
| Pnot p -> begin match do_eval state p with
| True -> False
| False -> True
| Unknown -> Unknown
end
| Pimplies (p1,p2) ->
do_eval state (Logic_const.por ((Logic_const.pnot p1), p2))
| Pseparated (_tset_l) -> Unknown
| Pfresh _
| Pvalid_range (_, _, _)| Pvalid_index (_, _)
| Plet (_, _) | Pif (_, _, _)
| Psubtype _
-> Unknown
in
try
match State_set.fold
(fun s acc ->
match do_eval s pred with
| Unknown -> raise Stop
|( True | False ) as arg ->
(match acc with
| None -> Some arg
| Some old when old = arg -> Some arg
| _ -> raise Stop))
state
None
with
| None -> True
| Some v -> v
with Stop -> Unknown