diff options
Diffstat (limited to 'lib/compiler/src')
| -rw-r--r-- | lib/compiler/src/Makefile | 5 | ||||
| -rw-r--r-- | lib/compiler/src/compile.erl | 66 | ||||
| -rw-r--r-- | lib/compiler/src/compiler.app.src | 4 | ||||
| -rwxr-xr-x | lib/compiler/src/genop.tab | 2 | ||||
| -rw-r--r-- | lib/compiler/src/sys_core_alias.erl | 308 | ||||
| -rw-r--r-- | lib/compiler/src/sys_core_bsm.erl | 355 | ||||
| -rw-r--r-- | lib/compiler/src/sys_core_fold.erl | 314 | ||||
| -rw-r--r-- | lib/compiler/src/v3_core.erl | 45 | ||||
| -rw-r--r-- | lib/compiler/src/v3_kernel.erl | 27 | ||||
| -rw-r--r-- | lib/compiler/src/v3_kernel_pp.erl | 2 |
10 files changed, 808 insertions, 320 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 59b80ade5d..9b22e5197b 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2016. All Rights Reserved. +# Copyright Ericsson AB 1996-2017. 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. @@ -83,6 +83,8 @@ MODULES = \ core_scan \ erl_bifs \ rec_env \ + sys_core_alias \ + sys_core_bsm \ sys_core_dsetel \ sys_core_fold \ sys_core_fold_lists \ @@ -193,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 b3c8c42af7..ec7e7aed14 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -264,9 +264,9 @@ format_error({delete_temp,File,Error}) -> io_lib:format("failed to delete temporary file ~ts: ~ts", [File,file:format_error(Error)]); format_error({parse_transform,M,R}) -> - io_lib:format("error in parse transform '~s': ~tp", [M, R]); + io_lib:format("error in parse transform '~ts': ~tp", [M, R]); format_error({undef_parse_transform,M}) -> - io_lib:format("undefined parse transform '~s'", [M]); + io_lib:format("undefined parse transform '~ts'", [M]); format_error({core_transform,M,R}) -> io_lib:format("error in core transform '~s': ~tp", [M, R]); format_error({crash,Pass,Reason}) -> @@ -467,8 +467,10 @@ mpf(Ms) -> passes(Type, Opts) -> {Ext,Passes0} = passes_1(Opts), Passes1 = case Type of - file -> Passes0; - forms -> tl(Passes0) + file -> + Passes0; + forms -> + fix_first_pass(Passes0) end, Passes = select_passes(Passes1, Opts), @@ -505,6 +507,22 @@ pass(from_beam) -> {".beam",[?pass(read_beam_file)|binary_passes()]}; pass(_) -> none. +%% For compilation from forms, replace the first pass with a pass +%% that retrieves the module name. The module name is needed for +%% proper diagnostics and for compilation to native code. + +fix_first_pass([{parse_core,_}|Passes]) -> + [?pass(get_module_name_from_core)|Passes]; +fix_first_pass([{beam_consult_asm,_}|Passes]) -> + [?pass(get_module_name_from_asm)|Passes]; +fix_first_pass([{read_beam_file,_}|Passes]) -> + [?pass(get_module_name_from_beam)|Passes]; +fix_first_pass([_|Passes]) -> + %% When compiling from abstract code, the module name + %% will be set after running the v3_core pass. + Passes. + + %% select_passes([Command], Opts) -> [{Name,Function}] %% Interpret the lists of commands to return a pure list of passes. %% @@ -688,20 +706,24 @@ 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()]. kernel_passes() -> - %% Destructive setelement/3 optimization and core lint. - [{pass,sys_core_dsetel}, + %% Optimizations that must be done after all other optimizations. + [{pass,sys_core_bsm}, + {iff,dcbsm,{listing,"core_bsm"}}, + {pass,sys_core_dsetel}, {iff,dsetel,{listing,"dsetel"}}, {iff,clint,?pass(core_lint_module)}, @@ -836,6 +858,12 @@ beam_consult_asm(_Code, St) -> {error,St#compile{errors=St#compile.errors ++ Es}} end. +get_module_name_from_asm({Mod,_,_,_,_}=Asm, St) -> + {ok,Asm,St#compile{module=Mod}}; +get_module_name_from_asm(Asm, St) -> + %% Invalid Beam assembly code. Let it crash in a later pass. + {ok,Asm,St}. + read_beam_file(_Code, St) -> case file:read_file(St#compile.ifile) of {ok,Beam} -> @@ -853,6 +881,16 @@ read_beam_file(_Code, St) -> {error,St#compile{errors=St#compile.errors ++ Es}} end. +get_module_name_from_beam(Beam, St) -> + case beam_lib:info(Beam) of + {error,beam_lib,Error} -> + Es = [{"((forms))",[{none,beam_lib,Error}]}], + {error,St#compile{errors=St#compile.errors ++ Es}}; + Info -> + {module,Mod} = keyfind(module, 1, Info), + {ok,Beam,St#compile{module=Mod}} + end. + no_native_compilation(BeamFile, #compile{options=Opts0}) -> case beam_lib:chunks(BeamFile, ["CInf"]) of {ok,{_,[{"CInf",Term0}]}} -> @@ -940,6 +978,16 @@ parse_core(_Code, St) -> {error,St#compile{errors=St#compile.errors ++ Es}} end. +get_module_name_from_core(Core, St) -> + try + Mod = cerl:concrete(cerl:module_name(Core)), + {ok,Core,St#compile{module=Mod}} + catch + _:_ -> + %% Invalid Core Erlang code. Let it crash in a later pass. + {ok,Core,St} + end. + compile_options([{attribute,_L,compile,C}|Fs]) when is_list(C) -> C ++ compile_options(Fs); compile_options([{attribute,_L,compile,C}|Fs]) -> @@ -1875,6 +1923,8 @@ pre_load() -> erl_lint, erl_parse, erl_scan, + sys_core_alias, + sys_core_bsm, sys_core_dsetel, sys_core_fold, v3_codegen, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 3961b2af86..703cf1d1b8 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -1,7 +1,7 @@ % This is an -*- erlang -*- file. %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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. @@ -58,6 +58,8 @@ core_lib, erl_bifs, rec_env, + sys_core_alias, + sys_core_bsm, sys_core_dsetel, sys_core_fold, sys_core_fold_lists, diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 9efb9ad6f8..b5688de339 100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1998-2016. All Rights Reserved. +# Copyright Ericsson AB 1998-2017. 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. 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_bsm.erl b/lib/compiler/src/sys_core_bsm.erl new file mode 100644 index 0000000000..3e04cc33df --- /dev/null +++ b/lib/compiler/src/sys_core_bsm.erl @@ -0,0 +1,355 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. 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 : Optimize bit syntax matching. + + +-module(sys_core_bsm). +-export([module/2,format_error/1]). + +-include("core_parse.hrl"). +-import(lists, [member/2,nth/2,reverse/1,usort/1]). + +-spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module()}. + +module(#c_module{defs=Ds0}=Mod, Opts) -> + {Ds,Ws0} = function(Ds0, [], []), + case member(bin_opt_info, Opts) of + false -> + {ok,Mod#c_module{defs=Ds}}; + true -> + Ws1 = [make_warning(Where, What) || {Where,What} <- Ws0], + Ws = usort(Ws1), + {ok,Mod#c_module{defs=Ds},Ws} + end. + +function([{#c_var{name={F,Arity}}=Name,B0}|Fs], FsAcc, Ws0) -> + try cerl_trees:mapfold(fun bsm_an/2, Ws0, B0) of + {B,Ws} -> + function(Fs, [{Name,B}|FsAcc], Ws) + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [F,Arity]), + erlang:raise(Class, Error, Stack) + end; +function([], Fs, Ws) -> + {reverse(Fs),Ws}. + +-type error() :: atom(). +-spec format_error(error()) -> nonempty_string(). + +format_error(bin_opt_alias) -> + "INFO: the '=' operator will prevent delayed sub binary optimization"; +format_error(bin_partition) -> + "INFO: matching non-variables after a previous clause matching a variable " + "will prevent delayed sub binary optimization"; +format_error(bin_left_var_used_in_guard) -> + "INFO: a variable to the left of the binary pattern is used in a guard; " + "will prevent delayed sub binary optimization"; +format_error(bin_argument_order) -> + "INFO: matching anything else but a plain variable to the left of " + "binary pattern will prevent delayed sub binary optimization; " + "SUGGEST changing argument order"; +format_error(bin_var_used) -> + "INFO: using a matched out sub binary will prevent " + "delayed sub binary optimization"; +format_error(orig_bin_var_used_in_guard) -> + "INFO: using the original binary variable in a guard will prevent " + "delayed sub binary optimization"; +format_error(bin_var_used_in_guard) -> + "INFO: using a matched out sub binary in a guard will prevent " + "delayed sub binary optimization". + + +%%% +%%% Annotate bit syntax matching to faciliate optimization in further passes. +%%% + +bsm_an(Core0, Ws0) -> + case bsm_an(Core0) of + {ok,Core} -> + {Core,Ws0}; + {ok,Core,W} -> + {Core,[W|Ws0]} + end. + +bsm_an(#c_case{arg=#c_var{}=V}=Case) -> + bsm_an_1([V], Case); +bsm_an(#c_case{arg=#c_values{es=Es}}=Case) -> + bsm_an_1(Es, Case); +bsm_an(Other) -> + {ok,Other}. + +bsm_an_1(Vs, #c_case{clauses=Cs}=Case) -> + case bsm_leftmost(Cs) of + none -> {ok,Case}; + Pos -> bsm_an_2(Vs, Cs, Case, Pos) + end. + +bsm_an_2(Vs, Cs, Case, Pos) -> + case bsm_nonempty(Cs, Pos) of + true -> bsm_an_3(Vs, Cs, Case, Pos); + false -> {ok,Case} + end. + +bsm_an_3(Vs, Cs, Case, Pos) -> + try + bsm_ensure_no_partition(Cs, Pos), + {ok,bsm_do_an(Vs, Pos, Cs, Case)} + catch + throw:{problem,Where,What} -> + {ok,Case,{Where,What}} + end. + +bsm_do_an(Vs0, Pos, Cs0, Case) -> + case nth(Pos, Vs0) of + #c_var{name=Vname}=V0 -> + Cs = bsm_do_an_var(Vname, Pos, Cs0, []), + V = bsm_annotate_for_reuse(V0), + Bef = lists:sublist(Vs0, Pos-1), + Aft = lists:nthtail(Pos, Vs0), + case Bef ++ [V|Aft] of + [_] -> + Case#c_case{arg=V,clauses=Cs}; + Vs -> + Case#c_case{arg=#c_values{es=Vs},clauses=Cs} + end; + _ -> + Case + end. + +bsm_do_an_var(V, S, [#c_clause{pats=Ps,guard=G,body=B0}=C0|Cs], Acc) -> + case nth(S, Ps) of + #c_var{name=VarName} -> + case core_lib:is_var_used(V, G) of + true -> bsm_problem(C0, orig_bin_var_used_in_guard); + false -> ok + end, + case core_lib:is_var_used(VarName, G) of + true -> bsm_problem(C0, bin_var_used_in_guard); + false -> ok + end, + B1 = bsm_maybe_ctx_to_binary(VarName, B0), + B = bsm_maybe_ctx_to_binary(V, B1), + C = C0#c_clause{body=B}, + bsm_do_an_var(V, S, Cs, [C|Acc]); + #c_alias{}=P -> + case bsm_could_match_binary(P) of + false -> + bsm_do_an_var(V, S, Cs, [C0|Acc]); + true -> + bsm_problem(C0, bin_opt_alias) + end; + P -> + case bsm_could_match_binary(P) andalso bsm_is_var_used(V, G, B0) of + false -> + bsm_do_an_var(V, S, Cs, [C0|Acc]); + true -> + bsm_problem(C0, bin_var_used) + end + end; +bsm_do_an_var(_, _, [], Acc) -> reverse(Acc). + +bsm_annotate_for_reuse(#c_var{anno=Anno}=Var) -> + Var#c_var{anno=[reuse_for_context|Anno]}. + +bsm_is_var_used(V, G, B) -> + core_lib:is_var_used(V, G) orelse core_lib:is_var_used(V, B). + +bsm_maybe_ctx_to_binary(V, B) -> + case core_lib:is_var_used(V, B) andalso not previous_ctx_to_binary(V, B) of + false -> + B; + true -> + #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary}, + args=[#c_var{name=V}]}, + body=B} + end. + +previous_ctx_to_binary(V, Core) -> + case Core of + #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary}, + args=[#c_var{name=V}]}} -> + true; + _ -> + false + end. + +%% bsm_leftmost(Cs) -> none | ArgumentNumber +%% Find the leftmost argument that does binary matching. Return +%% the number of the argument (1-N). + +bsm_leftmost(Cs) -> + bsm_leftmost_1(Cs, none). + +bsm_leftmost_1([#c_clause{pats=Ps}|Cs], Pos) -> + bsm_leftmost_2(Ps, Cs, 1, Pos); +bsm_leftmost_1([], Pos) -> Pos. + +bsm_leftmost_2(_, Cs, Pos, Pos) -> + bsm_leftmost_1(Cs, Pos); +bsm_leftmost_2([#c_binary{}|_], Cs, N, _) -> + bsm_leftmost_1(Cs, N); +bsm_leftmost_2([_|Ps], Cs, N, Pos) -> + bsm_leftmost_2(Ps, Cs, N+1, Pos); +bsm_leftmost_2([], Cs, _, Pos) -> + bsm_leftmost_1(Cs, Pos). + +%% bsm_nonempty(Cs, Pos) -> true|false +%% Check if at least one of the clauses matches a non-empty +%% binary in the given argument position. +%% +bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) -> + case nth(Pos, Ps) of + #c_binary{segments=[_|_]} -> + true; + _ -> + bsm_nonempty(Cs, Pos) + end; +bsm_nonempty([], _ ) -> false. + +%% bsm_ensure_no_partition(Cs, Pos) -> ok (exception if problem) +%% We must make sure that matching is not partitioned between +%% variables like this: +%% foo(<<...>>) -> ... +%% foo(<Variable>) when ... -> ... +%% foo(<Any non-variable pattern>) -> +%% If there is such partition, we are not allowed to reuse the binary variable +%% for the match context. +%% +%% Also, arguments to the left of the argument that is matched +%% against a binary, are only allowed to be simple variables, not +%% used in guards. The reason is that we must know that the binary is +%% only matched in one place (i.e. there must be only one bs_start_match2 +%% instruction emitted). + +bsm_ensure_no_partition(Cs, Pos) -> + bsm_ensure_no_partition_1(Cs, Pos, before). + +%% Loop through each clause. +bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], Pos, State0) -> + State = bsm_ensure_no_partition_2(Ps, Pos, G, simple_vars, State0), + case State of + 'after' -> + bsm_ensure_no_partition_after(Cs, Pos); + _ -> + ok + end, + bsm_ensure_no_partition_1(Cs, Pos, State); +bsm_ensure_no_partition_1([], _, _) -> ok. + +%% Loop through each pattern for this clause. +bsm_ensure_no_partition_2([#c_binary{}=Where|_], 1, _, Vstate, State) -> + case State of + before when Vstate =:= simple_vars -> within; + before -> bsm_problem(Where, Vstate); + within when Vstate =:= simple_vars -> within; + within -> bsm_problem(Where, Vstate) + end; +bsm_ensure_no_partition_2([#c_alias{}=Alias|_], 1, N, Vstate, State) -> + %% Retrieve the real pattern that the alias refers to and check that. + P = bsm_real_pattern(Alias), + bsm_ensure_no_partition_2([P], 1, N, Vstate, State); +bsm_ensure_no_partition_2([_|_], 1, _, _Vstate, before=State) -> + %% No binary matching yet - therefore no partition. + State; +bsm_ensure_no_partition_2([P|_], 1, _, Vstate, State) -> + case bsm_could_match_binary(P) of + false -> + %% If clauses can be freely arranged (Vstate =:= simple_vars), + %% a clause that cannot match a binary will not partition the clause. + %% Example: + %% + %% a(Var, <<>>) -> ... + %% a(Var, []) -> ... + %% a(Var, <<B>>) -> ... + %% + %% But if the clauses can't be freely rearranged, as in + %% + %% b(Var, <<X>>) -> ... + %% b(1, 2) -> ... + %% + %% we do have a problem. + %% + case Vstate of + simple_vars -> State; + _ -> bsm_problem(P, Vstate) + end; + true -> + %% The pattern P *may* match a binary, so we must update the state. + %% (P must be a variable.) + case State of + within -> 'after'; + 'after' -> 'after' + end + end; +bsm_ensure_no_partition_2([#c_var{name=V}|Ps], N, G, Vstate, S) -> + case core_lib:is_var_used(V, G) of + false -> + bsm_ensure_no_partition_2(Ps, N-1, G, Vstate, S); + true -> + bsm_ensure_no_partition_2(Ps, N-1, G, bin_left_var_used_in_guard, S) + end; +bsm_ensure_no_partition_2([_|Ps], N, G, _, S) -> + bsm_ensure_no_partition_2(Ps, N-1, G, bin_argument_order, S). + +bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs], Pos) -> + case nth(Pos, Ps) of + #c_var{} -> + bsm_ensure_no_partition_after(Cs, Pos); + _ -> + bsm_problem(C, bin_partition) + end; +bsm_ensure_no_partition_after([], _) -> ok. + +bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P); +bsm_could_match_binary(#c_cons{}) -> false; +bsm_could_match_binary(#c_tuple{}) -> false; +bsm_could_match_binary(#c_literal{val=Lit}) -> is_bitstring(Lit); +bsm_could_match_binary(_) -> true. + +bsm_real_pattern(#c_alias{pat=P}) -> bsm_real_pattern(P); +bsm_real_pattern(P) -> P. + +bsm_problem(Where, What) -> + throw({problem,Where,What}). + +make_warning(Core, Term) -> + case should_suppress_warning(Core) of + true -> + ok; + false -> + Anno = cerl:get_ann(Core), + Line = get_line(Anno), + File = get_file(Anno), + {File,[{Line,?MODULE,Term}]} + end. + +should_suppress_warning(Core) -> + Ann = cerl:get_ann(Core), + member(compiler_generated, Ann). + +get_line([Line|_]) when is_integer(Line) -> Line; +get_line([_|T]) -> get_line(T); +get_line([]) -> none. + +get_file([{file,File}|_]) -> File; +get_file([_|T]) -> get_file(T); +get_file([]) -> "no_file". % should not happen diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 3673a339f6..e0cd6da06f 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2017. 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. @@ -71,7 +71,7 @@ -export([module/2,format_error/1]). -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2, - reverse/1,reverse/2,member/2,nth/2,flatten/1, + reverse/1,reverse/2,member/2,flatten/1, unzip/1,keyfind/3]). -import(cerl, [ann_c_cons/3,ann_c_map/3,ann_c_tuple/2]). @@ -107,7 +107,6 @@ {'ok', cerl:c_module(), [_]}. module(#c_module{defs=Ds0}=Mod, Opts) -> - put(bin_opt_info, member(bin_opt_info, Opts)), put(no_inline_list_funcs, not member(inline_list_funcs, Opts)), case get(new_var_num) of undefined -> put(new_var_num, 0); @@ -116,7 +115,6 @@ module(#c_module{defs=Ds0}=Mod, Opts) -> init_warnings(), Ds1 = [function_1(D) || D <- Ds0], erase(no_inline_list_funcs), - erase(bin_opt_info), {ok,Mod#c_module{defs=Ds1},get_warnings()}. function_1({#c_var{name={F,Arity}}=Name,B0}) -> @@ -383,10 +381,8 @@ expr(#c_case{}=Case0, Ctxt, Sub) -> warn_no_clause_match(Case1, Case), Expr = eval_case(Case, Sub), case move_case_into_arg(Case, Sub) of - impossible -> - bsm_an(Expr); - Other -> - Other + impossible -> Expr; + Other -> Other end; Other -> expr(Other, Ctxt, Sub) @@ -1462,8 +1458,19 @@ sub_add_scope(Vs, #sub{s=Scope0}=Sub) -> Sub#sub{s=Scope}. sub_subst_scope(#sub{v=S0,s=Scope}=Sub) -> - S = [{-1,#c_var{name=Sv}} || Sv <- cerl_sets:to_list(Scope)]++S0, - Sub#sub{v=S}. + Initial = case S0 of + [{NegInt,_}|_] when is_integer(NegInt), NegInt < 0 -> + NegInt - 1; + _ -> + -1 + end, + S = sub_subst_scope_1(cerl_sets:to_list(Scope), Initial, S0), + Sub#sub{v=orddict:from_list(S)}. + +%% The keys in an orddict must be unique. Make them so! +sub_subst_scope_1([H|T], Key, Acc) -> + sub_subst_scope_1(T, Key-1, [{Key,#c_var{name=H}}|Acc]); +sub_subst_scope_1([], _, Acc) -> Acc. sub_is_val(#c_var{name=V}, #sub{v=S,s=Scope}) -> %% When the bottleneck in sub_del_var/2 was eliminated, this @@ -2943,15 +2950,8 @@ update_types(Expr, Pat, #sub{t=Tdb0}=Sub) -> Tdb = update_types_1(Expr, Pat, Tdb0), Sub#sub{t=Tdb}. -update_types_1(#c_var{name=V,anno=Anno}, Pat, Types) -> - case member(reuse_for_context, Anno) of - true -> - %% If a variable has been marked for reuse of binary context, - %% optimizations based on type information are unsafe. - kill_types(V, Types); - false -> - update_types_2(V, Pat, Types) - end; +update_types_1(#c_var{name=V}, Pat, Types) -> + update_types_2(V, Pat, Types); update_types_1(_, _, Types) -> Types. update_types_2(V, [#c_tuple{}=P], Types) -> @@ -2994,253 +2994,6 @@ copy_type(_, _, Tdb) -> Tdb. void() -> #c_literal{val=ok}. -%%% -%%% Annotate bit syntax matching to faciliate optimization in further passes. -%%% - -bsm_an(#c_case{arg=#c_var{}=V}=Case) -> - bsm_an_1([V], Case); -bsm_an(#c_case{arg=#c_values{es=Es}}=Case) -> - bsm_an_1(Es, Case); -bsm_an(Other) -> Other. - -bsm_an_1(Vs, #c_case{clauses=Cs}=Case) -> - case bsm_leftmost(Cs) of - none -> Case; - Pos -> bsm_an_2(Vs, Cs, Case, Pos) - end. - -bsm_an_2(Vs, Cs, Case, Pos) -> - case bsm_nonempty(Cs, Pos) of - true -> bsm_an_3(Vs, Cs, Case, Pos); - false -> Case - end. - -bsm_an_3(Vs, Cs, Case, Pos) -> - try - bsm_ensure_no_partition(Cs, Pos), - bsm_do_an(Vs, Pos, Cs, Case) - catch - throw:{problem,Where,What} -> - add_bin_opt_info(Where, What), - Case - end. - -bsm_do_an(Vs0, Pos, Cs0, Case) -> - case nth(Pos, Vs0) of - #c_var{name=Vname}=V0 -> - Cs = bsm_do_an_var(Vname, Pos, Cs0, []), - V = bsm_annotate_for_reuse(V0), - Bef = lists:sublist(Vs0, Pos-1), - Aft = lists:nthtail(Pos, Vs0), - case Bef ++ [V|Aft] of - [_] -> - Case#c_case{arg=V,clauses=Cs}; - Vs -> - Case#c_case{arg=#c_values{es=Vs},clauses=Cs} - end; - _ -> - Case - end. - -bsm_do_an_var(V, S, [#c_clause{pats=Ps,guard=G,body=B0}=C0|Cs], Acc) -> - case nth(S, Ps) of - #c_var{name=VarName} -> - case core_lib:is_var_used(V, G) of - true -> bsm_problem(C0, orig_bin_var_used_in_guard); - false -> ok - end, - case core_lib:is_var_used(VarName, G) of - true -> bsm_problem(C0, bin_var_used_in_guard); - false -> ok - end, - B1 = bsm_maybe_ctx_to_binary(VarName, B0), - B = bsm_maybe_ctx_to_binary(V, B1), - C = C0#c_clause{body=B}, - bsm_do_an_var(V, S, Cs, [C|Acc]); - #c_alias{}=P -> - case bsm_could_match_binary(P) of - false -> - bsm_do_an_var(V, S, Cs, [C0|Acc]); - true -> - bsm_problem(C0, bin_opt_alias) - end; - P -> - case bsm_could_match_binary(P) andalso bsm_is_var_used(V, G, B0) of - false -> - bsm_do_an_var(V, S, Cs, [C0|Acc]); - true -> - bsm_problem(C0, bin_var_used) - end - end; -bsm_do_an_var(_, _, [], Acc) -> reverse(Acc). - -bsm_annotate_for_reuse(#c_var{anno=Anno}=Var) -> - case member(reuse_for_context, Anno) of - false -> Var#c_var{anno=[reuse_for_context|Anno]}; - true -> Var - end. - -bsm_is_var_used(V, G, B) -> - core_lib:is_var_used(V, G) orelse core_lib:is_var_used(V, B). - -bsm_maybe_ctx_to_binary(V, B) -> - case core_lib:is_var_used(V, B) andalso not previous_ctx_to_binary(V, B) of - false -> - B; - true -> - #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary}, - args=[#c_var{name=V}]}, - body=B} - end. - -previous_ctx_to_binary(V, Core) -> - case Core of - #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary}, - args=[#c_var{name=V}]}} -> - true; - _ -> - false - end. - -%% bsm_leftmost(Cs) -> none | ArgumentNumber -%% Find the leftmost argument that does binary matching. Return -%% the number of the argument (1-N). - -bsm_leftmost(Cs) -> - bsm_leftmost_1(Cs, none). - -bsm_leftmost_1([#c_clause{pats=Ps}|Cs], Pos) -> - bsm_leftmost_2(Ps, Cs, 1, Pos); -bsm_leftmost_1([], Pos) -> Pos. - -bsm_leftmost_2(_, Cs, Pos, Pos) -> - bsm_leftmost_1(Cs, Pos); -bsm_leftmost_2([#c_binary{}|_], Cs, N, _) -> - bsm_leftmost_1(Cs, N); -bsm_leftmost_2([_|Ps], Cs, N, Pos) -> - bsm_leftmost_2(Ps, Cs, N+1, Pos); -bsm_leftmost_2([], Cs, _, Pos) -> - bsm_leftmost_1(Cs, Pos). - -%% bsm_nonempty(Cs, Pos) -> true|false -%% Check if at least one of the clauses matches a non-empty -%% binary in the given argument position. -%% -bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) -> - case nth(Pos, Ps) of - #c_binary{segments=[_|_]} -> - true; - _ -> - bsm_nonempty(Cs, Pos) - end; -bsm_nonempty([], _ ) -> false. - -%% bsm_ensure_no_partition(Cs, Pos) -> ok (exception if problem) -%% We must make sure that matching is not partitioned between -%% variables like this: -%% foo(<<...>>) -> ... -%% foo(<Variable>) when ... -> ... -%% foo(<Any non-variable pattern>) -> -%% If there is such partition, we are not allowed to reuse the binary variable -%% for the match context. -%% -%% Also, arguments to the left of the argument that is matched -%% against a binary, are only allowed to be simple variables, not -%% used in guards. The reason is that we must know that the binary is -%% only matched in one place (i.e. there must be only one bs_start_match2 -%% instruction emitted). - -bsm_ensure_no_partition(Cs, Pos) -> - bsm_ensure_no_partition_1(Cs, Pos, before). - -%% Loop through each clause. -bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], Pos, State0) -> - State = bsm_ensure_no_partition_2(Ps, Pos, G, simple_vars, State0), - case State of - 'after' -> - bsm_ensure_no_partition_after(Cs, Pos); - _ -> - ok - end, - bsm_ensure_no_partition_1(Cs, Pos, State); -bsm_ensure_no_partition_1([], _, _) -> ok. - -%% Loop through each pattern for this clause. -bsm_ensure_no_partition_2([#c_binary{}=Where|_], 1, _, Vstate, State) -> - case State of - before when Vstate =:= simple_vars -> within; - before -> bsm_problem(Where, Vstate); - within when Vstate =:= simple_vars -> within; - within -> bsm_problem(Where, Vstate) - end; -bsm_ensure_no_partition_2([#c_alias{}=Alias|_], 1, N, Vstate, State) -> - %% Retrieve the real pattern that the alias refers to and check that. - P = bsm_real_pattern(Alias), - bsm_ensure_no_partition_2([P], 1, N, Vstate, State); -bsm_ensure_no_partition_2([_|_], 1, _, _Vstate, before=State) -> - %% No binary matching yet - therefore no partition. - State; -bsm_ensure_no_partition_2([P|_], 1, _, Vstate, State) -> - case bsm_could_match_binary(P) of - false -> - %% If clauses can be freely arranged (Vstate =:= simple_vars), - %% a clause that cannot match a binary will not partition the clause. - %% Example: - %% - %% a(Var, <<>>) -> ... - %% a(Var, []) -> ... - %% a(Var, <<B>>) -> ... - %% - %% But if the clauses can't be freely rearranged, as in - %% - %% b(Var, <<X>>) -> ... - %% b(1, 2) -> ... - %% - %% we do have a problem. - %% - case Vstate of - simple_vars -> State; - _ -> bsm_problem(P, Vstate) - end; - true -> - %% The pattern P *may* match a binary, so we must update the state. - %% (P must be a variable.) - case State of - within -> 'after'; - 'after' -> 'after' - end - end; -bsm_ensure_no_partition_2([#c_var{name=V}|Ps], N, G, Vstate, S) -> - case core_lib:is_var_used(V, G) of - false -> - bsm_ensure_no_partition_2(Ps, N-1, G, Vstate, S); - true -> - bsm_ensure_no_partition_2(Ps, N-1, G, bin_left_var_used_in_guard, S) - end; -bsm_ensure_no_partition_2([_|Ps], N, G, _, S) -> - bsm_ensure_no_partition_2(Ps, N-1, G, bin_argument_order, S). - -bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs], Pos) -> - case nth(Pos, Ps) of - #c_var{} -> - bsm_ensure_no_partition_after(Cs, Pos); - _ -> - bsm_problem(C, bin_partition) - end; -bsm_ensure_no_partition_after([], _) -> ok. - -bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P); -bsm_could_match_binary(#c_cons{}) -> false; -bsm_could_match_binary(#c_tuple{}) -> false; -bsm_could_match_binary(#c_literal{val=Lit}) -> is_bitstring(Lit); -bsm_could_match_binary(_) -> true. - -bsm_real_pattern(#c_alias{pat=P}) -> bsm_real_pattern(P); -bsm_real_pattern(P) -> P. - -bsm_problem(Where, What) -> - throw({problem,Where,What}). %%% %%% Handling of warnings. @@ -3249,12 +3002,6 @@ bsm_problem(Where, What) -> init_warnings() -> put({?MODULE,warnings}, []). -add_bin_opt_info(Core, Term) -> - case get(bin_opt_info) of - true -> add_warning(Core, Term); - false -> ok - end. - add_warning(Core, Term) -> case should_suppress_warning(Core) of true -> @@ -3376,28 +3123,7 @@ format_error(result_ignored) -> format_error(invalid_call) -> "invalid function call"; format_error(useless_building) -> - "a term is constructed, but never used"; -format_error(bin_opt_alias) -> - "INFO: the '=' operator will prevent delayed sub binary optimization"; -format_error(bin_partition) -> - "INFO: matching non-variables after a previous clause matching a variable " - "will prevent delayed sub binary optimization"; -format_error(bin_left_var_used_in_guard) -> - "INFO: a variable to the left of the binary pattern is used in a guard; " - "will prevent delayed sub binary optimization"; -format_error(bin_argument_order) -> - "INFO: matching anything else but a plain variable to the left of " - "binary pattern will prevent delayed sub binary optimization; " - "SUGGEST changing argument order"; -format_error(bin_var_used) -> - "INFO: using a matched out sub binary will prevent " - "delayed sub binary optimization"; -format_error(orig_bin_var_used_in_guard) -> - "INFO: using the original binary variable in a guard will prevent " - "delayed sub binary optimization"; -format_error(bin_var_used_in_guard) -> - "INFO: using a matched out sub binary in a guard will prevent " - "delayed sub binary optimization". + "a term is constructed, but never used". -ifdef(DEBUG). %% In order for simplify_let/2 to work correctly, the list of 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/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 004c609311..1fc05109c5 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -1313,23 +1313,26 @@ get_vsub(V, Vsub) -> set_vsub(V, S, Vsub) -> orddict:store(V, S, Vsub). -subst_vsub(Key, New, [{K,Key}|Dict]) -> +subst_vsub(Key, New, Vsub) -> + orddict:from_list(subst_vsub_1(Key, New, Vsub)). + +subst_vsub_1(Key, New, [{K,Key}|Dict]) -> %% Fold chained substitution. - [{K,New}|subst_vsub(Key, New, Dict)]; -subst_vsub(Key, New, [{K,_}|_]=Dict) when Key < K -> + [{K,New}|subst_vsub_1(Key, New, Dict)]; +subst_vsub_1(Key, New, [{K,_}|_]=Dict) when Key < K -> %% Insert the new substitution here, and continue %% look for chained substitutions. - [{Key,New}|subst_vsub_1(Key, New, Dict)]; -subst_vsub(Key, New, [{K,_}=E|Dict]) when Key > K -> - [E|subst_vsub(Key, New, Dict)]; -subst_vsub(Key, New, []) -> [{Key,New}]. + [{Key,New}|subst_vsub_2(Key, New, Dict)]; +subst_vsub_1(Key, New, [{K,_}=E|Dict]) when Key > K -> + [E|subst_vsub_1(Key, New, Dict)]; +subst_vsub_1(Key, New, []) -> [{Key,New}]. -subst_vsub_1(V, S, [{K,V}|Dict]) -> +subst_vsub_2(V, S, [{K,V}|Dict]) -> %% Fold chained substitution. - [{K,S}|subst_vsub_1(V, S, Dict)]; -subst_vsub_1(V, S, [E|Dict]) -> - [E|subst_vsub_1(V, S, Dict)]; -subst_vsub_1(_, _, []) -> []. + [{K,S}|subst_vsub_2(V, S, Dict)]; +subst_vsub_2(V, S, [E|Dict]) -> + [E|subst_vsub_2(V, S, Dict)]; +subst_vsub_2(_, _, []) -> []. get_fsub(F, A, Fsub) -> case orddict:find({F,A}, Fsub) of diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index 716280a95c..53097d0d7d 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2017. 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. |