File 2361-Optimize-single-generators-in-comprehensions.patch of Package erlang
From 8f38c125c2869199ce29f72b4b8188d3f24fc64a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Mon, 26 May 2025 15:20:07 +0200
Subject: [PATCH] Optimize single generators in comprehensions
The only way to bind variables in a comprehension is via a generator.
If a value needs to be calculated once and used both as a filter and
as a result, one must resort to tricks such as:
[V || E <- L, V -> [expensive_calculation(E)], some_filter(V)]
This commit optimizes comprehensions where a generator iterates over a
list known to contain a single element.
---
lib/compiler/src/beam_ssa_bc_size.erl | 31 ++++-
lib/compiler/src/sys_core_fold.erl | 180 ++++++++++++++++++++++++-
lib/compiler/test/bs_bincomp_SUITE.erl | 3 +-
lib/compiler/test/lc_SUITE.erl | 71 +++++++++-
lib/stdlib/test/qlc_SUITE.erl | 44 ++++--
5 files changed, 306 insertions(+), 23 deletions(-)
diff --git a/lib/compiler/src/beam_ssa_bc_size.erl b/lib/compiler/src/beam_ssa_bc_size.erl
index f41c54cb31..9e82b4e6ac 100644
--- a/lib/compiler/src/beam_ssa_bc_size.erl
+++ b/lib/compiler/src/beam_ssa_bc_size.erl
@@ -71,20 +71,37 @@ opt_function(Id, StMap) ->
erlang:raise(Class, Error, Stack)
end.
-opt_blks([{L,#b_blk{is=Is}=Blk}|Blks], ParamInfo, StMap, AnyChange, Count0, Acc0) ->
- case Is of
+opt_blks([{L,#b_blk{is=Is0}=Blk0}|Blks], ParamInfo, StMap, AnyChange, Count0, Acc0) ->
+ case Is0 of
[#b_set{op=bs_init_writable,dst=Dst}] ->
Bs = #{st_map => StMap, Dst => {writable,#b_literal{val=0}},
seen => sets:new([{version,2}])},
- try opt_writable(Bs, L, Blk, Blks, ParamInfo, Count0, Acc0) of
+ try opt_writable(Bs, L, Blk0, Blks, ParamInfo, Count0, Acc0) of
{Acc,Count} ->
opt_blks(Blks, ParamInfo, StMap, changed, Count, Acc)
catch
throw:not_possible ->
- opt_blks(Blks, ParamInfo, StMap, AnyChange, Count0, [{L,Blk}|Acc0])
+ opt_blks(Blks, ParamInfo, StMap, AnyChange, Count0, [{L,Blk0}|Acc0])
+ end;
+ [#b_set{op=bs_init_writable,dst=InitDst}=_Init,
+ #b_set{op=bs_create_bin,dst=BinDst,args=[_,_,InitDst|_]}=Create|_] ->
+ Bs0 = #{InitDst => {writable,#b_literal{val=0}}},
+ Bs = calc_size_instr(Create, Bs0),
+ Call = {call,
+ [{match,
+ {b_literal,1},
+ {b_literal,1}},
+ map_get(BinDst, Bs)]},
+ Expr = make_expr_tree(Call),
+ try cg_size_calc(Expr, L, Blk0, Count0, Acc0) of
+ {Acc,Count} ->
+ opt_blks(Blks, ParamInfo, StMap, changed, Count, Acc)
+ catch
+ throw:not_possible ->
+ opt_blks(Blks, ParamInfo, StMap, AnyChange, Count0, [{L,Blk0}|Acc0])
end;
_ ->
- opt_blks(Blks, ParamInfo, StMap, AnyChange, Count0, [{L,Blk}|Acc0])
+ opt_blks(Blks, ParamInfo, StMap, AnyChange, Count0, [{L,Blk0}|Acc0])
end;
opt_blks([], _ParamInfo, _StMap, changed, Count, Acc) ->
{reverse(Acc),Count};
@@ -560,8 +577,8 @@ cg_size_calc(Expr, L, #b_blk{}=Blk0, Count0, Acc0) ->
PhiIs = [#b_set{op=phi,dst=PhiDst,args=PhiArgs}],
PhiBlk = #b_blk{is=PhiIs,last=cg_br(InitWrL)},
- #b_blk{is=[InitWr]} = Blk0,
- Is = [InitWr#b_set{args=[PhiDst]}],
+ #b_blk{is=[InitWr|Is0]} = Blk0,
+ Is = [InitWr#b_set{args=[PhiDst]}|Is0],
Blk = Blk0#b_blk{is=Is},
Acc = [{InitWrL,Blk},
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 1888f2af11..a01bcb1d15 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -281,7 +281,7 @@ expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) ->
%% This is named fun in an 'effect' context. Warn and ignore.
add_warning(Letrec, {ignored,useless_building}),
void();
-expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) ->
+expr(#c_letrec{defs=Fs0,body=B0}=Letrec0, Ctxt, Sub) ->
Fs1 = map(fun ({Name,Fb}) ->
case Ctxt =:= effect andalso is_fun_effect_safe(Name, B0) of
true ->
@@ -291,7 +291,8 @@ expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) ->
end
end, Fs0),
B1 = body(B0, Ctxt, Sub),
- Letrec#c_letrec{defs=Fs1,body=B1};
+ Letrec = Letrec0#c_letrec{defs=Fs1,body=B1},
+ opt_lc(Letrec);
expr(#c_case{}=Case0, Ctxt, Sub) ->
%% Ideally, the compiler should only emit warnings when there is
%% a real mistake in the code being compiled. We use the follow
@@ -2081,6 +2082,181 @@ opt_bool_case_in_let_1([#c_var{name=V}], Arg,
end;
opt_bool_case_in_let_1(_, _, _, Let, _) -> Let.
+%%%
+%%% Optimize list generators in comprehensions when the input list
+%%% is known to contain a single element. This happens when
+%%% a value is computed once and used both in a filter and as an
+%%% element expression as in this example:
+%%%
+%%% mine(L) ->
+%%% [{E,H} || E <- L,
+%%% H <- [erlang:phash2(E)],
+%%% H rem 10 =:= 0].
+%%%
+%%% In Core Erlang, each generator becomes a letrec, which is
+%%% later lowered to a function in BEAM code. Consider this
+%%% comprehension:
+%%%
+%%% [X || E <- L, X <- [E]].
+%%%
+%%% The Core Erlang code produced for the `X <- [E]` generator looks
+%%% like this:
+%%%
+%%% letrec
+%%% 'lc$^1'/1 =
+%%% fun (X) ->
+%%% case X of
+%%% <[X|Tail]> when 'true' ->
+%%% let <NewTail> = apply 'lc$^1'/1(Tail)
+%%% in [X|NewTail]
+%%% <[Head|Tail]> when 'true' ->
+%%% apply 'lc$^1'/1(Tail)
+%%% <[]> when 'true' ->
+%%% apply 'lc$^0'/1(PreviousTail) %% Outer
+%%% end
+%%% in apply 'lc$^1'/1([E|[]])
+%%%
+%%% The `PreviousTail` and `E` variables have been bound by the
+%%% `E <- L` generator.
+%%%
+%%% Since the X argument is a known singleton, recursion is
+%%% unnecessary. The recursive calls can be replaced with the body of
+%%% the final clause, which is known to be reached because `Tail` is
+%%% always [].
+%%%
+%%% Also, the second clause will always match, so we can drop the
+%%% third clause.
+%%%
+%%% That results in the following code:
+%%%
+%%% let
+%%% <NewFun> =
+%%% fun (X) ->
+%%% case X of
+%%% <[X|Tail]> when 'true' ->
+%%% let <NewTail> = apply 'lc$^0'/1(PreviousTail)
+%%% in [X|NewTail]
+%%% <[Head|Tail]> when 'true' ->
+%%% apply 'lc$^0'/1(PreviousTail)
+%%% end
+%%% in apply NewFun([E|[]])
+%%%
+%%% The usual Core Erlang optimizations will be applied to simplify
+%%% it. First, the fun will be eliminated:
+%%%
+%%% let <X> = [E|[]]
+%%% in case X of
+%%% <[X|Tail]> when 'true' ->
+%%% let <NewTail> = apply 'lc$^0'/1(PreviousTail)
+%%% in [X|NewTail]
+%%% <[Head|Tail]> when 'true' ->
+%%% apply 'lc$^0'/1(PreviousTail)
+%%% end
+%%%
+%%% Next, the outer let will be eliminated by substituting into the
+%%% case expression:
+%%%
+%%% case [E|[]] of
+%%% <[X|Tail]> when 'true' ->
+%%% .
+%%% .
+%%% .
+%%% end
+%%%
+%%% Since the first clause always matches, the remaining clauses can
+%%% be discarded and the case can be rewritten to a let:
+%%%
+%%% let <X, Tail> = <E, []>
+%%% in let <NewTail> = apply 'lc$^0'/1(PreviousTail)
+%%% in [X|NewTail]
+%%%
+%%% Finally, by eliminating the outermost let, we get:
+%%%
+%%% let <NewTail> = apply 'lc$^0'/1(PreviousTail)
+%%% in [E|NewTail]
+%%%
+opt_lc(Letrec) ->
+ maybe
+ #c_letrec{anno=Anno,defs=[{Name,Fun}],body=Body0} ?= Letrec,
+ true ?= lists:member(list_comprehension, Anno),
+ {ok,Body} ?= opt_lc_body(Body0, Name, Fun),
+ Body
+ else
+ _ ->
+ Letrec
+ end.
+
+opt_lc_body(Body0, Name, Fun) ->
+ try opt_lc_body_1(Body0, Name, Fun) of
+ Body ->
+ {ok,Body}
+ catch
+ throw:impossible ->
+ impossible
+ end.
+
+opt_lc_body_1(#c_let{body=Body0}=Let, Name, Fun) ->
+ Body = opt_lc_body_1(Body0, Name, Fun),
+ Let#c_let{body=Body};
+opt_lc_body_1(Apply, #c_var{name=Name}, Fun0) ->
+ maybe
+ %% Look for a letrec body that constructs a list
+ %% with a single element.
+ #c_apply{op=#c_var{name=Name},args=[Arg|_]} ?= Apply,
+ true ?= cerl:is_c_list(Arg) andalso cerl:list_length(Arg) =:= 1,
+
+ %% Now we know that the letrec body is suitable. Try to
+ %% rewrite the definition body.
+ Fun = opt_lc_definition(Fun0, Name),
+
+ %% Rewrite succeeded. Replace the letrec with a plain let.
+ FunNameVar = make_var([]),
+ #c_let{vars=[FunNameVar],arg=Fun,
+ body=Apply#c_apply{op=FunNameVar}}
+ else
+ _ ->
+ throw(impossible)
+ end.
+
+opt_lc_definition(#c_fun{body=Case}=Fun, Name) ->
+ maybe
+ %% Match the case used in a list comprehension generator.
+ #c_case{clauses=Cs0} ?= Case,
+ [#c_clause{pats=[#c_cons{tl=Tail}|_],body=C1Body0}=C1,
+ #c_clause{pats=[#c_cons{tl=Tail}|_],guard=#c_literal{val=true},
+ body=#c_apply{op=#c_var{name=Name},
+ args=[Tail|_]}}=C2,
+ #c_clause{pats=[#c_literal{val=[]}|_],body=Iterate}|_] ?= Cs0,
+
+ %% Replace self-recursion with the body of the clause matching
+ %% the empty list.
+ C1Body = opt_lc_fun_body(C1Body0, Name, Iterate),
+
+ %% Build a fun to replace the letrec. We know that the second
+ %% clause will always match, so there is no need to include
+ %% more clauses.
+ %%
+ %% Note that the the first clause will usually match, except
+ %% when it has a non-true guard as in this comprehension:
+ %%
+ %% [X || E <- L, is_list(E), X <- [E]]
+ %%
+ %% Therefore, it is necessary to include the second clause.
+ Cs = [C1#c_clause{body=C1Body},
+ C2#c_clause{body=Iterate}],
+ Fun#c_fun{body=Case#c_case{clauses=Cs}}
+ else
+ _ ->
+ throw(impossible)
+ end.
+
+opt_lc_fun_body(Core, Name, Iterate) ->
+ cerl_trees:map(fun(#c_apply{op=#c_var{name=Op}}) when Op =:= Name ->
+ Iterate;
+ (Other) ->
+ Other
+ end, Core).
+
%% is_simple_case_arg(Expr) -> true|false
%% Determine whether the Expr is simple enough to be worth
%% substituting into a case argument. (Common substitutions
diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl
index 7d3764e882..32c9c9ceb9 100644
--- a/lib/compiler/test/bs_bincomp_SUITE.erl
+++ b/lib/compiler/test/bs_bincomp_SUITE.erl
@@ -151,7 +151,8 @@ mixed(Config) when is_list(Config) ->
%% OTP-16899: Nested binary comprehensions would fail to load.
<<0,1,0,2,0,3,99>> = mixed_nested([1,2,3]),
- <<1>> = cs_default(<< <<X>> || L <- [[1]], X <- L >>),
+ <<1>> = cs(<< <<X>> || L <- [[1]], X <- L >>),
+ <<1,2>> = cs_default(<< <<X>> || L <- [[1,2]], X <- L >>),
%% The compiler would crash in v3_kernel.
<<42:32,75:32,253:32,(42 bsl 8 bor 75):32>> =
diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl
index 155e749277..f8ca6e4666 100644
--- a/lib/compiler/test/lc_SUITE.erl
+++ b/lib/compiler/test/lc_SUITE.erl
@@ -26,8 +26,9 @@
init_per_testcase/2,end_per_testcase/2,
basic/1,deeply_nested/1,no_generator/1,
empty_generator/1,no_export/1,shadow/1,
- effect/1,gh10020/1]).
+ effect/1,singleton_generator/1,gh10020/1]).
+-include_lib("stdlib/include/assert.hrl").
-include_lib("common_test/include/ct.hrl").
suite() ->
@@ -45,6 +46,7 @@ groups() ->
no_export,
shadow,
effect,
+ singleton_generator,
gh10020
]}].
@@ -286,6 +288,71 @@ do_effect(Lc, L) ->
ok = Lc(F, L),
lists:reverse(erase(?MODULE)).
+singleton_generator(_Config) ->
+ Seq = lists:seq(1, 100),
+ Mixed = [<<I:32>> || I <- Seq] ++ Seq,
+ Bin = << <<E:16>> || E <- Seq >>,
+
+ ?assertEqual(singleton_generator_1a(Seq), singleton_generator_1b(Seq)),
+ ?assertEqual(singleton_generator_2a(Seq), singleton_generator_2b(Seq)),
+ ?assertEqual(singleton_generator_3a(Seq), singleton_generator_3b(Seq)),
+ ?assertEqual(singleton_generator_4a(Seq), singleton_generator_4b(Seq)),
+
+ ?assertEqual(singleton_generator_5a(Mixed),
+ singleton_generator_5b(Mixed)),
+
+ ?assertEqual(singleton_generator_bin_1a(Bin),
+ singleton_generator_bin_1b(Bin)),
+
+ ok.
+
+singleton_generator_1a(L) ->
+ [{H,E} || E <- L,
+ H <- [erlang:phash2(E)],
+ H rem 10 =:= 0].
+
+singleton_generator_1b(L) ->
+ [{erlang:phash2(E),E} ||
+ E <- L,
+ erlang:phash2(E) rem 10 =:= 0].
+
+singleton_generator_2a(L) ->
+ [true = B || E <- L,
+ B <- [is_integer(E)]].
+
+singleton_generator_2b(L) ->
+ lists:duplicate(length(L), true).
+
+singleton_generator_3a(L) ->
+ [if
+ Sqr > 500 -> Sqr;
+ true -> 500
+ end || E <- L, Sqr <- [E*E]].
+
+singleton_generator_3b(L) ->
+ [if
+ E*E > 500 -> E*E;
+ true -> 500
+ end || E <- L].
+
+singleton_generator_4a(L) ->
+ [Res1 + Res2 || E <- L, EE <- L, Res1 <- [3*EE], Res2 <- [7*E]].
+
+singleton_generator_4b(L) ->
+ [7*E + 3*EE || E <- L, EE <- L].
+
+singleton_generator_5a(L) ->
+ [Sqr || E <- L, is_integer(E), Sqr <- [E*E], Sqr < 100].
+
+singleton_generator_5b(L) ->
+ [E*E || E <- L, is_integer(E), E*E < 100].
+
+singleton_generator_bin_1a(Bin) ->
+ << <<N:8>> || <<B:16>> <= Bin, N <- [B * 7], N < 256 >>.
+
+singleton_generator_bin_1b(Bin) ->
+ << <<(B*7):8>> || <<B:16>> <= Bin, B * 7 < 256 >>.
+
gh10020(Config) when is_list(Config) ->
L = lists:seq(1, 10),
do_gh10020(L).
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index 001b88b480..2de85d6d53 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -2337,13 +2337,20 @@ filter(Config) when is_list(Config) ->
\"[]\" = qlc:info(Q),
[] = qlc:e(Q)">>,
- <<"%% match spec
+ {cres,<<"%% match spec
[] = qlc:e(qlc:q([X || {X} <- [{1},{2}],
(false orelse (X/0 > 3))])),
%% generated code
{'EXIT', {badarith, _}} =
(catch qlc:e(qlc:q([X || {X} <- [{1}],
+ begin (false orelse (X/0 > 3)) end]))),
+ {'EXIT', {badarith, _}} =
+ (catch qlc:e(qlc:q([X || {X} <- [{1},{2}],
begin (false orelse (X/0 > 3)) end])))">>,
+ [], {warnings,
+ [{{7,60},
+ sys_core_fold,
+ {failed,{eval_failure,{erlang,'/',2},badarith}}}]}},
<<"%% Partial evaluation in filter.
etsc(fun(E) ->
@@ -4245,7 +4252,8 @@ skip_filters(Config) when is_list(Config) ->
{generate,_,{table,{ets,table,_}}},_,_,_,_],[]} = i(Q),
{'EXIT', _} = (catch qlc:e(Q))
end, [{1,1},{2,0}])">>,
- <<"%% There are objects in the ETS table, but none passes the filter.
+ {cres,
+ <<"%% There are objects in the ETS table, but none passes the filter.
%% F() would not be run if it did not \"invalidate\" the following
%% guards.
etsc(fun(E) ->
@@ -4255,14 +4263,23 @@ skip_filters(Config) when is_list(Config) ->
X =:= 17]),
{'EXIT', _} = (catch qlc:e(Q1))
end, [{1},{2},{3}])">>,
- <<"%% The last example works just like this one:
+ [], {warnings,
+ [{{5,55},
+ sys_core_fold,
+ {failed,{eval_failure,{erlang,'/',2},badarith}}}]}},
+ {cres,
+ <<"%% The last example works just like this one:
etsc(fun(E) ->
F = fun() -> [foo || A <- [0], 1/A] end,
Q1 = qlc:q([X || {X} <- ets:table(E),
F(),
begin X =:= 17 end]),
{'EXIT', _} = (catch qlc:e(Q1))
- end, [{1},{2},{3}])">>
+ end, [{1},{2},{3}])">>,
+ [], {warnings,
+ [{{3,55},
+ sys_core_fold,
+ {failed,{eval_failure,{erlang,'/',2},badarith}}}]}}
],
run(Config, Ts),
@@ -4622,7 +4639,8 @@ join_filter(Config) when is_list(Config) ->
X =:= Z]),
{'EXIT', _} = (catch qlc:e(Q))">>,
- <<"etsc(fun(E1) ->
+ {cres,
+ <<"etsc(fun(E1) ->
etsc(fun(E2) ->
F = fun() -> [foo || A <- [0], 1/A] end,
Q1 = qlc:q([X || {X} <- ets:table(E1),
@@ -4634,8 +4652,11 @@ join_filter(Config) when is_list(Config) ->
[]} = i(Q1),
{'EXIT', _} = (catch qlc:e(Q1))
end, [{1},{2},{3}])
- end, [{a},{b},{c}])">>
-
+ end, [{a},{b},{c}])">>,
+ [], {warnings,
+ [{{3,62},
+ sys_core_fold,
+ {failed,{eval_failure,{erlang,'/',2},badarith}}}]}}
],
run(Config, Ts),
ok.
@@ -6201,7 +6222,7 @@ otp_7238(Config) when is_list(Config) ->
<<"nomatch_5() ->
qlc:q([X || X = <<X>> <- [3]]).">>,
[],
- []},
+ {warnings,[{{2,38},sys_core_fold,{nomatch,no_clause}}]}},
{nomatch_6,
<<"nomatch_6() ->
@@ -6280,8 +6301,7 @@ otp_7238(Config) when is_list(Config) ->
1 > 0,
1 > X]).">>,
[],
- %% {warnings,[{{2,32},qlc,nomatch_pattern}]}},
- []},
+ {warnings,[{{2,37},sys_core_fold,{nomatch,no_clause}}]}},
%% Template warning.
{nomatch_template1,
@@ -7849,7 +7869,9 @@ run(Config, Tests) ->
run(Config, [], Tests).
run(Config, Extra, Tests) ->
- lists:foreach(fun(Body) -> run_test(Config, Extra, Body) end, Tests).
+ lists:foreach(fun(Body) ->
+ io:format("~p\n", [Body]),
+ run_test(Config, Extra, Body) end, Tests).
run_test(Config, Extra, {cres, Body, ExpectedCompileReturn}) ->
run_test(Config, Extra, {cres, Body, _Opts = [], ExpectedCompileReturn});
--
2.43.0
