Test uncurried cast idea.

When curried application is used for an uncurried function, instead of a type error one gets a curried partial application.

This allows e.g. to define curried library functions such as `raise` and use them both with curried and uncurried application.

Author: cristianoc

jscomp/ml/typecore.ml

@@ -2968,6 +2968,7 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
                 Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
               unify env ty_fun (newty (Tarrow(l1,t1,t2,Clink(ref Cunknown))));
               (t1, t2)
+          | Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc=Tarrow (l,t1,t2,_)}],_)
           | Tarrow (l,t1,t2,_) when Asttypes.same_arg_label l l1
             ->
               (t1, t2)

jscomp/test/build.ninja

@@ -0,0 +1,103 @@
+'use strict';
+
+var Curry = require("../../lib/js/curry.js");
+var Belt_List = require("../../lib/js/belt_List.js");
+var Caml_exceptions = require("../../lib/js/caml_exceptions.js");
+
+function raise(e) {
+  throw e;
+}
+
+var map = Belt_List.mapU;
+
+var List = {
+  map: map
+};
+
+var Uncurried = {
+  raise: raise,
+  List: List
+};
+
+var E = /* @__PURE__ */Caml_exceptions.create("Uncurried_cast.E");
+
+function testRaise(param) {
+  throw {
+        RE_EXN_ID: E,
+        Error: new Error()
+      };
+}
+
+var l = map({
+      hd: 1,
+      tl: {
+        hd: 2,
+        tl: /* [] */0
+      }
+    }, (function (x) {
+        return x + 1 | 0;
+      }));
+
+var partial_arg = {
+  hd: 1,
+  tl: {
+    hd: 2,
+    tl: /* [] */0
+  }
+};
+
+function partial(param) {
+  return map(partial_arg, param);
+}
+
+var ll = Curry._1(partial, (function (x) {
+        return x + 1 | 0;
+      }));
+
+var StandardNotation = {
+  testRaise: testRaise,
+  l: l,
+  partial: partial,
+  ll: ll
+};
+
+function testRaise$1() {
+  return raise({
+              RE_EXN_ID: E
+            });
+}
+
+var l$1 = map({
+      hd: 1,
+      tl: {
+        hd: 2,
+        tl: /* [] */0
+      }
+    }, (function (x) {
+        return x + 1 | 0;
+      }));
+
+var partial_arg$1 = {
+  hd: 1,
+  tl: {
+    hd: 2,
+    tl: /* [] */0
+  }
+};
+
+function partial$1(param) {
+  return map(partial_arg$1, param);
+}
+
+var ll$1 = partial$1(function (x) {
+      return x + 1 | 0;
+    });
+
+exports.Uncurried = Uncurried;
+exports.E = E;
+exports.StandardNotation = StandardNotation;
+exports.testRaise = testRaise$1;
+exports.l = l$1;
+exports.partial = partial$1;
+exports.ll = ll$1;
+/* l Not a pure module */

jscomp/test/uncurried_cast.js

@@ -0,0 +1,33 @@
+module Uncurried = {
+  let raise = (. e) => raise(e)
+
+  module List = {
+    let map = (. l, f) => Belt.List.mapU(l, f)
+  }
+}
+
+exception E
+
+module StandardNotation = {
+  open Uncurried
+
+  let testRaise = () => raise(E)
+
+  let l = List.map(.list{1, 2}, (. x) => x + 1)
+
+  let partial = List.map(list{1, 2})
+
+  let ll = partial((. x) => x + 1)
+}
+
+@@uncurried
+
+open Uncurried
+
+let testRaise = () => raise(E)
+
+let l = List.map(list{1, 2}, x => x + 1)
+
+let partial = List.map(. list{1, 2})
+
+let ll = partial(.x => x + 1)

jscomp/test/uncurried_cast.res

@@ -43666,6 +43666,7 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
                 Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
               unify env ty_fun (newty (Tarrow(l1,t1,t2,Clink(ref Cunknown))));
               (t1, t2)
+          | Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc=Tarrow (l,t1,t2,_)}],_)
           | Tarrow (l,t1,t2,_) when Asttypes.same_arg_label l l1
             ->
               (t1, t2)

lib/4.06.1/unstable/js_compiler.ml

@@ -43666,6 +43666,7 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
                 Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
               unify env ty_fun (newty (Tarrow(l1,t1,t2,Clink(ref Cunknown))));
               (t1, t2)
+          | Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc=Tarrow (l,t1,t2,_)}],_)
           | Tarrow (l,t1,t2,_) when Asttypes.same_arg_label l l1
             ->
               (t1, t2)

lib/4.06.1/unstable/js_playground_compiler.ml

@@ -98661,6 +98661,7 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
                 Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
               unify env ty_fun (newty (Tarrow(l1,t1,t2,Clink(ref Cunknown))));
               (t1, t2)
+          | Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc=Tarrow (l,t1,t2,_)}],_)
           | Tarrow (l,t1,t2,_) when Asttypes.same_arg_label l l1
             ->
               (t1, t2)