aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lib/compiler/src/sys_core_fold.erl144
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl31
-rw-r--r--lib/compiler/test/test_lib.erl4
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;