Skip to content

Commit 9805977

Browse files
cristianoccristianoc
committed
Fix uncurried case of multiple args, and handle corner case.
The corner case has the form: ```res (x, .y) => z => 3 ``` The dot in the middle of a sequence of args does not have a corresponding form in uncurried by default, because non-dots in uncurried by defaults are the normal ways to express the argument after the first. This means there's asymmetry between the two syntaxes. This could be handled by declaring this syntax invalid. Currently we instead parse to the desugaring of the syntax, which in normal mode is: ```res x => (.y) => { z => 3 } ``` And in uncurried mode is expressed as: ```res (.x) => y => { (. z) => 3 } ```
1 parent bfd522c commit 9805977

File tree

7 files changed

+155
-94
lines changed

7 files changed

+155
-94
lines changed

‎lib/4.06.1/unstable/js_playground_compiler.ml

Lines changed: 42 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -163792,23 +163792,34 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context
163792163792
in
163793163793
Parser.eatBreadcrumb p;
163794163794
let endPos = p.prevEndPos in
163795-
let body =
163795+
let bodyNeedsBraces =
163796+
let isFun =
163797+
match body.pexp_desc with
163798+
| Pexp_fun _ -> true
163799+
| _ -> false
163800+
in
163796163801
match parameters with
163797163802
| TermParameter {dotted} :: _
163798-
when (if p.uncurried_by_default then not dotted else dotted)
163799-
&&
163800-
match body.pexp_desc with
163801-
| Pexp_fun _ -> true
163802-
| _ -> false ->
163803+
when (if p.uncurried_by_default then not dotted else dotted) && isFun ->
163804+
true
163805+
| TermParameter _ :: rest when (not p.uncurried_by_default) && isFun ->
163806+
rest
163807+
|> List.exists (function
163808+
| TermParameter {dotted} -> dotted
163809+
| _ -> false)
163810+
| _ -> false
163811+
in
163812+
let body =
163813+
if bodyNeedsBraces then
163803163814
{
163804163815
body with
163805163816
pexp_attributes = makeBracesAttr body.pexp_loc :: body.pexp_attributes;
163806163817
}
163807-
| _ -> body
163818+
else body
163808163819
in
163809-
let arrowExpr, _arity =
163820+
let _paramNum, arrowExpr, _arity =
163810163821
List.fold_right
163811-
(fun parameter (expr, arity) ->
163822+
(fun parameter (paramNum, expr, arity) ->
163812163823
match parameter with
163813163824
| TermParameter
163814163825
{
@@ -163826,33 +163837,39 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context
163826163837
let uncurried =
163827163838
if p.uncurried_by_default then not dotted else dotted
163828163839
in
163829-
if uncurried then
163840+
if uncurried && (paramNum = 1 || not p.uncurried_by_default) then
163830163841
let arirtForFn =
163831163842
match pat.ppat_desc with
163832163843
| Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0
163833163844
| _ -> arity
163834163845
in
163835-
( Ast_helper.Exp.record ~loc
163836-
[
163837-
( {
163838-
txt =
163839-
Ldot
163840-
( Ldot (Lident "Js", "Fn"),
163841-
"I" ^ string_of_int arirtForFn );
163842-
loc;
163843-
},
163844-
funExpr );
163845-
]
163846-
None,
163846+
( paramNum - 1,
163847+
(if true then
163848+
Ast_helper.Exp.record ~loc
163849+
[
163850+
( {
163851+
txt =
163852+
Ldot
163853+
( Ldot (Lident "Js", "Fn"),
163854+
"I" ^ string_of_int arirtForFn );
163855+
loc;
163856+
},
163857+
funExpr );
163858+
]
163859+
None
163860+
else funExpr),
163847163861
1 )
163848-
else (funExpr, arity + 1)
163862+
else (paramNum - 1, funExpr, arity + 1)
163849163863
| TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} ->
163850163864
let uncurried =
163851163865
if p.uncurried_by_default then not dotted else dotted
163852163866
in
163853163867
let attrs = if uncurried then uncurryAttr :: attrs else attrs in
163854-
(makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity))
163855-
parameters (body, 1)
163868+
( paramNum - 1,
163869+
makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr,
163870+
arity ))
163871+
parameters
163872+
(List.length parameters, body, 1)
163856163873
in
163857163874
{arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}}
163858163875

‎lib/4.06.1/whole_compiler.ml

Lines changed: 42 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -177224,23 +177224,34 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context
177224177224
in
177225177225
Parser.eatBreadcrumb p;
177226177226
let endPos = p.prevEndPos in
177227-
let body =
177227+
let bodyNeedsBraces =
177228+
let isFun =
177229+
match body.pexp_desc with
177230+
| Pexp_fun _ -> true
177231+
| _ -> false
177232+
in
177228177233
match parameters with
177229177234
| TermParameter {dotted} :: _
177230-
when (if p.uncurried_by_default then not dotted else dotted)
177231-
&&
177232-
match body.pexp_desc with
177233-
| Pexp_fun _ -> true
177234-
| _ -> false ->
177235+
when (if p.uncurried_by_default then not dotted else dotted) && isFun ->
177236+
true
177237+
| TermParameter _ :: rest when (not p.uncurried_by_default) && isFun ->
177238+
rest
177239+
|> List.exists (function
177240+
| TermParameter {dotted} -> dotted
177241+
| _ -> false)
177242+
| _ -> false
177243+
in
177244+
let body =
177245+
if bodyNeedsBraces then
177235177246
{
177236177247
body with
177237177248
pexp_attributes = makeBracesAttr body.pexp_loc :: body.pexp_attributes;
177238177249
}
177239-
| _ -> body
177250+
else body
177240177251
in
177241-
let arrowExpr, _arity =
177252+
let _paramNum, arrowExpr, _arity =
177242177253
List.fold_right
177243-
(fun parameter (expr, arity) ->
177254+
(fun parameter (paramNum, expr, arity) ->
177244177255
match parameter with
177245177256
| TermParameter
177246177257
{
@@ -177258,33 +177269,39 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context
177258177269
let uncurried =
177259177270
if p.uncurried_by_default then not dotted else dotted
177260177271
in
177261-
if uncurried then
177272+
if uncurried && (paramNum = 1 || not p.uncurried_by_default) then
177262177273
let arirtForFn =
177263177274
match pat.ppat_desc with
177264177275
| Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0
177265177276
| _ -> arity
177266177277
in
177267-
( Ast_helper.Exp.record ~loc
177268-
[
177269-
( {
177270-
txt =
177271-
Ldot
177272-
( Ldot (Lident "Js", "Fn"),
177273-
"I" ^ string_of_int arirtForFn );
177274-
loc;
177275-
},
177276-
funExpr );
177277-
]
177278-
None,
177278+
( paramNum - 1,
177279+
(if true then
177280+
Ast_helper.Exp.record ~loc
177281+
[
177282+
( {
177283+
txt =
177284+
Ldot
177285+
( Ldot (Lident "Js", "Fn"),
177286+
"I" ^ string_of_int arirtForFn );
177287+
loc;
177288+
},
177289+
funExpr );
177290+
]
177291+
None
177292+
else funExpr),
177279177293
1 )
177280-
else (funExpr, arity + 1)
177294+
else (paramNum - 1, funExpr, arity + 1)
177281177295
| TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} ->
177282177296
let uncurried =
177283177297
if p.uncurried_by_default then not dotted else dotted
177284177298
in
177285177299
let attrs = if uncurried then uncurryAttr :: attrs else attrs in
177286-
(makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity))
177287-
parameters (body, 1)
177300+
( paramNum - 1,
177301+
makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr,
177302+
arity ))
177303+
parameters
177304+
(List.length parameters, body, 1)
177288177305
in
177289177306
{arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}}
177290177307

‎res_syntax/src/res_core.ml

Lines changed: 42 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -1529,23 +1529,34 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context
15291529
in
15301530
Parser.eatBreadcrumb p;
15311531
let endPos = p.prevEndPos in
1532-
let body =
1532+
let bodyNeedsBraces =
1533+
let isFun =
1534+
match body.pexp_desc with
1535+
| Pexp_fun _ -> true
1536+
| _ -> false
1537+
in
15331538
match parameters with
15341539
| TermParameter {dotted} :: _
1535-
when (if p.uncurried_by_default then not dotted else dotted)
1536-
&&
1537-
match body.pexp_desc with
1538-
| Pexp_fun _ -> true
1539-
| _ -> false ->
1540+
when (if p.uncurried_by_default then not dotted else dotted) && isFun ->
1541+
true
1542+
| TermParameter _ :: rest when (not p.uncurried_by_default) && isFun ->
1543+
rest
1544+
|> List.exists (function
1545+
| TermParameter {dotted} -> dotted
1546+
| _ -> false)
1547+
| _ -> false
1548+
in
1549+
let body =
1550+
if bodyNeedsBraces then
15401551
{
15411552
body with
15421553
pexp_attributes = makeBracesAttr body.pexp_loc :: body.pexp_attributes;
15431554
}
1544-
| _ -> body
1555+
else body
15451556
in
1546-
let arrowExpr, _arity =
1557+
let _paramNum, arrowExpr, _arity =
15471558
List.fold_right
1548-
(fun parameter (expr, arity) ->
1559+
(fun parameter (paramNum, expr, arity) ->
15491560
match parameter with
15501561
| TermParameter
15511562
{
@@ -1563,33 +1574,39 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context
15631574
let uncurried =
15641575
if p.uncurried_by_default then not dotted else dotted
15651576
in
1566-
if uncurried then
1577+
if uncurried && (paramNum = 1 || not p.uncurried_by_default) then
15671578
let arirtForFn =
15681579
match pat.ppat_desc with
15691580
| Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0
15701581
| _ -> arity
15711582
in
1572-
( Ast_helper.Exp.record ~loc
1573-
[
1574-
( {
1575-
txt =
1576-
Ldot
1577-
( Ldot (Lident "Js", "Fn"),
1578-
"I" ^ string_of_int arirtForFn );
1579-
loc;
1580-
},
1581-
funExpr );
1582-
]
1583-
None,
1583+
( paramNum - 1,
1584+
(if true then
1585+
Ast_helper.Exp.record ~loc
1586+
[
1587+
( {
1588+
txt =
1589+
Ldot
1590+
( Ldot (Lident "Js", "Fn"),
1591+
"I" ^ string_of_int arirtForFn );
1592+
loc;
1593+
},
1594+
funExpr );
1595+
]
1596+
None
1597+
else funExpr),
15841598
1 )
1585-
else (funExpr, arity + 1)
1599+
else (paramNum - 1, funExpr, arity + 1)
15861600
| TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} ->
15871601
let uncurried =
15881602
if p.uncurried_by_default then not dotted else dotted
15891603
in
15901604
let attrs = if uncurried then uncurryAttr :: attrs else attrs in
1591-
(makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity))
1592-
parameters (body, 1)
1605+
( paramNum - 1,
1606+
makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr,
1607+
arity ))
1608+
parameters
1609+
(List.length parameters, body, 1)
15931610
in
15941611
{arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}}
15951612

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

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -5,8 +5,8 @@ let cFun = x => 3
55
let uFun = (.x) => 3
66
let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4
77
let bracesFun = (. x) => y => x+y
8-
// let cFun2 = (x, y) => 3
9-
// let uFun2 = (. x, y) => 3
8+
let cFun2 = (x, y) => 3
9+
let uFun2 = (. x, y) => 3
1010

1111
type cTyp = string => int
1212
type uTyp = (. string) => int
@@ -22,10 +22,11 @@ let uApp = foo(3)
2222

2323
let cFun = (. x) => 3
2424
let uFun = x => 3
25-
let mixFun = (.a, b, .c) => (.d, .e, .f) => (.g, h) => 4
25+
let mixFun = (.a) => (b, c) => (.d, e, f) => (.g) => h => 4
2626
let bracesFun = x => (. y) => x+y
27-
// let cFun2 = (. x, y) => 3
28-
// let uFun2 = (x, y) => 3
27+
let cFun2 = (. x, y) => 3
28+
let uFun2 = (x, y) => 3
29+
let cFun2Dots = (.x, .y) => 3 // redundant dot on y
2930

3031
type cTyp = (. string) => int
3132
type uTyp = string => int

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

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -7,9 +7,12 @@ let mixFun a =
77
Js.Fn.I2 =
88
(fun b ->
99
fun c ->
10-
fun d -> fun e -> fun f -> fun g -> { Js.Fn.I1 = (fun h -> 4) })
10+
((fun d -> fun e -> fun f -> fun g -> { Js.Fn.I1 = (fun h -> 4) })
11+
[@ns.braces ]))
1112
}
1213
let bracesFun = { Js.Fn.I1 = (fun x -> ((fun y -> x + y)[@ns.braces ])) }
14+
let cFun2 x y = 3
15+
let uFun2 = { Js.Fn.I2 = (fun x -> fun y -> 3) }
1316
type nonrec cTyp = string -> int
1417
type nonrec uTyp = (string -> int) Js.Fn.arity1
1518
type nonrec mixTyp =
@@ -29,9 +32,13 @@ let mixFun a =
2932
Js.Fn.I2 =
3033
(fun b ->
3134
fun c ->
32-
fun d -> fun e -> fun f -> fun g -> { Js.Fn.I1 = (fun h -> 4) })
35+
((fun d -> fun e -> fun f -> fun g -> { Js.Fn.I1 = (fun h -> 4) })
36+
[@ns.braces ]))
3337
}
3438
let bracesFun = { Js.Fn.I1 = (fun x -> ((fun y -> x + y)[@ns.braces ])) }
39+
let cFun2 x y = 3
40+
let uFun2 = { Js.Fn.I2 = (fun x -> fun y -> 3) }
41+
let cFun2Dots x y = 3
3542
type nonrec cTyp = string -> int
3643
type nonrec uTyp = (string -> int) Js.Fn.arity1
3744
type nonrec mixTyp =

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

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,10 @@ let uApp = foo(. 3)
33

44
let cFun = x => 3
55
let uFun = (.x) => 3
6-
//let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4
6+
let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4
77
let bracesFun = (. x) => y => x+y
8-
// let cFun2 = (x, y) => 3
9-
// let uFun2 = (. x, y) => 3
8+
let cFun2 = (x, y) => 3
9+
let uFun2 = (. x, y) => 3
1010

1111
type cTyp = string => int
1212
type uTyp = (. string) => int
@@ -22,10 +22,11 @@ let uApp = foo(3)
2222

2323
let cFun = (. x) => 3
2424
let uFun = x => 3
25-
// let mixFun = (.a, b, .c) => (.d, .e, .f) => (.g, h) => 4
25+
let mixFun = (.a) => (b, c) => (.d, e, f) => (.g) => h => 4
2626
let bracesFun = x => (. y) => x+y
27-
// let cFun2 = (. x, y) => 3
28-
// let uFun2 = (x, y) => 3
27+
let cFun2 = (. x, y) => 3
28+
let uFun2 = (x, y) => 3
29+
let cFun2Dots = (.x, .y) => 3 // redundant dot on y
2930

3031
type cTyp = (. string) => int
3132
type uTyp = string => int

0 commit comments

Comments
 (0)