Skip to content

Commit ff3883e

Browse files
cristianoccristianoc
committed
Parsing: fix arity of curried after uncurried in types
1 parent a9956ee commit ff3883e

File tree

5 files changed

+62
-32
lines changed

5 files changed

+62
-32
lines changed

‎lib/4.06.1/unstable/js_playground_compiler.ml‎

Lines changed: 19 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -166495,9 +166495,19 @@ 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 _paramNum, typ =
166498+
let returnTypeArity =
166499+
match parameters with
166500+
| _ when p.uncurried_by_default -> 0
166501+
| _ ->
166502+
if parameters |> List.exists (function {dotted; typ = _} -> dotted)
166503+
then 0
166504+
else
166505+
let _, args, _ = Res_parsetree_viewer.arrowType returnType in
166506+
List.length args
166507+
in
166508+
let _paramNum, typ, _arity =
166499166509
List.fold_right
166500-
(fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t) ->
166510+
(fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t, arity) ->
166501166511
let uncurried =
166502166512
if p.uncurried_by_default then not dotted else dotted
166503166513
in
@@ -166507,10 +166517,8 @@ and parseEs6ArrowType ~attrs p =
166507166517
| Ptyp_constr ({txt = Lident "unit"}, []) -> true
166508166518
| _ -> false
166509166519
in
166510-
let _, args, _ = Res_parsetree_viewer.arrowType t in
166511-
let arity = 1 + List.length args in
166512166520
let loc = mkLoc startPos endPos in
166513-
let arity, tArg =
166521+
let fnArity, tArg =
166514166522
if isUnit && arity = 1 then (0, t)
166515166523
else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t)
166516166524
in
@@ -166519,16 +166527,18 @@ and parseEs6ArrowType ~attrs p =
166519166527
{
166520166528
txt =
166521166529
Ldot
166522-
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity);
166530+
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int fnArity);
166523166531
loc;
166524166532
}
166525-
[tArg] )
166533+
[tArg],
166534+
1 )
166526166535
else
166527166536
( paramNum - 1,
166528166537
Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl
166529-
typ t ))
166538+
typ t,
166539+
arity + 1 ))
166530166540
parameters
166531-
(List.length parameters, returnType)
166541+
(List.length parameters, returnType, returnTypeArity + 1)
166532166542
in
166533166543
{
166534166544
typ with

‎lib/4.06.1/whole_compiler.ml‎

Lines changed: 19 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -179927,9 +179927,19 @@ 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 _paramNum, typ =
179930+
let returnTypeArity =
179931+
match parameters with
179932+
| _ when p.uncurried_by_default -> 0
179933+
| _ ->
179934+
if parameters |> List.exists (function {dotted; typ = _} -> dotted)
179935+
then 0
179936+
else
179937+
let _, args, _ = Res_parsetree_viewer.arrowType returnType in
179938+
List.length args
179939+
in
179940+
let _paramNum, typ, _arity =
179931179941
List.fold_right
179932-
(fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t) ->
179942+
(fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t, arity) ->
179933179943
let uncurried =
179934179944
if p.uncurried_by_default then not dotted else dotted
179935179945
in
@@ -179939,10 +179949,8 @@ and parseEs6ArrowType ~attrs p =
179939179949
| Ptyp_constr ({txt = Lident "unit"}, []) -> true
179940179950
| _ -> false
179941179951
in
179942-
let _, args, _ = Res_parsetree_viewer.arrowType t in
179943-
let arity = 1 + List.length args in
179944179952
let loc = mkLoc startPos endPos in
179945-
let arity, tArg =
179953+
let fnArity, tArg =
179946179954
if isUnit && arity = 1 then (0, t)
179947179955
else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t)
179948179956
in
@@ -179951,16 +179959,18 @@ and parseEs6ArrowType ~attrs p =
179951179959
{
179952179960
txt =
179953179961
Ldot
179954-
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity);
179962+
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int fnArity);
179955179963
loc;
179956179964
}
179957-
[tArg] )
179965+
[tArg],
179966+
1 )
179958179967
else
179959179968
( paramNum - 1,
179960179969
Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl
179961-
typ t ))
179970+
typ t,
179971+
arity + 1 ))
179962179972
parameters
179963-
(List.length parameters, returnType)
179973+
(List.length parameters, returnType, returnTypeArity + 1)
179964179974
in
179965179975
{
179966179976
typ with

‎res_syntax/src/res_core.ml‎

Lines changed: 19 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -4232,9 +4232,19 @@ 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 _paramNum, typ =
4235+
let returnTypeArity =
4236+
match parameters with
4237+
| _ when p.uncurried_by_default -> 0
4238+
| _ ->
4239+
if parameters |> List.exists (function {dotted; typ = _} -> dotted)
4240+
then 0
4241+
else
4242+
let _, args, _ = Res_parsetree_viewer.arrowType returnType in
4243+
List.length args
4244+
in
4245+
let _paramNum, typ, _arity =
42364246
List.fold_right
4237-
(fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t) ->
4247+
(fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t, arity) ->
42384248
let uncurried =
42394249
if p.uncurried_by_default then not dotted else dotted
42404250
in
@@ -4244,10 +4254,8 @@ and parseEs6ArrowType ~attrs p =
42444254
| Ptyp_constr ({txt = Lident "unit"}, []) -> true
42454255
| _ -> false
42464256
in
4247-
let _, args, _ = Res_parsetree_viewer.arrowType t in
4248-
let arity = 1 + List.length args in
42494257
let loc = mkLoc startPos endPos in
4250-
let arity, tArg =
4258+
let fnArity, tArg =
42514259
if isUnit && arity = 1 then (0, t)
42524260
else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t)
42534261
in
@@ -4256,16 +4264,18 @@ and parseEs6ArrowType ~attrs p =
42564264
{
42574265
txt =
42584266
Ldot
4259-
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity);
4267+
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int fnArity);
42604268
loc;
42614269
}
4262-
[tArg] )
4270+
[tArg],
4271+
1 )
42634272
else
42644273
( paramNum - 1,
42654274
Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl
4266-
typ t ))
4275+
typ t,
4276+
arity + 1 ))
42674277
parameters
4268-
(List.length parameters, returnType)
4278+
(List.length parameters, returnType, returnTypeArity + 1)
42694279
in
42704280
{
42714281
typ with

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -20,8 +20,8 @@ type nonrec mixTyp =
2020
(string ->
2121
string ->
2222
string -> string -> string -> string -> (string -> int) Js.Fn.arity1)
23-
Js.Fn.arity6
24-
type nonrec bTyp = (string -> string -> int) Js.Fn.arity2
23+
Js.Fn.arity2
24+
type nonrec bTyp = (string -> string -> int) Js.Fn.arity1
2525
type nonrec cTyp2 = string -> string -> int
2626
type nonrec uTyp2 = (string -> string -> int) Js.Fn.arity2
2727
[@@@uncurried ]
@@ -48,7 +48,7 @@ type nonrec mixTyp =
4848
(string ->
4949
string ->
5050
string -> string -> string -> string -> (string -> int) Js.Fn.arity1)
51-
Js.Fn.arity6
51+
Js.Fn.arity2
5252
type nonrec bTyp = (string -> string -> int) Js.Fn.arity1
5353
type nonrec cTyp2 = string -> string -> int
5454
type nonrec uTyp2 = (string -> string -> int) Js.Fn.arity2

‎res_syntax/tests/parsing/grammar/typexpr/expected/uncurried.res.txt‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -9,8 +9,8 @@ type nonrec t =
99
type nonrec t =
1010
(((float ->
1111
((int)[@attr2 ]) ->
12-
(((bool -> ((string)[@attr4 ]) -> unit) Js.Fn.arity2)[@attr3 ]))
13-
Js.Fn.arity2)[@attr ])
12+
(((bool -> ((string)[@attr4 ]) -> unit) Js.Fn.arity1)[@attr3 ]))
13+
Js.Fn.arity1)[@attr ])
1414
type nonrec t =
1515
(((float)[@attr ]) ->
1616
((int)[@attr2 ]) ->

0 commit comments

Comments
 (0)