Use built-in type uncurried$ with one variant Uncurried$.

Author: cristianoc

jscomp/frontend/ast_core_type.ml

@@ -133,7 +133,7 @@ let get_uncurry_arity (ty : t) =
 let get_curry_arity (ty : t) =
   match ty.ptyp_desc with
   | Ptyp_constr ({ txt = Ldot (Ldot (Lident "Js", "Fn"), _) }, [ t ])
-  | Ptyp_constr ({ txt = Ldot (Lident "Js", "uncurried") }, [ t; _ ]) ->
+  | Ptyp_constr ({ txt = Lident "uncurried$" }, [ t; _ ]) ->
       get_uncurry_arity_aux t 0
   | _ -> get_uncurry_arity_aux ty 0
 

jscomp/frontend/ast_core_type_class_type.ml

@@ -76,7 +76,7 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
            [ { ptyp_desc = Ptyp_arrow (label, args, body) } ] )
      | Ptyp_constr
          (* Js.uncurried is re-wrapped around only in case Nothing below *)
-         ( { txt = Ldot (Lident "Js", "uncurried") },
+         ( { txt = Lident "uncurried$" },
            [ { ptyp_desc = Ptyp_arrow (label, args, body) }; _ ] ) );
    (* let it go without regard label names,
       it will report error later when the label is not empty

jscomp/frontend/ast_external_process.ml

@@ -870,9 +870,7 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type)
   let prim_name_with_source = { name = prim_name; source = External } in
   let type_annotation, build_uncurried_type =
     match type_annotation.ptyp_desc with
-    | Ptyp_constr
-        (({ txt = Ldot (Lident "Js", "uncurried"); _ } as lid), [ t; arity_ ])
-      ->
+    | Ptyp_constr (({ txt = Lident "uncurried$"; _ } as lid), [ t; arity_ ]) ->
         ( t,
           fun ~arity x ->
             let tArity =

jscomp/ml/ast_uncurried.ml

@@ -11,7 +11,7 @@ let uncurriedType ~loc ~arity tArg =
   if new_representation arity then
     let tArity = arityType ~loc arity in
     Ast_helper.Typ.constr ~loc
-      { txt = Ldot (Lident "Js", "uncurried"); loc }
+      { txt = Lident "uncurried$"; loc }
       [ tArg; tArity ]
   else
     Ast_helper.Typ.constr ~loc
@@ -52,7 +52,7 @@ let uncurriedFun ~loc ~arity funExpr =
   if new_representation arity then
     Ast_helper.Exp.construct ~loc
       ~attrs:(arity_to_attributes arity)
-      { txt = Ldot (Lident "Js", "Uncurried"); loc }
+      { txt = Lident "Uncurried$"; loc }
       (Some funExpr)
   else
     Ast_helper.Exp.record ~loc
@@ -70,14 +70,14 @@ let exprIsUncurriedFun (expr : Parsetree.expression) =
   | Pexp_record ([ ({ txt = Ldot (Ldot (Lident "Js", "Fn"), _) }, _e) ], None)
     ->
       true
-  | Pexp_construct ({ txt = Ldot (Lident "Js", "Uncurried") }, Some _) -> true
+  | Pexp_construct ({ txt = Lident "Uncurried$" }, 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 = Ldot (Lident "Js", "Uncurried") }, Some e) -> e
+  | Pexp_construct ({ txt = Lident "Uncurried$" }, Some e) -> e
   | _ -> assert false
 
 (* Typed AST *)
@@ -105,13 +105,12 @@ let type_to_arity (tArity : Types.type_expr) =
 
 let mk_js_fn ~env ~arity t =
   let typ_arity = arity_to_type arity in
-  let lid : Longident.t = Ldot (Lident "Js", "uncurried") in
+  let lid : Longident.t = Lident "uncurried$" in
   let path = Env.lookup_type lid env in
   Ctype.newconstr path [ t; typ_arity ]
 
 let uncurried_type_get_arity ~env typ =
   match (Ctype.expand_head env typ).desc with
-  | Tconstr (Pdot (Pident { name = "Js" }, "uncurried", _), [ _t; tArity ], _)
-    ->
+  | Tconstr (Pident { name = "uncurried$" }, [ _t; tArity ], _) ->
       type_to_arity tArity
   | _ -> assert false

jscomp/ml/predef.ml

@@ -49,6 +49,7 @@ and ident_floatarray = ident_create "floatarray"
 and ident_unknown = ident_create "unknown"
 
 and ident_promise = ident_create "promise"
+and ident_uncurried = ident_create "uncurried$"
 
 type test =
   | For_sure_yes
@@ -176,8 +177,9 @@ and ident_nil = ident_create "[]"
 and ident_cons = ident_create "::"
 and ident_none = ident_create "None"
 and ident_some = ident_create "Some"
-
 and ident_ctor_unknown = ident_create "Unknown"
+and ident_ctor_uncurried = ident_create "Uncurried$"
+
 let common_initial_env add_type add_extension empty_env =
   let decl_bool =
     {decl_abstr with
@@ -211,6 +213,15 @@ let common_initial_env add_type add_extension empty_env =
      type_arity = 1;
      type_kind = Type_variant([cstr ident_none []; cstr ident_some [tvar]]);
      type_variance = [Variance.covariant]}
+  and decl_uncurried =
+    let tvar1, tvar2 = newgenvar(), newgenvar() in
+    {decl_abstr with
+     type_params = [tvar1; tvar2];
+     type_arity = 2;
+     type_kind = Type_variant([cstr ident_ctor_uncurried [tvar1]]);
+     type_variance = [Variance.covariant; Variance.covariant];
+     type_unboxed = Types.unboxed_true_default_false;
+     }
   and decl_unknown = 
     let tvar = newgenvar () in 
     {decl_abstr with 
@@ -273,13 +284,14 @@ let common_initial_env add_type add_extension empty_env =
   add_type ident_unit decl_unit (
   add_type ident_bool decl_bool (
   add_type ident_float decl_abstr (
-  add_type ident_unknown decl_unknown(  
+  add_type ident_unknown decl_unknown (  
+  add_type ident_uncurried decl_uncurried (  
   add_type ident_string decl_abstr (
   add_type ident_int decl_abstr_imm (
   add_type ident_extension_constructor decl_abstr (
   add_type ident_floatarray decl_abstr (
     add_type ident_promise decl_promise (
-      empty_env))))))))))))))))))))))))
+      empty_env)))))))))))))))))))))))))
 
 let build_initial_env add_type add_exception empty_env =
   let common = common_initial_env add_type add_exception empty_env in

jscomp/ml/translcore.ml

@@ -775,7 +775,7 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
       with Not_constant -> Lprim (Pmakeblock Blk_tuple, ll, e.exp_loc))
   | Texp_construct ({ txt = Lident "false" }, _, []) -> Lconst Const_false
   | Texp_construct ({ txt = Lident "true" }, _, []) -> Lconst Const_true
-  | Texp_construct ({ txt = Ldot (Lident "Js", "Uncurried")}, _, [expr]) ->
+  | Texp_construct ({ txt = Lident "Uncurried$"}, _, [expr]) ->
       (* ReScript uncurried encoding *)
       let loc = expr.exp_loc in
       let lambda = transl_exp expr in

jscomp/ml/typecore.ml

@@ -2105,7 +2105,7 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
         exp_env = env }
   | Pexp_construct(lid, sarg) ->
       (match lid.txt with
-      | Ldot (Lident "Js", "Uncurried") ->
+      | Lident "Uncurried$" ->
         let arity = Ast_uncurried.attributes_to_arity sexp.pexp_attributes in
         let uncurried_typ = Ast_uncurried.mk_js_fn ~env ~arity (newvar()) in
         unify_exp_types loc env uncurried_typ ty_expected
@@ -2998,7 +2998,7 @@ and type_application uncurried env funct (sargs : sargs) : targs * Types.type_ex
         then int_of_string (String.sub a 5 (String.length a - 5))
         else 0 in
        Some (arity, t)
-    | Tconstr (Pdot(Pident {name = "Js"},"uncurried",_),[t; tArity],_) ->
+    | Tconstr (Pident {name = "uncurried$"},[t; tArity],_) ->
       let arity = Ast_uncurried.type_to_arity tArity in
       Some (arity, t)
     | _ -> None in

jscomp/ml/typedecl.ml

@@ -1593,8 +1593,8 @@ let rec parse_native_repr_attributes env core_type ty =
 let parse_native_repr_attributes env core_type ty =
   match core_type.ptyp_desc, (Ctype.repr ty).desc
   with
-  | Ptyp_constr ({txt = Ldot(Lident "Js", "uncurried")}, [{ptyp_desc = Ptyp_arrow (_, _, ct2)}; _]),
-    Tconstr (Pdot(Pident {name = "Js"},"uncurried",_),[{desc = Tarrow (_, _, t2, _)}; _],_) ->
+  | Ptyp_constr ({txt = Lident "uncurried$"}, [{ptyp_desc = Ptyp_arrow (_, _, ct2)}; _]),
+    Tconstr (Pident {name = "uncurried$"},[{desc = Tarrow (_, _, t2, _)}; _],_) ->
     let repr_args, repr_res = parse_native_repr_attributes env ct2 t2 in
     let native_repr_args = Same_as_ocaml_repr :: repr_args in
     (native_repr_args, repr_res)

res_syntax/src/res_uncurried.ml

@@ -32,9 +32,7 @@ let new_representation arity = arity = 5
 let uncurriedType ~loc ~arity tArg =
   if new_representation arity then
     let tArity = arityType ~loc arity in
-    Ast_helper.Typ.constr ~loc
-      {txt = Ldot (Lident "Js", "uncurried"); loc}
-      [tArg; tArity]
+    Ast_helper.Typ.constr ~loc {txt = Lident "uncurried$"; loc} [tArg; tArity]
   else
     Ast_helper.Typ.constr ~loc
       {
@@ -58,7 +56,7 @@ let uncurriedFun ~loc ~arity funExpr =
   if new_representation arity then
     Ast_helper.Exp.construct ~loc
       ~attrs:(arity_to_attributes arity)
-      {txt = Ldot (Lident "Js", "Uncurried"); loc}
+      {txt = Lident "Uncurried$"; loc}
       (Some funExpr)
   else
     Ast_helper.Exp.record ~loc
@@ -72,13 +70,13 @@ let exprIsUncurriedFun (expr : Parsetree.expression) =
   match expr.pexp_desc with
   | Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), _)}, _e)], None) ->
     true
-  | Pexp_construct ({txt = Ldot (Lident "Js", "Uncurried")}, Some _) -> true
+  | Pexp_construct ({txt = Lident "Uncurried$"}, 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 = Ldot (Lident "Js", "Uncurried")}, Some e) -> e
+  | Pexp_construct ({txt = Lident "Uncurried$"}, Some e) -> e
   | _ -> assert false
 
 let typeIsUncurriedFun (typ : Parsetree.core_type) =
@@ -87,8 +85,7 @@ let typeIsUncurriedFun (typ : Parsetree.core_type) =
       ({txt = Ldot (Ldot (Lident "Js", "Fn"), _)}, [{ptyp_desc = Ptyp_arrow _}])
     ->
     true
-  | Ptyp_constr
-      ({txt = Ldot (Lident "Js", "uncurried")}, [{ptyp_desc = Ptyp_arrow _}; _])
+  | Ptyp_constr ({txt = Lident "uncurried$"}, [{ptyp_desc = Ptyp_arrow _}; _])
     ->
     true
   | _ -> false
@@ -101,6 +98,6 @@ let typeExtractUncurriedFun (typ : Parsetree.core_type) =
         ((String.sub [@doesNotRaise]) arity 5 (String.length arity - 5))
     in
     (arity, tArg)
-  | Ptyp_constr ({txt = Ldot (Lident "Js", "uncurried")}, [tArg; tArity]) ->
+  | Ptyp_constr ({txt = Lident "uncurried$"}, [tArg; tArity]) ->
     (arityFromType tArity, tArg)
   | _ -> assert false