let mark_loops cfg =
let kf = cfg_kf cfg in
let env = Mloop.identify_loops cfg in
let mark_loop_back_edge h =
let h_stmt = node_stmt_exn h in
let mark_back_edge e =
let n = edge_src e in
let is_back_edge =
try
let n_stmt = node_stmt_exn 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:3 "[cfg] to loop edge %a@." pp_edge e
in iter_pred_e mark_back_edge cfg h
in
let mark_loop h =
Wp_parameters.debug ~level:3 "[cfg] loop head in %a@." VL.pretty h;
let h_stmt = node_stmt_exn 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:3
"[cfg] irreducible loop detected in %a@." VL.pretty h
in
h := { !h with kind = Vloop (is_natural, h_stmt) }
in
List.iter mark_loop env.LoopInfo.loop_headers;
Wp_parameters.debug ~level:3 "[cfg] unstructuredness coef = %f@."
(LoopInfo.unstructuredness env);
cfg.loop_nodes <- Some (env.LoopInfo.loop_headers)