Skip to content

Commit 85d99fb

Browse files
authored
Merge pull request #9223 from richcarl/apply-precedence
Make function application left associative so it can be chained OTP-19866
2 parents b353a1a + 9af30ee commit 85d99fb

File tree

3 files changed

+28
-12
lines changed

3 files changed

+28
-12
lines changed

lib/compiler/test/apply_SUITE.erl

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,9 +23,9 @@
2323

2424
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
2525
init_per_group/2,end_per_group/2,
26-
mfa/1,fun_apply/1,involved/1]).
26+
mfa/1,fun_apply/1,precedence/1,involved/1]).
2727

28-
-export([foo/0,bar/1,baz/2]).
28+
-export([foo/0,bar/1,baz/2,get_callback/0]).
2929

3030
-include_lib("common_test/include/ct.hrl").
3131

@@ -38,6 +38,7 @@ groups() ->
3838
[{p,test_lib:parallel(),
3939
[mfa,
4040
fun_apply,
41+
precedence,
4142
involved
4243
]}].
4344

@@ -139,6 +140,12 @@ fun_apply(Config) when is_list(Config) ->
139140

140141
ok.
141142

143+
get_callback() ->
144+
lists.
145+
146+
precedence(_Config) ->
147+
[3,2,1] = ?MODULE:get_callback():reverse([1,2,3]).
148+
142149
involved(_Config) ->
143150
self() ! message,
144151
ok = involved_1(),

lib/compiler/test/fun_SUITE.erl

Lines changed: 12 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@
2626
test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1,
2727
external/1,eep37/1,badarity/1,badfun/1,
2828
duplicated_fun/1,unused_fun/1,parallel_scopes/1,
29-
coverage/1,leaky_environment/1]).
29+
coverage/1,leaky_environment/1,chain/1]).
3030

3131
%% Internal exports.
3232
-export([call_me/1,dup1/0,dup2/0]).
@@ -40,7 +40,7 @@ all() ->
4040

4141
groups() ->
4242
[{p,[parallel],
43-
[test1,overwritten_fun,otp_7202,bif_fun,external,eep37,
43+
[test1,overwritten_fun,otp_7202,bif_fun,external,eep37,chain,
4444
badarity,badfun,duplicated_fun,unused_fun,
4545
parallel_scopes,
4646
coverage,leaky_environment]}].
@@ -204,13 +204,16 @@ external(Config) when is_list(Config) ->
204204

205205
42 = (fun erlang:abs/1)(-42),
206206
42 = (id(fun erlang:abs/1))(-42),
207+
42 = id(fun erlang:abs/1)(-42),
207208
42 = apply(fun erlang:abs/1, [-42]),
208209
42 = apply(id(fun erlang:abs/1), [-42]),
209210
6 = (fun lists:sum/1)([1,2,3]),
210211
6 = (id(fun lists:sum/1))([1,2,3]),
212+
6 = id(fun lists:sum/1)([1,2,3]),
211213

212214
{'EXIT',{{badarity,_},_}} = (catch (fun lists:sum/1)(1, 2, 3)),
213215
{'EXIT',{{badarity,_},_}} = (catch (id(fun lists:sum/1))(1, 2, 3)),
216+
{'EXIT',{{badarity,_},_}} = (catch id(fun lists:sum/1)(1, 2, 3)),
214217
{'EXIT',{{badarity,_},_}} = (catch apply(fun lists:sum/1, [1,2,3])),
215218

216219
{'EXIT',{badarg,_}} = (catch bad_external_fun()),
@@ -225,6 +228,11 @@ bad_external_fun() ->
225228
fun V0:V0/V0, %Should fail.
226229
never_reached.
227230

231+
chain(_Config) ->
232+
F3 = fun (A, B, C) -> {ok, (A + B) * C} end,
233+
F0 = fun (A) -> fun (B) -> fun (C) -> F3(A,B,C) end end end,
234+
{ok, 42} = F0(-2)(9)(6).
235+
228236
%% Named funs.
229237
eep37(_Config) ->
230238
eep37_basic(),
@@ -243,7 +251,9 @@ eep37_basic() ->
243251

244252
eep37_dup() ->
245253
dup1 = (dup1())(),
254+
dup1 = dup1()(),
246255
dup2 = (dup2())(),
256+
dup2 = dup2()(),
247257
ok.
248258

249259
dup1() ->

lib/stdlib/src/erl_parse.yrl

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -114,6 +114,7 @@ Left 400 add_op.
114114
Left 500 mult_op.
115115
Unary 600 prefix_op.
116116
Nonassoc 700 '#'.
117+
Left 750 '('.
117118
Nonassoc 800 ':'.
118119
Nonassoc 900 clause_body_exprs.
119120

@@ -271,9 +272,9 @@ expr -> map_expr : '$1'.
271272
expr -> function_call : '$1'.
272273
expr -> record_expr : '$1'.
273274
expr -> expr_remote : '$1'.
275+
expr -> expr_max : '$1'.
274276

275-
expr_remote -> expr_max ':' expr_max : {remote,?anno('$2'),'$1','$3'}.
276-
expr_remote -> expr_max : '$1'.
277+
expr_remote -> expr ':' expr : {remote,?anno('$2'),'$1','$3'}.
277278

278279
expr_max -> var : '$1'.
279280
expr_max -> atomic : '$1'.
@@ -433,11 +434,8 @@ record_fields -> record_field ',' record_fields : ['$1' | '$3'].
433434
record_field -> var '=' expr : {record_field,?anno('$1'),'$1','$3'}.
434435
record_field -> atom '=' expr : {record_field,?anno('$1'),'$1','$3'}.
435436

436-
%% N.B. This is called from expr.
437-
438-
function_call -> expr_remote argument_list :
439-
{call,first_anno('$1'),'$1',element(1, '$2')}.
440-
437+
function_call -> expr argument_list :
438+
{call,first_anno('$1'),'$1',element(1, '$2')}.
441439

442440
if_expr -> 'if' if_clauses 'end' : {'if',?anno('$1'),'$2'}.
443441

@@ -2037,7 +2035,8 @@ inop_prec('div') -> {500,500,600};
20372035
inop_prec('rem') -> {500,500,600};
20382036
inop_prec('band') -> {500,500,600};
20392037
inop_prec('and') -> {500,500,600};
2040-
inop_prec('#') -> {800,700,800};
2038+
inop_prec('#') -> {750,700,750};
2039+
inop_prec('(') -> {750,750,800};
20412040
inop_prec(':') -> {900,800,900};
20422041
inop_prec('.') -> {900,900,1000}.
20432042

0 commit comments

Comments
 (0)