Introduce a new core pass called sys_core_alias

The goal of this pass is to find values that are built from
patterns and generate aliases for those values to remove
pressure from the GC. For example, this code:

   example({ok, Val}) ->
       {ok, Val}.

shall become:

   example({ok, Val} = Tuple) ->
       Tuple.

Currently this pass aliases tuple and cons nodes made of literals,
variables and other cons. The tuple/cons may appear anywhere in the
pattern and it will be aliased if used later on.

Notice a tuple/cons made only of literals is not aliased as it may
be part of the literal pool.

3 files changed, 198 insertions, 1 deletions

diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index 63763f31b2..da5d207db9 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -22,6 +22,7 @@ MODULES= \
 	bs_construct_SUITE \
 	bs_match_SUITE \
 	bs_utf_SUITE \
+	core_alias_SUITE \
 	core_fold_SUITE \
 	compile_SUITE \
 	compilation_SUITE \
diff --git a/lib/compiler/test/core_alias_SUITE.erl b/lib/compiler/test/core_alias_SUITE.erl
new file mode 100644
index 0000000000..f3f15ef0f8
--- /dev/null
+++ b/lib/compiler/test/core_alias_SUITE.erl
@@ -0,0 +1,195 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%%     http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(core_alias_SUITE).
+
+-export([all/0, suite/0, groups/0,init_per_suite/1, end_per_suite/1,
+         init_per_group/2, end_per_group/2,
+         tuples/1, cons/1]).
+
+-include_lib("common_test/include/ct.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+    test_lib:recompile(?MODULE),
+    [{group,p}].
+
+groups() ->
+    [{p,[parallel],
+      [tuples, cons]}].
+
+init_per_suite(Config) ->
+    Config.
+
+end_per_suite(_Config) ->
+    ok.
+
+init_per_group(_GroupName, Config) ->
+    Config.
+
+end_per_group(_GroupName, Config) ->
+    Config.
+
+
+id(X) -> X.
+
+tuples(Config) when is_list(Config) ->
+    Tuple = {ok,id(value)},
+
+    true = erts_debug:same(Tuple, simple_tuple(Tuple)),
+    true = erts_debug:same(Tuple, simple_tuple_in_map(#{hello => Tuple})),
+    true = erts_debug:same(Tuple, simple_tuple_case_repeated(Tuple, Tuple)),
+    true = erts_debug:same(Tuple, simple_tuple_fun_repeated(Tuple, Tuple)),
+    true = erts_debug:same(Tuple, simple_tuple_twice_head(Tuple, Tuple)),
+
+    {Tuple1, Tuple2} = simple_tuple_twice_body(Tuple),
+    true = erts_debug:same(Tuple, Tuple1),
+    true = erts_debug:same(Tuple, Tuple2),
+
+    Nested = {nested,Tuple},
+    true = erts_debug:same(Tuple, nested_tuple_part(Nested)),
+    true = erts_debug:same(Nested, nested_tuple_whole(Nested)),
+    true = erts_debug:same(Nested, nested_tuple_with_alias(Nested)),
+
+    true = erts_debug:same(Tuple, tuple_rebinding_after(Tuple)),
+
+    Tuple = unaliased_tuple_rebinding_before(Tuple),
+    false = erts_debug:same(Tuple, unaliased_tuple_rebinding_before(Tuple)),
+    Nested = unaliased_literal_tuple_head(Nested),
+    false = erts_debug:same(Nested, unaliased_literal_tuple_head(Nested)),
+    Nested = unaliased_literal_tuple_body(Nested),
+    false = erts_debug:same(Nested, unaliased_literal_tuple_body(Nested)),
+    Nested = unaliased_different_var_tuple(Nested, Tuple),
+    false = erts_debug:same(Nested, unaliased_different_var_tuple(Nested, Tuple)).
+
+simple_tuple({ok,X}) ->
+    {ok,X}.
+simple_tuple_twice_head({ok,X}, {ok,X}) ->
+    {ok,X}.
+simple_tuple_twice_body({ok,X}) ->
+    {{ok,X},{ok,X}}.
+simple_tuple_in_map(#{hello := {ok,X}}) ->
+    {ok,X}.
+simple_tuple_fun_repeated({ok,X}, Y) ->
+    io:format("~p~n", [X]),
+    (fun({ok,X}) -> {ok,X} end)(Y).
+simple_tuple_case_repeated({ok,X}, Y) ->
+    io:format("~p~n", [X]),
+    case Y of {ok,X} -> {ok,X} end.
+
+nested_tuple_part({nested,{ok,X}}) ->
+    {ok,X}.
+nested_tuple_whole({nested,{ok,X}}) ->
+    {nested,{ok,X}}.
+nested_tuple_with_alias({nested,{ok,_}=Y}) ->
+    {nested,Y}.
+
+tuple_rebinding_after(Y) ->
+    (fun(X) -> {ok,X} end)(Y),
+    case Y of {ok,X} -> {ok,X} end.
+unaliased_tuple_rebinding_before({ok,X}) ->
+    io:format("~p~n", [X]),
+    (fun(X) -> {ok,X} end)(value).
+unaliased_literal_tuple_head({nested,{ok,value}=X}) ->
+    io:format("~p~n", [X]),
+    {nested,{ok,value}}.
+unaliased_literal_tuple_body({nested,{ok,value}=X}) ->
+    Res = {nested,Y={ok,value}},
+    io:format("~p~n", [[X,Y]]),
+    Res.
+unaliased_different_var_tuple({nested,{ok,value}=X}, Y) ->
+    io:format("~p~n", [X]),
+    {nested,Y}.
+
+cons(Config) when is_list(Config) ->
+    Cons = [ok|id(value)],
+
+    true = erts_debug:same(Cons, simple_cons(Cons)),
+    true = erts_debug:same(Cons, simple_cons_in_map(#{hello => Cons})),
+    true = erts_debug:same(Cons, simple_cons_case_repeated(Cons, Cons)),
+    true = erts_debug:same(Cons, simple_cons_fun_repeated(Cons, Cons)),
+    true = erts_debug:same(Cons, simple_cons_twice_head(Cons, Cons)),
+
+    {Cons1,Cons2} = simple_cons_twice_body(Cons),
+    true = erts_debug:same(Cons, Cons1),
+    true = erts_debug:same(Cons, Cons2),
+
+    Nested = [nested,Cons],
+    true = erts_debug:same(Cons, nested_cons_part(Nested)),
+    true = erts_debug:same(Nested, nested_cons_whole(Nested)),
+    true = erts_debug:same(Nested, nested_cons_with_alias(Nested)),
+    true = erts_debug:same(Cons, cons_rebinding_after(Cons)),
+
+    Unstripped = id([a,b]),
+    Stripped = cons_with_binary([<<>>|Unstripped]),
+    true = erts_debug:same(Unstripped, Stripped),
+
+    Cons = unaliased_cons_rebinding_before(Cons),
+    false = erts_debug:same(Cons, unaliased_cons_rebinding_before(Cons)),
+    Nested = unaliased_literal_cons_head(Nested),
+    false = erts_debug:same(Nested, unaliased_literal_cons_head(Nested)),
+    Nested = unaliased_literal_cons_body(Nested),
+    false = erts_debug:same(Nested, unaliased_literal_cons_body(Nested)),
+    Nested = unaliased_different_var_cons(Nested, Cons),
+    false = erts_debug:same(Nested, unaliased_different_var_cons(Nested, Cons)).
+
+simple_cons([ok|X]) ->
+    [ok|X].
+simple_cons_twice_head([ok|X], [ok|X]) ->
+    [ok|X].
+simple_cons_twice_body([ok|X]) ->
+    {[ok|X],[ok|X]}.
+simple_cons_in_map(#{hello := [ok|X]}) ->
+    [ok|X].
+simple_cons_fun_repeated([ok|X], Y) ->
+    io:format("~p~n", [X]),
+    (fun([ok|X]) -> [ok|X] end)(Y).
+simple_cons_case_repeated([ok|X], Y) ->
+    io:format("~p~n", [X]),
+    case Y of [ok|X] -> [ok|X] end.
+
+nested_cons_part([nested,[ok|X]]) ->
+    [ok|X].
+nested_cons_whole([nested,[ok|X]]) ->
+    [nested,[ok|X]].
+nested_cons_with_alias([nested,[ok|_]=Y]) ->
+    [nested,Y].
+
+cons_with_binary([<<>>,X|Y]) ->
+    cons_with_binary([X|Y]);
+cons_with_binary(A) ->
+    A.
+
+cons_rebinding_after(Y) ->
+    (fun(X) -> [ok|X] end)(Y),
+    case Y of [ok|X] -> [ok|X] end.
+unaliased_cons_rebinding_before([ok|X]) ->
+    io:format("~p~n", [X]),
+    (fun(X) -> [ok|X] end)(value).
+unaliased_literal_cons_head([nested,[ok|value]=X]) ->
+    io:format("~p~n", [X]),
+    [nested,[ok|value]].
+unaliased_literal_cons_body([nested,[ok|value]=X]) ->
+    Res = [nested,Y=[ok|value]],
+    io:format("~p~n", [[X, Y]]),
+    Res.
+unaliased_different_var_cons([nested,[ok|value]=X], Y) ->
+    io:format("~p~n", [X]),
+    [nested,Y].
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index 4bd884d86b..ea4aaf40a9 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -161,11 +161,12 @@ md5_1(Beam) ->
 %% Cover some code that handles internal errors.
 
 silly_coverage(Config) when is_list(Config) ->
-    %% sys_core_fold, sys_core_bsm, sys_core_setel, v3_kernel
+    %% sys_core_fold, sys_core_alias, sys_core_bsm, sys_core_setel, v3_kernel
     BadCoreErlang = {c_module,[],
 		     name,[],[],
 		     [{{c_var,[],{foo,2}},seriously_bad_body}]},
     expect_error(fun() -> sys_core_fold:module(BadCoreErlang, []) end),
+    expect_error(fun() -> sys_core_alias:module(BadCoreErlang, []) end),
     expect_error(fun() -> sys_core_bsm:module(BadCoreErlang, []) end),
     expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end),
     expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end),