now uncurry support is purely non-intrusive attributes (optimizations)

jscomp/lam_compile.ml

@@ -177,7 +177,6 @@ and get_exp_with_args (cxt : Lam_compile_defs.cxt)  lam args_lambda
                  end
             ) args_lambda ([], []) in
 
-
         match closed_lambda with 
         | Some (Lfunction (_, params, body)) 
           when Ext_list.same_length params args_lambda -> 
@@ -204,13 +203,13 @@ and get_exp_with_args (cxt : Lam_compile_defs.cxt)  lam args_lambda
              E.unit
            | {name = "CamlinternalMod"; _}, "init_mod" ,
              [ 
-                _ ;
-                shape  ;
-                (* Module []
-                   TODO: add a function [empty_shape]
-                   This pattern match is fragile, since it depends 
-                   on how we compile [Lconst]
-                *)
+               _ ;
+               shape  ;
+               (* Module []
+                  TODO: add a function [empty_shape]
+                  This pattern match is fragile, since it depends 
+                  on how we compile [Lconst]
+               *)
              ] when Js_of_lam_module.is_empty_shape shape
              ->
              E.dummy_obj () (* purely type definition*)
@@ -511,8 +510,11 @@ and
       compile_lambda  cxt  
         (Lapply (an, (args' @ args), (Lam_util.mk_apply_info App_na)))
     (* External function calll *)
-    | Lapply(Lprim(Pfield (n,_), [ Lprim(Pgetglobal id,[])]), args_lambda,_info) ->
-
+    | Lapply(Lprim(Pfield (n,_), [ Lprim(Pgetglobal id,[])]), args_lambda,
+             {apply_status = App_na | App_ml_full}) ->
+      (* Note we skip [App_js_full] since [get_exp_with_args] dont carry 
+         this information, we should fix [get_exp_with_args]
+      *)
       get_exp_with_args cxt lam  args_lambda id n  env
 
 
@@ -875,10 +877,10 @@ and
           end
 
         | fn :: rest -> 
-          compile_lambda cxt @@ 
-          Lambda.Lapply (fn, rest , 
-                         {apply_loc = Location.none;
-                          apply_status = App_js_full})
+          compile_lambda cxt 
+            (Lapply (fn, rest , 
+                     {apply_loc = Location.none;
+                      apply_status = App_js_full}))
         | _ -> assert false 
       else 
         begin match args_lambda with 

jscomp/ppx_entry.ml

@@ -279,27 +279,18 @@ let gen_fn_mk loc arity args  : Parsetree.expression_desc =
 
 
 
-let handle_raw ?ty loc e attrs  = 
-  let attrs = 
-    match ty with 
-    | Some ty -> 
-      Parsetree_util.attr_attribute_from_type ty :: attrs  
-    | None -> attrs in 
+let handle_raw loc e   = 
   Ast_helper.Exp.letmodule 
     {txt = tmp_module_name; loc }
     (Ast_helper.Mod.structure [ 
         Ast_helper.Str.primitive 
-          (Ast_helper.Val.mk ~attrs {loc ; txt = tmp_fn} 
+          (Ast_helper.Val.mk  {loc ; txt = tmp_fn} 
              ~prim:[prim]
-             (Ast_helper.Typ.arrow "" predef_string_type predef_any_type))]
-    )    
-  (Ast_helper.Exp.constraint_ ~loc  
+             (Ast_helper.Typ.arrow "" predef_string_type predef_any_type))])    
     (Ast_helper.Exp.apply 
        (Ast_helper.Exp.ident {txt= Ldot(Lident tmp_module_name, tmp_fn) ; loc})
        [("",e)])
-    (match ty with 
-    | Some ty -> ty
-    | None -> predef_any_type)) (* FIXME: use [create_local]*)
+
 
 
 
@@ -650,25 +641,10 @@ let rec unsafe_mapper : Ast_mapper.mapper =
             PStr 
               ( [{ pstr_desc = Pstr_eval ({ 
                    pexp_desc = Pexp_constant (Const_string (_, _)) ;
-                   pexp_attributes = attrs } as e ,
+                    } as e ,
                                                 _); pstr_loc = _ }]))
           -> 
-
-              handle_raw loc e attrs
-        | Pexp_extension( {txt = "bs.raw"; loc}, PStr 
-                ( [{ pstr_desc = Parsetree.Pstr_eval ({ 
-                      pexp_desc = 
-                        Pexp_constraint (
-                          {pexp_desc = Pexp_constant (Const_string (_, _)) ; _}
-                          as e,
-                             ty)
-                      ; pexp_attributes = attrs} , _);  }]))
-        | Pexp_constraint({pexp_desc = Pexp_extension( {txt = "bs.raw"; loc}, PStr 
-                ( [{ pstr_desc = Pstr_eval ({ 
-                      pexp_desc = 
-                        Pexp_constant (Const_string (_, _)) 
-                      ; pexp_attributes = attrs} as e , _);  }]))}, ty)            
-              -> handle_raw ~ty loc e attrs
+              handle_raw loc e 
         | Pexp_extension({txt = "bs.raw"; loc}, (PTyp _ | PPat _ | PStr _))
               -> 
               Location.raise_errorf ~loc "bs.raw can only be applied to a string"

jscomp/runtime/Makefile

@@ -21,7 +21,7 @@ $(addsuffix .cmj, $(OTHERS)): caml_builtin_exceptions.cmj  block.cmj js.cmj
 RUNTIME := $(addsuffix .cmj, $(SOURCE_LIST)) 
 
 
-COMPFLAGS += $(MODULE_FLAGS) -I ../stdlib -nostdlib -nopervasives -open Pervasives -w -40 -js-npm-output-path $(npm_package_name):lib/js -js-no-builtin-ppx-mli
+COMPFLAGS += $(MODULE_FLAGS) -I ../stdlib -nostdlib -nopervasives -open Pervasives -w -40 -js-npm-output-path $(npm_package_name):lib/js 
 
 
 

jscomp/runtime/caml_float.ml

@@ -117,7 +117,7 @@ let caml_modf_float (x : float) : float * float =
   else if Js.Float.is_nan x then Js.Float.nan ,  Js.Float.nan 
   else (1. /. x , x)
 
-let caml_ldexp_float = [%bs.raw ({| function (x,exp) {
+let caml_ldexp_float : float * int -> float [@uncurry] = [%bs.raw {| function (x,exp) {
     exp |= 0;
     if (exp > 1023) {
         exp -= 1023;
@@ -134,11 +134,11 @@ let caml_ldexp_float = [%bs.raw ({| function (x,exp) {
     x *= Math.pow(2, exp);
     return x;
 }
-|} : float -> int -> float)]
+|}]
 
 
 
-let caml_frexp_float =  [%bs.raw ({|function (x) {
+let caml_frexp_float : float -> float * int [@uncurry]=  [%bs.raw {|function (x) {
     if ((x == 0) || !isFinite(x)) return [ x, 0];
     var neg = x < 0;
     if (neg) x = - x;
@@ -148,7 +148,7 @@ let caml_frexp_float =  [%bs.raw ({|function (x) {
     if (neg) x = - x;
     return [x, exp];
 }
-|} : float -> float * int )]
+|}]
 
 let caml_float_compare (x : float) (y : float ) = 
   if x = y then 0 
@@ -178,18 +178,17 @@ let caml_log1p_float  : float -> float = function x ->
   if z = 0. then x else x *. log y /. z 
 
 
-let caml_hypot_float = [%bs.raw ({| function (x, y) {
+let caml_hypot_float : float * float -> float [@uncurry] = [%bs.raw {| function (x, y) {
     var x0 = Math.abs(x), y0 = Math.abs(y);
     var a = Math.max(x0, y0), b = Math.min(x0,y0) / (a?a:1);
     return a * Math.sqrt(1 + b*b);
 }
-|} : float -> float -> float)
-]
+|}]
 
 
-let caml_log10_float =  [%bs.raw ({| function  (x) { 
+let caml_log10_float : float -> float [@uncurry] =  [%bs.raw {| function  (x) { 
    return Math.LOG10E * Math.log(x); }
-|} : float -> float) ]
+|} ]
 
 
 let caml_cosh_float x = exp x +. exp (-. x) /. 2. 

jscomp/runtime/caml_float.mli

@@ -33,11 +33,13 @@ val caml_int32_bits_of_float : float -> int32
 
 val caml_classify_float : float -> fpclass
 val caml_modf_float : float -> float * float 
-val caml_ldexp_float : float -> int -> float 
-val caml_frexp_float : float -> float * int
+
+val caml_ldexp_float : float * int -> float [@uncurry]
+val caml_frexp_float : float -> float * int [@uncurry]
 val caml_float_compare : float -> float -> int 
 val caml_copysign_float : float -> float -> float
 val caml_expm1_float : float -> float 
 
-val caml_hypot_float : float -> float -> float  
-val caml_log10_float : float -> float
+val caml_hypot_float : float * float -> float  [@uncurry]
+
+val caml_log10_float : float -> float [@uncurry]

jscomp/runtime/caml_format.ml

@@ -361,9 +361,8 @@ let aux f (i : nativeint)  =
       f.filter <- " ";
       let n = f.prec -Js.String.length !s in 
       if n > 0 then
-        s :=  repeat n "0"  ^ !s
-    end
-  ;
+        s :=  repeat (n, "0")[@uncurry]  ^ !s
+    end ;
   finish_formatting f !s
 
 let caml_format_int fmt i = 
@@ -485,7 +484,7 @@ let caml_int64_format fmt x =
       f.filter <- " ";
       let n = f.prec -Js.String.length !s in
       if n > 0 then
-        s := repeat n "0" ^ !s
+        s := repeat (n, "0") [@uncurry] ^ !s
     end;
 
   finish_formatting f !s

jscomp/runtime/caml_int64.ml

@@ -388,7 +388,7 @@ let to_hex x =
     if pad <= 0 then             
       aux x.hi ^ lo
     else
-      aux x.hi ^ Caml_utils.repeat pad "0" ^ lo 
+      aux x.hi ^ Caml_utils.repeat(pad, "0") [@uncurry] ^ lo 
 
 let discard_sign x = {x with hi = Nativeint.logand 0x7fff_ffffn x.hi }  
 

jscomp/runtime/caml_io.ml

@@ -44,7 +44,7 @@ let stdout = {
   output = (fun _ s ->
     let v =Js.String.length s - 1 in
     if [%bs.raw{| (typeof process !== "undefined") && process.stdout && process.stdout.write|}] then
-      ([%bs.raw{| process.stdout.write |} ] : string -> unit) s
+      ([%bs.raw{| process.stdout.write |} ] : string -> unit [@uncurry]) s [@uncurry]
     else
     if s.[v] = '\n' then
       Js.log (Js.String.slice s 0 v)
@@ -86,10 +86,8 @@ let caml_ml_output (oc : out_channel) (str : string) offset len  =
     else Js.String.slice str offset len in
   if [%bs.raw{| (typeof process !== "undefined") && process.stdout && process.stdout.write |}] &&
      oc == stdout then
-    begin     
+    ([%bs.raw{| process.stdout.write |}] : string -> unit [@uncurry] ) str [@uncurry]
 
-      ([%bs.raw{| process.stdout.write |}] : string -> unit ) str
-    end        
   else
     begin     
 

jscomp/runtime/caml_utils.ml

@@ -31,7 +31,7 @@
 (* https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Math/imul *)
 
 
-let repeat : int -> string -> string = [%bs.raw{| (String.prototype.repeat && function (count,self){return self.repeat(count)}) ||
+let repeat : int * string -> string [@uncurry] = [%bs.raw{| (String.prototype.repeat && function (count,self){return self.repeat(count)}) ||
                                                   function(count , self) {
         if (self.length == 0 || count == 0) {
             return '';

jscomp/runtime/caml_utils.mli

@@ -29,4 +29,4 @@
 
 
 
-val repeat : int -> string -> string
+val repeat : int * string -> string [@uncurry]

jscomp/test/.depend

@@ -181,8 +181,8 @@ fail_comp.cmj :
 fail_comp.cmx :
 ffi_arity_test.cmj : mt.cmi ../runtime/js.cmj
 ffi_arity_test.cmx : mt.cmx ../runtime/js.cmx
-ffi_js.cmj :
-ffi_js.cmx :
+ffi_js.cmj : ../stdlib/obj.cmi
+ffi_js.cmx : ../stdlib/obj.cmx
 ffi_test.cmj : ../runtime/js.cmj
 ffi_test.cmx : ../runtime/js.cmx
 fib.cmj :
@@ -669,6 +669,8 @@ tuple_alloc.cmj :
 tuple_alloc.cmx :
 typeof_test.cmj : mt.cmi ../runtime/js.cmj
 typeof_test.cmx : mt.cmx ../runtime/js.cmx
+uncurry_glob_test.cmj : ../runtime/caml_utils.cmi
+uncurry_glob_test.cmx : ../runtime/caml_utils.cmx
 undef_regression_test.cmj : ../runtime/js.cmj
 undef_regression_test.cmx : ../runtime/js.cmx
 unitest_string.cmj :
@@ -833,8 +835,8 @@ fail_comp.cmo :
 fail_comp.cmj :
 ffi_arity_test.cmo : mt.cmi ../runtime/js.cmo
 ffi_arity_test.cmj : mt.cmj ../runtime/js.cmj
-ffi_js.cmo :
-ffi_js.cmj :
+ffi_js.cmo : ../stdlib/obj.cmi
+ffi_js.cmj : ../stdlib/obj.cmj
 ffi_test.cmo : ../runtime/js.cmo
 ffi_test.cmj : ../runtime/js.cmj
 fib.cmo :
@@ -1321,6 +1323,8 @@ tuple_alloc.cmo :
 tuple_alloc.cmj :
 typeof_test.cmo : mt.cmi ../runtime/js.cmo
 typeof_test.cmj : mt.cmj ../runtime/js.cmj
+uncurry_glob_test.cmo : ../runtime/caml_utils.cmi
+uncurry_glob_test.cmj : ../runtime/caml_utils.cmj
 undef_regression_test.cmo : ../runtime/js.cmo
 undef_regression_test.cmj : ../runtime/js.cmj
 unitest_string.cmo :

jscomp/test/attr_test.ml

@@ -22,3 +22,7 @@ class type date =
   end
 
 
+let max2 : float * float -> float [@uncurry] = fun [@uncurry] (x,y) -> 
+  x +. y 
+
+let hh = max2 (1., 2.) [@uncurry]

jscomp/test/ffi_js.ml

@@ -1 +1 @@
-let keys  = [%bs.raw  (" function (x){return Object.keys(x)}" : Obj.t -> string array)]
+let keys :  Obj.t -> string array [@uncurry] = [%bs.raw " function (x){return Object.keys(x)}" ]

jscomp/test/string_literal_print_test.ml

@@ -10,7 +10,7 @@ let h = "\000\001\002\003\004\005"
 let x = "W"
 let zero_to_255 = "\000\001\002\003\004\005\006\007\008\009\010\011\012\013\014\015\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031\032\033\034\035\036\037\038\039\040\041\042\043\044\045\046\047\048\049\050\051\052\053\054\055\056\057\058\059\060\061\062\063\064\065\066\067\068\069\070\071\072\073\074\075\076\077\078\079\080\081\082\083\084\085\086\087\088\089\090\091\092\093\094\095\096\097\098\099\100\101\102\103\104\105\106\107\108\109\110\111\112\113\114\115\116\117\118\119\120\121\122\123\124\125\126\127\128\129\130\131\132\133\134\135\136\137\138\139\140\141\142\143\144\145\146\147\148\149\150\151\152\153\154\155\156\157\158\159\160\161\162\163\164\165\166\167\168\169\170\171\172\173\174\175\176\177\178\179\180\181\182\183\184\185\186\187\188\189\190\191\192\193\194\195\196\197\198\199\200\201\202\203\204\205\206\207\208\209\210\211\212\213\214\215\216\217\218\219\220\221\222\223\224\225\226\227\228\229\230\231\232\233\234\235\236\237\238\239\240\241\242\243\244\245\246\247\248\249\250\251\252\253\254\255"
 
-let js_zero_to_255 = [%bs.raw ({|"\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff"|} : string) ]
+let js_zero_to_255 : string = [%bs.raw {|"\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff"|} ]
 let wth_quote = "'\"'\""
 
 

jscomp/test/test.mllib

@@ -308,4 +308,6 @@ obj_literal_ppx_test
 obj_literal_ppx
 gpr_405_test
 
-attr_test
+attr_test
+
+uncurry_glob_test

jscomp/test/uncurry_glob_test.ml

@@ -0,0 +1,7 @@
+
+
+let v = Caml_utils.repeat (100, "x") [@uncurry]
+
+module M ( U : sig val f : int * string -> string [@uncurry] end ) = struct
+  let v = U.f (100, "x") [@uncurry]
+end