Teach case_opt/3 to avoid unnecessary building

Given this code:

  f(S) ->
    F0 = F1 = {S,S},
    [F0,F1].

case_opt/3 would "optimize" it like this:

  f(S) ->
    F1 = {S,S},
    F0 = {S,S},
    [F0,F1].

Similarly, this code:

  g({a,_,_}=T) ->
    {b,
     [_,_] = [T,none],
     x}.

would be rewritten to:

  g({a,Tmp1,Tmp2}=T) ->
    Tmp3 = {a,Tmp1,Tmp2},
    {b,
     [Tmp3,none],
     x}.

where the tuple is rebuilt instead of using the T variable.

Rewrite case_opt/3 to be more careful while optimizing.

3 files changed, 129 insertions, 50 deletions

diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 72509947d6..c29b5cde41 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -2025,12 +2025,31 @@ case_opt_args([], Cs, _Sub, _LitExpr, Acc) ->
 %%  Try to expand one argument to several arguments (if tuple/list)
 %%  or to remove a literal argument.
 %%
-case_opt_arg(E0, Sub, Cs0, LitExpr) ->
-    E = maybe_replace_var(E0, Sub),
-    case cerl:is_data(E) of
+case_opt_arg(E0, Sub, Cs, LitExpr) ->
+    case cerl:is_c_var(E0) of
+	false ->
+	    case_opt_arg_1(E0, Cs, LitExpr);
+	true ->
+	    case case_will_var_match(Cs) of
+		true ->
+		    %% All clauses will match a variable in the
+		    %% current position. Don't expand this variable
+		    %% (that can only make the code worse).
+		    {error,Cs};
+		false ->
+		    %% If possible, expand this variable to a previously
+		    %% matched term.
+		    E = case_expand_var(E0, Sub),
+		    case_opt_arg_1(E, Cs, LitExpr)
+	    end
+    end.
+
+case_opt_arg_1(E0, Cs0, LitExpr) ->
+    case cerl:is_data(E0) of
 	false ->
             {error,Cs0};
 	true ->
+	    E = case_opt_compiler_generated(E0),
 	    Cs = case_opt_nomatch(E, Cs0, LitExpr),
 	    case cerl:data_type(E) of
 		{atomic,_} ->
@@ -2040,18 +2059,42 @@ case_opt_arg(E0, Sub, Cs0, LitExpr) ->
 	    end
     end.
 
-%% maybe_replace_var(Expr0, Sub) -> Expr
+%% case_will_var_match([Clause]) -> true | false.
+%%  Return if all clauses will match a variable in the
+%%  current position.
+%%
+case_will_var_match(Cs) ->
+    all(fun({[P|_],_,_,_}) ->
+		case cerl_clauses:match(P, any) of
+		    {true,_} -> true;
+		    _ -> false
+		end
+	end, Cs).
+
+
+%% case_opt_compiler_generated(Core) -> Core'
+%%  Mark Core expressions as compiler generated to ensure that
+%%  no warnings are generated if they turn out to be unused.
+%%  To pretty-printed Core Erlang easier to read, don't mark
+%%  constructs that can't cause warnings to be emitted.
+%%
+case_opt_compiler_generated(Core) ->
+    F = fun(C) ->
+		case cerl:type(C) of
+		    alias -> C;
+		    var -> C;
+		    _ -> cerl:set_ann(C, [compiler_generated])
+		end
+	end,
+    cerl_trees:map(F, Core).
+
+
+%% case_expand_var(Expr0, Sub) -> Expr
 %%  If Expr0 is a variable that has been previously matched and
 %%  is known to be a tuple, return the tuple instead. Otherwise
 %%  return Expr0 unchanged.
 %%
-maybe_replace_var(E, Sub) ->
-    case cerl:is_c_var(E) of
-	false -> E;
-	true -> maybe_replace_var_1(E, Sub)
-    end.
-
-maybe_replace_var_1(E, #sub{t=Tdb}) ->
+case_expand_var(E, #sub{t=Tdb}) ->
     case orddict:find(cerl:var_name(E), Tdb) of
 	{ok,T0} ->
 	    case cerl:is_c_tuple(T0) of
@@ -2068,9 +2111,8 @@ maybe_replace_var_1(E, #sub{t=Tdb}) ->
 		    %% operator will fail when used in map
 		    %% construction (only the '=>' operator is allowed
 		    %% when constructing a map from scratch).
-		    ToData = fun coerce_to_data/1,
 		    try
-			cerl_trees:map(ToData, T0)
+			cerl_trees:map(fun coerce_to_data/1, T0)
 		    catch
 			throw:impossible ->
 			    %% Something unsuitable was found (map or
@@ -2124,8 +2166,9 @@ case_opt_nomatch(_, [], _) -> [].
 %%  will match, and we can remove the corresponding pattern from
 %%  each clause.
 %%
-%%  The only complication is if the literal is a binary. Binary
-%%  pattern matching is tricky, so we will give up in that case.
+%%  The only complication is if the literal is a binary or map.
+%%  In general, it is difficult to know whether a binary or
+%%  map pattern will match, so we give up in that case.
 
 case_opt_lit(Lit, Cs0) ->
     try case_opt_lit_1(Lit, Cs0) of
@@ -2152,6 +2195,10 @@ case_opt_lit_1(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) ->
 case_opt_lit_1(_, []) -> [].
 
 %% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses}
+%%  The case expression is a non-atomic data constructor (cons
+%%  or tuple). We can know at compile time whether each clause
+%%  will match, and we can delay the building of the data to
+%%  the clauses where it is actually needed.
 
 case_opt_data(E, Cs0) ->
     Es = cerl:data_es(E),
@@ -2161,45 +2208,48 @@ case_opt_data(E, Cs0) ->
 	    {ok,Es,Cs}
     catch
 	throw:impossible ->
+	    %% The pattern contained a binary or map.
 	    {error,Cs0}
     end.
 
-case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) ->
-    {ok,Ps1,Bs1} = case_data_pat(P, TypeSig),
-    [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|
-     case_opt_data_1(Cs, Es, TypeSig)];
+case_opt_data_1([{[P0|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) ->
+    P = case_opt_compiler_generated(P0),
+    BindTo = #c_var{name=dummy},
+    {Ps1,[{BindTo,_}|Bs1]} = case_data_pat_alias(P, BindTo, TypeSig, []),
+    [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|case_opt_data_1(Cs, Es, TypeSig)];
 case_opt_data_1([], _, _) -> [].
 
-%% case_data_pat(Pattern, Type, Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error.
-
-case_data_pat(P, TypeSig) ->
-    case cerl:is_data(P) of
-	false ->
-	    case_data_pat_var(P, TypeSig);
-	true ->
-	    {ok,cerl:data_es(P),[]}
-    end.
-
-%% case_data_pat_var(Pattern, {DataType,ArityType}) ->
-%%          {ok,[Pattern],[{AliasVar,Pat}]}
-
-case_data_pat_var(P, {Type,Arity}=TypeSig) ->
-    %% If the entire case statement is evaluated in an effect
-    %% context (e.g. "case {A,B} of ... end, ok"), there will
-    %% be a warning that a term is constructed but never used.
-    %% To avoid that warning, we must annotate the data
-    %% constructor as compiler generated.
-    Ann = [compiler_generated|cerl:get_ann(P)],
+case_data_pat_alias(P, BindTo0, TypeSig, Bs0) ->
     case cerl:type(P) of
-	var ->
-	    Vars = make_vars(cerl:get_ann(P), Arity),
-	    {ok,Vars,[{P,cerl:ann_make_data(Ann, Type, Vars)}]};
 	alias ->
-	    V = cerl:alias_var(P),
-	    Apat = cerl:alias_pat(P),
-	    {ok,Ps,Bs} = case_data_pat(Apat, TypeSig),
-	    {ok,Ps,[{V,cerl:ann_make_data(Ann, Type,
-					  pat_to_expr_list(Ps))}|Bs]}
+	    %% Recursively handle the pattern and bind to
+	    %% the alias variable.
+	    BindTo = cerl:alias_var(P),
+	    Apat0 = cerl:alias_pat(P),
+	    Ann = [compiler_generated],
+	    Apat = cerl:set_ann(Apat0, Ann),
+	    {Ps,Bs} = case_data_pat_alias(Apat, BindTo, TypeSig, Bs0),
+	    {Ps,[{BindTo0,BindTo}|Bs]};
+	var ->
+	    %% Here we will need to actually build the data and bind
+	    %% it to the variable.
+	    {Type,Arity} = TypeSig,
+	    Vars = make_vars([], Arity),
+	    Ann = [compiler_generated],
+	    Data = cerl:ann_make_data(Ann, Type, Vars),
+	    Bs = [{BindTo0,P},{P,Data}|Bs0],
+	    {Vars,Bs};
+	_ ->
+	    %% Since case_opt_nomatch/3 has removed all clauses that
+	    %% cannot match, we KNOW that this clause must match and
+	    %% that the pattern must be a data constructor.
+	    %% Here we must build the data and bind it to the variable.
+	    {Type,_} = TypeSig,
+	    DataEs = cerl:data_es(P),
+	    Vars = pat_to_expr_list(DataEs),
+	    Ann = [compiler_generated],
+	    Data = cerl:ann_make_data(Ann, Type, Vars),
+	    {DataEs,[{BindTo0,Data}]}
     end.
 
 %% pat_to_expr(Pattern) -> Expression.
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index bca8afb1b0..b45874433c 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -23,7 +23,8 @@
 	 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,
 	 unused_multiple_values_error/1,unused_multiple_values/1,
-	 multiple_aliases/1,redundant_boolean_clauses/1,mixed_matching_clauses/1]).
+	 multiple_aliases/1,redundant_boolean_clauses/1,
+	 mixed_matching_clauses/1,unnecessary_building/1]).
 
 -export([foo/0,foo/1,foo/2,foo/3]).
 
@@ -40,7 +41,8 @@ groups() ->
       [t_element,setelement,t_length,append,t_apply,bifs,
        eq,nested_call_in_case,guard_try_catch,coverage,
        unused_multiple_values_error,unused_multiple_values,
-       multiple_aliases,redundant_boolean_clauses,mixed_matching_clauses]}].
+       multiple_aliases,redundant_boolean_clauses,
+       mixed_matching_clauses,unnecessary_building]}].
 
 
 init_per_suite(Config) ->
@@ -403,4 +405,29 @@ mixed_matching_clauses(Config) when is_list(Config) ->
       end,
   ok.
 
+unnecessary_building(Config) when is_list(Config) ->
+    Term1 = do_unnecessary_building_1(test_lib:id(a)),
+    [{a,a},{a,a}] = Term1,
+    7 = erts_debug:size(Term1),
+
+    %% The Input term should not be rebuilt (thus, it should
+    %% only be counted once in the size of the combined term).
+    Input = test_lib:id({a,b,c}),
+    Term2 = test_lib:id(do_unnecessary_building_2(Input)),
+    {b,[{a,b,c},none],x} = Term2,
+    4+4+4+2 = erts_debug:size([Term2|Input]),
+
+    ok.
+
+do_unnecessary_building_1(S) ->
+    %% The tuple must only be built once.
+    F0 = F1 = {S,S},
+    [F0,F1].
+
+do_unnecessary_building_2({a,_,_}=T) ->
+    %% The T term should not be rebuilt.
+    {b,
+     [_,_] = [T,none],
+     x}.
+
 id(I) -> I.
diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl
index e06e42276a..e8f469c5b4 100644
--- a/lib/compiler/test/test_lib.erl
+++ b/lib/compiler/test/test_lib.erl
@@ -20,9 +20,11 @@
 
 -include("test_server.hrl").
 -compile({no_auto_import,[binary_part/2]}).
--export([recompile/1,parallel/0,uniq/0,opt_opts/1,get_data_dir/1,
+-export([id/1,recompile/1,parallel/0,uniq/0,opt_opts/1,get_data_dir/1,
 	 smoke_disasm/1,p_run/2,binary_part/2]).
 
+id(I) -> I.
+
 recompile(Mod) when is_atom(Mod) ->
     case whereis(cover_server) of
  	undefined -> ok;