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.

bootstrap/lib/compiler/ebin/compiler.app

@@ -58,6 +58,7 @@
 	     core_lib,
 	     erl_bifs,
 	     rec_env,
+	     sys_core_alias,
 	     sys_core_bsm,
 	     sys_core_dsetel,
 	     sys_core_fold,

lib/compiler/src/Makefile

@@ -83,6 +83,7 @@ MODULES =  \
 	core_scan \
 	erl_bifs \
 	rec_env \
+	sys_core_alias \
 	sys_core_bsm \
 	sys_core_dsetel \
 	sys_core_fold \
@@ -194,6 +195,7 @@ $(EBIN)/core_lib.beam: core_parse.hrl
 $(EBIN)/core_lint.beam: core_parse.hrl
 $(EBIN)/core_parse.beam: core_parse.hrl $(EGEN)/core_parse.erl
 $(EBIN)/core_pp.beam: core_parse.hrl
+$(EBIN)/sys_core_alias.beam: core_parse.hrl
 $(EBIN)/sys_core_dsetel.beam: core_parse.hrl
 $(EBIN)/sys_core_fold.beam: core_parse.hrl
 $(EBIN)/sys_core_fold_lists.beam: core_parse.hrl

lib/compiler/src/compile.erl

@@ -706,14 +706,16 @@ core_passes() ->
       [{unless,no_copt,
        [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/2},
 	{iff,doldinline,{listing,"oldinline"}},
-	{pass,sys_core_fold},
+	{unless,no_fold,{pass,sys_core_fold}},
 	{iff,dcorefold,{listing,"corefold"}},
 	{core_inline_module,fun test_core_inliner/1,fun core_inline_module/2},
 	{iff,dinline,{listing,"inline"}},
         {core_fold_after_inlining,fun test_any_inliner/1,
          fun core_fold_module_after_inlining/2},
 	?pass(core_transforms)]},
        {iff,dcopt,{listing,"copt"}},
+       {unless,no_alias,{pass,sys_core_alias}},
+       {iff,dalias,{listing,"core_alias"}},
        {iff,'to_core',{done,"core"}}]}
      | kernel_passes()].
 
@@ -1921,6 +1923,7 @@ pre_load() ->
 	 erl_lint,
 	 erl_parse,
 	 erl_scan,
+	 sys_core_alias,
 	 sys_core_bsm,
 	 sys_core_dsetel,
 	 sys_core_fold,

lib/compiler/src/compiler.app.src

@@ -58,6 +58,7 @@
 	     core_lib,
 	     erl_bifs,
 	     rec_env,
+	     sys_core_alias,
 	     sys_core_bsm,
 	     sys_core_dsetel,
 	     sys_core_fold,

lib/compiler/src/sys_core_alias.erl

@@ -0,0 +1,308 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-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%
+%%
+%% Purpose : Replace values by aliases from patterns optimisation for Core
+
+%% Replace expressions by aliases from patterns. For example:
+%%
+%%    example({ok, Val}) ->
+%%        {ok, Val}.
+%%
+%% will 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.
+
+-module(sys_core_alias).
+
+-export([module/2]).
+
+-include("core_parse.hrl").
+
+-define(NOTSET, 0).
+
+-record(sub, {p=#{} :: #{term() => ?NOTSET | atom()},                %% Found pattern substitutions
+              v=cerl_sets:new() :: [cerl_sets:set(cerl:var_name())], %% Variables used by patterns
+              t=undefined :: term()}).                               %% Temporary information from pre to post
+
+-type sub() :: #sub{}.
+
+-spec module(cerl:c_module(), [compile:option()]) ->
+        {'ok',cerl:c_module(),[]}.
+
+module(#c_module{defs=Ds0}=Mod, _Opts) ->
+    Ds1 = [def(D) || D <- Ds0],
+    {ok,Mod#c_module{defs=Ds1},[]}.
+
+def({#c_var{name={F,Arity}}=Name,B0}) ->
+    try
+        put(new_var_num, 0),
+        {B1,_} = cerl_trees:mapfold(fun pre/2, fun post/2, sub_new(undefined), B0),
+        erase(new_var_num),
+        {Name,B1}
+    catch
+        Class:Error ->
+            Stack = erlang:get_stacktrace(),
+            io:fwrite("Function: ~w/~w\n", [F,Arity]),
+            erlang:raise(Class, Error, Stack)
+    end.
+
+pre(#c_let{vars=Vars}=Node, Sub) ->
+    {Node,sub_fold(get_variables(Vars), Sub)};
+
+pre(#c_fun{vars=Vars}=Node, Sub) ->
+    {Node,sub_fold(get_variables(Vars), Sub)};
+
+pre(#c_clause{pats=Pats}=Node, Sub0) ->
+    VarNames = get_variables(Pats),
+    Sub1 = sub_fold(VarNames, Sub0),
+    Keys = get_pattern_keys(Pats),
+    Sub2 = sub_add_keys(Keys, Sub1),
+
+    #sub{v=SubNames,t=Temp} = Sub2,
+    Sub3 = Sub2#sub{v=merge_variables(VarNames, SubNames),
+                    t={clause,Pats,Keys,SubNames,Temp}},
+
+    {Node#c_clause{pats=[]},Sub3};
+
+pre(Node, Sub0) ->
+    %% We cache only tuples and cons.
+    case cerl:is_data(Node) andalso not cerl:is_literal(Node) of
+        false ->
+            {Node,Sub0};
+        true ->
+            Kind = cerl:data_type(Node),
+            Es = cerl:data_es(Node),
+            case sub_cache_nodes(Kind, Es, Sub0) of
+                {Name,Sub1} ->
+                    {cerl:ann_c_var(cerl:get_ann(Node), Name),Sub1};
+                error ->
+                    {Node,Sub0}
+            end
+    end.
+
+post(#c_let{}=Node, Sub) ->
+    {Node,sub_unfold(Sub)};
+
+post(#c_fun{}=Node, Sub) ->
+    {Node,sub_unfold(Sub)};
+
+post(#c_clause{}=Node, #sub{t={clause,Pats0,Keys,V,T}}=Sub0) ->
+    {Sub1,PostKeys} = sub_take_keys(Keys, Sub0),
+    Pats1 = put_pattern_keys(Pats0, PostKeys),
+    Sub2 = sub_unfold(Sub1#sub{v=V,t=T}),
+    {Node#c_clause{pats=Pats1},Sub2};
+
+post(Node, Sub) ->
+    {Node,Sub}.
+
+%% sub_new/1
+%% sub_add_keys/2
+%% sub_take_keys/3
+%% sub_cache_nodes/3
+%%
+%% Manages the substitutions record.
+
+%% Builds a new sub.
+-spec sub_new(term()) -> sub().
+sub_new(Temp) ->
+    #sub{t=Temp}.
+
+%% Folds the sub into a new one if the variables in nodes are not disjoint
+sub_fold(VarNames, #sub{v=SubNames}=Sub) ->
+    case is_disjoint_variables(VarNames, SubNames) of
+        true  -> Sub#sub{t={temp,Sub#sub.t}};
+        false -> sub_new({sub,Sub})
+    end.
+
+%% Unfolds the sub in case one was folded in the previous step
+sub_unfold(#sub{t={temp,Temp}}=Sub) ->
+    Sub#sub{t=Temp};
+sub_unfold(#sub{t={sub,Sub}}) ->
+    Sub.
+
+%% Adds the keys extracted from patterns to the state.
+-spec sub_add_keys([term()], sub()) -> sub().
+sub_add_keys(Keys, #sub{p=Pat0}=Sub) ->
+    Pat1 =
+        lists:foldl(fun(Key, Acc) ->
+            false = maps:is_key(Key, Acc),         %Assertion.
+            maps:put(Key, ?NOTSET, Acc)
+        end, Pat0, Keys),
+    Sub#sub{p=Pat1}.
+
+%% Take the keys from the map taking into account the keys
+%% that have changed as those must become aliases in the pattern.
+-spec sub_take_keys([term()], sub()) -> {sub(), [{term(), atom()}]}.
+sub_take_keys(Keys, #sub{p=Pat0}=Sub) ->
+    {Pat1,Acc} = sub_take_keys(Keys, Pat0, []),
+    {Sub#sub{p=Pat1},Acc}.
+
+sub_take_keys([K|T], Sub0, Acc) ->
+    case maps:take(K, Sub0) of
+        {?NOTSET,Sub1} ->
+            sub_take_keys(T, Sub1, Acc);
+        {Name,Sub1} ->
+            sub_take_keys(T, Sub1, [{K,Name}|Acc])
+    end;
+sub_take_keys([], Sub, Acc) ->
+    {Sub,Acc}.
+
+%% Check if the node can be cached based on the state information.
+%% If it can be cached and it does not have an alias for it, we
+%% build one.
+-spec sub_cache_nodes(atom(), [cerl:cerl()], sub()) -> {atom(), sub()} | error.
+sub_cache_nodes(Kind, Nodes, #sub{p=Pat}=Sub) ->
+    case nodes_to_key(Kind, Nodes) of
+        {ok, Key} ->
+            case Pat of
+                #{Key := ?NOTSET} ->
+                    new_var_name(Key, Sub);
+                #{Key := Name} ->
+                    {Name,Sub};
+                #{} ->
+                    error
+            end;
+        error ->
+            error
+    end.
+
+new_var_name(Key, #sub{p=Pat}=Sub) ->
+    Counter = get(new_var_num),
+    Name = list_to_atom("@r" ++ integer_to_list(Counter)),
+    put(new_var_num, Counter + 1),
+    {Name,Sub#sub{p=maps:put(Key, Name, Pat)}}.
+
+%% get_variables/1
+%% is_disjoint_variables/2
+%% merge_variables/2
+
+get_variables(NodesList) ->
+    cerl_sets:from_list([Var || Node <- NodesList, Var <- cerl_trees:variables(Node)]).
+
+is_disjoint_variables(Vars1, Vars2) ->
+    cerl_sets:is_disjoint(Vars1, Vars2).
+
+merge_variables(Vars1, Vars2) ->
+    cerl_sets:union(Vars1, Vars2).
+
+%% get_pattern_keys/2
+%% put_pattern_keys/2
+%%
+%% Gets keys from patterns or add them as aliases.
+
+get_pattern_keys(Patterns) ->
+    lists:foldl(fun get_pattern_keys/2, [], Patterns).
+
+get_pattern_keys(#c_tuple{es=Es}, Acc0) ->
+    Acc1 = accumulate_pattern_keys(tuple, Es, Acc0),
+    lists:foldl(fun get_pattern_keys/2, Acc1, Es);
+get_pattern_keys(#c_cons{hd=Hd,tl=Tl}, Acc0) ->
+    Acc1 = accumulate_pattern_keys(cons, [Hd, Tl], Acc0),
+    get_pattern_keys(Tl, get_pattern_keys(Hd, Acc1));
+get_pattern_keys(#c_alias{pat=Pat}, Acc0) ->
+    get_pattern_keys(Pat, Acc0);
+get_pattern_keys(#c_map{es=Es}, Acc0) ->
+    lists:foldl(fun get_pattern_keys/2, Acc0, Es);
+get_pattern_keys(#c_map_pair{val=Val}, Acc0) ->
+    get_pattern_keys(Val, Acc0);
+get_pattern_keys(_, Acc) ->
+    Acc.
+
+accumulate_pattern_keys(Kind, Nodes, Acc) ->
+    case nodes_to_key(Kind, Nodes) of
+        {ok,Key} -> [Key|Acc];
+        error -> Acc
+    end.
+
+put_pattern_keys(Patterns, []) ->
+    Patterns;
+put_pattern_keys(Patterns, Keys) ->
+    {NewPatterns,Map} =
+        lists:mapfoldl(fun alias_pattern_keys/2, maps:from_list(Keys), Patterns),
+    %% Check all aliases have been consumed from the map.
+    0 = map_size(Map),
+    NewPatterns.
+
+alias_pattern_keys(#c_tuple{anno=Anno,es=Es0}=Node, Acc0) ->
+    {Es1,Acc1} = lists:mapfoldl(fun alias_pattern_keys/2, Acc0, Es0),
+    nodes_to_alias(tuple, Es0, Anno, Node#c_tuple{es=Es1}, Acc1);
+alias_pattern_keys(#c_cons{anno=Anno,hd=Hd0,tl=Tl0}=Node, Acc0) ->
+    {Hd1,Acc1} = alias_pattern_keys(Hd0, Acc0),
+    {Tl1,Acc2} = alias_pattern_keys(Tl0, Acc1),
+    nodes_to_alias(cons, [Hd0, Tl0], Anno, Node#c_cons{hd=Hd1,tl=Tl1}, Acc2);
+alias_pattern_keys(#c_alias{pat=Pat0}=Node, Acc0) ->
+    {Pat1,Acc1} = alias_pattern_keys(Pat0, Acc0),
+    {Node#c_alias{pat=Pat1}, Acc1};
+alias_pattern_keys(#c_map{es=Es0}=Node, Acc0) ->
+    {Es1,Acc1} = lists:mapfoldl(fun alias_pattern_keys/2, Acc0, Es0),
+    {Node#c_map{es=Es1}, Acc1};
+alias_pattern_keys(#c_map_pair{val=Val0}=Node, Acc0) ->
+    {Val1,Acc1} = alias_pattern_keys(Val0, Acc0),
+    {Node#c_map_pair{val=Val1}, Acc1};
+alias_pattern_keys(Pattern, Acc) ->
+    {Pattern,Acc}.
+
+%% Check if a node must become an alias because
+%% its pattern was used later on as an expression.
+nodes_to_alias(Kind, Inner, Anno, Node, Keys0) ->
+    case nodes_to_key(Kind, Inner) of
+        {ok,Key} ->
+            case maps:take(Key, Keys0) of
+                {Name,Keys1} ->
+                    Var = cerl:ann_c_var(Anno, Name),
+                    {cerl:ann_c_alias(Anno, Var, Node), Keys1};
+                error ->
+                    {Node,Keys0}
+            end;
+        error ->
+            {Node,Keys0}
+     end.
+
+%% Builds the key used to check if a value can be
+%% replaced by an alias. It considers literals,
+%% aliases, variables, tuples and cons recursively.
+nodes_to_key(Kind, Nodes) ->
+    nodes_to_key(Nodes, [], Kind).
+
+nodes_to_key([#c_alias{var=Var}|T], Acc, Kind) ->
+    nodes_to_key([Var|T], Acc, Kind);
+nodes_to_key([#c_var{name=Name}|T], Acc, Kind) ->
+    nodes_to_key(T, [[var,Name]|Acc], Kind);
+nodes_to_key([Node|T], Acc0, Kind) ->
+    case cerl:is_data(Node) of
+        false ->
+            error;
+        true ->
+            case nodes_to_key(cerl:data_es(Node), [], cerl:data_type(Node)) of
+                {ok,Key} ->
+                    nodes_to_key(T, [Key|Acc0], Kind);
+                error ->
+                    error
+            end
+    end;
+nodes_to_key([], Acc, Kind) ->
+    {ok,[Kind|Acc]}.

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 \