Add support for uncurried @this

CHANGELOG.md

@@ -19,7 +19,7 @@
 - Add support for unary uncurried pipe in uncurried mode https://github.com/rescript-lang/rescript-compiler/pull/5804
 - Add support for partial application of uncurried functions: with uncurried application one can provide a
 subset of the arguments, and return a curried type with the remaining ones https://github.com/rescript-lang/rescript-compiler/pull/5805
-- Add support for uncurried externals https://github.com/rescript-lang/rescript-compiler/pull/5815 https://github.com/rescript-lang/rescript-compiler/pull/5819
+- Add support for uncurried externals https://github.com/rescript-lang/rescript-compiler/pull/5815 https://github.com/rescript-lang/rescript-compiler/pull/5819 https://github.com/rescript-lang/rescript-compiler/pull/5830
 - Parser/Printer: unify uncurried functions of arity 0, and of arity 1 taking unit. There's now only arity 1 in the source language. https://github.com/rescript-lang/rescript-compiler/pull/5825
 
 

jscomp/frontend/ast_core_type_class_type.ml

@@ -122,7 +122,12 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
   match ty with
   | {
    ptyp_attributes;
-   ptyp_desc = Ptyp_arrow (label, args, body);
+   ptyp_desc =
+     ( Ptyp_arrow (label, args, body)
+     | Ptyp_constr
+         (* Js.Fn.xx is re-wrapped around only in case Nothing below *)
+         ( { txt = Ldot (Ldot (Lident "Js", "Fn"), _) },
+           [ { 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/bs_builtin_ppx.ml

@@ -115,6 +115,17 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
       | true, pexp_attributes ->
           Ast_bs_open.convertBsErrorFunction e.pexp_loc self pexp_attributes
             cases)
+  | Pexp_record
+      ( [
+          ( { txt = Ldot (Ldot (Lident "Js", "Fn"), _) },
+            ({ pexp_desc = Pexp_fun _; pexp_attributes } as inner_exp) );
+        ],
+        None )
+    when match Ast_attributes.process_attributes_rev pexp_attributes with
+         | Meth_callback _, _ -> true
+         | _ -> false ->
+      (* Treat @this (. x, y, z) => ... just like @this (x, y, z) => ... *)
+      self.expr self inner_exp
   | Pexp_fun (label, _, pat, body) -> (
       let async = Ast_attributes.has_async_payload e.pexp_attributes <> None in
       match Ast_attributes.process_attributes_rev e.pexp_attributes with

jscomp/test/UncurriedExternals.js

@@ -34,6 +34,20 @@ var te = (function (prim) {
 
 var tcr = {};
 
+function tsiC(c) {
+  c.increment = (function (amount) {
+      var me = this ;
+      console.log(me);
+    });
+}
+
+function tsiU(c) {
+  c.increment = (function (amount) {
+      var me = this ;
+      console.log(me);
+    });
+}
+
 var StandardNotation = {
   dd: dd,
   h: h,
@@ -43,7 +57,9 @@ var StandardNotation = {
   tg: tg,
   tc: tc,
   te: te,
-  tcr: tcr
+  tcr: tcr,
+  tsiC: tsiC,
+  tsiU: tsiU
 };
 
 function dd$1(param) {
@@ -79,6 +95,20 @@ var te$1 = (function (prim) {
 
 var tcr$1 = {};
 
+function tsiC$1(c) {
+  c.increment = (function (amount) {
+      var me = this ;
+      console.log(me);
+    });
+}
+
+function tsiU$1(c) {
+  c.increment = (function (amount) {
+      var me = this ;
+      console.log(me);
+    });
+}
+
 exports.StandardNotation = StandardNotation;
 exports.dd = dd$1;
 exports.h = h$1;
@@ -89,4 +119,6 @@ exports.tg = tg$1;
 exports.tc = tc$1;
 exports.te = te$1;
 exports.tcr = tcr$1;
+exports.tsiC = tsiC$1;
+exports.tsiU = tsiU$1;
 /* h Not a pure module */

jscomp/test/UncurriedExternals.res

@@ -26,6 +26,12 @@ module StandardNotation = {
 
   @obj external ccreate : (. unit) => string = ""
   let tcr = ccreate(.)
+
+  type counter
+  @set external setIncrementC: (counter, @this (counter, int) => unit) => unit = "increment"
+  let tsiC = c => setIncrementC(c, @this (me, amount) => Js.log(me))
+  @set external setIncrementU: (. counter, @this (. counter, int) => unit) => unit = "increment"
+  let tsiU = c => setIncrementU(. c, @this (. me, amount) => Js.log(me))
 }
 
 @@uncurried
@@ -57,3 +63,9 @@ let te = toException(Not_found)
 
 @obj external ucreate : unit => string = ""
 let tcr = ucreate()
+
+type counter
+@set external setIncrementC: (. counter, @this (. counter, int) => unit) => unit = "increment"
+let tsiC = c => setIncrementC(. c, @this (. me, amount) => Js.log(. me))
+@set external setIncrementU: (counter, @this (counter, int) => unit) => unit = "increment"
+let tsiU = c => setIncrementU(c, @this (me, amount) => Js.log(. me))

lib/4.06.1/unstable/js_compiler.ml

@@ -146937,7 +146937,12 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
   match ty with
   | {
    ptyp_attributes;
-   ptyp_desc = Ptyp_arrow (label, args, body);
+   ptyp_desc =
+     ( Ptyp_arrow (label, args, body)
+     | Ptyp_constr
+         (* Js.Fn.xx is re-wrapped around only in case Nothing below *)
+         ( { txt = Ldot (Ldot (Lident "Js", "Fn"), _) },
+           [ { 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
    *)
@@ -152110,6 +152115,17 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
       | true, pexp_attributes ->
           Ast_bs_open.convertBsErrorFunction e.pexp_loc self pexp_attributes
             cases)
+  | Pexp_record
+      ( [
+          ( { txt = Ldot (Ldot (Lident "Js", "Fn"), _) },
+            ({ pexp_desc = Pexp_fun _; pexp_attributes } as inner_exp) );
+        ],
+        None )
+    when match Ast_attributes.process_attributes_rev pexp_attributes with
+         | Meth_callback _, _ -> true
+         | _ -> false ->
+      (* Treat @this (. x, y, z) => ... just like @this (x, y, z) => ... *)
+      self.expr self inner_exp
   | Pexp_fun (label, _, pat, body) -> (
       let async = Ast_attributes.has_async_payload e.pexp_attributes <> None in
       match Ast_attributes.process_attributes_rev e.pexp_attributes with

lib/4.06.1/unstable/js_playground_compiler.ml

@@ -146937,7 +146937,12 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
   match ty with
   | {
    ptyp_attributes;
-   ptyp_desc = Ptyp_arrow (label, args, body);
+   ptyp_desc =
+     ( Ptyp_arrow (label, args, body)
+     | Ptyp_constr
+         (* Js.Fn.xx is re-wrapped around only in case Nothing below *)
+         ( { txt = Ldot (Ldot (Lident "Js", "Fn"), _) },
+           [ { 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
    *)
@@ -152110,6 +152115,17 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
       | true, pexp_attributes ->
           Ast_bs_open.convertBsErrorFunction e.pexp_loc self pexp_attributes
             cases)
+  | Pexp_record
+      ( [
+          ( { txt = Ldot (Ldot (Lident "Js", "Fn"), _) },
+            ({ pexp_desc = Pexp_fun _; pexp_attributes } as inner_exp) );
+        ],
+        None )
+    when match Ast_attributes.process_attributes_rev pexp_attributes with
+         | Meth_callback _, _ -> true
+         | _ -> false ->
+      (* Treat @this (. x, y, z) => ... just like @this (x, y, z) => ... *)
+      self.expr self inner_exp
   | Pexp_fun (label, _, pat, body) -> (
       let async = Ast_attributes.has_async_payload e.pexp_attributes <> None in
       match Ast_attributes.process_attributes_rev e.pexp_attributes with

lib/4.06.1/whole_compiler.ml

@@ -157221,7 +157221,12 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
   match ty with
   | {
    ptyp_attributes;
-   ptyp_desc = Ptyp_arrow (label, args, body);
+   ptyp_desc =
+     ( Ptyp_arrow (label, args, body)
+     | Ptyp_constr
+         (* Js.Fn.xx is re-wrapped around only in case Nothing below *)
+         ( { txt = Ldot (Ldot (Lident "Js", "Fn"), _) },
+           [ { 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
    *)
@@ -162394,6 +162399,17 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
       | true, pexp_attributes ->
           Ast_bs_open.convertBsErrorFunction e.pexp_loc self pexp_attributes
             cases)
+  | Pexp_record
+      ( [
+          ( { txt = Ldot (Ldot (Lident "Js", "Fn"), _) },
+            ({ pexp_desc = Pexp_fun _; pexp_attributes } as inner_exp) );
+        ],
+        None )
+    when match Ast_attributes.process_attributes_rev pexp_attributes with
+         | Meth_callback _, _ -> true
+         | _ -> false ->
+      (* Treat @this (. x, y, z) => ... just like @this (x, y, z) => ... *)
+      self.expr self inner_exp
   | Pexp_fun (label, _, pat, body) -> (
       let async = Ast_attributes.has_async_payload e.pexp_attributes <> None in
       match Ast_attributes.process_attributes_rev e.pexp_attributes with