Skip to content

Commit 9bf6a52

Browse files
cristianoccristianoc
committed
Preserve uncurried after curried when printing types.
E.g. `(. int) => string => bool`
1 parent ff3883e commit 9bf6a52

9 files changed

+79
-47
lines changed

‎lib/4.06.1/unstable/js_compiler.ml

+18-10
Original file line numberDiff line numberDiff line change
@@ -49384,6 +49384,7 @@ module Res_parsetree_viewer : sig
4938449384
* The parsetree contains: a => b => c => d, for printing purposes
4938549385
* we restructure the tree into (a, b, c) and its returnType d *)
4938649386
val arrowType :
49387+
?arity:int ->
4938749388
Parsetree.core_type ->
4938849389
Parsetree.attributes
4938949390
* (Parsetree.attributes * Asttypes.arg_label * Parsetree.core_type) list
@@ -49540,15 +49541,16 @@ end = struct
4954049541
#1 "res_parsetree_viewer.ml"
4954149542
open Parsetree
4954249543

49543-
let arrowType ct =
49544-
let rec process attrsBefore acc typ =
49544+
let arrowType ?(arity = max_int) ct =
49545+
let rec process attrsBefore acc typ arity =
4954549546
match typ with
49547+
| typ when arity <= 0 -> (attrsBefore, List.rev acc, typ)
4954649548
| {
4954749549
ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2);
4954849550
ptyp_attributes = [];
4954949551
} ->
4955049552
let arg = ([], lbl, typ1) in
49551-
process attrsBefore (arg :: acc) typ2
49553+
process attrsBefore (arg :: acc) typ2 (arity - 1)
4955249554
| {
4955349555
ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2);
4955449556
ptyp_attributes = [({txt = "bs"}, _)];
@@ -49565,14 +49567,14 @@ let arrowType ct =
4956549567
ptyp_attributes = attrs;
4956649568
} ->
4956749569
let arg = (attrs, lbl, typ1) in
49568-
process attrsBefore (arg :: acc) typ2
49570+
process attrsBefore (arg :: acc) typ2 (arity - 1)
4956949571
| typ -> (attrsBefore, List.rev acc, typ)
4957049572
in
4957149573
match ct with
4957249574
| {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as
4957349575
typ ->
49574-
process attrs [] {typ with ptyp_attributes = []}
49575-
| typ -> process [] [] typ
49576+
process attrs [] {typ with ptyp_attributes = []} arity
49577+
| typ -> process [] [] typ arity
4957649578

4957749579
let functorType modtype =
4957849580
let rec process acc modtype =
@@ -54612,8 +54614,10 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl =
5461254614
])
5461354615

5461454616
and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
54615-
let printArrow ~uncurried typExpr =
54616-
let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in
54617+
let printArrow ~uncurried ?(arity = max_int) typExpr =
54618+
let attrsBefore, args, returnType =
54619+
ParsetreeViewer.arrowType ~arity typExpr
54620+
in
5461754621
let dotted, attrsBefore =
5461854622
(* Converting .ml code to .res requires processing uncurried attributes *)
5461954623
let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in
@@ -54718,12 +54722,16 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
5471854722
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) ->
5471954723
let unitConstr = Location.mkloc (Longident.Lident "unit") tArg.ptyp_loc in
5472054724
let tUnit = Ast_helper.Typ.constr unitConstr [] in
54721-
printArrow ~uncurried:true
54725+
printArrow ~uncurried:true ~arity:1
5472254726
{tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)}
5472354727
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg])
5472454728
when String.length arity >= 5
5472554729
&& (String.sub [@doesNotRaise]) arity 0 5 = "arity" ->
54726-
printArrow ~uncurried:true tArg
54730+
let arity =
54731+
int_of_string
54732+
((String.sub [@doesNotRaise]) arity 5 (String.length arity - 5))
54733+
in
54734+
printArrow ~uncurried:true ~arity tArg
5472754735
| Ptyp_constr (longidentLoc, [{ptyp_desc = Ptyp_object (fields, openFlag)}])
5472854736
->
5472954737
(* for foo<{"a": b}>, when the object is long and needs a line break, we

‎lib/4.06.1/unstable/js_playground_compiler.ml

+18-10
Original file line numberDiff line numberDiff line change
@@ -49384,6 +49384,7 @@ module Res_parsetree_viewer : sig
4938449384
* The parsetree contains: a => b => c => d, for printing purposes
4938549385
* we restructure the tree into (a, b, c) and its returnType d *)
4938649386
val arrowType :
49387+
?arity:int ->
4938749388
Parsetree.core_type ->
4938849389
Parsetree.attributes
4938949390
* (Parsetree.attributes * Asttypes.arg_label * Parsetree.core_type) list
@@ -49540,15 +49541,16 @@ end = struct
4954049541
#1 "res_parsetree_viewer.ml"
4954149542
open Parsetree
4954249543

49543-
let arrowType ct =
49544-
let rec process attrsBefore acc typ =
49544+
let arrowType ?(arity = max_int) ct =
49545+
let rec process attrsBefore acc typ arity =
4954549546
match typ with
49547+
| typ when arity <= 0 -> (attrsBefore, List.rev acc, typ)
4954649548
| {
4954749549
ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2);
4954849550
ptyp_attributes = [];
4954949551
} ->
4955049552
let arg = ([], lbl, typ1) in
49551-
process attrsBefore (arg :: acc) typ2
49553+
process attrsBefore (arg :: acc) typ2 (arity - 1)
4955249554
| {
4955349555
ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2);
4955449556
ptyp_attributes = [({txt = "bs"}, _)];
@@ -49565,14 +49567,14 @@ let arrowType ct =
4956549567
ptyp_attributes = attrs;
4956649568
} ->
4956749569
let arg = (attrs, lbl, typ1) in
49568-
process attrsBefore (arg :: acc) typ2
49570+
process attrsBefore (arg :: acc) typ2 (arity - 1)
4956949571
| typ -> (attrsBefore, List.rev acc, typ)
4957049572
in
4957149573
match ct with
4957249574
| {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as
4957349575
typ ->
49574-
process attrs [] {typ with ptyp_attributes = []}
49575-
| typ -> process [] [] typ
49576+
process attrs [] {typ with ptyp_attributes = []} arity
49577+
| typ -> process [] [] typ arity
4957649578

4957749579
let functorType modtype =
4957849580
let rec process acc modtype =
@@ -54612,8 +54614,10 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl =
5461254614
])
5461354615

5461454616
and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
54615-
let printArrow ~uncurried typExpr =
54616-
let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in
54617+
let printArrow ~uncurried ?(arity = max_int) typExpr =
54618+
let attrsBefore, args, returnType =
54619+
ParsetreeViewer.arrowType ~arity typExpr
54620+
in
5461754621
let dotted, attrsBefore =
5461854622
(* Converting .ml code to .res requires processing uncurried attributes *)
5461954623
let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in
@@ -54718,12 +54722,16 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
5471854722
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) ->
5471954723
let unitConstr = Location.mkloc (Longident.Lident "unit") tArg.ptyp_loc in
5472054724
let tUnit = Ast_helper.Typ.constr unitConstr [] in
54721-
printArrow ~uncurried:true
54725+
printArrow ~uncurried:true ~arity:1
5472254726
{tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)}
5472354727
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg])
5472454728
when String.length arity >= 5
5472554729
&& (String.sub [@doesNotRaise]) arity 0 5 = "arity" ->
54726-
printArrow ~uncurried:true tArg
54730+
let arity =
54731+
int_of_string
54732+
((String.sub [@doesNotRaise]) arity 5 (String.length arity - 5))
54733+
in
54734+
printArrow ~uncurried:true ~arity tArg
5472754735
| Ptyp_constr (longidentLoc, [{ptyp_desc = Ptyp_object (fields, openFlag)}])
5472854736
->
5472954737
(* for foo<{"a": b}>, when the object is long and needs a line break, we

‎lib/4.06.1/whole_compiler.ml

+18-10
Original file line numberDiff line numberDiff line change
@@ -104379,6 +104379,7 @@ module Res_parsetree_viewer : sig
104379104379
* The parsetree contains: a => b => c => d, for printing purposes
104380104380
* we restructure the tree into (a, b, c) and its returnType d *)
104381104381
val arrowType :
104382+
?arity:int ->
104382104383
Parsetree.core_type ->
104383104384
Parsetree.attributes
104384104385
* (Parsetree.attributes * Asttypes.arg_label * Parsetree.core_type) list
@@ -104535,15 +104536,16 @@ end = struct
104535104536
#1 "res_parsetree_viewer.ml"
104536104537
open Parsetree
104537104538

104538-
let arrowType ct =
104539-
let rec process attrsBefore acc typ =
104539+
let arrowType ?(arity = max_int) ct =
104540+
let rec process attrsBefore acc typ arity =
104540104541
match typ with
104542+
| typ when arity <= 0 -> (attrsBefore, List.rev acc, typ)
104541104543
| {
104542104544
ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2);
104543104545
ptyp_attributes = [];
104544104546
} ->
104545104547
let arg = ([], lbl, typ1) in
104546-
process attrsBefore (arg :: acc) typ2
104548+
process attrsBefore (arg :: acc) typ2 (arity - 1)
104547104549
| {
104548104550
ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2);
104549104551
ptyp_attributes = [({txt = "bs"}, _)];
@@ -104560,14 +104562,14 @@ let arrowType ct =
104560104562
ptyp_attributes = attrs;
104561104563
} ->
104562104564
let arg = (attrs, lbl, typ1) in
104563-
process attrsBefore (arg :: acc) typ2
104565+
process attrsBefore (arg :: acc) typ2 (arity - 1)
104564104566
| typ -> (attrsBefore, List.rev acc, typ)
104565104567
in
104566104568
match ct with
104567104569
| {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as
104568104570
typ ->
104569-
process attrs [] {typ with ptyp_attributes = []}
104570-
| typ -> process [] [] typ
104571+
process attrs [] {typ with ptyp_attributes = []} arity
104572+
| typ -> process [] [] typ arity
104571104573

104572104574
let functorType modtype =
104573104575
let rec process acc modtype =
@@ -109607,8 +109609,10 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl =
109607109609
])
109608109610

109609109611
and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
109610-
let printArrow ~uncurried typExpr =
109611-
let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in
109612+
let printArrow ~uncurried ?(arity = max_int) typExpr =
109613+
let attrsBefore, args, returnType =
109614+
ParsetreeViewer.arrowType ~arity typExpr
109615+
in
109612109616
let dotted, attrsBefore =
109613109617
(* Converting .ml code to .res requires processing uncurried attributes *)
109614109618
let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in
@@ -109713,12 +109717,16 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
109713109717
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) ->
109714109718
let unitConstr = Location.mkloc (Longident.Lident "unit") tArg.ptyp_loc in
109715109719
let tUnit = Ast_helper.Typ.constr unitConstr [] in
109716-
printArrow ~uncurried:true
109720+
printArrow ~uncurried:true ~arity:1
109717109721
{tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)}
109718109722
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg])
109719109723
when String.length arity >= 5
109720109724
&& (String.sub [@doesNotRaise]) arity 0 5 = "arity" ->
109721-
printArrow ~uncurried:true tArg
109725+
let arity =
109726+
int_of_string
109727+
((String.sub [@doesNotRaise]) arity 5 (String.length arity - 5))
109728+
in
109729+
printArrow ~uncurried:true ~arity tArg
109722109730
| Ptyp_constr (longidentLoc, [{ptyp_desc = Ptyp_object (fields, openFlag)}])
109723109731
->
109724109732
(* for foo<{"a": b}>, when the object is long and needs a line break, we

‎res_syntax/src/res_parsetree_viewer.ml

+7-6
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,15 @@
11
open Parsetree
22

3-
let arrowType ct =
4-
let rec process attrsBefore acc typ =
3+
let arrowType ?(arity = max_int) ct =
4+
let rec process attrsBefore acc typ arity =
55
match typ with
6+
| typ when arity <= 0 -> (attrsBefore, List.rev acc, typ)
67
| {
78
ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2);
89
ptyp_attributes = [];
910
} ->
1011
let arg = ([], lbl, typ1) in
11-
process attrsBefore (arg :: acc) typ2
12+
process attrsBefore (arg :: acc) typ2 (arity - 1)
1213
| {
1314
ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2);
1415
ptyp_attributes = [({txt = "bs"}, _)];
@@ -25,14 +26,14 @@ let arrowType ct =
2526
ptyp_attributes = attrs;
2627
} ->
2728
let arg = (attrs, lbl, typ1) in
28-
process attrsBefore (arg :: acc) typ2
29+
process attrsBefore (arg :: acc) typ2 (arity - 1)
2930
| typ -> (attrsBefore, List.rev acc, typ)
3031
in
3132
match ct with
3233
| {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as
3334
typ ->
34-
process attrs [] {typ with ptyp_attributes = []}
35-
| typ -> process [] [] typ
35+
process attrs [] {typ with ptyp_attributes = []} arity
36+
| typ -> process [] [] typ arity
3637

3738
let functorType modtype =
3839
let rec process acc modtype =

‎res_syntax/src/res_parsetree_viewer.mli

+1
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
* The parsetree contains: a => b => c => d, for printing purposes
33
* we restructure the tree into (a, b, c) and its returnType d *)
44
val arrowType :
5+
?arity:int ->
56
Parsetree.core_type ->
67
Parsetree.attributes
78
* (Parsetree.attributes * Asttypes.arg_label * Parsetree.core_type) list

‎res_syntax/src/res_printer.ml

+10-4
Original file line numberDiff line numberDiff line change
@@ -1548,8 +1548,10 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl =
15481548
])
15491549

15501550
and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
1551-
let printArrow ~uncurried typExpr =
1552-
let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in
1551+
let printArrow ~uncurried ?(arity = max_int) typExpr =
1552+
let attrsBefore, args, returnType =
1553+
ParsetreeViewer.arrowType ~arity typExpr
1554+
in
15531555
let dotted, attrsBefore =
15541556
(* Converting .ml code to .res requires processing uncurried attributes *)
15551557
let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in
@@ -1654,12 +1656,16 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
16541656
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) ->
16551657
let unitConstr = Location.mkloc (Longident.Lident "unit") tArg.ptyp_loc in
16561658
let tUnit = Ast_helper.Typ.constr unitConstr [] in
1657-
printArrow ~uncurried:true
1659+
printArrow ~uncurried:true ~arity:1
16581660
{tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)}
16591661
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg])
16601662
when String.length arity >= 5
16611663
&& (String.sub [@doesNotRaise]) arity 0 5 = "arity" ->
1662-
printArrow ~uncurried:true tArg
1664+
let arity =
1665+
int_of_string
1666+
((String.sub [@doesNotRaise]) arity 5 (String.length arity - 5))
1667+
in
1668+
printArrow ~uncurried:true ~arity tArg
16631669
| Ptyp_constr (longidentLoc, [{ptyp_desc = Ptyp_object (fields, openFlag)}])
16641670
->
16651671
(* for foo<{"a": b}>, when the object is long and needs a line break, we

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

+2-2
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ 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
14+
type bTyp = (. string) => string => int
1515
type cTyp2 = (string, string) => int
1616
type uTyp2 = (.string, string) => int
1717

@@ -31,6 +31,6 @@ let cFun2Dots = (.x, .y) => 3 // redundant dot on y
3131
type cTyp = (. string) => int
3232
type uTyp = string => int
3333
type mixTyp = (.string) => (string, string) => (.string, string, string, string) => string => int
34-
// type bTyp = string => (. string) => int
34+
type bTyp = string => (. string) => int
3535
type cTyp2 = (. string, string) => int
3636
type uTyp2 = (string, string) => int

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

+4-4
Original file line numberDiff line numberDiff line change
@@ -10,8 +10,8 @@ let uFun2 = (. x, y) => 3
1010

1111
type cTyp = string => int
1212
type uTyp = (. string) => int
13-
type mixTyp = string => (. string, string, string, string, string, string) => (. string) => int
14-
// type bTyp = (. string) => string => int
13+
type mixTyp = string => (. string, string) => (string, string, string, string) => (. string) => int
14+
type bTyp = (. string) => string => int
1515
type cTyp2 = (string, string) => int
1616
type uTyp2 = (. string, string) => int
1717

@@ -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
34-
// type bTyp = string => (. string) => int
33+
type mixTyp = (. string) => (string, string) => (. string, string, string, string) => string => int
34+
type bTyp = string => (. string) => int
3535
type cTyp2 = (. string, string) => int
3636
type uTyp2 = (string, string) => int

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -140,5 +140,5 @@ let c1 = @foo x => @bar y => x + y
140140
let c2 = (. x) => {y => x + y}
141141
let c3 = (. x) => {@foo y => x + y}
142142

143-
type t1 = (. int, string) => bool
143+
type t1 = (. int) => string => bool
144144
type t2 = (. int, string) => bool

0 commit comments

Comments
 (0)