Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 391 lines (343 sloc) 11.337 kB
fccc685 Initial open-source release
MLstate authored
1 (*
f4bd094 @OpaOnWindowsNow [fix] preprocessing,error: add file and line position
OpaOnWindowsNow authored
2 Copyright © 2011, 2012 MLstate
fccc685 Initial open-source release
MLstate authored
3
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
4 This file is part of Opa.
fccc685 Initial open-source release
MLstate authored
5
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
6 Opa is free software: you can redistribute it and/or modify it under the
fccc685 Initial open-source release
MLstate authored
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
10 Opa is distributed in the hope that it will be useful, but WITHOUT ANY
fccc685 Initial open-source release
MLstate authored
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
16 along with Opa. If not, see <http://www.gnu.org/licenses/>.
fccc685 Initial open-source release
MLstate authored
17 *)
18 (**
19 Checking consistency between opabsl, stdlib et opacapi.
20 @author Mathieu Barbin
21 *)
22
23 (**
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
24 Opa COMPILER INTERFACE:
fccc685 Initial open-source release
MLstate authored
25
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
26 The Opa compiler needs to insert some call to identifiers and external primitives
fccc685 Initial open-source release
MLstate authored
27 defined in the stdlib, and in the opabsl. The set of these identifers and primitives
28 is called : opa-compiler-interface.
29
30 We want to be able, by reading the definition of a bypass, or by reading the definition
31 of a identifier in the stdlib, to know if it is part of this compiler interface.
32 It is necessary to have a better control on dependency between the stdlib, and the compiler.
33 (consistency, maintenance, etc.)
34
35 For that purpose, we decorate the opa-compiler-interface in the stdlib and opabsl,
36 and we use opacapi in the compiler.
37
38 STDLIB:
39 {[
40 @opacapi myfunction()=....
41 ]}
42
43 OPABSL:
44 {[
45 ##register [opacapi] mybypass : ...
46 ]}
47
48 OPACAPI:
49 {[
50 mybypass = "mybypass"
51 myfunction = "myfunction"
52 ]}
53
54 COMPILER:
55 {[
56 let myfunction = Opacapi.myfunction in
57 ...
58 ]}
59
60 This check will ensure that :
61 -the set of all identifier defined in opacapi is strictly equal to the set of identifiers
62 decorated with the directive [@opacapi] in the stdlib,
63 -the set of all bypass defined in opacapi is strictly equal to the set of bypasses
64 decorated with the property [opacapi] in the opabsl
65
66 If a bypass is not in opacapi, nor present in the stdlib, there will be a notification.
67 Since it is not yet clear what we want to do with such cases, currently a warning
68 is printed.
69
70 A file is generated indicating for each bsl-key the list of location where it is used.
71 *)
72
73 (* depends *)
74 module Arg = Base.Arg
75 module Format = Base.Format
76
77 (* shorthand *)
78 module BPI = BslPluginInterface
79 module D = SurfaceAstDecons
80 module Q = QmlAst
81 module SA = SurfaceAst
82
83 (* -- *)
84
5e9da00 @BourgerieQuentin [enhance] compiler, syntax: Default syntax is now js-like
BourgerieQuentin authored
85 let _ = OpaSyntax.Args.r := {!OpaSyntax.Args.r with OpaSyntax.Args.parser = OpaSyntax.Classic}
86
fccc685 Initial open-source release
MLstate authored
87 let validation_ok = ref true
88
89 (* f *)
90
91 let files = MutableList.create ()
d4519cc @BourgerieQuentin [enhance] opacapi: Added plugins to opacapi
BourgerieQuentin authored
92 let fopps = MutableList.create ()
fccc685 Initial open-source release
MLstate authored
93
94 (* t *)
95
96 let target = ref None
97
98 let (|>) = InfixOperator.(|>)
99 let (!>) = Format.sprintf
100
101 let spec = [
102
103 (* o *)
104 "-o",
105 Arg.String (fun t -> target := Some t),
106 !>
107 " specify a target for the trace file"
108
109 ]
110
d4519cc @BourgerieQuentin [enhance] opacapi: Added plugins to opacapi
BourgerieQuentin authored
111 let anon_fun file =
112 let ext = File.extension file in
113 match ext with
114 | "opa" -> MutableList.add files file
115 | "opp" -> MutableList.add fopps file
116 | _ -> OManager.error "Error with @{<bright>%S@} because file extension @{<bright>%S@} is unknown" file ext
fccc685 Initial open-source release
MLstate authored
117
118 let usage_msg =
9a4a8ee [enhance] help/manpages: global pass for improving help messages of O…
Mathieu Baudet authored
119 !> "@{<bright>%s@}: Opa Compiler Interface Validator %s\nUsage: %s [options] stdlib-files\n"
fccc685 Initial open-source release
MLstate authored
120 Sys.argv.(0) BuildInfos.version_id
121 Sys.argv.(0)
122
123 let parse () =
124 let spec = (
125 (OManager.Arg.version "checkopacapi" :: OManager.Arg.options) @
126 spec
127 )
128
129 |> Arg.add_bash_completion
130 |> Arg.sort
131 |> Arg.align
132
133 in
9a4a8ee [enhance] help/manpages: global pass for improving help messages of O…
Mathieu Baudet authored
134 Arg.parse spec anon_fun (usage_msg^"Options:")
fccc685 Initial open-source release
MLstate authored
135
136 (**
137 Folding input file, and applying a fold on the parsed code
138 *)
139
140 (**
141 pplib specification
142 *)
143 let pplib_spec = [
144 "OPA_CPS", "" ;
145 "OPA_BADOP", "1" ;
146 ]
147
148 let pprocess =
149 let ppenv = Pprocess.fill_with_sysenv Pprocess.empty_env in
150 let ppenv = List.fold_left (fun ppenv (var, value) -> Pprocess.add_env var value ppenv) ppenv pplib_spec in
151 let ppopt = Pprocess.default_options ppenv in
f4bd094 @OpaOnWindowsNow [fix] preprocessing,error: add file and line position
OpaOnWindowsNow authored
152 Pprocess.process Pplang.opa_description ppopt
fccc685 Initial open-source release
MLstate authored
153
154 let fold
155 ( fold : (SurfaceAst.nonuid, SurfaceAst.parsing_directive) SurfaceAst.code -> 'acc -> 'acc )
156 filename acc =
157 (* print_endline filename; *)
158 match File.content_opt filename with
159 | None ->
160 OManager.error "[!] I/O error: cannot read file @{<bright>%S@}" filename
161 | Some content ->
f4bd094 @OpaOnWindowsNow [fix] preprocessing,error: add file and line position
OpaOnWindowsNow authored
162 let content = pprocess ~name:filename content in
fccc685 Initial open-source release
MLstate authored
163 let code = OpaParser.code ~cache:true ~filename content in
164 fold code acc
165
166 (**
167 Specialized fold, for gathering opacapi directives
168 *)
169 let is_opacapi e =
170 D.Look.at
171 ~through:[
172 D.Remove.Basic.access_directive ;
173 D.Remove.Basic.expand ;
174 D.Remove.Basic.coerce ;
175 D.Remove.Basic.deprecated ;
176 D.Remove.Basic.magic_directive ;
177 D.Remove.Basic.slicer_directive ;
178 ]
179 ~at:[D.Remove.Basic.opacapi]
180 e
181
182 let stdlib acc code =
183 let fold_elt acc (elt, _) =
184 match elt with
185 | SA.NewVal (binds, _) ->
186 let fold acc ((p, _), e) =
187 match p with
188 | SA.PatVar ident | SA.PatAs (_, ident) ->
189 if is_opacapi e
46769f1 @OpaOnWindowsNow [feature] surfaceAst: create bind_ident (and use in pattern) node to …
OpaOnWindowsNow authored
190 then StringSet.add ident.SA.ident acc
fccc685 Initial open-source release
MLstate authored
191 else acc
192 | _ -> acc
193 in
194 List.fold_left fold acc binds
195 | SA.NewType typedefs ->
196 let fold acc (typedef, _) =
197 if typedef.SA.ty_def_options.Q.opacapi
198 then
199 let (SA.Typeident ident) = typedef.SA.ty_def_name in
200 StringSet.add ident acc
201 else
202 acc
203 in
204 List.fold_left fold acc typedefs
205 | _ -> acc
206 in
207 List.fold_left fold_elt acc code
208
209 (**
210 Check strict equality between 2 StringSet, with errors reporting.
211 *)
5242af3 @BourgerieQuentin [enhance] compiler: Add compiler packages (Import packages that not p…
BourgerieQuentin authored
212 let report elt name present absent set =
fccc685 Initial open-source release
MLstate authored
213 validation_ok := false ;
214 OManager.printf (
5242af3 @BourgerieQuentin [enhance] compiler: Add compiler packages (Import packages that not p…
BourgerieQuentin authored
215 "[!] The %s @{<bright>%s@} is present in @{<bright>%s@} but not in @{<bright>%s@}@\n@{<bright>%s@} set: %a@.@."
fccc685 Initial open-source release
MLstate authored
216 )
5242af3 @BourgerieQuentin [enhance] compiler: Add compiler packages (Import packages that not p…
BourgerieQuentin authored
217 elt name present absent absent
218 (StringSet.pp "," Format.pp_print_string) set
fccc685 Initial open-source release
MLstate authored
219
220 let strict_equality elt name1 name2 set1 set2 =
221 let iter name1 name2 set1 set2 =
5242af3 @BourgerieQuentin [enhance] compiler: Add compiler packages (Import packages that not p…
BourgerieQuentin authored
222 let error name = report elt name name1 name2 set2 in
fccc685 Initial open-source release
MLstate authored
223 StringSet.iter (fun s -> if not (StringSet.mem s set2) then error s) set1
224 in
225 iter name1 name2 set1 set2;
226 iter name2 name1 set2 set1
227
228 module LocMap = ListMap.Make(BslKey)
229
230
231 let core_types =
232 [
233 "float";
234 "int";
235 "OPA.Init.value";
236 "string";
237 "tuple_2";
238 "void";
239 ]
240
241 let _ =
d4519cc @BourgerieQuentin [enhance] opacapi: Added plugins to opacapi
BourgerieQuentin authored
242 (* Part 1: plugins VS opacapi *)
6ace2c3 @arthuraa [fix] build, opabsl: make main binaries compile.
arthuraa authored
243 OpabslPlugin.Self.self_store ();
fccc685 Initial open-source release
MLstate authored
244 parse ();
d4519cc @BourgerieQuentin [enhance] opacapi: Added plugins to opacapi
BourgerieQuentin authored
245 let cwd = Sys.getcwd () in
246 MutableList.iter
247 (fun opp ->
248 let plugin = BslConvention.inclusion ~cwd opp in
249 BslDynlink.load_bypass_plugin (BslDynlink.MarshalPlugin plugin.BslConvention.plugin))
250 fopps;
fccc685 Initial open-source release
MLstate authored
251 let plugins = BslPluginTable.finalize () in
252 let module B = BslLib.BSL in
253 List.iter (fun loader -> B.RegisterInterface.dynload loader.BPI.dynloader) plugins;
254 let bymap = B.RegisterTable.build_bypass_map () in
255 let opabsl =
256 let fold key bypass acc =
257 let fold acc impl =
258 let tags = B.Implementation.bsltags impl in
259 if tags.BslTags.opacapi
260 then StringSet.add (BslKey.to_string key) acc
261 else acc
262 in
263 let impls = B.ByPass.all_implementations bypass in
264 List.fold_left fold acc impls
265 in
266 B.ByPassMap.fold fold bymap StringSet.empty
267 in
268
269 let opacapi =
270 Hashtbl.fold
271 (fun key _ acc -> StringSet.add (BslKey.to_string key) acc)
272 Opacapi.Opabsl.table StringSet.empty in
273 strict_equality "bypass" "opabsl" "opacapi" opabsl opacapi;
274 (* Get the code of stdlib *)
275 let codes = MutableList.fold_right (fold (fun hd tl -> hd::tl)) files [] in
276 (* Part 2: stdlib VS opacapi *)
277 let stdlib = List.fold_left stdlib StringSet.empty codes in
278 let stdlib = List.fold_left (fun acc ident -> StringSet.add ident acc) stdlib core_types in
279 (* THIS LINE IS AN HACK - SHOW COMMIT WHERE I AM INTRODUCES*)
280 let stdlib = StringSet.add "``" stdlib in
281 let opacapi =
282 Hashtbl.fold
283 (fun ident _ acc -> StringSet.add ident acc)
284 Opacapi.table StringSet.empty in
285 strict_equality "ident" "stdlib" "opacapi" stdlib opacapi;
286 if not !validation_ok then exit 1;
287 (* Part 3: collect position where bypass are used *)
288 let opacapi_pos = FilePos.nopos "opacapi" in
289 let locmap = LocMap.empty in
290 let locmap =
291 Hashtbl.fold
292 (fun key _ acc -> LocMap.append key opacapi_pos acc)
293 Opacapi.Opabsl.table locmap in
294 let locmap =
295 let fold acc (e, annot) =
296 match e with
297 | SA.Bypass key ->
298 let pos = QmlLoc.pos annot in
299 LocMap.append key pos acc
300 | _ -> acc
301 in
302 let fold = OpaWalk.Code.fold fold in
303 List.fold_left fold locmap codes
304 in
305 (* Part 4: generate the log *)
306 let oc, close_out =
307 match !target with
308 | Some file -> (
309 try
310 Pervasives.open_out file
311 with
312 | Sys_error s ->
313 OManager.error "cannot open_out %s : %s" file s
314 ), Pervasives.close_out_noerr
315
316 | None ->
317 Pervasives.stdout, (fun _ -> ())
318 in
319 let fmt = Format.formatter_of_out_channel oc in
320 let iter key locs =
321 Format.fprintf fmt "@[<2>%a:@\n%a@]@\n"
322 BslKey.pp key (Format.pp_list "@\n" FilePos.pp_pos) locs
323 in
324 LocMap.iter iter locmap;
325 (* Part 5: notify bypass which are not used *)
326 let both_unused = ref [] in
327 let client_unused = ref [] in
328 let server_unused = ref [] in
329 let all_bypass = ref 0 in
330 let unused_bypass = ref 0 in
331 let iter key bypass =
332 incr(all_bypass);
333 match LocMap.find_opt key locmap with
334 | Some [] | None ->
335 (* This means that a bypass is registred, but never used in the stdlib. *)
336 let table =
337 if B.ByPass.implemented_in bypass ~lang:BslLanguage.js
338 then
339 if B.ByPass.implemented_in bypass ~lang:BslLanguage.ml
340 then both_unused
341 else client_unused
342 else
343 if B.ByPass.implemented_in bypass ~lang:BslLanguage.ml
344 then server_unused
345 else (
4f80ec3 @BourgerieQuentin [fix] opacapi: char is not a core type
BourgerieQuentin authored
346 OManager.i_error "checkopacapi: %a@\n" BslKey.pp key ;
fccc685 Initial open-source release
MLstate authored
347 )
348 in
349 incr(unused_bypass);
350 table := key :: !table
351 | _ -> ()
352 in
353 B.ByPassMap.iter iter bymap ;
354 let notify kind table =
355 let num = ref 0 in
356 let list = List.rev_map (fun t -> incr(num); t) !table in
357 if !num > 0
358 then (
946efc1 @arthuraa [fix] checkopacapi: proper plural, code style.
arthuraa authored
359 let p singular plural = if !num == 1 then singular else plural in
fccc685 Initial open-source release
MLstate authored
360 Format.fprintf fmt (
946efc1 @arthuraa [fix] checkopacapi: proper plural, code style.
arthuraa authored
361 "Warning: the %d following bypass%s implemented @@%s %s unused:@\n"
362 ) !num (p "" "es") kind (p "is" "are");
fccc685 Initial open-source release
MLstate authored
363 List.iter (fun key -> Format.fprintf fmt "%a@\n" BslKey.pp key) list
364 );
365 !num
366 in
367 let num_both = notify "both" both_unused in
368 let num_client = notify "client" client_unused in
369 let num_server = notify "server" server_unused in
370 let percent =
371 (float_of_int !unused_bypass) /. (float_of_int !all_bypass) *. 100.
372 in
373 Format.pp_print_flush fmt ();
374 close_out oc;
375 if !unused_bypass > 0 then
376 OManager.printf (
6286a3c @arthuraa [fix] checkopacapi: typo.
arthuraa authored
377 "@{<yellow>Warning@}: opabsl contains %f %% of unused bypasses: (%d / %d)@\n"^^
fccc685 Initial open-source release
MLstate authored
378 " %d both@\n"^^
379 " %d client@\n"^^
380 " %d server@\n"^^
946efc1 @arthuraa [fix] checkopacapi: proper plural, code style.
arthuraa authored
381 "c.f. file @{<bright>opacapi.validation@} for details@\n"
fccc685 Initial open-source release
MLstate authored
382 )
383 percent
384 !unused_bypass
385 !all_bypass
386 num_both
387 num_client
388 num_server
389 ;
390 exit 0
Something went wrong with that request. Please try again.