forked from alokmenghrajani/opalang
-
Notifications
You must be signed in to change notification settings - Fork 0
/
qml2jsOptions.ml
350 lines (321 loc) · 13.8 KB
/
qml2jsOptions.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
(*
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/>.
*)
(**
Command-line options for the Qml to JS compiler.
wip, should be merged with OpaEnv, Qml2ocamlOptions
@author Mathieu Barbin
@author Maxime Audouin
*)
(* depends *)
module Arg = Base.Arg
module String = Base.String
module StaticParameters =
struct
(** options for js exec *)
let options_js = []
(** directory to find libs to use with the generated code *)
let js_include_dir = []
(** directory to find libs to use with the generated code *)
let js_include_mlstate_dir = [
InstallDir.lib_opa ;
]
end
type t =
{
bypass_plugin : string list ;
(**
Beware, unlike opa, this is the list of .bypass files
*)
command_line : bool ; (** [true] if the generated js is meant to be run by command
line tool in that case, some bsl files are dropped *)
compilation_directory : string ;
cps : bool ;
cps_toplevel_concurrency : bool ;
exe_run : bool ;
exe_argv : string list ;
extra_lib : (string * BslJsConf.conf) list ;
extra_path : string list ;
input_files : Qml2ocamlOptions.input_file list ;
js_exe : string ;
backend : string;
jsopt : string list ;
alpha_renaming : bool;
cleanup : bool;
inlining : bool;
global_inlining : bool;
lambda_lifting : bool;
check_bsl_types : bool;
mlstatelibs : string ;
no_assert: bool;
no_stdlib : bool ;
qml_closure : bool;
split : bool ;
split_js_value : int option ;
target : string ;
}
type env_js_input =
{
js_init_contents : (string * [
| `ast of (BslInterface.unicity_index * JsAst.code_elt) list
| `string of string
]) list ;
js_code : JsAst.code ; (** will be split according to argv_options *)
}
module type JsBackend = sig
val dynloader : BslPluginInterface.plugin -> unit
val compile : ?val_:(string -> QmlAst.ident) ->
?bsl:JsAst.code ->
?closure_map:Ident.t IdentMap.t ->
renaming_server:QmlRenamingMap.t ->
renaming_client:QmlRenamingMap.t ->
t -> BslLib.env_bsl -> QmlTyper.env -> QmlAst.code -> env_js_input
val name : string
val runtime_libs : cps:bool -> (string * BslJsConf.conf) list
val dummy_compile : unit -> unit (* if the back end is not called because the input code is empty
* then this fake compilation function will be called instead
* The backend should use it to save dummy object files
* for all the separated passes that it contains *)
end
let backends = ref ([] : (module JsBackend) list)
let find_backend name =
List.find
(fun backend ->
let module M = (val backend : JsBackend) in
M.name = name
) !backends
let register_backend b =
backends := b :: !backends
let backend_names () =
List.map
(fun backend ->
let module M = (val backend : JsBackend) in
M.name
) !backends
module Argv :
sig
val default : unit -> t
val parse : unit -> t
val parse_argv : string array -> t (** see Arg.parse_argv (raise the same exceptions) *)
(** to be able to share some passes done in qml2ocaml, we need a traduction to qml2ocaml options *)
(** this traduction does not need to be complete, just should provide options which are used in qml2ocaml passes *)
val qml2ocaml_sharing : t -> Qml2ocamlOptions.argv_options
end
=
struct
(** tools *)
let extra_split g = List.map Base.String.trim (Base.String.slice_chars "{} ,;" g)
let mutable_list_factory () =
let s = MutableList.create () in
((fun () -> MutableList.to_list s), (fun p -> List.iter (MutableList.add s) (extra_split p)), (fun () -> MutableList.clear s))
(** Mutable env to set options
please preserve alphabetic order in independant vars and options *)
(** !! Default value must no be setted here, but in function reset !! *)
let bypass_plugins = MutableList.create ()
let bypass_plugin_add files =
List.iter (fun file ->
assert (String.is_suffix ".bypass" file);
MutableList.add bypass_plugins file)
(extra_split files)
let compilation_directory = ref None
let cps = ref false
let cps_toplevel_concurrency = ref false
let exe_run = ref false
let exe_argv_get, exe_argv_add, exe_argv_reset = mutable_list_factory ()
let extra_path_get, extra_path_add, extra_path_reset = mutable_list_factory ()
let input_files = MutableList.create ()
let input_files_get () = MutableList.to_list input_files
let input_files_reset () = MutableList.clear input_files
let add_input_qml_file qml = List.iter (fun qml -> MutableList.add input_files (Qml2ocamlOptions.QmlFile qml)) (extra_split qml)
let add_input_opa_file opa = List.iter (fun opa -> MutableList.add input_files (Qml2ocamlOptions.OpaFile opa)) (extra_split opa)
let js_exe = ref ""
let backend = ref ""
let jsopt_get, jsopt_add, jsopt_reset = mutable_list_factory ()
let lambda_lifting = ref false
let check_bsl_types = ref false
let mlstatelibs = ref ""
let mlstatepath_get, mlstatepath_add, mlstatepath_reset = mutable_list_factory ()
let no_assert=ref false
let no_stdlib = ref false
let alpha_renaming = ref true
let cleanup = ref true
let inlining = ref true
let global_inlining = ref true
let qml_closure = ref false
let split = ref false
let split_js_value = ref None
let target = ref None
let plugin_inclusion file =
let cwd = Sys.getcwd () in
let inclusion = BslConvention.inclusion ~cwd file in
extra_path_add inclusion.BslConvention.extrapath ;
bypass_plugin_add inclusion.BslConvention.plugin ;
()
(** DEFAULT VALUE and reset (if 2 time parsed (differents argv) *)
let reset () =
MutableList.clear bypass_plugins ;
compilation_directory := None ;
cps := false ;
cps_toplevel_concurrency := false ;
exe_run := false ;
exe_argv_reset () ;
let _ = extra_path_reset () ;
List.iter extra_path_add StaticParameters.js_include_dir in
input_files_reset () ;
js_exe := "js" ;
backend := "qmljsimp";
let _ =
jsopt_reset () ;
List.iter (fun s -> jsopt_add s) StaticParameters.options_js ;
in
lambda_lifting := false;
check_bsl_types := false;
mlstatelibs := Lazy.force InstallDir.getenv ;
let _ =
mlstatepath_reset () ;
List.iter mlstatepath_add StaticParameters.js_include_mlstate_dir in
no_assert := false;
no_stdlib := false ;
qml_closure := false;
split := false ;
split_js_value := None ;
target := None ;
()
let speclist_aux () =
[
("*.qml", Arg.Unit (fun () -> ()), " Give a qml file to the compiler");
("*.opa", Arg.Unit (fun () -> ()), " Give a opa file to the compiler");
("--qml", Arg.String add_input_qml_file, "<file> load a file as a qml source");
("--opa", Arg.String add_input_opa_file, "<file> load a file as a opa source");
("--", Arg.Tuple [Arg.Set exe_run ; Arg.Rest exe_argv_add], " -- Take every remaining options, and run directly the exe with them after compilation");
("--back-end", Arg.Symbol (backend_names (), (fun s -> backend := s)), " choose the js backend");
("--build-dir", Arg.String (fun s -> compilation_directory := Some s), "<dir> -- Specify a directory for js production (def is _build/target/)");
("--check-bsl-types", Arg.Set check_bsl_types, " Enables runtime type checking of the types of bypasses");
("--closure", Arg.Tuple [ Arg.Set lambda_lifting ; Arg.Set qml_closure ], " -- Use Qml closures (enforce --lambda-lifting)");
("--cps", Arg.Set cps, " -- Activate cps transformation mode");
("--cps-toplevel-concurrency", Arg.Tuple [ Arg.Set cps ; Arg.Set cps_toplevel_concurrency ],
" -- During cps transformation, toplevel not functionnal values are compiled as future (enforce --cps)");
("--extra-path", Arg.String extra_path_add, "<dir> -- Add an include directory for searching libs");
("--js-exe", Arg.Set_string js_exe, "<exe> -- Specify program js-exe (default is js)");
("--jsopt", Arg.String jsopt_add, "<opt> -- Pass option <opt> to js exec only");
("--lambda-lifting", Arg.Set lambda_lifting, " -- Use Qml lambda lifting");
("--mlstate-I", Arg.String mlstatepath_add, "<dir> -- Add an include directory from mlstatelibs");
("--no-assert", Arg.Set no_assert, " -- Remove all assert directives. Faster but less safe.");
("--no-alpha-renaming", Arg.Clear alpha_renaming, " -- disable alpha-renaming for local names");
("--no-cleanup", Arg.Clear cleanup, " -- disable clean up of the produced js");
("--no-inlining", Arg.Clear inlining, " -- disable inlining of the produced js");
("--no-global-inlining", Arg.Clear global_inlining, " -- disable toplevel inlining of the produced js");
("--no-stdlib", Arg.Set no_stdlib, " -- Do not use qml-initial");
("--split", Arg.Set split, " -- Do not merge all js-files in one uniq target");
("--split-js-value", Arg.Int (fun i -> split_js_value := Some i), " -- UNDOCUMENTED");
("-I", Arg.String extra_path_add, "<dir> -- Shorthand for --extra-path");
("-mI", Arg.String mlstatepath_add, "<dir> -- Shorthand for --mlstate-I");
("-o", Arg.String (fun s -> target := Some s), "<exe> -- Specify a name for the target");
]
@ OManager.Arg.options
@ PassHandler.Arg.options
@ WarningClass.Arg.options
@ Qml2jsBackendOptions.Arg.options
let speclist () =
Arg.sort
(Arg.align
(Arg.add_bash_completion
~names:["qmljs";"qmljs.native";"qmljs.byte";"qmljs.exe"]
~default:(Arg.File "@(opa|qml|cmxs|js|bypass)")
(speclist_aux ())
)
)
let anon_fun arg =
let ext = File.extension arg in
let fct =
match ext with
| "qml" -> add_input_qml_file
| "opa" -> add_input_opa_file
| "bypass" -> bypass_plugin_add
| "opp" -> plugin_inclusion
| _ -> (fun s -> OManager.error "I don't know what to do with anonymous argument %S@\n" s) in
fct arg
(** building the compiler input from current mutable env.
@parameter [backend] either "qmlflat" or "qmlfake" *)
let build_argv_options () =
let input_files = input_files_get () in
let last_qml = match List.rev input_files with t::_ -> Qml2ocamlOptions.input_filename t | _ -> "a.qml" in
let target_dir = File.from_pattern "%" last_qml in
let target = Option.default (File.from_pattern "%b.js" last_qml) !target in
{
bypass_plugin = MutableList.to_list bypass_plugins ;
command_line = true; (* no need to have an arg parser for this option
* if you use the command line qmljs, then you will
* execute the js in command line too *)
compilation_directory = Option.default (Filename.concat "_build" target_dir) !compilation_directory ;
cps = !cps ;
cps_toplevel_concurrency = !cps_toplevel_concurrency ;
exe_run = !exe_run ;
exe_argv = exe_argv_get () ;
extra_lib = [] ;
extra_path = (List.map (fun s -> Filename.concat !mlstatelibs s) (mlstatepath_get ())) @ (extra_path_get ()) ;
input_files = input_files ;
js_exe = !js_exe ;
backend = !backend ;
jsopt = jsopt_get () ;
alpha_renaming = !alpha_renaming;
cleanup = !cleanup;
inlining = !inlining;
global_inlining = !global_inlining;
lambda_lifting = !lambda_lifting;
check_bsl_types = !check_bsl_types;
mlstatelibs = !mlstatelibs ;
no_assert= !no_assert ;
no_stdlib = !no_stdlib ;
qml_closure = !qml_closure;
split = !split ;
split_js_value = !split_js_value ;
target = target ;
}
let usage_msg = Printf.sprintf "%s: command-line options for the Qml-to-JS compiler\nUsage: %s [options]\n" Sys.argv.(0) Sys.argv.(0)
(** parse *)
let parse () =
reset () ;
Arg.parse (speclist ()) anon_fun (usage_msg ^ "Options:");
let o = build_argv_options () in
let module M = (val (find_backend o.backend) : JsBackend) in
{o with extra_lib = M.runtime_libs ~cps:o.cps }
let parse_argv argv =
reset () ;
let current = ref 0 in
Arg.parse_argv ~current argv (speclist ()) anon_fun "<qml2jslib>" ;
let o = build_argv_options () in
let module M = (val (find_backend o.backend) : JsBackend) in
{o with extra_lib = M.runtime_libs ~cps:o.cps }
let default () =
reset () ;
build_argv_options ()
(** this traduction does not need to be complete, just should provide options which are used in qml2ocaml passes shared by qml2js.ml *)
let qml2ocaml_sharing t =
let qml2ocaml = Qml2ocamlOptions.ArgvOptions.default "qmlflat" in (* hack because of dirty string arg in qml2ocaml *)
{ qml2ocaml with Qml2ocamlOptions.
bypass_plugin = t.bypass_plugin ;
cps = t.cps ;
cps_toplevel_concurrency = t.cps_toplevel_concurrency ;
exe_run = t.exe_run ;
exe_argv = t.exe_argv ;
extra_path = t.extra_path ;
input_files = t.input_files ;
lambda_lifting = t.lambda_lifting;
no_assert = t.no_assert ;
no_stdlib = t.no_stdlib ;
qml_closure = t.qml_closure;
server_side = false;
target = t.target ;
}
end