X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fdaemons%2Fgraphs%2Ftools%2Fsimplify_deps%2Fsimplify_deps.ml;fp=helm%2Fsoftware%2Fdaemons%2Fgraphs%2Ftools%2Fsimplify_deps%2Fsimplify_deps.ml;h=9b0fb0042ab5d5847807fcd6fae877789c090c1e;hb=76ad23ea1e83e8c187a4593027e9baed1bb022e3;hp=0000000000000000000000000000000000000000;hpb=2b2b90087f836c2f32291935216549e9370e68c3;p=helm.git

diff --git a/helm/software/daemons/graphs/tools/simplify_deps/simplify_deps.ml b/helm/software/daemons/graphs/tools/simplify_deps/simplify_deps.ml
new file mode 100644
index 000000000..9b0fb0042
--- /dev/null
+++ b/helm/software/daemons/graphs/tools/simplify_deps/simplify_deps.ml
@@ -0,0 +1,102 @@
+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
+;;