Merge pull request #1080 from josevalim/jv-sys-core-replace

Introduce a new core pass called sys_core_alias

OTP-14505

4 files changed, 316 insertions, 2 deletions

diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index ef6db66ff6..9b22e5197b 100644
--- a/lib/compiler/src/Makefile
+++ b/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
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index aa2d224bb4..ec7e7aed14 100644
--- a/lib/compiler/src/compile.erl
+++ b/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},
+        {iff,dcopt,{listing,"copt"}},
+        {unless,no_alias,{pass,sys_core_alias}},
+        {iff,dalias,{listing,"core_alias"}},
 	?pass(core_transforms)]},
-       {iff,dcopt,{listing,"copt"}},
        {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,
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index 3139d68902..703cf1d1b8 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/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,
diff --git a/lib/compiler/src/sys_core_alias.erl b/lib/compiler/src/sys_core_alias.erl
new file mode 100644
index 0000000000..63e2f7488e
--- /dev/null
+++ b/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]}.