aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/src/Makefile2
-rw-r--r--lib/compiler/src/beam_clean.erl58
-rw-r--r--lib/compiler/src/beam_jump.erl223
-rw-r--r--lib/compiler/src/beam_utils.erl68
-rw-r--r--lib/compiler/src/compile.erl7
-rw-r--r--lib/compiler/src/compiler.app.src1
-rw-r--r--lib/compiler/src/sys_core_alias.erl308
-rw-r--r--lib/compiler/src/sys_core_fold.erl23
-rw-r--r--lib/compiler/src/v3_core.erl45
-rw-r--r--lib/compiler/test/Makefile1
-rw-r--r--lib/compiler/test/compile_SUITE.erl35
-rw-r--r--lib/compiler/test/core_alias_SUITE.erl195
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl28
-rw-r--r--lib/compiler/test/misc_SUITE.erl3
-rw-r--r--lib/compiler/test/trycatch_SUITE.erl6
15 files changed, 838 insertions, 165 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/beam_clean.erl b/lib/compiler/src/beam_clean.erl
index b736d39f9c..e094c2c320 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -24,7 +24,7 @@
-export([module/2]).
-export([bs_clean_saves/1]).
-export([clean_labels/1]).
--import(lists, [map/2,foldl/3,reverse/1,filter/2]).
+-import(lists, [foldl/3,reverse/1,filter/2]).
-spec module(beam_utils:module_code(), [compile:option()]) ->
{'ok',beam_utils:module_code()}.
@@ -118,7 +118,7 @@ add_to_work_list(F, {Fs,Used}=Sets) ->
clean_labels(Fs0) ->
St0 = #st{lmap=[],entry=1,lc=1},
{Fs1,#st{lmap=Lmap0,lc=Lc}} = function_renumber(Fs0, St0, []),
- Lmap = gb_trees:from_orddict(ordsets:from_list(Lmap0)),
+ Lmap = maps:from_list(Lmap0),
Fs = function_replace(Fs1, Lmap, []),
{Fs,Lc}.
@@ -187,7 +187,8 @@ is_record_tuple(_, _, _) -> no.
function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) ->
Asm = try
- replace(Asm0, [], Dict)
+ Fb = fun(Old) -> throw({error,{undefined_label,Old}}) end,
+ beam_utils:replace_labels(Asm0, [], Dict, Fb)
catch
throw:{error,{undefined_label,Lbl}=Reason} ->
io:format("Function ~s/~w refers to undefined label ~w\n",
@@ -197,57 +198,6 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) ->
function_replace(Fs, Dict, [{function,Name,Arity,Entry,Asm}|Acc]);
function_replace([], _, Acc) -> Acc.
-replace([{test,Test,{f,Lbl},Ops}|Is], Acc, D) ->
- replace(Is, [{test,Test,{f,label(Lbl, D)},Ops}|Acc], D);
-replace([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D) ->
- replace(Is, [{test,Test,{f,label(Lbl, D)},Live,Ops,Dst}|Acc], D);
-replace([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D) ->
- Vls = map(fun ({f,L}) -> {f,label(L, D)};
- (Other) -> Other
- end, Vls0),
- Fail = label(Fail0, D),
- replace(Is, [{select,I,R,{f,Fail},Vls}|Acc], D);
-replace([{'try',R,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{'try',R,{f,label(Lbl, D)}}|Acc], D);
-replace([{'catch',R,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{'catch',R,{f,label(Lbl, D)}}|Acc], D);
-replace([{jump,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{jump,{f,label(Lbl, D)}}|Acc], D);
-replace([{loop_rec,{f,Lbl},R}|Is], Acc, D) ->
- replace(Is, [{loop_rec,{f,label(Lbl, D)},R}|Acc], D);
-replace([{loop_rec_end,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{loop_rec_end,{f,label(Lbl, D)}}|Acc], D);
-replace([{wait,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{wait,{f,label(Lbl, D)}}|Acc], D);
-replace([{wait_timeout,{f,Lbl},To}|Is], Acc, D) ->
- replace(Is, [{wait_timeout,{f,label(Lbl, D)},To}|Acc], D);
-replace([{bif,Name,{f,Lbl},As,R}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bif,Name,{f,label(Lbl, D)},As,R}|Acc], D);
-replace([{gc_bif,Name,{f,Lbl},Live,As,R}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{gc_bif,Name,{f,label(Lbl, D)},Live,As,R}|Acc], D);
-replace([{call,Ar,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{call,Ar,{f,label(Lbl,D)}}|Acc], D);
-replace([{make_fun2,{f,Lbl},U1,U2,U3}|Is], Acc, D) ->
- replace(Is, [{make_fun2,{f,label(Lbl, D)},U1,U2,U3}|Acc], D);
-replace([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bs_init,{f,label(Lbl, D)},Info,Live,Ss,Dst}|Acc], D);
-replace([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bs_put,{f,label(Lbl, D)},Info,Ss}|Acc], D);
-replace([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D)
- when Lbl =/= 0 ->
- replace(Is, [{I,{f,label(Lbl, D)},Op,Src,Dst,Live,List}|Acc], D);
-replace([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{I,{f,label(Lbl, D)},Src,List}|Acc], D);
-replace([I|Is], Acc, D) ->
- replace(Is, [I|Acc], D);
-replace([], Acc, _) -> Acc.
-
-label(Old, D) ->
- case gb_trees:lookup(Old, D) of
- {value,Val} -> Val;
- none -> throw({error,{undefined_label,Old}})
- end.
-
%%%
%%% Final fixup of bs_start_match2/5,bs_save2/bs_restore2 instructions for
%%% new bit syntax matching (introduced in R11B).
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 4365451356..0bcec9ce19 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -71,9 +71,9 @@
%%%
%%% jump L2
%%% . . .
-%%% L1:
%%% L2: ...
%%%
+%%% and all preceding uses of L1 renamed to L2.
%%% If the jump is unreachable, it will be removed according to (1).
%%%
%%% (5) In
@@ -156,41 +156,46 @@ function({function,Name,Arity,CLabel,Asm0}) ->
%%%
share(Is0) ->
- %% We will get more sharing if we never fall through to a label.
- Is = eliminate_fallthroughs(Is0, []),
- share_1(Is, #{}, [], []).
+ Is1 = eliminate_fallthroughs(Is0, []),
+ Is2 = find_fixpoint(fun(Is) ->
+ share_1(Is, #{}, #{}, [], [])
+ end, Is1),
+ reverse(Is2).
-share_1([{label,L}=Lbl|Is], Dict0, [_|_]=Seq, Acc) ->
+share_1([{label,L}=Lbl|Is], Dict0, Lbls0, [_|_]=Seq, Acc) ->
case maps:find(Seq, Dict0) of
error ->
Dict = maps:put(Seq, L, Dict0),
- share_1(Is, Dict, [], [Lbl|Seq ++ Acc]);
+ share_1(Is, Dict, Lbls0, [], [Lbl|Seq ++ Acc]);
{ok,Label} ->
- share_1(Is, Dict0, [], [Lbl,{jump,{f,Label}}|Acc])
+ Lbls = maps:put(L, Label, Lbls0),
+ share_1(Is, Dict0, Lbls, [], [Lbl,{jump,{f,Label}}|Acc])
end;
-share_1([{func_info,_,_,_}=I|Is], _, [], Acc) ->
- reverse(Is, [I|Acc]);
-share_1([{'catch',_,_}=I|Is], Dict0, Seq, Acc) ->
- Dict = clean_non_sharable(Dict0),
- share_1(Is, Dict, [I|Seq], Acc);
-share_1([{'try',_,_}=I|Is], Dict0, Seq, Acc) ->
- Dict = clean_non_sharable(Dict0),
- share_1(Is, Dict, [I|Seq], Acc);
-share_1([{try_case,_}=I|Is], Dict0, Seq, Acc) ->
- Dict = clean_non_sharable(Dict0),
- share_1(Is, Dict, [I|Seq], Acc);
-share_1([{catch_end,_}=I|Is], Dict0, Seq, Acc) ->
- Dict = clean_non_sharable(Dict0),
- share_1(Is, Dict, [I|Seq], Acc);
-share_1([I|Is], Dict, Seq, Acc) ->
+share_1([{func_info,_,_,_}|_]=Is, _, Lbls, [], Acc) when Lbls =/= #{} ->
+ beam_utils:replace_labels(Acc, Is, Lbls, fun(Old) -> Old end);
+share_1([{func_info,_,_,_}|_]=Is, _, Lbls, [], Acc) when Lbls =:= #{} ->
+ reverse(Acc, Is);
+share_1([{'catch',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) ->
+ {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0),
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
+share_1([{'try',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) ->
+ {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0),
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
+share_1([{try_case,_}=I|Is], Dict0, Lbls0, Seq, Acc) ->
+ {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0),
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
+share_1([{catch_end,_}=I|Is], Dict0, Lbls0, Seq, Acc) ->
+ {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0),
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
+share_1([I|Is], Dict, Lbls, Seq, Acc) ->
case is_unreachable_after(I) of
false ->
- share_1(Is, Dict, [I|Seq], Acc);
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
true ->
- share_1(Is, Dict, [I], Acc)
+ share_1(Is, Dict, Lbls, [I], Acc)
end.
-clean_non_sharable(Dict) ->
+clean_non_sharable(Dict0, Lbls0) ->
%% We are passing in or out of a 'catch' or 'try' block. Remove
%% sequences that should not be shared over the boundaries of the
%% block. Since the end of the sequence must match, the only
@@ -198,7 +203,17 @@ clean_non_sharable(Dict) ->
%% the 'catch'/'try' block is a sequence that ends with an
%% instruction that causes an exception. Any sequence that causes
%% an exception must contain a line/1 instruction.
- maps:filter(fun(K, _V) -> sharable_with_try(K) end, Dict).
+ Dict1 = maps:to_list(Dict0),
+ Lbls1 = maps:to_list(Lbls0),
+ {Dict2,Lbls2} = foldl(fun({K, V}, {Dict,Lbls}) ->
+ case sharable_with_try(K) of
+ true ->
+ {[{K,V}|Dict],lists:keydelete(V, 2, Lbls)};
+ false ->
+ {Dict,Lbls}
+ end
+ end, {[],Lbls1}, Dict1),
+ {maps:from_list(Dict2),maps:from_list(Lbls2)}.
sharable_with_try([{line,_}|_]) ->
%% This sequence may cause an exception and may potentially
@@ -275,14 +290,15 @@ extract_seq_1(_, _) -> no.
-record(st,
{
entry :: beam_asm:label(), %Entry label (must not be moved).
- mlbl :: #{beam_asm:label() := [beam_asm:label()]}, %Moved labels.
- labels :: cerl_sets:set() %Set of referenced labels.
+ replace :: #{beam_asm:label() := beam_asm:label()}, %Labels to replace.
+ labels :: cerl_sets:set(), %Set of referenced labels.
+ index :: beam_utils:code_index() | {lazy,[beam_utils:instruction()]} %Index built lazily only if needed
}).
opt(Is0, CLabel) ->
find_fixpoint(fun(Is) ->
Lbls = initial_labels(Is),
- St = #st{entry=CLabel,mlbl=#{},labels=Lbls},
+ St = #st{entry=CLabel,replace=#{},labels=Lbls,index={lazy,Is}},
opt(Is, [], St)
end, Is0).
@@ -292,7 +308,7 @@ find_fixpoint(OptFun, Is0) ->
Is -> find_fixpoint(OptFun, Is)
end.
-opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc, St) ->
+opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc0, St0) ->
%% We have
%% Test Label Ops
%% jump Label
@@ -301,10 +317,34 @@ opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc, St) ->
case beam_utils:is_pure_test(I) of
false ->
%% Test is not pure; we must keep it.
- opt(Is, [I|Acc], label_used(Lbl, St));
+ opt(Is, [I|Acc0], label_used(Lbl, St0));
true ->
%% The test is pure and its failure label is the same
%% as in the jump that follows -- thus it is not needed.
+ %% Check if any of the previous instructions could also be eliminated.
+ {Acc,St} = opt_useless_loads(Acc0, L, St0),
+ opt(Is, Acc, St)
+ end;
+opt([{test,_,{f,L}=Lbl,_}=I|[{label,L}|_]=Is], Acc0, St0) ->
+ %% Similar to the above, except we have a fall-through rather than jump
+ %% Test Label Ops
+ %% label Label
+ case beam_utils:is_pure_test(I) of
+ false ->
+ opt(Is, [I|Acc0], label_used(Lbl, St0));
+ true ->
+ {Acc,St} = opt_useless_loads(Acc0, L, St0),
+ opt(Is, Acc, St)
+ end;
+opt([{test,_,{f,L}=Lbl,_}=I|[{label,L}|_]=Is], Acc0, St0) ->
+ %% Similar to the above, except we have a fall-through rather than jump
+ %% Test Label Ops
+ %% label Label
+ case beam_utils:is_pure_test(I) of
+ false ->
+ opt(Is, [I|Acc0], label_used(Lbl, St0));
+ true ->
+ {Acc,St} = opt_useless_loads(Acc0, L, St0),
opt(Is, Acc, St)
end;
opt([{test,Test0,{f,L}=Lbl,Ops}=I|[{jump,To}|Is]=Is0], Acc, St) ->
@@ -326,30 +366,16 @@ opt([{test,_,{f,_}=Lbl,_,_,_}=I|Is], Acc, St) ->
opt(Is, [I|Acc], label_used(Lbl, St));
opt([{select,_,_R,Fail,Vls}=I|Is], Acc, St) ->
skip_unreachable(Is, [I|Acc], label_used([Fail|Vls], St));
-opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) ->
- case maps:find(Lbl, Mlbl) of
- {ok,Lbls} ->
- %% Essential to remove the list of labels from the dictionary,
- %% since we will rescan the inserted labels. We MUST rescan.
- St = St0#st{mlbl=maps:remove(Lbl, Mlbl)},
- insert_labels([Lbl|Lbls], Is, Acc, St);
- error ->
- opt(Is, [I|Acc], St0)
- end;
+opt([{label,From}=I,{label,To}|Is], Acc, #st{replace=Replace}=St) ->
+ opt([I|Is], Acc, St#st{replace=Replace#{To => From}});
opt([{jump,{f,_}=X}|[{label,_},{jump,X}|_]=Is], Acc, St) ->
opt(Is, Acc, St);
opt([{jump,{f,Lbl}}|[{label,Lbl}|_]=Is], Acc, St) ->
opt(Is, Acc, St);
-opt([{jump,{f,L}=Lbl}=I|Is], Acc0, #st{mlbl=Mlbl0}=St0) ->
- %% All labels before this jump instruction should now be
- %% moved to the location of the jump's target.
- {Lbls,Acc} = collect_labels(Acc0, St0),
- St = case Lbls of
- [] -> St0;
- [_|_] ->
- Mlbl = maps_append_list(L, Lbls, Mlbl0),
- St0#st{mlbl=Mlbl}
- end,
+opt([{jump,{f,L}=Lbl}=I|Is], Acc0, St0) ->
+ %% Replace all labels before this jump instruction into the
+ %% location of the jump's target.
+ {Acc,St} = collect_labels(Acc0, L, St0),
skip_unreachable(Is, [I|Acc], label_used(Lbl, St));
%% Optimization: quickly handle some common instructions that don't
%% have any failure labels and where is_unreachable_after(I) =:= false.
@@ -369,36 +395,72 @@ opt([I|Is], Acc, #st{labels=Used0}=St0) ->
true -> skip_unreachable(Is, [I|Acc], St);
false -> opt(Is, [I|Acc], St)
end;
-opt([], Acc, #st{mlbl=Mlbl}) ->
- Code = reverse(Acc),
- insert_fc_labels(Code, Mlbl).
-
-insert_fc_labels([{label,L}=I|Is0], Mlbl) ->
- case maps:find(L, Mlbl) of
- error ->
- [I|insert_fc_labels(Is0, Mlbl)];
- {ok,Lbls} ->
- Is = [{label,Lb} || Lb <- Lbls] ++ Is0,
- [I|insert_fc_labels(Is, maps:remove(L, Mlbl))]
+opt([], Acc, #st{replace=Replace0}) when Replace0 =/= #{} ->
+ Replace = normalize_replace(maps:to_list(Replace0), Replace0, []),
+ beam_utils:replace_labels(Acc, [], Replace, fun(Old) -> Old end);
+opt([], Acc, #st{replace=Replace}) when Replace =:= #{} ->
+ reverse(Acc).
+
+normalize_replace([{From,To0}|Rest], Replace, Acc) ->
+ case Replace of
+ #{To0 := To} ->
+ normalize_replace([{From,To}|Rest], Replace, Acc);
+ _ ->
+ normalize_replace(Rest, Replace, [{From,To0}|Acc])
end;
-insert_fc_labels([_|_]=Is, _) -> Is.
-
-maps_append_list(K,Vs,M) ->
- case M of
- #{K:=Vs0} -> M#{K:=Vs0++Vs}; % same order as dict
- _ -> M#{K => Vs}
- end.
+normalize_replace([], _Replace, Acc) ->
+ maps:from_list(Acc).
+
+%% After eliminating a test, it might happen, that a register was only used
+%% in this test. Let's check if that was the case and if it was so, we can
+%% eliminate the load into the register completely.
+opt_useless_loads([{block,_}|_]=Is, L, #st{index={lazy,FIs}}=St) ->
+ opt_useless_loads(Is, L, St#st{index=beam_utils:index_labels(FIs)});
+opt_useless_loads([{block,Block0}|Is], L, #st{index=Index}=St) ->
+ case opt_useless_block_loads(Block0, L, Index) of
+ [] ->
+ opt_useless_loads(Is, L, St);
+ [_|_]=Block ->
+ {[{block,Block}|Is],St}
+ end;
+%% After eliminating the test and useless blocks, it might happen,
+%% that the previous test could also be eliminated.
+%% It might be that the label was already marked as used, even if ultimately,
+%% it never will be - we can't do much about it at that point, though
+opt_useless_loads([{test,_,{f,L},_}=I|Is], L, St) ->
+ case beam_utils:is_pure_test(I) of
+ false ->
+ {[I|Is],St};
+ true ->
+ opt_useless_loads(Is, L, St)
+ end;
+opt_useless_loads(Is, _L, St) ->
+ {Is,St}.
+
+opt_useless_block_loads([{set,[Dst],_,_}=I|Is], L, Index) ->
+ BlockJump = [{block,Is},{jump,{f,L}}],
+ case beam_utils:is_killed(Dst, BlockJump, Index) of
+ true ->
+ %% The register is killed and not used, we can remove the load
+ opt_useless_block_loads(Is, L, Index);
+ false ->
+ [I|opt_useless_block_loads(Is, L, Index)]
+ end;
+opt_useless_block_loads([I|Is], L, Index) ->
+ [I|opt_useless_block_loads(Is, L, Index)];
+opt_useless_block_loads([], _L, _Index) ->
+ [].
-collect_labels(Is, #st{entry=Entry}) ->
- collect_labels_1(Is, Entry, []).
+collect_labels(Is, Label, #st{entry=Entry,replace=Replace} = St) ->
+ collect_labels_1(Is, Label, Entry, Replace, St).
-collect_labels_1([{label,Entry}|_]=Is, Entry, Acc) ->
+collect_labels_1([{label,Entry}|_]=Is, _Label, Entry, Acc, St) ->
%% Never move the entry label.
- {Acc,Is};
-collect_labels_1([{label,L}|Is], Entry, Acc) ->
- collect_labels_1(Is, Entry, [L|Acc]);
-collect_labels_1(Is, _Entry, Acc) ->
- {Acc,Is}.
+ {Is,St#st{replace=Acc}};
+collect_labels_1([{label,L}|Is], Label, Entry, Acc, St) ->
+ collect_labels_1(Is, Label, Entry, Acc#{L => Label}, St);
+collect_labels_1(Is, _Label, _Entry, Acc, St) ->
+ {Is,St#st{replace=Acc}}.
%% label_defined(Is, Label) -> true | false.
%% Test whether the label Label is defined at the start of the instruction
@@ -418,13 +480,6 @@ invert_test(is_eq_exact) -> is_ne_exact;
invert_test(is_ne_exact) -> is_eq_exact;
invert_test(_) -> not_possible.
-insert_labels([L|Ls], Is, [{jump,{f,L}}|Acc], St) ->
- insert_labels(Ls, [{label,L}|Is], Acc, St);
-insert_labels([L|Ls], Is, Acc, St) ->
- insert_labels(Ls, [{label,L}|Is], Acc, St);
-insert_labels([], Is, Acc, St) ->
- opt(Is, Acc, St).
-
%% skip_unreachable([Instruction], St).
%% Remove all instructions (including definitions of labels
%% that have not been referenced yet) up to the next
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index e39fbdc3b7..52ed1c7ca0 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -23,14 +23,14 @@
-module(beam_utils).
-export([is_killed_block/2,is_killed/3,is_killed_at/3,
is_not_used/3,
- empty_label_index/0,index_label/3,index_labels/1,
+ empty_label_index/0,index_label/3,index_labels/1,replace_labels/4,
code_at/2,bif_to_test/3,is_pure_test/1,
live_opt/1,delete_live_annos/1,combine_heap_needs/2,
split_even/1]).
-export_type([code_index/0,module_code/0,instruction/0]).
--import(lists, [member/2,sort/1,reverse/1,splitwith/2]).
+-import(lists, [map/2,member/2,sort/1,reverse/1,splitwith/2]).
%% instruction() describes all instructions that are used during optimzation
%% (from beam_a to beam_z).
@@ -160,6 +160,18 @@ index_label(Lbl, Is0, Acc) ->
code_at(L, Ll) ->
gb_trees:get(L, Ll).
+%% replace_labels(FunctionIs, Tail, ReplaceDb, Fallback) -> FunctionIs.
+%% Replace all labels in instructions according to the ReplaceDb.
+%% If label is not found the Fallback is called with the label to
+%% produce a new one.
+
+-spec replace_labels([instruction()],
+ [instruction()],
+ #{beam_asm:label() => beam_asm:label()},
+ fun((beam_asm:label()) -> term())) -> [instruction()].
+replace_labels(Is, Acc, D, Fb) ->
+ replace_labels_1(Is, Acc, D, Fb).
+
%% bif_to_test(Bif, [Op], Fail) -> {test,Test,Fail,[Op]}
%% Convert a BIF to a test. Fail if not possible.
@@ -643,6 +655,58 @@ index_labels_1([], Acc) -> gb_trees:from_orddict(sort(Acc)).
drop_labels([{label,_}|Is]) -> drop_labels(Is);
drop_labels(Is) -> Is.
+
+replace_labels_1([{test,Test,{f,Lbl},Ops}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Ops}|Acc], D, Fb);
+replace_labels_1([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Live,Ops,Dst}|Acc], D, Fb);
+replace_labels_1([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D, Fb) ->
+ Vls = map(fun ({f,L}) -> {f,label(L, D, Fb)};
+ (Other) -> Other
+ end, Vls0),
+ Fail = label(Fail0, D, Fb),
+ replace_labels_1(Is, [{select,I,R,{f,Fail},Vls}|Acc], D, Fb);
+replace_labels_1([{'try',R,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{'try',R,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{'catch',R,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{'catch',R,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{jump,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{jump,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{loop_rec,{f,Lbl},R}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{loop_rec,{f,label(Lbl, D, Fb)},R}|Acc], D, Fb);
+replace_labels_1([{loop_rec_end,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{loop_rec_end,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{wait,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{wait,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{wait_timeout,{f,Lbl},To}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{wait_timeout,{f,label(Lbl, D, Fb)},To}|Acc], D, Fb);
+replace_labels_1([{bif,Name,{f,Lbl},As,R}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{bif,Name,{f,label(Lbl, D, Fb)},As,R}|Acc], D, Fb);
+replace_labels_1([{gc_bif,Name,{f,Lbl},Live,As,R}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{gc_bif,Name,{f,label(Lbl, D, Fb)},Live,As,R}|Acc], D, Fb);
+replace_labels_1([{call,Ar,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{call,Ar,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{make_fun2,{f,Lbl},U1,U2,U3}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{make_fun2,{f,label(Lbl, D, Fb)},U1,U2,U3}|Acc], D, Fb);
+replace_labels_1([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{bs_init,{f,label(Lbl, D, Fb)},Info,Live,Ss,Dst}|Acc], D, Fb);
+replace_labels_1([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{bs_put,{f,label(Lbl, D, Fb)},Info,Ss}|Acc], D, Fb);
+replace_labels_1([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D, Fb)
+ when Lbl =/= 0 ->
+ replace_labels_1(Is, [{I,{f,label(Lbl, D, Fb)},Op,Src,Dst,Live,List}|Acc], D, Fb);
+replace_labels_1([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{I,{f,label(Lbl, D, Fb)},Src,List}|Acc], D, Fb);
+replace_labels_1([I|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [I|Acc], D, Fb);
+replace_labels_1([], Acc, _, _) -> Acc.
+
+label(Old, D, Fb) ->
+ case D of
+ #{Old := New} -> New;
+ _ -> Fb(Old)
+ end.
+
%% Help functions for combine_heap_needs.
combine_alloc_lists(Al1, Al2) ->
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]}.
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index d73060fb7e..f3f315935a 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -2422,16 +2422,10 @@ move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner,
Outer#c_let{vars=OuterVs,arg=Arg,
body=Inner#c_let{vars=InnerVs,arg=OuterBody,body=InnerBody}};
move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
- #c_case{arg=Cexpr0,clauses=[Ca0,Cb0|Cs]}=Case, Sub0) ->
- %% Test if there are no more clauses than Ca0 and Cb0, or if
- %% Cb0 is guaranteed to match.
- TwoClauses = Cs =:= [] orelse
- case Cb0 of
- #c_clause{pats=[#c_var{}],guard=#c_literal{val=true}} -> true;
- _ -> false
- end,
- case {TwoClauses,is_failing_clause(Ca0),is_failing_clause(Cb0)} of
- {true,false,true} ->
+ #c_case{arg=Cexpr0,clauses=[Ca0|Cs0]}=Case, Sub0) ->
+ case not is_failing_clause(Ca0) andalso
+ are_all_failing_clauses(Cs0) of
+ true ->
%% let <Lvars> = case <Case-expr> of
%% <Cpats> -> <Clause-body>;
%% <OtherCpats> -> erlang:error(...)
@@ -2467,8 +2461,8 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
body=Lbody},
Ca = Ca0#c_clause{pats=CaPats,guard=G,body=B},
- Cb = clause(Cb0, Cexpr, value, Sub0),
- Case#c_case{arg=Cexpr,clauses=[Ca,Cb]}
+ Cs = [clause(C, Cexpr, value, Sub0) || C <- Cs0],
+ Case#c_case{arg=Cexpr,clauses=[Ca|Cs]}
catch
nomatch ->
%% This is not a defeat. The code will eventually
@@ -2476,7 +2470,7 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
%% optimizations done in this module.
impossible
end;
- {_,_,_} -> impossible
+ false -> impossible
end;
move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
#c_seq{arg=Sarg0,body=Sbody0}=Seq, Sub0) ->
@@ -2499,6 +2493,9 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
body=Lbody}};
move_let_into_expr(_Let, _Expr, _Sub) -> impossible.
+are_all_failing_clauses(Cs) ->
+ all(fun is_failing_clause/1, Cs).
+
is_failing_clause(#c_clause{body=B}) ->
will_fail(B).
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index ae650546e5..20cb3343fb 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -2505,8 +2505,46 @@ cexpr(#ifun{anno=#a{us=Us0}=A0,name={named,Name},fc=#iclause{pats=Ps}}=Fun0,
end;
cexpr(#iapply{anno=A,op=Op,args=Args}, _As, St) ->
{#c_apply{anno=A#a.anno,op=Op,args=Args},[],A#a.us,St};
-cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St) ->
- {#c_call{anno=A#a.anno,module=Mod,name=Name,args=Args},[],A#a.us,St};
+cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St0) ->
+ Anno = A#a.anno,
+ case (not cerl:is_c_atom(Mod)) andalso member(tuple_calls, St0#core.opts) of
+ true ->
+ GenAnno = [compiler_generated|Anno],
+
+ %% Generate the clause that matches on the tuple
+ {TupleVar,St1} = new_var(GenAnno, St0),
+ {TupleSizeVar, St2} = new_var(GenAnno, St1),
+ {TupleModVar, St3} = new_var(GenAnno, St2),
+ {TupleArgsVar, St4} = new_var(GenAnno, St3),
+ TryVar = cerl:c_var('Try'),
+
+ TupleGuardExpr =
+ cerl:c_let([TupleSizeVar],
+ c_call_erl(tuple_size, [TupleVar]),
+ c_call_erl('>', [TupleSizeVar, cerl:c_int(0)])),
+
+ TupleGuard =
+ cerl:c_try(TupleGuardExpr, [TryVar], TryVar,
+ [cerl:c_var('T'),cerl:c_var('R')], cerl:c_atom(false)),
+
+ TupleApply =
+ cerl:c_let([TupleModVar],
+ c_call_erl(element, [cerl:c_int(1),TupleVar]),
+ cerl:c_let([TupleArgsVar],
+ cerl:make_list(Args ++ [TupleVar]),
+ c_call_erl(apply, [TupleModVar,Name,TupleArgsVar]))),
+
+ TupleClause = cerl:ann_c_clause(GenAnno, [TupleVar], TupleGuard, TupleApply),
+
+ %% Generate the fallback clause
+ {OtherVar,St5} = new_var(GenAnno, St4),
+ OtherApply = cerl:ann_c_call(GenAnno, OtherVar, Name, Args),
+ OtherClause = cerl:ann_c_clause(GenAnno, [OtherVar], OtherApply),
+
+ {cerl:ann_c_case(GenAnno, Mod, [TupleClause,OtherClause]),[],A#a.us,St5};
+ false ->
+ {#c_call{anno=Anno,module=Mod,name=Name,args=Args},[],A#a.us,St0}
+ end;
cexpr(#iprimop{anno=A,name=Name,args=Args}, _As, St) ->
{#c_primop{anno=A#a.anno,name=Name,args=Args},[],A#a.us,St};
cexpr(#iprotect{anno=A,body=Es}, _As, St0) ->
@@ -2536,6 +2574,9 @@ cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) ->
clauses=Ccs ++ [Cfc]}},
[],A#a.us,St2}.
+c_call_erl(Fun, Args) ->
+ cerl:c_call(cerl:c_atom(erlang), cerl:c_atom(Fun), Args).
+
%% lit_vars(Literal) -> [Var].
lit_vars(Lit) -> lit_vars(Lit, []).
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/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index f647a4030d..aaa2005e73 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -32,7 +32,7 @@
binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1,
other_output/1, kernel_listing/1, encrypted_abstr/1,
strict_record/1, utf8_atoms/1, utf8_functions/1, extra_chunks/1,
- cover/1, env/1, core_pp/1,
+ cover/1, env/1, core_pp/1, tuple_calls/1,
core_roundtrip/1, asm/1, optimized_guards/1,
sys_pre_attributes/1, dialyzer/1,
warnings/1, pre_load_check/1, env_compiler_options/1,
@@ -49,7 +49,7 @@ all() ->
test_lib:recompile(?MODULE),
[app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir,
binary, makedep, cond_and_ifdef, listings, listings_big,
- other_output, kernel_listing, encrypted_abstr,
+ other_output, kernel_listing, encrypted_abstr, tuple_calls,
strict_record, utf8_atoms, utf8_functions, extra_chunks,
cover, env, core_pp, core_roundtrip, asm, optimized_guards,
sys_pre_attributes, dialyzer, warnings, pre_load_check,
@@ -781,6 +781,37 @@ extra_chunks(Config) when is_list(Config) ->
{ok,{extra_chunks,[{"ExCh",<<"Contents">>}]}} =
beam_lib:chunks(ExtraChunksBinary, ["ExCh"]).
+tuple_calls(Config) when is_list(Config) ->
+ Anno = erl_anno:new(1),
+ Forms = [{attribute,Anno,export,[{size,1},{store,1}]},
+ {function,Anno,size,1,
+ [{clause,Anno,[{var,[],mod}],[],
+ [{call,[],{remote,[],{var,[],mod},{atom,[],size}},[]}]}]},
+ {function,Anno,store,1,
+ [{clause,Anno,[{var,[],mod}],[],
+ [{call,[],{remote,[],{var,[],mod},{atom,[],store}},[{atom,[],key},{atom,[],value}]}]}]}],
+
+ TupleCallsFalse = [{attribute,Anno,module,tuple_calls_false}|Forms],
+ {ok,_,TupleCallsFalseBinary} = compile:forms(TupleCallsFalse, [binary]),
+ code:load_binary(tuple_calls_false, "compile_SUITE.erl", TupleCallsFalseBinary),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_false:store(dict())),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_false:size(dict())),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_false:size(empty_tuple())),
+
+ TupleCallsTrue = [{attribute,Anno,module,tuple_calls_true}|Forms],
+ {ok,_,TupleCallsTrueBinary} = compile:forms(TupleCallsTrue, [binary,tuple_calls]),
+ code:load_binary(tuple_calls_true, "compile_SUITE.erl", TupleCallsTrueBinary),
+ Dict = tuple_calls_true:store(dict()),
+ 1 = tuple_calls_true:size(Dict),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_true:size(empty_tuple())),
+
+ ok.
+
+dict() ->
+ dict:new().
+empty_tuple() ->
+ {}.
+
env(Config) when is_list(Config) ->
{Simple,Target} = get_files(Config, simple, env),
{ok,Cwd} = file:get_cwd(),
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/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index 0097e28d4d..262967d03d 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -26,7 +26,8 @@
unused_multiple_values_error/1,unused_multiple_values/1,
multiple_aliases/1,redundant_boolean_clauses/1,
mixed_matching_clauses/1,unnecessary_building/1,
- no_no_file/1,configuration/1,supplies/1]).
+ no_no_file/1,configuration/1,supplies/1,
+ redundant_stack_frame/1]).
-export([foo/0,foo/1,foo/2,foo/3]).
@@ -45,7 +46,8 @@ groups() ->
unused_multiple_values_error,unused_multiple_values,
multiple_aliases,redundant_boolean_clauses,
mixed_matching_clauses,unnecessary_building,
- no_no_file,configuration,supplies]}].
+ no_no_file,configuration,supplies,
+ redundant_stack_frame]}].
init_per_suite(Config) ->
@@ -527,4 +529,26 @@ supplies(_Config) ->
do_supplies(#{1 := Value}) when byte_size(Value), byte_size(kg) -> working.
+redundant_stack_frame(_Config) ->
+ {1,2} = do_redundant_stack_frame(#{x=>1,y=>2}),
+ {'EXIT',{{badkey,_,x},_}} = (catch do_redundant_stack_frame(#{y=>2})),
+ {'EXIT',{{badkey,_,y},_}} = (catch do_redundant_stack_frame(#{x=>1})),
+ ok.
+
+do_redundant_stack_frame(Map) ->
+ %% There should not be a stack frame for this function.
+ X = case Map of
+ #{x := X0} ->
+ X0;
+ #{} ->
+ erlang:error({badkey, Map, x})
+ end,
+ Y = case Map of
+ #{y := Y0} ->
+ Y0;
+ #{} ->
+ erlang:error({badkey, Map, y})
+ end,
+ {X, Y}.
+
id(I) -> I.
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),
diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl
index a591d6cc93..42dbf7d5f0 100644
--- a/lib/compiler/test/trycatch_SUITE.erl
+++ b/lib/compiler/test/trycatch_SUITE.erl
@@ -324,11 +324,11 @@ eclectic(Conf) when is_list(Conf) ->
{{error,{exit,V},{'EXIT',V}},V} =
eclectic_1({foo,{error,{exit,V}}}, error, {value,V}),
{{value,{value,V},V},
- {'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}} =
+ {'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}} =
eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}),
{{'EXIT',V},V} =
eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}),
- {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,2,_}|_]}}},
+ {{error,{'div',{1,0}},{'EXIT',{badarith,[{erlang,'div',[1,0],_},{?MODULE,my_div,2,_}|_]}}},
{'EXIT',V}} =
eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}),
{{{error,V},{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},
@@ -345,7 +345,7 @@ eclectic(Conf) when is_list(Conf) ->
eclectic_2({error,{value,V}}, throw, {error,V}),
{{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} =
eclectic_2({value,{'abs',V}}, undefined, {value,V}),
- {{caught,{'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}},V} =
+ {{caught,{'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}},V} =
eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}),
{{caught,{'EXIT',V}},undefined} =
eclectic_2({value,{error,V}}, undefined, {exit,V}),
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-04 03:52:36 +0000