From 5fb5a2de0885b0c6629ddff49386d981c4fac4f4 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Fri, 24 Jun 2016 16:46:03 -0400 Subject: [PATCH] simplify primitive run/make --- jscomp/lam.ml | 18 +++++++++++++++++- jscomp/lam.mli | 2 ++ jscomp/lam_analysis.ml | 4 +++- jscomp/lam_compile.ml | 20 +++++++------------- jscomp/lam_compile_primitive.ml | 4 +++- jscomp/lam_print.ml | 2 ++ 6 files changed, 34 insertions(+), 16 deletions(-) diff --git a/jscomp/lam.ml b/jscomp/lam.ml index 7430bbe1f2..f44d4afffc 100644 --- a/jscomp/lam.ml +++ b/jscomp/lam.ml @@ -141,6 +141,8 @@ type primitive = | Pjs_unsafe_downgrade | Pinit_mod | Pupdate_mod + | Pjs_fn_make of int + | Pjs_fn_run of int type switch = { sw_numconsts: int; sw_consts: (int * t) list; @@ -566,7 +568,21 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args : t = | {prim_name = "js_unsafe_downgrade" } -> prim ~primitive:Pjs_unsafe_downgrade ~args (* TODO: with location *) - | _ -> prim ~primitive:(Pccall a) ~args + | _ -> + if Ext_string.starts_with a.prim_name "js_fn_" then + let arity, kind = + let mk = Ext_string.starts_with_and_number a.prim_name ~offset:6 "mk_" in + if mk < 0 then + let run = Ext_string.starts_with_and_number a.prim_name ~offset:6 "run_" in + run , `Run + else mk, `Mk + in + if kind = `Run then + prim ~primitive:(Pjs_fn_run arity) ~args + else + prim ~primitive:(Pjs_fn_make arity) ~args + else + prim ~primitive:(Pccall a) ~args end | Praise _ -> prim ~primitive:Praise ~args | Psequand -> prim ~primitive:Psequand ~args diff --git a/jscomp/lam.mli b/jscomp/lam.mli index d259f744e0..24d50a3f7e 100644 --- a/jscomp/lam.mli +++ b/jscomp/lam.mli @@ -132,6 +132,8 @@ type primitive = | Pjs_unsafe_downgrade | Pinit_mod | Pupdate_mod + | Pjs_fn_make of int + | Pjs_fn_run of int type switch = { sw_numconsts: int; diff --git a/jscomp/lam_analysis.ml b/jscomp/lam_analysis.ml index 991abda5d4..3b2b06f40f 100644 --- a/jscomp/lam_analysis.ml +++ b/jscomp/lam_analysis.ml @@ -133,7 +133,9 @@ let rec no_side_effects (lam : Lam.t) : bool = | Pinit_mod | Pupdate_mod | Pjs_unsafe_downgrade - | Pdebugger (* TODO *) + | Pdebugger + | Pjs_fn_run _ | Pjs_fn_make _ + (* TODO *) | Pbytessetu | Pbytessets diff --git a/jscomp/lam_compile.ml b/jscomp/lam_compile.ml index a7f76f4671..a0e6eb7932 100644 --- a/jscomp/lam_compile.ml +++ b/jscomp/lam_compile.ml @@ -743,24 +743,16 @@ and blocks ret | _ -> assert false end - | Lprim {primitive = Pccall {prim_name; _}; args = args_lambda} - when Ext_string.starts_with prim_name "js_fn_" -> - let arity, kind = - let mk = Ext_string.starts_with_and_number prim_name ~offset:6 "mk_" in - if mk < 0 then - let run = Ext_string.starts_with_and_number prim_name ~offset:6 "run_" in - run , `Run - else mk, `Mk - in - + | Lprim {primitive = Pjs_fn_run arity; args = args_lambda} + -> (* 1. prevent eta-conversion by using [App_js_full] 2. invariant: `external` declaration will guarantee the function application is saturated 3. we need a location for Pccall in the call site *) - if kind = `Run then - match args_lambda with + + begin match args_lambda with | [Lsend(Public (Some "case_set"), _label, Lprim{primitive = Pjs_unsafe_downgrade; args = [obj]}, [] , loc) ; key ; value] -> @@ -867,7 +859,9 @@ and Location.none (*TODO*) App_js_full) | _ -> assert false - else + end + | Lprim {primitive = Pjs_fn_make arity; args = args_lambda} -> + begin match args_lambda with | [fn] -> if arity = 0 then diff --git a/jscomp/lam_compile_primitive.ml b/jscomp/lam_compile_primitive.ml index a4df299cc7..68ecd85702 100644 --- a/jscomp/lam_compile_primitive.ml +++ b/jscomp/lam_compile_primitive.ml @@ -47,7 +47,9 @@ let translate (args : J.expression list) : J.expression = match prim with | Pjs_unsafe_downgrade - | Pdebugger -> assert false (* already handled by {!Lam_compile} *) + | Pdebugger + | Pjs_fn_run _ + | Pjs_fn_make _ -> assert false (* already handled by {!Lam_compile} *) | Pinit_mod -> E.runtime_call Js_config.module_ "init_mod" args | Pupdate_mod -> diff --git a/jscomp/lam_print.ml b/jscomp/lam_print.ml index 0d893d6458..b3d5f56adc 100644 --- a/jscomp/lam_print.ml +++ b/jscomp/lam_print.ml @@ -105,6 +105,8 @@ let primitive ppf (prim : Lam.primitive) = match prim with | Pbytes_to_string -> fprintf ppf "bytes_to_string" | Pbytes_of_string -> fprintf ppf "bytes_of_string" | Pjs_unsafe_downgrade -> fprintf ppf "js_unsafe_downgrade" + | Pjs_fn_run i -> fprintf ppf "js_fn_run_%i" i + | Pjs_fn_make i -> fprintf ppf "js_fn_make_%i" i | Pdebugger -> fprintf ppf "debugger" | Pchar_to_int -> fprintf ppf "char_to_int" | Pchar_of_int -> fprintf ppf "char_of_int"