Skip to content

Commit 34c509a

Browse files
cristianoccristianoc
committed
Test: don't emit arity zero from the parser.
1 parent 2209d76 commit 34c509a

File tree

17 files changed

+126
-112
lines changed

17 files changed

+126
-112
lines changed

‎jscomp/frontend/ast_uncurry_apply.ml

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,18 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression)
5959
(Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) });
6060
] ->
6161
[]
62+
| [
63+
( Nolabel,
64+
({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) }
65+
as e) );
66+
] ->
67+
[
68+
( Asttypes.Nolabel,
69+
{
70+
e with
71+
pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None);
72+
} );
73+
]
6274
| _ -> args
6375
in
6476
let arity = List.length args in

‎jscomp/test/UncurriedExternals.js

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,8 @@ var te = (function (prim) {
3232
RE_EXN_ID: "Not_found"
3333
});
3434

35+
var tcr = {};
36+
3537
var StandardNotation = {
3638
dd: dd,
3739
h: h,
@@ -40,7 +42,8 @@ var StandardNotation = {
4042
mf: mf,
4143
tg: tg,
4244
tc: tc,
43-
te: te
45+
te: te,
46+
tcr: tcr
4447
};
4548

4649
function dd$1(param) {
@@ -74,6 +77,8 @@ var te$1 = (function (prim) {
7477
RE_EXN_ID: "Not_found"
7578
});
7679

80+
var tcr$1 = {};
81+
7782
exports.StandardNotation = StandardNotation;
7883
exports.dd = dd$1;
7984
exports.h = h$1;
@@ -83,4 +88,5 @@ exports.mf = mf$1;
8388
exports.tg = tg$1;
8489
exports.tc = tc$1;
8590
exports.te = te$1;
91+
exports.tcr = tcr$1;
8692
/* h Not a pure module */

‎jscomp/test/UncurriedExternals.res

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,9 @@ module StandardNotation = {
2323

2424
external toException: (. exn) => exn = "%identity"
2525
let te = toException(. Not_found)
26+
27+
@obj external ccreate : () => string = ""
28+
let tcr = ccreate()
2629
}
2730

2831
@@uncurried
@@ -51,3 +54,6 @@ let tc = copy("abc")
5154

5255
external toException: exn => exn = "%identity"
5356
let te = toException(Not_found)
57+
58+
@obj external ucreate : unit => string = ""
59+
let tcr = ucreate( (():unit))

‎jscomp/test/reactTestUtils.js

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -7,14 +7,14 @@ var Caml_option = require("../../lib/js/caml_option.js");
77
var TestUtils = require("react-dom/test-utils");
88

99
function act(func) {
10-
var reactFunc = function () {
10+
var reactFunc = function (param) {
1111
Curry._1(func, undefined);
1212
};
1313
TestUtils.act(reactFunc);
1414
}
1515

1616
function actAsync(func) {
17-
return TestUtils.act(function () {
17+
return TestUtils.act(function (param) {
1818
return Curry._1(func, undefined);
1919
});
2020
}

‎jscomp/test/uncurried_cast.js

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -76,7 +76,7 @@ var StandardNotation = {
7676
anInt: anInt
7777
};
7878

79-
function testRaise$1() {
79+
function testRaise$1(param) {
8080
return raise({
8181
RE_EXN_ID: E
8282
});

‎lib/4.06.1/unstable/js_compiler.ml

Lines changed: 15 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -54768,12 +54768,6 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
5476854768
| Ptyp_object (fields, openFlag) ->
5476954769
printObject ~state ~inline:false fields openFlag cmtTbl
5477054770
| Ptyp_arrow _ -> printArrow ~uncurried:false typExpr
54771-
| Ptyp_constr ({txt = Lident "()"}, []) -> Doc.text "()"
54772-
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) ->
54773-
let parensConstr = Location.mkloc (Longident.Lident "()") tArg.ptyp_loc in
54774-
let tUnit = Ast_helper.Typ.constr parensConstr [] in
54775-
printArrow ~uncurried:true ~arity:1
54776-
{tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)}
5477754771
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg])
5477854772
when String.length arity >= 5
5477954773
&& (String.sub [@doesNotRaise]) arity 0 5 = "arity" ->
@@ -55797,7 +55791,8 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl =
5579755791
printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c
5579855792
| Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes ->
5579955793
printJsxFragment ~state e cmtTbl
55800-
| Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()"
55794+
| Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _) ->
55795+
Doc.text "()"
5580155796
| Pexp_construct ({txt = Longident.Lident "[]"}, _) ->
5580255797
Doc.concat
5580355798
[Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace]
@@ -57628,7 +57623,7 @@ and printArguments ~state ~dotted
5762857623
| [
5762957624
( Nolabel,
5763057625
{
57631-
pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _);
57626+
pexp_desc = Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _);
5763257627
pexp_loc = loc;
5763357628
} );
5763457629
] -> (
@@ -148508,6 +148503,18 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression)
148508148503
(Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) });
148509148504
] ->
148510148505
[]
148506+
| [
148507+
( Nolabel,
148508+
({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) }
148509+
as e) );
148510+
] ->
148511+
[
148512+
( Asttypes.Nolabel,
148513+
{
148514+
e with
148515+
pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None);
148516+
} );
148517+
]
148511148518
| _ -> args
148512148519
in
148513148520
let arity = List.length args in

‎lib/4.06.1/unstable/js_playground_compiler.ml

Lines changed: 25 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -54768,12 +54768,6 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
5476854768
| Ptyp_object (fields, openFlag) ->
5476954769
printObject ~state ~inline:false fields openFlag cmtTbl
5477054770
| Ptyp_arrow _ -> printArrow ~uncurried:false typExpr
54771-
| Ptyp_constr ({txt = Lident "()"}, []) -> Doc.text "()"
54772-
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) ->
54773-
let parensConstr = Location.mkloc (Longident.Lident "()") tArg.ptyp_loc in
54774-
let tUnit = Ast_helper.Typ.constr parensConstr [] in
54775-
printArrow ~uncurried:true ~arity:1
54776-
{tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)}
5477754771
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg])
5477854772
when String.length arity >= 5
5477954773
&& (String.sub [@doesNotRaise]) arity 0 5 = "arity" ->
@@ -55797,7 +55791,8 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl =
5579755791
printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c
5579855792
| Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes ->
5579955793
printJsxFragment ~state e cmtTbl
55800-
| Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()"
55794+
| Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _) ->
55795+
Doc.text "()"
5580155796
| Pexp_construct ({txt = Longident.Lident "[]"}, _) ->
5580255797
Doc.concat
5580355798
[Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace]
@@ -57628,7 +57623,7 @@ and printArguments ~state ~dotted
5762857623
| [
5762957624
( Nolabel,
5763057625
{
57631-
pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _);
57626+
pexp_desc = Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _);
5763257627
pexp_loc = loc;
5763357628
} );
5763457629
] -> (
@@ -148508,6 +148503,18 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression)
148508148503
(Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) });
148509148504
] ->
148510148505
[]
148506+
| [
148507+
( Nolabel,
148508+
({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) }
148509+
as e) );
148510+
] ->
148511+
[
148512+
( Asttypes.Nolabel,
148513+
{
148514+
e with
148515+
pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None);
148516+
} );
148517+
]
148511148518
| _ -> args
148512148519
in
148513148520
let arity = List.length args in
@@ -163990,20 +163997,14 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context
163990163997
if p.uncurried_by_default then not dotted else dotted
163991163998
in
163992163999
if uncurried && (paramNum = 1 || not p.uncurried_by_default) then
163993-
let arirtForFn =
163994-
match pat.ppat_desc with
163995-
| Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0
163996-
| _ -> arity
163997-
in
163998164000
( paramNum - 1,
163999164001
(if true then
164000164002
Ast_helper.Exp.record ~loc
164001164003
[
164002164004
( {
164003164005
txt =
164004164006
Ldot
164005-
( Ldot (Lident "Js", "Fn"),
164006-
"I" ^ string_of_int arirtForFn );
164007+
(Ldot (Lident "Js", "Fn"), "I" ^ string_of_int arity);
164007164008
loc;
164008164009
},
164009164010
funExpr );
@@ -165923,7 +165924,9 @@ and parseArgument p : argument option =
165923165924
| Rparen ->
165924165925
let unitExpr =
165925165926
Ast_helper.Exp.construct
165926-
(Location.mknoloc (Longident.Lident "()"))
165927+
(Location.mknoloc
165928+
(Longident.Lident
165929+
(if p.uncurried_by_default then "()" else "(u)")))
165927165930
None
165928165931
in
165929165932
Some {dotted; label = Asttypes.Nolabel; expr = unitExpr}
@@ -166016,7 +166019,10 @@ and parseCallExpr p funExpr =
166016166019
label = Nolabel;
166017166020
expr =
166018166021
Ast_helper.Exp.construct ~loc
166019-
(Location.mkloc (Longident.Lident "()") loc)
166022+
(Location.mkloc
166023+
(Longident.Lident
166024+
(if p.uncurried_by_default then "(u)" else "()"))
166025+
loc)
166020166026
None;
166021166027
};
166022166028
]
@@ -166674,23 +166680,14 @@ and parseEs6ArrowType ~attrs p =
166674166680
if p.uncurried_by_default then not dotted else dotted
166675166681
in
166676166682
if uncurried && (paramNum = 1 || not p.uncurried_by_default) then
166677-
let isParens =
166678-
match typ.ptyp_desc with
166679-
| Ptyp_constr ({txt = Lident "unit"; loc}, []) ->
166680-
loc.loc_end.pos_cnum - loc.loc_start.pos_cnum = 2 (* () *)
166681-
| _ -> false
166682-
in
166683166683
let loc = mkLoc startPos endPos in
166684-
let fnArity, tArg =
166685-
if isParens && arity = 1 then (0, t)
166686-
else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t)
166687-
in
166684+
let tArg = Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t in
166688166685
( paramNum - 1,
166689166686
Ast_helper.Typ.constr ~loc
166690166687
{
166691166688
txt =
166692166689
Ldot
166693-
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int fnArity);
166690+
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity);
166694166691
loc;
166695166692
}
166696166693
[tArg],

‎lib/4.06.1/whole_compiler.ml

Lines changed: 25 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -109766,12 +109766,6 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
109766109766
| Ptyp_object (fields, openFlag) ->
109767109767
printObject ~state ~inline:false fields openFlag cmtTbl
109768109768
| Ptyp_arrow _ -> printArrow ~uncurried:false typExpr
109769-
| Ptyp_constr ({txt = Lident "()"}, []) -> Doc.text "()"
109770-
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) ->
109771-
let parensConstr = Location.mkloc (Longident.Lident "()") tArg.ptyp_loc in
109772-
let tUnit = Ast_helper.Typ.constr parensConstr [] in
109773-
printArrow ~uncurried:true ~arity:1
109774-
{tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)}
109775109769
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg])
109776109770
when String.length arity >= 5
109777109771
&& (String.sub [@doesNotRaise]) arity 0 5 = "arity" ->
@@ -110795,7 +110789,8 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl =
110795110789
printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c
110796110790
| Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes ->
110797110791
printJsxFragment ~state e cmtTbl
110798-
| Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()"
110792+
| Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _) ->
110793+
Doc.text "()"
110799110794
| Pexp_construct ({txt = Longident.Lident "[]"}, _) ->
110800110795
Doc.concat
110801110796
[Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace]
@@ -112626,7 +112621,7 @@ and printArguments ~state ~dotted
112626112621
| [
112627112622
( Nolabel,
112628112623
{
112629-
pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _);
112624+
pexp_desc = Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _);
112630112625
pexp_loc = loc;
112631112626
} );
112632112627
] -> (
@@ -158792,6 +158787,18 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression)
158792158787
(Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) });
158793158788
] ->
158794158789
[]
158790+
| [
158791+
( Nolabel,
158792+
({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) }
158793+
as e) );
158794+
] ->
158795+
[
158796+
( Asttypes.Nolabel,
158797+
{
158798+
e with
158799+
pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None);
158800+
} );
158801+
]
158795158802
| _ -> args
158796158803
in
158797158804
let arity = List.length args in
@@ -177422,20 +177429,14 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context
177422177429
if p.uncurried_by_default then not dotted else dotted
177423177430
in
177424177431
if uncurried && (paramNum = 1 || not p.uncurried_by_default) then
177425-
let arirtForFn =
177426-
match pat.ppat_desc with
177427-
| Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0
177428-
| _ -> arity
177429-
in
177430177432
( paramNum - 1,
177431177433
(if true then
177432177434
Ast_helper.Exp.record ~loc
177433177435
[
177434177436
( {
177435177437
txt =
177436177438
Ldot
177437-
( Ldot (Lident "Js", "Fn"),
177438-
"I" ^ string_of_int arirtForFn );
177439+
(Ldot (Lident "Js", "Fn"), "I" ^ string_of_int arity);
177439177440
loc;
177440177441
},
177441177442
funExpr );
@@ -179355,7 +179356,9 @@ and parseArgument p : argument option =
179355179356
| Rparen ->
179356179357
let unitExpr =
179357179358
Ast_helper.Exp.construct
179358-
(Location.mknoloc (Longident.Lident "()"))
179359+
(Location.mknoloc
179360+
(Longident.Lident
179361+
(if p.uncurried_by_default then "()" else "(u)")))
179359179362
None
179360179363
in
179361179364
Some {dotted; label = Asttypes.Nolabel; expr = unitExpr}
@@ -179448,7 +179451,10 @@ and parseCallExpr p funExpr =
179448179451
label = Nolabel;
179449179452
expr =
179450179453
Ast_helper.Exp.construct ~loc
179451-
(Location.mkloc (Longident.Lident "()") loc)
179454+
(Location.mkloc
179455+
(Longident.Lident
179456+
(if p.uncurried_by_default then "(u)" else "()"))
179457+
loc)
179452179458
None;
179453179459
};
179454179460
]
@@ -180106,23 +180112,14 @@ and parseEs6ArrowType ~attrs p =
180106180112
if p.uncurried_by_default then not dotted else dotted
180107180113
in
180108180114
if uncurried && (paramNum = 1 || not p.uncurried_by_default) then
180109-
let isParens =
180110-
match typ.ptyp_desc with
180111-
| Ptyp_constr ({txt = Lident "unit"; loc}, []) ->
180112-
loc.loc_end.pos_cnum - loc.loc_start.pos_cnum = 2 (* () *)
180113-
| _ -> false
180114-
in
180115180115
let loc = mkLoc startPos endPos in
180116-
let fnArity, tArg =
180117-
if isParens && arity = 1 then (0, t)
180118-
else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t)
180119-
in
180116+
let tArg = Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t in
180120180117
( paramNum - 1,
180121180118
Ast_helper.Typ.constr ~loc
180122180119
{
180123180120
txt =
180124180121
Ldot
180125-
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int fnArity);
180122+
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity);
180126180123
loc;
180127180124
}
180128180125
[tArg],

0 commit comments

Comments
 (0)