aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src
diff options
context:
space:
mode:
authorBjörn Gustavsson <[email protected]>2016-11-18 12:06:42 +0100
committerBjörn Gustavsson <[email protected]>2016-11-18 12:06:42 +0100
commit79653c709f854e6fadd719ef5f079f66219c6bdf (patch)
tree2f2a3a1a3b1a06a5e458424da5cb88f9733ec56f /lib/compiler/src
parentf578f6c57438ac7dd11a3d113406a104f4064b26 (diff)
parent09f170e35cf9df8438ae42d48b51becff167b5b4 (diff)
downloadotp-79653c709f854e6fadd719ef5f079f66219c6bdf.tar.gz
otp-79653c709f854e6fadd719ef5f079f66219c6bdf.tar.bz2
otp-79653c709f854e6fadd719ef5f079f66219c6bdf.zip
Merge branch 'bjorn/compiler/guards/PR-1232/OTP-14042'
* bjorn/compiler/guards/PR-1232/OTP-14042: compile_SUITE: Make sure that guards are optimized beam_dead: Remove redundant 'or' instruction beam_dead: Remove redundant 'bif' instructions Add test using LFE-generated Core Erlang modules Remove beam_bool v3_kernel: Generate optimized code for guards sys_core_fold: Remove unnecessary calls to opt_bool_case/1 record_SUITE: Strengthen test of record access in guards
Diffstat (limited to 'lib/compiler/src')
-rw-r--r--lib/compiler/src/Makefile1
-rw-r--r--lib/compiler/src/beam_bool.erl765
-rw-r--r--lib/compiler/src/beam_dead.erl32
-rw-r--r--lib/compiler/src/beam_jump.erl32
-rw-r--r--lib/compiler/src/beam_utils.erl16
-rw-r--r--lib/compiler/src/compile.erl3
-rw-r--r--lib/compiler/src/compiler.app.src1
-rw-r--r--lib/compiler/src/sys_core_fold.erl94
-rw-r--r--lib/compiler/src/v3_codegen.erl20
-rw-r--r--lib/compiler/src/v3_kernel.erl474
-rw-r--r--lib/compiler/src/v3_kernel.hrl2
-rw-r--r--lib/compiler/src/v3_kernel_pp.erl9
-rw-r--r--lib/compiler/src/v3_life.erl4
13 files changed, 553 insertions, 900 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index b5ca6c3c49..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 \
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 3606af9d75..9087586b58 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -266,12 +266,30 @@ 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([{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) ->
@@ -361,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.
@@ -379,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);
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 5311ce7379..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:
%%%
@@ -473,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_utils.erl b/lib/compiler/src/beam_utils.erl
index 564a62a7f2..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,
@@ -96,20 +96,6 @@ is_not_used(R, Is, D) ->
{_,_} -> true
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{lbl=D,res=gb_trees:empty()},
- case check_liveness_at(R, Lbl, St) of
- {used,_} -> false;
- {_,_} -> true
- end.
-
%% index_labels(FunctionIs) -> State
%% Index the instruction sequence so that we can quickly
%% look up the instruction following a specific label.
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index e4fb703939..37da045d25 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -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},
@@ -1780,7 +1778,6 @@ pre_load() ->
L = [beam_a,
beam_asm,
beam_block,
- beam_bool,
beam_bs,
beam_bsm,
beam_clean,
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index 20195ac36f..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,
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 5d7fd37270..50d28c0a5f 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -373,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),
@@ -1554,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.
@@ -1565,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 ->
@@ -1576,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;
@@ -1589,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)}.
@@ -1606,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)];
@@ -2238,14 +2240,14 @@ inverse_rel_op(_) -> no.
%% opt_bool_case_in_let(LetExpr) -> Core
-opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let) ->
- opt_bool_case_in_let_1(Vs, Arg, B, Let).
+opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) ->
+ opt_bool_case_in_let_1(Vs, Arg, B, Let, Sub).
opt_bool_case_in_let_1([#c_var{name=V}], Arg,
- #c_case{arg=#c_var{name=V}}=Case0, Let) ->
+ #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 -> Case;
true -> Let
@@ -2253,7 +2255,7 @@ opt_bool_case_in_let_1([#c_var{name=V}], Arg,
false ->
Let
end;
-opt_bool_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
@@ -2386,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,
@@ -2688,8 +2688,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, 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),
- opt_case_in_let_arg(Let2, Ctxt, Sub)
+ opt_bool_case_in_let(Let1, Sub)
end
end.
@@ -2817,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}},
- Case0#c_case{clauses=[Ca,Cb]};
- _ ->
- 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);
@@ -3289,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}, []).
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index c2e0c2bd1a..3627cdb7cd 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -363,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;
@@ -1051,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),
@@ -1103,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),
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index f8e99905b5..2bfa610628 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]).
@@ -190,9 +190,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};
diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl
index 1169a69117..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=[]}).
diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl
index 45065b7e11..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) ->
diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl
index 4337ec732c..0f2aeda87f 100644
--- a/lib/compiler/src/v3_life.erl
+++ b/lib/compiler/src/v3_life.erl
@@ -118,8 +118,8 @@ protected(#k_protected{anno=A,arg=Ts,ret=Rs}, I, Vdb) ->
%% 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) ->