Turn on new uncurried representation for all arities.

Author: cristianoc

jscomp/ml/ast_uncurried.ml

@@ -1,6 +1,5 @@
 (* Untyped AST *)
 
-let new_representation arity = arity = 0 || arity = 5
 
 let encode_arity_string arity = "Has_arity" ^ string_of_int arity
 let decode_arity_string arity_s = int_of_string ((String.sub [@doesNotRaise]) arity_s 9 (String.length arity_s - 9))
@@ -11,18 +10,10 @@ let arityType ~loc arity =
     Closed None
 
 let uncurriedType ~loc ~arity tArg =
-  if new_representation arity then
     let tArity = arityType ~loc arity in
     Ast_helper.Typ.constr ~loc
       { txt = Lident "function$"; loc }
       [ tArg; tArity ]
-  else
-    Ast_helper.Typ.constr ~loc
-      {
-        txt = Ldot (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity);
-        loc;
-      }
-      [ tArg ]
 
 let arity_to_attributes arity =
   [
@@ -52,34 +43,18 @@ let rec attributes_to_arity (attrs : Parsetree.attributes) =
   | _ -> assert false
 
 let uncurriedFun ~loc ~arity funExpr =
-  if new_representation arity then
     Ast_helper.Exp.construct ~loc
       ~attrs:(arity_to_attributes arity)
       { txt = Lident "Function$"; loc }
       (Some funExpr)
-  else
-    Ast_helper.Exp.record ~loc
-      [
-        ( {
-            txt = Ldot (Ldot (Lident "Js", "Fn"), "I" ^ string_of_int arity);
-            loc;
-          },
-          funExpr );
-      ]
-      None
 
 let exprIsUncurriedFun (expr : Parsetree.expression) =
   match expr.pexp_desc with
-  | Pexp_record ([ ({ txt = Ldot (Ldot (Lident "Js", "Fn"), _) }, _e) ], None)
-    ->
-      true
   | Pexp_construct ({ txt = Lident "Function$" }, Some _) -> true
   | _ -> false
 
 let exprExtractUncurriedFun (expr : Parsetree.expression) =
   match expr.pexp_desc with
-  | Pexp_record ([ ({ txt = Ldot (Ldot (Lident "Js", "Fn"), _) }, e) ], None) ->
-      e
   | Pexp_construct ({ txt = Lident "Function$" }, Some e) -> e
   | _ -> assert false
 

jscomp/ml/typecore.ml

@@ -2982,14 +2982,6 @@ and type_application uncurried env funct (sargs : sargs) : targs * Types.type_ex
     tvar || List.mem l ls
   in
   let ignored = ref [] in
-  let mk_js_fn arity t =
-    if Ast_uncurried.new_representation arity then
-      Ast_uncurried.mk_js_fn ~env ~arity t
-    else
-      let a = "arity" ^ string_of_int arity in
-      let lid:Longident.t = Ldot (Ldot (Lident "Js", "Fn"), a) in
-      let path = Env.lookup_type lid env in
-      newconstr path [t] in
   let has_uncurried_type t =
     match (expand_head env t).desc with
     | Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),a,_),[t],_) ->
@@ -3006,7 +2998,7 @@ and type_application uncurried env funct (sargs : sargs) : targs * Types.type_ex
     match has_uncurried_type funct.exp_type with
     | None ->
       let arity = List.length sargs in
-      let js_fn = mk_js_fn arity (newvar()) in
+      let js_fn = Ast_uncurried.mk_js_fn ~env ~arity (newvar()) in
       unify_exp env funct js_fn
     | Some _ -> () in
   let extract_uncurried_type t =
@@ -3025,7 +3017,7 @@ and type_application uncurried env funct (sargs : sargs) : targs * Types.type_ex
       if uncurried && not fully_applied then
         raise(Error(funct.exp_loc, env,
           Uncurried_arity_mismatch (t, arity, List.length sargs)));
-      let newT = if fully_applied then newT else mk_js_fn newarity newT in
+      let newT = if fully_applied then newT else Ast_uncurried.mk_js_fn ~env ~arity:newarity newT in
       (fully_applied, newT)
     | _ -> (false, newT)
   in

jscomp/others/js.ml

@@ -74,39 +74,6 @@
 type 'a t = < .. > as 'a
 (** JS object type *)
 
-(**/**)
-
-(* internal types for FFI, these types are not used by normal users
-    Absent cmi file when looking up module alias.
-*)
-
-module Fn = struct
-  type 'a arity1 = { i1 : 'a [@internal] }
-  type 'a arity2 = { i2 : 'a [@internal] }
-  type 'a arity3 = { i3 : 'a [@internal] }
-  type 'a arity4 = { i4 : 'a [@internal] }
-  type 'a arity5 = { i5 : 'a [@internal] }
-  type 'a arity6 = { i6 : 'a [@internal] }
-  type 'a arity7 = { i7 : 'a [@internal] }
-  type 'a arity8 = { i8 : 'a [@internal] }
-  type 'a arity9 = { i9 : 'a [@internal] }
-  type 'a arity10 = { i10 : 'a [@internal] }
-  type 'a arity11 = { i11 : 'a [@internal] }
-  type 'a arity12 = { i12 : 'a [@internal] }
-  type 'a arity13 = { i13 : 'a [@internal] }
-  type 'a arity14 = { i14 : 'a [@internal] }
-  type 'a arity15 = { i15 : 'a [@internal] }
-  type 'a arity16 = { i16 : 'a [@internal] }
-  type 'a arity17 = { i17 : 'a [@internal] }
-  type 'a arity18 = { i18 : 'a [@internal] }
-  type 'a arity19 = { i19 : 'a [@internal] }
-  type 'a arity20 = { i20 : 'a [@internal] }
-  type 'a arity21 = { i21 : 'a [@internal] }
-  type 'a arity22 = { i22 : 'a [@internal] }
-end
-
-(**/**)
-
 module MapperRt = Js_mapperRt
 
 module Internal = struct

jscomp/others/release.ninja

@@ -47,7 +47,7 @@ o others/js_obj.cmi others/js_obj.cmj : cc others/js_obj.ml | others/belt_intern
 o others/js_option.cmj : cc_cmi others/js_option.ml | others/belt_internals.cmi others/js.cmi others/js_exn.cmj others/js_option.cmi $bsc
 o others/js_option.cmi : cc others/js_option.mli | others/belt_internals.cmi others/js.cmi $bsc
 o others/js_promise.cmi others/js_promise.cmj : cc others/js_promise.ml | others/belt_internals.cmi others/js.cmi others/js_promise2.cmj $bsc
-o others/js_promise2.cmi others/js_promise2.cmj : cc others/js_promise2.res | others/belt_internals.cmi others/js.cmi others/js.cmj $bsc
+o others/js_promise2.cmi others/js_promise2.cmj : cc others/js_promise2.res | others/belt_internals.cmi others/js.cmi $bsc
 o others/js_re.cmi others/js_re.cmj : cc others/js_re.ml | others/belt_internals.cmi others/js.cmi others/js.cmj $bsc
 o others/js_result.cmj : cc_cmi others/js_result.ml | others/belt_internals.cmi others/js.cmi others/js_result.cmi $bsc
 o others/js_result.cmi : cc others/js_result.mli | others/belt_internals.cmi others/js.cmi $bsc

jscomp/runtime/js.ml

@@ -44,81 +44,7 @@
 (**/**)
 (** Types for JS objects *)
 type 'a t = < .. > as 'a
-(**/**)
-
-(* internal types for FFI, these types are not used by normal users 
-    Absent cmi file when looking up module alias.
-*)
-module Fn = struct
-  type 'a arity1 = {
-    i1 : 'a [@internal]
-  }
-  type 'a arity2 = {
-    i2 : 'a [@internal]
-  }
-  type 'a arity3 = {
-    i3 : 'a [@internal]
-  }
-  type 'a arity4 = {
-    i4 : 'a [@internal]
-  }
-  type 'a arity5 = {
-    i5 : 'a [@internal]
-  }
-  type 'a arity6 = {
-    i6 : 'a [@internal]
-  }
-  type 'a arity7 = {
-    i7 : 'a [@internal]
-  }
-  type 'a arity8 = {
-    i8 : 'a [@internal]
-  }
-  type 'a arity9 = {
-    i9 : 'a [@internal]
-  }
-  type 'a arity10 = {
-    i10 : 'a [@internal]
-  }
-  type 'a arity11 = {
-    i11 : 'a [@internal]
-  }
-  type 'a arity12 = {
-    i12 : 'a [@internal]
-  }
-  type 'a arity13 = {
-    i13 : 'a [@internal]
-  }
-  type 'a arity14 = {
-    i14 : 'a [@internal]
-  }
-  type 'a arity15 = {
-    i15 : 'a [@internal]
-  }
-  type 'a arity16 = {
-    i16 : 'a [@internal]
-  }
-  type 'a arity17 = {
-    i17 : 'a [@internal]
-  }
-  type 'a arity18 = {
-    i18 : 'a [@internal]
-  }
-  type 'a arity19 = {
-    i19 : 'a [@internal]
-  }
-  type 'a arity20 = {
-    i20 : 'a [@internal]
-  }
-  type 'a arity21 = {
-    i21 : 'a [@internal]
-  }
-  type 'a arity22 = {
-    i22 : 'a [@internal]
-  }
-end
 
-(**/**)
 module MapperRt = Js_mapperRt
 module Internal = struct 
   external opaqueFullApply : 'a -> 'a = "%uncurried_apply"