add type constraint for better error message, simplify runtime support

Author: bobzhang

jscomp/main/builtin_cmi_datasets.ml

@@ -164,16 +164,17 @@ module Meth = struct
   }[@@unboxed]
 end
 
+(**/**)
 module Internal = struct
   open Meth
   (* Use opaque instead of [._n] to prevent some optimizations happening *)
-  external id : 'a -> 'a = "%opaque"
 
-  external run0 : 'a arity0 -> 'a = "#run" "0"
+  external run : 'a arity0 -> 'a = "#run" "0"
   (* 
     x##meth a b --> 
     fullApppy (
         (id (unsafe_downgrade x)#meth).I_2) 
         a b)
   *)  
-end  
+end  
+(**/**)

jscomp/main/builtin_cmj_datasets.ml

@@ -133,31 +133,8 @@ module Internal = struct
   external unsafeInvariantApply : 'a -> 'a = "#full_apply"
 
   (* Use opaque instead of [._n] to prevent some optimizations happening *)
-  external run0 : 'a arity0 -> 'a = "#run" "0"
-  external run1 : 'a arity1 -> 'a = "%opaque"
-  external run2 : 'a arity2 -> 'a = "%opaque"
-  external run3 : 'a arity3 -> 'a = "%opaque"
-  external run4 : 'a arity4 -> 'a = "%opaque"
-  external run5 : 'a arity5 -> 'a = "%opaque"
-  external run6 : 'a arity6 -> 'a = "%opaque"
-  external run7 : 'a arity7 -> 'a = "%opaque"
-  external run8 : 'a arity8 -> 'a = "%opaque"
-  external run9 : 'a arity9 -> 'a = "%opaque"
-  external run10 : 'a arity10 -> 'a = "%opaque"
-  external run11 : 'a arity11 -> 'a = "%opaque"
-  external run12 : 'a arity12 -> 'a = "%opaque"
-  external run13 : 'a arity13 -> 'a = "%opaque"
-  external run14 : 'a arity14 -> 'a = "%opaque"
-  external run15 : 'a arity15 -> 'a = "%opaque"
-  external run16 : 'a arity16 -> 'a = "%opaque"
-  external run17 : 'a arity17 -> 'a = "%opaque"
-  external run18 : 'a arity18 -> 'a = "%opaque"
-  external run19 : 'a arity19 -> 'a = "%opaque"
-  external run20 : 'a arity20 -> 'a = "%opaque"
-  external run21 : 'a arity21 -> 'a = "%opaque"
-  external run22 : 'a arity22 -> 'a = "%opaque"
-
-
+  external run : 'a arity0 -> 'a = "#run" 
+  external opaque : 'a -> 'a = "%opaque"
   external mk0 : (unit -> 'a0) -> 'a0 arity0 = "#fn_mk" "0"    
 end    
 (**/**)

jscomp/others/js_OO.ml

@@ -48,6 +48,7 @@ module Lid = struct
   (* TODO should be renamed in to {!Js.fn} *)
   (* TODO should be moved into {!Js.t} Later *)
   let js_internal : t = Ldot (Lident "Js", "Internal")
+  let opaque : t = Ldot (js_internal, "opaque")
   let js_fn : t =
       Ldot (Lident "Js",  "Fn")
   let js_oo : t = Lident "Js_OO"    

jscomp/runtime/js.ml

@@ -35,6 +35,7 @@ module Lid : sig
   val type_unit : t 
   val type_int : t 
   val js_fn : t 
+  val opaque : t  
   val js_oo : t
   val js_meth : t 
   val js_meth_callback : t 

jscomp/syntax/ast_literal.ml

@@ -75,15 +75,21 @@ let generic_apply loc
   let arity = List.length args in       
   if arity = 0 then 
     Parsetree.Pexp_apply 
-      (Exp.ident {txt = Ldot (jsInternal, "run0");loc}, [Nolabel,fn])
+      (Exp.ident {txt = Ldot (jsInternal, "run");loc}, [Nolabel,fn])
   else 
-    let txt : Longident.t = 
-      Ldot (jsInternal, "run" ^ string_of_int arity) in 
+    let arity_s = string_of_int arity in 
+
     Parsetree.Pexp_apply (
       Exp.ident {txt = unsafeInvariantApply; loc},
       [Nolabel,
-       Exp.apply (Exp.apply (Exp.ident {txt ; loc}) [(Nolabel,fn)]) 
-                                          args])                        
+       Exp.apply 
+         (Exp.apply 
+            (Exp.ident {txt = Ast_literal.Lid.opaque; loc}) 
+            [(Nolabel, Exp.field ~loc 
+              (Exp.constraint_ ~loc fn 
+                (Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_fn, "arity"^arity_s);loc} 
+                  [Typ.any ~loc ()])) {txt = Longident.Lident ("I_"^ arity_s); loc})]) 
+         args])                        
 
 let method_apply  loc 
     (self : Bs_ast_mapper.mapper) 
@@ -104,16 +110,19 @@ let method_apply  loc
     let arity = List.length args in       
     if arity = 0 then 
       Parsetree.Pexp_apply 
-        (Exp.ident {txt = Ldot ((Ldot (Ast_literal.Lid.js_oo,"Internal")), "run0");loc}, [Nolabel,fn])
+        (Exp.ident {txt = Ldot ((Ldot (Ast_literal.Lid.js_oo,"Internal")), "run");loc}, [Nolabel,fn])
     else 
-      let txt : Longident.t = 
-        Ldot (Ldot (Ast_literal.Lid.js_oo,"Internal"), "id") in 
+      let arity_s = string_of_int arity in 
       Parsetree.Pexp_apply (
         Exp.ident {txt = unsafeInvariantApply; loc},
         [Nolabel,
          Exp.apply (
-           Exp.apply (Exp.ident {txt ; loc}) 
-             [(Nolabel,Exp.field fn {loc; txt = Ldot (Ast_literal.Lid.js_meth,"I_"^string_of_int arity)})]) 
+           Exp.apply (Exp.ident {txt = Ast_literal.Lid.opaque; loc}) 
+             [(Nolabel,
+              Exp.field 
+                (Exp.constraint_ ~loc 
+                  fn (Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_meth,"arity"^arity_s);loc} [Typ.any ~loc ()]))
+                {loc; txt = Lident ( "I_"^arity_s)})]) 
            args])
 
 

jscomp/syntax/ast_literal.mli

@@ -20,15 +20,15 @@ let u2 = ( ~f : t0 , a , b) => {
 
 let  f = (. ~x,y) => x + y ;
 let add = (+);
-// let u = f(.3,~x=2,1);
+ // let u = f(.3,~x=2,1);
 // This function has arity2 but was expected arity3
 
  // let h = f (1, 2) ;
  // This function has uncurried type, it needs to be applied in ucurried style
 // This function has uncurried type, it needs to be applied in ucurried style 
 
 
-//let h = add(.1,2);
+// let h = add(.1,2);
 // This function is a curried function where an uncurried function is expected