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