let rec get_only_succ env g v = match CFG.succ_e g v with
| [e'] -> compute_edge env e'
| _ -> assert false
and compute_edge ((kf, g, annots, he, wenv) as env) e =
let old_loc = Cil.CurrentLoc.get () in
let v = CFG.E.dst e in
Wp_parameters.debug ~level:3
"[compute_edge] get wp before %a@." Cil2cfg.VL.pretty v;
let res =
try
let res = get_wp_edge he e in
Wp_parameters.debug ~level:3
"[compute_edge] %a already computed@." Cil2cfg.VL.pretty v;
res
with Not_found ->
Wp_parameters.debug ~level:3
"[compute_edge] before %a go...@." Cil2cfg.VL.pretty v;
let _ = match Cil2cfg.VL.stmt_opt v with
| Some s -> Cil.CurrentLoc.set (Ast_info.loc_stmt s)
| _ -> ()
in
let res = match !v with
| Cil2cfg.Vstart _ -> assert false
| Cil2cfg.VfctIn _ ->
let obj = get_only_succ env g v in
W.quantif_locals kf obj
| Cil2cfg.VfctOut _ ->
let obj = get_only_succ env g v in
obj
| Cil2cfg.VblkIn _ | Cil2cfg.VblkOut _ ->
get_only_succ env g v
| Cil2cfg.Vstmt s ->
let obj = get_only_succ env g v in
wp_stmt kf annots s obj
| Cil2cfg.Vtest (_, c) ->
let et, ef = Cil2cfg.get_test_edges g v in
let t_obj = compute_edge env et in
let f_obj = compute_edge env ef in
W.test c t_obj f_obj
| Cil2cfg.Vloop (_, s) ->
if Cil2cfg.is_back_edge e then
W.ptrue
else
let loop_head = get_only_succ env g v in
let assigns = get_loop_assigns annots e in
let loop_name = "_loop_"^(string_of_int s.sid) in
W.wp_loop loop_name assigns loop_head
| Cil2cfg.Vexit _ -> W.ptrue
in
Wp_parameters.debug ~level:2
"[compute_edge] before %a done@." Cil2cfg.VL.pretty v;
let res = set_wp_edge kf annots wenv he e res in
res
in
Cil.CurrentLoc.set old_loc;
res