]> matita.cs.unibo.it Git - helm.git/blob - helm/graphs/tools/simplify_deps/simplify_deps.ml
fixed a syntax quirk to make ocamldoc happy
[helm.git] / 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 ;;