Skip to content

Commit 39993f3

Browse files
cristianoccristianoc
committed
Add support for uncurried externals
1 parent 1152b52 commit 39993f3

File tree

8 files changed

+162
-16
lines changed

8 files changed

+162
-16
lines changed

‎CHANGELOG.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@
1919
- Add support for unary uncurried pipe in uncurried mode https://github.com/rescript-lang/rescript-compiler/pull/5804
2020
- Add support for partial application of uncurried functions: with uncurried application one can provide a
2121
subset of the arguments, and return a curried type with the remaining ones https://github.com/rescript-lang/rescript-compiler/pull/5805
22+
- Add support for uncurried externals https://github.com/rescript-lang/rescript-compiler/pull/5815
2223

2324
#### :boom: Breaking Change
2425

‎jscomp/ml/typedecl.ml‎

Lines changed: 18 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1576,6 +1576,21 @@ let rec parse_native_repr_attributes env core_type ty =
15761576
| _ -> ([], Same_as_ocaml_repr)
15771577

15781578

1579+
let parse_native_repr_attributes valdecl env core_type ty =
1580+
match core_type.ptyp_desc, (Ctype.repr ty).desc
1581+
with
1582+
| Ptyp_constr ({txt = Ldot(Ldot(Lident "Js", "Fn"),_)}, [{ptyp_desc = Ptyp_arrow (_, _, ct2)}]),
1583+
Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc = Tarrow (_, _, t2, _)}],_) ->
1584+
let is_internal_primitive = match valdecl.pval_prim with
1585+
| [ s ] -> s <> "" && (s.[0] = '%' || s.[0] = '?')
1586+
| _ -> false in
1587+
let repr_args, repr_res = parse_native_repr_attributes env ct2 t2 in
1588+
let native_repr_args =
1589+
if is_internal_primitive then
1590+
Same_as_ocaml_repr :: repr_args (* uncurried primitives treated like curried ones *)
1591+
else [] (* uncurried externals are treated specially by the back-end *) in
1592+
(native_repr_args, repr_res)
1593+
| _ -> parse_native_repr_attributes env core_type ty
15791594

15801595
(* Translate a value declaration *)
15811596
let transl_value_decl env loc valdecl =
@@ -1592,11 +1607,11 @@ let transl_value_decl env loc valdecl =
15921607
let native_repr_args, native_repr_res =
15931608
let rec scann (attrs : Parsetree.attributes) =
15941609
match attrs with
1595-
| ({txt = "internal.arity";_},
1610+
| ({txt = "internal.arity";_},
15961611
PStr [ {pstr_desc = Pstr_eval
15971612
(
15981613
({pexp_desc = Pexp_constant (Pconst_integer (i,_))} :
1599-
Parsetree.expression) ,_)}]) :: _ ->
1614+
Parsetree.expression) ,_)}]) :: _ ->
16001615
Some (int_of_string i)
16011616
| _ :: rest -> scann rest
16021617
| [] -> None
@@ -1605,7 +1620,7 @@ let transl_value_decl env loc valdecl =
16051620
else Primitive.Same_as_ocaml_repr :: make (n - 1)
16061621
in
16071622
match scann valdecl.pval_attributes with
1608-
| None -> parse_native_repr_attributes env valdecl.pval_type ty
1623+
| None -> parse_native_repr_attributes valdecl env valdecl.pval_type ty
16091624
| Some x -> make x , Primitive.Same_as_ocaml_repr
16101625
in
16111626
let prim =

‎jscomp/test/UncurriedExternals.js‎

Lines changed: 52 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,52 @@
1+
'use strict';
2+
3+
4+
function dd(param) {
5+
throw {
6+
RE_EXN_ID: "Not_found",
7+
Error: new Error()
8+
};
9+
}
10+
11+
var h = sum(1.0, 2.0);
12+
13+
var M = {
14+
sum: sum
15+
};
16+
17+
var hh = M.sum(1.0, 2.0);
18+
19+
var mf = 3 % 4;
20+
21+
var StandardNotation = {
22+
dd: dd,
23+
h: h,
24+
M: M,
25+
hh: hh,
26+
mf: mf
27+
};
28+
29+
function dd$1(param) {
30+
throw {
31+
RE_EXN_ID: "Not_found",
32+
Error: new Error()
33+
};
34+
}
35+
36+
var h$1 = sum(1.0, 2.0);
37+
38+
var M$1 = {
39+
sum: sum
40+
};
41+
42+
var hh$1 = M$1.sum(1.0, 2.0);
43+
44+
var mf$1 = 3 % 4;
45+
46+
exports.StandardNotation = StandardNotation;
47+
exports.dd = dd$1;
48+
exports.h = h$1;
49+
exports.M = M$1;
50+
exports.hh = hh$1;
51+
exports.mf = mf$1;
52+
/* h Not a pure module */

‎jscomp/test/UncurriedExternals.res‎

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
module StandardNotation = {
2+
external raise: (. exn) => 'a = "%raise"
3+
let dd = () => raise(. Not_found)
4+
5+
@val external sum: (. float, float) => float = "sum"
6+
let h = sum(. 1.0, 2.0)
7+
8+
module M: {
9+
let sum: (. float, float) => float
10+
} = {
11+
external sum: (. float, float) => float = "sum"
12+
}
13+
let hh = M.sum(. 1.0, 2.0)
14+
15+
external mod_float : (. float, float) => float = "?fmod_float"
16+
let mf = mod_float(. 3., 4.)
17+
}
18+
19+
@@uncurried
20+
21+
external raise: exn => 'a = "%raise"
22+
let dd = (. ()) => raise(Not_found)
23+
24+
@val external sum: (float, float) => float = "sum"
25+
let h = sum(1.0, 2.0)
26+
27+
module M: {
28+
let sum: (float, float) => float
29+
} = {
30+
external sum: (float, float) => float = "sum"
31+
}
32+
let hh = M.sum(1.0, 2.0)
33+
34+
external mod_float : (float, float) => float = "?fmod_float"
35+
let mf = mod_float(3., 4.)

‎jscomp/test/build.ninja‎

Lines changed: 2 additions & 1 deletion
Large diffs are not rendered by default.

‎lib/4.06.1/unstable/js_compiler.ml‎

Lines changed: 18 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -39167,6 +39167,21 @@ let rec parse_native_repr_attributes env core_type ty =
3916739167
| _ -> ([], Same_as_ocaml_repr)
3916839168

3916939169

39170+
let parse_native_repr_attributes valdecl env core_type ty =
39171+
match core_type.ptyp_desc, (Ctype.repr ty).desc
39172+
with
39173+
| Ptyp_constr ({txt = Ldot(Ldot(Lident "Js", "Fn"),_)}, [{ptyp_desc = Ptyp_arrow (_, _, ct2)}]),
39174+
Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc = Tarrow (_, _, t2, _)}],_) ->
39175+
let is_internal_primitive = match valdecl.pval_prim with
39176+
| [ s ] -> s <> "" && (s.[0] = '%' || s.[0] = '?')
39177+
| _ -> false in
39178+
let repr_args, repr_res = parse_native_repr_attributes env ct2 t2 in
39179+
let native_repr_args =
39180+
if is_internal_primitive then
39181+
Same_as_ocaml_repr :: repr_args (* uncurried primitives treated like curried ones *)
39182+
else [] (* uncurried externals are treated specially by the back-end *) in
39183+
(native_repr_args, repr_res)
39184+
| _ -> parse_native_repr_attributes env core_type ty
3917039185

3917139186
(* Translate a value declaration *)
3917239187
let transl_value_decl env loc valdecl =
@@ -39183,11 +39198,11 @@ let transl_value_decl env loc valdecl =
3918339198
let native_repr_args, native_repr_res =
3918439199
let rec scann (attrs : Parsetree.attributes) =
3918539200
match attrs with
39186-
| ({txt = "internal.arity";_},
39201+
| ({txt = "internal.arity";_},
3918739202
PStr [ {pstr_desc = Pstr_eval
3918839203
(
3918939204
({pexp_desc = Pexp_constant (Pconst_integer (i,_))} :
39190-
Parsetree.expression) ,_)}]) :: _ ->
39205+
Parsetree.expression) ,_)}]) :: _ ->
3919139206
Some (int_of_string i)
3919239207
| _ :: rest -> scann rest
3919339208
| [] -> None
@@ -39196,7 +39211,7 @@ let transl_value_decl env loc valdecl =
3919639211
else Primitive.Same_as_ocaml_repr :: make (n - 1)
3919739212
in
3919839213
match scann valdecl.pval_attributes with
39199-
| None -> parse_native_repr_attributes env valdecl.pval_type ty
39214+
| None -> parse_native_repr_attributes valdecl env valdecl.pval_type ty
3920039215
| Some x -> make x , Primitive.Same_as_ocaml_repr
3920139216
in
3920239217
let prim =
@@ -43686,7 +43701,6 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
4368643701
Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
4368743702
unify env ty_fun (newty (Tarrow(l1,t1,t2,Clink(ref Cunknown))));
4368843703
(t1, t2)
43689-
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc=Tarrow (l,t1,t2,_)}],_)
4369043704
| Tarrow (l,t1,t2,_) when Asttypes.same_arg_label l l1
4369143705
->
4369243706
(t1, t2)

‎lib/4.06.1/unstable/js_playground_compiler.ml‎

Lines changed: 18 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -39167,6 +39167,21 @@ let rec parse_native_repr_attributes env core_type ty =
3916739167
| _ -> ([], Same_as_ocaml_repr)
3916839168

3916939169

39170+
let parse_native_repr_attributes valdecl env core_type ty =
39171+
match core_type.ptyp_desc, (Ctype.repr ty).desc
39172+
with
39173+
| Ptyp_constr ({txt = Ldot(Ldot(Lident "Js", "Fn"),_)}, [{ptyp_desc = Ptyp_arrow (_, _, ct2)}]),
39174+
Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc = Tarrow (_, _, t2, _)}],_) ->
39175+
let is_internal_primitive = match valdecl.pval_prim with
39176+
| [ s ] -> s <> "" && (s.[0] = '%' || s.[0] = '?')
39177+
| _ -> false in
39178+
let repr_args, repr_res = parse_native_repr_attributes env ct2 t2 in
39179+
let native_repr_args =
39180+
if is_internal_primitive then
39181+
Same_as_ocaml_repr :: repr_args (* uncurried primitives treated like curried ones *)
39182+
else [] (* uncurried externals are treated specially by the back-end *) in
39183+
(native_repr_args, repr_res)
39184+
| _ -> parse_native_repr_attributes env core_type ty
3917039185

3917139186
(* Translate a value declaration *)
3917239187
let transl_value_decl env loc valdecl =
@@ -39183,11 +39198,11 @@ let transl_value_decl env loc valdecl =
3918339198
let native_repr_args, native_repr_res =
3918439199
let rec scann (attrs : Parsetree.attributes) =
3918539200
match attrs with
39186-
| ({txt = "internal.arity";_},
39201+
| ({txt = "internal.arity";_},
3918739202
PStr [ {pstr_desc = Pstr_eval
3918839203
(
3918939204
({pexp_desc = Pexp_constant (Pconst_integer (i,_))} :
39190-
Parsetree.expression) ,_)}]) :: _ ->
39205+
Parsetree.expression) ,_)}]) :: _ ->
3919139206
Some (int_of_string i)
3919239207
| _ :: rest -> scann rest
3919339208
| [] -> None
@@ -39196,7 +39211,7 @@ let transl_value_decl env loc valdecl =
3919639211
else Primitive.Same_as_ocaml_repr :: make (n - 1)
3919739212
in
3919839213
match scann valdecl.pval_attributes with
39199-
| None -> parse_native_repr_attributes env valdecl.pval_type ty
39214+
| None -> parse_native_repr_attributes valdecl env valdecl.pval_type ty
3920039215
| Some x -> make x , Primitive.Same_as_ocaml_repr
3920139216
in
3920239217
let prim =
@@ -43686,7 +43701,6 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
4368643701
Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
4368743702
unify env ty_fun (newty (Tarrow(l1,t1,t2,Clink(ref Cunknown))));
4368843703
(t1, t2)
43689-
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc=Tarrow (l,t1,t2,_)}],_)
4369043704
| Tarrow (l,t1,t2,_) when Asttypes.same_arg_label l l1
4369143705
->
4369243706
(t1, t2)

‎lib/4.06.1/whole_compiler.ml‎

Lines changed: 18 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -94162,6 +94162,21 @@ let rec parse_native_repr_attributes env core_type ty =
9416294162
| _ -> ([], Same_as_ocaml_repr)
9416394163

9416494164

94165+
let parse_native_repr_attributes valdecl env core_type ty =
94166+
match core_type.ptyp_desc, (Ctype.repr ty).desc
94167+
with
94168+
| Ptyp_constr ({txt = Ldot(Ldot(Lident "Js", "Fn"),_)}, [{ptyp_desc = Ptyp_arrow (_, _, ct2)}]),
94169+
Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc = Tarrow (_, _, t2, _)}],_) ->
94170+
let is_internal_primitive = match valdecl.pval_prim with
94171+
| [ s ] -> s <> "" && (s.[0] = '%' || s.[0] = '?')
94172+
| _ -> false in
94173+
let repr_args, repr_res = parse_native_repr_attributes env ct2 t2 in
94174+
let native_repr_args =
94175+
if is_internal_primitive then
94176+
Same_as_ocaml_repr :: repr_args (* uncurried primitives treated like curried ones *)
94177+
else [] (* uncurried externals are treated specially by the back-end *) in
94178+
(native_repr_args, repr_res)
94179+
| _ -> parse_native_repr_attributes env core_type ty
9416594180

9416694181
(* Translate a value declaration *)
9416794182
let transl_value_decl env loc valdecl =
@@ -94178,11 +94193,11 @@ let transl_value_decl env loc valdecl =
9417894193
let native_repr_args, native_repr_res =
9417994194
let rec scann (attrs : Parsetree.attributes) =
9418094195
match attrs with
94181-
| ({txt = "internal.arity";_},
94196+
| ({txt = "internal.arity";_},
9418294197
PStr [ {pstr_desc = Pstr_eval
9418394198
(
9418494199
({pexp_desc = Pexp_constant (Pconst_integer (i,_))} :
94185-
Parsetree.expression) ,_)}]) :: _ ->
94200+
Parsetree.expression) ,_)}]) :: _ ->
9418694201
Some (int_of_string i)
9418794202
| _ :: rest -> scann rest
9418894203
| [] -> None
@@ -94191,7 +94206,7 @@ let transl_value_decl env loc valdecl =
9419194206
else Primitive.Same_as_ocaml_repr :: make (n - 1)
9419294207
in
9419394208
match scann valdecl.pval_attributes with
94194-
| None -> parse_native_repr_attributes env valdecl.pval_type ty
94209+
| None -> parse_native_repr_attributes valdecl env valdecl.pval_type ty
9419594210
| Some x -> make x , Primitive.Same_as_ocaml_repr
9419694211
in
9419794212
let prim =
@@ -98681,7 +98696,6 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
9868198696
Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
9868298697
unify env ty_fun (newty (Tarrow(l1,t1,t2,Clink(ref Cunknown))));
9868398698
(t1, t2)
98684-
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc=Tarrow (l,t1,t2,_)}],_)
9868598699
| Tarrow (l,t1,t2,_) when Asttypes.same_arg_label l l1
9868698700
->
9868798701
(t1, t2)

0 commit comments

Comments
 (0)