Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 767 lines (685 sloc) 26.438 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 (**
19 Common Passes for Qml Command Line compilers.
20 *)
21
22 (** {6 Design Notes} *)
23
24 (**
25 Currently, qml is still too far from opa in the framework organisation,
26 so we have dependencies probleme to be solved so that the options are
27 shared between qml passes and opa passes.
28
29 Waiting (not too long) where we will have time to continue to refactor
30 this, we start the passes once the options are already available, and
31 we have a unified dynloader function in libbsl. (todo)
32 *)
33
34 (* depends *)
35 let ( |> ) x f = f x
36
37 (* alias *)
38 module PH = PassHandler
39
40 (** {6 Types used} *)
41
42 (**
43 A dynloader is a function which take a generated loader
44 (like [OpabslgenLoader]), and register all bypass which its defines
45 somewhere, with a side effect.
46
47 @see "BslLib.BSLINTROSPECTION.ByPassMap.RegisterInterface" to see how
48 back-end build a value of this type
49 *)
50 type dynloader = BslPluginInterface.plugin -> unit
51
52 (**
53 The type of options used by qml compilers passes.
54 Currently, due to refactoring issues, this type is the type of
55 qml2ocaml options, which is bad.
56 TODO: use the same options than opa.exe
57 *)
58 type options = Qml2ocamlOptions.argv_options
59
60 (**
61 The type taken by the back-end at end of passes
62 *)
63 type env_final = {
64 env_bsl : BslLib.env_bsl ;
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
65 env_typer : QmlTyper.env ;
66 code : QmlAst.code ;
fccc685 Initial open-source release
MLstate authored
67 }
68
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
69 let extract_final_ac env = env.env_typer.QmlTypes.annotmap, env.code
5fdc6b9 @BourgerieQuentin [enhance] compiler: (big) Common path typing beetween several backend…
BourgerieQuentin authored
70 let extract_final_agc env = env.env_typer.QmlTypes.annotmap, (env.env_typer.QmlTypes.gamma, env.env_typer.QmlTypes.gamma) , env.code
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
71 let extract_final_code env = env.code
72 let extract_final_bypass_typer env = env.env_typer.QmlTypes.bypass_typer
73 let extract_final_bypass_typer_code env = extract_final_bypass_typer env, extract_final_code env
74
75 (**
76 Get a function working on env_final from a process_code working on gamma, annotmap and code
77 *)
78 let final_sugar ~process_code =
79 let pass env_final =
80 let env_typer = env_final.env_typer in
81 let gamma = env_typer.QmlTypes.gamma in
82 let annotmap = env_typer.QmlTypes.annotmap in
83 let code = env_final.code in
84 let (gamma, annotmap), code = process_code gamma annotmap code in
85 { env_final with
86 env_typer = { env_typer with QmlTypes.
87 gamma ;
88 annotmap ;
89 } ;
90 code ;
91 }
92 in
93 ( pass : env_final -> env_final )
fccc685 Initial open-source release
MLstate authored
94
95 module QmlPasses :
96 sig
97 (** {6 Front passes} *)
98
99 (**
100 The type returned by the parser
101 *)
102 type env_parsed = {
103 init_code : QmlAst.code option ;
104 user_code : QmlAst.code ;
105 }
106
107 (**
108 Load plugins and register all bypasses
109 *)
110 val pass_BslLoading :
111 (options, options, dynloader, BslLib.env_bsl) PassHandler.pass
112
113 (**
114 Get the code (stdlib of qml, and user code).
115 Waiting for killing the qml-syntax, there will be a transitionnal time
116 during which the 2 syntax will be supported as input of qmlcompilers.
117 *)
118 val pass_Parse :
119 (options, options, BslLib.env_bsl, BslLib.env_bsl * env_parsed)
120 PassHandler.pass
121
122 (**
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
123 AlphaConv + Typing
fccc685 Initial open-source release
MLstate authored
124 *)
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
125 val pass_Typing :
fccc685 Initial open-source release
MLstate authored
126 (options, options, BslLib.env_bsl * env_parsed, env_final) PassHandler.pass
127
128 (** {6 Middle passes} *)
129 (** From there, the final passes have the same type *)
130 type final_pass = (options, options, env_final, env_final) PassHandler.pass
131
132 (** main: combine passes using PassHandler, and return the final env for the
133 backends *)
134 val main : ?dynloader:dynloader -> side:[`client|`server] -> lang:BslLanguage.t -> options -> env_final
135 end =
136 struct
137 module List = Base.List
138
139 type env_parsed = {
140 init_code : QmlAst.code option ;
141 user_code : QmlAst.code ;
142 }
143 type final_pass = (options, options, env_final, env_final) PassHandler.pass
144
145 (* FIXME: sharing options with more *)
146 open Qml2ocamlOptions
147
148 let pass_BslLoading =
149 let transform pass_env =
150 let options = pass_env.PassHandler.options in
151 let dynloader = pass_env.PassHandler.env in
152 (* FIXME : share with opa/passes.ml : pass_BSLLoading will call this function with the minimum argv_options accessed here *)
153 let search_path = "" :: options.extra_path in
154 List.iter
155 (fun bypass_plugin ->
156 let file = bypass_plugin in
157 let found_files =
158 List.filter_map
159 (fun p ->
160 let fullname = Filename.concat p file in
161 if File.is_regular fullname then Some fullname else None)
162 search_path in
163 let file =
164 match found_files with
165 | [] -> file
166 | [fullname] -> fullname
167 | fullname::_ ->
168 OManager.warning ~wclass:WarningClass.bsl_loading (
169 "Bypass-plugin @{<bright>%s@} found in several places.@\n"^^
170 "I will use @{<bright>%s@}" ) file fullname;
171 fullname in
172 OManager.verbose "load file @{<bright>%S@} (plugin)" file;
173 BslDynlink.loadfile_private (BslDynlink.MarshalPlugin bypass_plugin)
174 )
175 options.bypass_plugin;
176 (* building the loader table -- resolving the dependencies (else,
177 fatal error containing a message) *)
178 let loaders = BslPluginTable.finalize () in
179 (* Call always BslLib.BSL + with the dynloader in arg *)
180 List.iter
181 (fun loader ->
182 BslLib.BSL.RegisterInterface.dynload
183 loader.BslPluginInterface.dynloader ;
184 dynloader loader
185 )
186 loaders ;
187 (* building a first version the map (not compiler specific) *)
188 let bymap = BslLib.BSL.RegisterTable.build_bypass_map () in
189 let env = { BslLib. bymap = bymap ; plugins = loaders } in
190 let empty _ = [] in
191 { pass_env with PassHandler.
192 env = env ;
193 printers = empty;
194 trackers = empty } in
195 let precond =
196 [
197 (* TODO: add pre condition *)
198 ] in
199 let postcond =
200 [
201 (* TODO: add post condition *)
202 ] in
203 PassHandler.make_pass ~precond ~postcond transform
204
205
206 (* ======================================================================= *)
207
208 let env_Parse_extract_code (_,env) = (Option.default [] env.init_code) @ env.user_code
5fdc6b9 @BourgerieQuentin [enhance] compiler: (big) Common path typing beetween several backend…
BourgerieQuentin authored
209 let env_Parse_extract_ac env = (QmlAnnotMap.empty, (QmlTypes.Env.empty, QmlTypes.Env.empty), env_Parse_extract_code env)
fccc685 Initial open-source release
MLstate authored
210
211 let pass_Parse =
212 let transform pass_env =
213 let vcp = ConsoleParser.create () in
214 let options = pass_env.PassHandler.options in
215 let bsl = pass_env.PassHandler.env in
216
217 let input_string location parse_me =
218 try
219 OpaToQml.Parser.of_string ~filename: location parse_me
220 with
221 | OpaToQml.Parser.Exception e ->
222 OManager.error "%s -- parsing error@\n%s" location e in
223
224 let lines_foldi filename line int =
225 match ConsoleParser.accumulate vcp line with
226 | None ->
227 []
228 | Some input -> (
229 match input with
230 | ConsoleParser.Directive _ ->
231 (* This qmltop directive is ignored by this compiler. *)
232 []
233 | ConsoleParser.Code parse_me ->
234 let location =
235 Printf.sprintf
236 "file \"%s\"%s"
237 filename
238 (if int > 0 then Printf.sprintf " -- line %d" int else "") in
239 input_string location parse_me
240 ) in
241
242 let input_file input_file =
243 let filename =
244 match input_file with
245 | Qml2ocamlOptions.QmlFile filename ->
246 OManager.error
247 "filename %S has suffix .qml@\nThe syntax qml is deprecated, please use opa syntax@\n" filename
248 | Qml2ocamlOptions.OpaFile filename -> filename in
249
250 OManager.verbose "parsing @{<bright>%S@}" filename;
251 ConsoleParser.reset vcp ;
252 let lcode = File.lines_rev_mapi (lines_foldi filename) filename in
253 let lcode = List.rev ((lines_foldi filename ";;" (-1))::lcode) in
254 List.concat lcode
255 in
256
257 let input_string (filename, contents) =
258 OManager.verbose "parsing @{<bright>%S@}" filename;
259 input_string filename contents in
260
261 let init_code = if options.no_stdlib then None else
262 Some (List.concat_map
263 (fun loader -> List.concat_map input_string
264 loader.BslPluginInterface.opa_code)
265 bsl.BslLib.plugins) in
266
267 let user_code =
268 List.concat_map input_file options.input_files in
269
270 let env = bsl,
271 {
272 init_code = init_code ;
273 user_code = user_code
274 } in
275
276 let printers = QmlTracker.printers env_Parse_extract_ac in
277 let trackers = QmlTracker.trackers env_Parse_extract_code in
278 { pass_env with PassHandler.
279 env ;
280 printers ;
281 trackers ;
282 }
283 in
284 let precond =
285 [
286 (* TODO: add pre condition *)
287 ] in
288 let postcond =
289 [
290 (* TODO: add post condition *)
291 ] in
292 PassHandler.make_pass ~precond ~postcond transform
293
294
295 (* ============================================================================== *)
296 (* FIXME: it is not yet sure what we should do with exceptions / vs OManager *)
297 (* Some user may be keen on keeping exception instead of errors (qmltop, ide?) *)
298 let handle_exception_error fct =
299 try
300 fct ()
301 with
302 | (QmlTypes.Exception _ | QmlTyperException.Exception _) as exn ->
303 (* At this point, we do not have any environment nor annotations map. *)
304 OManager.error "Typer : %a"
ed8052e @fpessaux [cleanup] Typer exceptions: Removed no more raised exceptions and rel…
fpessaux authored
305 (QmlTyperErrHandling.pp_report_from_typer_exception QmlAnnotMap.empty)
fccc685 Initial open-source release
MLstate authored
306 exn ;
307 | QmlCpsRewriter.Exception e ->
308 OManager.error "QmlCps : %s" (QmlCpsRewriter.error_message e)
309
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
310 module HighTyper = QmlTyper.DynamicallyChangeableTyper.HighTyper
311
312 let pass_Typing =
fccc685 Initial open-source release
MLstate authored
313 let transform pass_env =
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
314 let env_bsl, qml = pass_env.PassHandler.env in
fccc685 Initial open-source release
MLstate authored
315 (** construction of bypass_typer *)
5e2359f @fpessaux [cleanup] qml level typer: Cleanup in obscure options never set.
fpessaux authored
316 let bypass_typer =
317 BslLib.BSL.ByPassMap.bypass_typer env_bsl.BslLib.bymap in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
318 let env_typer =
319 HighTyper.initial
c2096c3 @fpessaux [cleanup] qml level typer: removed arguments always used with the sam…
fpessaux authored
320 ~bypass_typer ~explicit_instantiation: false
321 ~value_restriction: `disabled ~exported_values_idents: IdentSet.empty
322 () in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
323 let env_typer, code =
324 let code = Option.default [] qml.init_code @ qml.user_code in
fccc685 Initial open-source release
MLstate authored
325 let fct () =
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
326 (* 1°: sorting things out *)
327 let code_defs, code_dbfiles, code_dbdefs, code =
328 (* verbose "I-1) Sorting top-level nodes"; *)
329 let sort_user = QmlAstSort.add QmlAstSort.empty code in
330 let code_defs = QmlAstSort.Get.new_type sort_user
331 and code_dbfiles = QmlAstSort.Get.database sort_user
332 and code_dbdefs = QmlAstSort.Get.new_db_value sort_user
333 and user_code = QmlAstSort.Get.new_val sort_user
334 in code_defs, code_dbfiles, code_dbdefs, user_code
335 in
336
337 assert (code_dbfiles = []);
338 assert (code_dbdefs = []);
339
340 (* pre-2: dependency analysis on type definitions *)
341 QmlTypes.check_no_duplicate_type_defs code_defs;
342
343 (* 2°: getting type definitions into Gamma *)
344 let env_typer = HighTyper.fold env_typer code_defs in
345
346 (* 5°: alpha-conversion *)
347 let code =
348 let alpha = QmlAlphaConv.next () in
349 (* verbose "I-5) alpha-converting the code"; *)
350 let _, code = QmlAlphaConv.code alpha code in
351 code
352 in
353
354 (* 6°: typing *)
355 let env_typer = HighTyper.fold env_typer code in
356 env_typer, code
fccc685 Initial open-source release
MLstate authored
357 in
358 handle_exception_error fct
359 in
360
361 OManager.flush_errors () ;
362
363 let env =
364 {
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
365 env_bsl ;
366 env_typer ;
367 code ;
fccc685 Initial open-source release
MLstate authored
368 }
369 in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
370 let printers = QmlTracker.printers extract_final_agc in
371 let trackers = QmlTracker.trackers extract_final_code in
fccc685 Initial open-source release
MLstate authored
372 { pass_env with PassHandler.
373 env ;
374 printers ;
375 trackers ;
376 }
377 in
378 let precond =
379 [
380 (* TODO: add pre condition *)
381 ] in
382 let postcond =
383 [
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
384 QmlAlphaConv.Check.alpha extract_final_ac
fccc685 Initial open-source release
MLstate authored
385 ] in
386 PassHandler.make_pass ~precond ~postcond transform
387
388 (* ============================================================================== *)
389
390 (* FIXME: passing options around : if the type options is defined somewhere higher *)
391 (* Or even if a pass gives directly command arg tuple ?*)
392 (* need to pass some options to the pass from argv_options *)
393
394 let make_final_pass precond postcond process_code =
395 let transform pass_env =
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
396 let env_final = pass_env.PassHandler.env in
397 let env_final =
398 let fct () = final_sugar ~process_code env_final in
fccc685 Initial open-source release
MLstate authored
399 handle_exception_error fct
400 in
401 { pass_env with PassHandler.
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
402 env = env_final ;
fccc685 Initial open-source release
MLstate authored
403 }
404 in
405 PassHandler.make_pass ~precond ~postcond transform
406
407 let make_final_pass_options precond postcond process_code =
408 let transform pass_env =
409 let options = pass_env.PassHandler.options in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
410 let env_final = pass_env.PassHandler.env in
fccc685 Initial open-source release
MLstate authored
411 let process_code = process_code options in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
412 let env_final =
413 let fct () = final_sugar ~process_code env_final in
fccc685 Initial open-source release
MLstate authored
414 handle_exception_error fct
415 in
416 { pass_env with PassHandler.
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
417 env = env_final ;
fccc685 Initial open-source release
MLstate authored
418 }
419 in
420 PassHandler.make_pass ~precond ~postcond transform
421
422
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
423 let make_final_pass_options_env_typer precond postcond process_code =
fccc685 Initial open-source release
MLstate authored
424 let transform pass_env =
425 let options = pass_env.PassHandler.options in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
426 let env_final = pass_env.PassHandler.env in
427 let env_typer = env_final.env_typer in
428 let env_final =
429 let fct () = final_sugar ~process_code:(process_code options env_typer) env_final in
fccc685 Initial open-source release
MLstate authored
430 handle_exception_error fct
431 in
432 { pass_env with PassHandler.
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
433 env = env_final ;
fccc685 Initial open-source release
MLstate authored
434 }
435 in
436 PassHandler.make_pass ~precond ~postcond transform
437
438 let make_final_pass_bypass_typer precond postcond process_code =
439 let transform pass_env =
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
440 let env_final = pass_env.PassHandler.env in
441 let bypass_typer = env_final.env_typer.QmlTypes.bypass_typer in
442 let env_final =
443 let fct () = final_sugar ~process_code:(process_code bypass_typer) env_final in
fccc685 Initial open-source release
MLstate authored
444 handle_exception_error fct
445 in
446 { pass_env with PassHandler.
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
447 env = env_final ;
fccc685 Initial open-source release
MLstate authored
448 }
449 in
450 PassHandler.make_pass ~precond ~postcond transform
451
452 let make_final_pass_bymap precond postcond process_code =
453 let transform pass_env =
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
454 let env_final = pass_env.PassHandler.env in
455 let bymap = env_final.env_bsl.BslLib.bymap in
456 let env_final =
457 let fct () = final_sugar ~process_code:(process_code ~bymap) env_final in
fccc685 Initial open-source release
MLstate authored
458 handle_exception_error fct
459 in
460 { pass_env with PassHandler.
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
461 env = env_final ;
462 }
463 in
fccc685 Initial open-source release
MLstate authored
464 PassHandler.make_pass ~precond ~postcond transform
465
466 let pass_Assertion =
467 let process_code options gamma annotmap code =
468 let no_assert = options.no_assert in
469 let annotmap, code = Pass_Assertion.process_code ~no_assert gamma annotmap code in
470 (gamma, annotmap), code
471 in
472 make_final_pass_options
473 []
474 []
475 process_code
476
477 let pass_LambdaLifting side =
478 let precond =
479 [
480 QmlAlphaConv.Check.unicity extract_final_ac ;
481 ] in
482 let postcond =
483 [
484 QmlAlphaConv.Check.alpha extract_final_ac ;
485 ] in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
486 make_final_pass_options precond postcond
487 (fun options -> Pass_LambdaLifting.process_code ~early:false ~typed:(not options.cps) ~side)
fccc685 Initial open-source release
MLstate authored
488
489 let pass_BypassHoisting =
490 let precond =
491 [
492 (* TODO: add pre condition *)
493 ] in
494 let postcond =
495 [
496 QmlAlphaConv.Check.alpha extract_final_ac ;
497 ] in
88694da [clean] bypassHoisting: simplifying it a lot
Valentin Gatien-Baron authored
498 make_final_pass precond postcond (
499 fun gamma annotmap code ->
500 let annotmap, code = Pass_BypassApply.process_code gamma annotmap code in
501 (gamma, annotmap), code
502 )
fccc685 Initial open-source release
MLstate authored
503
504 let pass_DiscardRemoteBypasses ~lang =
505 let precond = [] and postcond = [] in
506 make_final_pass_bymap precond postcond (QmlFakeSlicer.discard_remote_bypasses ~lang)
507
508 let pass_Uncurry side =
509 let precond =
510 [
511 (* TODO: add pre condition *)
512 ] in
513 let postcond =
514 [
515 QmlAlphaConv.Check.alpha extract_final_ac ;
516 ] in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
517 make_final_pass_options precond postcond
518 (fun options gamma annotmap code ->
fccc685 Initial open-source release
MLstate authored
519 let gamma_annotmap, _closure_map, code =
520 Pass_Uncurry.process_code
521 ~typed:(not options.cps)
522 ~side
523 gamma
524 annotmap
525 code in
526 gamma_annotmap, code
527 )
528
529 (* need bypass typer *)
530 let pass_Closure ~side =
531 let precond =
532 [
533 (* TODO: add pre condition *)
534 ] in
535 let postcond =
536 [
537 QmlAlphaConv.Check.alpha extract_final_ac ;
538 ] in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
539 make_final_pass_options_env_typer precond postcond
540 (fun options env_typer ->
fccc685 Initial open-source release
MLstate authored
541 Pass_Closure.process_code
542 ~typed:(not options.cps)
543 ~side
544 ~renaming_server:QmlRenamingMap.empty
545 ~renaming_client:QmlRenamingMap.empty
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
546 env_typer.QmlTypes.bypass_typer)
fccc685 Initial open-source release
MLstate authored
547
548 let pass_ConstantSharing =
549 let transform pass_env =
550 let options = pass_env.PassHandler.options in
551 (*
552 Work arround : if we activate typed mode of ConstantSharing after cps,
553 some annot are not found because currently cps refresh annots and does
554 not report types.
555 TODO: once cps will be fixed, remove this hack, and let the pass be in typed mode.
556 *)
557 let typed = not options.cps in
558 let process_code = Pass_ConstantSharing.process_code ~side:`client ~typed in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
559 let env_final = pass_env.PassHandler.env in
560 let env_final =
561 final_sugar ~process_code env_final
fccc685 Initial open-source release
MLstate authored
562 in
563 { pass_env with PassHandler.
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
564 env = env_final ;
fccc685 Initial open-source release
MLstate authored
565 }
566 in
567 let precond =
568 [
569 (* TODO: add pre condition *)
570 ] in
571 let postcond =
572 [
573 QmlAlphaConv.Check.alpha extract_final_ac ;
574 ] in
575 PassHandler.make_pass ~precond ~postcond transform
576 (* ============================================================================== *)
577
578 let pass_CpsRewriter ~lang =
579 let transform pass_env =
580 let options = pass_env.PassHandler.options in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
581 let env_final = pass_env.PassHandler.env in
582 let code = env_final.code in
583 let env_bsl = env_final.env_bsl in
584 let env_typer = env_final.env_typer in
fccc685 Initial open-source release
MLstate authored
585 let cps_options =
586 { QmlCpsRewriter.default_options with QmlCpsRewriter.
587 no_assert = options.no_assert ;
588 qml_closure = options.qml_closure ;
589 toplevel_concurrency = options.cps_toplevel_concurrency ;
590 server_side = options.server_side
591 } in
592 let bsl_bypass_typer key =
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
593 match BslLib.BSL.ByPassMap.bsl_bypass_typer env_bsl.BslLib.bymap key with
fccc685 Initial open-source release
MLstate authored
594 | None ->
595 (* TODO: this must be a precondition, violation by the type checking *)
596 OManager.error (
597 "%%%% @{<bright>%s@} %%%% : unknown external primitives are not allowed@\n"^^
598 "Please use a plugin"
599 )
600 (BslKey.to_string key)
601 | Some t -> t in
602 let bsl_bypass_tags key =
603 match BslLib.BSL.ByPassMap.bsl_bypass_tags
604 ~lang
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
605 env_bsl.BslLib.bymap key
fccc685 Initial open-source release
MLstate authored
606 with
607 | None ->
608 OManager.error (
609 "%%%% @{<bright>%s@} %%%% : unknown external primitives are not allowed@\n"^^
610 "Please use a plugin"
611 )
612 (BslKey.to_string key)
613 | Some t -> t in
614 let bsl_bypass_cps =
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
615 BslLib.BSL.ByPassMap.bsl_bypass_cps ~lang env_bsl.BslLib.bymap in
fccc685 Initial open-source release
MLstate authored
616 let env_cps =
617 QmlCpsRewriter.env_initial
618 ~options:cps_options
619 ~bsl_bypass_typer
620 ~bsl_bypass_tags
621 ~bsl_bypass_cps
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
622 ~typing:env_typer
fccc685 Initial open-source release
MLstate authored
623 ()
624 in
625 let code =
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
626 let fct () =
627 (if options.cps then QmlCpsRewriter.cps_pass ~side:`server else QmlCpsRewriter.no_cps_pass)
628 env_cps code
629 in
fccc685 Initial open-source release
MLstate authored
630 handle_exception_error fct in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
631 let env_final = { env_final with code ; } in
fccc685 Initial open-source release
MLstate authored
632
633 OManager.flush_errors () ;
634
635 { pass_env with PassHandler.
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
636 env = env_final ;
fccc685 Initial open-source release
MLstate authored
637 }
638 in
639 let precond =
640 [
641 ] in
642 let postcond =
643 [
644 (*
645 This post condition is currently broken because of the second_order bypasses.
646 In bsl_ocaml_init.ml they take 1 extra argument, but the bypass_typer does not know
647 about it. This condition is desactivated until we solve this probleme.
648 QmlCheck.Bypass.applied extract;
649 *)
650 QmlAlphaConv.Check.alpha extract_final_ac ;
651 ] in
652 PassHandler.make_pass ~precond ~postcond transform
653
654 let pass_RemoveTyperCrap =
655 let transform env =
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
656 let env_final = env.PassHandler.env in
657 let code = env_final.code in
fccc685 Initial open-source release
MLstate authored
658 let code =
659 QmlAstWalk.CodeExpr.map
660 (QmlAstWalk.Expr.map_up
661 (function
662 | QmlAst.Coerce (_, e, _) -> e
663 | QmlAst.Directive (_, #QmlAst.type_directive, l, _) ->
664 (match l with
665 | [e] -> e
666 | _ -> assert false)
667 | e -> e)
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
668 ) code in
669 let env_final = { env_final with code } in
670 {env with PassHandler.env = env_final }
671 in
fccc685 Initial open-source release
MLstate authored
672 PassHandler.make_pass transform
673
674 (* lambda lifting can be switche on without closure, for testing *)
675 let if_LambdaLifting ~options _ = options.lambda_lifting || options.qml_closure
676 let if_Closure ~options _ = options.qml_closure
677 let if_ClosureServer side ~options _ = options.qml_closure && side = `server
678 let if_CpsRewriter ~options _ = options.cps
679
680 let if_ConstantSharing ~options _ = options.constant_sharing
681
682 let main ?(dynloader=ignore) ~side ~lang options =
683 ObjectFiles.no_init := true;
684 PassHandler.make_env options dynloader
685 |> PassHandler.handler "BslLoading" pass_BslLoading
686 |> PassHandler.handler "Parse" pass_Parse
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
687 |> PassHandler.handler "Typing" pass_Typing
fccc685 Initial open-source release
MLstate authored
688
689 |> PassHandler.handler "Assertion" pass_Assertion
690
88694da [clean] bypassHoisting: simplifying it a lot
Valentin Gatien-Baron authored
691 (* needed by closures *)
fccc685 Initial open-source release
MLstate authored
692 |> PassHandler.handler "BypassHoisting" pass_BypassHoisting
693
694 |> PassHandler.handler "DiscardRemoteBypasses" (pass_DiscardRemoteBypasses ~lang)
695
696 (* This one is for testing, maybe we'll use it, and update Cps so that it does its
697 own lambda lifting. (wip) *)
698 (* |> PassHandler.if_handler ~if_:if_LambdaLifting "PreCpsLambdaLifting" pass_LambdaLifting *)
699
700 |> PassHandler.handler "CpsRewriter" (pass_CpsRewriter ~lang)
701
702 |> PassHandler.if_handler ~if_:if_LambdaLifting "LambdaLifting" (pass_LambdaLifting side)
703 |> PassHandler.if_handler ~if_:(if_ClosureServer side) "Uncurry" (pass_Uncurry side)
704 |> PassHandler.if_handler ~if_:(if_ClosureServer side) "Closure" (pass_Closure ~side)
705 |> PassHandler.if_handler ~if_:if_ConstantSharing "ConstantSharing" pass_ConstantSharing
706 |> PassHandler.handler "RemoveTyperCrap" pass_RemoveTyperCrap
707 |> PassHandler.return
708
709 (* See : where to apply constant sharing ? *)
710 (* PassHandler.handler ~if_:if_ConstantSharing "ConstantSharing" pass_ConstantSharing *)
711 end
712
713 (** {6 Back-end passes} *)
714
715 module Qml2jsSugar :
716 sig
717 val console : unit -> int
718 end
719 =
720 struct
721 let console () =
722 let options = Qml2jsOptions.Argv.parse () in
723 let module B = (val (Qml2jsOptions.find_backend options.Qml2jsOptions.backend) : Qml2jsOptions.JsBackend) in
724 if options.Qml2jsOptions.input_files = [] then 0
725 else
726 let env_final =
727 let dynloader = B.dynloader in
728 let options = Qml2jsOptions.Argv.qml2ocaml_sharing options in
729 QmlPasses.main ~lang:BslLanguage.js ~side:`client ~dynloader options
730 in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
731 let env = PassHandler.make_env options env_final in
fccc685 Initial open-source release
MLstate authored
732 env
733 |> PassHandler.handler "JavascriptBslfilesLoading" (PassHandler.make_pass (
734 fun env ->
735 let options = env.PH.options in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
736 let env_final = env.PH.env in
737 let env_bsl = env_final.env_bsl in
738 let generated_files, generated_ast = Qml2js.JsTreat.js_bslfilesloading options env_bsl in
739 PassHandler.make_env options (generated_files, generated_ast, env_final)
fccc685 Initial open-source release
MLstate authored
740 ))
741 |> PassHandler.handler "JavascriptCompilation" (PassHandler.make_pass (
742 fun env ->
743 let options = env.PH.options in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
744 let generated_files, generated_ast, env_final = env.PH.env in
745 let { env_bsl ; env_typer ; code } = env_final in
fccc685 Initial open-source release
MLstate authored
746 let renaming_client = QmlRenamingMap.empty in
747 let renaming_server = QmlRenamingMap.empty in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
748 let env_js_input = B.compile options ~renaming_server ~renaming_client ~bsl:generated_ast env_bsl env_typer code in
fccc685 Initial open-source release
MLstate authored
749 PassHandler.make_env options (generated_files, env_js_input)
750 ))
751 |> PassHandler.handler "JavascriptGeneration" (PassHandler.make_pass (
752 fun env ->
753 let options = env.PH.options in
754 let generated_files, env_js_input = env.PH.env in
755 let env_js_output = Qml2js.JsTreat.js_generation options generated_files env_js_input in
756 PassHandler.make_env options env_js_output
757 ))
758 |> PassHandler.handler "JavascriptTreat" (PassHandler.make_pass (
759 fun env ->
760 let options = env.PH.options in
761 let env_js_output = env.PH.env in
762 let returned = Qml2js.JsTreat.js_treat options env_js_output in
763 PassHandler.make_env options returned
764 ))
765 |> PassHandler.return
766 end
Something went wrong with that request. Please try again.