aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/src')
-rw-r--r--lib/compiler/src/Makefile1
-rw-r--r--lib/compiler/src/beam_block.erl39
-rw-r--r--lib/compiler/src/beam_clean.erl52
-rw-r--r--lib/compiler/src/beam_disasm.erl7
-rw-r--r--lib/compiler/src/beam_except.erl247
-rw-r--r--lib/compiler/src/beam_ssa.erl4
-rw-r--r--lib/compiler/src/beam_ssa_codegen.erl131
-rw-r--r--lib/compiler/src/beam_ssa_dead.erl8
-rw-r--r--lib/compiler/src/beam_ssa_opt.erl2
-rw-r--r--lib/compiler/src/beam_ssa_pre_codegen.erl116
-rw-r--r--lib/compiler/src/beam_ssa_type.erl152
-rw-r--r--lib/compiler/src/beam_trim.erl7
-rw-r--r--lib/compiler/src/beam_validator.erl34
-rw-r--r--lib/compiler/src/compile.erl9
-rw-r--r--lib/compiler/src/compiler.app.src1
-rwxr-xr-xlib/compiler/src/genop.tab4
-rw-r--r--lib/compiler/src/sys_core_fold.erl414
17 files changed, 549 insertions, 679 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index 87b0d345f2..0c1dc30f9c 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -52,7 +52,6 @@ MODULES = \
beam_clean \
beam_dict \
beam_disasm \
- beam_except \
beam_flatten \
beam_jump \
beam_listing \
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index 707974b2c1..a734ca3a10 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -33,8 +33,9 @@ module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
function({function,Name,Arity,CLabel,Is0}) ->
try
- Is1 = blockify(Is0),
- Is = embed_lines(Is1),
+ Is1 = swap_opt(Is0),
+ Is2 = blockify(Is1),
+ Is = embed_lines(Is2),
{function,Name,Arity,CLabel,Is}
catch
Class:Error:Stack ->
@@ -42,6 +43,40 @@ function({function,Name,Arity,CLabel,Is0}) ->
erlang:raise(Class, Error, Stack)
end.
+%%%
+%%% Try to use a `swap` instruction instead of a sequence of moves.
+%%%
+%%% Note that beam_ssa_codegen generates `swap` instructions only for
+%%% the moves within a single SSA instruction (such as `call`), not
+%%% for the moves generated by a sequence of SSA instructions.
+%%% Therefore, this optimization is needed.
+%%%
+
+swap_opt([{move,Reg1,{x,X}=Temp}=Move1,
+ {move,Reg2,Reg1}=Move2,
+ {move,Temp,Reg2}=Move3|Is]) when Reg1 =/= Temp ->
+ case is_unused(X, Is) of
+ true ->
+ [{swap,Reg1,Reg2}|swap_opt(Is)];
+ false ->
+ [Move1|swap_opt([Move2,Move3|Is])]
+ end;
+swap_opt([I|Is]) ->
+ [I|swap_opt(Is)];
+swap_opt([]) -> [].
+
+is_unused(X, [{call,A,_}|_]) when A =< X -> true;
+is_unused(X, [{call_ext,A,_}|_]) when A =< X -> true;
+is_unused(X, [{make_fun2,_,_,_,A}|_]) when A =< X -> true;
+is_unused(X, [{move,Src,Dst}|Is]) ->
+ case {Src,Dst} of
+ {{x,X},_} -> false;
+ {_,{x,X}} -> true;
+ {_,_} -> is_unused(X, Is)
+ end;
+is_unused(X, [{line,_}|Is]) -> is_unused(X, Is);
+is_unused(_, _) -> false.
+
%% blockify(Instructions0) -> Instructions
%% Collect sequences of instructions to basic blocks.
%% Also do some simple optimations on instructions outside the blocks.
diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl
index 7299654476..6b2b2ce085 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -34,7 +34,8 @@ module({Mod,Exp,Attr,Fs0,_}, Opts) ->
Used = find_all_used(WorkList, All, cerl_sets:from_list(WorkList)),
Fs1 = remove_unused(Order, Used, All),
{Fs2,Lc} = clean_labels(Fs1),
- Fs = maybe_remove_lines(Fs2, Opts),
+ Fs3 = fix_swap(Fs2, Opts),
+ Fs = maybe_remove_lines(Fs3, Opts),
{ok,{Mod,Exp,Attr,Fs,Lc}}.
%% Determine the rootset, i.e. exported functions and
@@ -137,31 +138,54 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) ->
function_replace([], _, Acc) -> Acc.
%%%
+%%% If compatibility with a previous release (OTP 22 or earlier) has
+%%% been requested, replace swap instructions with a sequence of moves.
+%%%
+
+fix_swap(Fs, Opts) ->
+ case proplists:get_bool(no_swap, Opts) of
+ false -> Fs;
+ true -> fold_functions(fun swap_moves/1, Fs)
+ end.
+
+swap_moves([{swap,Reg1,Reg2}|Is]) ->
+ Temp = {x,1022},
+ [{move,Reg1,Temp},{move,Reg2,Reg1},{move,Temp,Reg2}|swap_moves(Is)];
+swap_moves([I|Is]) ->
+ [I|swap_moves(Is)];
+swap_moves([]) -> [].
+
+%%%
%%% Remove line instructions if requested.
%%%
maybe_remove_lines(Fs, Opts) ->
case proplists:get_bool(no_line_info, Opts) of
false -> Fs;
- true -> remove_lines(Fs)
+ true -> fold_functions(fun remove_lines/1, Fs)
end.
-remove_lines([{function,N,A,Lbl,Is0}|T]) ->
- Is = remove_lines_fun(Is0),
- [{function,N,A,Lbl,Is}|remove_lines(T)];
-remove_lines([]) -> [].
-
-remove_lines_fun([{line,_}|Is]) ->
- remove_lines_fun(Is);
-remove_lines_fun([{block,Bl0}|Is]) ->
+remove_lines([{line,_}|Is]) ->
+ remove_lines(Is);
+remove_lines([{block,Bl0}|Is]) ->
Bl = remove_lines_block(Bl0),
- [{block,Bl}|remove_lines_fun(Is)];
-remove_lines_fun([I|Is]) ->
- [I|remove_lines_fun(Is)];
-remove_lines_fun([]) -> [].
+ [{block,Bl}|remove_lines(Is)];
+remove_lines([I|Is]) ->
+ [I|remove_lines(Is)];
+remove_lines([]) -> [].
remove_lines_block([{set,_,_,{line,_}}|Is]) ->
remove_lines_block(Is);
remove_lines_block([I|Is]) ->
[I|remove_lines_block(Is)];
remove_lines_block([]) -> [].
+
+
+%%%
+%%% Helpers.
+%%%
+
+fold_functions(F, [{function,N,A,Lbl,Is0}|T]) ->
+ Is = F(Is0),
+ [{function,N,A,Lbl,Is}|fold_functions(F, T)];
+fold_functions(_F, []) -> [].
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index 7d048716e4..45b69d7e95 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -1123,6 +1123,13 @@ resolve_inst({put_tuple2,[Dst,{{z,1},{u,_},List0}]},_,_,_) ->
{put_tuple2,Dst,{list,List}};
%%
+%% OTP 23.
+%%
+resolve_inst({swap,[_,_]=List},_,_,_) ->
+ [R1,R2] = resolve_args(List),
+ {swap,R1,R2};
+
+%%
%% Catches instructions that are not yet handled.
%%
resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}).
diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl
deleted file mode 100644
index 2305502800..0000000000
--- a/lib/compiler/src/beam_except.erl
+++ /dev/null
@@ -1,247 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2011-2018. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
--module(beam_except).
--export([module/2]).
-
-%%% Rewrite certain calls to erlang:error/{1,2} to specialized
-%%% instructions:
-%%%
-%%% erlang:error({badmatch,Value}) => badmatch Value
-%%% erlang:error({case_clause,Value}) => case_end Value
-%%% erlang:error({try_clause,Value}) => try_case_end Value
-%%% erlang:error(if_clause) => if_end
-%%% erlang:error(function_clause, Args) => jump FuncInfoLabel
-%%%
-
--import(lists, [reverse/1,reverse/2,seq/2,splitwith/2]).
-
--spec module(beam_utils:module_code(), [compile:option()]) ->
- {'ok',beam_utils:module_code()}.
-
-module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
- Fs = [function(F) || F <- Fs0],
- {ok,{Mod,Exp,Attr,Fs,Lc}}.
-
-function({function,Name,Arity,CLabel,Is0}) ->
- try
- Is = function_1(Is0),
- {function,Name,Arity,CLabel,Is}
- catch
- Class:Error:Stack ->
- io:fwrite("Function: ~w/~w\n", [Name,Arity]),
- erlang:raise(Class, Error, Stack)
- end.
-
--record(st,
- {lbl :: beam_asm:label(), %func_info label
- loc :: [_], %location for func_info
- arity :: arity() %arity for function
- }).
-
-function_1(Is0) ->
- case Is0 of
- [{label,Lbl},{line,Loc},{func_info,_,_,Arity}|_] ->
- St = #st{lbl=Lbl,loc=Loc,arity=Arity},
- translate(Is0, St, []);
- [{label,_}|_] ->
- %% No line numbers. The source must be a .S file.
- %% There is no need to do anything.
- Is0
- end.
-
-translate([{call_ext,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) ->
- translate_1(Ar, I, Is, St, Acc);
-translate([I|Is], St, Acc) ->
- translate(Is, St, [I|Acc]);
-translate([], _, Acc) ->
- reverse(Acc).
-
-translate_1(Ar, I, Is, #st{arity=Arity}=St, [{line,_}=Line|Acc1]=Acc0) ->
- case dig_out(Ar, Arity, Acc1) of
- no ->
- translate(Is, St, [I|Acc0]);
- {yes,function_clause,Acc2} ->
- case {Is,Line,St} of
- {[return|_],{line,Loc},#st{lbl=Fi,loc=Loc}} ->
- Instr = {jump,{f,Fi}},
- translate(Is, St, [Instr|Acc2]);
- {_,_,_} ->
- %% Not a call_only instruction, or not the same
- %% location information as in in the line instruction
- %% before the func_info instruction. Not safe
- %% to translate to a jump.
- translate(Is, St, [I|Acc0])
- end;
- {yes,Instr,Acc2} ->
- translate(Is, St, [Instr,Line|Acc2])
- end.
-
-dig_out(1, _Arity, Is) ->
- dig_out(Is);
-dig_out(2, Arity, Is) ->
- dig_out_fc(Arity, Is);
-dig_out(_, _, _) -> no.
-
-dig_out([{block,Bl0}|Is]) ->
- case dig_out_block(reverse(Bl0)) of
- no -> no;
- {yes,What,[]} ->
- {yes,What,Is};
- {yes,What,Bl} ->
- {yes,What,[{block,Bl}|Is]}
- end;
-dig_out(_) -> no.
-
-dig_out_block([{set,[{x,0}],[{atom,if_clause}],move}]) ->
- {yes,if_end,[]};
-dig_out_block([{set,[{x,0}],[{literal,{Exc,Value}}],move}|Is]) ->
- translate_exception(Exc, {literal,Value}, Is, 0);
-dig_out_block([{set,[{x,0}],[{atom,Exc},Value],put_tuple2}|Is]) ->
- translate_exception(Exc, Value, Is, 3);
-dig_out_block(_) -> no.
-
-translate_exception(badmatch, Val, Is, Words) ->
- {yes,{badmatch,Val},fix_block(Is, Words)};
-translate_exception(case_clause, Val, Is, Words) ->
- {yes,{case_end,Val},fix_block(Is, Words)};
-translate_exception(try_clause, Val, Is, Words) ->
- {yes,{try_case_end,Val},fix_block(Is, Words)};
-translate_exception(_, _, _, _) -> no.
-
-fix_block(Is, 0) ->
- reverse(Is);
-fix_block(Is, Words) ->
- reverse(fix_block_1(Is, Words)).
-
-fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed0,F3}}}|Is], Words) ->
- case Needed0 - Words of
- 0 ->
- Is;
- Needed ->
- true = Needed >= 0, %Assertion.
- [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is]
- end;
-fix_block_1([I|Is], Words) ->
- [I|fix_block_1(Is, Words)];
-fix_block_1([], _Words) ->
- %% Rare. The heap allocation was probably done by a binary
- %% construction instruction.
- [].
-
-dig_out_fc(Arity, Is0) ->
- Regs0 = maps:from_list([{{x,X},{arg,X}} || X <- seq(0, Arity-1)]),
- {Is,Acc0} = splitwith(fun({label,_}) -> false;
- ({test,_,_,_}) -> false;
- (_) -> true
- end, Is0),
- {Regs,Acc} = dig_out_fc_1(reverse(Is), Regs0, Acc0),
- case Regs of
- #{{x,0}:={atom,function_clause},{x,1}:=Args} ->
- case moves_from_stack(Args, 0, []) of
- {Moves,Arity} ->
- {yes,function_clause,reverse(Moves, Acc)};
- {_,_} ->
- no
- end;
- #{} ->
- no
- end.
-
-dig_out_fc_1([{block,Bl}|Is], Regs0, Acc) ->
- Regs = dig_out_fc_block(Bl, Regs0),
- dig_out_fc_1(Is, Regs, Acc);
-dig_out_fc_1([{bs_set_position,_,_}=I|Is], Regs, Acc) ->
- dig_out_fc_1(Is, Regs, [I|Acc]);
-dig_out_fc_1([{bs_get_tail,Src,Dst,Live0}|Is], Regs0, Acc) ->
- Regs = prune_xregs(Live0, Regs0),
- Live = dig_out_stack_live(Regs, Live0),
- I = {bs_get_tail,Src,Dst,Live},
- dig_out_fc_1(Is, Regs, [I|Acc]);
-dig_out_fc_1([_|_], _Regs, _Acc) ->
- {#{},[]};
-dig_out_fc_1([], Regs, Acc) ->
- {Regs,Acc}.
-
-dig_out_fc_block([{set,[],[],{alloc,Live,_}}|Is], Regs0) ->
- Regs = prune_xregs(Live, Regs0),
- dig_out_fc_block(Is, Regs);
-dig_out_fc_block([{set,[Dst],[Hd,Tl],put_list}|Is], Regs0) ->
- Regs = Regs0#{Dst=>{cons,get_reg(Hd, Regs0),get_reg(Tl, Regs0)}},
- dig_out_fc_block(Is, Regs);
-dig_out_fc_block([{set,[Dst],[Src],move}|Is], Regs0) ->
- Regs = Regs0#{Dst=>get_reg(Src, Regs0)},
- dig_out_fc_block(Is, Regs);
-dig_out_fc_block([{set,_,_,_}|_], _Regs) ->
- %% Unknown instruction. Fail.
- #{};
-dig_out_fc_block([], Regs) -> Regs.
-
-dig_out_stack_live(Regs, Default) ->
- Reg = {x,2},
- case Regs of
- #{Reg:=List} ->
- dig_out_stack_live_1(List, Default);
- #{} ->
- Default
- end.
-
-dig_out_stack_live_1({cons,{arg,N},T}, Live) ->
- dig_out_stack_live_1(T, max(N + 1, Live));
-dig_out_stack_live_1({cons,_,T}, Live) ->
- dig_out_stack_live_1(T, Live);
-dig_out_stack_live_1(nil, Live) ->
- Live;
-dig_out_stack_live_1(_, Live) -> Live.
-
-prune_xregs(Live, Regs) ->
- maps:filter(fun({x,X}, _) -> X < Live end, Regs).
-
-moves_from_stack({cons,{arg,N},_}, I, _Acc) when N =/= I ->
- %% Wrong argument. Give up.
- {[],-1};
-moves_from_stack({cons,H,T}, I, Acc) ->
- case H of
- {arg,I} ->
- moves_from_stack(T, I+1, Acc);
- _ ->
- moves_from_stack(T, I+1, [{move,H,{x,I}}|Acc])
- end;
-moves_from_stack(nil, I, Acc) ->
- {reverse(Acc),I};
-moves_from_stack({literal,[H|T]}, I, Acc) ->
- Cons = {cons,tag_literal(H),tag_literal(T)},
- moves_from_stack(Cons, I, Acc);
-moves_from_stack(_, _, _) ->
- %% Not understood. Give up.
- {[],-1}.
-
-
-get_reg(R, Regs) ->
- case Regs of
- #{R:=Val} -> Val;
- #{} -> R
- end.
-
-tag_literal([]) -> nil;
-tag_literal(T) when is_atom(T) -> {atom,T};
-tag_literal(T) when is_float(T) -> {float,T};
-tag_literal(T) when is_integer(T) -> {integer,T};
-tag_literal(T) -> {literal,T}.
diff --git a/lib/compiler/src/beam_ssa.erl b/lib/compiler/src/beam_ssa.erl
index a9977b0b1d..831e6489a9 100644
--- a/lib/compiler/src/beam_ssa.erl
+++ b/lib/compiler/src/beam_ssa.erl
@@ -79,7 +79,7 @@
-type var_base() :: atom() | non_neg_integer().
-type literal_value() :: atom() | integer() | float() | list() |
- nil() | tuple() | map() | binary().
+ nil() | tuple() | map() | binary() | fun().
-type op() :: {'bif',atom()} | {'float',float_op()} | prim_op() | cg_prim_op().
-type anno() :: #{atom() := any()}.
@@ -118,7 +118,7 @@
%% Primops only used internally during code generation.
-type cg_prim_op() :: 'bs_get' | 'bs_match_string' | 'bs_restore' | 'bs_skip' |
- 'copy' | 'put_tuple_arity' | 'put_tuple_element' |
+ 'copy' | 'match_fail' | 'put_tuple_arity' | 'put_tuple_element' |
'set_tuple_element'.
-import(lists, [foldl/3,keyfind/3,mapfoldl/3,member/2,reverse/1]).
diff --git a/lib/compiler/src/beam_ssa_codegen.erl b/lib/compiler/src/beam_ssa_codegen.erl
index 07f4c8b461..7248aca5f3 100644
--- a/lib/compiler/src/beam_ssa_codegen.erl
+++ b/lib/compiler/src/beam_ssa_codegen.erl
@@ -28,7 +28,7 @@
-include("beam_ssa.hrl").
--import(lists, [foldl/3,keymember/3,keysort/2,last/1,map/2,mapfoldl/3,
+-import(lists, [foldl/3,keymember/3,keysort/2,map/2,mapfoldl/3,
reverse/1,reverse/2,sort/1,splitwith/2,takewhile/2]).
-record(cg, {lcount=1 :: beam_label(), %Label counter
@@ -37,7 +37,8 @@
used_labels=gb_sets:empty() :: gb_sets:set(ssa_label()),
regs=#{} :: #{beam_ssa:var_name()=>ssa_register()},
ultimate_fail=1 :: beam_label(),
- catches=gb_sets:empty() :: gb_sets:set(ssa_label())
+ catches=gb_sets:empty() :: gb_sets:set(ssa_label()),
+ fc_label=1 :: beam_label()
}).
-spec module(beam_ssa:b_module(), [compile:option()]) ->
@@ -124,7 +125,7 @@ function(#b_function{anno=Anno,bs=Blocks}, AtomMod, St0) ->
Labels = (St4#cg.labels)#{0=>Entry,?BADARG_BLOCK=>0},
St5 = St4#cg{labels=Labels,used_labels=gb_sets:singleton(Entry),
ultimate_fail=Ult},
- {Body,St} = cg_fun(Blocks, St5),
+ {Body,St} = cg_fun(Blocks, St5#cg{fc_label=Fi}),
Asm = [{label,Fi},line(Anno),
{func_info,AtomMod,{atom,Name},Arity}] ++
add_parameter_annos(Body, Anno) ++
@@ -384,6 +385,7 @@ classify_heap_need(is_tagged_tuple) -> neutral;
classify_heap_need(kill_try_tag) -> gc;
classify_heap_need(landingpad) -> gc;
classify_heap_need(make_fun) -> gc;
+classify_heap_need(match_fail) -> gc;
classify_heap_need(new_try_tag) -> gc;
classify_heap_need(peek_message) -> gc;
classify_heap_need(put_map) -> gc;
@@ -1168,6 +1170,10 @@ cg_block([#cg_set{op=call}=I,
#cg_set{op=succeeded,dst=Bool}], {Bool,_Fail}, St) ->
%% A call in try/catch block.
cg_block([I], none, St);
+cg_block([#cg_set{op=match_fail}=I,
+ #cg_set{op=succeeded,dst=Bool}], {Bool,_Fail}, St) ->
+ %% A match_fail instruction in a try/catch block.
+ cg_block([I], none, St);
cg_block([#cg_set{op=get_map_element,dst=Dst0,args=Args0},
#cg_set{op=succeeded,dst=Bool}], {Bool,Fail0}, St) ->
[Dst,Map,Key] = beam_args([Dst0|Args0], St),
@@ -1229,6 +1235,28 @@ cg_block([#cg_set{op=copy}|_]=T0, Context, St0) ->
no ->
{Is,St}
end;
+cg_block([#cg_set{op=match_fail,args=Args0,anno=Anno}], none, St) ->
+ Args = beam_args(Args0, St),
+ Is = cg_match_fail(Args, line(Anno), none),
+ {Is,St};
+cg_block([#cg_set{op=match_fail,args=Args0,anno=Anno}|T], Context, St0) ->
+ FcLabel = case Context of
+ {return,_,none} ->
+ %% There is no stack frame. If this is a function_clause
+ %% exception, it is safe to jump to the label of the
+ %% func_info instruction.
+ St0#cg.fc_label;
+ _ ->
+ %% This is most probably not a function_clause.
+ %% If this is a function_clause exception
+ %% (rare), it is not safe to jump to the
+ %% func_info label.
+ none
+ end,
+ Args = beam_args(Args0, St0),
+ Is0 = cg_match_fail(Args, line(Anno), FcLabel),
+ {Is1,St} = cg_block(T, Context, St0),
+ {Is0++Is1,St};
cg_block([#cg_set{op=Op,dst=Dst0,args=Args0}=Set], none, St) ->
[Dst|Args] = beam_args([Dst0|Args0], St),
Is = cg_instr(Op, Args, Dst, Set),
@@ -1260,8 +1288,7 @@ cg_copy(T0, St) ->
end, T0),
Moves0 = cg_copy_1(Copies, St),
Moves1 = [Move || {move,Src,Dst}=Move <- Moves0, Src =/= Dst],
- Scratch = {x,1022},
- Moves = order_moves(Moves1, Scratch),
+ Moves = order_moves(Moves1),
{Moves,T}.
cg_copy_1([#cg_set{dst=Dst0,args=Args}|T], St) ->
@@ -1502,6 +1529,42 @@ cg_call(#cg_set{anno=Anno,op=call,dst=Dst0,args=Args0},
Is = setup_args(Args++[Func], Anno, Context, St) ++ Line ++ Call,
{Is,St}.
+cg_match_fail([{atom,function_clause}|Args], Line, Fc) ->
+ case Fc of
+ none ->
+ %% There is a stack frame (probably because of inlining).
+ %% Jumping to the func_info label is not allowed by
+ %% beam_validator. Rewrite the instruction as a call to
+ %% erlang:error/2.
+ make_fc(Args, Line);
+ _ ->
+ setup_args(Args) ++ [{jump,{f,Fc}}]
+ end;
+cg_match_fail([{atom,Op}], Line, _Fc) ->
+ [Line,Op];
+cg_match_fail([{atom,Op},Val], Line, _Fc) ->
+ [Line,{Op,Val}].
+
+make_fc(Args, Line) ->
+ %% Recreate the original call to erlang:error/2.
+ Live = foldl(fun({x,X}, A) -> max(X+1, A);
+ (_, A) -> A
+ end, 0, Args),
+ TmpReg = {x,Live},
+ StkMoves = build_stk(reverse(Args), TmpReg, nil),
+ [{test_heap,2*length(Args),Live}|StkMoves] ++
+ [{move,{atom,function_clause},{x,0}},
+ Line,
+ {call_ext,2,{extfunc,erlang,error,2}}].
+
+build_stk([V], _TmpReg, Tail) ->
+ [{put_list,V,Tail,{x,1}}];
+build_stk([V|Vs], TmpReg, Tail) ->
+ I = {put_list,V,Tail,TmpReg},
+ [I|build_stk(Vs, TmpReg, TmpReg)];
+build_stk([], _TmpReg, nil) ->
+ [{move,nil,{x,1}}].
+
build_call(call_fun, Arity, _Func, none, Dst) ->
[{call_fun,Arity}|copy({x,0}, Dst)];
build_call(call_fun, Arity, _Func, {return,Dst,N}, Dst) when is_integer(N) ->
@@ -1540,15 +1603,15 @@ build_apply(Arity, {return,Val,N}, _Dst) when is_integer(N) ->
build_apply(Arity, none, Dst) ->
[{apply,Arity}|copy({x,0}, Dst)].
-cg_instr(put_map, [{atom,assoc},SrcMap|Ss], Dst, Set) ->
- Live = get_live(Set),
- [{put_map_assoc,{f,0},SrcMap,Dst,Live,{list,Ss}}];
cg_instr(bs_get_tail, [Src], Dst, Set) ->
Live = get_live(Set),
[{bs_get_tail,Src,Dst,Live}];
cg_instr(bs_get_position, [Ctx], Dst, Set) ->
Live = get_live(Set),
[{bs_get_position,Ctx,Dst,Live}];
+cg_instr(put_map, [{atom,assoc},SrcMap|Ss], Dst, Set) ->
+ Live = get_live(Set),
+ [{put_map_assoc,{f,0},SrcMap,Dst,Live,{list,Ss}}];
cg_instr(Op, Args, Dst, _Set) ->
cg_instr(Op, Args, Dst).
@@ -1718,7 +1781,7 @@ cg_catch(Agg, T0, Context, St0) ->
cg_try(Agg, Tag, T0, Context, St0) ->
{Moves0,T1} = cg_extract(T0, Agg, St0),
- Moves = order_moves(Moves0, {x,3}),
+ Moves = order_moves(Moves0),
[#cg_set{op=kill_try_tag}|T2] = T1,
{T,St} = cg_block(T2, Context, St0),
{[{try_case,Tag}|Moves++T],St}.
@@ -1874,8 +1937,7 @@ setup_args([]) ->
[];
setup_args([_|_]=Args) ->
Moves = gen_moves(Args, 0, []),
- Scratch = {x,1+last(sort([length(Args)-1|[X || {x,X} <- Args]]))},
- order_moves(Moves, Scratch).
+ order_moves(Moves).
%% kill_yregs(Anno, #cg{}) -> [{kill,{y,Y}}].
%% Kill Y registers that will not be used again.
@@ -1895,47 +1957,48 @@ gen_moves([A|As], I, Acc) ->
gen_moves([], _, Acc) ->
keysort(3, Acc).
-%% order_moves([Move], ScratchReg) -> [Move]
+%% order_moves([Move]) -> [Move]
%% Orders move instruction so that source registers are not
%% destroyed before they are used. If there are cycles
%% (such as {move,{x,0},{x,1}}, {move,{x,1},{x,1}}),
-%% the scratch register is used to break up the cycle.
-%% If possible, the first move of the input list is placed
+%% swap instructions will be used to break up the cycle.
+%%
+%% If possible, the first move of the input list is placed
%% last in the result list (to make the move to {x,0} occur
%% just before the call to allow the Beam loader to coalesce
%% the instructions).
-order_moves(Ms, Scr) -> order_moves(Ms, Scr, []).
+order_moves(Ms) -> order_moves(Ms, []).
-order_moves([{move,_,_}=M|Ms0], ScrReg, Acc0) ->
- {Chain,Ms} = collect_chain(Ms0, [M], ScrReg),
+order_moves([{move,_,_}=M|Ms0], Acc0) ->
+ {Chain,Ms} = collect_chain(Ms0, [M]),
Acc = reverse(Chain, Acc0),
- order_moves(Ms, ScrReg, Acc);
-order_moves([], _, Acc) -> Acc.
+ order_moves(Ms, Acc);
+order_moves([], Acc) -> Acc.
-collect_chain(Ms, Path, ScrReg) ->
- collect_chain(Ms, Path, [], ScrReg).
+collect_chain(Ms, Path) ->
+ collect_chain(Ms, Path, []).
-collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others, ScrReg) ->
+collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others) ->
case keymember(Src, 3, Path) of
false ->
- collect_chain(reverse(Others, Ms0), [M|Path], [], ScrReg);
+ collect_chain(reverse(Others, Ms0), [M|Path], []);
true ->
- %% There is a cycle, which we must break up.
- {break_up_cycle(M, Path, ScrReg),reverse(Others, Ms0)}
+ %% There is a cycle.
+ {break_up_cycle(M, Path),reverse(Others, Ms0)}
end;
-collect_chain([M|Ms], Path, Others, ScrReg) ->
- collect_chain(Ms, Path, [M|Others], ScrReg);
-collect_chain([], Path, Others, _) ->
+collect_chain([M|Ms], Path, Others) ->
+ collect_chain(Ms, Path, [M|Others]);
+collect_chain([], Path, Others) ->
{Path,Others}.
-break_up_cycle({move,Src,_}=M, Path, ScrReg) ->
- [{move,ScrReg,Src},M|break_up_cycle1(Src, Path, ScrReg)].
+break_up_cycle({move,Src,_Dst}=M, Path) ->
+ break_up_cycle_1(Src, [M|Path], []).
-break_up_cycle1(Dst, [{move,Src,Dst}|Path], ScrReg) ->
- [{move,Src,ScrReg}|Path];
-break_up_cycle1(Dst, [M|Path], LastMove) ->
- [M|break_up_cycle1(Dst, Path, LastMove)].
+break_up_cycle_1(Dst, [{move,_Src,Dst}|Path], Acc) ->
+ reverse(Acc, Path);
+break_up_cycle_1(Dst, [{move,S,D}|Path], Acc) ->
+ break_up_cycle_1(Dst, Path, [{swap,S,D}|Acc]).
%%%
%%% General utility functions.
diff --git a/lib/compiler/src/beam_ssa_dead.erl b/lib/compiler/src/beam_ssa_dead.erl
index 64b9b3e222..88767456a3 100644
--- a/lib/compiler/src/beam_ssa_dead.erl
+++ b/lib/compiler/src/beam_ssa_dead.erl
@@ -730,8 +730,8 @@ will_succeed_1('=/=', A, '=:=', B) when A =:= B -> no;
will_succeed_1('<', A, '=:=', B) when B >= A -> no;
will_succeed_1('<', A, '=/=', B) when B >= A -> yes;
will_succeed_1('<', A, '<', B) when B >= A -> yes;
-will_succeed_1('<', A, '=<', B) when B > A -> yes;
-will_succeed_1('<', A, '>=', B) when B > A -> no;
+will_succeed_1('<', A, '=<', B) when B >= A -> yes;
+will_succeed_1('<', A, '>=', B) when B >= A -> no;
will_succeed_1('<', A, '>', B) when B >= A -> no;
will_succeed_1('=<', A, '=:=', B) when B > A -> no;
@@ -751,9 +751,9 @@ will_succeed_1('>=', A, '>', B) when B < A -> yes;
will_succeed_1('>', A, '=:=', B) when B =< A -> no;
will_succeed_1('>', A, '=/=', B) when B =< A -> yes;
will_succeed_1('>', A, '<', B) when B =< A -> no;
-will_succeed_1('>', A, '=<', B) when B < A -> no;
+will_succeed_1('>', A, '=<', B) when B =< A -> no;
will_succeed_1('>', A, '>=', B) when B =< A -> yes;
-will_succeed_1('>', A, '>', B) when B < A -> yes;
+will_succeed_1('>', A, '>', B) when B =< A -> yes;
will_succeed_1('==', A, '==', B) ->
if
diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl
index 90c0d3cf16..0c8cefe74d 100644
--- a/lib/compiler/src/beam_ssa_opt.erl
+++ b/lib/compiler/src/beam_ssa_opt.erl
@@ -157,6 +157,8 @@ repeated_passes(Opts) ->
?PASS(ssa_opt_dead),
?PASS(ssa_opt_cse),
?PASS(ssa_opt_tail_phis),
+ ?PASS(ssa_opt_tuple_size),
+ ?PASS(ssa_opt_record),
?PASS(ssa_opt_type_continue)], %Must run after ssa_opt_dead to
%clean up phi nodes.
passes_1(Ps, Opts).
diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl
index 9af72afca7..a5fcb91cc0 100644
--- a/lib/compiler/src/beam_ssa_pre_codegen.erl
+++ b/lib/compiler/src/beam_ssa_pre_codegen.erl
@@ -108,7 +108,8 @@ functions([], _Ps, _UseBSM3) -> [].
intervals=[] :: [{b_var(),[range()]}],
res=[] :: [{b_var(),reservation()}] | #{b_var():=reservation()},
regs=#{} :: #{b_var():=ssa_register()},
- extra_annos=[] :: [{atom(),term()}]
+ extra_annos=[] :: [{atom(),term()}],
+ location :: term()
}).
-define(PASS(N), {N,fun N/1}).
@@ -120,6 +121,7 @@ passes(Opts) ->
%% Preliminaries.
?PASS(fix_bs),
?PASS(sanitize),
+ ?PASS(match_fail_instructions),
case FixTuples of
false -> ignore;
true -> ?PASS(fix_tuples)
@@ -162,7 +164,9 @@ passes(Opts) ->
function(#b_function{anno=Anno,args=Args,bs=Blocks0,cnt=Count0}=F0,
Ps, UseBSM3) ->
try
- St0 = #st{ssa=Blocks0,args=Args,use_bsm3=UseBSM3,cnt=Count0},
+ Location = maps:get(location, Anno, none),
+ St0 = #st{ssa=Blocks0,args=Args,use_bsm3=UseBSM3,
+ cnt=Count0,location=Location},
St = compile:run_sub_passes(Ps, St0),
#st{ssa=Blocks,cnt=Count,regs=Regs,extra_annos=ExtraAnnos} = St,
F1 = add_extra_annos(F0, ExtraAnnos),
@@ -854,6 +858,114 @@ prune_phi(#b_set{args=Args0}=Phi, Reachable) ->
gb_sets:is_element(Pred, Reachable)],
Phi#b_set{args=Args}.
+%%% Rewrite certain calls to erlang:error/{1,2} to specialized
+%%% instructions:
+%%%
+%%% erlang:error({badmatch,Value}) => badmatch Value
+%%% erlang:error({case_clause,Value}) => case_end Value
+%%% erlang:error({try_clause,Value}) => try_case_end Value
+%%% erlang:error(if_clause) => if_end
+%%% erlang:error(function_clause, Args) => jump FuncInfoLabel
+%%%
+%%% In SSA code, we represent those instructions as a 'match_fail'
+%%% instruction with the name of the BEAM instruction as the first
+%%% argument.
+
+match_fail_instructions(#st{ssa=Blocks0,args=Args,location=Location}=St) ->
+ Ls = maps:to_list(Blocks0),
+ Info = {length(Args),Location},
+ Blocks = match_fail_instrs_1(Ls, Info, Blocks0),
+ St#st{ssa=Blocks}.
+
+match_fail_instrs_1([{L,#b_blk{is=Is0}=Blk}|Bs], Arity, Blocks0) ->
+ case match_fail_instrs_blk(Is0, Arity, []) of
+ none ->
+ match_fail_instrs_1(Bs, Arity, Blocks0);
+ Is ->
+ Blocks = Blocks0#{L:=Blk#b_blk{is=Is}},
+ match_fail_instrs_1(Bs, Arity, Blocks)
+ end;
+match_fail_instrs_1([], _Arity, Blocks) -> Blocks.
+
+match_fail_instrs_blk([#b_set{op=put_tuple,dst=Dst,
+ args=[#b_literal{val=Tag},Val]},
+ #b_set{op=call,
+ args=[#b_remote{mod=#b_literal{val=erlang},
+ name=#b_literal{val=error}},
+ Dst]}=Call|Is],
+ _Arity, Acc) ->
+ match_fail_instr(Call, Tag, Val, Is, Acc);
+match_fail_instrs_blk([#b_set{op=call,
+ args=[#b_remote{mod=#b_literal{val=erlang},
+ name=#b_literal{val=error}},
+ #b_literal{val={Tag,Val}}]}=Call|Is],
+ _Arity, Acc) ->
+ match_fail_instr(Call, Tag, #b_literal{val=Val}, Is, Acc);
+match_fail_instrs_blk([#b_set{op=call,
+ args=[#b_remote{mod=#b_literal{val=erlang},
+ name=#b_literal{val=error}},
+ #b_literal{val=if_clause}]}=Call|Is],
+ _Arity, Acc) ->
+ I = Call#b_set{op=match_fail,args=[#b_literal{val=if_end}]},
+ reverse(Acc, [I|Is]);
+match_fail_instrs_blk([#b_set{op=call,anno=Anno,
+ args=[#b_remote{mod=#b_literal{val=erlang},
+ name=#b_literal{val=error}},
+ #b_literal{val=function_clause},
+ Stk]}=Call],
+ {Arity,Location}, Acc) ->
+ case match_fail_stk(Stk, Acc, [], []) of
+ {[_|_]=Vars,Is} when length(Vars) =:= Arity ->
+ case maps:get(location, Anno, none) of
+ Location ->
+ I = Call#b_set{op=match_fail,
+ args=[#b_literal{val=function_clause}|Vars]},
+ Is ++ [I];
+ _ ->
+ %% erlang:error/2 has a different location than the
+ %% func_info instruction at the beginning of the function
+ %% (probably because of inlining). Keep the original call.
+ reverse(Acc, [Call])
+ end;
+ _ ->
+ %% Either the stacktrace could not be picked apart (for example,
+ %% if the call to erlang:error/2 was handwritten) or the number
+ %% of arguments in the stacktrace was different from the arity
+ %% of the host function (because it is the implementation of a
+ %% fun). Keep the original call.
+ reverse(Acc, [Call])
+ end;
+match_fail_instrs_blk([I|Is], Arity, Acc) ->
+ match_fail_instrs_blk(Is, Arity, [I|Acc]);
+match_fail_instrs_blk(_, _, _) ->
+ none.
+
+match_fail_instr(Call, Tag, Val, Is, Acc) ->
+ Op = case Tag of
+ badmatch -> Tag;
+ case_clause -> case_end;
+ try_clause -> try_case_end;
+ _ -> none
+ end,
+ case Op of
+ none ->
+ none;
+ _ ->
+ I = Call#b_set{op=match_fail,args=[#b_literal{val=Op},Val]},
+ reverse(Acc, [I|Is])
+ end.
+
+match_fail_stk(#b_var{}=V, [#b_set{op=put_list,dst=V,args=[H,T]}|Is], IAcc, VAcc) ->
+ match_fail_stk(T, Is, IAcc, [H|VAcc]);
+match_fail_stk(#b_literal{val=[H|T]}, Is, IAcc, VAcc) ->
+ match_fail_stk(#b_literal{val=T}, Is, IAcc, [#b_literal{val=H}|VAcc]);
+match_fail_stk(#b_literal{val=[]}, [], IAcc, VAcc) ->
+ {reverse(VAcc),IAcc};
+match_fail_stk(T, [#b_set{op=Op}=I|Is], IAcc, VAcc)
+ when Op =:= bs_get_tail; Op =:= bs_set_position ->
+ match_fail_stk(T, Is, [I|IAcc], VAcc);
+match_fail_stk(_, _, _, _) -> none.
+
%%%
%%% Fix tuples.
%%%
diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl
index 57fd7fec60..f1c0030b3c 100644
--- a/lib/compiler/src/beam_ssa_type.erl
+++ b/lib/compiler/src/beam_ssa_type.erl
@@ -41,8 +41,9 @@
%% Records that represent type information.
-record(t_atom, {elements=any :: 'any' | [atom()]}).
--record(t_integer, {elements=any :: 'any' | {integer(),integer()}}).
-record(t_bs_match, {type :: type()}).
+-record(t_fun, {arity=any :: arity() | 'any'}).
+-record(t_integer, {elements=any :: 'any' | {integer(),integer()}}).
-record(t_tuple, {size=0 :: integer(),
exact=false :: boolean(),
%% Known element types (1-based index), unknown elements are
@@ -50,8 +51,9 @@
elements=#{} :: #{ non_neg_integer() => type() }}).
-type type() :: 'any' | 'none' |
- #t_atom{} | #t_integer{} | #t_bs_match{} | #t_tuple{} |
- {'binary',pos_integer()} | 'cons' | 'float' | 'list' | 'map' | 'nil' | 'number'.
+ #t_atom{} | #t_bs_match{} | #t_fun{} | #t_integer{} | #t_tuple{} |
+ {'binary',pos_integer()} | 'cons' | 'float' |
+ 'list' | 'map' | 'nil' | 'number'.
-type type_db() :: #{beam_ssa:var_name():=type()}.
-spec opt_start(Linear, Args, Anno, FuncDb) -> {Linear, FuncDb} when
@@ -157,21 +159,29 @@ opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo)
map_size(TypeMap) =:= 0 ->
opt_finish_1(Args, TypeMaps, ParamInfo);
opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo0) ->
- case join(maps:values(TypeMap)) of
+ JoinedType0 = verified_type(join(maps:values(TypeMap))),
+ case validator_anno(JoinedType0) of
any ->
opt_finish_1(Args, TypeMaps, ParamInfo0);
JoinedType ->
- JoinedType = verified_type(JoinedType),
- ParamInfo = ParamInfo0#{ Arg => validator_anno(JoinedType) },
+ ParamInfo = ParamInfo0#{ Arg => JoinedType },
opt_finish_1(Args, TypeMaps, ParamInfo)
end;
opt_finish_1([], [], ParamInfo) ->
ParamInfo.
+validator_anno(any) ->
+ any;
+validator_anno(#t_fun{}) ->
+ %% There is no need make funs visible to beam_validator.
+ any;
validator_anno(#t_tuple{size=Size,exact=Exact,elements=Elements0}) ->
- Elements = maps:fold(fun(Index, Type, Acc) ->
+ Elements = maps:fold(fun(Index, Type0, Acc) ->
Key = beam_validator:type_anno(integer, Index),
- Acc#{ Key => validator_anno(Type) }
+ case validator_anno(Type0) of
+ any -> Acc;
+ Type -> Acc#{Key=>Type}
+ end
end, #{}, Elements0),
beam_validator:type_anno(tuple, Size, Exact, Elements);
validator_anno(#t_integer{elements={Same,Same}}) ->
@@ -413,6 +423,11 @@ simplify_remote_call(Mod, Name, Args0, I) ->
end
end.
+opt_call(#b_set{dst=Dst,args=[#b_var{}=Fun|Args]}=I, _D, Ts0, Ds0, Fdb) ->
+ Type = #t_fun{arity=length(Args)},
+ Ts = Ts0#{ Fun => Type, Dst => any },
+ Ds = Ds0#{ Dst => I },
+ {Ts, Ds, Fdb, I};
opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, D, Ts0, Ds0, Fdb0) ->
{Ts, Ds, I} = opt_local_call(I0, Ts0, Ds0, Fdb0),
case Fdb0 of
@@ -440,9 +455,15 @@ opt_local_call(#b_set{dst=Dst,args=[Id|_]}=I0, Ts0, Ds0, Fdb) ->
#{} -> any
end,
I = case Type of
- any -> I0;
- none -> I0;
- _ -> beam_ssa:add_anno(result_type, validator_anno(Type), I0)
+ none ->
+ I0;
+ _ ->
+ case validator_anno(Type) of
+ any ->
+ I0;
+ ValidatorType ->
+ beam_ssa:add_anno(result_type, ValidatorType, I0)
+ end
end,
Ts = Ts0#{ Dst => Type },
Ds = Ds0#{ Dst => I },
@@ -519,19 +540,36 @@ simplify(#b_set{op={bif,tuple_size},args=[Term]}=I, Ts) ->
_ ->
I
end;
-simplify(#b_set{op={bif,'=='},args=Args}=I, Ts) ->
+simplify(#b_set{op={bif,is_function},args=[Fun,#b_literal{val=Arity}]}=I, Ts)
+ when is_integer(Arity), Arity >= 0 ->
+ case get_type(Fun, Ts) of
+ #t_fun{arity=any} ->
+ I;
+ #t_fun{arity=Arity} ->
+ #b_literal{val=true};
+ any ->
+ I;
+ _ ->
+ #b_literal{val=false}
+ end;
+simplify(#b_set{op={bif,Op0},args=Args}=I, Ts) when Op0 =:= '=='; Op0 =:= '/=' ->
Types = get_types(Args, Ts),
- EqEq = case {meet(Types),join(Types)} of
- {none,any} -> true;
- {#t_integer{},#t_integer{}} -> true;
- {float,float} -> true;
- {{binary,_},_} -> true;
- {#t_atom{},_} -> true;
- {_,_} -> false
- end,
+ EqEq0 = case {meet(Types),join(Types)} of
+ {none,any} -> true;
+ {#t_integer{},#t_integer{}} -> true;
+ {float,float} -> true;
+ {{binary,_},_} -> true;
+ {#t_atom{},_} -> true;
+ {_,_} -> false
+ end,
+ EqEq = EqEq0 orelse any_non_numeric_argument(Args, Ts),
case EqEq of
true ->
- simplify(I#b_set{op={bif,'=:='}}, Ts);
+ Op = case Op0 of
+ '==' -> '=:=';
+ '/=' -> '=/='
+ end,
+ simplify(I#b_set{op={bif,Op}}, Ts);
false ->
eval_bif(I, Ts)
end;
@@ -547,6 +585,17 @@ simplify(#b_set{op={bif,'=:='},args=[A1,_A2]=Args}=I, Ts) ->
{true,#t_atom{elements=[true]}} ->
%% Bool =:= true ==> Bool
A1;
+ {true,#t_atom{elements=[false]}} ->
+ %% Bool =:= false ==> not Bool
+ %%
+ %% This will be further optimized to eliminate the
+ %% 'not', swapping the success and failure
+ %% branches in the br instruction. If A1 comes
+ %% from a type test (such as is_atom/1) or a
+ %% comparison operator (such as >=) that can be
+ %% translated to test instruction, this
+ %% optimization will eliminate one instruction.
+ simplify(I#b_set{op={bif,'not'},args=[A1]}, Ts);
{_,_} ->
eval_bif(I, Ts)
end
@@ -597,6 +646,44 @@ simplify(#b_set{op=wait_timeout,args=[#b_literal{val=infinity}]}=I, _Ts) ->
I#b_set{op=wait,args=[]};
simplify(I, _Ts) -> I.
+any_non_numeric_argument([#b_literal{val=Lit}|_], _Ts) ->
+ is_non_numeric(Lit);
+any_non_numeric_argument([#b_var{}=V|T], Ts) ->
+ is_non_numeric_type(get_type(V, Ts)) orelse any_non_numeric_argument(T, Ts);
+any_non_numeric_argument([], _Ts) -> false.
+
+is_non_numeric([H|T]) ->
+ is_non_numeric(H) andalso is_non_numeric(T);
+is_non_numeric(Tuple) when is_tuple(Tuple) ->
+ is_non_numeric_tuple(Tuple, tuple_size(Tuple));
+is_non_numeric(Map) when is_map(Map) ->
+ %% Note that 17.x and 18.x compare keys in different ways.
+ %% Be very conservative -- require that both keys and values
+ %% are non-numeric.
+ is_non_numeric(maps:to_list(Map));
+is_non_numeric(Num) when is_number(Num) ->
+ false;
+is_non_numeric(_) -> true.
+
+is_non_numeric_tuple(Tuple, El) when El >= 1 ->
+ is_non_numeric(element(El, Tuple)) andalso
+ is_non_numeric_tuple(Tuple, El-1);
+is_non_numeric_tuple(_Tuple, 0) -> true.
+
+is_non_numeric_type(#t_atom{}) -> true;
+is_non_numeric_type({binary,_}) -> true;
+is_non_numeric_type(nil) -> true;
+is_non_numeric_type(#t_tuple{size=Size,exact=true,elements=Types})
+ when map_size(Types) =:= Size ->
+ is_non_numeric_tuple_type(Size, Types);
+is_non_numeric_type(_) -> false.
+
+is_non_numeric_tuple_type(0, _Types) ->
+ true;
+is_non_numeric_tuple_type(Pos, Types) ->
+ is_non_numeric_type(map_get(Pos, Types)) andalso
+ is_non_numeric_tuple_type(Pos - 1, Types).
+
make_literal_list(Args) ->
make_literal_list(Args, []).
@@ -859,6 +946,13 @@ type(bs_get_tail, _Args, _Ts, _Ds) ->
type(call, [#b_remote{mod=#b_literal{val=Mod},
name=#b_literal{val=Name}}|Args], Ts, _Ds) ->
case {Mod,Name,Args} of
+ {erlang,make_fun,[_,_,Arity0]} ->
+ case Arity0 of
+ #b_literal{val=Arity} when is_integer(Arity), Arity >= 0 ->
+ #t_fun{arity=Arity};
+ _ ->
+ #t_fun{}
+ end;
{erlang,setelement,[Pos,Tuple,Arg]} ->
case {get_type(Pos, Ts),get_type(Tuple, Ts)} of
{#t_integer{elements={Index,Index}},
@@ -931,6 +1025,8 @@ type(is_nonempty_list, [_], _Ts, _Ds) ->
t_boolean();
type(is_tagged_tuple, [_,#b_literal{},#b_literal{}], _Ts, _Ds) ->
t_boolean();
+type(make_fun, [#b_local{arity=TotalArity}|Env], _Ts, _Ds) ->
+ #t_fun{arity=TotalArity-length(Env)};
type(put_map, _Args, _Ts, _Ds) ->
map;
type(put_list, _Args, _Ts, _Ds) ->
@@ -1112,6 +1208,11 @@ will_succeed(is_float, Type) ->
number -> maybe;
_ -> no
end;
+will_succeed(is_function, Type) ->
+ case Type of
+ #t_fun{} -> yes;
+ _ -> no
+ end;
will_succeed(is_integer, Type) ->
case Type of
#t_integer{} -> yes;
@@ -1351,6 +1452,9 @@ get_type(#b_literal{val=Val}, _Ts) ->
t_atom(Val);
is_float(Val) ->
float;
+ is_function(Val) ->
+ {arity,Arity} = erlang:fun_info(Val, arity),
+ #t_fun{arity=Arity};
is_integer(Val) ->
t_integer(Val);
is_list(Val), Val =/= [] ->
@@ -1744,6 +1848,7 @@ join(#t_atom{elements=any}=T, #t_atom{elements=[_|_]}) -> T;
join(#t_atom{elements=[_|_]}, #t_atom{elements=any}=T) -> T;
join({binary,U1}, {binary,U2}) ->
{binary,gcd(U1, U2)};
+join(#t_fun{}, #t_fun{}) -> #t_fun{};
join(#t_integer{}, #t_integer{}) -> t_integer();
join(list, cons) -> list;
join(cons, list) -> list;
@@ -1861,6 +1966,10 @@ meet(#t_atom{elements=[_|_]}=T, #t_atom{elements=any}) ->
T;
meet(#t_atom{elements=any}, #t_atom{elements=[_|_]}=T) ->
T;
+meet(#t_fun{arity=any}, #t_fun{}=T) ->
+ T;
+meet(#t_fun{}=T, #t_fun{arity=any}) ->
+ T;
meet(#t_integer{elements={_,_}}=T, #t_integer{elements=any}) ->
T;
meet(#t_integer{elements=any}, #t_integer{elements={_,_}}=T) ->
@@ -1950,6 +2059,7 @@ verified_type(none=T) -> T;
verified_type(#t_atom{elements=any}=T) -> T;
verified_type(#t_atom{elements=[_|_]}=T) -> T;
verified_type({binary,U}=T) when is_integer(U) -> T;
+verified_type(#t_fun{arity=Arity}=T) when Arity =:= any; is_integer(Arity) -> T;
verified_type(#t_integer{elements=any}=T) -> T;
verified_type(#t_integer{elements={Min,Max}}=T)
when is_integer(Min), is_integer(Max) -> T;
diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl
index acf3838da4..ad8839cc7d 100644
--- a/lib/compiler/src/beam_trim.erl
+++ b/lib/compiler/src/beam_trim.erl
@@ -244,6 +244,9 @@ remap([{make_fun2,_,_,_,_}=I|T], Map, Acc) ->
remap([{deallocate,N}|Is], Map, Acc) ->
I = {deallocate,Map({frame_size,N})},
remap(Is, Map, [I|Acc]);
+remap([{swap,Reg1,Reg2}|Is], Map, Acc) ->
+ I = {swap,Map(Reg1),Map(Reg2)},
+ remap(Is, Map, [I|Acc]);
remap([{test,Name,Fail,Ss}|Is], Map, Acc) ->
I = {test,Name,Fail,[Map(S) || S <- Ss]},
remap(Is, Map, [I|Acc]);
@@ -382,6 +385,8 @@ frame_size([{bs_set_position,_,_}|Is], Safe) ->
frame_size(Is, Safe);
frame_size([{bs_get_tail,_,_,_}|Is], Safe) ->
frame_size(Is, Safe);
+frame_size([{swap,_,_}|Is], Safe) ->
+ frame_size(Is, Safe);
frame_size(_, _) -> throw(not_possible).
frame_size_branch(0, Is, Safe) ->
@@ -444,6 +449,8 @@ is_not_used(Y, [{line,_}|Is]) ->
is_not_used(Y, Is);
is_not_used(Y, [{make_fun2,_,_,_,_}|Is]) ->
is_not_used(Y, Is);
+is_not_used(Y, [{swap,Reg1,Reg2}|Is]) ->
+ Y =/= Reg1 andalso Y =/= Reg2 andalso is_not_used(Y, Is);
is_not_used(Y, [{test,_,_,Ss}|Is]) ->
not member(Y, Ss) andalso is_not_used(Y, Is);
is_not_used(Y, [{test,_Op,{f,_},_Live,Ss,Dst}|Is]) ->
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index ebe9631e09..717ea17475 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -200,7 +200,7 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
numy=none :: none | undecided | index(),
%% Available heap size.
h=0,
- %Available heap size for floats.
+ %%Available heap size for floats.
hf=0,
%% Floating point state.
fls=undefined,
@@ -240,7 +240,7 @@ index_parameter_types([{function,_,_,Entry,Code0}|Fs], Acc0) ->
Acc = index_parameter_types_1(Is, Entry, Acc0),
index_parameter_types(Fs, Acc);
_ ->
- %% Something serious is wrong. Ignore it for now.
+ %% Something is seriously wrong. Ignore it for now.
%% It will be detected and diagnosed later.
index_parameter_types(Fs, Acc0)
end;
@@ -392,6 +392,23 @@ valfun_1(build_stacktrace=I, Vst) ->
call(I, 1, Vst);
valfun_1({move,Src,Dst}, Vst) ->
assign(Src, Dst, Vst);
+valfun_1({swap,RegA,RegB}, Vst0) ->
+ assert_movable(RegA, Vst0),
+ assert_movable(RegB, Vst0),
+
+ %% We don't expect fragile registers to be swapped.
+ %% Therefore, we can conservatively make both registers
+ %% fragile if one of the register is fragile instead of
+ %% swapping the fragility of the registers.
+ Sources = [RegA,RegB],
+ Vst1 = propagate_fragility(RegA, Sources, Vst0),
+ Vst2 = propagate_fragility(RegB, Sources, Vst1),
+
+ %% Swap the value references.
+ VrefA = get_reg_vref(RegA, Vst2),
+ VrefB = get_reg_vref(RegB, Vst2),
+ Vst = set_reg_vref(VrefB, RegA, Vst2),
+ set_reg_vref(VrefA, RegB, Vst);
valfun_1({fmove,Src,{fr,_}=Dst}, Vst) ->
assert_type(float, Src, Vst),
set_freg(Dst, Vst);
@@ -1848,16 +1865,9 @@ get_reg_vref({y,_}=Src, #vst{current=#st{ys=Ys}}) ->
end.
set_type(Type, #value_ref{}=Ref, #vst{current=#st{vs=Vs0}=St}=Vst) ->
- case Vs0 of
- #{ Ref := #value{}=Entry } ->
- Vs = Vs0#{ Ref => Entry#value{type=Type} },
- Vst#vst{current=St#st{vs=Vs}};
- #{} ->
- %% Dead references may happen during type inference and are not an
- %% error in and of themselves. If a problem were to arise from this
- %% it'll explode elsewhere.
- Vst
- end.
+ #{ Ref := #value{}=Entry } = Vs0,
+ Vs = Vs0#{ Ref => Entry#value{type=Type} },
+ Vst#vst{current=St#st{vs=Vs}}.
new_value(Type, Op, Ss, #vst{current=#st{vs=Vs0}=St,ref_ctr=Counter}=Vst) ->
Ref = #value_ref{id=Counter},
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 28db8986ff..e5e63341b7 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -265,7 +265,9 @@ expand_opt(r19, Os) ->
expand_opt(r20, Os) ->
expand_opt_before_21(Os);
expand_opt(r21, Os) ->
- [no_put_tuple2 | expand_opt(no_bsm3, Os)];
+ [no_swap, no_put_tuple2 | expand_opt(no_bsm3, Os)];
+expand_opt(r22, Os) ->
+ [no_swap | Os];
expand_opt({debug_info_key,_}=O, Os) ->
[encrypt_debug_info,O|Os];
expand_opt(no_type_opt, Os) ->
@@ -275,7 +277,7 @@ expand_opt(no_type_opt, Os) ->
expand_opt(O, Os) -> [O|Os].
expand_opt_before_21(Os) ->
- [no_put_tuple2, no_get_hd_tl, no_ssa_opt_record,
+ [no_swap, no_put_tuple2, no_get_hd_tl, no_ssa_opt_record,
no_utf8_atoms | expand_opt(no_bsm3, Os)].
%% format_error(ErrorDescriptor) -> string()
@@ -860,8 +862,6 @@ asm_passes() ->
{unless,no_postopt,
[{pass,beam_block},
{iff,dblk,{listing,"block"}},
- {unless,no_except,{pass,beam_except}},
- {iff,dexcept,{listing,"except"}},
{unless,no_jopt,{pass,beam_jump}},
{iff,djmp,{listing,"jump"}},
{unless,no_peep_opt,{pass,beam_peep}},
@@ -2095,7 +2095,6 @@ pre_load() ->
beam_block,
beam_clean,
beam_dict,
- beam_except,
beam_flatten,
beam_jump,
beam_kernel_to_ssa,
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index a086a3a8d3..9dc3b6e339 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -27,7 +27,6 @@
beam_clean,
beam_dict,
beam_disasm,
- beam_except,
beam_flatten,
beam_jump,
beam_kernel_to_ssa,
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index 86590fad87..03507bafb3 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -596,3 +596,7 @@ BEAM_FORMAT_NUMBER=0
## @spec bs_set_positon Ctx Pos
## @doc Sets the current position of Ctx to Pos
168: bs_set_position/2
+
+## @spec swap Register1 Register2
+## @doc Swaps the contents of two registers.
+169: swap/2
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 4939a94a92..63c67639d4 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -99,10 +99,6 @@
t=#{} :: map(), %Types
in_guard=false}). %In guard or not.
--type type_info() :: cerl:cerl() | 'bool' | 'integer' | {'fun', pos_integer()}.
--type yes_no_maybe() :: 'yes' | 'no' | 'maybe'.
--type sub() :: #sub{}.
-
-spec module(cerl:c_module(), [compile:option()]) ->
{'ok', cerl:c_module(), [_]}.
@@ -315,10 +311,10 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) ->
false ->
%% Arg cannot be "values" here - only a single value
%% make sense here.
- case {Ctxt,is_safe_simple(Arg, Sub)} of
+ case {Ctxt,is_safe_simple(Arg)} of
{effect,true} -> B1;
{effect,false} ->
- case is_safe_simple(B1, Sub) of
+ case is_safe_simple(B1) of
true -> Arg;
false -> Seq0#c_seq{arg=Arg,body=B1}
end;
@@ -442,7 +438,7 @@ expr(#c_catch{anno=Anno,body=B}, effect, Sub) ->
expr(#c_catch{body=B0}=Catch, _, Sub) ->
%% We can remove catch if the value is simple
B1 = body(B0, value, Sub),
- case is_safe_simple(B1, Sub) of
+ case is_safe_simple(B1) of
true -> B1;
false -> Catch#c_catch{body=B1}
end;
@@ -458,7 +454,7 @@ expr(#c_try{arg=E0,vars=[#c_var{name=X}],body=#c_var{name=X},
%% We can remove try/catch if the expression is an
%% expression that cannot fail.
- case is_safe_bool_expr(E2, Sub) orelse is_safe_simple(E2, Sub) of
+ case is_safe_bool_expr(E2) orelse is_safe_simple(E2) of
true -> E2;
false -> Try#c_try{arg=E2}
end;
@@ -472,7 +468,7 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0)
E1 = body(E0, value, Sub0),
{Vs1,Sub1} = var_list(Vs0, Sub0),
B1 = body(B0, value, Sub1),
- case is_safe_simple(E1, Sub0) of
+ case is_safe_simple(E1) of
true ->
expr(#c_let{anno=A,vars=Vs1,arg=E1,body=B1}, value, Sub0);
false ->
@@ -602,20 +598,20 @@ is_literal_fun(_) -> false.
%% Currently, we don't attempt to check binaries because they
%% are difficult to check.
-is_safe_simple(#c_var{}=Var, _) ->
+is_safe_simple(#c_var{}=Var) ->
not cerl:is_c_fname(Var);
-is_safe_simple(#c_cons{hd=H,tl=T}, Sub) ->
- is_safe_simple(H, Sub) andalso is_safe_simple(T, Sub);
-is_safe_simple(#c_tuple{es=Es}, Sub) -> is_safe_simple_list(Es, Sub);
-is_safe_simple(#c_literal{}, _) -> true;
+is_safe_simple(#c_cons{hd=H,tl=T}) ->
+ is_safe_simple(H) andalso is_safe_simple(T);
+is_safe_simple(#c_tuple{es=Es}) -> is_safe_simple_list(Es);
+is_safe_simple(#c_literal{}) -> true;
is_safe_simple(#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=Name},
- args=Args}, Sub) when is_atom(Name) ->
+ args=Args}) when is_atom(Name) ->
NumArgs = length(Args),
case erl_internal:bool_op(Name, NumArgs) of
true ->
%% Boolean operators are safe if the arguments are boolean.
- all(fun(C) -> is_boolean_type(C, Sub) =:= yes end, Args);
+ all(fun is_bool_expr/1, Args);
false ->
%% We need a rather complicated test to ensure that
%% we only allow safe calls that are allowed in a guard.
@@ -624,9 +620,9 @@ is_safe_simple(#c_call{module=#c_literal{val=erlang},
(erl_internal:comp_op(Name, NumArgs) orelse
erl_internal:new_type_test(Name, NumArgs))
end;
-is_safe_simple(_, _) -> false.
+is_safe_simple(_) -> false.
-is_safe_simple_list(Es, Sub) -> all(fun(E) -> is_safe_simple(E, Sub) end, Es).
+is_safe_simple_list(Es) -> all(fun(E) -> is_safe_simple(E) end, Es).
%% will_fail(Expr) -> true|false.
%% Determine whether the expression will fail with an exception.
@@ -853,7 +849,7 @@ useless_call(_, _) -> no.
%% Anything that will not have any effect will be thrown away.
make_effect_seq([H|T], Sub) ->
- case is_safe_simple(H, Sub) of
+ case is_safe_simple(H) of
true -> make_effect_seq(T, Sub);
false -> #c_seq{arg=H,body=make_effect_seq(T, Sub)}
end;
@@ -959,138 +955,14 @@ fold_lit_args(Call, Module, Name, Args0) ->
%% Attempt to evaluate some pure BIF calls with one or more
%% non-literals arguments.
%%
-fold_non_lit_args(Call, erlang, is_boolean, [Arg], Sub) ->
- eval_is_boolean(Call, Arg, Sub);
fold_non_lit_args(Call, erlang, length, [Arg], _) ->
eval_length(Call, Arg);
fold_non_lit_args(Call, erlang, '++', [Arg1,Arg2], _) ->
eval_append(Call, Arg1, Arg2);
fold_non_lit_args(Call, lists, append, [Arg1,Arg2], _) ->
eval_append(Call, Arg1, Arg2);
-fold_non_lit_args(Call, erlang, is_function, [Arg1], Sub) ->
- eval_is_function_1(Call, Arg1, Sub);
-fold_non_lit_args(Call, erlang, is_function, [Arg1,Arg2], Sub) ->
- eval_is_function_2(Call, Arg1, Arg2, Sub);
-fold_non_lit_args(Call, erlang, N, Args, Sub) ->
- NumArgs = length(Args),
- case erl_internal:comp_op(N, NumArgs) of
- true ->
- eval_rel_op(Call, N, Args, Sub);
- false ->
- case erl_internal:bool_op(N, NumArgs) of
- true ->
- eval_bool_op(Call, N, Args, Sub);
- false ->
- Call
- end
- end;
fold_non_lit_args(Call, _, _, _, _) -> Call.
-eval_is_function_1(Call, Arg1, Sub) ->
- case get_type(Arg1, Sub) of
- none -> Call;
- {'fun',_} -> #c_literal{anno=cerl:get_ann(Call),val=true};
- _ -> #c_literal{anno=cerl:get_ann(Call),val=false}
- end.
-
-eval_is_function_2(Call, Arg1, #c_literal{val=Arity}, Sub)
- when is_integer(Arity), Arity > 0 ->
- case get_type(Arg1, Sub) of
- none -> Call;
- {'fun',Arity} -> #c_literal{anno=cerl:get_ann(Call),val=true};
- _ -> #c_literal{anno=cerl:get_ann(Call),val=false}
- end;
-eval_is_function_2(Call, _Arg1, _Arg2, _Sub) -> Call.
-
-%% Evaluate a relational operation using type information.
-eval_rel_op(Call, Op, [#c_var{name=V},#c_var{name=V}], _) ->
- Bool = erlang:Op(same, same),
- #c_literal{anno=cerl:get_ann(Call),val=Bool};
-eval_rel_op(Call, '=:=', [Term,#c_literal{val=true}], Sub) ->
- %% BoolVar =:= true ==> BoolVar
- case is_boolean_type(Term, Sub) of
- yes -> Term;
- maybe -> Call;
- no -> #c_literal{val=false}
- end;
-eval_rel_op(Call, '==', Ops, Sub) ->
- case is_exact_eq_ok(Ops, Sub) of
- true ->
- Name = #c_literal{anno=cerl:get_ann(Call),val='=:='},
- Call#c_call{name=Name};
- false ->
- Call
- end;
-eval_rel_op(Call, '/=', Ops, Sub) ->
- case is_exact_eq_ok(Ops, Sub) of
- true ->
- Name = #c_literal{anno=cerl:get_ann(Call),val='=/='},
- Call#c_call{name=Name};
- false ->
- Call
- end;
-eval_rel_op(Call, _, _, _) -> Call.
-
-is_exact_eq_ok([A,B]=L, Sub) ->
- case is_int_type(A, Sub) =:= yes andalso is_int_type(B, Sub) =:= yes of
- true -> true;
- false -> is_exact_eq_ok_1(L)
- end.
-
-is_exact_eq_ok_1([#c_literal{val=Lit}|_]) ->
- is_non_numeric(Lit);
-is_exact_eq_ok_1([_|T]) ->
- is_exact_eq_ok_1(T);
-is_exact_eq_ok_1([]) -> false.
-
-is_non_numeric([H|T]) ->
- is_non_numeric(H) andalso is_non_numeric(T);
-is_non_numeric(Tuple) when is_tuple(Tuple) ->
- is_non_numeric_tuple(Tuple, tuple_size(Tuple));
-is_non_numeric(Map) when is_map(Map) ->
- %% Note that 17.x and 18.x compare keys in different ways.
- %% Be very conservative -- require that both keys and values
- %% are non-numeric.
- is_non_numeric(maps:to_list(Map));
-is_non_numeric(Num) when is_number(Num) ->
- false;
-is_non_numeric(_) -> true.
-
-is_non_numeric_tuple(Tuple, El) when El >= 1 ->
- is_non_numeric(element(El, Tuple)) andalso
- is_non_numeric_tuple(Tuple, El-1);
-is_non_numeric_tuple(_Tuple, 0) -> true.
-
-%% Evaluate a bool op using type information. We KNOW that
-%% there must be at least one non-literal argument (i.e.
-%% there is no need to handle the case that all argments
-%% are literal).
-
-eval_bool_op(Call, 'and', [#c_literal{val=true},Term], Sub) ->
- eval_bool_op_1(Call, Term, Term, Sub);
-eval_bool_op(Call, 'and', [Term,#c_literal{val=true}], Sub) ->
- eval_bool_op_1(Call, Term, Term, Sub);
-eval_bool_op(Call, 'and', [#c_literal{val=false}=Res,Term], Sub) ->
- eval_bool_op_1(Call, Res, Term, Sub);
-eval_bool_op(Call, 'and', [Term,#c_literal{val=false}=Res], Sub) ->
- eval_bool_op_1(Call, Res, Term, Sub);
-eval_bool_op(Call, _, _, _) -> Call.
-
-eval_bool_op_1(Call, Res, Term, Sub) ->
- case is_boolean_type(Term, Sub) of
- yes -> Res;
- no -> eval_failure(Call, badarg);
- maybe -> Call
- end.
-
-%% Evaluate is_boolean/1 using type information.
-eval_is_boolean(Call, Term, Sub) ->
- case is_boolean_type(Term, Sub) of
- no -> #c_literal{val=false};
- yes -> #c_literal{val=true};
- maybe -> Call
- end.
-
%% eval_length(Call, List) -> Val.
%% Evaluates the length for the prefix of List which has a known
%% shape.
@@ -1804,7 +1676,7 @@ opt_bool_case_guard(#c_case{arg=#c_literal{}}=Case) ->
%%
Case;
opt_bool_case_guard(#c_case{arg=Arg,clauses=Cs0}=Case) ->
- case is_safe_bool_expr(Arg, sub_new()) of
+ case is_safe_bool_expr(Arg) of
false ->
Case;
true ->
@@ -1945,7 +1817,7 @@ case_opt_arg(E0, Sub, Cs, LitExpr) ->
{error,Cs};
false ->
%% If possible, expand this variable to a previously
- %% matched term.
+ %% constructed tuple
E = case_expand_var(E0, Sub),
case_opt_arg_1(E, Cs, LitExpr)
end
@@ -2004,13 +1876,8 @@ case_opt_compiler_generated(Core) ->
case_expand_var(E, #sub{t=Tdb}) ->
Key = cerl:var_name(E),
case Tdb of
- #{Key:=T} ->
- case cerl:is_c_tuple(T) of
- false -> E;
- true -> T
- end;
- _ ->
- E
+ #{Key:=T} -> T;
+ _ -> E
end.
%% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses'
@@ -2302,43 +2169,30 @@ is_simple_case_arg(_) -> false.
%% Check whether the Core expression is guaranteed to return
%% a boolean IF IT RETURNS AT ALL.
%%
-is_bool_expr(Core) ->
- is_bool_expr(Core, sub_new()).
-%% is_bool_expr(Core, Sub) -> true|false
-%% Check whether the Core expression is guaranteed to return
-%% a boolean IF IT RETURNS AT ALL. Uses type information
-%% to be able to identify more expressions as booleans.
-%%
is_bool_expr(#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=Name},args=Args}=Call, _) ->
+ name=#c_literal{val=Name},args=Args}=Call) ->
NumArgs = length(Args),
erl_internal:comp_op(Name, NumArgs) orelse
erl_internal:new_type_test(Name, NumArgs) orelse
erl_internal:bool_op(Name, NumArgs) orelse
will_fail(Call);
is_bool_expr(#c_try{arg=E,vars=[#c_var{name=X}],body=#c_var{name=X},
- handler=#c_literal{val=false}}, Sub) ->
- is_bool_expr(E, Sub);
-is_bool_expr(#c_case{clauses=Cs}, Sub) ->
- is_bool_expr_list(Cs, Sub);
-is_bool_expr(#c_clause{body=B}, Sub) ->
- is_bool_expr(B, Sub);
-is_bool_expr(#c_let{vars=[V],arg=Arg,body=B}, Sub0) ->
- Sub = case is_bool_expr(Arg, Sub0) of
- true -> update_types(V, [bool], Sub0);
- false -> Sub0
- end,
- is_bool_expr(B, Sub);
-is_bool_expr(#c_let{body=B}, Sub) ->
- %% Binding of multiple variables.
- is_bool_expr(B, Sub);
-is_bool_expr(C, Sub) ->
- is_boolean_type(C, Sub) =:= yes.
-
-is_bool_expr_list([C|Cs], Sub) ->
- is_bool_expr(C, Sub) andalso is_bool_expr_list(Cs, Sub);
-is_bool_expr_list([], _) -> true.
+ handler=#c_literal{val=false}}) ->
+ is_bool_expr(E);
+is_bool_expr(#c_case{clauses=Cs}) ->
+ is_bool_expr_list(Cs);
+is_bool_expr(#c_clause{body=B}) ->
+ is_bool_expr(B);
+is_bool_expr(#c_let{body=B}) ->
+ is_bool_expr(B);
+is_bool_expr(#c_literal{val=Val}) ->
+ is_boolean(Val);
+is_bool_expr(_) -> false.
+
+is_bool_expr_list([C|Cs]) ->
+ is_bool_expr(C) andalso is_bool_expr_list(Cs);
+is_bool_expr_list([]) -> true.
%% is_safe_bool_expr(Core) -> true|false
%% Check whether the Core expression ALWAYS returns a boolean
@@ -2346,17 +2200,17 @@ is_bool_expr_list([], _) -> true.
%% is suitable for a guard (no calls to non-guard BIFs, local
%% functions, or is_record/2).
%%
-is_safe_bool_expr(Core, Sub) ->
- is_safe_bool_expr_1(Core, Sub, cerl_sets:new()).
+is_safe_bool_expr(Core) ->
+ is_safe_bool_expr_1(Core, cerl_sets:new()).
is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_record},
args=[A,#c_literal{val=Tag},#c_literal{val=Size}]},
- Sub, _BoolVars) when is_atom(Tag), is_integer(Size) ->
- is_safe_simple(A, Sub);
+ _BoolVars) when is_atom(Tag), is_integer(Size) ->
+ is_safe_simple(A);
is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_record}},
- _Sub, _BoolVars) ->
+ _BoolVars) ->
%% The is_record/2 BIF is NOT allowed in guards.
%% The is_record/3 BIF where its second argument is not an atom or its third
%% is not an integer is NOT allowed in guards.
@@ -2368,49 +2222,49 @@ is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_function},
args=[A,#c_literal{val=Arity}]},
- Sub, _BoolVars) when is_integer(Arity), Arity >= 0 ->
- is_safe_simple(A, Sub);
+ _BoolVars) when is_integer(Arity), Arity >= 0 ->
+ is_safe_simple(A);
is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_function}},
- _Sub, _BoolVars) ->
+ _BoolVars) ->
false;
is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=Name},args=Args},
- Sub, BoolVars) ->
+ BoolVars) ->
NumArgs = length(Args),
case (erl_internal:comp_op(Name, NumArgs) orelse
erl_internal:new_type_test(Name, NumArgs)) andalso
- is_safe_simple_list(Args, Sub) of
+ is_safe_simple_list(Args) of
true ->
true;
false ->
%% Boolean operators are safe if all arguments are boolean.
erl_internal:bool_op(Name, NumArgs) andalso
- is_safe_bool_expr_list(Args, Sub, BoolVars)
+ is_safe_bool_expr_list(Args, BoolVars)
end;
-is_safe_bool_expr_1(#c_let{vars=Vars,arg=Arg,body=B}, Sub, BoolVars) ->
- case is_safe_simple(Arg, Sub) of
+is_safe_bool_expr_1(#c_let{vars=Vars,arg=Arg,body=B}, BoolVars) ->
+ case is_safe_simple(Arg) of
true ->
- case {is_safe_bool_expr_1(Arg, Sub, BoolVars),Vars} of
+ case {is_safe_bool_expr_1(Arg, BoolVars),Vars} of
{true,[#c_var{name=V}]} ->
- is_safe_bool_expr_1(B, Sub, cerl_sets:add_element(V, BoolVars));
+ is_safe_bool_expr_1(B, cerl_sets:add_element(V, BoolVars));
{false,_} ->
- is_safe_bool_expr_1(B, Sub, BoolVars)
+ is_safe_bool_expr_1(B, BoolVars)
end;
false -> false
end;
-is_safe_bool_expr_1(#c_literal{val=Val}, _Sub, _) ->
+is_safe_bool_expr_1(#c_literal{val=Val}, _BoolVars) ->
is_boolean(Val);
-is_safe_bool_expr_1(#c_var{name=V}, _Sub, BoolVars) ->
+is_safe_bool_expr_1(#c_var{name=V}, BoolVars) ->
cerl_sets:is_element(V, BoolVars);
-is_safe_bool_expr_1(_, _, _) -> false.
+is_safe_bool_expr_1(_, _) -> false.
-is_safe_bool_expr_list([C|Cs], Sub, BoolVars) ->
- case is_safe_bool_expr_1(C, Sub, BoolVars) of
- true -> is_safe_bool_expr_list(Cs, Sub, BoolVars);
+is_safe_bool_expr_list([C|Cs], BoolVars) ->
+ case is_safe_bool_expr_1(C, BoolVars) of
+ true -> is_safe_bool_expr_list(Cs, BoolVars);
false -> false
end;
-is_safe_bool_expr_list([], _, _) -> true.
+is_safe_bool_expr_list([], _) -> true.
%% simplify_let(Let, Sub) -> Expr | impossible
%% If the argument part of an let contains a complex expression, such
@@ -2785,7 +2639,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) ->
%% with exported variables, but the return value is
%% ignored). We can remove the first variable and the
%% the first value returned from the 'let' argument.
- Arg2 = remove_first_value(Arg1, Sub),
+ Arg2 = remove_first_value(Arg1),
Let1 = Let0#c_let{vars=Vars,arg=Arg2,body=Body},
post_opt_let(Let1, Sub);
true ->
@@ -2805,36 +2659,36 @@ post_opt_let(Let0, Sub) ->
opt_build_stacktrace(Let1).
-%% remove_first_value(Core0, Sub) -> Core.
+%% remove_first_value(Core0) -> Core.
%% Core0 is an expression that returns at least two values.
%% Remove the first value returned from Core0.
-remove_first_value(#c_values{es=[V|Vs]}, Sub) ->
+remove_first_value(#c_values{es=[V|Vs]}) ->
Values = core_lib:make_values(Vs),
- case is_safe_simple(V, Sub) of
+ case is_safe_simple(V) of
false ->
#c_seq{arg=V,body=Values};
true ->
Values
end;
-remove_first_value(#c_case{clauses=Cs0}=Core, Sub) ->
- Cs = remove_first_value_cs(Cs0, Sub),
+remove_first_value(#c_case{clauses=Cs0}=Core) ->
+ Cs = remove_first_value_cs(Cs0),
Core#c_case{clauses=Cs};
-remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core, Sub) ->
- Cs = remove_first_value_cs(Cs0, Sub),
- Act = remove_first_value(Act0, Sub),
+remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core) ->
+ Cs = remove_first_value_cs(Cs0),
+ Act = remove_first_value(Act0),
Core#c_receive{clauses=Cs,action=Act};
-remove_first_value(#c_let{body=B}=Core, Sub) ->
- Core#c_let{body=remove_first_value(B, Sub)};
-remove_first_value(#c_seq{body=B}=Core, Sub) ->
- Core#c_seq{body=remove_first_value(B, Sub)};
-remove_first_value(#c_primop{}=Core, _Sub) ->
+remove_first_value(#c_let{body=B}=Core) ->
+ Core#c_let{body=remove_first_value(B)};
+remove_first_value(#c_seq{body=B}=Core) ->
+ Core#c_seq{body=remove_first_value(B)};
+remove_first_value(#c_primop{}=Core) ->
Core;
-remove_first_value(#c_call{}=Core, _Sub) ->
+remove_first_value(#c_call{}=Core) ->
Core.
-remove_first_value_cs(Cs, Sub) ->
- [C#c_clause{body=remove_first_value(B, Sub)} ||
+remove_first_value_cs(Cs) ->
+ [C#c_clause{body=remove_first_value(B)} ||
#c_clause{body=B}=C <- Cs].
%% maybe_suppress_warnings(Arg, #c_var{}, PreviousBody) -> Arg'
@@ -2962,54 +2816,6 @@ move_case_into_arg(Expr, _) ->
Expr.
%%%
-%%% Retrieving information about types.
-%%%
-
--spec get_type(cerl:cerl(), #sub{}) -> type_info() | 'none'.
-
-get_type(#c_var{name=V}, #sub{t=Tdb}) ->
- case Tdb of
- #{V:=Type} -> Type;
- _ -> none
- end;
-get_type(C, _) ->
- case cerl:type(C) of
- binary -> C;
- map -> C;
- _ ->
- case cerl:is_data(C) of
- true -> C;
- false -> none
- end
- end.
-
--spec is_boolean_type(cerl:cerl(), sub()) -> yes_no_maybe().
-
-is_boolean_type(Var, Sub) ->
- case get_type(Var, Sub) of
- none ->
- maybe;
- bool ->
- yes;
- C ->
- B = cerl:is_c_atom(C) andalso
- is_boolean(cerl:atom_val(C)),
- yes_no(B)
- end.
-
--spec is_int_type(cerl:cerl(), sub()) -> yes_no_maybe().
-
-is_int_type(Var, Sub) ->
- case get_type(Var, Sub) of
- none -> maybe;
- integer -> yes;
- C -> yes_no(cerl:is_c_int(C))
- end.
-
-yes_no(true) -> yes;
-yes_no(false) -> no.
-
-%%%
%%% Update type information.
%%%
@@ -3020,70 +2826,14 @@ update_let_types(_Vs, _Arg, Sub) ->
%% that returns multiple values.
Sub.
-update_let_types_1([#c_var{}=V|Vs], [A|As], Sub0) ->
- Sub = update_types_from_expr(V, A, Sub0),
+update_let_types_1([#c_var{name=V}|Vs], [A|As], Sub0) ->
+ Sub = update_types(V, A, Sub0),
update_let_types_1(Vs, As, Sub);
update_let_types_1([], [], Sub) -> Sub.
-update_types_from_expr(V, Expr, Sub) ->
- Type = extract_type(Expr, Sub),
- update_types(V, [Type], Sub).
-
-extract_type(#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=Name},
- args=Args}=Call, Sub) ->
- case returns_integer(Name, Args) of
- true -> integer;
- false -> extract_type_1(Call, Sub)
- end;
-extract_type(Expr, Sub) ->
- extract_type_1(Expr, Sub).
-
-extract_type_1(Expr, Sub) ->
- case is_bool_expr(Expr, Sub) of
- false -> Expr;
- true -> bool
- end.
-
-returns_integer('band', [_,_]) -> true;
-returns_integer('bnot', [_]) -> true;
-returns_integer('bor', [_,_]) -> true;
-returns_integer('bxor', [_,_]) -> true;
-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;
-returns_integer(size, [_]) -> true;
-returns_integer(tuple_size, [_]) -> true;
-returns_integer(trunc, [_]) -> true;
-returns_integer(_, _) -> false.
-
-%% update_types(Expr, Pattern, Sub) -> Sub'
-%% Update the type database.
-
--spec update_types(cerl:c_var(), [type_info()], sub()) -> sub().
-
-update_types(#c_var{name=V}, Pat, #sub{t=Tdb0}=Sub) ->
- Tdb = update_types_1(V, Pat, Tdb0),
- Sub#sub{t=Tdb}.
-
-update_types_1(V, [#c_tuple{}=P], Types) ->
- Types#{V=>P};
-update_types_1(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) ->
- Types#{V=>bool};
-update_types_1(V, [#c_fun{vars=Vars}], Types) ->
- Types#{V=>{'fun',length(Vars)}};
-update_types_1(V, [#c_var{name={_,Arity}}], Types) ->
- Types#{V=>{'fun',Arity}};
-update_types_1(V, [Type], Types) when is_atom(Type) ->
- Types#{V=>Type};
-update_types_1(_, _, Types) -> Types.
+update_types(V, #c_tuple{}=P, #sub{t=Tdb}=Sub) ->
+ Sub#sub{t=Tdb#{V=>P}};
+update_types(_, _, Sub) -> Sub.
%% kill_types(V, Tdb) -> Tdb'
%% Kill any entries that references the variable,
@@ -3099,10 +2849,6 @@ kill_types2(V, [{_,#c_tuple{}=Tuple}=Entry|Tdb]) ->
false -> [Entry|kill_types2(V, Tdb)];
true -> kill_types2(V, Tdb)
end;
-kill_types2(V, [{_, {'fun',_}}=Entry|Tdb]) ->
- [Entry|kill_types2(V, Tdb)];
-kill_types2(V, [{_,Atom}=Entry|Tdb]) when is_atom(Atom) ->
- [Entry|kill_types2(V, Tdb)];
kill_types2(_, []) -> [].
%% copy_type(DestVar, SrcVar, Tdb) -> Tdb'
generated by cgit v1.2.3 (git 2.25.1) at 2024-10-31 16:53:46 +0000