Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 405 lines (364 sloc) 11.267 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
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
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (* CF mli *)
19
20 (* depends *)
21 module Format = Base.Format
22 module List = Base.List
23
24 (* refactoring in progress *)
25
26 (* alias *)
27 module JsSerializer = Qmljs_Serializer.JsSerializer
28 module QmlSerializer = Qmljs_Serializer.QmlSerializer
29
30 (* shorthands *)
31 module BPI = BslPluginInterface
32 module O = OpaEnv
33
34 (* -- *)
35
36 (*
37 Compositionality.
38 Used to know what js files have already been registred, to avoid duplication
39 of js insertion.
40 *)
41 module S =
42 struct
43 type t = {
44 (**
45 Indexed by the name of the file.
46 *)
47 extralibs : (string, unit) Hashtbl.t ;
48
49 (**
50 Indexed by a plugin_id (module_name)
51 *)
52 plugins : (string, unit) Hashtbl.t ;
53 }
54
55 let pass = "JavascriptCompilation"
56 let pp f _ = Format.pp_print_string f "<dummy>"
57 end
58
59 module R = ObjectFiles.Make(S)
60
61 (*
62 Traduction of options.
63 *)
64 let pass_OpaOptionsToJsOptions _backend options =
65 let argv_options = Qml2jsOptions.Argv.default () in
66 { argv_options with Qml2jsOptions.
67 command_line = false;
68 cps = options.O.cps_client;
69 cps_toplevel_concurrency = options.O.cps_toplevel_concurrency ;
70 qml_closure = options.O.closure;
71 extra_lib = options.O.extrajs;
72 alpha_renaming = options.O.js_local_renaming;
73 check_bsl_types = options.O.js_check_bsl_types;
74 cleanup = options.O.js_cleanup;
75 inlining = options.O.js_local_inlining;
76 global_inlining = options.O.js_global_inlining;
77 no_assert = options.O.no_assert;
78 }
79
80
81 (*
82 A external root elemt (plugin and extra libs)
83 *)
84 let make_root key content =
85 let content = [ JsSerializer.Verbatim content ] in
86 let code_elt = { JsSerializer.
87 ident = JsSerializer.KI_key key ;
88 root = true ;
89 definition = `Nothing ;
90 content = content ;
91 } in
92 code_elt
93
94 (*
95 Serialization of the client code
96 *)
97 let client_serialization
98 ~client_roots
99 rev_code ( env_js_input : Qml2jsOptions.env_js_input ) =
100 (*
101 bsl projection: They are no longer roots since the generation
102 of bypass projection uses Ident.
103 *)
104 let rev_code =
105 List.fold_left (
106 fun rev_code (_name, elts) ->
107 match elts with
108 | `ast elts ->
109 List.fold_left (
110 fun rev_code (unicity_index, js_elt) ->
111 let js_elt = JsUtils.globalize_native_ident js_elt in
112 let js_elt =
113 JsSerializer.serialize
114 ~client_roots
115 ~key:unicity_index
116 js_elt in
117 js_elt :: rev_code
118 ) rev_code elts
119 | `string s ->
120 make_root (Digest.string s) s :: rev_code
121 ) rev_code env_js_input.Qml2jsOptions.js_init_contents
122 in
123
124 (*
125 serialization of the compiled client code.
126 *)
127 let rev_code =
128 List.fold_left (
129 fun rev_code ( code_elt : JsAst.code_elt ) ->
130 (*
131 No need to globalize native ident, done in the compiler directly.
132 *)
133 let code_elt =
134 JsSerializer.serialize
135 ~client_roots
136 code_elt in
137 code_elt :: rev_code
138 ) rev_code env_js_input.Qml2jsOptions.js_code
139 in
140 rev_code
141
142 (*
143 A special function for parsing and serializing external js files,
144 such than bsl files, and/or extralibs
145 *)
146 let parse_js_content ~optimized_conf ~key_prefix ~filename ~content =
147 let parsed_code =
148 try JsParse.String.code ~throw_exn:true content
149 with JsParse.Exception e ->
150 OManager.error (
151 "External Javascript serialization@\n"^^
152 "Cannot serialize external js-code @{<bright>%s@}@\n"^^
153 "File %S: %a@\n"
154 )
155 key_prefix
156 filename
157 JsParse.pp e in
158
159 let parsed_code = if optimized_conf.BslJsConf.localrenaming then Imp_Renaming.rename parsed_code else parsed_code in
160 (* cleanup does not always reaches a fixpoint on the first try, it is worth applying it twice *)
161 let parsed_code = if optimized_conf.BslJsConf.cleanup then Imp_CleanUp.clean ~use_shortcut_assignment:true parsed_code else parsed_code in
162 let parsed_code = if optimized_conf.BslJsConf.cleanup then Imp_CleanUp.clean ~use_shortcut_assignment:true parsed_code else parsed_code in
163 let parsed_code = List.map JsUtils.globalize_native_ident parsed_code in
164 parsed_code
165
166 let serialize_js_content
167 ~client_roots
168 ~key_prefix ~parsed_code
169 rev_code
170 =
171 (*
172 We use a counter for distinguing statements from external files.
173 We assume that if we parse 2 time the same plugin, or external files,
174 the order returned by the parser is the same.
175 *)
176 let count = ref 0 in
177 let fold rev_code js_elt =
178 let key =
179 incr(count) ;
180 key_prefix ^ "_item_" ^ (string_of_int !count)
181 in
182 let js_elt =
183 JsSerializer.serialize
184 ~client_roots
185 ~key
186 js_elt in
187 js_elt :: rev_code
188 in
189 List.fold_left fold rev_code parsed_code
190
191 (*
192 Process all the code.
193 Handle the serialization of extralibs, plugins, code, and reinjection of the client code
194 in the server code.
195 *)
196 let full_serialize
197 ~options
198 ~closure_map
199 ~renaming_server
200 ~renaming_client
201 ~client_roots
202 ~typing:_
203 ~bsl_pp
204 ~bsl_client
205 ~client
206 =
207
208 let back_end = options.OpaEnv.js_back_end in
209 let jsoptions = pass_OpaOptionsToJsOptions back_end options in
210
211 (* compositionality -- load *)
212 let all_extralibs = Hashtbl.create 16 in
213 let all_plugins = Hashtbl.create 16 in
214 let this_extralibs = Hashtbl.create 4 in
215 let this_plugins = Hashtbl.create 4 in
216
217 let () =
218 let iter t =
219 Hashtbl.iter (Hashtbl.add all_extralibs) t.S.extralibs ;
220 Hashtbl.iter (Hashtbl.add all_plugins) t.S.plugins ;
221 in
222 R.iter ~deep:true iter
223 in
224 let register_extralib lib_id =
225 Hashtbl.add all_extralibs lib_id () ;
226 Hashtbl.add this_extralibs lib_id () ;
227 ()
228 in
229 let register_plugin plugin_id =
230 Hashtbl.add all_plugins plugin_id () ;
231 Hashtbl.add this_plugins plugin_id () ;
232 ()
233 in
234 (* --- *)
235
236 let rev_ast : ([ `unparsed of JsSerializer.jsast_code_elt | `parsed of JsAst.code] * string) list = [] in
237
238 (* 1) extra libs *)
239 (*
240 Each extra lib is traduced as a [JsSerializer.code_elt]
241 *)
242 let rev_ast =
243 List.fold_left
244 (fun rev_ast (extra_lib, conf) ->
245 (*
246 Avoid to register several time the same extra lib with different packages:
247 1. detected at compile time if we have already compiled the same elt
248 2. detected at runtime for independant packages (key)
249 *)
250 if Hashtbl.mem all_extralibs extra_lib
251 then rev_ast
252 else (
253 register_extralib extra_lib ;
254 let filename, content, hash = ObjectFiles.find_js_file_content_digest extra_lib in
255 let key_prefix = File.concat "extralib" hash in
256 match conf with
257 | BslJsConf.Verbatim ->
258 let code_elt = make_root key_prefix content in
259 (`unparsed code_elt, key_prefix) :: rev_ast
260 | BslJsConf.Optimized optimized_conf ->
261 (`parsed (parse_js_content ~optimized_conf ~key_prefix ~filename ~content), key_prefix) :: rev_ast
262 )
263 ) rev_ast jsoptions.Qml2jsOptions.extra_lib in
264
265
266 (* 2) plugins *)
267 (*
268 Each plugin is also traduced as a list of [JsSerializer.code_elt]
269 *)
270 let rev_ast =
271 List.fold_left
272 (fun rev_ast plugin ->
273 let plugin_id = plugin.BPI.self_module_name in
274 if Hashtbl.mem all_plugins plugin_id
275 then rev_ast
276 else (
277 register_plugin plugin_id ;
278 let fold rev_ast (filename, content, conf) =
279 let key_prefix = plugin_id ^ filename in
280 let content = bsl_pp content in
281 match conf with
282 | BslJsConf.Verbatim ->
283 let code_elt = make_root plugin_id content in
284 (`unparsed code_elt, key_prefix) :: rev_ast
285 | BslJsConf.Optimized optimized_conf ->
286 (`parsed (parse_js_content ~optimized_conf ~key_prefix ~filename ~content), key_prefix) :: rev_ast in
287 List.fold_left fold rev_ast plugin.BPI.js_code
288 )
289 ) rev_ast bsl_client.BslLib.plugins in
290
291 let bsl_and_plugin_ast =
292 List.flatten (
293 List.filter_map
294 (function
295 | `parsed parsed -> Some parsed
296 | `unparsed _ -> None)
297 (List.rev_map fst rev_ast)
298 ) in
299
300 (* compilation of js code *)
301 let env_js_input_val_ name =
302 try
303 let name = Hashtbl.find Opacapi.table name in
304 OpaMapToIdent.val_ ~side:`client name
305 with Not_found ->
306 OManager.error "Function %S not registered in Opacapi@\n" name in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
307 let env_js_input =
308 Qml2js.Sugar.for_opa
309 ~bsl:bsl_and_plugin_ast
310 ~val_:env_js_input_val_
311 ~closure_map
312 ~renaming_server
313 ~renaming_client
314 back_end
315 jsoptions
316 bsl_client
317 client.QmlBlender.env
318 client.QmlBlender.code
319 in
fccc685 Initial open-source release
MLstate authored
320
321 let rev_code : JsSerializer.jsast_code = [] in
322 let rev_code = List.fold_left
323 (fun rev_code (ast,key_prefix) ->
324 match ast with
325 | `parsed parsed_code ->
326 serialize_js_content
327 ~client_roots
328 ~key_prefix
329 ~parsed_code
330 rev_code
331 | `unparsed code_elt ->
332 code_elt :: rev_code
333 ) rev_code (List.rev rev_ast) in
334
335 (* 3) client code *)
336 let rev_code =
337 client_serialization
338 ~client_roots
339 rev_code env_js_input
340 in
341
342 (* compositionality -- save *)
343 let () =
344 let t = { S.
345 extralibs = this_extralibs ;
346 plugins = this_plugins ;
347 } in
348 R.save t
349 in
350 (* -- *)
351
352 rev_code
353
354
355 (*
356 Serialize the js, and reinject it in the server code.
357 *)
358 let reinjection ~options ~server ~rev_code =
359 let server_code = server.QmlBlender.code in
360 let server_code =
361 QmlSerializer.insert_code
362 ~kind:options.OpaEnv.js_serialize
363 (List.rev rev_code)
364 server_code in
365 { server with QmlBlender.
366 code = server_code ;
367 }
368
369 (*
370 Main function, exported to be used by the pass.
371 *)
372 let process
373 ~options
374 ~closure_map
375 ~renaming_server
376 ~renaming_client
377 ~client_roots
378 ~typing
379 ~bsl_pp
380 ~bsl_client
381 ~server
382 ~client
383 =
384
385 if client.QmlBlender.code = [] then (
386 R.save {S.extralibs = Hashtbl.create 0; S.plugins = Hashtbl.create 0};
387 Qml2js.Sugar.dummy_for_opa options.OpaEnv.js_back_end;
388 server
389 ) else (
390
391 let rev_code = full_serialize
392 ~options
393 ~closure_map
394 ~renaming_server
395 ~renaming_client
396 ~client_roots
397 ~typing
398 ~bsl_pp
399 ~bsl_client
400 ~client
401 in
402 let server = reinjection ~options ~server ~rev_code in
403 server
404 )
Something went wrong with that request. Please try again.