This repository has been archived by the owner on Jun 4, 2019. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 204
/
main_codequery.ml
232 lines (197 loc) · 8.17 KB
/
main_codequery.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
(*
* Please imagine a long and boring gnu-style copyright notice
* appearing just here.
*)
open Common
(*****************************************************************************)
(* Purpose *)
(*****************************************************************************)
(*
* An interactive tool a la SQL to query information about the structure
* of a codebase (the inheritance tree, the call graph, the data graph),
* for instance "What are all the children of class Foo?".
* The data is the code. The query language is
* Prolog (http://en.wikipedia.org/wiki/Prolog), a logic-based
* programming language used mainly in AI but also popular in database
* (http://en.wikipedia.org/wiki/Datalog).
*
* See h_program-lang/database_code.pl for more information
*)
(*****************************************************************************)
(* Flags *)
(*****************************************************************************)
let verbose = ref false
let lang = ref "php"
(* todo: swipl (SWI-Prolog) is not in PATH by default on our machines *)
let swipl_fb = "/home/pad/packages/Linux/bin/swipl"
let swipl =
if Sys.file_exists swipl_fb
then swipl_fb
else "swipl"
let predicates_file =
Filename.concat Config_pfff.path "h_program-lang/database_code.pl"
(* todo: should remove that at some point and be able to do everything in RAM *)
let metapath = ref "/tmp/pfff_db"
(* action mode *)
let action = ref ""
(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)
(*****************************************************************************)
(* Language specific, building the prolog db *)
(*****************************************************************************)
let build_prolog_db lang root =
let root = Common.realpath root +> Common2.chop_dirsymbol in
let files = Find_source.files_of_root ~lang:"lang" root in
match lang with
| "php" ->
(*
* todo:
* - do things in parallel, pack things.
* => should significantly reduce the time to produce the
* prolog facts. It currently takes 41min on www and I hope
* we can reduce that to a few minutes.
*)
(* so many errors that is better to hide them for now *)
Flag_analyze_php.show_errors := false;
let facts_pl_file = "facts.pl" in
let prolog_compiled_db = "prolog_compiled_db" in
let file = Filename.concat !metapath facts_pl_file in
pr2 (spf "generating prolog facts in %s" file);
let facts =
Database_prolog_php.build ~show_progress:!verbose root files in
Common.command2 (spf "mkdir -p %s" !metapath);
Common.with_open_outfile file (fun (pr_no_nl, _chan) ->
let pr s = pr_no_nl (s ^ "\n") in
facts +> List.iter (fun fact ->
pr (Graph_code_prolog.string_of_fact fact);
)
);
pr2 (spf "compiling prolog facts with swipl in %s/%s"
!metapath prolog_compiled_db);
Common.command2 (spf "%s -c %s/%s %s"
swipl !metapath facts_pl_file predicates_file);
Common.command2 (spf "mv a.out %s/%s" !metapath prolog_compiled_db);
pr2 "";
pr2 (spf "Your compiled prolog DB is ready. Run %s/%s"
!metapath prolog_compiled_db);
| "cmt" | "bytecode" | "clang2" ->
let g =
match lang with
| "cmt" ->
let ml_files = Find_source.files_of_root ~lang:"ml" root in
let cmt_files = files in
Graph_code_cmt.build ~verbose:!verbose ~root ~cmt_files ~ml_files
| "bytecode" ->
let graph_code_java =
(* Some (Graph_code_java.build ~verbose:!verbose ~only_defs:true
root skip_list)
*)
None
in
Graph_code_bytecode.build ~verbose:!verbose ~graph_code_java
root files
| "clang2" -> Graph_code_clang.build ~verbose:!verbose root files
| _ -> raise Impossible
in
let facts = Graph_code_prolog.build g in
let facts_pl_file = Filename.concat root "facts.pl" in
Common.with_open_outfile facts_pl_file (fun (pr_no_nl, _chan) ->
let pr s = pr_no_nl (s ^ "\n") in
facts +> List.iter (fun x -> pr (Graph_code_prolog.string_of_fact x))
);
let prolog_compiled_db = Filename.concat root "prolog_compiled_db" in
Common.command2 (spf "%s -c %s %s" swipl facts_pl_file predicates_file);
Common.command2 (spf "mv a.out %s" prolog_compiled_db);
pr2 (spf "Your compiled proog DB is ready. Run %s" prolog_compiled_db);
()
| _ -> failwith ("language not yet supported: " ^ lang)
(*****************************************************************************)
(* Main action *)
(*****************************************************************************)
let main_action _xs =
Logger.log Config_pfff.logger "codequery" None;
raise Todo
(*****************************************************************************)
(* Extra Actions *)
(*****************************************************************************)
(*---------------------------------------------------------------------------*)
(* regression testing *)
(*---------------------------------------------------------------------------*)
let test () =
let suite = Unit_prolog_php.unittest in
OUnit.run_test_tt suite +> ignore;
()
(* ---------------------------------------------------------------------- *)
let extra_actions () = [
"-build", " <dir> source code to analyze",
Common.mk_action_1_arg (fun dir -> build_prolog_db !lang dir);
"-test", " run regression tests",
Common.mk_action_0_arg test;
]
(*****************************************************************************)
(* The options *)
(*****************************************************************************)
let all_actions () =
extra_actions () @
[]
let options () = [
"-lang", Arg.Set_string lang,
(spf " <str> choose language (default = %s)" !lang);
"-metapath", Arg.Set_string metapath,
(spf " <dir> where to put the data (default = %s)" !metapath);
"-verbose", Arg.Unit (fun () ->
verbose := true;
Flag_analyze_php.verbose_database := true;
), " ";
] @
Common.options_of_actions action (all_actions()) @
Common2.cmdline_flags_devel () @
[
"-version", Arg.Unit (fun () ->
pr2 (spf "CodeQuery version: %s" Config_pfff.version);
exit 0;
),
" guess what";
]
(*****************************************************************************)
(* Main entry point *)
(*****************************************************************************)
let main () =
Gc.set {(Gc.get ()) with Gc.stack_limit = 200 * 1024 * 1024};
Flag_analyze_php.verbose_database := false;
let usage_msg =
spf "Usage: %s [options] <dir> \nDoc: %s\nOptions:"
(Common2.basename Sys.argv.(0))
"https://github.com/facebook/pfff/wiki/Codequery"
in
(* does side effect on many global flags *)
let args = Common.parse_options (options()) usage_msg Sys.argv in
(* must be done after Arg.parse, because Common.profile is set by it *)
Common.profile_code "Main total" (fun () ->
(match args with
(* --------------------------------------------------------- *)
(* actions, useful to debug subpart *)
(* --------------------------------------------------------- *)
| xs when List.mem !action (Common.action_list (all_actions())) ->
Common.do_action !action xs (all_actions())
| _ when not (Common.null_string !action) ->
failwith ("unrecognized action or wrong params: " ^ !action)
(* --------------------------------------------------------- *)
(* main entry *)
(* --------------------------------------------------------- *)
| x::xs ->
main_action (x::xs)
(* --------------------------------------------------------- *)
(* empty entry *)
(* --------------------------------------------------------- *)
| [] ->
Common.usage usage_msg (options());
failwith "too few arguments"
)
)
(*****************************************************************************)
let _ =
Common.main_boilerplate (fun () ->
main ();
)