let type_cond needs_pebble env tr cond =
let current = if needs_pebble then Some tr.stop else None in
let rec aux pos env =
function
| PRel(rel,e1,e2) ->
let env, e1, c1 = type_expr env ~tr ?current e1 in
let env, e2, c2 = type_expr env ~tr ?current e2 in
let call_cond = if pos then tand c1 c2 else tor (tnot c1) (tnot c2) in
let rel = TRel(Logic_typing.type_rel rel,e1,e2) in
let cond = if pos then tand rel call_cond else tor rel call_cond in
env, cond
| PTrue -> env, TTrue
| PFalse -> env, TFalse
| POr(c1,c2) ->
let env1, c1 = aux pos env c1 in
let env2, c2 = aux pos env c2 in
merge_current_event env1 env2 c1 c2
| PAnd(c1,c2) ->
let env, c1 = aux pos env c1 in
let env, c2 = aux pos env c2 in
env, TAnd(c1,c2)
| PNot c ->
let env, c = aux (not pos) env c in env, TNot c
| PCall (s,b) ->
let kf =
try
Globals.Functions.find_by_name s
with Not_found -> Aorai_option.abort "No such function: %s" s
in
let b =
Extlib.opt_map
(fun b ->
let bhvs =
(Kernel_function.get_spec ~populate:false kf).spec_behavior
in
try
List.find (fun x -> x.b_name = b) bhvs
with Not_found ->
Aorai_option.abort "Function %a has no behavior named %s"
Kernel_function.pretty kf b)
b
in
if pos then
add_current_event
(ECall (kf, Cil_datatype.Varinfo.Hashtbl.create 3, tr)) env
(TCall (kf,b))
else env, TCall (kf,b)
| PReturn s ->
let kf =
try
Globals.Functions.find_by_name s
with Not_found -> Aorai_option.abort "No such function %s" s
in
if pos then add_current_event (EReturn kf) env (TReturn kf)
else env, TReturn kf
in
aux true (ENone::env) cond