Skip to content

Commit 0915cbc

Browse files
cristianoccristianoc
committed
Test: don't emit arity zero from the parser.
1 parent b55d5e7 commit 0915cbc

File tree

18 files changed

+138
-121
lines changed

18 files changed

+138
-121
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
@@ -54757,12 +54757,6 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
5475754757
| Ptyp_object (fields, openFlag) ->
5475854758
printObject ~state ~inline:false fields openFlag cmtTbl
5475954759
| Ptyp_arrow _ -> printArrow ~uncurried:false typExpr
54760-
| Ptyp_constr ({txt = Lident "()"}, []) -> Doc.text "()"
54761-
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) ->
54762-
let parensConstr = Location.mkloc (Longident.Lident "()") tArg.ptyp_loc in
54763-
let tUnit = Ast_helper.Typ.constr parensConstr [] in
54764-
printArrow ~uncurried:true ~arity:1
54765-
{tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)}
5476654760
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg])
5476754761
when String.length arity >= 5
5476854762
&& (String.sub [@doesNotRaise]) arity 0 5 = "arity" ->
@@ -55782,7 +55776,8 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl =
5578255776
printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c
5578355777
| Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes ->
5578455778
printJsxFragment ~state e cmtTbl
55785-
| Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()"
55779+
| Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _) ->
55780+
Doc.text "()"
5578655781
| Pexp_construct ({txt = Longident.Lident "[]"}, _) ->
5578755782
Doc.concat
5578855783
[Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace]
@@ -57606,7 +57601,7 @@ and printArguments ~state ~dotted
5760657601
| [
5760757602
( Nolabel,
5760857603
{
57609-
pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _);
57604+
pexp_desc = Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _);
5761057605
pexp_loc = loc;
5761157606
} );
5761257607
] -> (
@@ -148486,6 +148481,18 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression)
148486148481
(Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) });
148487148482
] ->
148488148483
[]
148484+
| [
148485+
( Nolabel,
148486+
({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) }
148487+
as e) );
148488+
] ->
148489+
[
148490+
( Asttypes.Nolabel,
148491+
{
148492+
e with
148493+
pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None);
148494+
} );
148495+
]
148489148496
| _ -> args
148490148497
in
148491148498
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
@@ -54757,12 +54757,6 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
5475754757
| Ptyp_object (fields, openFlag) ->
5475854758
printObject ~state ~inline:false fields openFlag cmtTbl
5475954759
| Ptyp_arrow _ -> printArrow ~uncurried:false typExpr
54760-
| Ptyp_constr ({txt = Lident "()"}, []) -> Doc.text "()"
54761-
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) ->
54762-
let parensConstr = Location.mkloc (Longident.Lident "()") tArg.ptyp_loc in
54763-
let tUnit = Ast_helper.Typ.constr parensConstr [] in
54764-
printArrow ~uncurried:true ~arity:1
54765-
{tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)}
5476654760
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg])
5476754761
when String.length arity >= 5
5476854762
&& (String.sub [@doesNotRaise]) arity 0 5 = "arity" ->
@@ -55782,7 +55776,8 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl =
5578255776
printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c
5578355777
| Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes ->
5578455778
printJsxFragment ~state e cmtTbl
55785-
| Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()"
55779+
| Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _) ->
55780+
Doc.text "()"
5578655781
| Pexp_construct ({txt = Longident.Lident "[]"}, _) ->
5578755782
Doc.concat
5578855783
[Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace]
@@ -57606,7 +57601,7 @@ and printArguments ~state ~dotted
5760657601
| [
5760757602
( Nolabel,
5760857603
{
57609-
pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _);
57604+
pexp_desc = Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _);
5761057605
pexp_loc = loc;
5761157606
} );
5761257607
] -> (
@@ -148486,6 +148481,18 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression)
148486148481
(Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) });
148487148482
] ->
148488148483
[]
148484+
| [
148485+
( Nolabel,
148486+
({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) }
148487+
as e) );
148488+
] ->
148489+
[
148490+
( Asttypes.Nolabel,
148491+
{
148492+
e with
148493+
pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None);
148494+
} );
148495+
]
148489148496
| _ -> args
148490148497
in
148491148498
let arity = List.length args in
@@ -163968,20 +163975,14 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context
163968163975
if p.uncurried_by_default then not dotted else dotted
163969163976
in
163970163977
if uncurried && (paramNum = 1 || not p.uncurried_by_default) then
163971-
let arirtForFn =
163972-
match pat.ppat_desc with
163973-
| Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0
163974-
| _ -> arity
163975-
in
163976163978
( paramNum - 1,
163977163979
(if true then
163978163980
Ast_helper.Exp.record ~loc
163979163981
[
163980163982
( {
163981163983
txt =
163982163984
Ldot
163983-
( Ldot (Lident "Js", "Fn"),
163984-
"I" ^ string_of_int arirtForFn );
163985+
(Ldot (Lident "Js", "Fn"), "I" ^ string_of_int arity);
163985163986
loc;
163986163987
},
163987163988
funExpr );
@@ -165896,7 +165897,9 @@ and parseArgument p : argument option =
165896165897
| Rparen ->
165897165898
let unitExpr =
165898165899
Ast_helper.Exp.construct
165899-
(Location.mknoloc (Longident.Lident "()"))
165900+
(Location.mknoloc
165901+
(Longident.Lident
165902+
(if p.uncurried_by_default then "()" else "(u)")))
165900165903
None
165901165904
in
165902165905
Some {dotted; label = Asttypes.Nolabel; expr = unitExpr}
@@ -165989,7 +165992,10 @@ and parseCallExpr p funExpr =
165989165992
label = Nolabel;
165990165993
expr =
165991165994
Ast_helper.Exp.construct ~loc
165992-
(Location.mkloc (Longident.Lident "()") loc)
165995+
(Location.mkloc
165996+
(Longident.Lident
165997+
(if p.uncurried_by_default then "(u)" else "()"))
165998+
loc)
165993165999
None;
165994166000
};
165995166001
]
@@ -166647,23 +166653,14 @@ and parseEs6ArrowType ~attrs p =
166647166653
if p.uncurried_by_default then not dotted else dotted
166648166654
in
166649166655
if uncurried && (paramNum = 1 || not p.uncurried_by_default) then
166650-
let isParens =
166651-
match typ.ptyp_desc with
166652-
| Ptyp_constr ({txt = Lident "unit"; loc}, []) ->
166653-
loc.loc_end.pos_cnum - loc.loc_start.pos_cnum = 2 (* () *)
166654-
| _ -> false
166655-
in
166656166656
let loc = mkLoc startPos endPos in
166657-
let fnArity, tArg =
166658-
if isParens && arity = 1 then (0, t)
166659-
else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t)
166660-
in
166657+
let tArg = Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t in
166661166658
( paramNum - 1,
166662166659
Ast_helper.Typ.constr ~loc
166663166660
{
166664166661
txt =
166665166662
Ldot
166666-
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int fnArity);
166663+
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity);
166667166664
loc;
166668166665
}
166669166666
[tArg],

‎lib/4.06.1/whole_compiler.ml

Lines changed: 25 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -109755,12 +109755,6 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
109755109755
| Ptyp_object (fields, openFlag) ->
109756109756
printObject ~state ~inline:false fields openFlag cmtTbl
109757109757
| Ptyp_arrow _ -> printArrow ~uncurried:false typExpr
109758-
| Ptyp_constr ({txt = Lident "()"}, []) -> Doc.text "()"
109759-
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) ->
109760-
let parensConstr = Location.mkloc (Longident.Lident "()") tArg.ptyp_loc in
109761-
let tUnit = Ast_helper.Typ.constr parensConstr [] in
109762-
printArrow ~uncurried:true ~arity:1
109763-
{tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)}
109764109758
| Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg])
109765109759
when String.length arity >= 5
109766109760
&& (String.sub [@doesNotRaise]) arity 0 5 = "arity" ->
@@ -110780,7 +110774,8 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl =
110780110774
printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c
110781110775
| Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes ->
110782110776
printJsxFragment ~state e cmtTbl
110783-
| Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()"
110777+
| Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _) ->
110778+
Doc.text "()"
110784110779
| Pexp_construct ({txt = Longident.Lident "[]"}, _) ->
110785110780
Doc.concat
110786110781
[Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace]
@@ -112604,7 +112599,7 @@ and printArguments ~state ~dotted
112604112599
| [
112605112600
( Nolabel,
112606112601
{
112607-
pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _);
112602+
pexp_desc = Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _);
112608112603
pexp_loc = loc;
112609112604
} );
112610112605
] -> (
@@ -158770,6 +158765,18 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression)
158770158765
(Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) });
158771158766
] ->
158772158767
[]
158768+
| [
158769+
( Nolabel,
158770+
({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) }
158771+
as e) );
158772+
] ->
158773+
[
158774+
( Asttypes.Nolabel,
158775+
{
158776+
e with
158777+
pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None);
158778+
} );
158779+
]
158773158780
| _ -> args
158774158781
in
158775158782
let arity = List.length args in
@@ -177400,20 +177407,14 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context
177400177407
if p.uncurried_by_default then not dotted else dotted
177401177408
in
177402177409
if uncurried && (paramNum = 1 || not p.uncurried_by_default) then
177403-
let arirtForFn =
177404-
match pat.ppat_desc with
177405-
| Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0
177406-
| _ -> arity
177407-
in
177408177410
( paramNum - 1,
177409177411
(if true then
177410177412
Ast_helper.Exp.record ~loc
177411177413
[
177412177414
( {
177413177415
txt =
177414177416
Ldot
177415-
( Ldot (Lident "Js", "Fn"),
177416-
"I" ^ string_of_int arirtForFn );
177417+
(Ldot (Lident "Js", "Fn"), "I" ^ string_of_int arity);
177417177418
loc;
177418177419
},
177419177420
funExpr );
@@ -179328,7 +179329,9 @@ and parseArgument p : argument option =
179328179329
| Rparen ->
179329179330
let unitExpr =
179330179331
Ast_helper.Exp.construct
179331-
(Location.mknoloc (Longident.Lident "()"))
179332+
(Location.mknoloc
179333+
(Longident.Lident
179334+
(if p.uncurried_by_default then "()" else "(u)")))
179332179335
None
179333179336
in
179334179337
Some {dotted; label = Asttypes.Nolabel; expr = unitExpr}
@@ -179421,7 +179424,10 @@ and parseCallExpr p funExpr =
179421179424
label = Nolabel;
179422179425
expr =
179423179426
Ast_helper.Exp.construct ~loc
179424-
(Location.mkloc (Longident.Lident "()") loc)
179427+
(Location.mkloc
179428+
(Longident.Lident
179429+
(if p.uncurried_by_default then "(u)" else "()"))
179430+
loc)
179425179431
None;
179426179432
};
179427179433
]
@@ -180079,23 +180085,14 @@ and parseEs6ArrowType ~attrs p =
180079180085
if p.uncurried_by_default then not dotted else dotted
180080180086
in
180081180087
if uncurried && (paramNum = 1 || not p.uncurried_by_default) then
180082-
let isParens =
180083-
match typ.ptyp_desc with
180084-
| Ptyp_constr ({txt = Lident "unit"; loc}, []) ->
180085-
loc.loc_end.pos_cnum - loc.loc_start.pos_cnum = 2 (* () *)
180086-
| _ -> false
180087-
in
180088180088
let loc = mkLoc startPos endPos in
180089-
let fnArity, tArg =
180090-
if isParens && arity = 1 then (0, t)
180091-
else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t)
180092-
in
180089+
let tArg = Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t in
180093180090
( paramNum - 1,
180094180091
Ast_helper.Typ.constr ~loc
180095180092
{
180096180093
txt =
180097180094
Ldot
180098-
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int fnArity);
180095+
(Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity);
180099180096
loc;
180100180097
}
180101180098
[tArg],

0 commit comments

Comments
 (0)