Skip to content

Commit c49a598

Browse files
author
José Valim
committed
Ensure with is tail call optimizable
Closes #6251
1 parent 86f4e3b commit c49a598

File tree

11 files changed

+173
-213
lines changed

11 files changed

+173
-213
lines changed

lib/elixir/src/elixir.hrl

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@
1212
vars=#{}, %% a map of defined variables and their alias
1313
backup_vars=nil, %% a copy of vars to be used on ^var
1414
export_vars=nil, %% a dict of all variables defined in a particular clause
15-
extra_guards=nil, %% extra guards from args expansion
15+
extra_guards=[], %% extra guards from args expansion
1616
counter=#{}, %% a map counting the variables defined
1717
file=(<<"nofile">>) %% the current scope filename
1818
}).

lib/elixir/src/elixir_clauses.erl

Lines changed: 61 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
%% fn, receive and friends. try is handled in elixir_try.
33
-module(elixir_clauses).
44
-export([match/3, clause/5, def/2, head/2,
5-
'case'/3, 'receive'/3, 'try'/3, 'cond'/3,
5+
'case'/3, 'receive'/3, 'try'/3, 'cond'/3, with/3,
66
format_error/1]).
77
-import(elixir_errors, [form_error/4]).
88
-include("elixir.hrl").
@@ -112,6 +112,66 @@ expand_receive(Meta, {'after', _}, _Acc, E) ->
112112
expand_receive(Meta, {Key, _}, _Acc, E) ->
113113
form_error(Meta, ?key(E, file), ?MODULE, {unexpected_option, 'receive', Key}).
114114

115+
%% With
116+
117+
with(Meta, Args, E) ->
118+
{Exprs, Opts0} =
119+
case elixir_utils:split_last(Args) of
120+
{_, LastArg} = SplitResult when is_list(LastArg) ->
121+
SplitResult;
122+
_ ->
123+
{Args, []}
124+
end,
125+
126+
{EExprs, {EE, HasMatch}} = lists:mapfoldl(fun expand_with/2, {E, false}, Exprs),
127+
{EDo, Opts1} = expand_with_do(Meta, Opts0, EE),
128+
{EOpts, Opts2} = expand_with_else(Meta, Opts1, E, HasMatch),
129+
130+
case Opts2 of
131+
[{Key, _} | _] ->
132+
form_error(Meta, ?key(E, file), elixir_clauses, {unexpected_option, with, Key});
133+
[] ->
134+
ok
135+
end,
136+
137+
{{with, Meta, EExprs ++ [[{do, EDo} | EOpts]]}, E}.
138+
139+
expand_with({'<-', Meta, [{Name, _, Ctx}, _] = Args}, Acc) when is_atom(Name), is_atom(Ctx) ->
140+
expand_with({'=', Meta, Args}, Acc);
141+
expand_with({'<-', Meta, [Left, Right]}, {E, _HasMatch}) ->
142+
{ERight, ER} = elixir_expand:expand(Right, E),
143+
{[ELeft], EL} = head([Left], E),
144+
{{'<-', Meta, [ELeft, ERight]}, {elixir_env:mergev(EL, ER), true}};
145+
expand_with(Expr, {E, HasMatch}) ->
146+
{EExpr, EE} = elixir_expand:expand(Expr, E),
147+
{EExpr, {EE, HasMatch}}.
148+
149+
expand_with_do(Meta, Opts, E) ->
150+
case lists:keytake(do, 1, Opts) of
151+
{value, {do, Expr}, RestOpts} ->
152+
{EExpr, _} = elixir_expand:expand(Expr, E),
153+
{EExpr, RestOpts};
154+
false ->
155+
form_error(Meta, ?key(E, file), elixir_expand, {missing_option, 'with', [do]})
156+
end.
157+
158+
expand_with_else(Meta, Opts, E, HasMatch) ->
159+
case lists:keytake(else, 1, Opts) of
160+
{value, Pair, RestOpts} ->
161+
if
162+
HasMatch ->
163+
ok;
164+
true ->
165+
Message = "\"else\" clauses will never match because all patterns in \"with\" will always match",
166+
elixir_errors:warn(?line(Meta), ?key(E, file), Message)
167+
end,
168+
Fun = expand_one(Meta, 'with', 'else', fun head/2),
169+
EPair = expand_without_export(Meta, 'with', Fun, Pair, E),
170+
{[EPair], RestOpts};
171+
false ->
172+
{[], Opts}
173+
end.
174+
115175
%% Try
116176

117177
'try'(Meta, [], E) ->

lib/elixir/src/elixir_erl_clauses.erl

Lines changed: 7 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,20 +1,16 @@
11
%% Handle code related to args, guard and -> matching for case,
22
%% fn, receive and friends. try is handled in elixir_erl_try.
33
-module(elixir_erl_clauses).
4-
-export([match/3, clause/6, clauses/3, guards/3, get_clauses/3, get_clauses/4]).
4+
-export([match/3, clause/6, clauses/3, guards/3, get_clauses/3]).
55
-include("elixir.hrl").
66

77
%% Get clauses under the given key.
88

99
get_clauses(Key, Keyword, As) ->
10-
get_clauses(Key, Keyword, As, false).
11-
get_clauses(Key, Keyword, As, AllowNil) ->
1210
case lists:keyfind(Key, 1, Keyword) of
1311
{Key, Clauses} when is_list(Clauses) ->
1412
[{As, Meta, Left, Right} || {'->', Meta, [Left, Right]} <- Clauses];
15-
{Key, nil} when AllowNil ->
16-
[];
17-
false ->
13+
_ ->
1814
[]
1915
end.
2016

@@ -28,19 +24,16 @@ match(Fun, Args, S) -> Fun(Args, S).
2824
%% Translate clauses with args, guards and expressions
2925

3026
clause(Meta, Fun, Args, Expr, Guards, S) when is_list(Meta) ->
31-
{TArgs, SA} = match(Fun, Args, S#elixir_erl{extra_guards=[]}),
32-
{TExpr, SE} = elixir_erl_pass:translate(Expr,
33-
SA#elixir_erl{extra_guards=nil, export_vars=S#elixir_erl.export_vars}),
34-
35-
Extra = SA#elixir_erl.extra_guards,
36-
TGuards = guards(Guards, Extra, SA),
27+
{TArgs, SA} = match(Fun, Args, S),
28+
SG = SA#elixir_erl{extra_guards=[]},
29+
TGuards = guards(Guards, SA#elixir_erl.extra_guards, SG),
30+
{TExpr, SE} = elixir_erl_pass:translate(Expr, SG#elixir_erl{export_vars=S#elixir_erl.export_vars}),
3731
{{clause, ?ann(Meta), TArgs, TGuards, unblock(TExpr)}, SE}.
3832

3933
% Translate/Extract guards from the given expression.
4034

4135
guards(Guards, Extra, S) ->
42-
SG = S#elixir_erl{context=guard, extra_guards=nil},
43-
36+
SG = S#elixir_erl{context=guard},
4437
case Guards of
4538
[] -> case Extra of [] -> []; _ -> [Extra] end;
4639
_ -> [translate_guard(Guard, Extra, SG) || Guard <- Guards]

lib/elixir/src/elixir_erl_for.erl

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -50,11 +50,11 @@ translate_gen(_Meta, Left, Right, T, S) ->
5050
{TRight, SR} = elixir_erl_pass:translate(Right, S),
5151
{LeftArgs, LeftGuards} = elixir_utils:extract_guards(Left),
5252
{TLeft, SL} = elixir_erl_clauses:match(fun elixir_erl_pass:translate/2, LeftArgs,
53-
SR#elixir_erl{extra=pin_guard, extra_guards=[]}),
53+
SR#elixir_erl{extra=pin_guard}),
5454

5555
TLeftGuards = elixir_erl_clauses:guards(LeftGuards, [], SL),
5656
ExtraGuards = [{nil, X} || X <- SL#elixir_erl.extra_guards],
57-
SF = SL#elixir_erl{extra=S#elixir_erl.extra, extra_guards=nil},
57+
SF = SL#elixir_erl{extra=S#elixir_erl.extra, extra_guards=[]},
5858

5959
{TT, {TFilters, TS}} = translate_filters(T, SF),
6060

lib/elixir/src/elixir_erl_pass.erl

Lines changed: 56 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,7 @@ translate({'__CALLER__', Meta, Atom}, #elixir_erl{def=Kind}=S) when is_atom(Atom
4646
{{atom, ?ann(Meta), nil}, S}
4747
end;
4848

49-
translate({'super', Meta, [{Kind,Name}|Args]}, S) ->
49+
translate({'super', Meta, [{Kind, Name} | Args]}, S) ->
5050
%% In the expanded AST, super is used to invoke a function
5151
%% in the current module originated from a default clause
5252
%% or a super call.
@@ -76,8 +76,8 @@ translate({'&', Meta, [{'/', _, [{Fun, _, Atom}, Arity]}]}, S)
7676
translate({fn, Meta, Clauses}, S) ->
7777
Transformer = fun({'->', CMeta, [ArgsWithGuards, Expr]}, Acc) ->
7878
{Args, Guards} = elixir_utils:extract_splat_guards(ArgsWithGuards),
79-
{TClause, TS } = elixir_erl_clauses:clause(CMeta, fun translate_fn_match/2,
80-
Args, Expr, Guards, Acc),
79+
{TClause, TS} = elixir_erl_clauses:clause(CMeta, fun translate_fn_match/2,
80+
Args, Expr, Guards, Acc),
8181
{TClause, elixir_erl_var:mergec(S, TS)}
8282
end,
8383
{TClauses, NS} = lists:mapfoldl(Transformer, S, Clauses),
@@ -107,29 +107,28 @@ translate({'case', Meta, [Expr, Opts]}, S) ->
107107
%% Try
108108

109109
translate({'try', Meta, [Opts]}, S) ->
110-
SN = S#elixir_erl{extra=nil},
111110
Do = proplists:get_value('do', Opts, nil),
112-
{TDo, SB} = translate(Do, SN),
111+
{TDo, SB} = translate(Do, S),
113112

114113
Catch = [Tuple || {X, _} = Tuple <- Opts, X == 'rescue' orelse X == 'catch'],
115-
{TCatch, SC} = elixir_erl_try:clauses(Meta, Catch, mergec(SN, SB)),
114+
{TCatch, SC} = elixir_erl_try:clauses(Meta, Catch, mergec(S, SB)),
116115

117116
{TAfter, SA} = case lists:keyfind('after', 1, Opts) of
118117
{'after', After} ->
119-
{TBlock, SAExtracted} = translate(After, mergec(SN, SC)),
118+
{TBlock, SAExtracted} = translate(After, mergec(S, SC)),
120119
{unblock(TBlock), SAExtracted};
121120
false ->
122-
{[], mergec(SN, SC)}
121+
{[], mergec(S, SC)}
123122
end,
124123

125124
Else = elixir_erl_clauses:get_clauses(else, Opts, match),
126-
{TElse, SE} = elixir_erl_clauses:clauses(Meta, Else, mergec(SN, SA)),
125+
{TElse, SE} = elixir_erl_clauses:clauses(Meta, Else, mergec(S, SA)),
127126
{{'try', ?ann(Meta), unblock(TDo), TElse, TCatch, TAfter}, mergec(S, SE)};
128127

129128
%% Receive
130129

131130
translate({'receive', Meta, [Opts]}, S) ->
132-
Do = elixir_erl_clauses:get_clauses(do, Opts, match, true),
131+
Do = elixir_erl_clauses:get_clauses(do, Opts, match),
133132

134133
case lists:keyfind('after', 1, Opts) of
135134
false ->
@@ -143,11 +142,17 @@ translate({'receive', Meta, [Opts]}, S) ->
143142
{{'receive', ?ann(Meta), FClauses, FExpr, FAfter}, SC}
144143
end;
145144

146-
%% Comprehensions
145+
%% Comprehensions and with
147146

148147
translate({for, Meta, [_ | _] = Args}, S) ->
149148
elixir_erl_for:translate(Meta, Args, true, S);
150149

150+
translate({with, Meta, [_ | _] = Args}, S) ->
151+
{Exprs, [{do, Do} | Opts]} = elixir_utils:split_last(Args),
152+
{ElseClause, SE} = translate_with_else(Meta, Opts, S),
153+
{With, SD} = translate_with_do(Exprs, Do, ElseClause, elixir_erl_var:mergec(S, SE)),
154+
{With, elixir_erl_var:mergec(S, SD)};
155+
151156
%% Variables
152157

153158
translate({'^', Meta, [{Name, VarMeta, Kind}]}, #elixir_erl{context=match, file=File} = S) when is_atom(Name), is_atom(Kind) ->
@@ -240,10 +245,10 @@ translate(Other, S) ->
240245
translate_case(true, Meta, Expr, Opts, S) ->
241246
Clauses = elixir_erl_clauses:get_clauses(do, Opts, match),
242247
{TExpr, SE} = translate(Expr, S),
243-
{TClauses, SC} = elixir_erl_clauses:clauses(Meta, Clauses, SE#elixir_erl{extra=nil}),
244-
{{'case', ?ann(Meta), TExpr, TClauses}, SC#elixir_erl{extra=SE#elixir_erl.extra}};
248+
{TClauses, SC} = elixir_erl_clauses:clauses(Meta, Clauses, SE),
249+
{{'case', ?ann(Meta), TExpr, TClauses}, SC};
245250
translate_case(false, Meta, Expr, Opts, S) ->
246-
{Case, SC} = translate_case(true, Meta, Expr, Opts, S#elixir_erl{extra=nil}),
251+
{Case, SC} = translate_case(true, Meta, Expr, Opts, S),
247252
{Case, elixir_erl_var:mergec(S, SC)}.
248253

249254
translate_list([{'|', _, [_, _]=Args}], Fun, Acc, List) ->
@@ -355,6 +360,43 @@ returns_boolean(Condition, Body) ->
355360
false -> false
356361
end.
357362

363+
%% with
364+
365+
translate_with_else(Meta, [], S) ->
366+
Ann = ?ann(?generated(Meta)),
367+
{VarName, _, SC} = elixir_erl_var:build('_', S),
368+
Var = {var, Ann, VarName},
369+
{{clause, Ann, [Var], [], [Var]}, SC};
370+
translate_with_else(Meta, [{else, Else}], S) ->
371+
Generated = ?generated(Meta),
372+
ElseVarEx = {else, Generated, ?var_context},
373+
{ElseVarErl, SV} = elixir_erl_var:assign(Generated, else, ?var_context, S),
374+
375+
RaiseVar = {catch_all, Generated, ?var_context},
376+
RaiseExpr = {{'.', Generated, [erlang, error]}, Generated, [{with_clause, RaiseVar}]},
377+
RaiseClause = {'->', Generated, [[RaiseVar], RaiseExpr]},
378+
379+
Case = {'case', [{export_vars, false} | Meta], [ElseVarEx, [{do, Else ++ [RaiseClause]}]]},
380+
{TranslatedCase, SC} = elixir_erl_pass:translate(Case, SV),
381+
{{clause, ?ann(Generated), [ElseVarErl], [], [TranslatedCase]}, SC}.
382+
383+
translate_with_do([{'<-', Meta, [Left, Expr]} | Rest], Do, Else, S) ->
384+
{Args, Guards} = elixir_utils:extract_guards(Left),
385+
{TExpr, SR} = elixir_erl_pass:translate(Expr, S),
386+
{TArgs, SA} = elixir_erl_clauses:match(fun elixir_erl_pass:translate/2, Args, SR),
387+
TGuards = elixir_erl_clauses:guards(Guards, [], SA),
388+
{TBody, SB} = translate_with_do(Rest, Do, Else, SA),
389+
390+
Ann = ?ann(?generated(Meta)),
391+
Clause = {clause, Ann, [TArgs], TGuards, unblock(TBody)},
392+
{{'case', Ann, TExpr, [Clause, Else]}, SB};
393+
translate_with_do([Expr | Rest], Do, Else, S) ->
394+
{TExpr, TS} = elixir_erl_pass:translate(Expr, S),
395+
{TRest, RS} = translate_with_do(Rest, Do, Else, TS),
396+
{{block, 0, [TExpr | unblock(TRest)]}, RS};
397+
translate_with_do([], Do, _Else, S) ->
398+
elixir_erl_pass:translate(Do, S).
399+
358400
%% Maps and structs
359401

360402
translate_map(Meta, [{'|', _Meta, [Update, Assocs]}], S) ->

lib/elixir/src/elixir_erl_try.erl

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -28,14 +28,14 @@ each_clause({'catch', Meta, Raw, Expr}, S) ->
2828

2929
each_clause({rescue, Meta, [{in, _, [Left, Right]}], Expr}, S) ->
3030
{TempName, _, CS} = elixir_erl_var:build('_', S),
31-
TempVar = {TempName, Meta, 'Elixir'},
31+
TempVar = {TempName, Meta, ?var_context},
3232
{Parts, Safe, FS} = rescue_guards(Meta, TempVar, Right, CS),
3333
Body = rescue_clause_body(Left, Expr, Safe, TempVar, Meta),
3434
build_rescue(Meta, Parts, Body, FS);
3535

3636
each_clause({rescue, Meta, [{VarName, _, Context} = Left], Expr}, S) when is_atom(VarName), is_atom(Context) ->
3737
{TempName, _, CS} = elixir_erl_var:build('_', S),
38-
TempVar = {TempName, Meta, 'Elixir'},
38+
TempVar = {TempName, Meta, ?var_context},
3939
Body = rescue_clause_body(Left, Expr, false, TempVar, Meta),
4040
build_rescue(Meta, [{TempVar, []}], Body, CS).
4141

lib/elixir/src/elixir_erl_var.erl

Lines changed: 32 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
%% Convenience functions used to manipulate scope and its variables.
22
-module(elixir_erl_var).
3-
-export([translate/4, build/2,
3+
-export([translate/4, build/2, assign/4,
44
load_binding/2, dump_binding/2,
55
mergev/2, mergec/2, merge_vars/2, merge_opt_vars/2,
66
warn_unsafe_var/4, format_error/1
@@ -10,57 +10,59 @@
1010
%% VAR HANDLING
1111

1212
translate(Meta, Name, Kind, S) when is_atom(Kind); is_integer(Kind) ->
13-
Ann = ?ann(Meta),
1413
Tuple = {Name, Kind},
15-
Vars = S#elixir_erl.vars,
16-
BackupVars = S#elixir_erl.backup_vars,
1714

1815
{Current, Safe} =
19-
case maps:find({Name, Kind}, Vars) of
16+
case maps:find(Tuple, S#elixir_erl.vars) of
2017
{ok, {VarC, _, VarS}} -> {VarC, VarS};
2118
error -> {nil, true}
2219
end,
2320

2421
case S#elixir_erl.context of
2522
match ->
2623
Previous =
27-
case maps:find({Name, Kind}, BackupVars) of
24+
case maps:find(Tuple, S#elixir_erl.backup_vars) of
2825
{ok, {BackupVarC, _, _}} -> BackupVarC;
2926
error -> nil
3027
end,
3128

3229
if
3330
Current /= nil, Current /= Previous ->
34-
{{var, Ann, Current}, S};
31+
{{var, ?ann(Meta), Current}, S};
3532
true ->
36-
%% We attempt to give vars a nice name because we
37-
%% still use the unused vars warnings from erl_lint.
38-
%%
39-
%% Once we move the warning to Elixir compiler, we
40-
%% can name vars as _@COUNTER.
41-
{NewVar, Counter, NS} =
42-
if
43-
Kind /= nil ->
44-
build('_', S);
45-
true ->
46-
build(Name, S)
47-
end,
48-
49-
FS = NS#elixir_erl{
50-
vars=maps:put(Tuple, {NewVar, Counter, true}, Vars),
51-
export_vars=case S#elixir_erl.export_vars of
52-
nil -> nil;
53-
EV -> maps:put(Tuple, {NewVar, Counter, true}, EV)
54-
end
55-
},
56-
57-
{{var, Ann, NewVar}, FS}
33+
assign(Meta, Name, Kind, S)
5834
end;
5935
_ when Current /= nil ->
6036
warn_unsafe_var(Meta, S#elixir_erl.file, Name, Safe),
61-
{{var, Ann, Current}, S}
37+
{{var, ?ann(Meta), Current}, S}
6238
end.
6339

40+
assign(Meta, Name, Kind, S) ->
41+
Tuple = {Name, Kind},
42+
43+
%% We attempt to give vars a nice name because we
44+
%% still use the unused vars warnings from erl_lint.
45+
%%
46+
%% Once we move the warning to Elixir compiler, we
47+
%% can name vars as _@COUNTER.
48+
{NewVar, Counter, NS} =
49+
if
50+
Kind /= nil ->
51+
build('_', S);
52+
true ->
53+
build(Name, S)
54+
end,
55+
56+
FS = NS#elixir_erl{
57+
vars=maps:put(Tuple, {NewVar, Counter, true}, S#elixir_erl.vars),
58+
export_vars=case S#elixir_erl.export_vars of
59+
nil -> nil;
60+
EV -> maps:put(Tuple, {NewVar, Counter, true}, EV)
61+
end
62+
},
63+
64+
{{var, ?ann(Meta), NewVar}, FS}.
65+
6466
build(Key, #elixir_erl{counter=Counter} = S) ->
6567
Cnt =
6668
case maps:find(Key, Counter) of

0 commit comments

Comments
 (0)