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,rest) =
  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 ^ rest ^ ";")
  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       begin
  62        if source <> target then
  63         (* not a self loop *)
  64         let rest   = Str.matched_group 3 line in
  65          let tar =
  66            try
  67                   search_node target
  68            with
  69             Not_found ->
  70                    let tar = Node (target,ref []) in
  71                     nodes := tar :: !nodes ;
  72                     tar
  73          in
  74           let sou =
  75            try
  76             let sou = search_node source in
  77              let Node (_,ts) = sou in
  78               ts := tar::!ts ;
  79                     sou
  80            with
  81             Not_found ->
  82              let sou = Node (source,ref [tar]) in
  83               nodes := sou :: !nodes ;
  84                     sou
  85           in
  86            arcs := (sou,tar,rest)::!arcs
  87       end
  88     else
  89      print_endline line
  90   done
  91  with
  92   End_of_file -> ()
  93 ;;
  94
  95 (************************************************)
  96 (*                     MAIN                     *)
  97 (************************************************)
  98
  99 let _ =
 100  parse () ;
 101  simplify_deps_and_output_them !arcs
 102 ;;