Skip to content

Commit 766a65f

Browse files
cristianoccristianoc
committed
Partial application of an uncurried type returns an uncurried type.
1 parent 158599b commit 766a65f

File tree

7 files changed

+137
-17
lines changed

7 files changed

+137
-17
lines changed

‎CHANGELOG.md

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,8 @@
1717
- Introduce experimental uncurried by default mode. Can be turned on mid-file by adding standalone annotation `@@uncurried`. For experimentation only. https://github.com/rescript-lang/rescript-compiler/pull/5796
1818
- Adding `@@toUncurried` to the file and reformat will convert to uncurried syntax https://github.com/rescript-lang/rescript-compiler/pull/5800
1919
- Add support for unary uncurried pipe in uncurried mode https://github.com/rescript-lang/rescript-compiler/pull/5804
20+
- Add support for partial application of uncurried functions: with uncurried application one can provide a
21+
subset of the arguments, and return a curried type with the remaining ones https://github.com/rescript-lang/rescript-compiler/pull/5805
2022

2123
#### :boom: Breaking Change
2224

‎jscomp/ml/typecore.ml

Lines changed: 24 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -2949,6 +2949,26 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
29492949
tvar || List.mem l ls
29502950
in
29512951
let ignored = ref [] in
2952+
let extract_uncurried t =
2953+
match t.desc with
2954+
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[t],_) -> t
2955+
| _ -> t in
2956+
let lower_uncurried_arity ~nargs t newT =
2957+
match t.desc with
2958+
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),a,_),[_],_) ->
2959+
let arity =
2960+
if String.sub a 0 5 = "arity"
2961+
then int_of_string (String.sub a 5 (String.length a - 5))
2962+
else 0 in
2963+
let newarity = arity - nargs in
2964+
if newarity > 0 then
2965+
let a = "arity" ^ string_of_int newarity in
2966+
let lid:Longident.t = Ldot (Ldot (Lident "Js", "Fn"), a) in
2967+
let path = Env.lookup_type lid env in
2968+
newconstr path [newT]
2969+
else newT
2970+
| _ -> newT
2971+
in
29522972
let rec type_unknown_args (args : lazy_args) omitted ty_fun (syntax_args : sargs)
29532973
: targs * _ =
29542974
match syntax_args with
@@ -2968,7 +2988,6 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
29682988
Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
29692989
unify env ty_fun (newty (Tarrow(l1,t1,t2,Clink(ref Cunknown))));
29702990
(t1, t2)
2971-
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc=Tarrow (l,t1,t2,_)}],_)
29722991
| Tarrow (l,t1,t2,_) when Asttypes.same_arg_label l l1
29732992
->
29742993
(t1, t2)
@@ -3059,8 +3078,10 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
30593078
end;
30603079
([Nolabel, Some exp], ty_res)
30613080
| _ ->
3062-
let ty = funct.exp_type in
3063-
type_args [] [] ~ty_fun:ty (instance env ty) ~sargs
3081+
let ty_ = funct.exp_type in
3082+
let ty = extract_uncurried ty_ in
3083+
let targs, ret_t = type_args [] [] ~ty_fun:ty (instance env ty) ~sargs in
3084+
targs, lower_uncurried_arity ty_ ~nargs:(List.length !ignored + List.length sargs) ret_t
30643085

30653086
and type_construct env loc lid sarg ty_expected attrs =
30663087
let opath =

‎jscomp/test/uncurried_cast.js

Lines changed: 31 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -54,11 +54,26 @@ var ll = Curry._1(partial, (function (x) {
5454
return x + 1 | 0;
5555
}));
5656

57+
function withOpts(xOpt, y, zOpt, w) {
58+
var x = xOpt !== undefined ? xOpt : 3;
59+
var z = zOpt !== undefined ? zOpt : 4;
60+
return ((x + y | 0) + z | 0) + w | 0;
61+
}
62+
63+
function still2Args(param, param$1) {
64+
return withOpts(undefined, 4, param, param$1);
65+
}
66+
67+
var anInt = still2Args(3, 5);
68+
5769
var StandardNotation = {
5870
testRaise: testRaise,
5971
l: l,
6072
partial: partial,
61-
ll: ll
73+
ll: ll,
74+
withOpts: withOpts,
75+
still2Args: still2Args,
76+
anInt: anInt
6277
};
6378

6479
function testRaise$1() {
@@ -93,11 +108,26 @@ var ll$1 = partial$1(function (x) {
93108
return x + 1 | 0;
94109
});
95110

111+
function withOpts$1(xOpt, y, zOpt, w) {
112+
var x = xOpt !== undefined ? xOpt : 3;
113+
var z = zOpt !== undefined ? zOpt : 4;
114+
return ((x + y | 0) + z | 0) + w | 0;
115+
}
116+
117+
function still2Args$1(param, param$1) {
118+
return withOpts$1(undefined, 4, param, param$1);
119+
}
120+
121+
var anInt$1 = still2Args$1(3, 5);
122+
96123
exports.Uncurried = Uncurried;
97124
exports.E = E;
98125
exports.StandardNotation = StandardNotation;
99126
exports.testRaise = testRaise$1;
100127
exports.l = l$1;
101128
exports.partial = partial$1;
102129
exports.ll = ll$1;
130+
exports.withOpts = withOpts$1;
131+
exports.still2Args = still2Args$1;
132+
exports.anInt = anInt$1;
103133
/* l Not a pure module */

‎jscomp/test/uncurried_cast.res

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -14,10 +14,12 @@ module StandardNotation = {
1414
let testRaise = () => raise(E)
1515

1616
let l = List.map(.list{1, 2}, (. x) => x + 1)
17-
1817
let partial = List.map(list{1, 2})
19-
2018
let ll = partial((. x) => x + 1)
19+
20+
let withOpts = (. ~x=3, y, ~z=4, w) => x + y + z + w
21+
let still2Args : (. ~z: int=?, int) => int = withOpts(4)
22+
let anInt = still2Args(. ~z=3, 5)
2123
}
2224

2325
@@uncurried
@@ -27,7 +29,9 @@ open Uncurried
2729
let testRaise = () => raise(E)
2830

2931
let l = List.map(list{1, 2}, x => x + 1)
30-
3132
let partial = List.map(. list{1, 2})
32-
3333
let ll = partial(.x => x + 1)
34+
35+
let withOpts = (~x=3, y, ~z=4, w) => x + y + z + w
36+
let still2Args : (~z: int=?, int) => int = withOpts(. 4)
37+
let anInt = still2Args(~z=3, 5)

‎lib/4.06.1/unstable/js_compiler.ml

Lines changed: 24 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -43647,6 +43647,26 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
4364743647
tvar || List.mem l ls
4364843648
in
4364943649
let ignored = ref [] in
43650+
let extract_uncurried t =
43651+
match t.desc with
43652+
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[t],_) -> t
43653+
| _ -> t in
43654+
let lower_uncurried_arity ~nargs t newT =
43655+
match t.desc with
43656+
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),a,_),[_],_) ->
43657+
let arity =
43658+
if String.sub a 0 5 = "arity"
43659+
then int_of_string (String.sub a 5 (String.length a - 5))
43660+
else 0 in
43661+
let newarity = arity - nargs in
43662+
if newarity > 0 then
43663+
let a = "arity" ^ string_of_int newarity in
43664+
let lid:Longident.t = Ldot (Ldot (Lident "Js", "Fn"), a) in
43665+
let path = Env.lookup_type lid env in
43666+
newconstr path [newT]
43667+
else newT
43668+
| _ -> newT
43669+
in
4365043670
let rec type_unknown_args (args : lazy_args) omitted ty_fun (syntax_args : sargs)
4365143671
: targs * _ =
4365243672
match syntax_args with
@@ -43666,7 +43686,6 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
4366643686
Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
4366743687
unify env ty_fun (newty (Tarrow(l1,t1,t2,Clink(ref Cunknown))));
4366843688
(t1, t2)
43669-
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc=Tarrow (l,t1,t2,_)}],_)
4367043689
| Tarrow (l,t1,t2,_) when Asttypes.same_arg_label l l1
4367143690
->
4367243691
(t1, t2)
@@ -43757,8 +43776,10 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
4375743776
end;
4375843777
([Nolabel, Some exp], ty_res)
4375943778
| _ ->
43760-
let ty = funct.exp_type in
43761-
type_args [] [] ~ty_fun:ty (instance env ty) ~sargs
43779+
let ty_ = funct.exp_type in
43780+
let ty = extract_uncurried ty_ in
43781+
let targs, ret_t = type_args [] [] ~ty_fun:ty (instance env ty) ~sargs in
43782+
targs, lower_uncurried_arity ty_ ~nargs:(List.length !ignored + List.length sargs) ret_t
4376243783

4376343784
and type_construct env loc lid sarg ty_expected attrs =
4376443785
let opath =

‎lib/4.06.1/unstable/js_playground_compiler.ml

Lines changed: 24 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -43647,6 +43647,26 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
4364743647
tvar || List.mem l ls
4364843648
in
4364943649
let ignored = ref [] in
43650+
let extract_uncurried t =
43651+
match t.desc with
43652+
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[t],_) -> t
43653+
| _ -> t in
43654+
let lower_uncurried_arity ~nargs t newT =
43655+
match t.desc with
43656+
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),a,_),[_],_) ->
43657+
let arity =
43658+
if String.sub a 0 5 = "arity"
43659+
then int_of_string (String.sub a 5 (String.length a - 5))
43660+
else 0 in
43661+
let newarity = arity - nargs in
43662+
if newarity > 0 then
43663+
let a = "arity" ^ string_of_int newarity in
43664+
let lid:Longident.t = Ldot (Ldot (Lident "Js", "Fn"), a) in
43665+
let path = Env.lookup_type lid env in
43666+
newconstr path [newT]
43667+
else newT
43668+
| _ -> newT
43669+
in
4365043670
let rec type_unknown_args (args : lazy_args) omitted ty_fun (syntax_args : sargs)
4365143671
: targs * _ =
4365243672
match syntax_args with
@@ -43666,7 +43686,6 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
4366643686
Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
4366743687
unify env ty_fun (newty (Tarrow(l1,t1,t2,Clink(ref Cunknown))));
4366843688
(t1, t2)
43669-
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc=Tarrow (l,t1,t2,_)}],_)
4367043689
| Tarrow (l,t1,t2,_) when Asttypes.same_arg_label l l1
4367143690
->
4367243691
(t1, t2)
@@ -43757,8 +43776,10 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
4375743776
end;
4375843777
([Nolabel, Some exp], ty_res)
4375943778
| _ ->
43760-
let ty = funct.exp_type in
43761-
type_args [] [] ~ty_fun:ty (instance env ty) ~sargs
43779+
let ty_ = funct.exp_type in
43780+
let ty = extract_uncurried ty_ in
43781+
let targs, ret_t = type_args [] [] ~ty_fun:ty (instance env ty) ~sargs in
43782+
targs, lower_uncurried_arity ty_ ~nargs:(List.length !ignored + List.length sargs) ret_t
4376243783

4376343784
and type_construct env loc lid sarg ty_expected attrs =
4376443785
let opath =

‎lib/4.06.1/whole_compiler.ml

Lines changed: 24 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -98642,6 +98642,26 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
9864298642
tvar || List.mem l ls
9864398643
in
9864498644
let ignored = ref [] in
98645+
let extract_uncurried t =
98646+
match t.desc with
98647+
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[t],_) -> t
98648+
| _ -> t in
98649+
let lower_uncurried_arity ~nargs t newT =
98650+
match t.desc with
98651+
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),a,_),[_],_) ->
98652+
let arity =
98653+
if String.sub a 0 5 = "arity"
98654+
then int_of_string (String.sub a 5 (String.length a - 5))
98655+
else 0 in
98656+
let newarity = arity - nargs in
98657+
if newarity > 0 then
98658+
let a = "arity" ^ string_of_int newarity in
98659+
let lid:Longident.t = Ldot (Ldot (Lident "Js", "Fn"), a) in
98660+
let path = Env.lookup_type lid env in
98661+
newconstr path [newT]
98662+
else newT
98663+
| _ -> newT
98664+
in
9864598665
let rec type_unknown_args (args : lazy_args) omitted ty_fun (syntax_args : sargs)
9864698666
: targs * _ =
9864798667
match syntax_args with
@@ -98661,7 +98681,6 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
9866198681
Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
9866298682
unify env ty_fun (newty (Tarrow(l1,t1,t2,Clink(ref Cunknown))));
9866398683
(t1, t2)
98664-
| Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[{desc=Tarrow (l,t1,t2,_)}],_)
9866598684
| Tarrow (l,t1,t2,_) when Asttypes.same_arg_label l l1
9866698685
->
9866798686
(t1, t2)
@@ -98752,8 +98771,10 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
9875298771
end;
9875398772
([Nolabel, Some exp], ty_res)
9875498773
| _ ->
98755-
let ty = funct.exp_type in
98756-
type_args [] [] ~ty_fun:ty (instance env ty) ~sargs
98774+
let ty_ = funct.exp_type in
98775+
let ty = extract_uncurried ty_ in
98776+
let targs, ret_t = type_args [] [] ~ty_fun:ty (instance env ty) ~sargs in
98777+
targs, lower_uncurried_arity ty_ ~nargs:(List.length !ignored + List.length sargs) ret_t
9875798778

9875898779
and type_construct env loc lid sarg ty_expected attrs =
9875998780
let opath =

0 commit comments

Comments
 (0)