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 =
(*        print_string ("^(string_of_int 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;
(*    print_string ";
    print_status(); *)

    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;
(*    print_string ";
    print_status(); *)

    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;
    ()