helm/graphs/tools/simplify_deps/simplify_deps.ml

   1 type node =
   2  Node of string * node list ref (* label, children *)
   3
   4 let debug = false;;
   5
   6 (************************************************)
   7 (*      SIMPLIFICATION AND PRETTY-PRINTING      *)
   8 (************************************************)
   9
  10 let reachable target source_arcs =
  11  let rec find s =
  12   if s = target then true
  13   else
  14    let Node (_,arcs) = s in
  15     List.fold_left (fun i n -> i or find n) false !arcs
  16  in
  17   List.fold_left
  18    (fun i n ->
  19      i or
  20       (if n = target then
  21         (* this is the arc we would like to get rid of *)
  22         false
  23        else
  24         find n
  25       )
  26    ) false source_arcs
  27 ;;
  28
  29 let consider_arc (source,target) =
  30  let Node (source_name,source_arcs) = source in
  31  let Node (target_name,_) = target in
  32   if not (reachable target !source_arcs) then
  33    print_endline (source_name ^ " -> " ^ target_name)
  34   else
  35    if debug then
  36     print_endline (source_name ^ " -> " ^ target_name ^ " [color=green];")
  37 ;;
  38
  39 let simplify_deps_and_output_them =
  40  List.iter consider_arc
  41 ;;
  42
  43 (************************************************)
  44 (*                   PARSING                    *)
  45 (************************************************)
  46
  47 let nodes = ref [];;
  48 let arcs  = ref [];;  (* (source,target) *)
  49
  50 let search_node s =
  51  List.find (function Node (s',_) -> s' = s) !nodes
  52 ;;
  53
  54 let parse () =
  55  try
  56   while true do
  57    let line = read_line () in
  58     if Str.string_match (Str.regexp " \([^ ]*\) -> \(.*\);") line 0 then
  59      let source = Str.matched_group 1 line in
  60      let target = Str.matched_group 2 line in
  61       let tar =
  62         try
  63          search_node target
  64         with
  65          Not_found ->
  66           let tar = Node (target,ref []) in
  67            nodes := tar :: !nodes ;
  68            tar
  69       in
  70        let sou =
  71         try
  72          let sou = search_node source in
  73           let Node (_,ts) = sou in
  74            ts := tar::!ts ;
  75            sou
  76         with
  77          Not_found ->
  78           let sou = Node (source,ref [tar]) in
  79            nodes := sou :: !nodes ;
  80            sou
  81        in
  82         arcs := (sou,tar)::!arcs
  83     else
  84      print_endline line
  85   done
  86  with
  87   End_of_file -> ()
  88 ;;
  89
  90 (************************************************)
  91 (*                     MAIN                     *)
  92 (************************************************)
  93
  94 let _ =
  95  parse () ;
  96  simplify_deps_and_output_them !arcs
  97 ;;