find_cycles

#!/usr/bin/env ocaml
(* vim:filetype=ocaml expandtab
*)
#use "topfind";;
#require "batteries";;
open Batteries;;

let main () =
    let nodes = Hashtbl.create 31 in (* node -> index *)
    let paths = Hashtbl.create 31 in (* src -> dst *)
    File.lines_of "module-deps.dot" |>
    Enum.skip 1 |>
    Enum.iter (fun line ->
        if line <> "}" then (
            let src, dst = String.split ~by:" -> " line in
            Hashtbl.replace nodes src 0 ;
            Hashtbl.replace nodes dst 0 ;
            Hashtbl.add paths src dst
        )) ;
    let num_nodes = Hashtbl.length nodes in
    (* Give a unique index to each node *)
    let i = ref 0 in
    Hashtbl.iter (fun n _v -> Hashtbl.replace nodes n !i ; incr i) nodes ;
    let node_name = Array.create num_nodes "" in
    Hashtbl.iter (fun n i -> node_name.(i) <- n) nodes ;
    (* Build accessibility matrix *)
    let make_matrix () = Array.init num_nodes (fun _i -> Array.create num_nodes false) in
    let reachable = ref (make_matrix ()) in
    (* add all known paths *)
    let node_index n = Hashtbl.find nodes n in
    Hashtbl.iter (fun src dst ->
        !reachable.(node_index src).(node_index dst) <- true) paths ;
    (* add longer paths until convergeance *)
    let rec loop () =
        let changed = ref false in
        let res = make_matrix () in
        for i = 0 to num_nodes-1 do
            for j = 0 to num_nodes-1 do
                res.(i).(j) <- !reachable.(i).(j) ;
                if not res.(i).(j) then (
                    for k = 0 to num_nodes-1 do
                        res.(i).(j) <- res.(i).(j) || (!reachable.(i).(k) && !reachable.(k).(j))
                    done ;
                    if res.(i).(j) then changed := true
                )
            done
        done ;
        if !changed then (
            reachable := res ;
            loop ()
        ) in
    loop () ;
    (* Display cycles *)
    for i = 0 to num_nodes-1 do
        if !reachable.(i).(i) then
            Printf.printf "Cycle from %s\n" node_name.(i)
    done;;

main ();;