let process_unreached_annots cfg unreached =
Wp_parameters.debug ~level:3 "[strategy] collecting unreachable annotations@.";
let kf = Cil2cfg.cfg_kf cfg in
let spec = Kernel_function.get_spec kf in
let add_id id acc =
if proved id
then acc
else id::acc
in
let do_post b tk acc (termk, p) =
if tk = termk then add_id (mk_fct_post_id kf b termk p) acc else acc
in
let do_bhv termk acc b = List.fold_left (do_post b termk) acc b.b_post_cond in
let do_annot s a acc = match a with
| Before (User ca | AI (_, ca)) -> add_id (mk_code_annot_id kf s ca) acc
| _ -> acc
in
let do_node acc n =
Wp_parameters.debug ~level:3
"[strategy] process annotations of unreachable node %a@."
Cil2cfg.pp_node_type n;
match n with
| Cil2cfg.Vstart -> Wp_parameters.fatal "Start must be reachable"
| Cil2cfg.VfctIn -> Wp_parameters.fatal "FctIn must be reachable"
| Cil2cfg.VfctOut -> List.fold_left (do_bhv Normal) acc spec.spec_behavior
| Cil2cfg.Vexit -> List.fold_left (do_bhv Exits) acc spec.spec_behavior
| Cil2cfg.Vstmt s
| Cil2cfg.VblkIn (Cil2cfg.Bstmt s, _) | Cil2cfg.VcallIn (s, _, _, _)
| Cil2cfg.Vtest (true, s, _) | Cil2cfg.Vloop (_, s) | Cil2cfg.Vswitch (s,_)
-> Annotations.single_fold_stmt (do_annot s) s acc
| Cil2cfg.Vtest (false, _, _)
| Cil2cfg.VcallOut _ | Cil2cfg.VcallExit _
| Cil2cfg.VblkIn _ | Cil2cfg.VblkOut _ | Cil2cfg.Vend -> acc
in
let annots = List.fold_left do_node [] unreached in
Wp_parameters.debug ~level:3
"[strategy] found %d unreachable annotations@." (List.length annots) ;
List.iter (fun pid -> set_unreachable pid) annots