let rec eval_predicate ~result env pred =
let rec do_eval env p =
match p.content with
| Ptrue -> True
| Pfalse -> False
| Pand (p1,p2 ) ->
begin match do_eval env p1 with
| True -> do_eval env p2
| False -> False
| Unknown ->
let reduced = reduce_by_predicate ~result env true p1 in
match do_eval reduced p2 with
| False -> False
| _ -> Unknown
end
| Por (p1,p2 ) ->
let val_p1 = do_eval env p1 in
begin match val_p1 with
| True -> True
| False -> do_eval env p2
| Unknown -> begin
let reduced_state = reduce_by_predicate ~result env false p1 in
match do_eval reduced_state p2 with
| True -> True
| _ -> Unknown
end
end
| Pxor (p1,p2) ->
begin match do_eval env p1, do_eval env p2 with
| True, True -> False
| False, False -> False
| True, False | False, True -> True
| Unknown, _ | _, Unknown -> Unknown
end
| Piff (p1,p2 ) ->
begin match do_eval env p1,do_eval env p2 with
| True, True | False, False -> True
| Unknown, _ | _, Unknown -> Unknown
| _ -> False
end
| Pat (p, lbl) -> begin
let _env = { env with e_cur = convert_label lbl } in
do_eval env p
end
| Papp _ -> Unknown
| Pvalid tsets -> begin
try
List.iter
(fun (typ, loc) ->
if not (isPointerType typ)
then raise Predicate_alarm ;
let size = sizeof_pointed typ in
let loc = loc_bytes_to_loc_bits loc in
let loc = Locations.make_loc loc size in
if not (Locations.is_valid ~for_writing:false loc) then (
(if Locations.cardinal_zero_or_one loc then
let valid = valid_part ~for_writing:false loc in
if Location_Bits.equal Location_Bits.bottom valid.loc
then raise Stop;
);
raise Predicate_alarm
))
(eval_term env result tsets);
True
with
| Predicate_alarm -> Unknown
| Stop -> False
end
| Pinitialized tsets -> begin
try
let locb = eval_term env result tsets in
fold_join_predicate List.fold_left
(fun (typ, loc) ->
let locbi = loc_bytes_to_loc_bits loc in
let size = match unrollType typ with
| TPtr (t, _) -> bitsSizeOf t
| _ -> assert false
in
let loc = make_loc locbi (Int_Base.inject (Int.of_int size)) in
let value = Cvalue.Model.find_unspecified
~with_alarms:CilE.warn_none_mode (env_current_state env) loc
in
match value with
| Cvalue.V_Or_Uninitialized.C_uninit_esc v
| Cvalue.V_Or_Uninitialized.C_uninit_noesc v ->
if Location_Bytes.is_bottom v then False else Unknown
| Cvalue.V_Or_Uninitialized.C_init_esc _
| Cvalue.V_Or_Uninitialized.C_init_noesc _ -> True
) locb
with
| Cannot_find_lv
| Predicate_alarm -> Unknown
end
| Prel (op,t1,t2) -> begin
try
let t = t1.term_type in
let trm = Logic_const.term (TBinOp (lop_to_cop op, t1, t2)) t in
let l = List.map snd (eval_term env result trm) in
if List.for_all
(Location_Bytes.equal Location_Bytes.singleton_zero) l
then False
else if List.for_all
(Location_Bytes.equal Location_Bytes.singleton_one) l
then True
else Unknown
with
| Predicate_alarm -> Unknown
end
| Pexists (varl, p1) | Pforall (varl, p1) ->
let result =
begin try
let env = List.fold_left
(fun acc var ->
match var.lv_origin with
| None -> raise Exit
| Some vi ->
let loc = loc_of_varinfo vi in
let state =
Cvalue.Model.add_binding
~with_alarms:warn_raise_mode ~exact:true
(env_current_state acc) loc Location_Bytes.top
in
overwrite_current_state env state
) env varl
in
do_eval env 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 env p with
| True -> False
| False -> True
| Unknown -> Unknown
end
| Pimplies (p1,p2) ->
do_eval env (Logic_const.por ((Logic_const.pnot p1), p2))
| Pseparated (_tset_l) -> Unknown
| Pfresh _
| Pvalid_range (_, _, _)| Pvalid_index (_, _)
| Plet (_, _) | Pif (_, _, _)
| Psubtype _
-> Unknown
in
do_eval env pred