Add support for uncurried externals (#5815)

* 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.

* Partial application of an uncurried type returns an uncurried type.

* Add support for uncurried externals

Author: cristianoc

CHANGELOG.md

@@ -19,6 +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
 
 #### :boom: Breaking Change
 

jscomp/ml/typedecl.ml

@@ -1576,6 +1576,21 @@ let rec parse_native_repr_attributes env core_type ty =
   | _ -> ([], Same_as_ocaml_repr)
 
 
+let parse_native_repr_attributes valdecl env core_type ty =
+  match core_type.ptyp_desc, (Ctype.repr ty).desc
+  with
+  | Ptyp_constr ({txt = Ldot(Ldot(Lident "Js", "Fn"),_)}, [{ptyp_desc = Ptyp_arrow (_, _, ct2)}]),
+    Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc = Tarrow (_, _, t2, _)}],_) ->
+    let is_internal_primitive = match valdecl.pval_prim with
+      | [ s ] -> s <> "" && (s.[0] = '%' || s.[0] = '?')
+      | _ -> false in
+    let repr_args, repr_res = parse_native_repr_attributes env ct2 t2 in
+    let native_repr_args =
+      if is_internal_primitive then
+        Same_as_ocaml_repr :: repr_args (* uncurried primitives treated like curried ones *)
+      else [] (* uncurried externals are treated specially by the back-end *) in
+    (native_repr_args, repr_res)
+  | _ -> parse_native_repr_attributes env core_type ty
 
 (* Translate a value declaration *)
 let transl_value_decl env loc valdecl =
@@ -1592,11 +1607,11 @@ let transl_value_decl env loc valdecl =
       let native_repr_args, native_repr_res =
           let rec scann (attrs : Parsetree.attributes)  = 
             match attrs with 
-            | ({txt = "internal.arity";_}, 
+            | ({txt = "internal.arity";_},
               PStr [ {pstr_desc = Pstr_eval
                         (
                           ({pexp_desc = Pexp_constant (Pconst_integer (i,_))} :
-                             Parsetree.expression) ,_)}]) :: _ -> 
+                             Parsetree.expression) ,_)}]) :: _ ->
                Some (int_of_string i)              
             | _ :: rest  -> scann rest 
             | [] -> None 
@@ -1605,7 +1620,7 @@ let transl_value_decl env loc valdecl =
             else Primitive.Same_as_ocaml_repr :: make (n - 1)
           in 
             match scann valdecl.pval_attributes with 
-            | None ->  parse_native_repr_attributes env valdecl.pval_type ty 
+            | None ->  parse_native_repr_attributes valdecl env valdecl.pval_type ty 
             | Some x -> make x , Primitive.Same_as_ocaml_repr
       in
       let prim =

jscomp/test/UncurriedExternals.js

@@ -0,0 +1,52 @@
+'use strict';
+
+
+function dd(param) {
+  throw {
+        RE_EXN_ID: "Not_found",
+        Error: new Error()
+      };
+}
+
+var h = sum(1.0, 2.0);
+
+var M = {
+  sum: sum
+};
+
+var hh = M.sum(1.0, 2.0);
+
+var mf = 3 % 4;
+
+var StandardNotation = {
+  dd: dd,
+  h: h,
+  M: M,
+  hh: hh,
+  mf: mf
+};
+
+function dd$1(param) {
+  throw {
+        RE_EXN_ID: "Not_found",
+        Error: new Error()
+      };
+}
+
+var h$1 = sum(1.0, 2.0);
+
+var M$1 = {
+  sum: sum
+};
+
+var hh$1 = M$1.sum(1.0, 2.0);
+
+var mf$1 = 3 % 4;
+
+exports.StandardNotation = StandardNotation;
+exports.dd = dd$1;
+exports.h = h$1;
+exports.M = M$1;
+exports.hh = hh$1;
+exports.mf = mf$1;
+/* h Not a pure module */

jscomp/test/UncurriedExternals.res

@@ -0,0 +1,35 @@
+module StandardNotation = {
+  external raise: (. exn) => 'a = "%raise"
+  let dd = () => raise(. Not_found)
+
+  @val external sum: (. float, float) => float = "sum"
+  let h = sum(. 1.0, 2.0)
+
+  module M: {
+    let sum: (. float, float) => float
+  } = {
+    external sum: (. float, float) => float = "sum"
+  }
+  let hh = M.sum(. 1.0, 2.0)
+
+  external mod_float : (. float, float) => float = "?fmod_float"
+  let mf = mod_float(. 3., 4.)
+}
+
+@@uncurried
+
+external raise: exn => 'a = "%raise"
+let dd = (. ()) => raise(Not_found)
+
+@val external sum: (float, float) => float = "sum"
+let h = sum(1.0, 2.0)
+
+module M: {
+  let sum: (float, float) => float
+} = {
+  external sum: (float, float) => float = "sum"
+}
+let hh = M.sum(1.0, 2.0)
+
+external mod_float : (float, float) => float = "?fmod_float"
+let mf = mod_float(3., 4.)

jscomp/test/build.ninja

@@ -39167,6 +39167,21 @@ let rec parse_native_repr_attributes env core_type ty =
   | _ -> ([], Same_as_ocaml_repr)
 
 
+let parse_native_repr_attributes valdecl env core_type ty =
+  match core_type.ptyp_desc, (Ctype.repr ty).desc
+  with
+  | Ptyp_constr ({txt = Ldot(Ldot(Lident "Js", "Fn"),_)}, [{ptyp_desc = Ptyp_arrow (_, _, ct2)}]),
+    Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc = Tarrow (_, _, t2, _)}],_) ->
+    let is_internal_primitive = match valdecl.pval_prim with
+      | [ s ] -> s <> "" && (s.[0] = '%' || s.[0] = '?')
+      | _ -> false in
+    let repr_args, repr_res = parse_native_repr_attributes env ct2 t2 in
+    let native_repr_args =
+      if is_internal_primitive then
+        Same_as_ocaml_repr :: repr_args (* uncurried primitives treated like curried ones *)
+      else [] (* uncurried externals are treated specially by the back-end *) in
+    (native_repr_args, repr_res)
+  | _ -> parse_native_repr_attributes env core_type ty
 
 (* Translate a value declaration *)
 let transl_value_decl env loc valdecl =
@@ -39183,11 +39198,11 @@ let transl_value_decl env loc valdecl =
       let native_repr_args, native_repr_res =
           let rec scann (attrs : Parsetree.attributes)  = 
             match attrs with 
-            | ({txt = "internal.arity";_}, 
+            | ({txt = "internal.arity";_},
               PStr [ {pstr_desc = Pstr_eval
                         (
                           ({pexp_desc = Pexp_constant (Pconst_integer (i,_))} :
-                             Parsetree.expression) ,_)}]) :: _ -> 
+                             Parsetree.expression) ,_)}]) :: _ ->
                Some (int_of_string i)              
             | _ :: rest  -> scann rest 
             | [] -> None 
@@ -39196,7 +39211,7 @@ let transl_value_decl env loc valdecl =
             else Primitive.Same_as_ocaml_repr :: make (n - 1)
           in 
             match scann valdecl.pval_attributes with 
-            | None ->  parse_native_repr_attributes env valdecl.pval_type ty 
+            | None ->  parse_native_repr_attributes valdecl env valdecl.pval_type ty 
             | Some x -> make x , Primitive.Same_as_ocaml_repr
       in
       let prim =

lib/4.06.1/unstable/js_compiler.ml

@@ -39167,6 +39167,21 @@ let rec parse_native_repr_attributes env core_type ty =
   | _ -> ([], Same_as_ocaml_repr)
 
 
+let parse_native_repr_attributes valdecl env core_type ty =
+  match core_type.ptyp_desc, (Ctype.repr ty).desc
+  with
+  | Ptyp_constr ({txt = Ldot(Ldot(Lident "Js", "Fn"),_)}, [{ptyp_desc = Ptyp_arrow (_, _, ct2)}]),
+    Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc = Tarrow (_, _, t2, _)}],_) ->
+    let is_internal_primitive = match valdecl.pval_prim with
+      | [ s ] -> s <> "" && (s.[0] = '%' || s.[0] = '?')
+      | _ -> false in
+    let repr_args, repr_res = parse_native_repr_attributes env ct2 t2 in
+    let native_repr_args =
+      if is_internal_primitive then
+        Same_as_ocaml_repr :: repr_args (* uncurried primitives treated like curried ones *)
+      else [] (* uncurried externals are treated specially by the back-end *) in
+    (native_repr_args, repr_res)
+  | _ -> parse_native_repr_attributes env core_type ty
 
 (* Translate a value declaration *)
 let transl_value_decl env loc valdecl =
@@ -39183,11 +39198,11 @@ let transl_value_decl env loc valdecl =
       let native_repr_args, native_repr_res =
           let rec scann (attrs : Parsetree.attributes)  = 
             match attrs with 
-            | ({txt = "internal.arity";_}, 
+            | ({txt = "internal.arity";_},
               PStr [ {pstr_desc = Pstr_eval
                         (
                           ({pexp_desc = Pexp_constant (Pconst_integer (i,_))} :
-                             Parsetree.expression) ,_)}]) :: _ -> 
+                             Parsetree.expression) ,_)}]) :: _ ->
                Some (int_of_string i)              
             | _ :: rest  -> scann rest 
             | [] -> None 
@@ -39196,7 +39211,7 @@ let transl_value_decl env loc valdecl =
             else Primitive.Same_as_ocaml_repr :: make (n - 1)
           in 
             match scann valdecl.pval_attributes with 
-            | None ->  parse_native_repr_attributes env valdecl.pval_type ty 
+            | None ->  parse_native_repr_attributes valdecl env valdecl.pval_type ty 
             | Some x -> make x , Primitive.Same_as_ocaml_repr
       in
       let prim =

lib/4.06.1/unstable/js_playground_compiler.ml

@@ -94162,6 +94162,21 @@ let rec parse_native_repr_attributes env core_type ty =
   | _ -> ([], Same_as_ocaml_repr)
 
 
+let parse_native_repr_attributes valdecl env core_type ty =
+  match core_type.ptyp_desc, (Ctype.repr ty).desc
+  with
+  | Ptyp_constr ({txt = Ldot(Ldot(Lident "Js", "Fn"),_)}, [{ptyp_desc = Ptyp_arrow (_, _, ct2)}]),
+    Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc = Tarrow (_, _, t2, _)}],_) ->
+    let is_internal_primitive = match valdecl.pval_prim with
+      | [ s ] -> s <> "" && (s.[0] = '%' || s.[0] = '?')
+      | _ -> false in
+    let repr_args, repr_res = parse_native_repr_attributes env ct2 t2 in
+    let native_repr_args =
+      if is_internal_primitive then
+        Same_as_ocaml_repr :: repr_args (* uncurried primitives treated like curried ones *)
+      else [] (* uncurried externals are treated specially by the back-end *) in
+    (native_repr_args, repr_res)
+  | _ -> parse_native_repr_attributes env core_type ty
 
 (* Translate a value declaration *)
 let transl_value_decl env loc valdecl =
@@ -94178,11 +94193,11 @@ let transl_value_decl env loc valdecl =
       let native_repr_args, native_repr_res =
           let rec scann (attrs : Parsetree.attributes)  = 
             match attrs with 
-            | ({txt = "internal.arity";_}, 
+            | ({txt = "internal.arity";_},
               PStr [ {pstr_desc = Pstr_eval
                         (
                           ({pexp_desc = Pexp_constant (Pconst_integer (i,_))} :
-                             Parsetree.expression) ,_)}]) :: _ -> 
+                             Parsetree.expression) ,_)}]) :: _ ->
                Some (int_of_string i)              
             | _ :: rest  -> scann rest 
             | [] -> None 
@@ -94191,7 +94206,7 @@ let transl_value_decl env loc valdecl =
             else Primitive.Same_as_ocaml_repr :: make (n - 1)
           in 
             match scann valdecl.pval_attributes with 
-            | None ->  parse_native_repr_attributes env valdecl.pval_type ty 
+            | None ->  parse_native_repr_attributes valdecl env valdecl.pval_type ty 
             | Some x -> make x , Primitive.Same_as_ocaml_repr
       in
       let prim =