simplify primitive run/make

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 

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;

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

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 

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 ->

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"