let mark_loops cfg =
let graph = cfg_graph cfg in
let kf = cfg_kf cfg in
let env = Mloop.identify_loops cfg in
let mark_loop_back_edge h =
let h_stmt = VL.stmt h in
let mark_back_edge e =
let n = CFG.E.src e in
let is_back_edge =
try
let n_stmt = VL.stmt n in
!Db.Dominators.is_dominator kf ~opening:h_stmt ~closing:n_stmt
with Not_found -> false
in
if is_back_edge then set_back_edge e;
Wp_parameters.debug ~level:2 "[cfg] to loop edge %a@." pretty_edge e
in CFG.iter_pred_e mark_back_edge graph h
in
let mark_loop h =
Wp_parameters.debug ~level:2 "[cfg] loop head in %a@." VL.pretty h;
let h_stmt = VL.stmt h in
let is_natural = not (LoopInfo.is_irreducible env h) in
let _ =
if is_natural then mark_loop_back_edge h
else Wp_parameters.debug ~level:1
"[cfg] irreducible loop detected in %a@." VL.pretty h
in
h := Vloop (is_natural, h_stmt)
in
List.iter mark_loop env.LoopInfo.loop_headers;
Wp_parameters.debug ~level:2 "[cfg] unstructuredness coef = %f@."
(LoopInfo.unstructuredness env)