diff options
Diffstat (limited to 'lib/compiler/src')
27 files changed, 1182 insertions, 1954 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 518c89d044..c37f731d8c 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -49,7 +49,6 @@ MODULES = \ beam_a \ beam_asm \ beam_block \ - beam_bool \ beam_bs \ beam_bsm \ beam_clean \ @@ -88,7 +87,6 @@ MODULES = \ sys_core_fold_lists \ sys_core_inline \ sys_pre_attributes \ - sys_pre_expand \ v3_codegen \ v3_core \ v3_kernel \ @@ -198,7 +196,6 @@ $(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 $(EBIN)/sys_core_inline.beam: core_parse.hrl -$(EBIN)/sys_pre_expand.beam: ../../stdlib/include/erl_bits.hrl $(EBIN)/v3_codegen.beam: v3_life.hrl $(EBIN)/v3_core.beam: core_parse.hrl $(EBIN)/v3_kernel.beam: core_parse.hrl v3_kernel.hrl diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl deleted file mode 100644 index 99e4ccb1e9..0000000000 --- a/lib/compiler/src/beam_bool.erl +++ /dev/null @@ -1,765 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-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: Optimizes booleans in guards. - --module(beam_bool). - --export([module/2]). - --import(lists, [reverse/1,reverse/2,foldl/3,mapfoldl/3,map/2]). - --record(st, - {next, %Next label number. - ll %Live regs at labels. - }). - -module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> - %%io:format("~p:\n", [Mod]), - {Fs,_} = mapfoldl(fun(Fn, Lbl) -> function(Fn, Lbl) end, 100000000, Fs0), - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -function({function,Name,Arity,CLabel,Is0}, Lbl0) -> - try - {Is,#st{next=Lbl}} = bool_opt(Is0, Lbl0), - {{function,Name,Arity,CLabel,Is},Lbl} - catch - Class:Error -> - Stack = erlang:get_stacktrace(), - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -%% -%% Optimize boolean expressions that use guard bifs. Rewrite to -%% use test instructions if possible. -%% - -bool_opt(Asm, Lbl) -> - LiveInfo = beam_utils:index_labels(Asm), - bopt(Asm, [], #st{next=Lbl,ll=LiveInfo}). - -bopt([{block,Bl0}=Block| - [{jump,{f,Succ}}, - {label,Fail}, - {block,[{set,[Dst],[{atom,false}],move}]}, - {label,Succ}|Is]=Is0], Acc0, St) -> - case split_block(Bl0, Dst, Fail, Acc0, true) of - failed -> - bopt(Is0, [Block|Acc0], St); - {Bl,PreBlock} -> - Acc1 = case PreBlock of - [] -> Acc0; - _ -> [{block,PreBlock}|Acc0] - end, - Acc = [{protected,[Dst],Bl,{Fail,Succ}}|Acc1], - bopt(Is, Acc, St) - end; -bopt([{test,is_eq_exact,{f,Fail},[Reg,{atom,true}]}=I|Is], [{block,_}|_]=Acc0, St0) -> - case bopt_block(Reg, Fail, Is, Acc0, St0) of - failed -> bopt(Is, [I|Acc0], St0); - {Acc,St} -> bopt(Is, Acc, St) - end; -bopt([I|Is], Acc, St) -> - bopt(Is, [I|Acc], St); -bopt([], Acc, St) -> - {bopt_reverse(Acc, []),St}. - -bopt_reverse([{protected,[Dst],Block,{Fail,Succ}}|Is], Acc0) -> - Acc = [{block,Block},{jump,{f,Succ}}, - {label,Fail}, - {block,[{set,[Dst],[{atom,false}],move}]}, - {label,Succ}|Acc0], - bopt_reverse(Is, Acc); -bopt_reverse([I|Is], Acc) -> - bopt_reverse(Is, [I|Acc]); -bopt_reverse([], Acc) -> Acc. - -%% bopt_block(Reg, Fail, OldIs, Accumulator, St) -> failed | {NewAcc,St} -%% Attempt to optimized a block of guard BIFs followed by a test -%% instruction. -bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> - case split_block(Bl0, Reg, Fail, Acc0, false) of - failed -> - %% Reason for failure: The block either contained no - %% guard BIFs with the failure label Fail, or the final - %% instruction in the block did not assign the Reg register. - - %%io:format("split ~p: ~P\n", [Reg,Bl0,20]), - failed; - {Bl1,BlPre} -> - %% The block has been splitted. Bl1 is a non-empty list - %% of guard BIF instructions having the failure label Fail. - %% BlPre is a (possibly empty list) of instructions preceeding - %% Bl1. - Acc1 = make_block(BlPre, Acc0), - {Bl,Acc} = extend_block(Bl1, Fail, Acc1), - try - {NewCode,St} = bopt_tree_cg(Bl, Fail, St0), - ensure_opt_safe(Bl, NewCode, OldIs, Fail, Acc, St), - {NewCode++Acc,St} - catch - %% Not possible to rewrite because a boolean value is - %% passed to another guard bif, e.g. 'abs(A > B)' - %% (in this case, obviously nonsense code). Rare in - %% practice. - throw:mixed -> - failed; - - %% There was a reference to a boolean expression - %% from inside a protected block (try/catch), to - %% a boolean expression outside. - throw:protected_barrier -> - failed; - - %% The 'xor' operator was used. We currently don't - %% find it worthwile to translate 'xor' operators - %% (the code would be clumsy). - throw:'xor' -> - failed; - - %% The block does not contain a boolean expression, - %% but only a call to a guard BIF. - %% For instance: ... when element(1, T) -> - throw:not_boolean_expr -> - failed; - - %% The optimization is not safe. (A register - %% used by the instructions following the - %% optimized code is either not assigned a - %% value at all or assigned a different value.) - throw:all_registers_not_killed -> - failed; - throw:registers_used -> - failed; - - %% A protected block refered to the value - %% returned by another protected block, - %% probably because the Core Erlang code - %% used nested try/catches in the guard. - %% (v3_core never produces nested try/catches - %% in guards, so it must have been another - %% Core Erlang translator.) - throw:protected_violation -> - failed; - - %% Failed to work out the live registers for a GC - %% BIF. For example, if the number of live registers - %% needed to be 4 because {x,3} was a source register, - %% but {x,2} was not known to be initialized, this - %% exception would be thrown. - throw:gc_bif_alloc_failure -> - failed - - end - end. - -%% ensure_opt_safe(OriginalCode, OptCode, FollowingCode, Fail, -%% ReversedPrecedingCode, State) -> ok -%% Comparing the original code to the optimized code, determine -%% whether the optimized code is guaranteed to work in the same -%% way as the original code. -%% -%% Throw an exception if the optimization is not safe. -%% -ensure_opt_safe(Bl, NewCode, OldIs, Fail, PrecedingCode, St) -> - %% Here are the conditions that must be true for the - %% optimization to be safe. - %% - %% 1. If a register is INITIALIZED by PrecedingCode, - %% then if that register assigned a value in the original - %% code, but not in the optimized code, it must be UNUSED or KILLED - %% in the code that follows. - %% - %% 2. If a register is not known to be INITIALIZED by PreccedingCode, - %% then if that register assigned a value in the original - %% code, but not in the optimized code, it must be KILLED - %% by the code that follows. - %% - %% 3. Any register that is assigned a value in the optimized - %% code must be UNUSED or KILLED in the following code, - %% unless we can be sure that it is always assigned the same - %% value. - - InitInPreceding = initialized_regs(PrecedingCode), - - PrevDst = dst_regs(Bl), - NewDst = dst_regs(NewCode), - NotSet = ordsets:subtract(PrevDst, NewDst), - MustBeKilled = ordsets:subtract(NotSet, InitInPreceding), - - case all_killed(MustBeKilled, OldIs, Fail, St) of - false -> throw(all_registers_not_killed); - true -> ok - end, - MustBeUnused = ordsets:subtract(ordsets:union(NotSet, NewDst), - MustBeKilled), - case none_used(MustBeUnused, OldIs, Fail, St) of - false -> throw(registers_used); - true -> ok - end, - ok. - -update_fail_label([{set,Ds,As,{bif,N,{f,_}}}|Is], Fail, Acc) -> - update_fail_label(Is, Fail, [{set,Ds,As,{bif,N,{f,Fail}}}|Acc]); -update_fail_label([{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,_}}}}|Is], Fail, Acc) -> - update_fail_label(Is, Fail, - [{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,Fail}}}}|Acc]); -update_fail_label([], _, Acc) -> reverse(Acc). - -make_block(Bl) -> - make_block(Bl, []). - -make_block([], Acc) -> Acc; -make_block(Bl, Acc) -> [{block,Bl}|Acc]. - -extend_block(BlAcc, Fail, [{protected,_,_,_}=Prot|OldAcc]) -> - extend_block([Prot|BlAcc], Fail, OldAcc); -extend_block(BlAcc0, Fail, [{block,Is0}|OldAcc]) -> - case extend_block_1(reverse(Is0), Fail, BlAcc0) of - {BlAcc,[]} -> extend_block(BlAcc, Fail, OldAcc); - {BlAcc,Is} -> {BlAcc,[{block,Is}|OldAcc]} - end; -extend_block(BlAcc, _, OldAcc) -> {BlAcc,OldAcc}. - -extend_block_1([{set,[{x,_}],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> - extend_block_1(Is, Fail, [I|Acc]); -extend_block_1([{set,[{x,_}],As,{bif,Bif,_}}=I|Is]=Is0, Fail, Acc) -> - case safe_bool_op(Bif, length(As)) of - false -> {Acc,reverse(Is0)}; - true -> extend_block_1(Is, Fail, [I|Acc]) - end; -extend_block_1([_|_]=Is, _, Acc) -> {Acc,reverse(Is)}; -extend_block_1([], _, Acc) -> {Acc,[]}. - -%% split_block([Instruction], Destination, FailLabel, [PreInstruction], -%% ProhibitFailLabelInPreBlock) -> failed | {Block,PreBlock} -%% Split a sequence of instructions into two blocks - one containing -%% all guard bif instructions and a pre-block all instructions before -%% the guard BIFs. - -split_block(Is0, Dst, Fail, PreIs, ProhibitFailLabel) -> - case ProhibitFailLabel andalso beam_jump:is_label_used_in(Fail, PreIs) of - true -> - %% The failure label was used in one of the instructions (most - %% probably bit syntax construction) preceeding the block, - %% the caller might eliminate the label. - failed; - false -> - case reverse(Is0) of - [{set,[Dst],_,_}|_]=Is -> - split_block_1(Is, Fail, ProhibitFailLabel); - _ -> failed - end - end. - -split_block_1(Is, Fail, ProhibitFailLabel) -> - case split_block_2(Is, Fail, []) of - {[],_} -> failed; - {_,PreBlock}=Res -> - case ProhibitFailLabel andalso - split_block_label_used(PreBlock, Fail) of - true -> - %% The failure label was used in the pre-block; - %% not allowed, because the label may be removed. - failed; - false -> - Res - end - end. - -split_block_2([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> - split_block_2(Is, Fail, [I|Acc]); -split_block_2([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}=I|Is], Fail, Acc) -> - split_block_2(Is, Fail, [I|Acc]); -split_block_2(Is0, _, Acc) -> - Is = reverse(Is0), - {Acc,Is}. - -split_block_label_used([{set,[_],_,{bif,_,{f,Fail}}}|_], Fail) -> - true; -split_block_label_used([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}|_], Fail) -> - true; -split_block_label_used([{set,[_],_,{alloc,_,{put_map,_,{f,Fail}}}}|_], Fail) -> - true; -split_block_label_used([_|Is], Fail) -> - split_block_label_used(Is, Fail); -split_block_label_used([], _) -> false. - -dst_regs(Is) -> - dst_regs(Is, []). - -dst_regs([{block,Bl}|Is], Acc) -> - dst_regs(Bl, dst_regs(Is, Acc)); -dst_regs([{set,[D],_,{bif,_,{f,_}}}|Is], Acc) -> - dst_regs(Is, [D|Acc]); -dst_regs([{set,[D],_,{alloc,_,{gc_bif,_,{f,_}}}}|Is], Acc) -> - dst_regs(Is, [D|Acc]); -dst_regs([{protected,_,Bl,_}|Is], Acc) -> - dst_regs(Bl, dst_regs(Is, Acc)); -dst_regs([_|Is], Acc) -> - dst_regs(Is, Acc); -dst_regs([], Acc) -> ordsets:from_list(Acc). - -all_killed([R|Rs], OldIs, Fail, St) -> - case is_killed(R, OldIs, Fail, St) of - false -> false; - true -> all_killed(Rs, OldIs, Fail, St) - end; -all_killed([], _, _, _) -> true. - -none_used([R|Rs], OldIs, Fail, St) -> - case is_not_used(R, OldIs, Fail, St) of - false -> false; - true -> none_used(Rs, OldIs, Fail, St) - end; -none_used([], _, _, _) -> true. - -bopt_tree_cg(Block0, Fail, St) -> - Free = free_variables(Block0), - Block = ssa_block(Block0), -%% io:format("~p\n", [Block0]), -%% io:format("~p\n", [Block]), -%% io:format("~p\n", [gb_trees:to_list(Free)]), - case bopt_tree(Block, Free, []) of - {Pre0,[{_,Tree}]} -> - Pre1 = update_fail_label(Pre0, Fail, []), - Regs0 = init_regs(gb_trees:keys(Free)), -%% io:format("~p\n", [dst_regs(Block0)]), -%% io:format("~p\n", [Pre1]), -%% io:format("~p\n", [Tree]), -%% io:nl(), - {Pre,Regs} = rename_regs(Pre1, Regs0), -%% io:format("~p\n", [Regs0]), -%% io:format("~p\n", [Pre]), - bopt_cg(Tree, Fail, Regs, make_block(Pre), St); - _Res -> - throw(not_boolean_expr) - end. - -bopt_tree([{set,[Dst],As0,{bif,'not',_}}|Is], Forest0, Pre) -> - {[Arg],Forest1} = bopt_bool_args(As0, Forest0), - Forest = gb_trees:enter(Dst, {'not',Arg}, Forest1), - bopt_tree(Is, Forest, Pre); -bopt_tree([{set,[Dst],As0,{bif,'and',_}}|Is], Forest0, Pre) -> - {As,Forest1} = bopt_bool_args(As0, Forest0), - Node = make_and_node(As), - Forest = gb_trees:enter(Dst, Node, Forest1), - bopt_tree(Is, Forest, Pre); -bopt_tree([{set,[Dst],As0,{bif,'or',_}}|Is], Forest0, Pre) -> - {As,Forest1} = bopt_bool_args(As0, Forest0), - Node = make_or_node(As), - Forest = gb_trees:enter(Dst, Node, Forest1), - bopt_tree(Is, Forest, Pre); -bopt_tree([{set,_,_,{bif,'xor',_}}|_], _, _) -> - throw('xor'); -bopt_tree([{protected,[Dst],Code,_}|Is], Forest0, Pre) -> - ProtForest0 = gb_trees:from_orddict([P || {_,any}=P <- gb_trees:to_list(Forest0)]), - case bopt_tree(Code, ProtForest0, []) of - {ProtPre,[{_,ProtTree}]} -> - Prot = {prot,ProtPre,ProtTree}, - Forest = gb_trees:enter(Dst, Prot, Forest0), - bopt_tree(Is, Forest, Pre); - _Res -> - throw(not_boolean_expr) - end; -bopt_tree([{set,[Dst],As,{bif,N,_}}=Bif|Is], Forest0, Pre) -> - Ar = length(As), - case safe_bool_op(N, Ar) of - false -> - bopt_good_args(As, Forest0), - Forest = gb_trees:enter(Dst, any, Forest0), - bopt_tree(Is, Forest, [Bif|Pre]); - true -> - bopt_good_args(As, Forest0), - Test = bif_to_test(Dst, N, As), - Forest = gb_trees:enter(Dst, Test, Forest0), - bopt_tree(Is, Forest, Pre) - end; -bopt_tree([{set,[Dst],As,{alloc,_,{gc_bif,_,_}}}=Bif|Is], Forest0, Pre) -> - bopt_good_args(As, Forest0), - Forest = gb_trees:enter(Dst, any, Forest0), - bopt_tree(Is, Forest, [Bif|Pre]); -bopt_tree([], Forest, Pre) -> - {reverse(Pre),[R || {_,V}=R <- gb_trees:to_list(Forest), V =/= any]}. - -safe_bool_op(N, Ar) -> - erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar). - -bopt_bool_args([V0,V0], Forest0) -> - {V,Forest} = bopt_bool_arg(V0, Forest0), - {[V,V],Forest}; -bopt_bool_args(As, Forest) -> - mapfoldl(fun bopt_bool_arg/2, Forest, As). - -bopt_bool_arg({T,_}=R, Forest) when T =:= x; T =:= y; T =:= tmp -> - Val = case gb_trees:lookup(R, Forest) of - {value,any} -> {test,is_eq_exact,fail,[R,{atom,true}]}; - {value,Val0} -> Val0; - none -> throw(mixed) - end, - {Val,gb_trees:delete(R, Forest)}; -bopt_bool_arg(Term, Forest) -> - {Term,Forest}. - -bopt_good_args([A|As], Regs) -> - bopt_good_arg(A, Regs), - bopt_good_args(As, Regs); -bopt_good_args([], _) -> ok. - -bopt_good_arg({Tag,_}=X, Regs) when Tag =:= x; Tag =:= tmp -> - case gb_trees:lookup(X, Regs) of - {value,any} -> ok; - {value,_} -> throw(mixed); - none -> throw(protected_barrier) - end; -bopt_good_arg(_, _) -> ok. - -bif_to_test(_, N, As) -> - beam_utils:bif_to_test(N, As, fail). - -make_and_node(Is) -> - AndList0 = make_and_list(Is), - case simplify_and_list(AndList0) of - [] -> {atom,true}; - [Op] -> Op; - AndList -> {'and',AndList} - end. - -make_and_list([{'and',As}|Is]) -> - make_and_list(As++Is); -make_and_list([I|Is]) -> - [I|make_and_list(Is)]; -make_and_list([]) -> []. - -simplify_and_list([{atom,true}|T]) -> - simplify_and_list(T); -simplify_and_list([{atom,false}=False|_]) -> - [False]; -simplify_and_list([H|T]) -> - [H|simplify_and_list(T)]; -simplify_and_list([]) -> []. - -make_or_node(Is) -> - OrList0 = make_or_list(Is), - case simplify_or_list(OrList0) of - [] -> {atom,false}; - [Op] -> Op; - OrList -> {'or',OrList} - end. - -make_or_list([{'or',As}|Is]) -> - make_or_list(As++Is); -make_or_list([I|Is]) -> - [I|make_or_list(Is)]; -make_or_list([]) -> []. - -simplify_or_list([{atom,false}|T]) -> - simplify_or_list(T); -simplify_or_list([{atom,true}=True|_]) -> - [True]; -simplify_or_list([H|T]) -> - [H|simplify_or_list(T)]; -simplify_or_list([]) -> []. - -%% Code generation for a boolean tree. - -bopt_cg({'not',Arg}, Fail, Rs, Acc, St) -> - I = bopt_cg_not(Arg), - bopt_cg(I, Fail, Rs, Acc, St); -bopt_cg({'and',As}, Fail, Rs, Acc, St) -> - bopt_cg_and(As, Fail, Rs, Acc, St); -bopt_cg({'or',As}, Fail, Rs, Acc, St0) -> - {Succ,St} = new_label(St0), - bopt_cg_or(As, Succ, Fail, Rs, Acc, St); -bopt_cg({test,N,fail,As0}, Fail, Rs, Acc, St) -> - As = rename_sources(As0, Rs), - Test = {test,N,{f,Fail},As}, - {[Test|Acc],St}; -bopt_cg({inverted_test,N,fail,As0}, Fail, Rs, Acc, St0) -> - As = rename_sources(As0, Rs), - {Lbl,St} = new_label(St0), - {[{label,Lbl},{jump,{f,Fail}},{test,N,{f,Lbl},As}|Acc],St}; -bopt_cg({prot,Pre0,Tree}, Fail, Rs0, Acc, St0) -> - Pre1 = update_fail_label(Pre0, Fail, []), - {Pre,Rs} = rename_regs(Pre1, Rs0), - bopt_cg(Tree, Fail, Rs, make_block(Pre, Acc), St0); -bopt_cg({atom,true}, _Fail, _Rs, Acc, St) -> - {Acc,St}; -bopt_cg({atom,false}, Fail, _Rs, Acc, St) -> - {[{jump,{f,Fail}}|Acc],St}; -bopt_cg(_, _, _, _, _) -> - throw(not_boolean_expr). - -bopt_cg_not({'and',As0}) -> - As = [bopt_cg_not(A) || A <- As0], - {'or',As}; -bopt_cg_not({'or',As0}) -> - As = [bopt_cg_not(A) || A <- As0], - {'and',As}; -bopt_cg_not({'not',Arg}) -> - bopt_cg_not_not(Arg); -bopt_cg_not({test,Test,Fail,As}) -> - {inverted_test,Test,Fail,As}; -bopt_cg_not({atom,Bool}) when is_boolean(Bool) -> - {atom,not Bool}; -bopt_cg_not(_) -> - throw(not_boolean_expr). - -bopt_cg_not_not({'and',As}) -> - {'and',[bopt_cg_not_not(A) || A <- As]}; -bopt_cg_not_not({'or',As}) -> - {'or',[bopt_cg_not_not(A) || A <- As]}; -bopt_cg_not_not({'not',Arg}) -> - bopt_cg_not(Arg); -bopt_cg_not_not(Leaf) -> Leaf. - -bopt_cg_and([I|Is], Fail, Rs, Acc0, St0) -> - {Acc,St} = bopt_cg(I, Fail, Rs, Acc0, St0), - bopt_cg_and(Is, Fail, Rs, Acc, St); -bopt_cg_and([], _, _, Acc, St) -> {Acc,St}. - -bopt_cg_or([I], Succ, Fail, Rs, Acc0, St0) -> - {Acc,St} = bopt_cg(I, Fail, Rs, Acc0, St0), - {[{label,Succ}|Acc],St}; -bopt_cg_or([I|Is], Succ, Fail, Rs, Acc0, St0) -> - {Lbl,St1} = new_label(St0), - {Acc,St} = bopt_cg(I, Lbl, Rs, Acc0, St1), - bopt_cg_or(Is, Succ, Fail, Rs, [{label,Lbl},{jump,{f,Succ}}|Acc], St). - -new_label(#st{next=LabelNum}=St) when is_integer(LabelNum) -> - {LabelNum,St#st{next=LabelNum+1}}. - -free_variables(Is) -> - E = gb_sets:empty(), - free_vars_1(Is, E, E, E). - -free_vars_1([{set,Ds,As,{bif,_,_}}|Is], F0, N0, A) -> - F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), - N = gb_sets:union(N0, var_list(Ds)), - free_vars_1(Is, F, N, A); -free_vars_1([{set,Ds,As,{alloc,Regs,{gc_bif,_,_}}}|Is], F0, N0, A0) -> - A = gb_sets:union(A0, gb_sets:from_list(free_vars_regs(Regs))), - F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), - N = gb_sets:union(N0, var_list(Ds)), - free_vars_1(Is, F, N, A); -free_vars_1([{protected,_,Pa,_}|Is], F, N, A) -> - free_vars_1(Pa++Is, F, N, A); -free_vars_1([], F0, N, A) -> - F = case gb_sets:is_empty(A) of - true -> - %% No GC BIFs. - {x,X} = gb_sets:smallest(N), - P = ordsets:from_list(free_vars_regs(X)), - ordsets:union(gb_sets:to_list(F0), P); - false -> - %% At least one GC BIF. - gb_sets:to_list(gb_sets:union(F0, gb_sets:difference(A, N))) - end, - gb_trees:from_orddict([{K,any} || K <- F]). - -var_list(Is) -> - var_list_1(Is, gb_sets:empty()). - -var_list_1([{Tag,_}=X|Is], D) when Tag =:= x; Tag =:= y -> - var_list_1(Is, gb_sets:add(X, D)); -var_list_1([_|Is], D) -> - var_list_1(Is, D); -var_list_1([], D) -> D. - -free_vars_regs(0) -> []; -free_vars_regs(X) -> [{x,X-1}|free_vars_regs(X-1)]. - -rename_regs(Is, Regs) -> - rename_regs(Is, Regs, []). - -rename_regs([{set,[Dst0],Ss0,{alloc,_,Info}}|Is], Regs0, Acc) -> - Live = live_regs(Regs0), - Ss = rename_sources(Ss0, Regs0), - Regs = put_reg(Dst0, Regs0), - Dst = fetch_reg(Dst0, Regs), - rename_regs(Is, Regs, [{set,[Dst],Ss,{alloc,Live,Info}}|Acc]); -rename_regs([{set,[Dst0],Ss0,Info}|Is], Regs0, Acc) -> - Ss = rename_sources(Ss0, Regs0), - Regs = put_reg(Dst0, Regs0), - Dst = fetch_reg(Dst0, Regs), - rename_regs(Is, Regs, [{set,[Dst],Ss,Info}|Acc]); -rename_regs([], Regs, Acc) -> {reverse(Acc),Regs}. - -rename_sources(Ss, Regs) -> - map(fun({x,_}=R) -> fetch_reg(R, Regs); - ({tmp,_}=R) -> fetch_reg(R, Regs); - (E) -> E - end, Ss). - -%%% -%%% Keeping track of register assignments. -%%% - -init_regs(Free) -> - init_regs_1(Free, 0). - -init_regs_1([{x,I}=V|T], I) -> - [{I,V}|init_regs_1(T, I+1)]; -init_regs_1([{x,X}|_]=T, I) when I < X -> - [{I,reserved}|init_regs_1(T, I+1)]; -init_regs_1([{y,_}|_], _) -> []; -init_regs_1([], _) -> []. - -put_reg(V, Rs) -> put_reg_1(V, Rs, 0). - -put_reg_1(V, [R|Rs], I) -> [R|put_reg_1(V, Rs, I+1)]; -put_reg_1(V, [], I) -> [{I,V}]. - -fetch_reg(V, [{I,V}|_]) -> {x,I}; -fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). - -live_regs([{_,reserved}|_]) -> - %% We are not sure that this register is initialized, so we must - %% abort the optimization. - throw(gc_bif_alloc_failure); -live_regs([{I,_}]) -> - I+1; -live_regs([{_,_}|Regs]) -> - live_regs(Regs); -live_regs([]) -> - 0. - - -%%% -%%% Convert a block to Static Single Assignment (SSA) form. -%%% - --record(ssa, - {live=0, %Variable counter. - sub=gb_trees:empty(), %Substitution table. - prot=gb_sets:empty(), %Targets assigned by protecteds. - in_prot=false %Inside a protected. - }). - -ssa_block(Is0) -> - {Is,_} = ssa_block_1(Is0, #ssa{}, []), - Is. - -ssa_block_1([{protected,[_],Pa0,Pb}|Is], Sub0, Acc) -> - {Pa,Sub1} = ssa_block_1(Pa0, Sub0#ssa{in_prot=true}, []), - Dst = ssa_last_target(Pa), - Sub = Sub1#ssa{prot=gb_sets:insert(Dst, Sub1#ssa.prot), - in_prot=Sub0#ssa.in_prot}, - ssa_block_1(Is, Sub, [{protected,[Dst],Pa,Pb}|Acc]); -ssa_block_1([{set,[Dst],As,Bif}|Is], Sub0, Acc0) -> - Sub1 = ssa_in_use_list(As, Sub0), - Sub = ssa_assign(Dst, Sub1), - Acc = [{set,[ssa_sub(Dst, Sub)],ssa_sub_list(As, Sub0),Bif}|Acc0], - ssa_block_1(Is, Sub, Acc); -ssa_block_1([], Sub, Acc) -> {reverse(Acc),Sub}. - -ssa_in_use_list(As, Sub) -> - foldl(fun ssa_in_use/2, Sub, As). - -ssa_in_use({x,_}=R, #ssa{sub=Sub0}=Ssa) -> - case gb_trees:is_defined(R, Sub0) of - true -> Ssa; - false -> - Sub = gb_trees:insert(R, R, Sub0), - Ssa#ssa{sub=Sub} - end; -ssa_in_use(_, Ssa) -> Ssa. - -ssa_assign({x,_}=R, #ssa{sub=Sub0}=Ssa0) -> - {NewReg,Ssa} = ssa_new_reg(Ssa0), - case gb_trees:is_defined(R, Sub0) of - false -> - Sub = gb_trees:insert(R, NewReg, Sub0), - Ssa#ssa{sub=Sub}; - true -> - Sub1 = gb_trees:update(R, NewReg, Sub0), - Sub = gb_trees:insert(NewReg, NewReg, Sub1), - Ssa#ssa{sub=Sub} - end. - -ssa_sub_list(List, Sub) -> - [ssa_sub(E, Sub) || E <- List]. - -ssa_sub(R0, #ssa{sub=Sub,prot=Prot,in_prot=InProt}) -> - case gb_trees:lookup(R0, Sub) of - none -> R0; - {value,R} -> - case InProt andalso gb_sets:is_element(R, Prot) of - true -> - throw(protected_violation); - false -> - R - end - end. - -ssa_new_reg(#ssa{live=Reg}=Ssa) -> - {{tmp,Reg},Ssa#ssa{live=Reg+1}}. - -ssa_last_target([{set,[Dst],_,_}]) -> Dst; -ssa_last_target([_|Is]) -> ssa_last_target(Is). - -%% is_killed(Register, [Instruction], FailLabel, State) -> true|false -%% Determine whether a register is killed in the instruction sequence. -%% The state is used to allow us to determine the kill state -%% across branches. - -is_killed(R, Is, Label, #st{ll=Ll}) -> - beam_utils:is_killed(R, Is, Ll) andalso - beam_utils:is_killed_at(R, Label, Ll). - -%% is_not_used(Register, [Instruction], FailLabel, State) -> true|false -%% Determine whether a register is never used in the instruction sequence -%% (it could still referenced by an allocate instruction, meaning that -%% it MUST be initialized). -%% The state is used to allow us to determine the usage state -%% across branches. - -is_not_used(R, Is, Label, #st{ll=Ll}) -> - beam_utils:is_not_used(R, Is, Ll) andalso - beam_utils:is_not_used_at(R, Label, Ll). - -%% initialized_regs([Instruction]) -> [Register]) -%% Given a REVERSED instruction sequence, return a list of the registers -%% that are guaranteed to be initialized (not contain garbage). - -initialized_regs(Is) -> - initialized_regs(Is, ordsets:new()). - -initialized_regs([{set,Dst,_Src,{alloc,Live,_}}|_], Regs0) -> - Regs = add_init_regs(free_vars_regs(Live), Regs0), - add_init_regs(Dst, Regs); -initialized_regs([{set,Dst,Src,_}|Is], Regs) -> - initialized_regs(Is, add_init_regs(Dst, add_init_regs(Src, Regs))); -initialized_regs([{test,_,_,Src}|Is], Regs) -> - initialized_regs(Is, add_init_regs(Src, Regs)); -initialized_regs([{block,Bl}|Is], Regs) -> - initialized_regs(reverse(Bl, Is), Regs); -initialized_regs([{bs_context_to_binary,Src}|Is], Regs) -> - initialized_regs(Is, add_init_regs([Src], Regs)); -initialized_regs([{label,_},{func_info,_,_,Arity}|_], Regs) -> - InitRegs = free_vars_regs(Arity), - add_init_regs(InitRegs, Regs); -initialized_regs([_|_], Regs) -> Regs. - -add_init_regs([{x,_}=X|T], Regs) -> - add_init_regs(T, ordsets:add_element(X, Regs)); -add_init_regs([_|T], Regs) -> - add_init_regs(T, Regs); -add_init_regs([], Regs) -> Regs. diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 6f6d742293..9087586b58 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -266,20 +266,42 @@ backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) -> false -> backward([Move|Is], D, [Jump|Acc]); true -> backward([Jump|Is], D, Acc) end; -backward([{jump,{f,To}}=J|[{bif,Op,_,Ops,Reg}|Is]=Is0], D, Acc) -> +backward([{jump,{f,To}}=J|[{bif,Op,{f,BifFail},Ops,Reg}|Is]=Is0], D, Acc) -> try replace_comp_op(To, Reg, Op, Ops, D) of I -> backward(Is, D, I++Acc) catch - throw:not_possible -> backward(Is0, D, [J|Acc]) + throw:not_possible -> + case To =:= BifFail of + true -> + %% The bif instruction is redundant. See the comment + %% in the next clause for why there is no need to + %% test for liveness of Reg at label To. + backward([J|Is], D, Acc); + false -> + backward(Is0, D, [J|Acc]) + end end; -backward([{test,bs_start_match2,F,_,[R,_],Ctxt}=I|Is], D, +backward([{jump,{f,To}}=J|[{gc_bif,_,{f,To},_,_,_Dst}|Is]], D, Acc) -> + %% The gc_bif instruction is redundant, since either the gc_bif + %% instruction itself or the jump instruction will transfer control + %% to label To. Note that a gc_bif instruction does not assign its + %% destination register if the failure branch is taken; therefore, + %% the code at label To is not allowed to assume that the destination + %% register is initialized, and it is therefore no need to test + %% for liveness of the destination register at label To. + backward([J|Is], D, Acc); +backward([{test,bs_start_match2,F,Live,[R,_]=Args,Ctxt}|Is], D, [{test,bs_match_string,F,[Ctxt,Bs]}, {test,bs_test_tail2,F,[Ctxt,0]}|Acc0]=Acc) -> + {f,To0} = F, case beam_utils:is_killed(Ctxt, Acc0, D) of true -> - Eq = {test,is_eq_exact,F,[R,{literal,Bs}]}, + To = shortcut_bs_context_to_binary(To0, R, D), + Eq = {test,is_eq_exact,{f,To},[R,{literal,Bs}]}, backward(Is, D, [Eq|Acc0]); false -> + To = shortcut_bs_start_match(To0, R, D), + I = {test,bs_start_match2,{f,To},Live,Args,Ctxt}, backward(Is, D, [I|Acc]) end; backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) -> @@ -357,6 +379,14 @@ backward([{kill,_}=I|Is], D, [{line,_},Exit|_]=Acc) -> false -> backward(Is, D, [I|Acc]); true -> backward(Is, D, Acc) end; +backward([{bif,'or',{f,To0},[Dst,{atom,false}],Dst}=I|Is], D, + [{test,is_eq_exact,{f,To},[Dst,{atom,true}]}|_]=Acc) -> + case shortcut_label(To0, D) of + To -> + backward(Is, D, Acc); + _ -> + backward(Is, D, [I|Acc]) + end; backward([I|Is], D, Acc) -> backward(Is, D, [I|Acc]); backward([], _D, Acc) -> Acc. @@ -375,6 +405,8 @@ shortcut_select_list([Lit,{f,To0}|T], Reg, D, Acc) -> shortcut_select_list(T, Reg, D, [{f,To},Lit|Acc]); shortcut_select_list([], _, _, Acc) -> reverse(Acc). +shortcut_label(0, _) -> + 0; shortcut_label(To0, D) -> case beam_utils:code_at(To0, D) of [{jump,{f,To}}|_] -> shortcut_label(To, D); @@ -551,6 +583,21 @@ shortcut_bs_start_match_1([{test,bs_start_match2,{f,To},_,[Reg|_],_}|_], shortcut_bs_start_match_1(_, _, To, _) -> To. +%% shortcut_bs_context_to_binary(TargetLabel, Reg) -> TargetLabel +%% If a bs_start_match2 instruction has been eliminated, the +%% bs_context_to_binary instruction can be eliminated too. + +shortcut_bs_context_to_binary(To, Reg, D) -> + shortcut_bs_ctb_1(beam_utils:code_at(To, D), Reg, To, D). + +shortcut_bs_ctb_1([{bs_context_to_binary,Reg}|Is], Reg, To, D) -> + shortcut_bs_ctb_1(Is, Reg, To, D); +shortcut_bs_ctb_1([{jump,{f,To}}|_], Reg, _, D) -> + Code = beam_utils:code_at(To, D), + shortcut_bs_ctb_1(Code, Reg, To, D); +shortcut_bs_ctb_1(_, _, To, _) -> + To. + %% shortcut_rel_op(FailLabel, Operator, [Operand], D) -> FailLabel' %% Try to shortcut the given test instruction. Example: %% diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 48b5a32814..e096270d8c 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -23,7 +23,7 @@ -export([module/2, is_unreachable_after/1,is_exit_instruction/1, - remove_unused_labels/1,is_label_used_in/2]). + remove_unused_labels/1]). %%% The following optimisations are done: %%% @@ -155,9 +155,7 @@ share(Is0) -> Is = eliminate_fallthroughs(Is0, []), share_1(Is, #{}, [], []). -share_1([{label,_}=Lbl|Is], Dict, [], Acc) -> - share_1(Is, Dict, [], [Lbl|Acc]); -share_1([{label,L}=Lbl|Is], Dict0, Seq, Acc) -> +share_1([{label,L}=Lbl|Is], Dict0, [_|_]=Seq, Acc) -> case maps:find(Seq, Dict0) of error -> Dict = maps:put(Seq, L, Dict0), @@ -208,21 +206,18 @@ sharable_with_try([]) -> true. %% Eliminate all fallthroughs. Return the result reversed. -eliminate_fallthroughs([I,{label,L}=Lbl|Is], Acc) -> - case is_unreachable_after(I) orelse is_label(I) of +eliminate_fallthroughs([{label,L}=Lbl|Is], [I|_]=Acc) -> + case is_unreachable_after(I) of false -> %% Eliminate fallthrough. - eliminate_fallthroughs(Is, [Lbl,{jump,{f,L}},I|Acc]); + eliminate_fallthroughs(Is, [Lbl,{jump,{f,L}}|Acc]); true -> - eliminate_fallthroughs(Is, [Lbl,I|Acc]) + eliminate_fallthroughs(Is, [Lbl|Acc]) end; eliminate_fallthroughs([I|Is], Acc) -> eliminate_fallthroughs(Is, [I|Acc]); eliminate_fallthroughs([], Acc) -> Acc. -is_label({label,_}) -> true; -is_label(_) -> false. - %%% %%% (2) Move short code sequences ending in an instruction that causes an exit %%% to the end of the function. @@ -478,36 +473,6 @@ is_exit_instruction({try_case_end,_}) -> true; is_exit_instruction({badmatch,_}) -> true; is_exit_instruction(_) -> false. -%% is_label_used_in(LabelNumber, [Instruction]) -> boolean() -%% Check whether the label is used in the instruction sequence -%% (including inside blocks). - -is_label_used_in(Lbl, Is) -> - is_label_used_in_1(Is, Lbl, cerl_sets:new()). - -is_label_used_in_1([{block,Block}|Is], Lbl, Empty) -> - lists:any(fun(I) -> is_label_used_in_block(I, Lbl) end, Block) - orelse is_label_used_in_1(Is, Lbl, Empty); -is_label_used_in_1([I|Is], Lbl, Empty) -> - Used = ulbl(I, Empty), - cerl_sets:is_element(Lbl, Used) orelse is_label_used_in_1(Is, Lbl, Empty); -is_label_used_in_1([], _, _) -> false. - -is_label_used_in_block({set,_,_,Info}, Lbl) -> - case Info of - {bif,_,{f,F}} -> F =:= Lbl; - {alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl; - {alloc,_,{put_map,_,{f,F}}} -> F =:= Lbl; - {get_map_elements,{f,F}} -> F =:= Lbl; - {try_catch,_,{f,F}} -> F =:= Lbl; - {alloc,_,_} -> false; - {put_tuple,_} -> false; - {get_tuple_element,_} -> false; - {set_tuple_element,_} -> false; - {line,_} -> false; - _ when is_atom(Info) -> false - end. - %% remove_unused_labels(Instructions0) -> Instructions %% Remove all unused labels. Also remove unreachable %% instructions following labels that are removed. diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index ce566373bb..d82ed8639d 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -49,10 +49,6 @@ module(Stream, {Mod,Exp,Attr,Code,NumLabels}) -> [Name, Arity, Entry]), io:put_chars(Stream, format_asm(Asm)) end, Code); -module(Stream, {Mod,Exp,Inter}) -> - %% Other kinds of intermediate formats. - io:fwrite(Stream, "~w.~n~p.~n", [Mod,Exp]), - foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Inter); module(Stream, [_|_]=Fs) -> %% Form-based abstract format. foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Fs). diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index a8dc6805bc..d40669083e 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -230,7 +230,7 @@ safe_labels([], Acc) -> gb_sets:from_list(Acc). frame_layout(Is, Kills, #st{safe=Safe,lbl=D}) -> N = frame_size(Is, Safe), - IsKilled = fun(R) -> beam_utils:is_killed(R, Is, D) end, + IsKilled = fun(R) -> beam_utils:is_not_used(R, Is, D) end, {N,frame_layout_1(Kills, 0, N, IsKilled, [])}. frame_layout_1([{kill,{y,Y}}=I|Ks], Y, N, IsKilled, Acc) -> diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index acaf3ede66..d324580cba 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -592,6 +592,9 @@ is_math_bif(log10, 1) -> true; is_math_bif(sqrt, 1) -> true; is_math_bif(atan2, 2) -> true; is_math_bif(pow, 2) -> true; +is_math_bif(ceil, 1) -> true; +is_math_bif(floor, 1) -> true; +is_math_bif(fmod, 2) -> true; is_math_bif(pi, 0) -> true; is_math_bif(_, _) -> false. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 249d9395ca..74e3d7e38a 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -22,7 +22,7 @@ -module(beam_utils). -export([is_killed_block/2,is_killed/3,is_killed_at/3, - is_not_used/3,is_not_used_at/3, + is_not_used/3, empty_label_index/0,index_label/3,index_labels/1, code_at/2,bif_to_test/3,is_pure_test/1, live_opt/1,delete_live_annos/1,combine_heap_needs/2, @@ -31,8 +31,7 @@ -import(lists, [member/2,sort/1,reverse/1,splitwith/2]). -record(live, - {bl, %Block check fun. - lbl, %Label to code index. + {lbl, %Label to code index. res}). %Result cache for each label. @@ -45,12 +44,16 @@ %% i.e. it is OK to enter the instruction sequence with Register %% containing garbage. -is_killed_block(R, Is) -> - case check_killed_block(R, Is) of - killed -> true; - used -> false; - transparent -> false - end. +is_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) -> + X >= Live; +is_killed_block(R, [{set,Ds,Ss,_Op}|Is]) -> + not member(R, Ss) andalso (member(R, Ds) orelse is_killed_block(R, Is)); +is_killed_block(R, [{'%live',_,Regs}|Is]) -> + case R of + {x,X} when (Regs bsr X) band 1 =:= 0 -> true; + _ -> is_killed_block(R, Is) + end; +is_killed_block(_, []) -> false. %% is_killed(Register, [Instruction], State) -> true|false %% Determine whether a register is killed by the instruction sequence. @@ -63,20 +66,20 @@ is_killed_block(R, Is) -> %% to determine the kill state across branches. is_killed(R, Is, D) -> - St = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()}, + St = #live{lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of {killed,_} -> true; - {used,_} -> false + {_,_} -> false end. %% is_killed_at(Reg, Lbl, State) -> true|false %% Determine whether Reg is killed at label Lbl. is_killed_at(R, Lbl, D) when is_integer(Lbl) -> - St0 = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()}, + St0 = #live{lbl=D,res=gb_trees:empty()}, case check_liveness_at(R, Lbl, St0) of {killed,_} -> true; - {used,_} -> false + {_,_} -> false end. %% is_not_used(Register, [Instruction], State) -> true|false @@ -87,24 +90,10 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) -> %% across branches. is_not_used(R, Is, D) -> - St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()}, + St = #live{lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of - {killed,_} -> true; - {used,_} -> false - end. - -%% is_not_used(Register, [Instruction], State) -> true|false -%% Determine whether a register is never used in the instruction sequence -%% (it could still be referenced by an allocate instruction, meaning that -%% it MUST be initialized, but that its value does not matter). -%% The state is used to allow us to determine the usage state -%% across branches. - -is_not_used_at(R, Lbl, D) -> - St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()}, - case check_liveness_at(R, Lbl, St) of - {killed,_} -> true; - {used,_} -> false + {used,_} -> false; + {_,_} -> true end. %% index_labels(FunctionIs) -> State @@ -240,15 +229,19 @@ split_even(Rs) -> split_even(Rs, [], []). %% check_liveness(Reg, [Instruction], #live{}) -> -%% {killed | used, #live{}} +%% {killed | not_used | used, #live{}} %% Find out whether Reg is used or killed in instruction sequence. -%% 'killed' means that Reg is assigned a new value or killed by an -%% allocation instruction. 'used' means that Reg is used in some way. +%% +%% killed - Reg is assigned or killed by an allocation instruction. +%% not_used - the value of Reg is not used, but Reg must not be garbage +%% used - Reg is used -check_liveness(R, [{block,Blk}|Is], #live{bl=BlockCheck}=St0) -> - case BlockCheck(R, Blk, St0) of - {transparent,St} -> check_liveness(R, Is, St); - {Other,_}=Res when is_atom(Other) -> Res +check_liveness(R, [{block,Blk}|Is], St0) -> + case check_liveness_block(R, Blk, St0) of + {transparent,St1} -> + check_liveness(R, Is, St1); + {Other,_}=Res when is_atom(Other) -> + Res end; check_liveness(R, [{label,_}|Is], St) -> check_liveness(R, Is, St); @@ -258,8 +251,12 @@ check_liveness(R, [{test,_,{f,Fail},As}|Is], St0) -> {used,St0}; false -> case check_liveness_at(R, Fail, St0) of - {killed,St} -> check_liveness(R, Is, St); - {_,_}=Other -> Other + {killed,St1} -> + check_liveness(R, Is, St1); + {not_used,St1} -> + not_used(check_liveness(R, Is, St1)); + {used,_}=Used -> + Used end end; check_liveness(R, [{test,Op,Fail,Live,Ss,Dst}|Is], St) -> @@ -329,7 +326,7 @@ check_liveness(R, [{call,Live,_}|Is], St) -> case R of {x,X} when X < Live -> {used,St}; {x,_} -> {killed,St}; - {y,_} -> check_liveness(R, Is, St) + {y,_} -> not_used(check_liveness(R, Is, St)) end; check_liveness(R, [{call_ext,Live,_}=I|Is], St) -> case R of @@ -340,7 +337,7 @@ check_liveness(R, [{call_ext,Live,_}=I|Is], St) -> {y,_} -> case beam_jump:is_exit_instruction(I) of false -> - check_liveness(R, Is, St); + not_used(check_liveness(R, Is, St)); true -> %% We must make sure we don't check beyond this %% instruction or we will fall through into random @@ -352,43 +349,20 @@ check_liveness(R, [{call_fun,Live}|Is], St) -> case R of {x,X} when X =< Live -> {used,St}; {x,_} -> {killed,St}; - {y,_} -> check_liveness(R, Is, St) + {y,_} -> not_used(check_liveness(R, Is, St)) end; check_liveness(R, [{apply,Args}|Is], St) -> case R of {x,X} when X < Args+2 -> {used,St}; {x,_} -> {killed,St}; - {y,_} -> check_liveness(R, Is, St) - end; -check_liveness(R, [{bif,Op,{f,Fail},Ss,D}|Is], St0) -> - case check_liveness_fail(R, Op, Ss, Fail, St0) of - {killed,St} = Killed -> - case member(R, Ss) of - true -> {used,St}; - false when R =:= D -> Killed; - false -> check_liveness(R, Is, St) - end; - Other -> - Other - end; -check_liveness(R, [{gc_bif,Op,{f,Fail},Live,Ss,D}|Is], St0) -> - case R of - {x,X} when X >= Live -> - {killed,St0}; - {x,_} -> - {used,St0}; - _ -> - case check_liveness_fail(R, Op, Ss, Fail, St0) of - {killed,St}=Killed -> - case member(R, Ss) of - true -> {used,St}; - false when R =:= D -> Killed; - false -> check_liveness(R, Is, St) - end; - Other -> - Other - end - end; + {y,_} -> not_used(check_liveness(R, Is, St)) + end; +check_liveness(R, [{bif,Op,Fail,Ss,D}|Is], St) -> + Set = {set,[D],Ss,{bif,Op,Fail}}, + check_liveness(R, [{block,[Set]}|Is], St); +check_liveness(R, [{gc_bif,Op,{f,Fail},Live,Ss,D}|Is], St) -> + Set = {set,[D],Ss,{alloc,Live,{gc_bif,Op,Fail}}}, + check_liveness(R, [{block,[Set]}|Is], St); check_liveness(R, [{bs_put,{f,0},_,Ss}|Is], St) -> case member(R, Ss) of true -> {used,St}; @@ -414,7 +388,7 @@ check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) -> case R of {x,X} when X < NumFree -> {used,St}; {x,_} -> {killed,St}; - _ -> check_liveness(R, Is, St) + {y,_} -> not_used(check_liveness(R, Is, St)) end; check_liveness({x,_}=R, [{'catch',_,_}|Is], St) -> %% All x registers will be killed if an exception occurs. @@ -483,18 +457,9 @@ check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) -> Other end end; -check_liveness(R, [{put_map,{f,_},_,Src,_D,Live,{list,_}}|_], St0) -> - case R of - Src -> - {used,St0}; - {x,X} when X < Live -> - {used,St0}; - {x,_} -> - {killed,St0}; - {y,_} -> - %% Conservatively mark it as used. - {used,St0} - end; +check_liveness(R, [{put_map,F,Op,S,D,Live,{list,Puts}}|Is], St) -> + Set = {set,[D],[S|Puts],{alloc,Live,{put_map,Op,F}}}, + check_liveness(R, [{block,[Set]}||Is], St); check_liveness(R, [{test_heap,N,Live}|Is], St) -> I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]}, check_liveness(R, [I|Is], St); @@ -507,16 +472,24 @@ check_liveness(R, [{get_list,S,D1,D2}|Is], St) -> check_liveness(_R, Is, St) when is_list(Is) -> %% Not implemented. Conservatively assume that the register is used. {used,St}. - -check_liveness_everywhere(R, [{f,Lbl}|T], St0) -> - case check_liveness_at(R, Lbl, St0) of - {killed,St} -> check_liveness_everywhere(R, T, St); - {_,_}=Other -> Other + +check_liveness_everywhere(R, Lbls, St0) -> + check_liveness_everywhere_1(R, Lbls, killed, St0). + +check_liveness_everywhere_1(R, [{f,Lbl}|T], Res0, St0) -> + {Res1,St} = check_liveness_at(R, Lbl, St0), + Res = case Res1 of + killed -> Res0; + _ -> Res1 + end, + case Res of + used -> {used,St}; + _ -> check_liveness_everywhere_1(R, T, Res, St) end; -check_liveness_everywhere(R, [_|T], St) -> - check_liveness_everywhere(R, T, St); -check_liveness_everywhere(_, [], St) -> - {killed,St}. +check_liveness_everywhere_1(R, [_|T], Res, St) -> + check_liveness_everywhere_1(R, T, Res, St); +check_liveness_everywhere_1(_, [], Res, St) -> + {Res,St}. check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) -> case gb_trees:lookup(Lbl, ResMemorized) of @@ -530,56 +503,20 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) -> {Res,St#live{res=gb_trees:insert(Lbl, Res, St#live.res)}} end. +not_used({killed,St}) -> {not_used,St}; +not_used({_,_}=Res) -> Res. + check_liveness_ret(R, R, St) -> {used,St}; check_liveness_ret(_, _, St) -> {killed,St}. -check_liveness_fail(_, _, _, 0, St) -> - {killed,St}; -check_liveness_fail(R, Op, Args, Fail, St) -> - Arity = length(Args), - case erl_internal:comp_op(Op, Arity) orelse - erl_internal:new_type_test(Op, Arity) of - true -> {killed,St}; - false -> check_liveness_at(R, Fail, St) - end. - -%% check_killed_block(Reg, [Instruction], State) -> killed | transparent | used -%% Finds out how Reg is used in the instruction sequence inside a block. -%% Returns one of: -%% killed - Reg is assigned a new value or killed by an allocation instruction -%% transparent - Reg is neither used nor killed -%% used - Reg is used or referenced by an allocation instruction. -%% -%% (Unknown instructions will cause an exception.) - -check_killed_block_fun() -> - fun(R, Is, St) -> {check_killed_block(R, Is),St} end. - -check_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) -> - if - X >= Live -> killed; - true -> used - end; -check_killed_block(R, [{set,Ds,Ss,_Op}|Is]) -> - case member(R, Ss) of - true -> used; - false -> - case member(R, Ds) of - true -> killed; - false -> check_killed_block(R, Is) - end - end; -check_killed_block(R, [{'%live',_,Regs}|Is]) -> - case R of - {x,X} when (Regs bsr X) band 1 =:= 0 -> killed; - _ -> check_killed_block(R, Is) - end; -check_killed_block(_, []) -> transparent. - -%% check_used_block(Reg, [Instruction], State) -> killed | transparent | used +%% check_liveness_block(Reg, [Instruction], State) -> +%% {killed | not_used | used | transparent,State'} %% Finds out how Reg is used in the instruction sequence inside a block. %% Returns one of: -%% killed - Reg is assigned a new value or killed by an allocation instruction +%% killed - Reg is assigned a new value or killed by an +%% allocation instruction +%% not_used - The value is not used, but the register is referenced +%% e.g. by an allocation instruction %% transparent - Reg is neither used nor killed %% used - Reg is explicitly used by an instruction %% @@ -587,45 +524,64 @@ check_killed_block(_, []) -> transparent. %% %% (Unknown instructions will cause an exception.) -check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St) -> +check_liveness_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St0) -> if - X >= Live -> {killed,St}; - true -> check_used_block_1(R, Ss, Ds, Op, Is, St) + X >= Live -> + {killed,St0}; + true -> + case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of + {killed,St} -> {not_used,St}; + {transparent,St} -> {not_used,St}; + {_,_}=Res -> Res + end end; -check_used_block(R, [{set,Ds,Ss,Op}|Is], St) -> - check_used_block_1(R, Ss, Ds, Op, Is, St); -check_used_block(_, [], St) -> {transparent,St}. +check_liveness_block({y,_}=R, [{set,Ds,Ss,{alloc,_Live,Op}}|Is], St) -> + check_liveness_block_1(R, Ss, Ds, Op, Is, St); +check_liveness_block(R, [{set,Ds,Ss,Op}|Is], St) -> + check_liveness_block_1(R, Ss, Ds, Op, Is, St); +check_liveness_block(_, [], St) -> {transparent,St}. -check_used_block_1(R, Ss, Ds, Op, Is, St0) -> +check_liveness_block_1(R, Ss, Ds, Op, Is, St0) -> case member(R, Ss) of true -> {used,St0}; false -> - case is_reg_used_at(R, Op, St0) of - {true,St} -> - {used,St}; - {false,St} -> + case check_liveness_block_2(R, Op, Ss, St0) of + {killed,St} -> case member(R, Ds) of true -> {killed,St}; - false -> check_used_block(R, Is, St) - end + false -> check_liveness_block(R, Is, St) + end; + {not_used,St} -> + not_used(case member(R, Ds) of + true -> {killed,St}; + false -> check_liveness_block(R, Is, St) + end); + {used,St} -> + {used,St} end end. -is_reg_used_at(R, {gc_bif,_,{f,Lbl}}, St) -> - is_reg_used_at_1(R, Lbl, St); -is_reg_used_at(R, {bif,_,{f,Lbl}}, St) -> - is_reg_used_at_1(R, Lbl, St); -is_reg_used_at(_, _, St) -> - {false,St}. +check_liveness_block_2(R, {gc_bif,_Op,{f,Lbl}}, _Ss, St) -> + check_liveness_block_3(R, Lbl, St); +check_liveness_block_2(R, {bif,Op,{f,Lbl}}, Ss, St) -> + Arity = length(Ss), + case erl_internal:comp_op(Op, Arity) orelse + erl_internal:new_type_test(Op, Arity) of + true -> + {killed,St}; + false -> + check_liveness_block_3(R, Lbl, St) + end; +check_liveness_block_2(R, {put_map,_Op,{f,Lbl}}, _Ss, St) -> + check_liveness_block_3(R, Lbl, St); +check_liveness_block_2(_, _, _, St) -> + {killed,St}. -is_reg_used_at_1(_, 0, St) -> - {false,St}; -is_reg_used_at_1(R, Lbl, St0) -> - case check_liveness_at(R, Lbl, St0) of - {killed,St} -> {false,St}; - {used,St} -> {true,St} - end. +check_liveness_block_3(_, 0, St) -> + {killed,St}; +check_liveness_block_3(R, Lbl, St0) -> + check_liveness_at(R, Lbl, St0). index_labels_1([{label,Lbl}|Is0], Acc) -> Is = drop_labels(Is0), diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 16dba35adc..5659077c5d 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -909,7 +909,7 @@ all_ms_in_x_regs(Live0, Vst) -> ms_in_y_regs(Id, #vst{current=#st{y=Ys0}}) -> Ys = gb_trees:to_list(Ys0), - [Y || {Y,#ms{id=OtherId}} <- Ys, OtherId =:= Id]. + [{y,Y} || {Y,#ms{id=OtherId}} <- Ys, OtherId =:= Id]. verify_call_match_context(Lbl, Ctx, #vst{ft=Ft}) -> case gb_trees:lookup(Lbl, Ft) of @@ -1508,7 +1508,9 @@ bif_type(abs, [Num], Vst) -> bif_type(float, _, _) -> {float,[]}; bif_type('/', _, _) -> {float,[]}; %% Integer operations. +bif_type(ceil, [_], _) -> {integer,[]}; bif_type('div', [_,_], _) -> {integer,[]}; +bif_type(floor, [_], _) -> {integer,[]}; bif_type('rem', [_,_], _) -> {integer,[]}; bif_type(length, [_], _) -> {integer,[]}; bif_type(size, [_], _) -> {integer,[]}; @@ -1642,6 +1644,9 @@ return_type_math(log10, 1) -> {float,[]}; return_type_math(sqrt, 1) -> {float,[]}; return_type_math(atan2, 2) -> {float,[]}; return_type_math(pow, 2) -> {float,[]}; +return_type_math(ceil, 1) -> {float,[]}; +return_type_math(floor, 1) -> {float,[]}; +return_type_math(fmod, 2) -> {float,[]}; return_type_math(pi, 0) -> {float,[]}; return_type_math(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 61abae344c..b1be6ffc6d 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -1,8 +1,3 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-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 @@ -15,9 +10,8 @@ %% See the License for the specific language governing permissions and %% limitations under the License. %% -%% %CopyrightEnd% - -%% ===================================================================== +%% @copyright 1999-2002 Richard Carlsson +%% @author Richard Carlsson <[email protected]> %% @doc Core Erlang abstract syntax trees. %% %% <p> This module defines an abstract data type for representing Core diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl index 805095e30c..7d6518c3c6 100644 --- a/lib/compiler/src/cerl_clauses.erl +++ b/lib/compiler/src/cerl_clauses.erl @@ -1,8 +1,3 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-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 @@ -15,8 +10,8 @@ %% See the License for the specific language governing permissions and %% limitations under the License. %% -%% %CopyrightEnd% - +%% @copyright 1999-2002 Richard Carlsson +%% @author Richard Carlsson <[email protected]> %% @doc Utility functions for Core Erlang case/receive clauses. %% %% <p>Syntax trees are defined in the module <a diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index 2a8cf2e758..f5afa75b16 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -1,8 +1,3 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-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 @@ -15,9 +10,9 @@ %% See the License for the specific language governing permissions and %% limitations under the License. %% -%% %CopyrightEnd% -%% -%% Core Erlang inliner. +%% @copyright 1999-2002 Richard Carlsson +%% @author Richard Carlsson <[email protected]> +%% @doc Core Erlang inliner. %% ===================================================================== %% diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index b3decbec1f..f30a0b33ac 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -1,8 +1,3 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-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 @@ -15,8 +10,8 @@ %% See the License for the specific language governing permissions and %% limitations under the License. %% -%% %CopyrightEnd% - +%% @copyright 1999-2002 Richard Carlsson. +%% @author Richard Carlsson <[email protected]> %% @doc Basic functions on Core Erlang abstract syntax trees. %% %% <p>Syntax trees are defined in the module <a diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 434360d294..8608d2daac 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -360,7 +360,7 @@ run_tc({Name,Fun}, St) -> T1 = erlang:monotonic_time(), Val = (catch Fun(St)), T2 = erlang:monotonic_time(), - Elapsed = erlang:convert_time_unit(T2 - T1, native, milli_seconds), + Elapsed = erlang:convert_time_unit(T2 - T1, native, millisecond), Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize), Mem = lists:flatten(io_lib:format("~.1f kB", [Mem0/1024])), io:format(" ~-30s: ~10.3f s ~12s\n", @@ -646,13 +646,13 @@ standard_passes() -> {iff,'dabstr',{listing,"abstr"}}, {iff,debug_info,?pass(save_abstract_code)}, - ?pass(expand_module), + ?pass(expand_records), {iff,'dexp',{listing,"expand"}}, {iff,'E',{src_listing,"E"}}, {iff,'to_exp',{done,"E"}}, %% Conversion to Core Erlang. - {pass,v3_core}, + ?pass(core), {iff,'dcore',{listing,"core"}}, {iff,'to_core0',{done,"core"}} | core_passes()]. @@ -707,8 +707,6 @@ asm_passes() -> {iff,dexcept,{listing,"except"}}, {unless,no_bs_opt,{pass,beam_bs}}, {iff,dbs,{listing,"bs"}}, - {unless,no_bopt,{pass,beam_bool}}, - {iff,dbool,{listing,"bool"}}, {unless,no_topt,{pass,beam_type}}, {iff,dtype,{listing,"type"}}, {pass,beam_split}, @@ -1227,13 +1225,17 @@ makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) -> {error,St#compile{errors=St#compile.errors++[Err]}} end. -%% expand_module(State) -> State' -%% Do the common preprocessing of the input forms. +expand_records(#compile{code=Code0,options=Opts}=St0) -> + Code = erl_expand_records:module(Code0, Opts), + {ok,St0#compile{code=Code}}. -expand_module(#compile{code=Code,options=Opts0}=St0) -> - {Mod,Exp,Forms,Opts1} = sys_pre_expand:module(Code, Opts0), +core(#compile{code=Forms,options=Opts0}=St) -> + Opts1 = lists:flatten([C || {attribute,_,compile,C} <- Forms] ++ Opts0), Opts = expand_opts(Opts1), - {ok,St0#compile{module=Mod,options=Opts,code={Mod,Exp,Forms}}}. + {ok,Core,Ws} = v3_core:module(Forms, Opts), + Mod = cerl:concrete(cerl:module_name(Core)), + {ok,St#compile{module=Mod,code=Core,options=Opts, + warnings=St#compile.warnings++Ws}}. core_fold_module_after_inlining(#compile{code=Code0,options=Opts}=St) -> %% Inlining may produce code that generates spurious warnings. @@ -1787,7 +1789,6 @@ pre_load() -> L = [beam_a, beam_asm, beam_block, - beam_bool, beam_bs, beam_bsm, beam_clean, @@ -1819,7 +1820,6 @@ pre_load() -> erl_scan, sys_core_dsetel, sys_core_fold, - sys_pre_expand, v3_codegen, v3_core, v3_kernel, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 1fd7800e85..3cb991687b 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -24,7 +24,6 @@ beam_a, beam_asm, beam_block, - beam_bool, beam_bs, beam_bsm, beam_clean, @@ -63,7 +62,6 @@ sys_core_fold_lists, sys_core_inline, sys_pre_attributes, - sys_pre_expand, v3_codegen, v3_core, v3_kernel, @@ -73,5 +71,5 @@ {registered, []}, {applications, [kernel, stdlib]}, {env, []}, - {runtime_dependencies, ["stdlib-2.5","kernel-4.0","hipe-3.12","erts-7.0", + {runtime_dependencies, ["stdlib-2.5","kernel-4.0","hipe-3.12","erts-9.0", "crypto-3.6"]}]}. diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl index 8028aa99bb..79a7cccd98 100644 --- a/lib/compiler/src/core_parse.yrl +++ b/lib/compiler/src/core_parse.yrl @@ -432,6 +432,21 @@ timeout -> %% ====================================================================== %% +Header +"%% This file was automatically generated from the file \"core_parse.yrl\"." +"%%" +"%% Copyright Ericsson AB 1999-2009. 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." +"". Erlang code. diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index 67209d06be..cff6c7098b 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -179,7 +179,7 @@ format_1(#c_tuple{es=Es}, Ctxt) -> format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), $} ]; -format_1(#c_map{arg=#c_literal{anno=[],val=M},es=Es}, Ctxt) +format_1(#c_map{arg=#c_literal{val=M},es=Es}, Ctxt) when is_map(M), map_size(M) =:= 0 -> ["~{", format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 6b2d781a76..d60f73d421 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -75,10 +75,12 @@ is_pure(erlang, binary_to_list, 1) -> true; is_pure(erlang, binary_to_list, 3) -> true; is_pure(erlang, bit_size, 1) -> true; is_pure(erlang, byte_size, 1) -> true; +is_pure(erlang, ceil, 1) -> true; is_pure(erlang, element, 2) -> true; is_pure(erlang, float, 1) -> true; is_pure(erlang, float_to_list, 1) -> true; is_pure(erlang, float_to_binary, 1) -> true; +is_pure(erlang, floor, 1) -> true; is_pure(erlang, hash, 2) -> false; is_pure(erlang, hd, 1) -> true; is_pure(erlang, integer_to_binary, 1) -> true; @@ -129,11 +131,14 @@ is_pure(math, asinh, 1) -> true; is_pure(math, atan, 1) -> true; is_pure(math, atan2, 2) -> true; is_pure(math, atanh, 1) -> true; +is_pure(math, ceil, 1) -> true; is_pure(math, cos, 1) -> true; is_pure(math, cosh, 1) -> true; is_pure(math, erf, 1) -> true; is_pure(math, erfc, 1) -> true; is_pure(math, exp, 1) -> true; +is_pure(math, floor, 1) -> true; +is_pure(math, fmod, 2) -> true; is_pure(math, log, 1) -> true; is_pure(math, log2, 1) -> true; is_pure(math, log10, 1) -> true; @@ -203,7 +208,6 @@ is_safe(erlang, registered, 0) -> true; is_safe(erlang, self, 0) -> true; is_safe(erlang, term_to_binary, 1) -> true; is_safe(erlang, time, 0) -> true; -is_safe(error_logger, warning_map, 0) -> true; is_safe(_, _, _) -> false. diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl index cdc513e57c..48d39776dc 100644 --- a/lib/compiler/src/rec_env.erl +++ b/lib/compiler/src/rec_env.erl @@ -1,8 +1,3 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-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 @@ -15,10 +10,8 @@ %% See the License for the specific language governing permissions and %% limitations under the License. %% -%% %CopyrightEnd% -%% -%% @author Richard Carlsson <[email protected]> %% @copyright 1999-2004 Richard Carlsson +%% @author Richard Carlsson <[email protected]> %% @doc Abstract environments, supporting self-referential bindings and %% automatic new-key generation. diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 4922953407..50d28c0a5f 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -83,10 +83,11 @@ -ifdef(DEBUG). -define(ASSERT(E), case E of - true -> ok; + true -> + ok; false -> io:format("~p, line ~p: assertion failed\n", [?MODULE,?LINE]), - exit(assertion_failed) + error(assertion_failed) end). -else. -define(ASSERT(E), ignore). @@ -120,7 +121,10 @@ module(#c_module{defs=Ds0}=Mod, Opts) -> function_1({#c_var{name={F,Arity}}=Name,B0}) -> try - B = expr(B0, value, sub_new()), %This must be a fun! + B = find_fixpoint(fun(Core) -> + %% This must be a fun! + expr(Core, value, sub_new()) + end, B0, 20), {Name,B} catch Class:Error -> @@ -129,6 +133,14 @@ function_1({#c_var{name={F,Arity}}=Name,B0}) -> erlang:raise(Class, Error, Stack) end. +find_fixpoint(_OptFun, Core, 0) -> + Core; +find_fixpoint(OptFun, Core0, Max) -> + case OptFun(Core0) of + Core0 -> Core0; + Core -> find_fixpoint(OptFun, Core, Max-1) + end. + %% body(Expr, Sub) -> Expr. %% body(Expr, Context, Sub) -> Expr. %% No special handling of anything except values. @@ -160,13 +172,23 @@ guard(Expr, Sub) -> %% opt_guard_try(#c_seq{arg=Arg,body=Body0}=Seq) -> Body = opt_guard_try(Body0), - case {Arg,Body} of - {#c_call{module=#c_literal{val=Mod}, - name=#c_literal{val=Name}, - args=Args},#c_literal{val=false}} -> + WillFail = case Body of + #c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=error}, + args=[_]} -> + true; + #c_literal{val=false} -> + true; + _ -> + false + end, + case Arg of + #c_call{module=#c_literal{val=Mod}, + name=#c_literal{val=Name}, + args=Args} when WillFail -> %% We have sequence consisting of a call (evaluated %% for a possible exception and/or side effect only), - %% followed by 'false'. + %% followed by 'false' or a call to error/1. %% Since the sequence is inside a try block that will %% default to 'false' if any exception occurs, not %% evalutating the call will not change the behaviour @@ -181,7 +203,7 @@ opt_guard_try(#c_seq{arg=Arg,body=Body0}=Seq) -> %% be safely removed. Body end; - {_,_} -> + _ -> Seq#c_seq{body=Body} end; opt_guard_try(#c_case{clauses=Cs}=Term) -> @@ -239,7 +261,7 @@ expr(#c_cons{anno=Anno,hd=H0,tl=T0}=Cons, Ctxt, Sub) -> case Ctxt of effect -> add_warning(Cons, useless_building), - expr(make_effect_seq([H1,T1], Sub), Ctxt, Sub); + make_effect_seq([H1,T1], Sub); value -> ann_c_cons(Anno, H1, T1) end; @@ -248,7 +270,7 @@ expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) -> case Ctxt of effect -> add_warning(Tuple, useless_building), - expr(make_effect_seq(Es, Sub), Ctxt, Sub); + make_effect_seq(Es, Sub); value -> ann_c_tuple(Anno, Es) end; @@ -257,7 +279,7 @@ expr(#c_map{anno=Anno,arg=V0,es=Es0}=Map, Ctxt, Sub) -> case Ctxt of effect -> add_warning(Map, useless_building), - expr(make_effect_seq(Es, Sub), Ctxt, Sub); + make_effect_seq(Es, Sub); value -> V = expr(V0, Ctxt, Sub), ann_c_map(Anno,V,Es) @@ -310,7 +332,7 @@ expr(#c_let{}=Let0, Ctxt, Sub) -> Expr -> %% The let body was successfully moved into the let argument. %% Now recursively re-process the new expression. - expr(Expr, Ctxt, sub_new_preserve_types(Sub)) + Expr end; expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) -> %% This is named fun in an 'effect' context. Warn and ignore. @@ -351,7 +373,7 @@ expr(#c_case{}=Case0, Ctxt, Sub) -> %% (in addition to any warnings that may have been emitted %% according to the rules above). %% - case opt_bool_case(Case0) of + case opt_bool_case(Case0, Sub) of #c_case{arg=Arg0,clauses=Cs0}=Case1 -> Arg1 = body(Arg0, value, Sub), LitExpr = cerl:is_literal(Arg1), @@ -364,7 +386,7 @@ expr(#c_case{}=Case0, Ctxt, Sub) -> impossible -> bsm_an(Expr); Other -> - expr(Other, Ctxt, sub_new_preserve_types(Sub)) + Other end; Other -> expr(Other, Ctxt, Sub) @@ -1403,9 +1425,6 @@ sub_new() -> #sub{v=orddict:new(),s=cerl_sets:new(),t=#{}}. sub_new(#sub{}=Sub) -> Sub#sub{v=orddict:new(),t=#{}}. -sub_new_preserve_types(#sub{}=Sub) -> - Sub#sub{v=orddict:new()}. - sub_get_var(#c_var{name=V}=Var, #sub{v=S}) -> case orddict:find(V, S) of {ok,Val} -> Val; @@ -1535,9 +1554,11 @@ will_match(E, [P]) -> will_match_1({false,_}) -> maybe; will_match_1({true,_}) -> yes. -%% opt_bool_case(CoreExpr) - CoreExpr'. -%% Do various optimizations to case statement that has a -%% boolean case expression. +%% opt_bool_case(CoreExpr, Sub) - CoreExpr'. +%% +%% In bodies, do various optimizations to case statements that have +%% boolean case expressions. We don't do the optimizations in guards, +%% because they would thwart the optimization in v3_kernel. %% %% We start with some simple optimizations and normalization %% to facilitate later optimizations. @@ -1546,7 +1567,7 @@ will_match_1({true,_}) -> yes. %% (or fail), we can remove any clause that cannot %% possibly match 'true' or 'false'. Also, any clause %% following both 'true' and 'false' clause can -%% be removed. If successful, we will end up this: +%% be removed. If successful, we will end up like this: %% %% case BoolExpr of case BoolExpr of %% true -> false -> @@ -1557,8 +1578,11 @@ will_match_1({true,_}) -> yes. %% %% We give up if there are clauses with guards, or if there %% is a variable clause that matches anything. -%% -opt_bool_case(#c_case{arg=Arg}=Case0) -> + +opt_bool_case(#c_case{}=Case, #sub{in_guard=true}) -> + %% v3_kernel does a better job without "help". + Case; +opt_bool_case(#c_case{arg=Arg}=Case0, #sub{in_guard=false}) -> case is_bool_expr(Arg) of false -> Case0; @@ -1570,8 +1594,7 @@ opt_bool_case(#c_case{arg=Arg}=Case0) -> impossible -> Case0 end - end; -opt_bool_case(Core) -> Core. + end. opt_bool_clauses(#c_case{clauses=Cs}=Case) -> Case#c_case{clauses=opt_bool_clauses(Cs, false, false)}. @@ -1587,16 +1610,14 @@ opt_bool_clauses(Cs, true, true) -> [] end; opt_bool_clauses([#c_clause{pats=[#c_literal{val=Lit}], - guard=#c_literal{val=true}, - body=B}=C0|Cs], SeenT, SeenF) -> + guard=#c_literal{val=true}}=C|Cs], SeenT, SeenF) -> case is_boolean(Lit) of false -> %% Not a boolean - this clause can't match. - add_warning(C0, nomatch_clause_type), + add_warning(C, nomatch_clause_type), opt_bool_clauses(Cs, SeenT, SeenF); true -> %% This clause will match. - C = C0#c_clause{body=opt_bool_case(B)}, case {Lit,SeenT,SeenF} of {false,_,false} -> [C|opt_bool_clauses(Cs, SeenT, true)]; @@ -2023,10 +2044,10 @@ case_opt_lit_1(_, []) -> []. %% the clauses where it is actually needed. case_opt_data(E, Cs0) -> - Es = cerl:data_es(E), TypeSig = {cerl:data_type(E),cerl:data_arity(E)}, - try case_opt_data_1(Cs0, Es, TypeSig) of + try case_opt_data_1(Cs0, TypeSig) of Cs -> + Es = cerl:data_es(E), {ok,Es,Cs} catch throw:impossible -> @@ -2034,44 +2055,47 @@ case_opt_data(E, Cs0) -> {error,Cs0} end. -case_opt_data_1([{[P0|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) -> +case_opt_data_1([{[P0|Ps0],C,PsAcc,Bs0}|Cs], TypeSig) -> P = case_opt_compiler_generated(P0), - BindTo = #c_var{name=dummy}, - {Ps1,[{BindTo,_}|Bs1]} = case_data_pat_alias(P, BindTo, TypeSig, []), - [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|case_opt_data_1(Cs, Es, TypeSig)]; -case_opt_data_1([], _, _) -> []. + {Ps1,Bs} = case_opt_data_2(P, TypeSig, Bs0), + [{Ps1++Ps0,C,PsAcc,Bs}|case_opt_data_1(Cs, TypeSig)]; +case_opt_data_1([], _) -> []. -case_data_pat_alias(P, BindTo0, TypeSig, Bs0) -> - case cerl:type(P) of - alias -> - %% Recursively handle the pattern and bind to - %% the alias variable. - BindTo = cerl:alias_var(P), - Apat0 = cerl:alias_pat(P), - Ann = [compiler_generated], - Apat = cerl:set_ann(Apat0, Ann), - {Ps,Bs} = case_data_pat_alias(Apat, BindTo, TypeSig, Bs0), - {Ps,[{BindTo0,BindTo}|Bs]}; - var -> - %% Here we will need to actually build the data and bind - %% it to the variable. +case_opt_data_2(P, TypeSig, Bs0) -> + case case_analyze_pat(P) of + {[],Pat} when Pat =/= none -> + DataEs = cerl:data_es(P), + {DataEs,Bs0}; + {[V|Vs],none} -> {Type,Arity} = TypeSig, Ann = [compiler_generated], Vars = make_vars(Ann, Arity), Data = cerl:ann_make_data(Ann, Type, Vars), - Bs = [{BindTo0,P},{P,Data}|Bs0], + Bs = [{V,Data} | [{Var,V} || Var <- Vs] ++ Bs0], {Vars,Bs}; - _ -> - %% Since case_opt_nomatch/3 has removed all clauses that - %% cannot match, we KNOW that this clause must match and - %% that the pattern must be a data constructor. - %% Here we must build the data and bind it to the variable. + {[V|Vs],Pat} when Pat =/= none -> {Type,_} = TypeSig, - DataEs = cerl:data_es(P), + DataEs = cerl:data_es(Pat), Vars = pat_to_expr_list(DataEs), Ann = [compiler_generated], Data = cerl:ann_make_data(Ann, Type, Vars), - {DataEs,[{BindTo0,Data}]} + Bs = [{V,Data} | [{Var,V} || Var <- Vs] ++ Bs0], + {DataEs,Bs} + end. + +case_analyze_pat(P) -> + case_analyze_pat_1(P, [], none). + +case_analyze_pat_1(P, Vs, Pat) -> + case cerl:type(P) of + alias -> + V = cerl:alias_var(P), + Apat = cerl:alias_pat(P), + case_analyze_pat_1(Apat, [V|Vs], Pat); + var -> + {[P|Vs],Pat}; + _ -> + {Vs,P} end. %% pat_to_expr(Pattern) -> Expression. @@ -2115,7 +2139,7 @@ make_var(A) -> make_var_name() -> N = get(new_var_num), put(new_var_num, N+1), - list_to_atom("fol"++integer_to_list(N)). + list_to_atom("@f"++integer_to_list(N)). letify(Bs, Body) -> Ann = cerl:get_ann(Body), @@ -2129,7 +2153,7 @@ letify(Bs, Body) -> -spec opt_not_in_let(cerl:c_let()) -> cerl:cerl(). opt_not_in_let(#c_let{vars=[_]=Vs0,arg=Arg0,body=Body0}=Let) -> - case opt_not_in_let(Vs0, Arg0, Body0) of + case opt_not_in_let_0(Vs0, Arg0, Body0) of {[],#c_values{es=[]},Body} -> Body; {Vs,Arg,Body} -> @@ -2137,13 +2161,7 @@ opt_not_in_let(#c_let{vars=[_]=Vs0,arg=Arg0,body=Body0}=Let) -> end; opt_not_in_let(Let) -> Let. -%% opt_not_in_let(Vs, Arg, Body) -> {Vs',Arg',Body'} -%% Try to optimize away a 'not' operator in a 'let'. - --spec opt_not_in_let([cerl:c_var()], cerl:cerl(), cerl:cerl()) -> - {[cerl:c_var()],cerl:cerl(),cerl:cerl()}. - -opt_not_in_let([#c_var{name=V}]=Vs0, Arg0, Body0) -> +opt_not_in_let_0([#c_var{name=V}]=Vs0, Arg0, Body0) -> case cerl:type(Body0) of call -> %% let <V> = Expr in not V ==> @@ -2174,9 +2192,7 @@ opt_not_in_let([#c_var{name=V}]=Vs0, Arg0, Body0) -> end; _ -> {Vs0,Arg0,Body0} - end; -opt_not_in_let(Vs, Arg, Body) -> - {Vs,Arg,Body}. + end. opt_not_in_let_1(V, Call, Body) -> case Call of @@ -2222,24 +2238,24 @@ inverse_rel_op('=<') -> '>'; inverse_rel_op(_) -> no. -%% opt_bool_case_in_let(LetExpr, Sub) -> Core +%% opt_bool_case_in_let(LetExpr) -> Core opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> - opt_case_in_let_1(Vs, Arg, B, Let, Sub). + opt_bool_case_in_let_1(Vs, Arg, B, Let, Sub). -opt_case_in_let_1([#c_var{name=V}], Arg, +opt_bool_case_in_let_1([#c_var{name=V}], Arg, #c_case{arg=#c_var{name=V}}=Case0, Let, Sub) -> case is_simple_case_arg(Arg) of true -> - Case = opt_bool_case(Case0#c_case{arg=Arg}), + Case = opt_bool_case(Case0#c_case{arg=Arg}, Sub), case core_lib:is_var_used(V, Case) of - false -> expr(Case, sub_new(Sub)); + false -> Case; true -> Let end; false -> Let end; -opt_case_in_let_1(_, _, _, Let, _) -> Let. +opt_bool_case_in_let_1(_, _, _, Let, _) -> Let. %% is_simple_case_arg(Expr) -> true|false %% Determine whether the Expr is simple enough to be worth @@ -2372,9 +2388,7 @@ is_safe_bool_expr_list([], _, _) -> true. %% as a let or a sequence, move the original let body into the complex %% expression. -simplify_let(#c_let{arg=Arg0}=Let0, Sub) -> - Arg = opt_bool_case(Arg0), - Let = Let0#c_let{arg=Arg}, +simplify_let(#c_let{arg=Arg}=Let, Sub) -> move_let_into_expr(Let, Arg, Sub). move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner, @@ -2630,11 +2644,10 @@ opt_simple_let_0(#c_let{arg=Arg0}=Let, Ctxt, Sub) -> opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) -> %% Optimise let and add new substitutions. - {Vs1,Args,Sub1} = let_substs(Vs0, Arg0, Sub0), - BodySub = update_let_types(Vs1, Args, Sub1), - B1 = body(B0, Ctxt, BodySub), - Arg1 = core_lib:make_values(Args), - {Vs,Arg,B} = opt_not_in_let(Vs1, Arg1, B1), + {Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0), + BodySub = update_let_types(Vs, Args, Sub1), + B = body(B0, Ctxt, BodySub), + Arg = core_lib:make_values(Args), opt_simple_let_2(Let, Vs, Arg, B, B0, Ctxt, Sub1). opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> @@ -2647,25 +2660,23 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> false -> %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody), - expr(#c_seq{arg=Arg,body=Body}, Ctxt, - sub_new_preserve_types(Sub)) + #c_seq{arg=Arg,body=Body} end; {[],#c_values{es=[]},_} -> %% No variables left. Body; {Vs,Arg1,#c_literal{}} -> Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), - E = case Ctxt of - effect -> - %% Throw away the literal body. - Arg; - value -> - %% Since the variable is not used in the body, we - %% can rewrite the let to a sequence. - %% let <Var> = Arg in Literal ==> seq Arg Literal - #c_seq{arg=Arg,body=Body} - end, - expr(E, Ctxt, sub_new_preserve_types(Sub)); + case Ctxt of + effect -> + %% Throw away the literal body. + Arg; + value -> + %% Since the variable is not used in the body, we + %% can rewrite the let to a sequence. + %% let <Var> = Arg in Literal ==> seq Arg Literal + #c_seq{arg=Arg,body=Body} + end; {Vs,Arg1,Body} -> %% If none of the variables are used in the body, we can %% rewrite the let to a sequence: @@ -2674,12 +2685,10 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> case is_any_var_used(Vs, Body) of false -> Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), - expr(#c_seq{arg=Arg,body=Body}, Ctxt, - sub_new_preserve_types(Sub)); + #c_seq{arg=Arg,body=Body}; true -> Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body}, - Let2 = opt_bool_case_in_let(Let1, Sub), - opt_case_in_let_arg(Let2, Ctxt, Sub) + opt_bool_case_in_let(Let1, Sub) end end. @@ -2807,48 +2816,6 @@ move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer, move_case_into_arg(_, _) -> impossible. -%% In guards only, rewrite a case in a let argument like -%% -%% let <Var> = case <> of -%% <> when AnyGuard -> Literal1; -%% <> when AnyGuard -> Literal2 -%% end -%% in LetBody -%% -%% to -%% -%% case <> of -%% <> when AnyGuard -> -%% let <Var> = Literal1 in LetBody -%% <> when 'true' -> -%% let <Var> = Literal2 in LetBody -%% end -%% -%% In the worst case, the size of the code could increase. -%% In practice, though, substituting the literals into -%% LetBody and doing constant folding will decrease the code -%% size. (Doing this transformation outside of guards could -%% lead to a substantational increase in code size.) -%% -opt_case_in_let_arg(#c_let{arg=#c_case{}=Case}=Let, Ctxt, - #sub{in_guard=true}=Sub) -> - opt_case_in_let_arg_1(Let, Case, Ctxt, Sub); -opt_case_in_let_arg(Let, _, _) -> Let. - -opt_case_in_let_arg_1(Let0, #c_case{arg=#c_values{es=[]}, - clauses=Cs}=Case0, Ctxt, Sub) -> - Let = mark_compiler_generated(Let0), - case Cs of - [#c_clause{body=#c_literal{}=BodyA}=Ca0, - #c_clause{body=#c_literal{}=BodyB}=Cb0] -> - Ca = Ca0#c_clause{body=Let#c_let{arg=BodyA}}, - Cb = Cb0#c_clause{body=Let#c_let{arg=BodyB}}, - Case = Case0#c_case{clauses=[Ca,Cb]}, - expr(Case, Ctxt, sub_new_preserve_types(Sub)); - _ -> Let - end; -opt_case_in_let_arg_1(Let, _, _, _) -> Let. - is_any_var_used([#c_var{name=V}|Vs], Expr) -> case core_lib:is_var_used(V, Expr) of false -> is_any_var_used(Vs, Expr); @@ -2956,7 +2923,9 @@ returns_integer(bit_size, [_]) -> true; returns_integer('bsl', [_,_]) -> true; returns_integer('bsr', [_,_]) -> true; returns_integer(byte_size, [_]) -> true; +returns_integer(ceil, [_]) -> true; returns_integer('div', [_,_]) -> true; +returns_integer(floor, [_]) -> true; returns_integer(length, [_]) -> true; returns_integer('rem', [_,_]) -> true; returns_integer('round', [_]) -> true; @@ -3277,13 +3246,6 @@ bsm_problem(Where, What) -> %%% Handling of warnings. %%% -mark_compiler_generated(Term) -> - cerl_trees:map(fun mark_compiler_generated_1/1, Term). - -mark_compiler_generated_1(#c_call{anno=Anno}=Term) -> - Term#c_call{anno=[compiler_generated|Anno--[compiler_generated]]}; -mark_compiler_generated_1(Term) -> Term. - init_warnings() -> put({?MODULE,warnings}, []). @@ -3446,12 +3408,18 @@ format_error(bin_var_used_in_guard) -> verify_scope(E, #sub{s=Scope}) -> Free0 = cerl_trees:free_variables(E), Free = [V || V <- Free0, not is_tuple(V)], %Ignore function names. - case ordsets:is_subset(Free, cerl_sets:to_list(Scope)) of - true -> true; + case is_subset_of_scope(Free, Scope) of + true -> + true; false -> io:format("~p\n", [E]), io:format("~p\n", [Free]), - io:format("~p\n", [cerl_sets:to_list(Scope)]), + io:format("~p\n", [ordsets:from_list(cerl_sets:to_list(Scope))]), false end. + +is_subset_of_scope([V|Vs], Scope) -> + cerl_sets:is_element(V, Scope) andalso is_subset_of_scope(Vs, Scope); +is_subset_of_scope([], _) -> true. + -endif. diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl deleted file mode 100644 index 7ab4e1845c..0000000000 --- a/lib/compiler/src/sys_pre_expand.erl +++ /dev/null @@ -1,616 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2015. 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 : Expand some source Erlang constructions. This is part of the -%% pre-processing phase. - -%% N.B. Although structs (tagged tuples) are not yet allowed in the -%% language there is code included in pattern/2 and expr/3 (commented out) -%% that handles them by transforming them to tuples. - --module(sys_pre_expand). - -%% Main entry point. --export([module/2]). - --import(lists, [member/2,foldl/3,foldr/3]). - --type fa() :: {atom(), arity()}. - --record(expand, {module=[], %Module name - exports=[], %Exports - attributes=[], %Attributes - callbacks=[], %Callbacks - optional_callbacks=[] :: [fa()], %Optional callbacks - vcount=0, %Variable counter - func=[], %Current function - arity=[], %Arity for current function - fcount=0, %Local fun count - ctype %Call type map - }). - -%% module(Forms, CompileOptions) -%% {ModuleName,Exports,TransformedForms,CompileOptions'} -%% Expand the forms in one module. -%% -%% CompileOptions is augmented with options from -compile attributes. - -module(Fs0, Opts0) -> - - %% Expand records. Normalise guard tests. - Fs = erl_expand_records:module(Fs0, Opts0), - - Opts = compiler_options(Fs) ++ Opts0, - - %% Set pre-defined exported functions. - PreExp = [{module_info,0},{module_info,1}], - - %% Build the set of defined functions and the initial call - %% type map. - Defined = defined_functions(Fs, PreExp), - Ctype = maps:from_list([{K,local} || K <- Defined]), - - %% Build initial expand record. - St0 = #expand{exports=PreExp, - ctype=Ctype - }, - - %% Expand the functions. - {Tfs,St1} = forms(Fs, St0), - - %% Get the correct list of exported functions. - Exports = case member(export_all, Opts) of - true -> Defined; - false -> St1#expand.exports - end, - St2 = St1#expand{exports=Exports,ctype=undefined}, - - %% Generate all functions from stored info. - {Ats,St3} = module_attrs(St2), - {Mfs,St4} = module_predef_funcs(St3), - {St4#expand.module, St4#expand.exports, Ats ++ Tfs ++ Mfs, - Opts}. - -compiler_options(Forms) -> - lists:flatten([C || {attribute,_,compile,C} <- Forms]). - -%% defined_function(Forms, Predef) -> Functions. -%% Add function to defined if form is a function. - -defined_functions(Forms, Predef) -> - Fs = foldl(fun({function,_,N,A,_Cs}, Acc) -> [{N,A}|Acc]; - (_, Acc) -> Acc - end, Predef, Forms), - ordsets:from_list(Fs). - -module_attrs(#expand{attributes=Attributes}=St) -> - Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes], - Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs], - OptionalCallbacks = get_optional_callbacks(Attrs), - {Attrs,St#expand{callbacks=Callbacks, - optional_callbacks=OptionalCallbacks}}. - -get_optional_callbacks(Attrs) -> - L = [O || - {attribute, _, optional_callbacks, O} <- Attrs, - is_fa_list(O)], - lists:append(L). - -is_fa_list([{FuncName, Arity}|L]) - when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> - is_fa_list(L); -is_fa_list([]) -> true; -is_fa_list(_) -> false. - -module_predef_funcs(St0) -> - {Mpf1,St1} = module_predef_func_beh_info(St0), - Mpf2 = module_predef_funcs_mod_info(St1), - Mpf = [erl_parse:new_anno(F) || F <- Mpf1++Mpf2], - {Mpf,St1}. - -module_predef_func_beh_info(#expand{callbacks=[]}=St) -> - {[], St}; -module_predef_func_beh_info(#expand{callbacks=Callbacks, - optional_callbacks=OptionalCallbacks, - exports=Exports}=St) -> - PreDef0 = [{behaviour_info,1}], - PreDef = ordsets:from_list(PreDef0), - {[gen_beh_info(Callbacks, OptionalCallbacks)], - St#expand{exports=ordsets:union(PreDef, Exports)}}. - -gen_beh_info(Callbacks, OptionalCallbacks) -> - List = make_list(Callbacks), - OptionalList = make_optional_list(OptionalCallbacks), - {function,0,behaviour_info,1, - [{clause,0,[{atom,0,callbacks}],[], - [List]}, - {clause,0,[{atom,0,optional_callbacks}],[], - [OptionalList]}]}. - -make_list([]) -> {nil,0}; -make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) -> - {cons,0, - {tuple,0, - [{atom,0,Name}, - {integer,0,Arity}]}, - make_list(Rest)}. - -make_optional_list([]) -> {nil,0}; -make_optional_list([{Name,Arity}|Rest]) -> - {cons,0, - {tuple,0, - [{atom,0,Name}, - {integer,0,Arity}]}, - make_optional_list(Rest)}. - -module_predef_funcs_mod_info(#expand{module=Mod}) -> - ModAtom = {atom,0,Mod}, - [{function,0,module_info,0, - [{clause,0,[],[], - [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}}, - [ModAtom]}]}]}, - {function,0,module_info,1, - [{clause,0,[{var,0,'X'}],[], - [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}}, - [ModAtom,{var,0,'X'}]}]}]}]. - -%% forms(Forms, State) -> -%% {TransformedForms,State'} -%% Process the forms. Attributes are lost and just affect the state. -%% Ignore uninteresting forms like eof and type. - -forms([{attribute,_,file,_File}=F|Fs0], St0) -> - {Fs,St1} = forms(Fs0, St0), - {[F|Fs],St1}; -forms([{attribute,Line,Name,Val}|Fs0], St0) -> - St1 = attribute(Name, Val, Line, St0), - forms(Fs0, St1); -forms([{function,L,N,A,Cs}|Fs0], St0) -> - {Ff,St1} = function(L, N, A, Cs, St0), - {Fs,St2} = forms(Fs0, St1), - {[Ff|Fs],St2}; -forms([_|Fs], St) -> forms(Fs, St); -forms([], St) -> {[],St}. - -%% attribute(Attribute, Value, Line, State) -> State'. -%% Process an attribute, this just affects the state. - -attribute(module, Module, _L, St) -> - true = is_atom(Module), - St#expand{module=Module}; -attribute(export, Es, _L, St) -> - St#expand{exports=ordsets:union(ordsets:from_list(Es), - St#expand.exports)}; -attribute(import, Is, _L, St) -> - import(Is, St); -attribute(compile, _C, _L, St) -> - St; -attribute(Name, Val, Line, St) when is_list(Val) -> - St#expand{attributes=St#expand.attributes ++ [{Name,Line,Val}]}; -attribute(Name, Val, Line, St) -> - St#expand{attributes=St#expand.attributes ++ [{Name,Line,[Val]}]}. - -function(L, N, A, Cs0, St0) -> - {Cs,St} = clauses(Cs0, St0#expand{func=N,arity=A,fcount=0}), - {{function,L,N,A,Cs},St}. - -%% clauses([Clause], State) -> -%% {[TransformedClause],State}. -%% Expand function clauses. - -clauses([{clause,Line,H0,G0,B0}|Cs0], St0) -> - {H,St1} = head(H0, St0), - {G,St2} = guard(G0, St1), - {B,St3} = exprs(B0, St2), - {Cs,St4} = clauses(Cs0, St3), - {[{clause,Line,H,G,B}|Cs],St4}; -clauses([], St) -> {[],St}. - -%% head(HeadPatterns, State) -> -%% {TransformedPatterns,Variables,UsedVariables,State'} - -head(As, St) -> pattern_list(As, St). - -%% pattern(Pattern, State) -> -%% {TransformedPattern,State'} -%% - -pattern({var,_,_}=Var, St) -> - {Var,St}; -pattern({char,_,_}=Char, St) -> - {Char,St}; -pattern({integer,_,_}=Int, St) -> - {Int,St}; -pattern({float,_,_}=Float, St) -> - {Float,St}; -pattern({atom,_,_}=Atom, St) -> - {Atom,St}; -pattern({string,_,_}=String, St) -> - {String,St}; -pattern({nil,_}=Nil, St) -> - {Nil,St}; -pattern({cons,Line,H,T}, St0) -> - {TH,St1} = pattern(H, St0), - {TT,St2} = pattern(T, St1), - {{cons,Line,TH,TT},St2}; -pattern({tuple,Line,Ps}, St0) -> - {TPs,St1} = pattern_list(Ps, St0), - {{tuple,Line,TPs},St1}; -pattern({map,Line,Ps}, St0) -> - {TPs,St1} = pattern_list(Ps, St0), - {{map,Line,TPs},St1}; -pattern({map_field_exact,Line,K0,V0}, St0) -> - %% Key should be treated as an expression - %% but since expressions are not allowed yet, - %% process it through pattern .. and handle assoc - %% (normalise unary op integer -> integer) - {K,St1} = pattern(K0, St0), - {V,St2} = pattern(V0, St1), - {{map_field_exact,Line,K,V},St2}; -pattern({map_field_assoc,Line,K0,V0}, St0) -> - %% when keys are Maps - {K,St1} = pattern(K0, St0), - {V,St2} = pattern(V0, St1), - {{map_field_assoc,Line,K,V},St2}; -%%pattern({struct,Line,Tag,Ps}, St0) -> -%% {TPs,TPsvs,St1} = pattern_list(Ps, St0), -%% {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1}; -pattern({bin,Line,Es0}, St0) -> - {Es1,St1} = pattern_bin(Es0, St0), - {{bin,Line,Es1},St1}; -pattern({op,_,'++',{nil,_},R}, St) -> - pattern(R, St); -pattern({op,_,'++',{cons,Li,H,T},R}, St) -> - pattern({cons,Li,H,{op,Li,'++',T,R}}, St); -pattern({op,_,'++',{string,Li,L},R}, St) -> - pattern(string_to_conses(Li, L, R), St); -pattern({match,Line,Pat1, Pat2}, St0) -> - {TH,St1} = pattern(Pat2, St0), - {TT,St2} = pattern(Pat1, St1), - {{match,Line,TT,TH},St2}; -%% Compile-time pattern expressions, including unary operators. -pattern({op,_Line,_Op,_A}=Op, St) -> - {erl_eval:partial_eval(Op),St}; -pattern({op,_Line,_Op,_L,_R}=Op, St) -> - {erl_eval:partial_eval(Op),St}. - -pattern_list([P0|Ps0], St0) -> - {P,St1} = pattern(P0, St0), - {Ps,St2} = pattern_list(Ps0, St1), - {[P|Ps],St2}; -pattern_list([], St) -> {[],St}. - -%% guard(Guard, State) -> -%% {TransformedGuard,State'} -%% Transform a list of guard tests. We KNOW that this has been checked -%% and what the guards test are. Use expr for transforming the guard -%% expressions. - -guard([G0|Gs0], St0) -> - {G,St1} = guard_tests(G0, St0), - {Gs,St2} = guard(Gs0, St1), - {[G|Gs],St2}; -guard([], St) -> {[],St}. - -guard_tests([Gt0|Gts0], St0) -> - {Gt1,St1} = guard_test(Gt0, St0), - {Gts1,St2} = guard_tests(Gts0, St1), - {[Gt1|Gts1],St2}; -guard_tests([], St) -> {[],St}. - -guard_test(Test, St) -> - expr(Test, St). - -%% exprs(Expressions, State) -> -%% {TransformedExprs,State'} - -exprs([E0|Es0], St0) -> - {E,St1} = expr(E0, St0), - {Es,St2} = exprs(Es0, St1), - {[E|Es],St2}; -exprs([], St) -> {[],St}. - -%% expr(Expression, State) -> -%% {TransformedExpression,State'} - -expr({var,_,_}=Var, St) -> - {Var,St}; -expr({char,_,_}=Char, St) -> - {Char,St}; -expr({integer,_,_}=Int, St) -> - {Int,St}; -expr({float,_,_}=Float, St) -> - {Float,St}; -expr({atom,_,_}=Atom, St) -> - {Atom,St}; -expr({string,_,_}=String, St) -> - {String,St}; -expr({nil,_}=Nil, St) -> - {Nil,St}; -expr({cons,Line,H0,T0}, St0) -> - {H,St1} = expr(H0, St0), - {T,St2} = expr(T0, St1), - {{cons,Line,H,T},St2}; -expr({lc,Line,E0,Qs0}, St0) -> - {Qs1,St1} = lc_tq(Line, Qs0, St0), - {E1,St2} = expr(E0, St1), - {{lc,Line,E1,Qs1},St2}; -expr({bc,Line,E0,Qs0}, St0) -> - {Qs1,St1} = lc_tq(Line, Qs0, St0), - {E1,St2} = expr(E0, St1), - {{bc,Line,E1,Qs1},St2}; -expr({tuple,Line,Es0}, St0) -> - {Es1,St1} = expr_list(Es0, St0), - {{tuple,Line,Es1},St1}; -%%expr({struct,Line,Tag,Es0}, Vs, St0) -> -%% {Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0), -%% {{tuple,Line,[{atom,Line,Tag}|Es1]},Esvs,Esus,St1}; -expr({map,Line,Es0}, St0) -> - {Es1,St1} = expr_list(Es0, St0), - {{map,Line,Es1},St1}; -expr({map,Line,E0,Es0}, St0) -> - {E1,St1} = expr(E0, St0), - {Es1,St2} = expr_list(Es0, St1), - {{map,Line,E1,Es1},St2}; -expr({map_field_assoc,Line,K0,V0}, St0) -> - {K,St1} = expr(K0, St0), - {V,St2} = expr(V0, St1), - {{map_field_assoc,Line,K,V},St2}; -expr({map_field_exact,Line,K0,V0}, St0) -> - {K,St1} = expr(K0, St0), - {V,St2} = expr(V0, St1), - {{map_field_exact,Line,K,V},St2}; -expr({bin,Line,Es0}, St0) -> - {Es1,St1} = expr_bin(Es0, St0), - {{bin,Line,Es1},St1}; -expr({block,Line,Es0}, St0) -> - {Es,St1} = exprs(Es0, St0), - {{block,Line,Es},St1}; -expr({'if',Line,Cs0}, St0) -> - {Cs,St1} = clauses(Cs0, St0), - {{'if',Line,Cs},St1}; -expr({'case',Line,E0,Cs0}, St0) -> - {E,St1} = expr(E0, St0), - {Cs,St2} = clauses(Cs0, St1), - {{'case',Line,E,Cs},St2}; -expr({'receive',Line,Cs0}, St0) -> - {Cs,St1} = clauses(Cs0, St0), - {{'receive',Line,Cs},St1}; -expr({'receive',Line,Cs0,To0,ToEs0}, St0) -> - {To,St1} = expr(To0, St0), - {ToEs,St2} = exprs(ToEs0, St1), - {Cs,St3} = clauses(Cs0, St2), - {{'receive',Line,Cs,To,ToEs},St3}; -expr({'fun',Line,Body}, St) -> - fun_tq(Line, Body, St); -expr({named_fun,Line,Name,Cs}, St) -> - fun_tq(Line, Cs, St, Name); -expr({call,Line,{atom,La,N}=Atom,As0}, St0) -> - {As,St1} = expr_list(As0, St0), - Ar = length(As), - Key = {N,Ar}, - case St1#expand.ctype of - #{Key:=local} -> - {{call,Line,Atom,As},St1}; - #{Key:={imported,Mod}} -> - {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1}; - _ -> - true = erl_internal:bif(N, Ar), - {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1} - end; -expr({call,Line,{remote,Lr,M0,F},As0}, St0) -> - {[M1,F1|As1],St1} = expr_list([M0,F|As0], St0), - {{call,Line,{remote,Lr,M1,F1},As1},St1}; -expr({call,Line,F,As0}, St0) -> - {[Fun1|As1],St1} = expr_list([F|As0], St0), - {{call,Line,Fun1,As1},St1}; -expr({'try',Line,Es0,Scs0,Ccs0,As0}, St0) -> - {Es1,St1} = exprs(Es0, St0), - {Scs1,St2} = clauses(Scs0, St1), - {Ccs1,St3} = clauses(Ccs0, St2), - {As1,St4} = exprs(As0, St3), - {{'try',Line,Es1,Scs1,Ccs1,As1},St4}; -expr({'catch',Line,E0}, St0) -> - {E,St1} = expr(E0, St0), - {{'catch',Line,E},St1}; -expr({match,Line,P0,E0}, St0) -> - {E,St1} = expr(E0, St0), - {P,St2} = pattern(P0, St1), - {{match,Line,P,E},St2}; -expr({op,Line,Op,A0}, St0) -> - {A,St1} = expr(A0, St0), - {{op,Line,Op,A},St1}; -expr({op,Line,Op,L0,R0}, St0) -> - {L,St1} = expr(L0, St0), - {R,St2} = expr(R0, St1), - {{op,Line,Op,L,R},St2}. - -expr_list([E0|Es0], St0) -> - {E,St1} = expr(E0, St0), - {Es,St2} = expr_list(Es0, St1), - {[E|Es],St2}; -expr_list([], St) -> {[],St}. - -%% lc_tq(Line, Qualifiers, State) -> -%% {[TransQual],State'} - -lc_tq(Line, [{generate,Lg,P0,G0} | Qs0], St0) -> - {G1,St1} = expr(G0, St0), - {P1,St2} = pattern(P0, St1), - {Qs1,St3} = lc_tq(Line, Qs0, St2), - {[{generate,Lg,P1,G1} | Qs1],St3}; - -lc_tq(Line, [{b_generate,Lg,P0,G0}|Qs0], St0) -> - {G1,St1} = expr(G0, St0), - {P1,St2} = pattern(P0, St1), - {Qs1,St3} = lc_tq(Line, Qs0, St2), - {[{b_generate,Lg,P1,G1}|Qs1],St3}; -lc_tq(Line, [F0 | Qs0], St0) -> - {F1,St1} = expr(F0, St0), - {Qs1,St2} = lc_tq(Line, Qs0, St1), - {[F1|Qs1],St2}; -lc_tq(_Line, [], St0) -> - {[],St0}. - - -%% fun_tq(Line, Body, State) -> -%% {Fun,State'} -%% Transform an "explicit" fun {'fun', Line, {clauses, Cs}} into an -%% extended form {'fun', Line, {clauses, Cs}, Info}, unless it is the -%% name of a BIF (erl_lint has checked that it is not an import). -%% "Implicit" funs {'fun', Line, {function, F, A}} are not changed. - -fun_tq(Lf, {function,F,A}=Function, St0) -> - case erl_internal:bif(F, A) of - true -> - {As,St1} = new_vars(A, Lf, St0), - Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}], - fun_tq(Lf, {clauses,Cs}, St1); - false -> - {Fname,St1} = new_fun_name(St0), - Index = Uniq = 0, - {{'fun',Lf,Function,{Index,Uniq,Fname}},St1} - end; -fun_tq(L, {function,M,F,A}, St) when is_atom(M), is_atom(F), is_integer(A) -> - %% This is the old format for external funs, generated by a pre-R15 - %% compiler. That means that a tool, such as the debugger or xref, - %% directly invoked this module with the abstract code from a - %% pre-R15 BEAM file. Be helpful, and translate it to the new format. - fun_tq(L, {function,{atom,L,M},{atom,L,F},{integer,L,A}}, St); -fun_tq(Lf, {function,_,_,_}=ExtFun, St) -> - {{'fun',Lf,ExtFun},St}; -fun_tq(Lf, {clauses,Cs0}, St0) -> - {Cs1,St1} = clauses(Cs0, St0), - {Fname,St2} = new_fun_name(St1), - %% Set dummy values for Index and Uniq -- the real values will - %% be assigned by beam_asm. - Index = Uniq = 0, - {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}. - -fun_tq(Line, Cs0, St0, Name) -> - {Cs1,St1} = clauses(Cs0, St0), - {Fname,St2} = new_fun_name(St1, Name), - {{named_fun,Line,Name,Cs1,{0,0,Fname}},St2}. - -%% new_fun_name(State) -> {FunName,State}. - -new_fun_name(St) -> - new_fun_name(St, 'fun'). - -new_fun_name(#expand{func=F,arity=A,fcount=I}=St, FName) -> - Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A) - ++ "-" ++ atom_to_list(FName) ++ "-" ++ integer_to_list(I) ++ "-", - {list_to_atom(Name),St#expand{fcount=I+1}}. - -%% pattern_bin([Element], State) -> {[Element],[Variable],[UsedVar],State}. - -pattern_bin(Es0, St) -> - Es1 = bin_expand_strings(Es0), - foldr(fun (E, Acc) -> pattern_element(E, Acc) end, {[],St}, Es1). - -pattern_element({bin_element,Line,Expr0,Size0,Type0}, {Es,St0}) -> - {Expr1,St1} = pattern(Expr0, St0), - {Size1,St2} = pat_bit_size(Size0, St1), - {Size,Type} = make_bit_type(Line, Size1, Type0), - Expr = coerce_to_float(Expr1, Type0), - {[{bin_element,Line,Expr,Size,Type}|Es],St2}. - -pat_bit_size(default, St) -> {default,St}; -pat_bit_size({var,_Lv,_V}=Var, St) -> {Var,St}; -pat_bit_size(Size, St) -> - Line = element(2, Size), - {value,Sz,_} = erl_eval:expr(Size, erl_eval:new_bindings()), - {{integer,Line,Sz},St}. - -make_bit_type(Line, default, Type0) -> - case erl_bits:set_bit_type(default, Type0) of - {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)}; - {ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)}; - {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)} - end; -make_bit_type(_Line, Size, Type0) -> %Integer or 'all' - {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0), - {Size,erl_bits:as_list(Bt)}. - -coerce_to_float({integer,L,I}=E, [float|_]) -> - try - {float,L,float(I)} - catch - error:badarg -> E - end; -coerce_to_float(E, _) -> E. - -%% expr_bin([Element], State) -> {[Element],State}. - -expr_bin(Es0, St) -> - Es1 = bin_expand_strings(Es0), - foldr(fun (E, Acc) -> bin_element(E, Acc) end, {[],St}, Es1). - -bin_element({bin_element,Line,Expr,Size,Type}, {Es,St0}) -> - {Expr1,St1} = expr(Expr, St0), - {Size1,St2} = if Size == default -> {default,St1}; - true -> expr(Size, St1) - end, - {Size2,Type1} = make_bit_type(Line, Size1, Type), - {[{bin_element,Line,Expr1,Size2,Type1}|Es],St2}. - -bin_expand_strings(Es) -> - foldr(fun ({bin_element,Line,{string,_,S},Sz,Ts}, Es1) -> - foldr(fun (C, Es2) -> - [{bin_element,Line,{char,Line,C},Sz,Ts}|Es2] - end, Es1, S); - (E, Es1) -> [E|Es1] - end, [], Es). - -%% new_var_name(State) -> {VarName,State}. - -new_var_name(St) -> - C = St#expand.vcount, - {list_to_atom("pre" ++ integer_to_list(C)),St#expand{vcount=C+1}}. - -%% new_var(Line, State) -> {Var,State}. - -new_var(L, St0) -> - {New,St1} = new_var_name(St0), - {{var,L,New},St1}. - -%% new_vars(Count, Line, State) -> {[Var],State}. -%% Make Count new variables. - -new_vars(N, L, St) -> new_vars(N, L, St, []). - -new_vars(N, L, St0, Vs) when N > 0 -> - {V,St1} = new_var(L, St0), - new_vars(N-1, L, St1, [V|Vs]); -new_vars(0, _L, St, Vs) -> {Vs,St}. - -string_to_conses(Line, Cs, Tail) -> - foldr(fun (C, T) -> {cons,Line,{char,Line,C},T} end, Tail, Cs). - - -%% import(Line, Imports, State) -> -%% State' -%% Handle import declarations. - -import({Mod,Fs}, #expand{ctype=Ctype0}=St) -> - true = is_atom(Mod), - Ctype = foldl(fun(F, A) -> - A#{F=>{imported,Mod}} - end, Ctype0, Fs), - St#expand{ctype=Ctype}. diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 4df1aadd0a..3627cdb7cd 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -151,6 +151,8 @@ cg({bif,Bif,As,Rs}, Le, Vdb, Bef, St) -> bif_cg(Bif, As, Rs, Le, Vdb, Bef, St); cg({gc_bif,Bif,As,Rs}, Le, Vdb, Bef, St) -> gc_bif_cg(Bif, As, Rs, Le, Vdb, Bef, St); +cg({internal,Bif,As,Rs}, Le, Vdb, Bef, St) -> + internal_cg(Bif, As, Rs, Le, Vdb, Bef, St); cg({receive_loop,Te,Rvar,Rm,Tes,Rs}, Le, Vdb, Bef, St) -> recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St); cg(receive_next, Le, Vdb, Bef, St) -> @@ -208,15 +210,10 @@ need_heap_1(#l{ke={set,_,Val}}, H) -> {tuple,Es} -> 1 + length(Es); _Other -> 0 end}; -need_heap_1(#l{ke={bif,dsetelement,_As,_Rs},i=I}, H) -> - {need_heap_need(I, H),0}; -need_heap_1(#l{ke={bif,{make_fun,_,_,_,_},_As,_Rs},i=I}, H) -> - {need_heap_need(I, H),0}; -need_heap_1(#l{ke={bif,bs_init_writable,_As,_Rs},i=I}, H) -> - {need_heap_need(I, H),0}; need_heap_1(#l{ke={bif,_Bif,_As,_Rs}}, H) -> {[],H}; need_heap_1(#l{i=I}, H) -> + %% Call or call-like instruction such as set_tuple_element/3. {need_heap_need(I, H),0}. need_heap_need(_I, 0) -> []; @@ -366,7 +363,7 @@ bsm_rename_ctx(#l{ke={match,Ms0,Rs}}=L, Old, New, InProt) -> bsm_rename_ctx(#l{ke={guard_match,Ms0,Rs}}=L, Old, New, InProt) -> Ms = bsm_rename_ctx(Ms0, Old, New, InProt), L#l{ke={guard_match,Ms,Rs}}; -bsm_rename_ctx(#l{ke={test,_,_}}=L, _, _, _) -> L; +bsm_rename_ctx(#l{ke={test,_,_,_}}=L, _, _, _) -> L; bsm_rename_ctx(#l{ke={bif,_,_,_}}=L, _, _, _) -> L; bsm_rename_ctx(#l{ke={gc_bif,_,_,_}}=L, _, _, _) -> L; bsm_rename_ctx(#l{ke={set,_,_}}=L, _, _, _) -> L; @@ -1054,8 +1051,15 @@ guard_cg(#l{ke={protected,Ts,Rs},i=I,vdb=Pdb}, Fail, _Vdb, Bef, St) -> protected_cg(Ts, Rs, Fail, I, Pdb, Bef, St); guard_cg(#l{ke={block,Ts},i=I,vdb=Bdb}, Fail, _Vdb, Bef, St) -> guard_cg_list(Ts, Fail, I, Bdb, Bef, St); -guard_cg(#l{ke={test,Test,As},i=I,vdb=_Tdb}, Fail, Vdb, Bef, St) -> - test_cg(Test, As, Fail, I, Vdb, Bef, St); +guard_cg(#l{ke={test,Test,As,Inverted},i=I,vdb=_Tdb}, Fail, Vdb, Bef, St0) -> + case Inverted of + false -> + test_cg(Test, As, Fail, I, Vdb, Bef, St0); + true -> + {Psucc,St1} = new_label(St0), + {Is,Aft,St2} = test_cg(Test, As, Psucc, I, Vdb, Bef, St1), + {Is++[{jump,{f,Fail}},{label,Psucc}],Aft,St2} + end; guard_cg(G, _Fail, Vdb, Bef, St) -> %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{G,Fail,Vdb,Bef}]), {Gis,Aft,St1} = cg(G, Vdb, Bef, St), @@ -1106,6 +1110,13 @@ test_cg(is_map, [A], Fail, I, Vdb, Bef, St) -> Arg = cg_reg_arg_prefer_y(A, Bef), Aft = clear_dead(Bef, I, Vdb), {[{test,is_map,{f,Fail},[Arg]}],Aft,St}; +test_cg(is_boolean, [{atom,Val}], Fail, I, Vdb, Bef, St) -> + Aft = clear_dead(Bef, I, Vdb), + Is = case is_boolean(Val) of + true -> []; + false -> [{jump,{f,Fail}}] + end, + {Is,Aft,St}; test_cg(Test, As, Fail, I, Vdb, Bef, St) -> Args = cg_reg_args(As, Bef), Aft = clear_dead(Bef, I, Vdb), @@ -1301,10 +1312,10 @@ trap_bif(erlang, group_leader, 2) -> true; trap_bif(erlang, exit, 2) -> true; trap_bif(_, _, _) -> false. -%% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> +%% internal_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> %% {[Ainstr],StackReg,State}. -bif_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) -> +internal_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) -> [Src] = cg_reg_args([Src0], Bef), case is_register(Src) of false -> @@ -1312,25 +1323,34 @@ bif_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) -> true -> {[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0} end; -bif_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) -> +internal_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) -> [New,Tuple,{integer,Index1}] = cg_reg_args([New0,Tuple0,Index0], Bef), Index = Index1-1, {[{set_tuple_element,New,Tuple,Index}], clear_dead(Bef, Le#l.i, Vdb), St0}; -bif_cg({make_fun,Func,Arity,Index,Uniq}, As, Rs, Le, Vdb, Bef, St0) -> +internal_cg(make_fun, [Func0,Arity0|As], Rs, Le, Vdb, Bef, St0) -> %% This behaves more like a function call. + {atom,Func} = Func0, + {integer,Arity} = Arity0, {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), Reg = load_vars(Rs, clear_regs(Int#sr.reg)), {FuncLbl,St1} = local_func_label(Func, Arity, St0), - MakeFun = {make_fun2,{f,FuncLbl},Index,Uniq,length(As)}, + MakeFun = {make_fun2,{f,FuncLbl},0,0,length(As)}, {Sis ++ [MakeFun], clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb), St1}; -bif_cg(bs_init_writable=I, As, Rs, Le, Vdb, Bef, St) -> +internal_cg(bs_init_writable=I, As, Rs, Le, Vdb, Bef, St) -> %% This behaves like a function call. {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), Reg = load_vars(Rs, clear_regs(Int#sr.reg)), {Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St}; +internal_cg(raise, As, Rs, Le, Vdb, Bef, St) -> + %% raise can be treated like a guard BIF. + bif_cg(raise, As, Rs, Le, Vdb, Bef, St). + +%% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> +%% {[Ainstr],StackReg,State}. + bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> Ars = cg_reg_args(As, Bef), diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index d71411de80..14cd41ae27 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -137,11 +137,13 @@ -record(core, {vcount=0 :: non_neg_integer(), %Variable counter fcount=0 :: non_neg_integer(), %Function counter + function={none,0} :: fa(), %Current function. in_guard=false :: boolean(), %In guard or not. wanted=true :: boolean(), %Result wanted or not. opts :: [compile:option()], %Options. ws=[] :: [warning()], %Warnings. - file=[{file,""}]}). %File + file=[{file,""}] %File. + }). %% XXX: The following type declarations do not belong in this module -type fa() :: {atom(), arity()}. @@ -149,38 +151,77 @@ -type form() :: {function, integer(), atom(), arity(), _} | {attribute, integer(), attribute(), _}. --spec module({module(), [fa()], [form()]}, [compile:option()]) -> +-record(imodule, {name = [], + exports = ordsets:new(), + attrs = [], + defs = [], + file = [], + opts = [], + ws = []}). + +-spec module([form()], [compile:option()]) -> {'ok',cerl:c_module(),[warning()]}. -module({Mod,Exp,Forms}, Opts) -> - Cexp = map(fun ({_N,_A} = NA) -> #c_var{name=NA} end, Exp), - {Kfs0,As0,Ws,_File} = foldl(fun (F, Acc) -> - form(F, Acc, Opts) - end, {[],[],[],[]}, Forms), - Kfs = reverse(Kfs0), +module(Forms0, Opts) -> + Forms = erl_internal:add_predefined_functions(Forms0), + Module = foldl(fun (F, Acc) -> + form(F, Acc, Opts) + end, #imodule{}, Forms), + #imodule{name=Mod,exports=Exp0,attrs=As0,defs=Kfs0,ws=Ws} = Module, + Exp = case member(export_all, Opts) of + true -> defined_functions(Forms); + false -> Exp0 + end, + Cexp = [#c_var{name=FA} || {_,_}=FA <- Exp], As = reverse(As0), + Kfs = reverse(Kfs0), {ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}. -form({function,_,_,_,_}=F0, {Fs,As,Ws0,File}, Opts) -> +form({function,_,_,_,_}=F0, Module, Opts) -> + #imodule{file=File,defs=Defs,ws=Ws0} = Module, {F,Ws} = function(F0, Ws0, File, Opts), - {[F|Fs],As,Ws,File}; -form({attribute,_,file,{File,_Line}}, {Fs,As,Ws,_}, _Opts) -> - {Fs,As,Ws,File}; -form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) -> - {Fs,[attribute(F)|As],Ws,File}. + Module#imodule{defs=[F|Defs],ws=Ws}; +form({attribute,_,module,Mod}, Module, _Opts) -> + true = is_atom(Mod), + Module#imodule{name=Mod}; +form({attribute,_,file,{File,_Line}}, Module, _Opts) -> + Module#imodule{file=File}; +form({attribute,_,compile,_}, Module, _Opts) -> + %% Ignore compilation options. + Module; +form({attribute,_,import,_}, Module, _Opts) -> + %% Ignore. We have no futher use for imports. + Module; +form({attribute,_,export,Es}, #imodule{exports=Exp0}=Module, _Opts) -> + Exp = ordsets:union(ordsets:from_list(Es), Exp0), + Module#imodule{exports=Exp}; +form({attribute,_,_,_}=F, #imodule{attrs=As}=Module, _Opts) -> + Module#imodule{attrs=[attribute(F)|As]}; +form(_, Module, _Opts) -> + %% Ignore uninteresting forms such as 'eof'. + Module. attribute(Attribute) -> Fun = fun(A) -> [erl_anno:location(A)] end, - {attribute,Line,Name,Val} = erl_parse:map_anno(Fun, Attribute), + {attribute,Line,Name,Val0} = erl_parse:map_anno(Fun, Attribute), + Val = if + is_list(Val0) -> Val0; + true -> [Val0] + end, {#c_literal{val=Name, anno=Line}, #c_literal{val=Val, anno=Line}}. +defined_functions(Forms) -> + Fs = [{Name,Arity} || {function,_,Name,Arity,_} <- Forms], + ordsets:from_list(Fs). + %% function_dump(module_info,_,_,_) -> ok; %% function_dump(Name,Arity,Format,Terms) -> %% io:format("~w/~w " ++ Format,[Name,Arity]++Terms), %% ok. function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) -> - St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]}, + St0 = #core{vcount=0,function={Name,Arity},opts=Opts, + ws=Ws0,file=[{file,File}]}, {B0,St1} = body(Cs0, Name, Arity, St0), %% ok = function_dump(Name,Arity,"body:~n~p~n",[B0]), {B1,St2} = ubody(B0, St1), @@ -632,9 +673,11 @@ expr({'catch',L,E0}, St0) -> {E1,Eps,St1} = expr(E0, St0), Lanno = lineno_anno(L, St1), {#icatch{anno=#a{anno=Lanno},body=Eps ++ [E1]},[],St1}; -expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) -> - Lanno = full_anno(L, St), - {#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St}; +expr({'fun',L,{function,F,A}}, St0) -> + {Fname,St1} = new_fun_name(St0), + Lanno = full_anno(L, St1), + Id = {0,0,Fname}, + {#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St1}; expr({'fun',L,{function,M,F,A}}, St0) -> {As,Aps,St1} = safe_list([M,F,A], St0), Lanno = full_anno(L, St1), @@ -642,12 +685,12 @@ expr({'fun',L,{function,M,F,A}}, St0) -> module=#c_literal{val=erlang}, name=#c_literal{val=make_fun}, args=As},Aps,St1}; -expr({'fun',L,{clauses,Cs},Id}, St) -> - fun_tq(Id, Cs, L, St, unnamed); -expr({named_fun,L,'_',Cs,Id}, St) -> - fun_tq(Id, Cs, L, St, unnamed); -expr({named_fun,L,Name,Cs,Id}, St) -> - fun_tq(Id, Cs, L, St, {named,Name}); +expr({'fun',L,{clauses,Cs}}, St) -> + fun_tq(Cs, L, St, unnamed); +expr({named_fun,L,'_',Cs}, St) -> + fun_tq(Cs, L, St, unnamed); +expr({named_fun,L,Name,Cs}, St) -> + fun_tq(Cs, L, St, {named,Name}); expr({call,L,{remote,_,M,F},As0}, St0) -> {[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0), Anno = full_anno(L, St1), @@ -840,19 +883,33 @@ badmap_term(Map, #core{in_guard=false}) -> c_tuple([#c_literal{val=badmap},Map]). map_build_pairs(Map, Es0, Ann, St0) -> - {Es,Pre,St1} = map_build_pairs_1(Es0, St0), + {Es,Pre,_,St1} = map_build_pairs_1(Es0, cerl_sets:new(), St0), {ann_c_map(Ann, Map, Es),Pre,St1}. -map_build_pairs_1([{Op0,L,K0,V0}|Es], St0) -> +map_build_pairs_1([{Op0,L,K0,V0}|Es], Used0, St0) -> {K,Pre0,St1} = safe(K0, St0), {V,Pre1,St2} = safe(V0, St1), - {Pairs,Pre2,St3} = map_build_pairs_1(Es, St2), + {Pairs,Pre2,Used1,St3} = map_build_pairs_1(Es, Used0, St2), As = lineno_anno(L, St3), Op = map_op(Op0), + {Used2,St4} = maybe_warn_repeated_keys(K, L, Used1, St3), Pair = cerl:ann_c_map_pair(As, Op, K, V), - {[Pair|Pairs],Pre0++Pre1++Pre2,St3}; -map_build_pairs_1([], St) -> - {[],[],St}. + {[Pair|Pairs],Pre0++Pre1++Pre2,Used2,St4}; +map_build_pairs_1([], Used, St) -> + {[],[],Used,St}. + +maybe_warn_repeated_keys(Ck,Line,Used,St) -> + case cerl:is_literal(Ck) of + false -> {Used,St}; + true -> + K = cerl:concrete(Ck), + case cerl_sets:is_element(K,Used) of + true -> + {Used, add_warning(Line, {map_key_repeated,K}, St)}; + false -> + {cerl_sets:add_element(K,Used), St} + end + end. map_op(map_field_assoc) -> #c_literal{val=assoc}; map_op(map_field_exact) -> #c_literal{val=exact}. @@ -899,14 +956,29 @@ try_after(As, St0) -> %% record whereas c_literal should not have a wrapped annotation expr_bin(Es0, Anno, St0) -> - case constant_bin(Es0) of + Es1 = [bin_element(E) || E <- Es0], + case constant_bin(Es1) of error -> - {Es,Eps,St} = expr_bin_1(Es0, St0), + {Es,Eps,St} = expr_bin_1(bin_expand_strings(Es1), St0), {#ibinary{anno=#a{anno=Anno},segments=Es},Eps,St}; Bin -> {#c_literal{anno=Anno,val=Bin},[],St0} end. +bin_element({bin_element,Line,Expr,Size0,Type0}) -> + {Size,Type} = make_bit_type(Line, Size0, Type0), + {bin_element,Line,Expr,Size,Type}. + +make_bit_type(Line, default, Type0) -> + case erl_bits:set_bit_type(default, Type0) of + {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)}; + {ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)}; + {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)} + end; +make_bit_type(_Line, Size, Type0) -> %Integer or 'all' + {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0), + {Size,erl_bits:as_list(Bt)}. + %% constant_bin([{bin_element,_,_,_,_}]) -> binary() | error %% If the binary construction is truly constant (no variables, %% no native fields), and does not contain fields whose expansion @@ -923,7 +995,8 @@ constant_bin(Es) -> constant_bin_1(Es) -> verify_suitable_fields(Es), EmptyBindings = erl_eval:new_bindings(), - EvalFun = fun({integer,_,I}, B) -> {value,I,B}; + EvalFun = fun({string,_,S}, B) -> {value,S,B}; + ({integer,_,I}, B) -> {value,I,B}; ({char,_,C}, B) -> {value,C,B}; ({float,_,F}, B) -> {value,F,B}; ({atom,_,undefined}, B) -> {value,undefined,B} @@ -944,6 +1017,9 @@ verify_suitable_fields([{bin_element,_,Val,SzTerm,Opts}|Es]) -> end, {unit,Unit} = keyfind(unit, 1, Opts), case {SzTerm,Val} of + {{atom,_,undefined},{string,_,_}} -> + %% UTF-8/16/32. + ok; {{atom,_,undefined},{char,_,_}} -> %% UTF-8/16/32. ok; @@ -983,6 +1059,14 @@ count_bits(Int) -> count_bits_1(0, Bits) -> Bits; count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64). +bin_expand_strings(Es) -> + foldr(fun ({bin_element,Line,{string,_,S},Sz,Ts}, Es1) -> + foldr(fun (C, Es2) -> + [{bin_element,Line,{char,Line,C},Sz,Ts}|Es2] + end, Es1, S); + (E, Es1) -> [E|Es1] + end, [], Es). + expr_bin_1(Es, St) -> foldr(fun (E, {Ces,Esp,St0}) -> {Ce,Ep,St1} = bitstr(E, St0), @@ -1018,17 +1102,19 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> %% fun_tq(Id, [Clauses], Line, State, NameInfo) -> {Fun,[PreExp],State}. -fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> +fun_tq(Cs0, L, St0, NameInfo) -> Arity = clause_arity(hd(Cs0)), {Cs1,Ceps,St1} = clauses(Cs0, St0), {Args,St2} = new_vars(Arity, St1), {Ps,St3} = new_vars(Arity, St2), %Need new variables here Anno = full_anno(L, St3), + {Name,St4} = new_fun_name(St3), Fc = function_clause(Ps, Anno, {Name,Arity}), + Id = {0,0,Name}, Fun = #ifun{anno=#a{anno=Anno}, id=[{id,Id}], %We KNOW! vars=Args,clauses=Cs1,fc=Fc,name=NameInfo}, - {Fun,Ceps,St3}. + {Fun,Ceps,St4}. %% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}. %% This TQ from Simon PJ pp 127-138. @@ -1354,8 +1440,9 @@ list_gen_pattern(P0, Line, St) -> %%% the result binary in a binary comprehension. %%% -bc_initial_size(E, Q, St0) -> +bc_initial_size(E0, Q, St0) -> try + E = bin_bin_element(E0), {ElemSzExpr,ElemSzPre,EVs,St1} = bc_elem_size(E, St0), {V,St2} = new_var(St1), {GenSzExpr,GenSzPre,St3} = bc_gen_size(Q, EVs, St2), @@ -1394,11 +1481,15 @@ bc_elem_size({bin,_,El}, St0) -> bc_elem_size(_, _) -> throw(impossible). -bc_elem_size_1([{bin_element,_,_,{integer,_,N},Flags}|Es], Bits, Vars) -> - {unit,U} = keyfind(unit, 1, Flags), +bc_elem_size_1([{bin_element,_,{string,_,String},{integer,_,N},_}=El|Es], + Bits, Vars) -> + U = get_unit(El), + bc_elem_size_1(Es, Bits+U*N*length(String), Vars); +bc_elem_size_1([{bin_element,_,_,{integer,_,N},_}=El|Es], Bits, Vars) -> + U = get_unit(El), bc_elem_size_1(Es, Bits+U*N, Vars); -bc_elem_size_1([{bin_element,_,_,{var,_,Var},Flags}|Es], Bits, Vars) -> - {unit,U} = keyfind(unit, 1, Flags), +bc_elem_size_1([{bin_element,_,_,{var,_,Var},_}=El|Es], Bits, Vars) -> + U = get_unit(El), bc_elem_size_1(Es, Bits, [{U,#c_var{name=Var}}|Vars]); bc_elem_size_1([_|_], _, _) -> throw(impossible); @@ -1455,7 +1546,9 @@ bc_gen_size_1([{generate,L,El,Gen}|Qs], EVs, E0, Pre0, St0) -> {E,Pre,St} = bc_gen_size_mul(E0, #c_literal{val=Len}, Pre0, St0), bc_gen_size_1(Qs, EVs, E, Pre, St) end; -bc_gen_size_1([{b_generate,_,El,Gen}|Qs], EVs, E0, Pre0, St0) -> +bc_gen_size_1([{b_generate,_,El0,Gen0}|Qs], EVs, E0, Pre0, St0) -> + El = bin_bin_element(El0), + Gen = bin_bin_element(Gen0), bc_verify_non_filtering(El, EVs), {MatchSzExpr,Pre1,_,St1} = bc_elem_size(El, St0), Pre2 = reverse(Pre1, Pre0), @@ -1471,6 +1564,10 @@ bc_gen_size_1([], _, E, Pre, St) -> bc_gen_size_1(_, _, _, _, _) -> throw(impossible). +bin_bin_element({bin,L,El}) -> + {bin,L,[bin_element(E) || E <- El]}; +bin_bin_element(Other) -> Other. + bc_gen_bit_size({var,L,V}, Pre0, St0) -> Lanno = lineno_anno(L, St0), {SzVar,St} = new_var(St0), @@ -1513,8 +1610,11 @@ bc_list_length(_, _) -> bc_bin_size({bin,_,Els}) -> bc_bin_size_1(Els, 0). -bc_bin_size_1([{bin_element,_,_,{integer,_,Sz},Flags}|Els], N) -> - {unit,U} = keyfind(unit, 1, Flags), +bc_bin_size_1([{bin_element,_,{string,_,String},{integer,_,Sz},_}=El|Els], N) -> + U = get_unit(El), + bc_bin_size_1(Els, N+U*Sz*length(String)); +bc_bin_size_1([{bin_element,_,_,{integer,_,Sz},_}=El|Els], N) -> + U = get_unit(El), bc_bin_size_1(Els, N+U*Sz); bc_bin_size_1([], N) -> N; bc_bin_size_1(_, _) -> throw(impossible). @@ -1549,11 +1649,24 @@ bc_bsr(E1, E2) -> name=#c_literal{val='bsr'}, args=[E1,E2]}. -%% is_guard_test(Expression) -> true | false. -%% Test if a general expression is a guard test. Use erl_lint here -%% as it now allows sys_pre_expand transformed source. +get_unit({bin_element,_,_,_,Flags}) -> + {unit,U} = keyfind(unit, 1, Flags), + U. -is_guard_test(E) -> erl_lint:is_guard_test(E). +%% is_guard_test(Expression) -> true | false. +%% Test if a general expression is a guard test. +%% +%% Note that a local function overrides a BIF with the same name. +%% For example, if there is a local function named is_list/1, +%% any unqualified call to is_list/1 will be to the local function. +%% The guard function must be explicitly called as erlang:is_list/1. + +is_guard_test(E) -> + %% erl_expand_records has added a module prefix to any call + %% to a BIF or imported function. Any call without a module + %% prefix that remains must therefore be to a local function. + IsOverridden = fun({_,_}) -> true end, + erl_lint:is_guard_test(E, [], IsOverridden). %% novars(Expr, State) -> {Novars,[PreExpr],State}. %% Generate a novars expression, basically a call or a safe. At this @@ -1696,7 +1809,18 @@ pattern({bin,L,Ps}, St) -> pattern({match,_,P1,P2}, St) -> {Cp1,Eps1,St1} = pattern(P1,St), {Cp2,Eps2,St2} = pattern(P2,St1), - {pat_alias(Cp1,Cp2),Eps1++Eps2,St2}. + {pat_alias(Cp1,Cp2),Eps1++Eps2,St2}; +%% Evaluate compile-time expressions. +pattern({op,_,'++',{nil,_},R}, St) -> + pattern(R, St); +pattern({op,_,'++',{cons,Li,H,T},R}, St) -> + pattern({cons,Li,H,{op,Li,'++',T,R}}, St); +pattern({op,_,'++',{string,Li,L},R}, St) -> + pattern(string_to_conses(Li, L, R), St); +pattern({op,_Line,_Op,_A}=Op, St) -> + pattern(erl_eval:partial_eval(Op), St); +pattern({op,_Line,_Op,_L,_R}=Op, St) -> + pattern(erl_eval:partial_eval(Op), St). %% pattern_map_pairs([MapFieldExact],State) -> [#c_map_pairs{}] pattern_map_pairs(Ps, St) -> @@ -1736,18 +1860,29 @@ pat_alias_map_pairs_1([]) -> []. %% pat_bin([BinElement], State) -> [BinSeg]. -pat_bin(Ps, St) -> [pat_segment(P, St) || P <- Ps]. +pat_bin(Ps, St) -> [pat_segment(P, St) || P <- bin_expand_strings(Ps)]. -pat_segment({bin_element,L,Val,Size,[Type,{unit,Unit}|Flags]}, St) -> +pat_segment({bin_element,L,Val,Size0,Type0}, St) -> + {Size,Type1} = make_bit_type(L, Size0, Type0), + [Type,{unit,Unit}|Flags] = Type1, Anno = lineno_anno(L, St), - {Pval,[],St1} = pattern(Val,St), - {Psize,[],_St2} = pattern(Size,St1), + {Pval0,[],St1} = pattern(Val, St), + Pval = coerce_to_float(Pval0, Type0), + {Psize,[],_St2} = pattern(Size, St1), #c_bitstr{anno=Anno, val=Pval,size=Psize, unit=#c_literal{val=Unit}, type=#c_literal{val=Type}, flags=#c_literal{val=Flags}}. +coerce_to_float(#c_literal{val=Int}=E, [float|_]) when is_integer(Int) -> + try + E#c_literal{val=float(Int)} + catch + error:badarg -> E + end; +coerce_to_float(E, _) -> E. + %% pat_alias(CorePat, CorePat) -> AliasPat. %% Normalise aliases. Trap bad aliases by throwing 'nomatch'. @@ -1817,11 +1952,18 @@ pattern_list([P0|Ps0], St0) -> pattern_list([], St) -> {[],[],St}. +string_to_conses(Line, Cs, Tail) -> + foldr(fun (C, T) -> {cons,Line,{char,Line,C},T} end, Tail, Cs). %% make_vars([Name]) -> [{Var,Name}]. make_vars(Vs) -> [ #c_var{name=V} || V <- Vs ]. +new_fun_name(#core{function={F,A},fcount=I}=St) -> + Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A) + ++ "-fun-" ++ integer_to_list(I) ++ "-", + {list_to_atom(Name),St#core{fcount=I+1}}. + %% new_fun_name(Type, State) -> {FunName,State}. new_fun_name(Type, #core{fcount=C}=St) -> @@ -1830,7 +1972,7 @@ new_fun_name(Type, #core{fcount=C}=St) -> %% new_var_name(State) -> {VarName,State}. new_var_name(#core{vcount=C}=St) -> - {list_to_atom("cor" ++ integer_to_list(C)),St#core{vcount=C + 1}}. + {list_to_atom("@c" ++ integer_to_list(C)),St#core{vcount=C + 1}}. %% new_var(State) -> {{var,Name},State}. %% new_var(LineAnno, State) -> {{var,Name},State}. @@ -2475,7 +2617,11 @@ format_error(nomatch) -> format_error(bad_binary) -> "binary construction will fail because of a type mismatch"; format_error(badmap) -> - "map construction will fail because of a type mismatch". + "map construction will fail because of a type mismatch"; +format_error({map_key_repeated,Key}) when is_atom(Key) -> + io_lib:format("key '~w' will be overridden in expression", [Key]); +format_error({map_key_repeated,Key}) -> + io_lib:format("key ~p will be overridden in expression", [Key]). add_warning(Anno, Term, #core{ws=Ws,file=[{file,File}]}=St) -> case erl_anno:generated(Anno) of diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index b4bbc5e739..4b5d7d919c 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -82,7 +82,7 @@ -export([module/2,format_error/1]). -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2, - keymember/3,keyfind/3,partition/2,droplast/1,last/1]). + keymember/3,keyfind/3,partition/2,droplast/1,last/1,sort/1]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). -import(cerl, [c_tuple/1]). @@ -151,6 +151,7 @@ include_attribute(optional_callbacks) -> false; include_attribute(_) -> true. function({#c_var{name={F,Arity}=FA},Body}, St0) -> + %%io:format("~w/~w~n", [F,Arity]), try St1 = St0#kern{func=FA,ff=undefined,vcount=0,fcount=0,ds=cerl_sets:new()}, {#ifun{anno=Ab,vars=Kvs,body=B0},[],St2} = expr(Body, new_sub(), St1), @@ -190,9 +191,479 @@ body(Ce, Sub, St0) -> guard(G0, Sub, St0) -> {G1,St1} = wrap_guard(G0, St0), {Ge0,Pre,St2} = expr(G1, Sub, St1), - {Ge,St} = gexpr_test(Ge0, St2), + {Ge1,St3} = gexpr_test(Ge0, St2), + {Ge,St} = guard_opt(Ge1, St3), {pre_seq(Pre, Ge),St}. +%% guard_opt(Kexpr, State) -> {Kexpr,State}. +%% Optimize the Kexpr for the guard. Instead of evaluating a boolean +%% expression comparing it to 'true' in a final #k_test{}, +%% replace BIF calls with #k_test{} in the expression. +%% +%% As an example, take the guard: +%% +%% when is_integer(V0), is_atom(V1) -> +%% +%% The unoptimized Kexpr translated to pseudo BEAM assembly +%% code would look like: +%% +%% bif is_integer V0 => Bool0 +%% bif is_atom V1 => Bool1 +%% bif and Bool0 Bool1 => Bool +%% test Bool =:= true else goto Fail +%% ... +%% Fail: +%% ... +%% +%% The optimized code would look like: +%% +%% test is_integer V0 else goto Fail +%% test is_atom V1 else goto Fail +%% ... +%% Fail: +%% ... +%% +%% An 'or' operation is only slightly more complicated: +%% +%% test is_integer V0 else goto NotFailedYet +%% goto Success +%% +%% NotFailedYet: +%% test is_atom V1 else goto Fail +%% +%% Success: +%% ... +%% Fail: +%% ... + +guard_opt(G, St0) -> + {Root,Forest0,St1} = make_forest(G, St0), + {Exprs,Forest,St} = rewrite_bool(Root, Forest0, false, St1), + E = forest_pre_seq(Exprs, Forest), + {G#k_try{arg=E},St}. + +%% rewrite_bool(Kexpr, Forest, Inv, St) -> {[Kexpr],Forest,St}. +%% Rewrite Kexpr to use #k_test{} operations instead of comparison +%% and type test BIFs. +%% +%% If Kexpr is a #k_test{} operation, the call will always +%% succeed. Otherwise, a 'not_possible' exception will be +%% thrown if Kexpr cannot be rewritten. + +rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, + args=[#k_var{}=V,#k_atom{val=true}]}=Test, Forest0, Inv, St0) -> + try rewrite_bool_var(V, Forest0, Inv, St0) of + {_,_,_}=Res -> + Res + catch + throw:not_possible -> + {[Test],Forest0,St0} + end; +rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, + args=[#k_var{}=V,#k_atom{val=false}]}=Test, Forest0, Inv, St0) -> + try rewrite_bool_var(V, Forest0, not Inv, St0) of + {_,_,_}=Res -> + Res + catch + throw:not_possible -> + {[Test],Forest0,St0} + end; +rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, + args=[#k_atom{val=V1},#k_atom{val=V2}]}, Forest0, false, St0) -> + case V1 =:= V2 of + true -> + {[make_test(is_boolean, [#k_atom{val=true}])],Forest0,St0}; + false -> + {[make_failing_test()],Forest0,St0} + end; +rewrite_bool(#k_test{}=Test, Forest, false, St) -> + {[Test],Forest,St}; +rewrite_bool(#k_try{vars=[#k_var{name=X}],body=#k_var{name=X}, + handler=#k_atom{val=false},ret=[]}=Prot, + Forest0, Inv, St0) -> + {Root,Forest1,St1} = make_forest(Prot, Forest0, St0), + {Exprs,Forest2,St} = rewrite_bool(Root, Forest1, Inv, St1), + InnerForest = maps:without(maps:keys(Forest0), Forest2), + Forest = maps:without(maps:keys(InnerForest), Forest2), + E = forest_pre_seq(Exprs, InnerForest), + {[Prot#k_try{arg=E}],Forest,St}; +rewrite_bool(#k_match{body=Body,ret=[]}, Forest, Inv, St) -> + rewrite_match(Body, Forest, Inv, St); +rewrite_bool(Other, Forest, Inv, St) -> + case extract_bif(Other) of + {Name,Args} -> + rewrite_bif(Name, Args, Forest, Inv, St); + error -> + throw(not_possible) + end. + +%% rewrite_bool_var(Var, Forest, Inv, St) -> {[Kexpr],Forest,St}. +%% Rewrite the boolean expression whose key in Forest is +%% given by Var. Throw a 'not_possible' expression if something +%% prevents the rewriting. + +rewrite_bool_var(Arg, Forest0, Inv, St) -> + {Expr,Forest} = forest_take_expr(Arg, Forest0), + rewrite_bool(Expr, Forest, Inv, St). + +%% rewrite_bool_args([Kexpr], Forest, Inv, St) -> {[[Kexpr]],Forest,St}. +%% Rewrite each Kexpr in the list. The input Kexpr should be variables +%% or boolean values. Throw a 'not_possible' expression if something +%% prevents the rewriting. +%% +%% This function is suitable for handling the arguments for both +%% 'and' and 'or'. + +rewrite_bool_args([#k_atom{val=B}=A|Vs], Forest0, false=Inv, St0) when is_boolean(B) -> + {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0), + Bif = make_bif('=:=', [A,#k_atom{val=true}]), + {Exprs,Forest,St} = rewrite_bool(Bif, Forest1, Inv, St1), + {[Exprs|Tail],Forest,St}; +rewrite_bool_args([#k_var{}=Var|Vs], Forest0, false=Inv, St0) -> + {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0), + {Exprs,Forest,St} = + case is_bool_expr(Var, Forest0) of + true -> + rewrite_bool_var(Var, Forest1, Inv, St1); + false -> + Bif = make_bif('=:=', [Var,#k_atom{val=true}]), + rewrite_bool(Bif, Forest1, Inv, St1) + end, + {[Exprs|Tail],Forest,St}; +rewrite_bool_args([_|_], _Forest, _Inv, _St) -> + throw(not_possible); +rewrite_bool_args([], Forest, _Inv, St) -> + {[],Forest,St}. + +%% rewrite_bif(Name, [Kexpr], Forest, Inv, St) -> {[Kexpr],Forest,St}. +%% Rewrite a BIF. Throw a 'not_possible' expression if something +%% prevents the rewriting. + +rewrite_bif('or', Args, Forest, true, St) -> + rewrite_not_args('and', Args, Forest, St); +rewrite_bif('and', Args, Forest, true, St) -> + rewrite_not_args('or', Args, Forest, St); +rewrite_bif('and', [#k_atom{val=Val},Arg], Forest0, Inv, St0) -> + false = Inv, %Assertion. + case Val of + true -> + %% The result only depends on Arg. + rewrite_bool_var(Arg, Forest0, Inv, St0); + _ -> + %% Will fail. There is no need to evalute the expression + %% represented by Arg. Take it out from the forest and + %% discard the expression. + Failing = make_failing_test(), + try rewrite_bool_var(Arg, Forest0, Inv, St0) of + {_,Forest,St} -> + {[Failing],Forest,St} + catch + throw:not_possible -> + try forest_take_expr(Arg, Forest0) of + {_,Forest} -> + {[Failing],Forest,St0} + catch + throw:not_possible -> + %% Arg is probably a variable bound in an + %% outer scope. + {[Failing],Forest0,St0} + end + end + end; +rewrite_bif('and', [Arg,#k_atom{}=Atom], Forest, Inv, St) -> + false = Inv, %Assertion. + rewrite_bif('and', [Atom,Arg], Forest, Inv, St); +rewrite_bif('and', Args, Forest0, Inv, St0) -> + false = Inv, %Assertion. + {[Es1,Es2],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0), + {Es1 ++ Es2,Forest,St}; +rewrite_bif('or', Args, Forest0, Inv, St0) -> + false = Inv, %Assertion. + {[First,Then],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0), + Alt = make_alt(First, Then), + {[Alt],Forest,St}; +rewrite_bif('xor', [_,_], _Forest, _Inv, _St) -> + %% Rewriting 'xor' is not practical. Fortunately, 'xor' is + %% almost never used in practice. + throw(not_possible); +rewrite_bif('not', [Arg], Forest0, Inv, St) -> + {Expr,Forest} = forest_take_expr(Arg, Forest0), + rewrite_bool(Expr, Forest, not Inv, St); +rewrite_bif(Op, Args, Forest, Inv, St) -> + case is_test(Op, Args) of + true -> + rewrite_bool(make_test(Op, Args, Inv), Forest, false, St); + false -> + throw(not_possible) + end. + +rewrite_not_args(Op, [A0,B0], Forest0, St0) -> + {A,Forest1,St1} = rewrite_not_args_1(A0, Forest0, St0), + {B,Forest2,St2} = rewrite_not_args_1(B0, Forest1, St1), + rewrite_bif(Op, [A,B], Forest2, false, St2). + +rewrite_not_args_1(Arg, Forest, St) -> + Not = make_bif('not', [Arg]), + forest_add_expr(Not, Forest, St). + +%% rewrite_match(Kvar, TypeClause, Forest, Inv, St) -> +%% {[Kexpr],Forest,St}. +%% Try to rewrite a #k_match{} originating from an 'andalso' or an 'orelse'. + +rewrite_match(#k_alt{first=First,then=Then}, Forest, Inv, St) -> + case {First,Then} of + {#k_select{var=#k_var{name=V}=Var,types=[TypeClause]},#k_var{name=V}} -> + rewrite_match_1(Var, TypeClause, Forest, Inv, St); + {_,_} -> + throw(not_possible) + end. + +rewrite_match_1(Var, #k_type_clause{values=Cs0}, Forest0, Inv, St0) -> + Cs = sort([{Val,B} || #k_val_clause{val=#k_atom{val=Val},body=B} <- Cs0]), + case Cs of + [{false,False},{true,True}] -> + rewrite_match_2(Var, False, True, Forest0, Inv, St0); + _ -> + throw(not_possible) + end. + +rewrite_match_2(Var, False, #k_atom{val=true}, Forest0, Inv, St0) -> + %% Originates from an 'orelse'. + case False of + #k_atom{val=NotBool} when not is_boolean(NotBool) -> + rewrite_bool(Var, Forest0, Inv, St0); + _ -> + {CodeVar,Forest1,St1} = add_protected_expr(False, Forest0, St0), + rewrite_bif('or', [Var,CodeVar], Forest1, Inv, St1) + end; +rewrite_match_2(Var, #k_atom{val=false}, True, Forest0, Inv, St0) -> + %% Originates from an 'andalso'. + {CodeVar,Forest1,St1} = add_protected_expr(True, Forest0, St0), + rewrite_bif('and', [Var,CodeVar], Forest1, Inv, St1); +rewrite_match_2(_V, _, _, _Forest, _Inv, _St) -> + throw(not_possible). + +%% is_bool_expr(#k_var{}, Forest) -> true|false. +%% Return true if the variable refers to a boolean expression +%% that does not need an explicit '=:= true' test. + +is_bool_expr(V, Forest) -> + case forest_peek_expr(V, Forest) of + error -> + %% Defined outside of the guard. We can't know. + false; + Expr -> + case extract_bif(Expr) of + {Name,Args} -> + is_test(Name, Args) orelse + erl_internal:bool_op(Name, length(Args)); + error -> + %% Not a BIF. Should be possible to rewrite + %% to a boolean. Definitely does not need + %% a '=:= true' test. + true + end + end. + +make_bif(Op, Args) -> + #k_bif{op=#k_remote{mod=#k_atom{val=erlang}, + name=#k_atom{val=Op}, + arity=length(Args)}, + args=Args}. + +extract_bif(#k_bif{op=#k_remote{mod=#k_atom{val=erlang}, + name=#k_atom{val=Name}}, + args=Args}) -> + {Name,Args}; +extract_bif(_) -> + error. + +%% make_alt(First, Then) -> KMatch. +%% Make a #k_alt{} within a #k_match{} to implement +%% 'or' or 'orelse'. + +make_alt(First0, Then0) -> + First1 = pre_seq(droplast(First0), last(First0)), + Then1 = pre_seq(droplast(Then0), last(Then0)), + First2 = make_protected(First1), + Then2 = make_protected(Then1), + Body = #k_atom{val=ignored}, + First3 = #k_guard_clause{guard=First2,body=Body}, + Then3 = #k_guard_clause{guard=Then2,body=Body}, + First = #k_guard{clauses=[First3]}, + Then = #k_guard{clauses=[Then3]}, + Alt = #k_alt{first=First,then=Then}, + #k_match{vars=[],body=Alt}. + +add_protected_expr(#k_atom{}=Atom, Forest, St) -> + {Atom,Forest,St}; +add_protected_expr(#k_var{}=Var, Forest, St) -> + {Var,Forest,St}; +add_protected_expr(E0, Forest, St) -> + E = make_protected(E0), + forest_add_expr(E, Forest, St). + +make_protected(#k_try{}=Try) -> + Try; +make_protected(B) -> + #k_try{arg=B,vars=[#k_var{name=''}],body=#k_var{name=''}, + handler=#k_atom{val=false}}. + +make_failing_test() -> + make_test(is_boolean, [#k_atom{val=fail}]). + +make_test(Op, Args) -> + make_test(Op, Args, false). + +make_test(Op, Args, Inv) -> + Remote = #k_remote{mod=#k_atom{val=erlang}, + name=#k_atom{val=Op}, + arity=length(Args)}, + #k_test{op=Remote,args=Args,inverted=Inv}. + +is_test(Op, Args) -> + A = length(Args), + erl_internal:new_type_test(Op, A) orelse erl_internal:comp_op(Op, A). + +%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}. +%% Build a forest out of Kexpr. RootKexpr is the final expression +%% nested inside Kexpr. + +make_forest(G, St) -> + make_forest_1(G, #{}, 0, St). + +%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}. +%% Add to Forest from Kexpr. RootKexpr is the final expression +%% nested inside Kexpr. + +make_forest(G, Forest0, St) -> + N = forest_next_index(Forest0), + make_forest_1(G, Forest0, N, St). + +make_forest_1(#k_try{arg=B}, Forest, I, St) -> + make_forest_1(B, Forest, I, St); +make_forest_1(#iset{vars=[]}=Iset0, Forest, I, St0) -> + {UnrefVar,St} = new_var(St0), + Iset = Iset0#iset{vars=[UnrefVar]}, + make_forest_1(Iset, Forest, I, St); +make_forest_1(#iset{vars=[#k_var{name=V}],arg=Arg,body=B}, Forest0, I, St) -> + Forest = Forest0#{V => {I,Arg}, {untaken,V} => true}, + make_forest_1(B, Forest, I+1, St); +make_forest_1(Innermost, Forest, _I, St) -> + {Innermost,Forest,St}. + +%% forest_take_expr(Kexpr, Forest) -> {Expr,Forest}. +%% If Kexpr is a variable, take out the expression corresponding +%% to variable in Forest. Expressions that have been taken out +%% of the forest will not be included the Kexpr returned +%% by forest_pre_seq/2. +%% +%% Throw a 'not_possible' exception if Kexpr is not a variable or +%% if the name of the variable is not a key in Forest. + +forest_take_expr(#k_var{name=V}, Forest0) -> + %% v3_core currently always generates guard expressions that can + %% be represented as a tree. Other code generators (such as LFE) + %% could generate guard expressions that can only be represented + %% as a DAG (i.e. some nodes are referenced more than once). To + %% handle DAGs, we must never remove a node from the forest, but + %% just remove the {untaken,V} marker. That will effectively convert + %% the DAG to a tree by duplicating the shared nodes and their + %% descendants. + + case maps:find(V, Forest0) of + {ok,{_,Expr}} -> + Forest = maps:remove({untaken,V}, Forest0), + {Expr,Forest}; + error -> + throw(not_possible) + end; +forest_take_expr(_, _) -> + throw(not_possible). + +%% forest_peek_expr(Kvar, Forest) -> Kexpr | error. +%% Return the expression corresponding to Kvar in Forest or +%% return 'error' if there is a corresponding expression. + +forest_peek_expr(#k_var{name=V}, Forest0) -> + case maps:find(V, Forest0) of + {ok,{_,Expr}} -> Expr; + error -> error + end. + +%% forest_add_expr(Kexpr, Forest, St) -> {Kvar,Forest,St}. +%% Add a new expression to Forest. + +forest_add_expr(Expr, Forest0, St0) -> + {#k_var{name=V}=Var,St} = new_var(St0), + N = forest_next_index(Forest0), + Forest = Forest0#{V => {N,Expr}}, + {Var,Forest,St}. + +forest_next_index(Forest) -> + 1 + lists:max([N || {N,_} <- maps:values(Forest), + is_integer(N)] ++ [0]). + +%% forest_pre_seq([Kexpr], Forest) -> Kexpr. +%% Package the list of Kexprs into a nested Kexpr, prepending all +%% expressions in Forest that have not been taken out using +%% forest_take_expr/2. + +forest_pre_seq(Exprs, Forest) -> + Es0 = [#k_var{name=V} || {untaken,V} <- maps:keys(Forest)], + Es = Es0 ++ Exprs, + Vs = extract_all_vars(Es, Forest, []), + Pre0 = sort([{maps:get(V, Forest),V} || V <- Vs]), + Pre = [#iset{vars=[#k_var{name=V}],arg=A} || + {{_,A},V} <- Pre0], + pre_seq(Pre++droplast(Exprs), last(Exprs)). + +extract_all_vars(Es, Forest, Acc0) -> + case extract_var_list(Es) of + [] -> + Acc0; + [_|_]=Vs0 -> + Vs = [V || V <- Vs0, maps:is_key(V, Forest)], + NewVs = ordsets:subtract(Vs, Acc0), + NewEs = [begin + {_,E} = maps:get(V, Forest), + E + end || V <- NewVs], + Acc = union(NewVs, Acc0), + extract_all_vars(NewEs, Forest, Acc) + end. + +extract_vars(#iset{arg=A,body=B}) -> + union(extract_vars(A), extract_vars(B)); +extract_vars(#k_bif{args=Args}) -> + ordsets:from_list(lit_list_vars(Args)); +extract_vars(#k_call{}) -> + []; +extract_vars(#k_test{args=Args}) -> + ordsets:from_list(lit_list_vars(Args)); +extract_vars(#k_match{body=Body}) -> + extract_vars(Body); +extract_vars(#k_alt{first=First,then=Then}) -> + union(extract_vars(First), extract_vars(Then)); +extract_vars(#k_guard{clauses=Cs}) -> + extract_var_list(Cs); +extract_vars(#k_guard_clause{guard=G}) -> + extract_vars(G); +extract_vars(#k_select{var=Var,types=Types}) -> + union(ordsets:from_list(lit_vars(Var)), + extract_var_list(Types)); +extract_vars(#k_type_clause{values=Values}) -> + extract_var_list(Values); +extract_vars(#k_val_clause{body=Body}) -> + extract_vars(Body); +extract_vars(#k_try{arg=Arg}) -> + extract_vars(Arg); +extract_vars(Lit) -> + ordsets:from_list(lit_vars(Lit)). + +extract_var_list(L) -> + union([extract_vars(E) || E <- L]). + %% Wrap the entire guard in a try/catch if needed. wrap_guard(#c_try{}=Try, St) -> {Try,St}; @@ -880,7 +1351,7 @@ new_fun_name(Type, #kern{func={F,Arity},fcount=C}=St) -> %% new_var_name(State) -> {VarName,State}. new_var_name(#kern{vcount=C}=St) -> - {list_to_atom("ker" ++ integer_to_list(C)),St#kern{vcount=C+1}}. + {list_to_atom("@k" ++ integer_to_list(C)),St#kern{vcount=C+1}}. %% new_var(State) -> {#k_var{},State}. @@ -1350,10 +1821,70 @@ select(T, Cs) -> [ C || C <- Cs, clause_con(C) =:= T ]. %% At this point all the clauses have the same constructor, we must %% now separate them according to value. -match_value(Us, T, Cs0, Def, St0) -> - Css = group_value(T, Cs0), +match_value(Us0, T, Cs0, Def, St0) -> + {Us1,Cs1,St1} = partition_intersection(T, Us0, Cs0, St0), + UCss = group_value(T, Us1, Cs1), %%ok = io:format("match_value ~p ~p~n", [T, Css]), - mapfoldl(fun (Cs, St) -> match_clause(Us, Cs, Def, St) end, St0, Css). + mapfoldl(fun ({Us,Cs}, St) -> match_clause(Us, Cs, Def, St) end, St1, UCss). + +%% partition_intersection +%% Partitions a map into two maps with the most common keys to the first map. +%% case <M> of +%% <#{a}> +%% <#{a,b}> +%% <#{a,c}> +%% <#{c}> +%% end +%% becomes +%% case <M,M> of +%% <#{a}, #{ }> +%% <#{a}, #{b}> +%% <#{ }, #{c}> +%% <#{a}, #{c}> +%% end +%% The intention is to group as many keys together as possible and thus +%% reduce the number of lookups to that key. +partition_intersection(k_map, [U|_]=Us0, [_,_|_]=Cs0,St0) -> + Ps = [clause_val(C) || C <- Cs0], + case find_key_partition(Ps) of + no_partition -> + {Us0,Cs0,St0}; + Ks -> + {Cs1,St1} = mapfoldl(fun(#iclause{pats=[Arg|Args]}=C, Sti) -> + {{Arg1,Arg2},St} = partition_key_intersection(Arg, Ks, Sti), + {C#iclause{pats=[Arg1,Arg2|Args]}, St} + end, St0, Cs0), + {[U|Us0],Cs1,St1} + end; +partition_intersection(_, Us, Cs, St) -> + {Us,Cs,St}. + +partition_key_intersection(#k_map{es=Pairs}=Map,Ks,St0) -> + F = fun(#k_map_pair{key=Key}) -> member(map_key_clean(Key), Ks) end, + {Ps1,Ps2} = partition(F, Pairs), + {{Map#k_map{es=Ps1},Map#k_map{es=Ps2}},St0}; +partition_key_intersection(#ialias{pat=Map}=Alias,Ks,St0) -> + %% only alias one of them + {{Map1,Map2},St1} = partition_key_intersection(Map, Ks, St0), + {{Map1,Alias#ialias{pat=Map2}},St1}. + +% Only check for the complete intersection of keys and not commonality +find_key_partition(Ps) -> + Sets = [sets:from_list(Ks)||Ks <- Ps], + Is = sets:intersection(Sets), + case sets:to_list(Is) of + [] -> no_partition; + KeyIntersection -> + %% Check if the intersection are all keys in all clauses. + %% Don't split if they are since this will only + %% infer extra is_map instructions with no gain. + All = foldl(fun (Kset, Bool) -> + Bool andalso sets:is_subset(Kset, Is) + end, true, Sets), + if All -> no_partition; + true -> KeyIntersection + end + end. %% group_value([Clause]) -> [[Clause]]. %% Group clauses according to value. Here we know that @@ -1361,30 +1892,30 @@ match_value(Us, T, Cs0, Def, St0) -> %% 2. The clauses in bin_segs cannot be reordered only grouped %% 3. Other types are disjoint and can be reordered -group_value(k_cons, Cs) -> [Cs]; %These are single valued -group_value(k_nil, Cs) -> [Cs]; -group_value(k_binary, Cs) -> [Cs]; -group_value(k_bin_end, Cs) -> [Cs]; -group_value(k_bin_seg, Cs) -> group_bin_seg(Cs); -group_value(k_bin_int, Cs) -> [Cs]; -group_value(k_map, Cs) -> group_map(Cs); -group_value(_, Cs) -> +group_value(k_cons, Us, Cs) -> [{Us,Cs}]; %These are single valued +group_value(k_nil, Us, Cs) -> [{Us,Cs}]; +group_value(k_binary, Us, Cs) -> [{Us,Cs}]; +group_value(k_bin_end, Us, Cs) -> [{Us,Cs}]; +group_value(k_bin_seg, Us, Cs) -> group_bin_seg(Us,Cs); +group_value(k_bin_int, Us, Cs) -> [{Us,Cs}]; +group_value(k_map, Us, Cs) -> group_map(Us,Cs); +group_value(_, Us, Cs) -> %% group_value(Cs). Cd = foldl(fun (C, Gcs0) -> dict:append(clause_val(C), C, Gcs0) end, dict:new(), Cs), - dict:fold(fun (_, Vcs, Css) -> [Vcs|Css] end, [], Cd). + dict:fold(fun (_, Vcs, Css) -> [{Us,Vcs}|Css] end, [], Cd). -group_bin_seg([C1|Cs]) -> +group_bin_seg(Us, [C1|Cs]) -> V1 = clause_val(C1), {More,Rest} = splitwith(fun (C) -> clause_val(C) == V1 end, Cs), - [[C1|More]|group_bin_seg(Rest)]; -group_bin_seg([]) -> []. + [{Us,[C1|More]}|group_bin_seg(Us,Rest)]; +group_bin_seg(_, []) -> []. -group_map([C1|Cs]) -> +group_map(Us, [C1|Cs]) -> V1 = clause_val(C1), {More,Rest} = splitwith(fun (C) -> clause_val(C) =:= V1 end, Cs), - [[C1|More]|group_map(Rest)]; -group_map([]) -> []. + [{Us,[C1|More]}|group_map(Us,Rest)]; +group_map(_, []) -> []. %% Profiling shows that this quadratic implementation account for a big amount %% of the execution time if there are many values. @@ -1734,15 +2265,15 @@ uexpr(#k_receive_accept{anno=A}, _, St) -> {#k_receive_accept{anno=#k{us=[],ns=[],a=A}},[],St}; uexpr(#k_receive_next{anno=A}, _, St) -> {#k_receive_next{anno=#k{us=[],ns=[],a=A}},[],St}; -uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}=Try, +uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, {break,Rs0}=Br, St0) -> case is_in_guard(St0) of true -> {[#k_var{name=X}],#k_var{name=X}} = {Vs,B0}, %Assertion. #k_atom{val=false} = H0, %Assertion. {A1,Bu,St1} = uexpr(A0, Br, St0), - {Try#k_try{anno=#k{us=Bu,ns=lit_list_vars(Rs0),a=A}, - arg=A1,ret=Rs0},Bu,St1}; + {#k_protected{anno=#k{us=Bu,ns=lit_list_vars(Rs0),a=A}, + arg=A1,ret=Rs0},Bu,St1}; false -> {Avs,St1} = new_vars(length(Vs), St0), {A1,Au,St2} = ubody(A0, {break,Avs}, St1), @@ -1791,13 +2322,9 @@ uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) -> end, Fun = #k_fdef{anno=#k{us=[],ns=[],a=A},func=Fname,arity=Arity, vars=Vs ++ Fvs,body=B1}, - %% Set dummy values for Index and Uniq -- the real values will - %% be assigned by beam_asm. - Index = Uniq = 0, {#k_bif{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A}, - op=#k_internal{name=make_fun,arity=length(Free)+3}, - args=[#k_atom{val=Fname},#k_int{val=Arity}, - #k_int{val=Index},#k_int{val=Uniq}|Fvs], + op=#k_internal{name=make_fun,arity=length(Free)+2}, + args=[#k_atom{val=Fname},#k_int{val=Arity}|Fvs], ret=Rs}, Free,add_local_function(Fun, St)}; uexpr(Lit, {break,Rs0}, St0) -> diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index 5216a1a620..7cd30b25a8 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -58,7 +58,7 @@ -record(k_seq, {anno=[],arg,body}). -record(k_put, {anno=[],arg,ret=[]}). -record(k_bif, {anno=[],op,args,ret=[]}). --record(k_test, {anno=[],op,args}). +-record(k_test, {anno=[],op,args,inverted=false}). -record(k_call, {anno=[],op,args,ret=[]}). -record(k_enter, {anno=[],op,args}). -record(k_receive, {anno=[],var,body,timeout,action,ret=[]}). @@ -66,6 +66,7 @@ -record(k_receive_next, {anno=[]}). -record(k_try, {anno=[],arg,vars,body,evars,handler,ret=[]}). -record(k_try_enter, {anno=[],arg,vars,body,evars,handler}). +-record(k_protected, {anno=[],arg,ret=[]}). -record(k_catch, {anno=[],body,ret=[]}). -record(k_guard_match, {anno=[],vars,body,ret=[]}). diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index 0b90f0a1e0..d5f6ee19c9 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -235,8 +235,13 @@ format_1(#k_bif{op=Op,args=As,ret=Rs}, Ctxt) -> [Txt,format_args(As, Ctxt1), format_ret(Rs, Ctxt1) ]; -format_1(#k_test{op=Op,args=As}, Ctxt) -> - Txt = ["test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)], +format_1(#k_test{op=Op,args=As,inverted=Inverted}, Ctxt) -> + Txt = case Inverted of + false -> + ["test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)]; + true -> + ["inverted_test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)] + end, Ctxt1 = ctxt_bump_indent(Ctxt, 2), [Txt,format_args(As, Ctxt1)]; format_1(#k_put{arg=A,ret=Rs}, Ctxt) -> @@ -279,6 +284,15 @@ format_1(#k_try_enter{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Ctxt) -> nl_indent(Ctxt), "end" ]; +format_1(#k_protected{arg=A,ret=Rs}, Ctxt) -> + Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent), + ["protected", + nl_indent(Ctxt1), + format(A, Ctxt1), + nl_indent(Ctxt), + "end", + format_ret(Rs, ctxt_bump_indent(Ctxt, 1)) + ]; format_1(#k_catch{body=B,ret=Rs}, Ctxt) -> Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent), ["catch", diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index 1452b78d1d..0f2aeda87f 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -78,9 +78,7 @@ function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) -> #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a}, vars=Vs,body=Kb,ret=[]} end, - put(guard_refc, 0), {B1,_,Vdb1} = body(B0, 1, Vdb0), - erase(guard_refc), {function,F,Ar,As,B1,Vdb1,Anno} catch Class:Error -> @@ -106,12 +104,13 @@ body(Ke, I, Vdb0) -> E = expr(Ke, I, Vdb1), {[E],I,Vdb1}. -%% guard(Kguard, I, Vdb) -> Guard. +%% protected(Kprotected, I, Vdb) -> Protected. +%% Only used in guards. -guard(#k_try{anno=A,arg=Ts,vars=[#k_var{name=X}],body=#k_var{name=X}, - handler=#k_atom{val=false},ret=Rs}, I, Vdb) -> +protected(#k_protected{anno=A,arg=Ts,ret=Rs}, I, Vdb) -> %% Lock variables that are alive before try and used afterwards. - %% Don't lock variables that are only used inside the try expression. + %% Don't lock variables that are only used inside the protected + %% expression. Pdb0 = vdb_sub(I, I+1, Vdb), {T,MaxI,Pdb1} = body(Ts, I+1, Pdb0), Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values @@ -119,8 +118,8 @@ guard(#k_try{anno=A,arg=Ts,vars=[#k_var{name=X}],body=#k_var{name=X}, %% expr(Kexpr, I, Vdb) -> Expr. -expr(#k_test{anno=A,op=Op,args=As}, I, _Vdb) -> - #l{ke={test,test_op(Op),atomic_list(As)},i=I,a=A#k.a}; +expr(#k_test{anno=A,op=Op,args=As,inverted=Inverted}, I, _Vdb) -> + #l{ke={test,test_op(Op),atomic_list(As),Inverted},i=I,a=A#k.a}; expr(#k_call{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) -> #l{ke={call,call_op(Op),atomic_list(As),var_list(Rs)},i=I,a=A#k.a}; expr(#k_enter{anno=A,op=Op,args=As}, I, _Vdb) -> @@ -139,10 +138,9 @@ expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> M = match(Kb, A#k.us, I+1, [], Mdb), #l{ke={guard_match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}; expr(#k_try{}=Try, I, Vdb) -> - case is_in_guard() of - false -> body_try(Try, I, Vdb); - true -> guard(Try, I, Vdb) - end; + body_try(Try, I, Vdb); +expr(#k_protected{}=Protected, I, Vdb) -> + protected(Protected, I, Vdb); expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) -> %% Lock variables that are alive before the catch and used afterwards. %% Don't lock variables that are only used inside the try. @@ -213,7 +211,6 @@ body_try(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs}, i=I,vdb=Tdb1,a=A#k.a}. %% call_op(Op) -> Op. -%% bif_op(Op) -> Op. %% test_op(Op) -> Op. %% Do any necessary name translations here to munge into beam format. @@ -221,28 +218,14 @@ call_op(#k_local{name=N}) -> N; call_op(#k_remote{mod=M,name=N}) -> {remote,atomic(M),atomic(N)}; call_op(Other) -> variable(Other). -bif_op(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=N}}) -> N; -bif_op(#k_internal{name=N}) -> N. - test_op(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=N}}) -> N. %% k_bif(Anno, Op, [Arg], [Ret], Vdb) -> Expr. -%% Build bifs, do special handling of internal some calls. - -k_bif(_A, #k_internal{name=dsetelement,arity=3}, As, []) -> - {bif,dsetelement,atomic_list(As),[]}; -k_bif(_A, #k_internal{name=bs_context_to_binary=Op,arity=1}, As, []) -> - {bif,Op,atomic_list(As),[]}; -k_bif(_A, #k_internal{name=bs_init_writable=Op,arity=1}, As, Rs) -> - {bif,Op,atomic_list(As),var_list(Rs)}; -k_bif(_A, #k_internal{name=make_fun}, - [#k_atom{val=Fun},#k_int{val=Arity}, - #k_int{val=Index},#k_int{val=Uniq}|Free], - Rs) -> - {bif,{make_fun,Fun,Arity,Index,Uniq},var_list(Free),var_list(Rs)}; -k_bif(_A, Op, As, Rs) -> - %% The general case. - Name = bif_op(Op), +%% Build bifs. + +k_bif(_A, #k_internal{name=Name}, As, Rs) -> + {internal,Name,atomic_list(As),var_list(Rs)}; +k_bif(_A, #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, As, Rs) -> Ar = length(As), case is_gc_bif(Name, Ar) of false -> @@ -303,9 +286,7 @@ val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Ctxt0, Vdb0) -> guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) -> Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0), Gdb = vdb_sub(I+1, I+2, Vdb1), - OldRefc = put(guard_refc, get(guard_refc)+1), - G = guard(Kg, I+1, Gdb), - put(guard_refc, OldRefc), + G = protected(Kg, I+1, Gdb), B = match(Kb, Ls, I+2, Ctxt, Vdb1), #l{ke={guard_clause,G,B}, i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1), @@ -394,7 +375,6 @@ is_gc_bif(node, 0) -> false; is_gc_bif(node, 1) -> false; is_gc_bif(element, 2) -> false; is_gc_bif(get, 1) -> false; -is_gc_bif(raise, 2) -> false; is_gc_bif(tuple_size, 1) -> false; is_gc_bif(Bif, Arity) -> not (erl_internal:bool_op(Bif, Arity) orelse @@ -431,11 +411,6 @@ use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). add_var(V, F, L, Vdb) -> vdb_store_new(V, {V,F,L}, Vdb). -%% is_in_guard() -> true|false. - -is_in_guard() -> - get(guard_refc) > 0. - %% vdb vdb_new(Vs) -> |