Permalink
Browse files

[enhance] compiler: jscompiler, slicer, bslloading should take care o…

…f backend
  • Loading branch information...
1 parent f3ad64b commit c62c74acef6bc0c153103415fe35cf1f32a85cf7 @BourgerieQuentin BourgerieQuentin committed Apr 25, 2012
View
@@ -54,7 +54,7 @@
<opa_parse.ml>: use_opalib, use_opalang, use_opapasses
# s3 main
-<s3Passes.{ml,mli}>: use_pplib, use_libqmlcompil, use_opalib, use_qmlslicer, use_passlib, use_opapasses, use_qml2ocaml, use_opalang, use_libbsl, use_qmlfakecompiler, use_qmlflatcompiler, use_ocamllang, use_qmlpasses, use_qml2js
+<s3Passes.{ml,mli}>: use_pplib, use_libqmlcompil, use_opalib, use_qmlslicer, use_passlib, use_opapasses, use_qml2ocaml, use_opalang, use_libbsl, use_qmlfakecompiler, use_qmlflatcompiler, use_ocamllang, use_qmlpasses, use_qml2js, use_jslang
<{main,gen_opa_manpage}.ml>: use_opalib, use_opalang, use_opapasses, use_libqmlcompil, use_qml2ocaml, use_passlib
<syntaxHelper.ml>: use_opalib, use_opalang, use_opapasses, use_libqmlcompil, use_qml2ocaml, use_passlib
View
@@ -256,8 +256,8 @@ let process
=
(* Pass *)
let plugins = options.O.bypass_plugin in
- let back_end = options.O.back_end in
- let js_back_end = options.O.js_back_end in
+ let server_back_end = options.O.back_end in
+ let client_back_end = options.O.js_back_end in
let cwd = Sys.getcwd () in
let search_path = cwd :: ObjectFiles.get_paths () in
@@ -439,23 +439,29 @@ let process
It is actually possible to remove this
by coding a table export in libbsl
*)
- let js_back_end_dynload =
- let module M = (val js_back_end : Qml2jsOptions.JsBackend) in
- M.dynloader in
- let back_end_dynload =
- match back_end with
- | `qmlflat -> Flat_Compiler.dynloader
- | `qmljs -> js_back_end_dynload
+ let client_back_end_dynload, client_bsl_lang =
+ let module M = (val client_back_end : Qml2jsOptions.JsBackend) in
+ (M.dynloader, BslLanguage.js) in
+ let server_back_end_dynload, server_bsl_lang =
+ match server_back_end with
+ | `qmlflat -> (Flat_Compiler.dynloader, BslLanguage.ml)
+ | `qmljs -> (client_back_end_dynload, BslLanguage.nodejs)
in
(* Register plug-ins with actual backend.*)
List.iter
(fun plugin ->
(* ML back-end *)
- back_end_dynload plugin ;
+ server_back_end_dynload plugin ;
(* js back-end *)
- js_back_end_dynload plugin ;
+ client_back_end_dynload plugin ;
) plugins;
- let bymap = BslLib.BSL.RegisterTable.build_bypass_map () in (* Build public map.*)
+ (* Build bypass map *)
+ let bymap =
+ let lang = [client_bsl_lang; server_bsl_lang] in
+ BslLib.BSL.RegisterTable.build_bypass_map
+ ~filter:(fun bp -> BslLib.BSL.ByPass.implemented_in_any bp ~lang)
+ ()
+ in
let bsl = { BslLib.bymap = bymap ; plugins = plugins } in
(* Separated compilation: saving *)
@@ -311,6 +311,7 @@ let full_serialize
~closure_map
~renaming_server
~renaming_client
+ ~bsl_lang:BslLanguage.js
back_end
jsoptions
bsl_client
View
@@ -308,12 +308,19 @@ let pass_simple_slicer ~(options:opa_options) (env:'tmp_env env_Gen) =
}
}
in
+ let client_bsl_lang = BslLanguage.js in
+ let server_bsl_lang = match options.OpaEnv.back_end with
+ | `qmlflat -> BslLanguage.ml
+ | `qmljs -> BslLanguage.nodejs
+ in
let stdlib_gamma, typer_env, client, server =
QmlSimpleSlicer.process_code
~test_mode:options.OpaEnv.slicer_test
~dump:options.OpaEnv.slicer_dump
~stdlib_gamma:env.stdlib_gamma
~typer_env:env.typerEnv
+ ~client_bsl_lang
+ ~server_bsl_lang
~bymap:env.bsl.BslLib.bymap
~code:env.qmlAst in
View
@@ -2175,24 +2175,28 @@ let pass_ServerJavascriptCompilation =
inlining = options.OpaEnv.js_local_inlining;
global_inlining = options.OpaEnv.js_global_inlining;
no_assert = options.OpaEnv.no_assert;
+ compilation_directory = Option.get (ObjectFiles.get_compilation_directory ())
} in
let env_bsl = env.Passes.newFinalCompile_bsl in
- let generated_files, generated_ast =
- Qml2js.JsTreat.js_bslfilesloading jsoptions env_bsl in
+ let generated_ast = ([] : JsAst.code) in
+ (* Qml2js.JsTreat.js_bslfilesloading jsoptions env_bsl in *)
let env_js_input = JsBackend.compile
~bsl: generated_ast
~val_:OpaMapToIdent.val_
~closure_map:env.Passes.newFinalCompile_closure_map
~renaming_server:env.Passes.newFinalCompile_renaming_server
~renaming_client:env.Passes.newFinalCompile_renaming_client
+ ~bsl_lang:BslLanguage.nodejs
jsoptions
env_bsl
env.Passes.newFinalCompile_qml_milkshake.QmlBlender.env
env.Passes.newFinalCompile_qml_milkshake.QmlBlender.code
in let _env_js_output =
- Qml2js.JsTreat.js_generation jsoptions generated_files env_js_input
+ Qml2js.JsTreat.js_generation jsoptions []
+ { env_js_input with Qml2jsOptions.js_init_contents = [] }
in
- PH.make_env options 5
+
+ PH.make_env options 0
)
let pass_CleanUp =
View
@@ -132,7 +132,7 @@ struct
fun (filename, content, _conf) -> Some (filename, content)
in
let fold acc loader =
- List.rev_filter_map_append filter_bsl loader.BslPluginInterface.js_code acc
+ List.rev_filter_map_append filter_bsl loader.BslPluginInterface.nodejs_code acc
in
List.fold_left fold generated_files env_bsl.BslLib.plugins
in
@@ -251,6 +251,7 @@ sig
closure_map:Ident.t IdentMap.t ->
renaming_server:QmlRenamingMap.t ->
renaming_client:QmlRenamingMap.t ->
+ bsl_lang:BslLanguage.t ->
(module Qml2jsOptions.JsBackend) ->
Qml2jsOptions.t ->
BslLib.env_bsl ->
@@ -261,9 +262,9 @@ sig
end
=
struct
- let for_opa ~val_ ?bsl:bsl_code ~closure_map ~renaming_server ~renaming_client back_end argv env_bsl env_typer code =
+ let for_opa ~val_ ?bsl:bsl_code ~closure_map ~renaming_server ~renaming_client ~bsl_lang 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
+ let env_js_input = M.compile ~val_ ?bsl:bsl_code ~closure_map ~renaming_server ~renaming_client ~bsl_lang argv env_bsl env_typer code in
env_js_input
let dummy_for_opa backend =
let module M = (val backend : Qml2jsOptions.JsBackend) in
View
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -94,6 +94,7 @@ module type JsBackend = sig
?closure_map:Ident.t IdentMap.t ->
renaming_server:QmlRenamingMap.t ->
renaming_client:QmlRenamingMap.t ->
+ bsl_lang:BslLanguage.t ->
t -> BslLib.env_bsl -> QmlTyper.env -> QmlAst.code -> env_js_input
val name : string
val runtime_libs : cps:bool -> (string * BslJsConf.conf) list
View
@@ -75,7 +75,7 @@ let is_it_void _env expr =
aux expr
let compile_bypass env key =
- match Imp_Bsl.JsImpBSL.ByPassMap.find_opt_implementation env.E.private_bymap ~lang:BslLanguage.js key with
+ match Imp_Bsl.JsImpBSL.ByPassMap.find_opt_implementation env.E.private_bymap ~lang:env.E.bsl_lang key with
| None ->
OManager.error
"bsl-resolution failed for: key %a" BslKey.pp key
View
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -26,7 +26,7 @@ module E = Imp_Env
let warning_set = Imp_Warnings.warning_set
-let initial_env ~val_ ~renaming_server ~renaming_client options env_typer code =
+let initial_env ~val_ ~renaming_server ~renaming_client ~bsl_lang options env_typer code =
let js_ctrans = Imp_Bsl.build_ctrans_env ~options in
let private_bymap = Imp_Bsl.JsImpBSL.RegisterTable.build_bypass_map ~js_ctrans () in
let gamma = env_typer.QmlTypes.gamma in
@@ -37,6 +37,7 @@ let initial_env ~val_ ~renaming_server ~renaming_client options env_typer code =
annotmap;
val_;
private_bymap;
+ bsl_lang;
renaming_client;
renaming_server;
} in
@@ -61,10 +62,10 @@ let repeat2 n (f : int -> 'a -> 'b -> 'a * 'b) =
aux (i+1) a b in
aux 0
-let compile ?(val_=fun _ -> assert false) ?bsl ?(closure_map=IdentMap.empty) ~renaming_server ~renaming_client options _env_bsl env_typer code =
+let compile ?(val_=fun _ -> assert false) ?bsl ?(closure_map=IdentMap.empty) ~renaming_server ~renaming_client ~bsl_lang options _env_bsl env_typer code =
let _chrono = Chrono.make () in
_chrono.Chrono.start ();
- let env, code = initial_env ~val_ ~renaming_server ~renaming_client options env_typer code in
+ let env, code = initial_env ~val_ ~renaming_server ~renaming_client ~bsl_lang options env_typer code in
let js_init = Imp_Bsl.JsImpBSL.ByPassMap.js_init env.E.private_bymap in
#<If:JS_IMP$contains "time"> Printf.printf "bsl projection: %fs\n%!" (_chrono.Chrono.read ()); _chrono.Chrono.restart () #<End>;
let private_env = initial_private_env () in
@@ -108,7 +109,7 @@ let compile ?(val_=fun _ -> assert false) ?bsl ?(closure_map=IdentMap.empty) ~re
let lst = List.map (function (i, e) -> i, tra e) lst in
let ine = QmlAst.Directive (label, `full_apply env, [ine], tys) in
let ine = tra ine in
- QmlAst.LetIn (inl, lst, ine)
+ tra (QmlAst.LetIn (inl, lst, ine))
| QmlAst.Directive (_,(`lifted_lambda _ | `full_apply _),_,_) as expr ->
OManager.i_error "Unexpected expression %a\n%!" QmlPrint.pp#expr expr
| e -> tra e
View
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -23,6 +23,7 @@ type env = {
annotmap : QmlAst.annotmap;
val_ : string -> Ident.t;
private_bymap : Imp_Bsl.JsImpBSL.ByPassMap.t;
+ bsl_lang : BslLanguage.t;
renaming_client : QmlRenamingMap.t;
renaming_server : QmlRenamingMap.t;
}
View
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -23,6 +23,7 @@ type env = {
annotmap : QmlAst.annotmap;
val_ : string -> Ident.t;
private_bymap : Imp_Bsl.JsImpBSL.ByPassMap.t;
+ bsl_lang : BslLanguage.t;
renaming_client : QmlRenamingMap.t;
renaming_server : QmlRenamingMap.t;
}
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -388,8 +388,8 @@ end
type environment =
{ informations : information IdentTable.t;
call_graph : G.t;
- client_language : BslLanguage.t;
- server_language : BslLanguage.t; (* could have a debug mode where both sides are ml *)
+ client_bsl_lang : BslLanguage.t;
+ server_bsl_lang : BslLanguage.t; (* could have a debug mode where both sides are ml *)
bymap : BslLib.BSL.ByPassMap.t;
gamma : QmlTypes.gamma;
annotmap : Q.annotmap;
@@ -400,8 +400,8 @@ let get_bypass_side env bslkey =
| None -> assert false (* shouldn't have undefined bypass at that point *)
| Some bypass ->
let langs = BslLib.BSL.ByPass.langs bypass in
- let impl_client = List.mem env.client_language langs in
- let impl_server = List.mem env.server_language langs in
+ let impl_client = List.mem env.client_bsl_lang langs in
+ let impl_server = List.mem env.server_bsl_lang langs in
match impl_server,impl_client with
| true,true -> `both
| false,true -> `client
@@ -416,11 +416,11 @@ let get_bypass_side env bslkey =
(* TODO: annotation @assert_both etc? *)
(* TODO: never insert_server_value of any datatype containing functions? *)
-let empty_env bymap typer_env =
+let empty_env ~client_bsl_lang ~server_bsl_lang bymap typer_env =
{ informations = IdentTable.create 100;
call_graph = G.create ();
- client_language = BslLanguage.js;
- server_language = BslLanguage.ml;
+ client_bsl_lang ;
+ server_bsl_lang ;
bymap = bymap;
gamma = typer_env.QmlTypes.gamma;
annotmap = typer_env.QmlTypes.annotmap;
@@ -1838,8 +1838,10 @@ struct
)
end
-let process_code ~test_mode ~dump ~typer_env ~stdlib_gamma ~bymap ~code =
- let env = empty_env bymap typer_env in
+let process_code ~test_mode ~dump ~typer_env ~stdlib_gamma
+ ~client_bsl_lang ~server_bsl_lang ~bymap
+ ~code =
+ let env = empty_env ~client_bsl_lang ~server_bsl_lang bymap typer_env in
let _chrono = Chrono.make () in
#<If:SLICER_TIME> _chrono.Chrono.start () #<End>;
R.load env;
@@ -41,6 +41,8 @@ val process_code :
dump:bool ->
typer_env:QmlTyper.env ->
stdlib_gamma:QmlTypes.gamma ->
+ client_bsl_lang:BslLanguage.t ->
+ server_bsl_lang:BslLanguage.t ->
bymap:BslLib.BSL.ByPassMap.t ->
code:QmlAst.code ->
QmlTypes.gamma

0 comments on commit c62c74a

Please sign in to comment.