--- /dev/null
+type node =
+ Node of string * node list ref (* label, children *)
+
+let debug = false;;
+
+(************************************************)
+(* SIMPLIFICATION AND PRETTY-PRINTING *)
+(************************************************)
+
+let reachable target source_arcs =
+ let rec find s =
+ if s = target then true
+ else
+ let Node (_,arcs) = s in
+ List.fold_left (fun i n -> i or find n) false !arcs
+ in
+ List.fold_left
+ (fun i n ->
+ i or
+ (if n = target then
+ (* this is the arc we would like to get rid of *)
+ false
+ else
+ find n
+ )
+ ) false source_arcs
+;;
+
+let consider_arc (source,target,rest) =
+ let Node (source_name,source_arcs) = source in
+ let Node (target_name,_) = target in
+ if not (reachable target !source_arcs) then
+ print_endline (source_name ^ " -> " ^ target_name ^ rest ^ ";")
+ else
+ if debug then
+ print_endline (source_name ^ " -> " ^ target_name ^ " [color=green];")
+;;
+
+let simplify_deps_and_output_them =
+ List.iter consider_arc
+;;
+
+(************************************************)
+(* PARSING *)
+(************************************************)
+
+let nodes = ref [];;
+let arcs = ref [];; (* (source,target) *)
+
+let search_node s =
+ List.find (function Node (s',_) -> s' = s) !nodes
+;;
+
+let parse () =
+ try
+ while true do
+ let line = read_line () in
+ if Str.string_match (Str.regexp " \\([^ ]*\\) -> \\([^ ;]*\\)\\(\\( \\[.*\\]\\)?\\);") line 0 then
+ let source = Str.matched_group 1 line in
+ let target = Str.matched_group 2 line in
+ begin
+ if source <> target then
+ (* not a self loop *)
+ let rest = Str.matched_group 3 line in
+ let tar =
+ try
+ search_node target
+ with
+ Not_found ->
+ let tar = Node (target,ref []) in
+ nodes := tar :: !nodes ;
+ tar
+ in
+ let sou =
+ try
+ let sou = search_node source in
+ let Node (_,ts) = sou in
+ ts := tar::!ts ;
+ sou
+ with
+ Not_found ->
+ let sou = Node (source,ref [tar]) in
+ nodes := sou :: !nodes ;
+ sou
+ in
+ arcs := (sou,tar,rest)::!arcs
+ end
+ else
+ print_endline line
+ done
+ with
+ End_of_file -> ()
+;;
+
+(************************************************)
+(* MAIN *)
+(************************************************)
+
+let _ =
+ parse () ;
+ simplify_deps_and_output_them !arcs
+;;