-
Notifications
You must be signed in to change notification settings - Fork 125
/
qml2js.ml
276 lines (248 loc) · 9.64 KB
/
qml2js.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
(*
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/>.
*)
(**
Common library for any Js compiler
@author Mathieu Barbin
@author Maxime Audouin
*)
(* depends *)
module List = Base.List
(* alias *)
module J = Qml2jsOptions
(** some type are shared with qml2ocaml, some not *)
type env_js_output =
{
generated_files : (string * string) list ; (** path/name without build directory * contents *)
}
(**
PASSES :
-------
// Command line passes
returns a : env_bsl, env_blender
val js_generation : argv_options -> env_js_input -> env_js_output
val js_treat : argv_options -> env_js_output -> int
NEEDED from any instance of a js-compiler :
val qml_to_js : qml_to_js
*)
module JsTreat :
sig
val js_bslfilesloading : Qml2jsOptions.t -> BslLib.env_bsl -> (string * string) list * JsAst.code
val js_generation : Qml2jsOptions.t -> (string * string) list -> J.env_js_input -> env_js_output
val js_treat : Qml2jsOptions.t -> env_js_output -> int
end =
struct
open Qml2jsOptions
let take_n n =
let rec aux acc i rest =
if i >= n then List.rev acc, rest else
match rest with
| [] -> List.rev acc, []
| t::q -> aux (t::acc) (succ i) q
in aux [] 0
let js_bslfilesloading env_opt env_bsl =
(* 1) extra libraries *)
let generated_files = [] in
let generated_files =
let fold acc (extra_lib, conf) =
let () =
(*
TODO: refactor so that conf is not ignored,
and optimization pass applied
*)
ignore conf
in
let get t =
let contents = File.content t in
(File.from_pattern "%b.js" t, contents)::acc
in
match File.get_locations env_opt.extra_path extra_lib with
| [] ->
OManager.error (
"Cannot find extra-lib @{<bright>%s@} in search path@\n"^^
"@[<2>@{<bright>Hint@}:@\nPerhaps a missing @{<bright>-I@} ?@]" ) extra_lib
| [t] -> get t
| (t::_) as all ->
OManager.warning ~wclass:WarningClass.bsl_loading (
"extra-lib @{<bright>%s@} is found in several places@\n%s\n"^^
"I will use this one : @{<bright>%s@}" ) extra_lib (String.concat " " all) t ;
get t
in
List.fold_left fold generated_files env_opt.extra_lib
in
(* 2) loaded bsl containing js files
order : since the generated code contains call to bypass of bsl, it is too dangerous to
put the extra-libs between bsl and the generated code *)
let generated_files =
let filter_bsl =
if env_opt.command_line then
fun (filename, content, conf) ->
let filename = Filename.basename filename in
let b:bool = List.for_all
(fun s -> not (String.is_contained s filename))
["bslClient.js"; "bslClientOnly.js"; "bslJson.js"; "syslog.js";
"jquery"; "jQuery"; "Anchors";
"json2.js"; "ojs.js"]
(* every file that need functionality that won't be available in
* js or rhino should end up in this match *)
in if b then
let ppjs =
let ppenv = Pprocess.fill_with_sysenv Pprocess.empty_env in
(* TODO modifier ppenv avec des choses *)
let ppopt = Pprocess.default_options ppenv in
Pprocess.process Pplang.js_description ppopt in
let content = ppjs content in
let () =
(*
TODO: refactor so that conf is not ignored,
and optimization pass applied
*)
ignore conf
in
Some (filename, content)
else None
else
fun (filename, content, _conf) -> Some (filename, content)
in
let fold acc loader =
List.rev_filter_map_append filter_bsl loader.BslPluginInterface.js_code acc
in
List.fold_left fold generated_files env_bsl.BslLib.plugins
in
let ast = List.flatten (List.rev_map (
fun (_,content) ->
(*
TODO: we must take care about conf,
and not parse file tagged as Verbatim
*)
JsParse.String.code content
) generated_files) in
List.rev generated_files, ast
let js_generation env_opt generated_files env_js_input =
let name_generation ?index () =
match index with
| None -> env_opt.target
| Some (i, n) -> Printf.sprintf "js_%d_%s" (i * n) env_opt.target
in
let generated_files = List.rev generated_files in
(* some more init given by the specific implementation of the backen (bypass projection : bsl_js_init.js) *)
let generated_files =
let map (name, elts) =
name, (
match elts with
| `ast elts ->
let code = List.map snd elts in
JsPrint.code code
| `string s -> s
)
in
List.rev_map_append map env_js_input.js_init_contents generated_files
in
let generated_files =
match env_opt.split_js_value with
| None ->
let file = name_generation (), JsPrint.code env_js_input.js_code in
file::generated_files
| Some n ->
let rec aux acc i rest =
let filename = name_generation ~index:(i, n) () in
match take_n n rest with
| code, rest ->
let acc =
let file = filename, JsPrint.code code in
file::acc in
begin
match rest with
| [] -> acc
| _ :: _ -> aux acc (succ i) rest
end
in
aux generated_files 1 env_js_input.js_code
in
let last =
match generated_files with
| (last,_)::_ -> last
| [] -> Filename.concat env_opt.compilation_directory "empty.js" in
let generated_files = List.rev generated_files in
(* keep split, or merge them all *)
let generated_files =
if env_opt.split then generated_files else
begin
OManager.verbose "append files into %s" last ;
let fold buf (filename, contents) =
OManager.verbose "append -- @{<bright>%s@}" filename;
FBuffer.addln buf contents in
let buf = FBuffer.create 1048 in
let buf = List.fold_left fold buf generated_files in
[ last, FBuffer.contents buf ]
end
in
let _ =
let write (filename, contents) =
let filename = Filename.concat env_opt.compilation_directory filename in
OManager.verbose "writing file @{<bright>%s@}" filename ;
let success = File.output filename contents in
if not success then OManager.error "cannot write file @{<bright>%S@}" filename
in
let caller_wd = Sys.getcwd () in
let build_dir = Filename.concat caller_wd env_opt.compilation_directory in
OManager.verbose "create/enter directory @{<bright>%s@}" build_dir ;
let success = File.check_create_path build_dir in
let _ = if not success then OManager.error "cannot create or enter in directory @{<bright>%s@}" build_dir in
List.iter write generated_files
in
{ generated_files = generated_files }
let js_treat env_opt env_js_output =
if not env_opt.exe_run
then 0
else
let prog = env_opt.js_exe in
let args = env_opt.exe_argv in
let args = args @ ( List.map fst env_js_output.generated_files ) in
OManager.verbose "building finished, will run @{<bright>%s@}" prog ;
OManager.verbose "going to directory @{<bright>%s@}" env_opt.compilation_directory ;
Sys.chdir env_opt.compilation_directory ;
let command = String.concat " " (prog::args) in
OManager.verbose "exec$ %s" command ;
let args = Array.of_list (prog::args) in
let run () = Unix.execvp prog args in
Unix.handle_unix_error run ()
end
module Sugar :
sig
val for_opa : val_:(string -> QmlAst.ident) ->
?bsl:JsAst.code ->
closure_map:Ident.t IdentMap.t ->
renaming_server:QmlRenamingMap.t ->
renaming_client:QmlRenamingMap.t ->
(module Qml2jsOptions.JsBackend) ->
Qml2jsOptions.t ->
BslLib.env_bsl ->
QmlTyper.env ->
QmlAst.code ->
J.env_js_input
val dummy_for_opa : (module Qml2jsOptions.JsBackend) -> unit
end
=
struct
let for_opa ~val_ ?bsl:bsl_code ~closure_map ~renaming_server ~renaming_client back_end argv env_bsl env_typer code =
let module M = (val back_end : Qml2jsOptions.JsBackend) in
let env_js_input = M.compile ~val_ ?bsl:bsl_code ~closure_map ~renaming_server ~renaming_client argv env_bsl env_typer code in
env_js_input
let dummy_for_opa backend =
let module M = (val backend : Qml2jsOptions.JsBackend) in
M.dummy_compile ()
end
let wclass =
let doc = "Javascript compiler warnings" in
WarningClass.create ~name:"jscompiler" ~doc ~err:false ~enable:true ()