Skip to content

Commit 332cbea

Browse files
cristianoccristianoc
committed
Fix uncurried type of multiple args
1 parent 9805977 commit 332cbea

File tree

7 files changed

+73
-57
lines changed

7 files changed

+73
-57
lines changed

‎lib/4.06.1/unstable/js_playground_compiler.ml

Lines changed: 17 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -166495,13 +166495,13 @@ and parseEs6ArrowType ~attrs p =
166495166495
Parser.expect EqualGreater p;
166496166496
let returnType = parseTypExpr ~alias:false p in
166497166497
let endPos = p.prevEndPos in
166498-
let typ =
166498+
let _paramNum, typ =
166499166499
List.fold_right
166500-
(fun {dotted; attrs; label = argLbl; typ; startPos} t ->
166500+
(fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t) ->
166501166501
let uncurried =
166502166502
if p.uncurried_by_default then not dotted else dotted
166503166503
in
166504-
if uncurried then
166504+
if uncurried && (paramNum = 1 || not p.uncurried_by_default) then
166505166505
let isUnit =
166506166506
match typ.ptyp_desc with
166507166507
| Ptyp_constr ({txt = Lident "unit"}, []) -> true
@@ -166514,17 +166514,21 @@ and parseEs6ArrowType ~attrs p =
166514166514
if isUnit && arity = 1 then (0, t)
166515166515
else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t)
166516166516
in
166517-
Ast_helper.Typ.constr ~loc
166518-
{
166519-
txt =
166520-
Ldot (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity);
166521-
loc;
166522-
}
166523-
[tArg]
166517+
( paramNum - 1,
166518+
Ast_helper.Typ.constr ~loc
166519+
{
166520+
txt =
166521+
Ldot
166522+
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity);
166523+
loc;
166524+
}
166525+
[tArg] )
166524166526
else
166525-
Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl typ
166526-
t)
166527-
parameters returnType
166527+
( paramNum - 1,
166528+
Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl
166529+
typ t ))
166530+
parameters
166531+
(List.length parameters, returnType)
166528166532
in
166529166533
{
166530166534
typ with

‎lib/4.06.1/whole_compiler.ml

Lines changed: 17 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -179927,13 +179927,13 @@ and parseEs6ArrowType ~attrs p =
179927179927
Parser.expect EqualGreater p;
179928179928
let returnType = parseTypExpr ~alias:false p in
179929179929
let endPos = p.prevEndPos in
179930-
let typ =
179930+
let _paramNum, typ =
179931179931
List.fold_right
179932-
(fun {dotted; attrs; label = argLbl; typ; startPos} t ->
179932+
(fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t) ->
179933179933
let uncurried =
179934179934
if p.uncurried_by_default then not dotted else dotted
179935179935
in
179936-
if uncurried then
179936+
if uncurried && (paramNum = 1 || not p.uncurried_by_default) then
179937179937
let isUnit =
179938179938
match typ.ptyp_desc with
179939179939
| Ptyp_constr ({txt = Lident "unit"}, []) -> true
@@ -179946,17 +179946,21 @@ and parseEs6ArrowType ~attrs p =
179946179946
if isUnit && arity = 1 then (0, t)
179947179947
else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t)
179948179948
in
179949-
Ast_helper.Typ.constr ~loc
179950-
{
179951-
txt =
179952-
Ldot (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity);
179953-
loc;
179954-
}
179955-
[tArg]
179949+
( paramNum - 1,
179950+
Ast_helper.Typ.constr ~loc
179951+
{
179952+
txt =
179953+
Ldot
179954+
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity);
179955+
loc;
179956+
}
179957+
[tArg] )
179956179958
else
179957-
Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl typ
179958-
t)
179959-
parameters returnType
179959+
( paramNum - 1,
179960+
Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl
179961+
typ t ))
179962+
parameters
179963+
(List.length parameters, returnType)
179960179964
in
179961179965
{
179962179966
typ with

‎res_syntax/src/res_core.ml

Lines changed: 17 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -4232,13 +4232,13 @@ and parseEs6ArrowType ~attrs p =
42324232
Parser.expect EqualGreater p;
42334233
let returnType = parseTypExpr ~alias:false p in
42344234
let endPos = p.prevEndPos in
4235-
let typ =
4235+
let _paramNum, typ =
42364236
List.fold_right
4237-
(fun {dotted; attrs; label = argLbl; typ; startPos} t ->
4237+
(fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t) ->
42384238
let uncurried =
42394239
if p.uncurried_by_default then not dotted else dotted
42404240
in
4241-
if uncurried then
4241+
if uncurried && (paramNum = 1 || not p.uncurried_by_default) then
42424242
let isUnit =
42434243
match typ.ptyp_desc with
42444244
| Ptyp_constr ({txt = Lident "unit"}, []) -> true
@@ -4251,17 +4251,21 @@ and parseEs6ArrowType ~attrs p =
42514251
if isUnit && arity = 1 then (0, t)
42524252
else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t)
42534253
in
4254-
Ast_helper.Typ.constr ~loc
4255-
{
4256-
txt =
4257-
Ldot (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity);
4258-
loc;
4259-
}
4260-
[tArg]
4254+
( paramNum - 1,
4255+
Ast_helper.Typ.constr ~loc
4256+
{
4257+
txt =
4258+
Ldot
4259+
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity);
4260+
loc;
4261+
}
4262+
[tArg] )
42614263
else
4262-
Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl typ
4263-
t)
4264-
parameters returnType
4264+
( paramNum - 1,
4265+
Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl
4266+
typ t ))
4267+
parameters
4268+
(List.length parameters, returnType)
42654269
in
42664270
{
42674271
typ with

‎res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -12,8 +12,8 @@ type cTyp = string => int
1212
type uTyp = (. string) => int
1313
type mixTyp = (string, .string, string) => (string, string, string) => (string, .string) => int
1414
type bTyp = (. string) => string => int
15-
// type cTyp2 = (string, string) => int
16-
// type uTyp2 = (.string, string) => int
15+
type cTyp2 = (string, string) => int
16+
type uTyp2 = (.string, string) => int
1717

1818
@@uncurried
1919

@@ -30,7 +30,7 @@ let cFun2Dots = (.x, .y) => 3 // redundant dot on y
3030

3131
type cTyp = (. string) => int
3232
type uTyp = string => int
33-
type mixTyp = (.string, string, .string) => (.string, .string, .string) => (.string, string) => int
33+
type mixTyp = (.string) => (string, string) => (.string, string, string, string) => string => int
3434
type bTyp = string => (. string) => int
35-
// type cTyp2 = (.string, string) => int
36-
// type uTyp2 = (string, string) => int
35+
type cTyp2 = (.string, string) => int
36+
type uTyp2 = (string, string) => int

‎res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,8 @@ type nonrec mixTyp =
2222
string -> string -> string -> string -> (string -> int) Js.Fn.arity1)
2323
Js.Fn.arity6
2424
type nonrec bTyp = (string -> string -> int) Js.Fn.arity2
25+
type nonrec cTyp2 = string -> string -> int
26+
type nonrec uTyp2 = (string -> string -> int) Js.Fn.arity2
2527
[@@@uncurried ]
2628
let cApp = foo 3
2729
let uApp = ((foo 3)[@bs ])
@@ -47,4 +49,6 @@ type nonrec mixTyp =
4749
string ->
4850
string -> string -> string -> string -> (string -> int) Js.Fn.arity1)
4951
Js.Fn.arity6
50-
type nonrec bTyp = (string -> string -> int) Js.Fn.arity1
52+
type nonrec bTyp = (string -> string -> int) Js.Fn.arity1
53+
type nonrec cTyp2 = string -> string -> int
54+
type nonrec uTyp2 = (string -> string -> int) Js.Fn.arity2

‎res_syntax/tests/printer/expr/UncurriedByDefault.res

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -11,9 +11,9 @@ let uFun2 = (. x, y) => 3
1111
type cTyp = string => int
1212
type uTyp = (. string) => int
1313
type mixTyp = (string, .string, string) => (string, string, string) => (string, .string) => int
14-
type bTyp = (. string) => string => int
15-
// type cTyp2 = (string, string) => int
16-
// type uTyp2 = (.string, string) => int
14+
// type bTyp = (. string) => string => int
15+
type cTyp2 = (string, string) => int
16+
type uTyp2 = (.string, string) => int
1717

1818
@@uncurried
1919

@@ -30,7 +30,7 @@ let cFun2Dots = (.x, .y) => 3 // redundant dot on y
3030

3131
type cTyp = (. string) => int
3232
type uTyp = string => int
33-
// type mixTyp = (.string, string, .string) => (.string, .string, .string) => (.string, string) => int
33+
type mixTyp = (.string) => (string, string) => (.string, string, string, string) => string => int
3434
// type bTyp = string => (. string) => int
35-
// type cTyp2 = (. string, string) => int
36-
// type uTyp2 = (string, string) => int
35+
type cTyp2 = (. string, string) => int
36+
type uTyp2 = (string, string) => int

‎res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -11,9 +11,9 @@ let uFun2 = (. x, y) => 3
1111
type cTyp = string => int
1212
type uTyp = (. string) => int
1313
type mixTyp = string => (. string, string, string, string, string, string) => (. string) => int
14-
type bTyp = (. string, string) => int
15-
// type cTyp2 = (string, string) => int
16-
// type uTyp2 = (.string, string) => int
14+
// type bTyp = (. string) => string => int
15+
type cTyp2 = (string, string) => int
16+
type uTyp2 = (. string, string) => int
1717

1818
@@uncurried
1919

@@ -30,7 +30,7 @@ let cFun2Dots = (. x, y) => 3 // redundant dot on y
3030

3131
type cTyp = (. string) => int
3232
type uTyp = string => int
33-
// type mixTyp = (.string, string, .string) => (.string, .string, .string) => (.string, string) => int
33+
type mixTyp = (. string) => (string, string, string, string, string, string) => string => int
3434
// type bTyp = string => (. string) => int
35-
// type cTyp2 = (. string, string) => int
36-
// type uTyp2 = (string, string) => int
35+
type cTyp2 = (. string, string) => int
36+
type uTyp2 = (string, string) => int

0 commit comments

Comments
 (0)