Skip to content
This repository
Browse code

* lang_ml/analyze/graph_modules_packages_ml.ml: new file, also main_p…

…m_depend.ml
  • Loading branch information...
commit 7966cbd73fb3e6a365e642cf09ff514745a5d955 1 parent 8749727
Yoann Padioleau authored September 02, 2011
1  .gitignore
@@ -333,3 +333,4 @@ external/ocamlbdb/libcamlbdb.a
333 333
 /web/client.js
334 334
 /tests/cpp/a.out
335 335
 /lang_cpp/parsing/ocamldoc.out
  336
+/pm_depend
15  Makefile
@@ -22,6 +22,8 @@ PROGS=pfff
22 22
 PROGS+=sgrep
23 23
 PROGS+=spatch
24 24
 PROGS+=stags
  25
+PROGS+=pm_depend
  26
+
25 27
 PROGS+=ppp
26 28
 
27 29
 # note that without bdb, pfff_db will be incomplete regarding PHP
@@ -394,6 +396,19 @@ clean::
394 396
 	rm -f stags
395 397
 
396 398
 #------------------------------------------------------------------------------
  399
+# pm_depend targets
  400
+#------------------------------------------------------------------------------
  401
+
  402
+pm_depend: $(LIBS) main_pm_depend.cmo 
  403
+	$(OCAMLC) $(CUSTOM) -o $@ $(SYSLIBS) $^
  404
+
  405
+pm_depend.opt: $(LIBS:.cma=.cmxa) main_pm_depend.cmx
  406
+	$(OCAMLOPT) $(STATIC) -o $@ $(BASICSYSLIBS:.cma=.cmxa) $^
  407
+
  408
+clean::
  409
+	rm -f pm_depend
  410
+
  411
+#------------------------------------------------------------------------------
397 412
 # sgrep targets
398 413
 #------------------------------------------------------------------------------
399 414
 
5  lang_ml/analyze/Makefile
@@ -9,6 +9,7 @@ SRC= \
9 9
      highlight_ml.ml \
10 10
      tags_ml.ml \
11 11
      database_light_ml.ml \
  12
+     graph_modules_packages_ml.ml \
12 13
      test_analyze_ml.ml
13 14
 
14 15
 -include $(TOP)/Makefile.config
@@ -35,7 +36,9 @@ INCLUDEDIRS= $(TOP)/commons \
35 36
    $(TOP)/commons/ocollection $(TOP)/commons/ocamlextra \
36 37
    $(TOP)/commons/lib-json \
37 38
    $(TOP)/external/ocamlpcre/lib \
38  
-   $(TOP)/h_program-lang $(TOP)/h_version-control  \
  39
+   $(TOP)/h_program-lang \
  40
+   $(TOP)/h_version-control  \
  41
+   $(TOP)/h_visualization  \
39 42
    $(TOP)/globals \
40 43
    ../parsing \
41 44
 
277  lang_ml/analyze/graph_modules_packages_ml.ml
... ...
@@ -0,0 +1,277 @@
  1
+(* Yoann Padioleau
  2
+ *
  3
+ * Copyright (C) 2011 Facebook
  4
+ *
  5
+ * This library is free software; you can redistribute it and/or
  6
+ * modify it under the terms of the GNU Lesser General Public License
  7
+ * version 2.1 as published by the Free Software Foundation, with the
  8
+ * special exception on linking described in file license.txt.
  9
+ * 
  10
+ * This library is distributed in the hope that it will be useful, but
  11
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  12
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file
  13
+ * license.txt for more details.
  14
+ *)
  15
+
  16
+open Common
  17
+
  18
+open Ast_ml
  19
+module V = Visitor_ml
  20
+module G = Graph
  21
+
  22
+(*****************************************************************************)
  23
+(* Prelude *)
  24
+(*****************************************************************************)
  25
+(*
  26
+ * Dependency visualization for ocaml code.
  27
+ * 
  28
+ * alternatives:
  29
+ *  - ocamldoc -dot -dot-reduce -dot-colors ... with graphviz
  30
+ *    But if there is one parse error or a module not found,
  31
+ *    then ocamldoc fails.
  32
+ *    Also there is no package "projection" or with-extern view.
  33
+ *    Finally the -dot-reduce is good for layering, but in the end
  34
+ *    I may prefer to see things without the reduction (especially
  35
+ *    with gephi).
  36
+ *  - graphviz backend? graphviz is good for layers, but
  37
+ *    you lost space and it does not scale so well.
  38
+ * 
  39
+ * todo? there is no edge weight? But is it useful in an ocaml context?
  40
+ * We can't have mutually dependent files or directories; the ocaml compiler
  41
+ * imposes a layering, so the in-edge will be enough information to give
  42
+ * more weight to some nodes. Thx to this layering the connected components
  43
+ * module of gephi also does some good work.
  44
+ * 
  45
+ * todo? if give edge weight, then need to modulate depending on
  46
+ * the type of the reference. 2 references to a function in another
  47
+ * module is more important than 10 references to some constructors.
  48
+ * Type|Exception > Function|Class|Global > Constructors|constants ?
  49
+ * 
  50
+ * todo: could annotate edges with the actual dependency
  51
+ * (a function name example, a type name example), that way maybe
  52
+ * in gephi we could see what an edge corresponds too (especially useful
  53
+ * with edge where we don't understand why there is a dependency).
  54
+ * 
  55
+ *)
  56
+
  57
+(*****************************************************************************)
  58
+(* Types *)
  59
+(*****************************************************************************)
  60
+(* filename in readable path *)
  61
+type ml_graph = Common.filename Graph.graph
  62
+
  63
+(*****************************************************************************)
  64
+(* Helpers *)
  65
+(*****************************************************************************)
  66
+
  67
+(* assumes get a readable path *)
  68
+let project ~package_depth file =
  69
+  let xs = Common.split "/" file in
  70
+  match package_depth with
  71
+  | 0 -> file
  72
+  | n ->
  73
+      (* todo? do something for n = 1? *)
  74
+      let xs' =
  75
+        match xs with
  76
+        (* todo: pfff specific ... *)
  77
+        | "external"::_-> 
  78
+            Common.take_safe 2 xs
  79
+        | "facebook"::"external"::x::xs-> 
  80
+            ["external";x]
  81
+        (* <=> dirname *)
  82
+        | _ -> Common.list_init xs
  83
+      in
  84
+      let s = Common.join "/" xs' in
  85
+      if s = "" then "."
  86
+      else s
  87
+
  88
+(*****************************************************************************)
  89
+(* Main entry point *)
  90
+(*****************************************************************************)
  91
+
  92
+let dependencies ?(verbose=true) ~with_extern ~package_depth dir =
  93
+  let root = Common.realpath dir in
  94
+  let files = Lib_parsing_ml.find_ml_files_of_dir_or_files [root] in
  95
+
  96
+  (* step0: adjust the set of files, to exclude noisy modules
  97
+   * or modules that would introduce false positive when do the 
  98
+   * modulename ->file lookup.
  99
+   *)
  100
+  let files = 
  101
+    files +> Common.exclude (fun file ->
  102
+      (* less: could also do a pfff_dependencies that just care about mli
  103
+       * like my make doti
  104
+       *)
  105
+      let (d,b,e) = Common.dbe_of_filename file in
  106
+      let xs = Common.split "/" d in
  107
+      let ml_file = Common.filename_of_dbe (d,b,"ml") in
  108
+
  109
+      (* todo: pfff specific ... *)
  110
+      let is_test_in_external =
  111
+        List.mem "external" xs &&
  112
+          xs +> List.exists (fun s ->
  113
+           match s with
  114
+           | "examples" | "tests" |  "test" 
  115
+           (* ocamlgraph and ocamlgtk specific *)
  116
+           | "dgraph" | "editor" | "view_graph" | "applications"
  117
+               -> true
  118
+           | _ -> false
  119
+          )
  120
+      in
  121
+      (* pad specific *)
  122
+      let is_old = List.mem "old" xs in
  123
+
  124
+      (* some files like in pfff/external/core/ do not have a .ml
  125
+       * so at least index the mli. otherwise skip the mli
  126
+       *)
  127
+      let is_mli_with_a_ml =
  128
+        e = "mli" && Sys.file_exists ml_file
  129
+      in
  130
+      is_test_in_external || is_mli_with_a_ml || is_old
  131
+    )
  132
+  in
  133
+  let g = G.create () in
  134
+
  135
+  (* step1: creating the nodes *)
  136
+  let h_module_to_node = Hashtbl.create 101 in
  137
+
  138
+  (* The PARSING_ERROR node beliw is in comment for now because 
  139
+   * it screws the graph. Moreover when in package mode, we don't want one 
  140
+   * of the file to make the whole package link to PARSING_ERROR. 
  141
+   * Moreover with a parsing error only the out-edges are missing;
  142
+   * the in-edges will work.
  143
+   * old: g +> G.add_vertex_if_not_present "PARSING_ERROR"; 
  144
+   *)
  145
+
  146
+  files +> List.iter (fun file ->
  147
+    let readable = Common.filename_without_leading_path root file in
  148
+    let node = project ~package_depth readable in
  149
+    g +> G.add_vertex_if_not_present node;
  150
+    let m = Module_ml.module_name_of_filename readable in
  151
+    Hashtbl.add h_module_to_node m node;
  152
+  );
  153
+  (* the hierarchical support is not that good in gephi right now from
  154
+   * what I've seen
  155
+   * 
  156
+   * let _tree = 
  157
+   * files 
  158
+   * +> Treemap.tree_of_dirs_or_files ~file_hook:(fun f -> ())
  159
+   * +> Common.map_tree
  160
+   * ~fnode:(fun f -> Common.filename_without_leading_path root f)
  161
+   * ~fleaf:(fun (f, _) -> Common.filename_without_leading_path root f)
  162
+   * ()
  163
+   * in
  164
+   * let _ = tree +> Common.map_tree
  165
+   * ~fnode:(fun dir -> g +> G.add_vertex_if_not_present dir)
  166
+   * ~fleaf:(fun f -> f)
  167
+   * in
  168
+   *)
  169
+
  170
+  (* step2: creating edges *)
  171
+  files +> Common.index_list_and_total +> List.iter (fun (file, i, total) ->
  172
+    if verbose then pr2 (spf "processing: %s (%d/%d)" file i total);
  173
+    let readable = Common.filename_without_leading_path root file in
  174
+    let node1 = project ~package_depth  readable in
  175
+    let ast = 
  176
+      Common.save_excursion Flag_parsing_ml.show_parsing_error false (fun ()->
  177
+        Parse_ml.parse_program file 
  178
+      )
  179
+    in
  180
+    (* when do module A = Foo, don't want to consider calls like A.foo *)
  181
+    let h_module_aliases = Hashtbl.create 101 in
  182
+
  183
+    let add_edge_if_existing_module s =
  184
+      if Hashtbl.mem h_module_aliases s
  185
+      then () 
  186
+      else 
  187
+       if Hashtbl.mem h_module_to_node s
  188
+       then 
  189
+        (match Hashtbl.find_all h_module_to_node s with
  190
+        | [node2] ->
  191
+            (* todo? do weighted graph? but then if do some pattern matching
  192
+             * on 20 constructors, is it more important than
  193
+             * 2 functions calls? Need to differentiate those different
  194
+             * use of the qualifier
  195
+             *)
  196
+            if node1 <> node2
  197
+            then g +> G.add_edge node1 node2
  198
+
  199
+        | _ -> ()
  200
+        )
  201
+      else
  202
+        if not with_extern 
  203
+        then pr2_once (spf "PB: could not find %s" s)
  204
+        else begin
  205
+          let node2 = "EXTERN/" ^ s in 
  206
+          g +> G.add_vertex_if_not_present node2;
  207
+          g +> G.add_edge node1 node2;
  208
+        end
  209
+    in
  210
+
  211
+    let visitor = V.mk_visitor { V.default_visitor with
  212
+      V.ktoplevel = (fun (k, _) x ->
  213
+        match x with
  214
+        | NotParsedCorrectly _ ->
  215
+            (* g +> G.add_edge node1 "PARSING_ERROR"; *)
  216
+            ()
  217
+        | _ -> k x
  218
+      );
  219
+      (* todo? does it cover all use cases of modules ? maybe need
  220
+       * to introduce a kmodule_name_ref helper in the visitor
  221
+       * that does that for us.
  222
+       * todo: if want to give more information on edges, need
  223
+       * to intercept the module name reference at a upper level
  224
+       * like in FunCallSimple. C-s for long_name in ast_ml.ml
  225
+       *)
  226
+      V.kmodule_expr = (fun (k, _) x ->
  227
+        (match x with
  228
+        | ModuleName (qu, (Name (s,_))) ->
  229
+            add_edge_if_existing_module s
  230
+        | _ -> ()
  231
+        );
  232
+        k x
  233
+      );
  234
+      V.kitem = (fun (k, _) x ->
  235
+        (match x with
  236
+        | Open (_tok, (qu, (Name (s,_)))) ->
  237
+            add_edge_if_existing_module s
  238
+        | ModuleAlias (_, Name (s,_), _, _) ->
  239
+            Hashtbl.add h_module_aliases s true;
  240
+        | _ -> ()
  241
+        );
  242
+        k x
  243
+      );
  244
+      V.kqualifier = (fun (k, _) xs ->
  245
+        (match xs with 
  246
+        | [Name (s, _), _tok] ->
  247
+            add_edge_if_existing_module s
  248
+        | _ -> ()
  249
+        );
  250
+        k xs
  251
+      );
  252
+    }
  253
+    in
  254
+    visitor (Program ast);
  255
+  );
  256
+  (* could put that in gephi.ml *)
  257
+  g +> G.add_vertex_if_not_present "SINGLE"; 
  258
+  g +> G.add_vertex_if_not_present "ONLY_TO_COMMON"; 
  259
+  let nodes = G.nodes g in
  260
+  nodes +> List.iter (fun n ->
  261
+    let succ = G.succ n g in
  262
+    let pred = G.pred n g in
  263
+    match succ, pred with
  264
+    | [], [] ->
  265
+        g +> G.add_edge n "SINGLE"
  266
+    | [x], [] ->
  267
+        if x = "commons"
  268
+        then g +> G.add_edge n "ONLY_TO_COMMON"
  269
+
  270
+    | [], _ ->
  271
+        ()
  272
+    | _, [] ->
  273
+        ()
  274
+    | x::xs, y::ys ->
  275
+        ()
  276
+  );
  277
+  g
9  lang_ml/analyze/graph_modules_packages_ml.mli
... ...
@@ -0,0 +1,9 @@
  1
+
  2
+(* filename in readable path *)
  3
+type ml_graph = Common.filename Graph.graph
  4
+
  5
+val dependencies: 
  6
+  ?verbose:bool ->
  7
+  with_extern:bool ->
  8
+  package_depth: int ->
  9
+  Common.dirname -> ml_graph
200  main.ml
@@ -9,7 +9,7 @@ open Common
9 9
 (* Purpose *)
10 10
 (*****************************************************************************)
11 11
 
12  
-(* A "driver" of the different parsers in pfff *)
  12
+(* A "driver" for the different parsers in pfff *)
13 13
 
14 14
 (*****************************************************************************)
15 15
 (* Flags *)
@@ -47,201 +47,6 @@ let test_json_pretty_printer file =
47 47
   let json = Json_in.load_json file in
48 48
   let s = Json_io.string_of_json json in
49 49
   pr s
50  
-
51  
-module V = Visitor_ml
52  
-module G = Graph
53  
-open Ast_ml
54  
-
55  
-(* filename in readable path *)
56  
-type ml_graph = Common.filename Graph.graph
57  
-
58  
-(* assumes get a readable path *)
59  
-let project file =
60  
-  let xs = Common.split "/" file in
61  
-  let xs' =
62  
-    match xs with
63  
-    | "external"::_-> 
64  
-        Common.take_safe 2 xs
65  
-    | "facebook"::"external"::x::xs-> 
66  
-        ["external";x]
67  
-
68  
-    | _ -> Common.list_init xs
69  
-  in
70  
-  let s = Common.join "/" xs' in
71  
-  if s = "" then "."
72  
-  else s
73  
-
74  
-let project file = file
75  
-
76  
-let pfff_gephi_dependencies dir output =
77  
-  let root = Common.realpath dir in
78  
-  let files = Lib_parsing_ml.find_ml_files_of_dir_or_files [root] in
79  
-  let files = 
80  
-    files +> Common.exclude (fun file ->
81  
-      (* less: could also do a pfff_dependencies that just care about mli
82  
-       * like my make doti
83  
-       *)
84  
-      let (d,b,e) = Common.dbe_of_filename file in
85  
-      let xs = Common.split "/" d in
86  
-      let ml_file = Common.filename_of_dbe (d,b,"ml") in
87  
-
88  
-      let is_test_in_external =
89  
-        List.mem "external" xs &&
90  
-          xs +> List.exists (fun s ->
91  
-           match s with
92  
-           | "examples" | "tests" |  "test" 
93  
-           | "dgraph" | "editor" | "view_graph" | "applications"
94  
-               -> true
95  
-           | _ -> false
96  
-          )
97  
-      in
98  
-      let is_old = List.mem "old" xs in
99  
-
100  
-      let is_mli_with_a_ml =
101  
-        e = "mli" && Sys.file_exists ml_file
102  
-      in
103  
-      is_test_in_external || is_mli_with_a_ml || is_old
104  
-    )
105  
-  in
106  
-  let _tree = 
107  
-    files 
108  
-    +> Treemap.tree_of_dirs_or_files ~file_hook:(fun f -> ())
109  
-    +> Common.map_tree
110  
-    ~fnode:(fun f -> Common.filename_without_leading_path root f)
111  
-    ~fleaf:(fun (f, _) -> Common.filename_without_leading_path root f)
112  
-  in
113  
-  
114  
-  let g = G.create () in
115  
-  let h_module_to_node = Hashtbl.create 101 in
116  
-(* 
117  
-   in comment for now because screw the graph, and when project,
118  
-   we don't want one of the file to make the whole package link
119  
-   to PARSING_ERROR. Moreover with a parsing error only the out-edges
120  
-   are missing. The in-edges will work.
121  
-   g +> G.add_vertex_if_not_present "PARSING_ERROR"; 
122  
-*)
123  
-  files +> List.iter (fun file ->
124  
-    let realpath = Common.filename_without_leading_path root file in
125  
-    let node = project realpath in
126  
-    g +> G.add_vertex_if_not_present node;
127  
-    let m = Module_ml.module_name_of_filename realpath in
128  
-    Hashtbl.add h_module_to_node m node;
129  
-  );
130  
-  (*
131  
-  let _ = tree +> Common.map_tree
132  
-    ~fnode:(fun dir -> g +> G.add_vertex_if_not_present dir)
133  
-    ~fleaf:(fun f -> f)
134  
-  in
135  
-  *)
136  
-
137  
-  files +> Common.index_list_and_total +> List.iter (fun (file, i, total) ->
138  
-    pr2 (spf "processing: %s (%d/%d)" file i total);
139  
-    let realpath = Common.filename_without_leading_path root file in
140  
-    let node1 = project realpath in
141  
-    let ast = 
142  
-      Common.save_excursion Flag_parsing_ml.show_parsing_error false (fun ()->
143  
-        Parse_ml.parse_program file 
144  
-      )
145  
-    in
146  
-    let h_module_aliases = Hashtbl.create 101 in
147  
-
148  
-    let add_edge_if_existing_module s =
149  
-      if Hashtbl.mem h_module_aliases s
150  
-      then () 
151  
-      else 
152  
-       if Hashtbl.mem h_module_to_node s
153  
-       then 
154  
-        (match Hashtbl.find_all h_module_to_node s with
155  
-        | [node2] ->
156  
-            (* todo? do weighted graph? but then if do some pattern matching
157  
-             * on 20 constructors, is it more important than
158  
-             * 2 functions calls? Need to differentiate those different
159  
-             * use of the qualifier
160  
-             *)
161  
-            if node1 <> node2
162  
-            then g +> G.add_edge node1 node2
163  
-
164  
-        | _ -> ()
165  
-        )
166  
-      else begin
167  
-        pr2_once (spf "PB: could not find %s" s);
168  
-(*
169  
-        let node2 = "EXTERN/" ^ s in 
170  
-        g +> G.add_vertex_if_not_present node2;
171  
-        g +> G.add_edge node1 node2;
172  
-*)
173  
-      end
174  
-          
175  
-    in
176  
-
177  
-    let visitor = V.mk_visitor { V.default_visitor with
178  
-      V.ktoplevel = (fun (k, _) x ->
179  
-        match x with
180  
-        | NotParsedCorrectly _ ->
181  
-            (* g +> G.add_edge node1 "PARSING_ERROR"; *)
182  
-            ()
183  
-        | _ -> k x
184  
-      );
185  
-      V.kmodule_expr = (fun (k, _) x ->
186  
-        (match x with
187  
-        | ModuleName (qu, (Name (s,_))) ->
188  
-            add_edge_if_existing_module s
189  
-        | _ -> ()
190  
-        );
191  
-        k x
192  
-      );
193  
-      V.kitem = (fun (k, _) x ->
194  
-        (match x with
195  
-        | Open (_tok, (qu, (Name (s,_)))) ->
196  
-            add_edge_if_existing_module s
197  
-        | ModuleAlias (_, Name (s,_), _, _) ->
198  
-            Hashtbl.add h_module_aliases s true;
199  
-        | _ -> ()
200  
-        );
201  
-        k x
202  
-      );
203  
-      V.kqualifier = (fun (k, _) xs ->
204  
-        (match xs with 
205  
-        | [Name (s, _), _tok] ->
206  
-            add_edge_if_existing_module s
207  
-        | _ -> ()
208  
-        );
209  
-        k xs
210  
-      );
211  
-    }
212  
-    in
213  
-    visitor (Program ast);
214  
-  );
215  
-  (* could put that in gephi.ml *)
216  
-  g +> G.add_vertex_if_not_present "SINGLE"; 
217  
-  g +> G.add_vertex_if_not_present "ONLY_TO_COMMON"; 
218  
-  let nodes = G.nodes g in
219  
-  nodes +> List.iter (fun n ->
220  
-    let succ = G.succ n g in
221  
-    let pred = G.pred n g in
222  
-    match succ, pred with
223  
-    | [], [] ->
224  
-        g +> G.add_edge n "SINGLE"
225  
-    | [x], [] ->
226  
-        if x = "commons"
227  
-        then g +> G.add_edge n "ONLY_TO_COMMON"
228  
-
229  
-    | [], _ ->
230  
-        ()
231  
-    | _, [] ->
232  
-        ()
233  
-    | x::xs, y::ys ->
234  
-        ()
235  
-  );
236  
-
237  
-  g +> Gephi.graph_to_gefx 
238  
-    ~str_of_node:(fun s -> s)
239  
-    ~tree:None
240  
-    ~weight_edges:None
241  
-    ~output;
242  
-  ()
243  
-
244  
-
245 50
   
246 51
 (* ---------------------------------------------------------------------- *)
247 52
 let pfff_extra_actions () = [
@@ -250,9 +55,6 @@ let pfff_extra_actions () = [
250 55
   
251 56
   "-layer_stat", " <file>",
252 57
   Common.mk_action_1_arg Test_program_lang.layer_stat;
253  
-
254  
-  "-pfff_gephi_dependencies", " <dir> <output>",
255  
-  Common.mk_action_2_arg pfff_gephi_dependencies;
256 58
 ]
257 59
 
258 60
 (*****************************************************************************)
169  main_pm_depend.ml
... ...
@@ -0,0 +1,169 @@
  1
+(*
  2
+ * Please imagine a long and boring gnu-style copyright notice 
  3
+ * appearing just here.
  4
+ *)
  5
+
  6
+open Common
  7
+
  8
+(*****************************************************************************)
  9
+(* Purpose *)
  10
+(*****************************************************************************)
  11
+
  12
+(* A module/package dependency visualizer generating data for gephi.
  13
+ * See http://gephi.org.
  14
+ * 
  15
+ * todo? have a backend for graphviz?
  16
+ *
  17
+ * usage: 
  18
+ *  $ pm_depend [-lang X] [-with-extern] [-depth n] -o pfff.gexf /path/to/dir
  19
+ *)
  20
+
  21
+(*****************************************************************************)
  22
+(* Flags *)
  23
+(*****************************************************************************)
  24
+
  25
+(* In addition to flags that can be tweaked via -xxx options (cf the
  26
+ * full list of options in the "the options" section below), this 
  27
+ * program also depends on external files ?
  28
+ *)
  29
+
  30
+let verbose = ref false
  31
+
  32
+let with_extern = ref false
  33
+let package_depth = ref 0
  34
+
  35
+let lang = ref "ml"
  36
+
  37
+let output_file = ref "/tmp/pm.gexf"
  38
+
  39
+(* action mode *)
  40
+let action = ref ""
  41
+
  42
+(*****************************************************************************)
  43
+(* Some  debugging functions *)
  44
+(*****************************************************************************)
  45
+
  46
+(*****************************************************************************)
  47
+(* Helpers *)
  48
+(*****************************************************************************)
  49
+
  50
+(*****************************************************************************)
  51
+(* Language specific *)
  52
+(*****************************************************************************)
  53
+
  54
+let rec dependencies_of_files_or_dirs lang xs = 
  55
+  let verbose = !verbose in
  56
+  match lang, xs with
  57
+  | "ml", [dir] ->
  58
+      Graph_modules_packages_ml.dependencies
  59
+        ~verbose
  60
+        ~with_extern:!with_extern
  61
+        ~package_depth:!package_depth
  62
+        dir
  63
+  | _ -> failwith ("language not supported: " ^ lang)
  64
+      
  65
+(*****************************************************************************)
  66
+(* Main action *)
  67
+(*****************************************************************************)
  68
+
  69
+let main_action xs =
  70
+  let g = dependencies_of_files_or_dirs !lang xs in
  71
+  pr2 (spf "Writing data in %s" !output_file);
  72
+  g +> Gephi.graph_to_gefx 
  73
+    ~str_of_node:(fun s -> s)
  74
+    ~tree:None
  75
+    ~weight_edges:None
  76
+    ~output:!output_file;
  77
+  ()
  78
+
  79
+(*****************************************************************************)
  80
+(* Extra Actions *)
  81
+(*****************************************************************************)
  82
+
  83
+(* ---------------------------------------------------------------------- *)
  84
+let pfff_extra_actions () = [
  85
+]
  86
+
  87
+(*****************************************************************************)
  88
+(* The options *)
  89
+(*****************************************************************************)
  90
+
  91
+let all_actions () = 
  92
+  []
  93
+
  94
+let options () = 
  95
+  [
  96
+    "-with_extern", Arg.Set with_extern,
  97
+    " includes external references";
  98
+    "-package_mode", Arg.Set_int package_depth,
  99
+    " <n> project at depth n";
  100
+    "-verbose", Arg.Set verbose, 
  101
+    " ";
  102
+    "-lang", Arg.Set_string lang, 
  103
+    (spf " <str> choose language (default = %s)" !lang);
  104
+    "-o", Arg.Set_string output_file, 
  105
+    (spf " <file> default = %s" !output_file);
  106
+  ] ++
  107
+  Common.options_of_actions action (all_actions()) ++
  108
+  Common.cmdline_flags_devel () ++
  109
+  Common.cmdline_flags_other () ++
  110
+  [
  111
+    "-version",   Arg.Unit (fun () -> 
  112
+      pr2 (spf "pm_depend version: %s" Config.version);
  113
+      exit 0;
  114
+    ), 
  115
+    "  guess what";
  116
+    (* this can not be factorized in Common *)
  117
+    "-date",   Arg.Unit (fun () -> 
  118
+      pr2 "version: $Date: 2011/09/01 00:44:57 $";
  119
+      raise (Common.UnixExit 0)
  120
+    ), 
  121
+    "   guess what";
  122
+  ] ++
  123
+  []
  124
+
  125
+(*****************************************************************************)
  126
+(* Main entry point *)
  127
+(*****************************************************************************)
  128
+
  129
+let main () = 
  130
+  (* Common_extra.set_link(); *)
  131
+  let usage_msg = 
  132
+    "Usage: " ^ basename Sys.argv.(0) ^ 
  133
+      " [options] <file or dir> " ^ "\n" ^ "Options are:"
  134
+  in
  135
+  (* does side effect on many global flags *)
  136
+  let args = Common.parse_options (options()) usage_msg Sys.argv in
  137
+
  138
+  (* must be done after Arg.parse, because Common.profile is set by it *)
  139
+  Common.profile_code "Main total" (fun () -> 
  140
+    (match args with
  141
+    (* --------------------------------------------------------- *)
  142
+    (* actions, useful to debug subpart *)
  143
+    (* --------------------------------------------------------- *)
  144
+    | xs when List.mem !action (Common.action_list (all_actions())) -> 
  145
+        Common.do_action !action xs (all_actions())
  146
+
  147
+    | _ when not (Common.null_string !action) -> 
  148
+        failwith ("unrecognized action or wrong params: " ^ !action)
  149
+
  150
+    (* --------------------------------------------------------- *)
  151
+    (* main entry *)
  152
+    (* --------------------------------------------------------- *)
  153
+    | x::xs -> 
  154
+        main_action (x::xs)
  155
+
  156
+    (* --------------------------------------------------------- *)
  157
+    (* empty entry *)
  158
+    (* --------------------------------------------------------- *)
  159
+    | [] -> 
  160
+        Common.usage usage_msg (options()); 
  161
+        failwith "too few arguments"
  162
+    )
  163
+  )
  164
+
  165
+(*****************************************************************************)
  166
+let _ =
  167
+  Common.main_boilerplate (fun () -> 
  168
+    main ();
  169
+  )

0 notes on commit 7966cbd

Please sign in to comment.
Something went wrong with that request. Please try again.