let find_dominator f =
let n = ref 0 in
let size = Array.length f + 1 in
let successor = Array.create size [] in
let predecessor = Array.create size [] in
let semi = Array.create size 0 in
let vertex = Array.create size 0 in
let parent = Array.create size 0 in
let bucket = Array.create size [] in
let dom = Array.create size 0 in
let ancestor = Array.create size 0 in
let label = Array.init size (function n -> n) in
let child = Array.create size 0 in
let size = Array.create size 1 in
size.(0) <- 0;
let offset n = n + 1 in
for i = 0 to Array.length f - 1 do
successor.(offset i) <- List.map offset f.(i).successor;
predecessor.(offset i) <- List.map offset f.(i).predecessor
done;
let print_status() =
let string_of_int_list = Ctt_printer.print_list string_of_int "," in
for i = 1 to !n do
print_string ((string_of_int i)^": ");
print_string ("dom = "^(string_of_int dom.(i))^", ");
print_string ("semi = "^(string_of_int vertex.(semi.(i)))^",");
print_string ("parent = "^(string_of_int parent.(i))^", ");
print_string ("succ = "^(string_of_int_list successor.(i))^", ");
print_string ("pred = "^(string_of_int_list predecessor.(i))^", ");
print_string ("bucket = "^(string_of_int_list bucket.(i))^"\n");
done
in
let add_bucket v i =
if not (List.mem v bucket.(i)) then
bucket.(i) <- v::bucket.(i)
in
let remove_bucket v i =
let rec continue = function
[] -> []
| j::l -> if i = j then l else j::continue l
in
if List.mem v bucket.(i) then
bucket.(i) <- continue bucket.(i)
in
let rec compress v =
if ancestor.(ancestor.(v)) != 0 then begin
compress ancestor.(v);
if semi.(label.(ancestor.(v))) < semi.(label.(v)) then
label.(v) <- label.(ancestor.(v));
ancestor.(v) <- ancestor.(ancestor.(v))
end
in
let eval v =
if ancestor.(v) = 0 then
v
else begin
compress v;
label.(v)
end
in
let link v w =
ancestor.(w) <- v
in
let rec initialize v =
n := !n + 1;
semi.(v) <- !n;
vertex.(!n) <- v;
let check_child w =
if semi.(w) = 0 then begin
parent.(w) <- v;
initialize w
end
in
List.iter check_child successor.(v)
in
initialize 1;
for j = 0 to !n - 2 do
let i = !n - j in
let w = vertex.(i) in
let set_semi v =
let u = eval v in
if semi.(u) < semi.(w) then
semi.(w) <- semi.(u)
in
List.iter set_semi predecessor.(w);
add_bucket w vertex.(semi.(w));
link parent.(w) w;
let set_dom v =
remove_bucket v parent.(w);
let u = eval v in
dom.(v) <- if semi.(u) < semi.(v) then u else parent.(w)
in
List.iter set_dom bucket.(parent.(w))
done;
for i = 2 to !n do
let w = vertex.(i) in
if dom.(w) <> vertex.(semi.(w)) then
dom.(w) <- dom.(dom.(w))
done;
dom.(0) <- 0;
for i = 0 to Array.length f - 1 do
let block =
{
f.(i) with
immediate_dominator = dom.(i + 1) - 1;
}
in
f.(i) <- block
done;
()