Permalink
Browse files

wip

  • Loading branch information...
1 parent 1851a1b commit ac0e6721e1de73feede9590019a836650b6d36e6 @Aqua-Ye Aqua-Ye committed Oct 3, 2012
View
34 compiler/opa/compiler.ml
@@ -60,16 +60,15 @@ let make_backend name ?(aliases=[]) pass dynloader bsl_lang register_fields = {
register_fields = register_fields;
}
-let compute_backend_options backend_handlers =
- List.map (
- fun backend_handler ->
- backend_handler.name :: backend_handler.aliases
- ) backend_handlers |> List.flatten
-
(* Run all passes *)
let compile backend_handlers =
- let backend_options = compute_backend_options backend_handlers in
+ let available_back_end_list =
+ List.map (
+ fun backend_handler ->
+ backend_handler.name :: backend_handler.aliases
+ ) backend_handlers
+ in
let unify_backend_name =
fun (OpaEnv.Backend b) ->
let rec find_backend l =
@@ -119,12 +118,24 @@ let compile backend_handlers =
OManager.error "The back-end @{<bright>%s@} is not recognized" (b);
in find_backend backend_handlers
in
+ let backend_bsl_lang_switcher =
+ fun (OpaEnv.Backend b) ->
+ let rec find_backend l =
+ match l with
+ | hd :: tl ->
+ if hd.name = b || (List.mem b hd.aliases) then
+ hd.bsl_lang
+ else find_backend tl
+ | [] ->
+ OManager.error "The back-end @{<bright>%s@} is not recognized" (b);
+ in find_backend backend_handlers
+ in
(**********************************************)
(* INITIALIZATION *****************************)
PH.init
- |+> ("Welcome", (S3.pass_Welcome backend_options))
+ |+> ("Welcome", (S3.pass_Welcome available_back_end_list))
|+> ("CheckOptions", (S3.pass_CheckOptions unify_backend_name))
@@ -266,7 +277,7 @@ let compile backend_handlers =
(**********************************************)
(* SLICED PASSES ******************************)
<?> (If.server or If.separated or If.slicer_test,
- ("Slicing" , S3.pass_SimpleSlicer),
+ ("Slicing" , S3.pass_SimpleSlicer backend_bsl_lang_switcher),
("NoSlicing", S3.pass_NoSlicer))
|+> ("Assertion", S3.pass_Assertion)
@@ -334,7 +345,7 @@ let compile backend_handlers =
|?> (If.init & If.server,
"InitializeBslValues", S3.pass_InitializeBslValues)
- |+> ("ServerQmlCpsRewriter", S3.pass_ServerCpsRewriter)
+ |+> ("ServerQmlCpsRewriter", (S3.pass_ServerCpsRewriter backend_bsl_lang_switcher))
|?| (Switch.back_end, backend_pass_switcher)
@@ -344,7 +355,8 @@ let compile backend_handlers =
|> PH.return )) (* end of the pass endOfSeparateCompilation *)
|> PH.return )) (* end of the pass loadObjects *)
- |> PH.return
+ |> PH.return;
+ OManager.exit 0
(* Set title of generic pass system. *)
let _ = PH.set_title "Opa.exe"
View
6 compiler/opa/main.ml
@@ -87,8 +87,4 @@ let js_backend = Compiler.make_backend "qmljs"
)
) None BslLanguage.nodejs ignore
-let backend_handlers = [js_backend; flat_backend]
-
-let () = Compiler.compile(backend_handlers)
-
-let () = OManager.exit 0
+let () = Compiler.compile([js_backend; flat_backend])
View
15 compiler/opa/passes.ml
@@ -304,7 +304,7 @@ let pass_no_slicer ~options:(_:opa_options) (env:'tmp_env env_Gen) =
}
-let pass_simple_slicer ~(options:opa_options) (env:'tmp_env env_Gen) =
+let pass_simple_slicer backend_bsl_lang_switcher ~(options:opa_options) (env:'tmp_env env_Gen) =
let make_sliced_env env_gen ~server ~client =
{ env_gen;
sliced_env = {
@@ -314,10 +314,7 @@ 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
- | OpaEnv.Backend "qmljs" -> BslLanguage.nodejs
- | _ -> BslLanguage.ml
- in
+ let server_bsl_lang = backend_bsl_lang_switcher options.OpaEnv.back_end in
let stdlib_gamma, typer_env, client, server =
QmlSimpleSlicer.process_code
~test_mode:options.OpaEnv.slicer_test
@@ -548,7 +545,7 @@ let pass_DbCodeGeneration ~options:(_:opa_options) env =
annotmap = annotmap} in
{env with qmlAst = code; typerEnv = typerEnv; temporary_env = ()}
-let pass_QmlCpsRewriter client ~(options:opa_options) (env:env_NewFinalCompile) : env_NewFinalCompile =
+let pass_QmlCpsRewriter backend_bsl_lang_switcher client ~(options:opa_options) (env:env_NewFinalCompile) : env_NewFinalCompile =
(* Passing options to qmlCpsRewriter : use syntax { with } like ever *)
let opaoptions = options in
let qml_closure =
@@ -561,11 +558,7 @@ let pass_QmlCpsRewriter client ~(options:opa_options) (env:env_NewFinalCompile)
| OpaEnv.Backend "qmljs" -> false
| _ -> not client;
in
- let lang =
- match options.OpaEnv.back_end with
- | OpaEnv.Backend "qmljs" -> BslLanguage.nodejs
- | _ -> BslLanguage.ml
- in
+ let lang = backend_bsl_lang_switcher options.OpaEnv.back_end in
let options =
{ QmlCpsRewriter.default_options with QmlCpsRewriter.
no_assert = options.OpaEnv.no_assert ;
View
13 compiler/opa/s3Passes.ml
@@ -341,10 +341,10 @@ end
(* AND COMPLETE MLI ***************************************)
(**********************************************************)
-let pass_Welcome backend_options =
+let pass_Welcome available_back_end_list =
PassHandler.make_pass
(fun {PH.env=()} ->
- OpaEnv.Options.parse_options backend_options;
+ OpaEnv.Options.parse_options available_back_end_list;
let options = OpaEnv.Options.get_options () in
OManager.verbose "Opa version %s" BuildInfos.opa_version_name ;
OManager.verbose "(c) 2007-%s MLstate, All Rights Reserved." BuildInfos.year;
@@ -1272,7 +1272,8 @@ let pass_GenericSlicer slicer =
} )
let pass_NoSlicer = pass_GenericSlicer Passes.pass_no_slicer
-let pass_SimpleSlicer = pass_GenericSlicer Passes.pass_simple_slicer
+let pass_SimpleSlicer backend_bsl_lang_switcher =
+ pass_GenericSlicer (Passes.pass_simple_slicer backend_bsl_lang_switcher)
let pass_CleanLambdaLiftingDirectives =
PassHandler.make_pass
@@ -1773,7 +1774,7 @@ let pass_SlicedToFinal =
(* FINAL CLIENT COMPILATION **********************)
let pass_ClientCpsRewriter =
- Adapter.adapt_sliced_on_client (P.pass_QmlCpsRewriter true)
+ Adapter.adapt_sliced_on_client (P.pass_QmlCpsRewriter (fun _ -> BslLanguage.js) true)
let pass_ClientLambdaLifting =
Adapter.adapt_sliced_on_client (P.pass_LambdaLifting2 ~typed:true ~side:`client)
@@ -1977,12 +1978,12 @@ let pass_InitializeBslValues =
{e with PH.env = env}
)
-let pass_ServerCpsRewriter =
+let pass_ServerCpsRewriter backend_bsl_lang_switcher =
let transform pass_env =
let options = pass_env.PassHandler.options in
let env = pass_env.PassHandler.env in
{ pass_env with PassHandler.
- env = Passes.pass_QmlCpsRewriter false ~options env
+ env = Passes.pass_QmlCpsRewriter backend_bsl_lang_switcher false ~options env
}
in
(* invariants, and pre/post conds *)
View
4 compiler/opa/s3Passes.mli
@@ -50,7 +50,7 @@ end
(**{6 S3 Passes} All value bellow should be type of
[opa_pass].*)
-val pass_Welcome : string list -> (unit, opa_options, unit, unit) PassHandler.pass
+val pass_Welcome : string list list -> (unit, opa_options, unit, unit) PassHandler.pass
val pass_CheckOptions : (OpaEnv.opa_back_end -> OpaEnv.opa_back_end) -> (unit, env_ArgParse) opa_pass
@@ -301,6 +301,7 @@ val pass_NoSlicer :
(unit env_Gen, unit env_Gen_sliced) opa_pass
val pass_SimpleSlicer :
+ (OpaEnv.opa_back_end -> BslLanguage.t) ->
(unit env_Gen, unit env_Gen_sliced) opa_pass
val pass_ExplicitInstantiation :
@@ -376,6 +377,7 @@ val pass_InitializeBslValues :
(env_NewFinalCompile, env_NewFinalCompile) opa_pass
val pass_ServerCpsRewriter :
+ (OpaEnv.opa_back_end -> BslLanguage.t) ->
(env_NewFinalCompile, env_NewFinalCompile) opa_pass
val pass_QmlConstantSharing :
View
2 compiler/opa/syntaxHelper.ml
@@ -50,7 +50,7 @@ let _ = WarningClass.load_set S3Warnings.warning_set
let _ =
PH.init
- |+> ("Welcome", S3.pass_Welcome ["qmljs"])
+ |+> ("Welcome", S3.pass_Welcome [["qmljs"]])
|+> ("CheckOptions", S3.pass_CheckOptions Base.identity)
View
5 compiler/opalib/opaEnv.ml
@@ -203,7 +203,7 @@ let i18n_template option = option.i18n.I18n.template_opa || option.i18n.I18n.tem
module Options :
sig
- val parse_options : string list -> unit
+ val parse_options : string list list -> unit
val get_options : unit -> opa_options
val echo_help : unit -> unit
@@ -491,6 +491,7 @@ struct
] @ (
if List.length available_back_end_list > 1 then [
+ let available_back_end_list = List.flatten available_back_end_list in
("--back-end", Arg.Symbol (available_back_end_list, back_end),
(Printf.sprintf "Select the backend (default is %s)"
(default_back_end)));
@@ -966,7 +967,7 @@ struct
~centerheader:"Opa Manual"
~synopsis:ArgParser.synopsis
~description:"The Opa compiler allows you to compile Opa projects into executable files. Please refer to the online manual on http://doc.opalang.org for a detailed description of the language and its tools.\n"
- ~options:(ArgParser.speclist ["qmljs"])
+ ~options:(ArgParser.speclist [["qmljs"]])
~other:[("VERSION", ArgParser.str_version)]
file

0 comments on commit ac0e672

Please sign in to comment.