Move LC ++ Tail fusion from v3_core to sys_core_fold

lib/compiler/src/sys_core_fold.erl

@@ -2296,6 +2296,97 @@ opt_lc_fun_body(Core, Name, Iterate) ->
                               Other
                    end, Core).
 
+%% opt_lc_append(VarName, Arg, Body) -> {ok, Core} | error.
+%%  Detect: let V = letrec{LC} in erlang:'++'(V, Tail)
+%%  Transform: fuse Tail into the LC's base case, eliminating ++.
+opt_lc_append(V, Arg, Body) ->
+    maybe
+        #c_call{module=#c_literal{val=Mod},
+                name=#c_literal{val=Name},
+                args=[#c_var{name=V}, Tail]} ?= Body,
+        true ?= is_append_call(Mod, Name),
+        #c_letrec{anno=Anno,defs=[{FNameVar, Fun}],
+                  body=LetrecBody} ?= Arg,
+        true ?= lists:member(list_comprehension, Anno),
+        false ?= core_lib:is_var_used(V, Tail),
+        fuse_lc_tail(Arg, FNameVar, Fun, LetrecBody, Tail)
+    else
+        _ -> error
+    end.
+
+is_append_call(erlang, '++') -> true;
+is_append_call(lists, append) -> true;
+is_append_call(_, _) -> false.
+
+%% fuse_lc_tail(Letrec, FNameVar, Fun, LetrecBody, Tail) ->
+%%     {ok, NewLetrec} | error.
+%%  Rewrite a list comprehension letrec to use Tail as the base case
+%%  instead of [], eliminating the need for a ++ call.
+fuse_lc_tail(Letrec, FNameVar, Fun, LetrecBody, Tail) ->
+    try
+        maybe
+            #c_var{name={FName, Arity}=Name} ?= FNameVar,
+            #c_fun{vars=FunVars, body=FunBody} ?= Fun,
+            TailVar = make_var(cerl:get_ann(FNameVar)),
+            NewName = {FName, Arity + 1},
+            NewFNameVar = FNameVar#c_var{name=NewName},
+            {ok, NewFunBody} ?= rewrite_lc_body(FunBody, Name, NewName, TailVar),
+            NewFun = Fun#c_fun{vars=FunVars ++ [TailVar], body=NewFunBody},
+            NewLetrecBody = rewrite_lc_apply(LetrecBody, Name, NewName, Tail),
+            {ok, Letrec#c_letrec{defs=[{NewFNameVar, NewFun}],
+                                  body=NewLetrecBody}}
+        else
+            _ -> error
+        end
+    catch
+        throw:not_possible -> error
+    end.
+
+rewrite_lc_body(#c_case{clauses=Clauses0}=Case, OldName, NewName, TailVar) ->
+    maybe
+        {ok, Clauses} ?= rewrite_lc_clauses(Clauses0, OldName, NewName, TailVar),
+        {ok, Case#c_case{clauses=Clauses}}
+    end;
+rewrite_lc_body(_, _, _, _) ->
+    error.
+
+rewrite_lc_clauses(Clauses, OldName, NewName, TailVar) ->
+    rewrite_lc_clauses(Clauses, OldName, NewName, TailVar, [], false).
+
+rewrite_lc_clauses([#c_clause{pats=[#c_literal{val=[]}],
+                               body=#c_literal{val=[]}}=C|Rest],
+                   OldName, NewName, TailVar, Acc, _FoundBase) ->
+    NewC = C#c_clause{body=TailVar},
+    rewrite_lc_clauses(Rest, OldName, NewName, TailVar, [NewC|Acc], true);
+rewrite_lc_clauses([C0|Rest], OldName, NewName, TailVar, Acc, FoundBase) ->
+    Body0 = C0#c_clause.body,
+    Body = rewrite_lc_applies(Body0, OldName, NewName, TailVar),
+    C = C0#c_clause{body=Body},
+    rewrite_lc_clauses(Rest, OldName, NewName, TailVar, [C|Acc], FoundBase);
+rewrite_lc_clauses([], _OldName, _NewName, _TailVar, Acc, true) ->
+    {ok, lists:reverse(Acc)};
+rewrite_lc_clauses([], _OldName, _NewName, _TailVar, _Acc, false) ->
+    error.
+
+rewrite_lc_applies(Core, OldName, NewName, TailVar) ->
+    cerl_trees:map(fun(#c_apply{op=#c_var{name=OldName0}=Op, args=Args}=Apply)
+                         when OldName0 =:= OldName ->
+                           Apply#c_apply{op=Op#c_var{name=NewName},
+                                         args=Args ++ [TailVar]};
+                      (Other) ->
+                           Other
+                   end, Core).
+
+rewrite_lc_apply(#c_apply{op=#c_var{name=OldName}=Op, args=Args}=Apply,
+                 OldName, NewName, Tail) ->
+    Apply#c_apply{op=Op#c_var{name=NewName}, args=Args ++ [Tail]};
+rewrite_lc_apply(#c_let{body=Body0}=Let, OldName, NewName, Tail) ->
+    Let#c_let{body=rewrite_lc_apply(Body0, OldName, NewName, Tail)};
+rewrite_lc_apply(#c_seq{body=Body0}=Seq, OldName, NewName, Tail) ->
+    Seq#c_seq{body=rewrite_lc_apply(Body0, OldName, NewName, Tail)};
+rewrite_lc_apply(_, _, _, _) ->
+    throw(not_possible).
+
 %% is_simple_case_arg(Expr) -> true|false
 %%  Determine whether the Expr is simple enough to be worth
 %%  substituting into a case argument. (Common substitutions
@@ -2674,8 +2765,13 @@ opt_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) ->
                     Arg = maybe_suppress_warnings(Arg1, Var, PrevBody),
                     #c_seq{arg=Arg,body=Body};
                 true ->
-                    Let1 = Let0#c_let{vars=Vars0,arg=Arg1,body=Body},
-                    post_opt_let(Let1, Sub)
+                    case opt_lc_append(V, Arg1, Body) of
+                        {ok, Fused} ->
+                            Fused;
+                        error ->
+                            Let1 = Let0#c_let{vars=Vars0,arg=Arg1,body=Body},
+                            post_opt_let(Let1, Sub)
+                    end
 	    end;
         {_,_,_} ->
             %% The argument for a sequence must be a single value (not

lib/compiler/src/v3_core.erl

@@ -978,17 +978,6 @@ expr({record_field=Op,Loc,Src0,Id,F0}, St0) ->
                       args=[Src,#c_literal{val=Id},F]},
     Aps = Aps0 ++ Aps1,
     {PrimOp,Aps,St2};
-expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) ->
-    %% Optimise '++' here because of the list comprehension algorithm.
-    %%
-    %% To avoid achieving quadratic complexity if there is a chain of
-    %% list comprehensions without generators combined with '++', force
-    %% evaluation of More now. Evaluating More here could also reduce the
-    %% number variables in the environment for letrec.
-    {Mc,Mps,St1} = safe(More, St0),
-    {Qs,St2} = preprocess_quals(Llc, Qs0, St1),
-    {Y,Yps,_OptInfo,St} = lc_tq(Llc, {lc, wrap_list(E)}, Qs, Mc, St2),
-    {Y,Mps++Yps,St};
 expr({op,_,'andalso',_,_}=E0, St0) ->
     {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso'),
     Anno = lineno_anno(L, St0),

lib/compiler/test/core_fold_SUITE.erl

@@ -21,7 +21,7 @@
 %%
 -module(core_fold_SUITE).
 
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
 	 init_per_group/2,end_per_group/2,
 	 t_element/1,setelement/1,t_length/1,append/1,t_apply/1,bifs/1,
 	 eq/1,nested_call_in_case/1,guard_try_catch/1,coverage/1,
@@ -32,7 +32,7 @@
          redundant_stack_frame/1,export_from_case/1,
          empty_values/1,cover_letrec_effect/1,
          receive_effect/1,nested_lets/1,
-         map_effect/1]).
+         map_effect/1,lc_append/1]).
 
 -export([foo/0,foo/1,foo/2,foo/3]).
 
@@ -55,7 +55,7 @@ groups() ->
        redundant_stack_frame,export_from_case,
        empty_values,cover_letrec_effect,
        receive_effect,nested_lets,
-       map_effect]}].
+       map_effect,lc_append]}].
 
 init_per_suite(Config) ->
     test_lib:recompile(?MODULE),
@@ -875,6 +875,49 @@ map_effect_2(Map) ->
     Map#{key := value},
     ok.
 
+lc_append(_Config) ->
+    %% Basic: intermediate variable LC ++ Tail
+    [1,2,3,4,5] = lc_append_var([1,2,3], [4,5]),
+    [4,5] = lc_append_var([], [4,5]),
+    [1,2,3] = lc_append_var([1,2,3], []),
+    [] = lc_append_var([], []),
+
+    %% Inline: [E || Qs] ++ Tail
+    [1,2,3,4,5] = lc_append_inline([1,2,3], [4,5]),
+    [4,5] = lc_append_inline([], [4,5]),
+
+    %% With filter
+    [2,3,4,5] = lc_append_filter([1,2,3], [4,5]),
+
+    %% Multi-use variable must NOT be optimized (still correct)
+    [1,2,3,4,5] = lc_append_multi_use([1,2,3], [4,5]),
+
+    %% Multi-generator
+    [{1,a},{1,b},{2,a},{2,b},done] =
+        lc_append_multi_gen([1,2], [a,b], [done]),
+
+    ok.
+
+lc_append_var(List, Tail) ->
+    Expanded = id([X || X <- List]),
+    Expanded ++ Tail.
+
+lc_append_inline(List, Tail) ->
+    [X || X <- List] ++ Tail.
+
+lc_append_filter(List, Tail) ->
+    Expanded = id([X || X <- List, X > 1]),
+    Expanded ++ Tail.
+
+lc_append_multi_use(List, Tail) ->
+    Expanded = id([X || X <- List]),
+    _ = length(Expanded),
+    Expanded ++ Tail.
+
+lc_append_multi_gen(L1, L2, Tail) ->
+    Expanded = id([{X,Y} || X <- L1, Y <- L2]),
+    Expanded ++ Tail.
+
 %%% Common utility functions.
 
 id(I) -> I.