-
Notifications
You must be signed in to change notification settings - Fork 125
/
checkopacapi.ml
379 lines (332 loc) · 10.5 KB
/
checkopacapi.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
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
(*
Copyright © 2011 MLstate
This file is part of OPA.
OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
(**
Checking consistency between opabsl, stdlib et opacapi.
@author Mathieu Barbin
*)
(**
OPA COMPILER INTERFACE:
The OPA compiler needs to insert some call to identifiers and external primitives
defined in the stdlib, and in the opabsl. The set of these identifers and primitives
is called : opa-compiler-interface.
We want to be able, by reading the definition of a bypass, or by reading the definition
of a identifier in the stdlib, to know if it is part of this compiler interface.
It is necessary to have a better control on dependency between the stdlib, and the compiler.
(consistency, maintenance, etc.)
For that purpose, we decorate the opa-compiler-interface in the stdlib and opabsl,
and we use opacapi in the compiler.
STDLIB:
{[
@opacapi myfunction()=....
]}
OPABSL:
{[
##register [opacapi] mybypass : ...
]}
OPACAPI:
{[
mybypass = "mybypass"
myfunction = "myfunction"
]}
COMPILER:
{[
let myfunction = Opacapi.myfunction in
...
]}
This check will ensure that :
-the set of all identifier defined in opacapi is strictly equal to the set of identifiers
decorated with the directive [@opacapi] in the stdlib,
-the set of all bypass defined in opacapi is strictly equal to the set of bypasses
decorated with the property [opacapi] in the opabsl
If a bypass is not in opacapi, nor present in the stdlib, there will be a notification.
Since it is not yet clear what we want to do with such cases, currently a warning
is printed.
A file is generated indicating for each bsl-key the list of location where it is used.
*)
(* depends *)
module Arg = Base.Arg
module Format = Base.Format
(* shorthand *)
module BPI = BslPluginInterface
module D = SurfaceAstDecons
module Q = QmlAst
module SA = SurfaceAst
(* -- *)
let _ = OpaSyntax.Args.r := {!OpaSyntax.Args.r with OpaSyntax.Args.parser = OpaSyntax.Classic}
let validation_ok = ref true
(* f *)
let files = MutableList.create ()
(* t *)
let target = ref None
let (|>) = InfixOperator.(|>)
let (!>) = Format.sprintf
let spec = [
(* o *)
"-o",
Arg.String (fun t -> target := Some t),
!>
" specify a target for the trace file"
]
let anon_fun file = MutableList.add files file
let usage_msg =
!> "@{<bright>%s@}: Opa Compiler Interface Validator %s\nUsage: %s [options] stdlib-files\n"
Sys.argv.(0) BuildInfos.version_id
Sys.argv.(0)
let parse () =
let spec = (
(OManager.Arg.version "checkopacapi" :: OManager.Arg.options) @
spec
)
|> Arg.add_bash_completion
|> Arg.sort
|> Arg.align
in
Arg.parse spec anon_fun (usage_msg^"Options:")
(**
Folding input file, and applying a fold on the parsed code
*)
(**
pplib specification
*)
let pplib_spec = [
"OPA_CPS", "" ;
"OPA_BADOP", "1" ;
]
let pprocess =
let ppenv = Pprocess.fill_with_sysenv Pprocess.empty_env in
let ppenv = List.fold_left (fun ppenv (var, value) -> Pprocess.add_env var value ppenv) ppenv pplib_spec in
let ppopt = Pprocess.default_options ppenv in
(fun s -> Pprocess.process Pplang.opa_description ppopt s)
let fold
( fold : (SurfaceAst.nonuid, SurfaceAst.parsing_directive) SurfaceAst.code -> 'acc -> 'acc )
filename acc =
(* print_endline filename; *)
match File.content_opt filename with
| None ->
OManager.error "[!] I/O error: cannot read file @{<bright>%S@}" filename
| Some content ->
let content = pprocess content in
let code = OpaParser.code ~cache:true ~filename content in
fold code acc
(**
Specialized fold, for gathering opacapi directives
*)
let is_opacapi e =
D.Look.at
~through:[
D.Remove.Basic.access_directive ;
D.Remove.Basic.expand ;
D.Remove.Basic.coerce ;
D.Remove.Basic.deprecated ;
D.Remove.Basic.magic_directive ;
D.Remove.Basic.slicer_directive ;
]
~at:[D.Remove.Basic.opacapi]
e
let stdlib acc code =
let fold_elt acc (elt, _) =
match elt with
| SA.NewVal (binds, _) ->
let fold acc ((p, _), e) =
match p with
| SA.PatVar ident | SA.PatAs (_, ident) ->
if is_opacapi e
then StringSet.add ident.SA.ident acc
else acc
| _ -> acc
in
List.fold_left fold acc binds
| SA.NewType typedefs ->
let fold acc (typedef, _) =
if typedef.SA.ty_def_options.Q.opacapi
then
let (SA.Typeident ident) = typedef.SA.ty_def_name in
StringSet.add ident acc
else
acc
in
List.fold_left fold acc typedefs
| _ -> acc
in
List.fold_left fold_elt acc code
(**
Check strict equality between 2 StringSet, with errors reporting.
*)
let report elt name present absent set =
validation_ok := false ;
OManager.printf (
"[!] The %s @{<bright>%s@} is present in @{<bright>%s@} but not in @{<bright>%s@}@\n@{<bright>%s@} set: %a@.@."
)
elt name present absent absent
(StringSet.pp "," Format.pp_print_string) set
let strict_equality elt name1 name2 set1 set2 =
let iter name1 name2 set1 set2 =
let error name = report elt name name1 name2 set2 in
StringSet.iter (fun s -> if not (StringSet.mem s set2) then error s) set1
in
iter name1 name2 set1 set2;
iter name2 name1 set2 set1
module LocMap = ListMap.Make(BslKey)
let core_types =
[
"char";
"float";
"int";
"OPA.Init.value";
"string";
"tuple_2";
"void";
]
let _ =
(* Part 1: bsl VS opacapi *)
OpabslgenPlugin.Self.self_store ();
parse ();
let plugins = BslPluginTable.finalize () in
let module B = BslLib.BSL in
List.iter (fun loader -> B.RegisterInterface.dynload loader.BPI.dynloader) plugins;
let bymap = B.RegisterTable.build_bypass_map () in
let opabsl =
let fold key bypass acc =
let fold acc impl =
let tags = B.Implementation.bsltags impl in
if tags.BslTags.opacapi
then StringSet.add (BslKey.to_string key) acc
else acc
in
let impls = B.ByPass.all_implementations bypass in
List.fold_left fold acc impls
in
B.ByPassMap.fold fold bymap StringSet.empty
in
let opacapi =
Hashtbl.fold
(fun key _ acc -> StringSet.add (BslKey.to_string key) acc)
Opacapi.Opabsl.table StringSet.empty in
strict_equality "bypass" "opabsl" "opacapi" opabsl opacapi;
(* Get the code of stdlib *)
let codes = MutableList.fold_right (fold (fun hd tl -> hd::tl)) files [] in
(* Part 2: stdlib VS opacapi *)
let stdlib = List.fold_left stdlib StringSet.empty codes in
let stdlib = List.fold_left (fun acc ident -> StringSet.add ident acc) stdlib core_types in
(* THIS LINE IS AN HACK - SHOW COMMIT WHERE I AM INTRODUCES*)
let stdlib = StringSet.add "``" stdlib in
let opacapi =
Hashtbl.fold
(fun ident _ acc -> StringSet.add ident acc)
Opacapi.table StringSet.empty in
strict_equality "ident" "stdlib" "opacapi" stdlib opacapi;
if not !validation_ok then exit 1;
(* Part 3: collect position where bypass are used *)
let opacapi_pos = FilePos.nopos "opacapi" in
let locmap = LocMap.empty in
let locmap =
Hashtbl.fold
(fun key _ acc -> LocMap.append key opacapi_pos acc)
Opacapi.Opabsl.table locmap in
let locmap =
let fold acc (e, annot) =
match e with
| SA.Bypass key ->
let pos = QmlLoc.pos annot in
LocMap.append key pos acc
| _ -> acc
in
let fold = OpaWalk.Code.fold fold in
List.fold_left fold locmap codes
in
(* Part 4: generate the log *)
let oc, close_out =
match !target with
| Some file -> (
try
Pervasives.open_out file
with
| Sys_error s ->
OManager.error "cannot open_out %s : %s" file s
), Pervasives.close_out_noerr
| None ->
Pervasives.stdout, (fun _ -> ())
in
let fmt = Format.formatter_of_out_channel oc in
let iter key locs =
Format.fprintf fmt "@[<2>%a:@\n%a@]@\n"
BslKey.pp key (Format.pp_list "@\n" FilePos.pp_pos) locs
in
LocMap.iter iter locmap;
(* Part 5: notify bypass which are not used *)
let both_unused = ref [] in
let client_unused = ref [] in
let server_unused = ref [] in
let all_bypass = ref 0 in
let unused_bypass = ref 0 in
let iter key bypass =
incr(all_bypass);
match LocMap.find_opt key locmap with
| Some [] | None ->
(* This means that a bypass is registred, but never used in the stdlib. *)
let table =
if B.ByPass.implemented_in bypass ~lang:BslLanguage.js
then
if B.ByPass.implemented_in bypass ~lang:BslLanguage.ml
then both_unused
else client_unused
else
if B.ByPass.implemented_in bypass ~lang:BslLanguage.ml
then server_unused
else (
OManager.printf "checkopacapi: %a@\n" BslKey.pp key ;
assert false
)
in
incr(unused_bypass);
table := key :: !table
| _ -> ()
in
B.ByPassMap.iter iter bymap ;
let notify kind table =
let num = ref 0 in
let list = List.rev_map (fun t -> incr(num); t) !table in
if !num > 0
then (
Format.fprintf fmt (
"Warning: the %d following bypass implemented @@%s are unused:@\n"
) !num kind;
List.iter (fun key -> Format.fprintf fmt "%a@\n" BslKey.pp key) list
);
!num
in
let num_both = notify "both" both_unused in
let num_client = notify "client" client_unused in
let num_server = notify "server" server_unused in
let percent =
(float_of_int !unused_bypass) /. (float_of_int !all_bypass) *. 100.
in
Format.pp_print_flush fmt ();
close_out oc;
if !unused_bypass > 0 then
OManager.printf (
"@{<yellow>Warning@}: opabsl contains %f %% of unused bypass: (%d / %d)@\n"^^
" %d both@\n"^^
" %d client@\n"^^
" %d server@\n"^^
"cf file @{<bright>opacapi.validation@} for details@\n"
)
percent
!unused_bypass
!all_bypass
num_both
num_client
num_server
;
exit 0