Skip to content
This repository
Newer
Older
100644 451 lines (356 sloc) 11.418 kb
fccc6851 » MLstate
2011-06-21 Initial open-source release
1 (*
5f95972b » Aqua-Ye
2012-04-26 [feature] iconv: binded iconv in Opa
2 Copyright © 2011, 2012 MLstate
fccc6851 » MLstate
2011-06-21 Initial open-source release
3
5bb0f1a4 » Aqua-Ye
2012-07-09 [cleanup] compiler: typo on Opa
4 This file is part of Opa.
fccc6851 » MLstate
2011-06-21 Initial open-source release
5
5bb0f1a4 » Aqua-Ye
2012-07-09 [cleanup] compiler: typo on Opa
6 Opa is free software: you can redistribute it and/or modify it under the
fccc6851 » MLstate
2011-06-21 Initial open-source release
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
5bb0f1a4 » Aqua-Ye
2012-07-09 [cleanup] compiler: typo on Opa
10 Opa is distributed in the hope that it will be useful, but WITHOUT ANY
fccc6851 » MLstate
2011-06-21 Initial open-source release
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
5bb0f1a4 » Aqua-Ye
2012-07-09 [cleanup] compiler: typo on Opa
16 along with Opa. If not, see <http://www.gnu.org/licenses/>.
fccc6851 » MLstate
2011-06-21 Initial open-source release
17 *)
18 (**
19 This application is the register generator, used as a preprocessor
20 on all files including to build the Bypass Standard Library.
21
22 @author Mathieu Barbin
23 @author Mehdi Bouaziz
24 *)
25
26 (* TODO: refactoring of libbase *)
27 (* open Base is BAD, hoisting modules *)
28 module Arg = Base.Arg
29 module Format = Base.Format
30 module String = Base.String
31
32 (* shorthand *)
33 module BI = BslInterface
34 module BR = BslRegisterLib
86e0e8e8 » arthuraa
2012-07-24 [enhance] bslregister: separate CL interface.
35 module BG = BslGeneration
fccc6851 » MLstate
2011-06-21 Initial open-source release
36
37 let (|>) x f = f x
38
86e0e8e8 » arthuraa
2012-07-24 [enhance] bslregister: separate CL interface.
39 (* Options for BslGenerator *)
fccc6851 » MLstate
2011-06-21 Initial open-source release
40 let static = ref false
86e0e8e8 » arthuraa
2012-07-24 [enhance] bslregister: separate CL interface.
41 let no_opp = ref false
04241837 » arthuraa
2012-07-23 [enhance] qml2js: make modular plugins an option.
42 let modular_plugins = ref false
86e0e8e8 » arthuraa
2012-07-24 [enhance] bslregister: separate CL interface.
43 let build_dir = ref ""
44 let bsl_pref = ref "default"
45 let auto_build = ref true
46 let check_style = ref false
47 let clean = ref false
48 let clean_would_only = ref false
49 let default_iformats = ref true
50 let extrapaths = MutableList.create ()
51 let unsafe_js = ref false
52 let unsafe_opa = ref false
53 let bypass_plugins = MutableList.create ()
54 let files = MutableList.create ()
55 let package_version = ref "0.1.0"
56 let spec_process = Hashtbl.create 5
57 let ml_flags = MutableList.create ()
58 let mlopt_flags = MutableList.create ()
59 let js_validator = ref (Some "js")
60 let js_validator_files = MutableList.create ()
61 let js_validator_options = MutableList.create ()
62 let pprocess = ref None
870ba74a » arthuraa
2012-07-30 [enhance] bsl: add option for js bsl syntax.
63 let js_bypass_syntax : [`classic | `jsdoc] ref = ref `classic
04241837 » arthuraa
2012-07-23 [enhance] qml2js: make modular plugins an option.
64
86e0e8e8 » arthuraa
2012-07-24 [enhance] bslregister: separate CL interface.
65 let cwd = Sys.getcwd ()
66 let is_default_lib = ref true
fccc6851 » MLstate
2011-06-21 Initial open-source release
67
68 let customize_lib_name name =
69 let name =
70 String.remove_suffix_if_possible ("."^BslConvention.Extension.plugin) name
71 in
72 if
56308976 » François-Régis Sinot
2011-09-30 [feature] stdlib: more tolerant naming of files
73 not (String.is_universal_ident name)
fccc6851 » MLstate
2011-06-21 Initial open-source release
74 || name.[0] = '_' (* an universal ident is not empty *)
75 then
76 OManager.error (
77 "@{<bright>%S@} is not a valid plugin name@\n"^^
78 "Plugin name should be alphanumeric and start with a letter"
79 )
80 name
81 ;
82 let name = BslConvention.plugin_name name in
83
84 is_default_lib := false ;
85 bsl_pref := name ;
86 ()
87
88 let spliter g =
89 List.map String.trim
461365b0 » Louis Gesbert
2011-06-23 [cleanup] Base.String: changed String.split to a much simpler String.…
90 (String.slice_chars "{} ,;" g)
fccc6851 » MLstate
2011-06-21 Initial open-source release
91
92 (* b *)
93
94 let bypass_plugins_add_file files =
95 List.iter (
96 fun file ->
97 if String.is_suffix ("." ^ BslConvention.Extension.bypass) file
98 then MutableList.add bypass_plugins (BslDynlink.MarshalPlugin file)
99 else MutableList.add bypass_plugins (BslDynlink.SharedObject file)
100 )
101 (spliter files)
102
103 (* e *)
104
105 let extrapaths_add d =
106 let existing_dir d = Sys.file_exists d && Sys.is_directory d in
107 let iter d =
108 if d.[0] <> '+' && not (existing_dir d)
109 then OManager.error "Option -I %S\nNo such file or directory" d
110 else (
111 let d =
112 if File.is_relative_include_path d
113 then
114 Filename.concat cwd d
115 else d
116 in
117 MutableList.add extrapaths d
118 )
119 in
120 List.iter iter (Arg.split d)
121
122 (* j *)
123
124 let js_files = MutableList.create ()
d34c3d82 » BourgerieQuentin
2012-06-28 [enhand] compiler, bsl: Added the node.js language to the bsl
125 let nodejs_files = MutableList.create ()
fccc6851 » MLstate
2011-06-21 Initial open-source release
126
6f114593 » OpaOnWindowsNow
2011-10-18 [feature] bslregister: activate js validation
127 let js_validator_files_set = ref StringSet.empty
fccc6851 » MLstate
2011-06-21 Initial open-source release
128 let js_validator_add_file s =
129 List.iter (fun f ->
130 if not (File.is_regular f)
131 then OManager.error "cannot find file %S (js-validation)" f
132 else MutableList.add js_validator_files f)
133 (spliter s)
134
135 let js_validator_add_option o =
136 MutableList.add js_validator_options o
137
870ba74a » arthuraa
2012-07-30 [enhance] bsl: add option for js bsl syntax.
138 let available_js_bypass_syntax_list = ["classic"; "jsdoc"; "new"]
139 let js_bypass_syntax_of_string = function
140 | "classic" -> Some `classic
141 | "jsdoc"
142 | "new" -> Some `jsdoc
143 | _ -> None
144 let set_js_bypass_syntax s =
145 js_bypass_syntax := Option.get (js_bypass_syntax_of_string s)
146
fccc6851 » MLstate
2011-06-21 Initial open-source release
147 (* m *)
148
149
247109aa » BourgerieQuentin
2012-04-25 [enhance] opa-plugin-builder: Adding an option to specify a preproces…
150 (* p *)
151
fccc6851 » MLstate
2011-06-21 Initial open-source release
152
edff8ab0 » arthuraa
2012-07-13 [enhance] node_packages: specify package version in CL.
153 let set_package_version version =
154 package_version := version
fccc6851 » MLstate
2011-06-21 Initial open-source release
155
156 let plugin_inclusion file =
157 let inclusion = BslConvention.inclusion ~cwd file in
158 MutableList.add extrapaths inclusion.BslConvention.extrapath ;
159 bypass_plugins_add_file inclusion.BslConvention.plugin ;
160 ()
161
86e0e8e8 » arthuraa
2012-07-24 [enhance] bslregister: separate CL interface.
162 (* s *)
fccc6851 » MLstate
2011-06-21 Initial open-source release
163
86e0e8e8 » arthuraa
2012-07-24 [enhance] bslregister: separate CL interface.
164 (* u *)
fccc6851 » MLstate
2011-06-21 Initial open-source release
165
86e0e8e8 » arthuraa
2012-07-24 [enhance] bslregister: separate CL interface.
166 (* following guidelines for command line tools *)
fccc6851 » MLstate
2011-06-21 Initial open-source release
167
168 let (!>) = Format.sprintf
169
170 let spec = [
171
172 (* b *)
173
174
175 "--build-dir",
176 Arg.Set_string build_dir,
177 !>
178 " Change the build directory. Default is $PWD" ;
179
180
181 (* c *)
182
183
184 "--check-style",
185 Arg.Set check_style,
186 !>
187 " Make some more check about some guidelines used in the files" ;
188
189
190 "--clean",
191 Arg.Symbol (["-n" ; "-f"], (
192 function
193 | "-f" ->
194 clean := true
195 | _ ->
196 clean := true;
197 clean_would_only := true
198 )),
199 !>
200 " With -n, it only says the files which would be cleaned, with '-f' the files are removed" ;
201
202
203 (* i *)
204
205
206 "-I",
207 Arg.String extrapaths_add,
208 !>
209 " Add path to external librairies for the compilation" ;
210
211 (* j *)
212
870ba74a » arthuraa
2012-07-30 [enhance] bsl: add option for js bsl syntax.
213 "--js-bypass-syntax",
214 Arg.Symbol (available_js_bypass_syntax_list, set_js_bypass_syntax),
215 !>
216 " Choose a bsl directive syntax for JS files (default: \"classic\")" ;
217
fccc6851 » MLstate
2011-06-21 Initial open-source release
218 "--js-validator",
219 Arg.String (fun s -> js_validator := Some s),
220 !>
221 " Specify a js-validator (default is %a)" (Option.pp Format.pp_print_string) !js_validator ;
222
223
224 "--js-validator-file",
225 Arg.String js_validator_add_file,
226 !>
227 "<file> Add an js init file for the js-validation only" ;
228
229
230 "--js-validator-off",
231 Arg.Unit (fun () -> js_validator := None),
232 !>
233 " Disable the js validation (sad)" ;
234
235
236 "--js-validator-opt",
237 Arg.String js_validator_add_option,
238 !>
239 "<opt> Add an shell option for the the js-validator" ;
240
241
242 (* l *)
243
244
245 (* m *)
246
247
248 "--ml",
249 Arg.String (fun s -> List.iter (MutableList.add ml_flags) (Arg.split s)),
250 !>
251 "<flags> Add options for ocaml compilation (both byte and native)" ;
252
253
254 "--mlopt",
255 Arg.String (fun s -> List.iter (MutableList.add mlopt_flags) (Arg.split s)),
256 !>
257 "<flags> Add options for ocaml native compilation" ;
258
04241837 » arthuraa
2012-07-23 [enhance] qml2js: make modular plugins an option.
259 "--modular-plugins",
260 Arg.Set modular_plugins,
261 " Export module identifiers following common js conventions instead of globally" ;
262
fccc6851 » MLstate
2011-06-21 Initial open-source release
263 (* n *)
264
265 "--no-build",
266 Arg.Clear auto_build,
267 !>
268 " Do not build the plugin, just generate opp-files" ;
269
270
271 "--no-default-iformats",
272 Arg.Clear default_iformats,
273 !>
274 " Do not load default format for ##include" ;
275
276
277 "--no-opp",
278 Arg.Set no_opp,
279 !>
280 " Produces files in the build_dir directly, do not produce any opp directoy" ;
281
282 (* o *)
283
284 "-o",
285 Arg.String customize_lib_name,
286 !>
287 "<name> Specify the name of the plugin, default is %s"
288 !bsl_pref ;
289
290 (* p *)
291
edff8ab0 » arthuraa
2012-07-13 [enhance] node_packages: specify package version in CL.
292 "--package-version",
293 Arg.String set_package_version,
294 !>
295 "version to be added to the package.json file (default 0.1.0)" ;
fccc6851 » MLstate
2011-06-21 Initial open-source release
296
297 "--plugin",
298 Arg.String plugin_inclusion,
299 !>
300 "<opp> Take the following argument as an opa plugin (opp)" ;
301
247109aa » BourgerieQuentin
2012-04-25 [enhance] opa-plugin-builder: Adding an option to specify a preproces…
302 "--pp",
303 Arg.String (fun s -> pprocess := Some s),
304 !>
305 "<command> Pipe sources through preprocessor <command>";
306
307 "--pp-file",
308 Arg.String (fun s ->
309 match BaseString.split_char ':' s with
310 | (_, "") -> raise (Arg.Help "--pp-file")
311 | (file, pprocess) -> Hashtbl.add spec_process file pprocess
312 ),
313 !>
314 "<file>:<command> Pipe file through preprocessor <command>";
315
fccc6851 » MLstate
2011-06-21 Initial open-source release
316 (* u *)
317
318 "--unsafe-js",
319 Arg.Set unsafe_js,
320 !>
321 " Activate unsafe-js mode (ignore js errors)" ;
322
323 "--unsafe-opa",
324 Arg.Set unsafe_opa,
325 !>
326 " Activate unsafe-opa mode (ignore opa errors)" ;
327
328 (* s *)
329
330 "--static",
331 Arg.Set static,
332 !>
333 "produces files for static linking with opa.exe (not for standard distrib)" ;
334
335 ]
336
337 let anon_fun file =
338 match File.extension file with
339
340 | opp when opp = BslConvention.Extension.plugin ->
341 plugin_inclusion file
342
d34c3d82 » BourgerieQuentin
2012-06-28 [enhand] compiler, bsl: Added the node.js language to the bsl
343 | ("js" | "nodejs") as ext ->
344 (*
345 The js files are indexed by their basename.
346 *)
347 let key = file in
348 if StringSet.mem key (!js_validator_files_set)
349 then
350 OManager.error (
351 "Found several js files with the same basename : @{<bright>%s@}@\n"^^
fccc6851 » MLstate
2011-06-21 Initial open-source release
352 "@[<2>{@<bright>Hint@}:@\n"^^
353 "Perhaps the same file is passed several time in the command line@\n"^^
354 "or maybe you could rename one of the clashing javascript files@]@\n"
d34c3d82 » BourgerieQuentin
2012-06-28 [enhand] compiler, bsl: Added the node.js language to the bsl
355 )
356 file
357 ;
358 js_validator_files_set := StringSet.add key (!js_validator_files_set);
359 (if ext = "js" then MutableList.add js_files file
360 else MutableList.add nodejs_files file);
fccc6851 » MLstate
2011-06-21 Initial open-source release
361 MutableList.add files file
d34c3d82 » BourgerieQuentin
2012-06-28 [enhand] compiler, bsl: Added the node.js language to the bsl
362 | _ -> MutableList.add files file
fccc6851 » MLstate
2011-06-21 Initial open-source release
363
364
365 let usage_msg =
2f956840 » Aqua-Ye
2012-07-27 [enhance] manoages: better manpages for opa-plugin-browser, opa-plugi…
366 !> "@{<bright>%s@}: Bob Opa External Libraries Register\nUsage: %s [options] files\n"
367 (Filename.basename Sys.argv.(0)) (Filename.basename Sys.argv.(0))
fccc6851 » MLstate
2011-06-21 Initial open-source release
368
369 let parse () =
370 let spec = (
ee9137a2 » Mathieu Baudet
2011-12-13 [cleanup] options: removed useless () argument to cmdline options
371 WarningClass.Arg.options @
fccc6851 » MLstate
2011-06-21 Initial open-source release
372 (OManager.Arg.version "bslregister" :: OManager.Arg.options) @
373 BslLib.Arg.options @
374 spec
375 )
376
377 |> Arg.add_bash_completion
378 |> Arg.sort
379 |> Arg.align
380
381 in
86e0e8e8 » arthuraa
2012-07-24 [enhance] bslregister: separate CL interface.
382 Arg.parse spec anon_fun (usage_msg^"Options:");
383 {
384 BG.
385 static = !static;
386 no_opp = !no_opp;
387 modular_plugins = !modular_plugins;
388 build_dir = !build_dir;
389 bsl_pref = !bsl_pref;
390 auto_build = !auto_build;
391 check_style = !check_style;
392 clean = !clean;
393 clean_would_only = !clean_would_only;
394 default_iformats = !default_iformats;
395 extrapaths = MutableList.to_list extrapaths;
396 unsafe_js = !unsafe_js;
397 unsafe_opa = !unsafe_opa;
398 bypass_plugins = MutableList.to_list bypass_plugins;
399 files = MutableList.to_list files;
400 package_version = !package_version;
401 spec_process =
402 Hashtbl.fold StringMap.add spec_process StringMap.empty;
403 ml_flags = MutableList.to_list ml_flags;
404 mlopt_flags = MutableList.to_list mlopt_flags;
405 js_validator = !js_validator;
406 js_validator_files = MutableList.to_list js_validator_files;
407 js_validator_options = MutableList.to_list js_validator_options;
408 pprocess = !pprocess;
870ba74a » arthuraa
2012-07-30 [enhance] bsl: add option for js bsl syntax.
409 js_classic_bypass_syntax = !js_bypass_syntax = `classic;
86e0e8e8 » arthuraa
2012-07-24 [enhance] bslregister: separate CL interface.
410 }
fccc6851 » MLstate
2011-06-21 Initial open-source release
411
412 (* Checking options *)
413 let check_options options =
414 (* if needed, add some checks *)
415 ignore options ;
416
417 (* default lib name *)
418 if !is_default_lib then
419 OManager.warning ~wclass:WarningClass.bsl_register (
420 "@[<2>You did not precise a name for your lib.@\n"^^
421 "By default the lib name will be @{<bright>%S@}.@]@\n"^^
422 "@[<2>@{<bright>Hint@}:@\n"^^
423 "use option @{<bright>-o@} <libname>@]" )
424 !bsl_pref ;
425 ()
426
427 (* === *)
428
429 (* Main *)
430 let _ =
431 try
432 WarningClass.load_set BR.warning_set;
433 BR.set_signal_sigint ();
86e0e8e8 » arthuraa
2012-07-24 [enhance] bslregister: separate CL interface.
434 let options = parse () in
435 check_options options;
fccc6851 » MLstate
2011-06-21 Initial open-source release
436 OManager.this_is_tool "bslregister";
437 if MutableList.length files = 0 then (
438 OManager.unquiet "no input files";
439 exit 0
440 );
86e0e8e8 » arthuraa
2012-07-24 [enhance] bslregister: separate CL interface.
441 BG.process options
fccc6851 » MLstate
2011-06-21 Initial open-source release
442 with
443 | BR.SigInt ->
86e0e8e8 » arthuraa
2012-07-24 [enhance] bslregister: separate CL interface.
444 OManager.error
445 "building process @{<bright>not accomplished@} due to an @{<bright>user interruption@}"
fccc6851 » MLstate
2011-06-21 Initial open-source release
446 | e ->
86e0e8e8 » arthuraa
2012-07-24 [enhance] bslregister: separate CL interface.
447 let backtrace = Printexc.get_backtrace () in
448 OManager.apologies ();
449 OManager.printf "@[<2>@{<bright>Hint@}:@\n%s@]@\n@{<bright>Backtrace@}:@\n%s@\n"
450 (Printexc.to_string e) backtrace;
451 exit 2
Something went wrong with that request. Please try again.