aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/src/Makefile4
-rw-r--r--lib/compiler/src/beam_a.erl3
-rw-r--r--lib/compiler/src/beam_block.erl23
-rw-r--r--lib/compiler/src/beam_bool.erl3
-rw-r--r--lib/compiler/src/beam_dead.erl24
-rw-r--r--lib/compiler/src/beam_peep.erl15
-rw-r--r--lib/compiler/src/beam_type.erl31
-rw-r--r--lib/compiler/src/beam_utils.erl17
-rw-r--r--lib/compiler/src/beam_validator.erl25
-rw-r--r--lib/compiler/src/cerl.erl3
-rw-r--r--lib/compiler/src/sys_core_fold.erl526
-rw-r--r--lib/compiler/src/v3_codegen.erl22
-rw-r--r--lib/compiler/src/v3_core.erl188
-rw-r--r--lib/compiler/src/v3_kernel.erl30
-rw-r--r--lib/compiler/src/v3_life.erl56
-rw-r--r--lib/compiler/test/andor_SUITE.erl12
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl26
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl2
-rw-r--r--lib/compiler/test/guard_SUITE.erl12
-rw-r--r--lib/compiler/test/match_SUITE.erl13
-rw-r--r--lib/compiler/test/warnings_SUITE.erl32
21 files changed, 671 insertions, 396 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index 2032392821..7c4cebdc28 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -159,6 +159,10 @@ $(EBIN)/beam_asm.beam: $(ESRC)/beam_asm.erl $(EGEN)/beam_opcodes.hrl
$(EBIN)/cerl_inline.beam: $(ESRC)/cerl_inline.erl
$(V_ERLC) $(ERL_COMPILE_FLAGS) +nowarn_shadow_vars -o$(EBIN) $<
+# Inlining core_parse is slow and has no benefit.
+$(EBIN)/core_parse.beam: $(EGEN)/core_parse.erl
+ $(V_ERLC) $(subst +inline,,$(ERL_COMPILE_FLAGS)) -o$(EBIN) $<
+
# ----------------------------------------------------
# Release Target
# ----------------------------------------------------
diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl
index fe4f473846..dd7e03dd28 100644
--- a/lib/compiler/src/beam_a.erl
+++ b/lib/compiler/src/beam_a.erl
@@ -54,6 +54,9 @@ rename_instrs([{call_only,A,F}|Is]) ->
[{call,A,F},return|rename_instrs(Is)];
rename_instrs([{call_ext_only,A,F}|Is]) ->
[{call_ext,A,F},return|rename_instrs(Is)];
+rename_instrs([{'%live',_}|Is]) ->
+ %% When compiling from old .S files.
+ rename_instrs(Is);
rename_instrs([I|Is]) ->
[rename_instr(I)|rename_instrs(Is)];
rename_instrs([]) -> [].
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index 7d65dc983a..5216f39296 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -184,7 +184,7 @@ embed_lines([], Acc) -> Acc.
opt_blocks([{block,Bl0}|Is]) ->
%% The live annotation at the beginning is not useful.
- [{'%live',_}|Bl] = Bl0,
+ [{'%live',_,_}|Bl] = Bl0,
[{block,opt_block(Bl)}|opt_blocks(Is)];
opt_blocks([I|Is]) ->
[I|opt_blocks(Is)];
@@ -252,13 +252,6 @@ combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) ->
%% opt([Instruction]) -> [Instruction]
%% Optimize the instruction stream inside a basic block.
-opt([{set,[Dst],As,{bif,Bif,Fail}}=I1,
- {set,[Dst],[Dst],{bif,'not',Fail}}=I2|Is]) ->
- %% Get rid of the 'not' if the operation can be inverted.
- case inverse_comp_op(Bif) of
- none -> [I1,I2|opt(Is)];
- RevBif -> [{set,[Dst],As,{bif,RevBif,Fail}}|opt(Is)]
- end;
opt([{set,[X],[X],move}|Is]) -> opt(Is);
opt([{set,_,_,{line,_}}=Line1,
{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1,
@@ -269,7 +262,7 @@ opt([{set,_,_,{line,_}}=Line1,
opt([{set,Ds0,Ss,Op}|Is0]) ->
{Ds,Is} = opt_moves(Ds0, Is0),
[{set,Ds,Ss,Op}|opt(Is)];
-opt([{'%live',_}=I|Is]) ->
+opt([{'%live',_,_}=I|Is]) ->
[I|opt(Is)];
opt([]) -> [].
@@ -428,18 +421,6 @@ x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N));
x_live([_|Rs], Regs) -> x_live(Rs, Regs);
x_live([], Regs) -> Regs.
-%% inverse_comp_op(Op) -> none|RevOp
-
-inverse_comp_op('=:=') -> '=/=';
-inverse_comp_op('=/=') -> '=:=';
-inverse_comp_op('==') -> '/=';
-inverse_comp_op('/=') -> '==';
-inverse_comp_op('>') -> '=<';
-inverse_comp_op('<') -> '>=';
-inverse_comp_op('>=') -> '<';
-inverse_comp_op('=<') -> '>';
-inverse_comp_op(_) -> none.
-
%%%
%%% Evaluation of constant bit fields.
%%%
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl
index a452d30b61..5ed9c16d61 100644
--- a/lib/compiler/src/beam_bool.erl
+++ b/lib/compiler/src/beam_bool.erl
@@ -787,6 +787,9 @@ is_not_used(R, Is, Label, #st{ll=Ll}) ->
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) ->
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index 7cd07dc3be..f4515ba2a7 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -98,6 +98,12 @@ move_move_into_block([], Acc) -> reverse(Acc).
forward(Is, Lc) ->
forward(Is, gb_trees:empty(), Lc, []).
+forward([{move,_,_}=Move|[{label,L}|_]=Is], D, Lc, Acc) ->
+ %% move/2 followed by jump/1 is optimized by backward/3.
+ forward([Move,{jump,{f,L}}|Is], D, Lc, Acc);
+forward([{bif,_,_,_,_}=Bif|[{label,L}|_]=Is], D, Lc, Acc) ->
+ %% bif/4 followed by jump/1 is optimized by backward/3.
+ forward([Bif,{jump,{f,L}}|Is], D, Lc, Acc);
forward([{block,[]}|Is], D, Lc, Acc) ->
%% Empty blocks can prevent optimizations.
forward(Is, D, Lc, Acc);
@@ -124,6 +130,8 @@ forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) ->
_ -> Is0 %Keep move instruction.
end,
forward(Is, D, Lc, [LblI|Acc]);
+forward([{test,is_eq_exact,_,[Same,Same]}|Is], D, Lc, Acc) ->
+ forward(Is, D, Lc, Acc);
forward([{test,is_eq_exact,_,[Dst,Src]}=I,
{block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) ->
forward([I,{block,Bl}|Is], D, Lc, Acc);
@@ -234,10 +242,8 @@ backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) ->
Fail = shortcut_bs_test(Fail1, Is, D),
Sel = {select,select_val,Reg,{f,Fail},List},
backward(Is, D, [Sel|Acc]);
-backward([{jump,{f,To0}},{move,Src0,Reg}|Is], D, Acc) ->
- To1 = shortcut_select_label(To0, Reg, Src0, D),
- {To,Src} = shortcut_boolean_label(To1, Reg, Src0, D),
- Move = {move,Src,Reg},
+backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) ->
+ To = shortcut_select_label(To0, Reg, Src, D),
Jump = {jump,{f,To}},
case beam_utils:is_killed_at(Reg, To, D) of
false -> backward([Move|Is], D, [Jump|Acc]);
@@ -330,16 +336,6 @@ shortcut_label(To0, D) ->
shortcut_select_label(To, Reg, Lit, D) ->
shortcut_rel_op(To, is_ne_exact, [Reg,Lit], D).
-shortcut_boolean_label(To0, Reg, {atom,Bool0}=Lit, D) when is_boolean(Bool0) ->
- case beam_utils:code_at(To0, D) of
- [{line,_},{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] ->
- Bool = {atom,not Bool0},
- {shortcut_select_label(To, Reg, Bool, D),Bool};
- _ ->
- {To0,Lit}
- end;
-shortcut_boolean_label(To, _, Bool, _) -> {To,Bool}.
-
%% Replace a comparison operator with a test instruction and a jump.
%% For example, if we have this code:
%%
diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl
index 97a8c7ba70..5abacc8d5d 100644
--- a/lib/compiler/src/beam_peep.erl
+++ b/lib/compiler/src/beam_peep.erl
@@ -108,14 +108,14 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) ->
%% has succeeded.
peep(Is, gb_sets:empty(), [I|Acc]);
true ->
- Test = {Op,Ops},
- case gb_sets:is_element(Test, SeenTests0) of
+ case is_test_redundant(Op, Ops, SeenTests0) of
true ->
- %% This test has already succeeded and
+ %% This test or a similar test has already succeeded and
%% is therefore redundant.
peep(Is, SeenTests0, Acc);
false ->
%% Remember that we have seen this test.
+ Test = {Op,Ops},
SeenTests = gb_sets:insert(Test, SeenTests0),
peep(Is, SeenTests, [I|Acc])
end
@@ -136,6 +136,15 @@ peep([I|Is], _, Acc) ->
peep(Is, gb_sets:empty(), [I|Acc]);
peep([], _, Acc) -> reverse(Acc).
+is_test_redundant(Op, Ops, Seen) ->
+ gb_sets:is_element({Op,Ops}, Seen) orelse
+ is_test_redundant_1(Op, Ops, Seen).
+
+is_test_redundant_1(is_boolean, [R], Seen) ->
+ gb_sets:is_element({is_eq_exact,[R,{atom,false}]}, Seen) orelse
+ gb_sets:is_element({is_eq_exact,[R,{atom,true}]}, Seen);
+is_test_redundant_1(_, _, _) -> false.
+
kill_seen(Dst, Seen0) ->
gb_sets:from_ordset(kill_seen_1(gb_sets:to_list(Seen0), Dst)).
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index d9713cef0d..26c933481a 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -244,7 +244,7 @@ clearerror([], OrigIs) -> [{set,[],[],fclearerror}|OrigIs].
%% Combine two blocks and eliminate any move instructions that assign
%% to registers that are killed later in the block.
%%
-merge_blocks(B1, [{'%live',_}|B2]) ->
+merge_blocks(B1, [{'%live',_,_}|B2]) ->
merge_blocks_1(B1++[{set,[],[],stop_here}|B2]).
merge_blocks_1([{set,[],_,stop_here}|Is]) -> Is;
@@ -329,27 +329,27 @@ build_alloc(Words, Floats) -> {alloc,[{words,Words},{floats,Floats}]}.
%% flt_liveness([Instruction]) -> [Instruction]
%% (Re)calculate the number of live registers for each heap allocation
-%% function. We base liveness of the number of live registers at
-%% entry to the instruction sequence.
+%% function. We base liveness of the number of register map at the
+%% beginning of the instruction sequence.
%%
%% A 'not_possible' term will be thrown if the set of live registers
%% is not continous at an allocation function (e.g. if {x,0} and {x,2}
%% are live, but not {x,1}).
-flt_liveness([{'%live',Live}=LiveInstr|Is]) ->
- flt_liveness_1(Is, init_regs(Live), [LiveInstr]).
+flt_liveness([{'%live',_Live,Regs}=LiveInstr|Is]) ->
+ flt_liveness_1(Is, Regs, [LiveInstr]).
-flt_liveness_1([{set,Ds,Ss,{alloc,_,Alloc}}|Is], Regs0, Acc) ->
- Live = live_regs(Regs0),
+flt_liveness_1([{set,Ds,Ss,{alloc,Live0,Alloc}}|Is], Regs0, Acc) ->
+ Live = min(Live0, live_regs(Regs0)),
I = {set,Ds,Ss,{alloc,Live,Alloc}},
- Regs = foldl(fun(R, A) -> set_live(R, A) end, Regs0, Ds),
+ Regs1 = init_regs(Live),
+ Regs = x_live(Ds, Regs1),
flt_liveness_1(Is, Regs, [I|Acc]);
flt_liveness_1([{set,Ds,_,_}=I|Is], Regs0, Acc) ->
- Regs = foldl(fun(R, A) -> set_live(R, A) end, Regs0, Ds),
+ Regs = x_live(Ds, Regs0),
flt_liveness_1(Is, Regs, [I|Acc]);
-flt_liveness_1([{'%live',_}=I|Is], Regs, Acc) ->
- flt_liveness_1(Is, Regs, [I|Acc]);
-flt_liveness_1([], _Regs, Acc) -> reverse(Acc).
+flt_liveness_1([{'%live',_,_}], _Regs, Acc) ->
+ reverse(Acc).
init_regs(Live) ->
(1 bsl Live) - 1.
@@ -364,14 +364,15 @@ live_regs_1(R, N) ->
1 -> live_regs_1(R bsr 1, N+1)
end.
-set_live({x,X}, Regs) -> Regs bor (1 bsl X);
-set_live(_, Regs) -> Regs.
+x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N));
+x_live([_|Rs], Regs) -> x_live(Rs, Regs);
+x_live([], Regs) -> Regs.
%% update(Instruction, TypeDb) -> NewTypeDb
%% Update the type database to account for executing an instruction.
%%
%% First the cases for instructions inside basic blocks.
-update({'%live',_}, Ts) -> Ts;
+update({'%live',_,_}, Ts) -> Ts;
update({set,[D],[S],move}, Ts) ->
tdb_copy(S, D, Ts);
update({set,[D],[{integer,I},Reg],{bif,element,_}}, Ts0) ->
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index 3249024854..7704690f86 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -196,7 +196,7 @@ is_pure_test({test,Op,_,Ops}) ->
%% Go through the instruction sequence in reverse execution
%% order, keep track of liveness and remove 'move' instructions
%% whose destination is a register that will not be used.
-%% Also insert {'%live',Live} annotations at the beginning
+%% Also insert {'%live',Live,Regs} annotations at the beginning
%% and end of each block.
%%
live_opt(Is0) ->
@@ -217,7 +217,7 @@ delete_live_annos([{block,Bl0}|Is]) ->
[] -> delete_live_annos(Is);
[_|_]=Bl -> [{block,Bl}|delete_live_annos(Is)]
end;
-delete_live_annos([{'%live',_}|Is]) ->
+delete_live_annos([{'%live',_,_}|Is]) ->
delete_live_annos(Is);
delete_live_annos([I|Is]) ->
[I|delete_live_annos(Is)];
@@ -366,11 +366,6 @@ check_liveness(R, [{apply,Args}|Is], St) ->
{x,_} -> {killed,St};
{y,_} -> check_liveness(R, Is, St)
end;
-check_liveness({x,R}, [{'%live',Live}|Is], St) ->
- if
- R < Live -> check_liveness(R, Is, St);
- true -> {killed,St}
- end;
check_liveness(R, [{bif,Op,{f,Fail},Ss,D}|Is], St0) ->
case check_liveness_fail(R, Op, Ss, Fail, St0) of
{killed,St} = Killed ->
@@ -554,7 +549,7 @@ check_killed_block(R, [{set,Ds,Ss,_Op}|Is]) ->
false -> check_killed_block(R, Is)
end
end;
-check_killed_block(R, [{'%live',Live}|Is]) ->
+check_killed_block(R, [{'%live',Live,_}|Is]) ->
case R of
{x,X} when X >= Live -> killed;
_ -> check_killed_block(R, Is)
@@ -577,7 +572,7 @@ check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St) ->
end;
check_used_block(R, [{set,Ds,Ss,Op}|Is], St) ->
check_used_block_1(R, Ss, Ds, Op, Is, St);
-check_used_block(R, [{'%live',Live}|Is], St) ->
+check_used_block(R, [{'%live',Live,_}|Is], St) ->
case R of
{x,X} when X >= Live -> {killed,St};
_ -> check_used_block(R, Is, St)
@@ -678,9 +673,9 @@ live_opt([{test,bs_start_match2,Fail,Live,[Src,_],_}=I|Is], _, D, Acc) ->
%% Other instructions.
live_opt([{block,Bl0}|Is], Regs0, D, Acc) ->
- Live0 = {'%live',live_regs(Regs0)},
+ Live0 = {'%live',live_regs(Regs0),Regs0},
{Bl,Regs} = live_opt_block(reverse(Bl0), Regs0, D, [Live0]),
- Live = {'%live',live_regs(Regs)},
+ Live = {'%live',live_regs(Regs),Regs},
live_opt(Is, Regs, D, [{block,[Live|Bl]}|Acc]);
live_opt([{label,L}=I|Is], Regs, D0, Acc) ->
D = gb_trees:insert(L, Regs, D0),
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index e60184c929..4d4536b79c 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -361,9 +361,6 @@ valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) ->
valfun_1({recv_set,{f,Fail}}, Vst) when is_integer(Fail) ->
Vst;
%% Misc.
-valfun_1({'%live',Live}, Vst) ->
- verify_live(Live, Vst),
- Vst;
valfun_1(remove_message, Vst) ->
Vst;
valfun_1({'%',_}, Vst) ->
@@ -669,9 +666,17 @@ valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) ->
assert_type(tuple, Tuple, Vst),
set_type_reg({tuple,Sz}, Tuple, branch_state(Lbl, Vst));
valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) ->
- validate_src([Src], Vst),
+ assert_type(map, Src, Vst),
assert_strict_literal_termorder(List),
branch_state(Lbl, Vst);
+valfun_4({test,is_map,{f,Lbl},[Src]}, Vst0) ->
+ Vst = branch_state(Lbl, Vst0),
+ case Src of
+ {Tag,_} when Tag =:= x; Tag =:= y ->
+ set_type_reg(map, Src, Vst);
+ _ ->
+ Vst
+ end;
valfun_4({test,_Op,{f,Lbl},Src}, Vst) ->
validate_src(Src, Vst),
branch_state(Lbl, Vst);
@@ -766,7 +771,7 @@ valfun_4(_, _) ->
error(unknown_instruction).
verify_get_map(Fail, Src, List, Vst0) ->
- assert_term(Src, Vst0),
+ assert_type(map, Src, Vst0),
Vst1 = branch_state(Fail, Vst0),
Keys = extract_map_keys(List),
assert_strict_literal_termorder(Keys),
@@ -782,14 +787,14 @@ verify_get_map_pair([Src,Dst|Vs],Vst0,Vsti) ->
verify_get_map_pair(Vs,Vst0,set_type_reg(term,Dst,Vsti)).
verify_put_map(Fail, Src, Dst, Live, List, Vst0) ->
+ assert_type(map, Src, Vst0),
verify_live(Live, Vst0),
verify_y_init(Vst0),
foreach(fun (Term) -> assert_term(Term, Vst0) end, List),
- assert_term(Src, Vst0),
Vst1 = heap_alloc(0, Vst0),
Vst2 = branch_state(Fail, Vst1),
Vst = prune_x_regs(Live, Vst2),
- set_type_reg(term, Dst, Vst).
+ set_type_reg(map, Dst, Vst).
%%
%% Common code for validating bs_get* instructions.
@@ -1223,7 +1228,8 @@ assert_term(Src, Vst) ->
%%
%% number Integer or Float of unknown value
%%
-
+%% map Map.
+%%
assert_type(WantedType, Term, Vst) ->
assert_type(WantedType, get_term_type(Term, Vst)).
@@ -1305,6 +1311,7 @@ get_term_type_1(nil=T, _) -> T;
get_term_type_1({atom,A}=T, _) when is_atom(A) -> T;
get_term_type_1({float,F}=T, _) when is_float(F) -> T;
get_term_type_1({integer,I}=T, _) when is_integer(I) -> T;
+get_term_type_1({literal,Map}, _) when is_map(Map) -> map;
get_term_type_1({literal,_}=T, _) -> T;
get_term_type_1({x,X}=Reg, #vst{current=#st{x=Xs}}) when is_integer(X) ->
case gb_trees:lookup(X, Xs) of
@@ -1554,6 +1561,7 @@ bif_type(is_float, [_], _) -> bool;
bif_type(is_function, [_], _) -> bool;
bif_type(is_integer, [_], _) -> bool;
bif_type(is_list, [_], _) -> bool;
+bif_type(is_map, [_], _) -> bool;
bif_type(is_number, [_], _) -> bool;
bif_type(is_pid, [_], _) -> bool;
bif_type(is_port, [_], _) -> bool;
@@ -1583,6 +1591,7 @@ is_bif_safe(is_float, 1) -> true;
is_bif_safe(is_function, 1) -> true;
is_bif_safe(is_integer, 1) -> true;
is_bif_safe(is_list, 1) -> true;
+is_bif_safe(is_map, 1) -> true;
is_bif_safe(is_number, 1) -> true;
is_bif_safe(is_pid, 1) -> true;
is_bif_safe(is_port, 1) -> true;
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 3d4b9ee0c6..8367a1e19e 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -138,7 +138,8 @@
]).
-export_type([c_binary/0, c_bitstr/0, c_call/0, c_clause/0, c_cons/0, c_fun/0,
- c_literal/0, c_map/0, c_map_pair/0, c_module/0, c_tuple/0,
+ c_let/0, c_literal/0, c_map/0, c_map_pair/0,
+ c_module/0, c_tuple/0,
c_values/0, c_var/0, cerl/0, var_name/0]).
-include("core_parse.hrl").
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 2618f7adba..0d020578f5 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -96,7 +96,7 @@
t=[], %Types
in_guard=false}). %In guard or not.
--type type_info() :: cerl:cerl() | 'bool'.
+-type type_info() :: cerl:cerl() | 'bool' | 'integer'.
-type yes_no_maybe() :: 'yes' | 'no' | 'maybe'.
-type sub() :: #sub{}.
@@ -297,7 +297,8 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) ->
false -> Seq0#c_seq{arg=Arg,body=B1}
end
end;
-expr(#c_let{}=Let, Ctxt, Sub) ->
+expr(#c_let{}=Let0, Ctxt, Sub) ->
+ Let = opt_case_in_let(Let0),
case simplify_let(Let, Sub) of
impossible ->
%% The argument for the let is "simple", i.e. has no
@@ -829,16 +830,16 @@ eval_rel_op(Call, '=:=', [Term,#c_literal{val=true}], Sub) ->
maybe -> Call;
no -> #c_literal{val=false}
end;
-eval_rel_op(Call, '==', Ops, _Sub) ->
- case is_exact_eq_ok(Ops) of
+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) of
+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};
@@ -847,11 +848,17 @@ eval_rel_op(Call, '/=', Ops, _Sub) ->
end;
eval_rel_op(Call, _, _, _) -> Call.
-is_exact_eq_ok([#c_literal{val=Lit}|_]) ->
+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([_|T]) ->
- is_exact_eq_ok(T);
-is_exact_eq_ok([]) -> false.
+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);
@@ -963,7 +970,7 @@ eval_element(Call, #c_literal{val=Pos}, Tuple, Types)
1 =< Pos, Pos =< length(Es) ->
El = lists:nth(Pos, Es),
try
- pat_to_expr(El)
+ cerl:set_ann(pat_to_expr(El), [compiler_generated])
catch
throw:impossible ->
Call
@@ -1008,28 +1015,32 @@ eval_is_record(Call, _, _, _, _) -> Call.
%% eval_setelement(Call, Pos, Tuple, NewVal) -> Core.
%% Evaluates setelement/3 if position Pos is an integer
-%% the shape of the tuple Tuple is known.
+%% and the shape of the tuple Tuple is known.
%%
-eval_setelement(Call, Pos, Tuple, NewVal) ->
- try
- eval_setelement_1(Pos, Tuple, NewVal)
- catch
- error:_ ->
- Call
- end.
-
-eval_setelement_1(#c_literal{val=Pos}, #c_tuple{anno=A,es=Es}, NewVal)
+eval_setelement(Call, #c_literal{val=Pos}, Tuple, NewVal)
when is_integer(Pos) ->
- ann_c_tuple(A, eval_setelement_2(Pos, Es, NewVal));
-eval_setelement_1(#c_literal{val=Pos}, #c_literal{anno=A,val=Es0}, NewVal)
- when is_integer(Pos) ->
- Es = [#c_literal{anno=A,val=E} || E <- tuple_to_list(Es0)],
- ann_c_tuple(A, eval_setelement_2(Pos, Es, NewVal)).
+ case cerl:is_data(Tuple) of
+ false ->
+ Call;
+ true ->
+ Es0 = case cerl:is_c_tuple(Tuple) of
+ false -> [];
+ true -> cerl:tuple_es(Tuple)
+ end,
+ if
+ 1 =< Pos, Pos =< length(Es0) ->
+ Es = eval_setelement_1(Pos, Es0, NewVal),
+ cerl:update_c_tuple(Tuple, Es);
+ true ->
+ eval_failure(Call, badarg)
+ end
+ end;
+eval_setelement(Call, _, _, _) -> Call.
-eval_setelement_2(1, [_|T], NewVal) ->
+eval_setelement_1(1, [_|T], NewVal) ->
[NewVal|T];
-eval_setelement_2(Pos, [H|T], NewVal) when Pos > 1 ->
- [H|eval_setelement_2(Pos-1, T, NewVal)].
+eval_setelement_1(Pos, [H|T], NewVal) when Pos > 1 ->
+ [H|eval_setelement_1(Pos-1, T, NewVal)].
%% eval_failure(Call, Reason) -> Core.
%% Warn for a call that will fail and replace the call with
@@ -1603,6 +1614,7 @@ eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,
%% is correct, the clause will always match at run-time.
Case;
{true,Bs} ->
+ eval_case_warn(B),
{Ps,As} = unzip(Bs),
InnerLet = cerl:c_let(Ps, core_lib:make_values(As), B),
Let = cerl:c_let(Vs, E, InnerLet),
@@ -1610,6 +1622,19 @@ eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,
end;
eval_case(Case, _) -> Case.
+eval_case_warn(#c_primop{anno=Anno,
+ name=#c_literal{val=match_fail},
+ args=[#c_literal{val=Reason}]}=Core)
+ when is_atom(Reason) ->
+ case member(eval_failure, Anno) of
+ false ->
+ ok;
+ true ->
+ %% Example: M = not_map, M#{k:=v}
+ add_warning(Core, {eval_failure,Reason})
+ end;
+eval_case_warn(_) -> ok.
+
%% case_opt(CaseArg, [Clause]) -> {CaseArg,[Clause]}.
%% Try and optimise a case by avoid building tuples or lists
%% in the case expression. Instead combine the variable parts
@@ -1941,46 +1966,125 @@ letify(Bs, Body) ->
cerl:ann_c_let(Ann, [V], Val, B)
end, Body, Bs).
-%% opt_case_in_let(LetExpr) -> LetExpr'
+%% opt_not_in_let(Let) -> Cerl
+%% Try to optimize away a 'not' operator in a 'let'.
-opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) ->
- opt_case_in_let_0(Vs, Arg, B, Let, Sub).
+-spec opt_not_in_let(cerl:c_let()) -> cerl:cerl().
-opt_case_in_let_0([#c_var{name=V}], Arg,
- #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let, Sub) ->
- case opt_case_in_let_1(V, Arg, Cs) of
- impossible ->
- case is_simple_case_arg(Arg) andalso
- not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of
- true ->
- expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new(Sub));
- false ->
- Let
+opt_not_in_let(#c_let{vars=[_]=Vs0,arg=Arg0,body=Body0}=Let) ->
+ case opt_not_in_let(Vs0, Arg0, Body0) of
+ {[],#c_values{es=[]},Body} ->
+ Body;
+ {Vs,Arg,Body} ->
+ Let#c_let{vars=Vs,arg=Arg,body=Body}
+ end;
+opt_not_in_let(Let) -> Let.
+
+%% opt_not_in_let(Vs, Arg, Body) -> {Vs',Arg',Body'}
+%% Try to optimize away a 'not' operator in a 'let'.
+
+-spec opt_not_in_let([cerl:c_var()], cerl:cerl(), cerl:cerl()) ->
+ {[cerl:c_var()],cerl:cerl(),cerl:cerl()}.
+
+opt_not_in_let([#c_var{name=V}]=Vs0, Arg0, Body0) ->
+ case cerl:type(Body0) of
+ call ->
+ %% let <V> = Expr in not V ==>
+ %% let <> = <> in notExpr
+ case opt_not_in_let_1(V, Body0, Arg0) of
+ no ->
+ {Vs0,Arg0,Body0};
+ {yes,Body} ->
+ {[],#c_values{es=[]},Body}
end;
- Expr -> Expr
+ 'let' ->
+ %% let <V> = Expr in let <Var> = not V in Body ==>
+ %% let <Var> = notExpr in Body
+ %% V must not be used in Body.
+ LetArg = cerl:let_arg(Body0),
+ case opt_not_in_let_1(V, LetArg, Arg0) of
+ no ->
+ {Vs0,Arg0,Body0};
+ {yes,Arg} ->
+ LetBody = cerl:let_body(Body0),
+ case core_lib:is_var_used(V, LetBody) of
+ true ->
+ {Vs0,Arg0,Body0};
+ false ->
+ LetVars = cerl:let_vars(Body0),
+ {LetVars,Arg,LetBody}
+ end
+ end;
+ _ ->
+ {Vs0,Arg0,Body0}
end;
-opt_case_in_let_0(_, _, _, Let, _) -> Let.
-
-opt_case_in_let_1(V, Arg, Cs) ->
- try
- opt_case_in_let_2(V, Arg, Cs)
- catch
- _:_ -> impossible
+opt_not_in_let(Vs, Arg, Body) ->
+ {Vs,Arg,Body}.
+
+opt_not_in_let_1(V, Call, Body) ->
+ case Call of
+ #c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val='not'},
+ args=[#c_var{name=V}]} ->
+ opt_not_in_let_2(Body);
+ _ ->
+ no
end.
-opt_case_in_let_2(V, Arg0,
- [#c_clause{pats=[#c_tuple{es=Es}],
- guard=#c_literal{val=true},body=B}|_]) ->
+opt_not_in_let_2(#c_case{clauses=Cs0}=Case) ->
+ Vars = make_vars([], 1),
+ Body = #c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val='not'},
+ args=Vars},
+ Cs = [begin
+ Let = #c_let{vars=Vars,arg=B,body=Body},
+ C#c_clause{body=opt_not_in_let(Let)}
+ end || #c_clause{body=B}=C <- Cs0],
+ {yes,Case#c_case{clauses=Cs}};
+opt_not_in_let_2(#c_call{}=Call0) ->
+ invert_call(Call0);
+opt_not_in_let_2(_) -> no.
+
+invert_call(#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=Name0},
+ args=[_,_]}=Call) ->
+ case inverse_rel_op(Name0) of
+ no -> no;
+ Name -> {yes,Call#c_call{name=#c_literal{val=Name}}}
+ end;
+invert_call(#c_call{}) -> no.
- %% In {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end.
- %% avoid building tuples, by converting tuples to multiple values.
- %% (The optimisation is not done if the built tuple is used or returned.)
+%% inverse_rel_op(Op) -> no | RevOp
- true = all(fun (#c_var{}) -> true;
- (_) -> false end, Es), %Only variables in tuple
- false = core_lib:is_var_used(V, B), %Built tuple must not be used.
- Arg1 = tuple_to_values(Arg0, length(Es)), %Might fail.
- #c_let{vars=Es,arg=Arg1,body=B}.
+inverse_rel_op('=:=') -> '=/=';
+inverse_rel_op('=/=') -> '=:=';
+inverse_rel_op('==') -> '/=';
+inverse_rel_op('/=') -> '==';
+inverse_rel_op('>') -> '=<';
+inverse_rel_op('<') -> '>=';
+inverse_rel_op('>=') -> '<';
+inverse_rel_op('=<') -> '>';
+inverse_rel_op(_) -> no.
+
+
+%% opt_bool_case_in_let(LetExpr, Sub) -> Core
+
+opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) ->
+ opt_case_in_let_1(Vs, Arg, B, Let, Sub).
+
+opt_case_in_let_1([#c_var{name=V}], Arg,
+ #c_case{arg=#c_var{name=V}}=Case0, Let, Sub) ->
+ case is_simple_case_arg(Arg) of
+ true ->
+ Case = opt_bool_case(Case0#c_case{arg=Arg}),
+ case core_lib:is_var_used(V, Case) of
+ false -> expr(Case, sub_new(Sub));
+ true -> Let
+ end;
+ false ->
+ Let
+ end;
+opt_case_in_let_1(_, _, _, Let, _) -> Let.
%% is_simple_case_arg(Expr) -> true|false
%% Determine whether the Expr is simple enough to be worth
@@ -2022,7 +2126,7 @@ 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, [#c_literal{val=true}], Sub0);
+ true -> update_types(V, [bool], Sub0);
false -> Sub0
end,
is_bool_expr(B, Sub);
@@ -2108,38 +2212,6 @@ is_safe_bool_expr_list([C|Cs], Sub, BoolVars) ->
end;
is_safe_bool_expr_list([], _, _) -> true.
-%% tuple_to_values(Expr, TupleArity) -> Expr'
-%% Convert tuples in return position of arity TupleArity to values.
-%% Throws an exception for constructs that are not handled.
-
-tuple_to_values(#c_tuple{es=Es}, Arity) when length(Es) =:= Arity ->
- core_lib:make_values(Es);
-tuple_to_values(#c_literal{val=Tuple}=Lit, Arity) when tuple_size(Tuple) =:= Arity ->
- Es = [Lit#c_literal{val=E} || E <- tuple_to_list(Tuple)],
- core_lib:make_values(Es);
-tuple_to_values(#c_case{clauses=Cs0}=Case, Arity) ->
- Cs1 = [tuple_to_values(E, Arity) || E <- Cs0],
- Case#c_case{clauses=Cs1};
-tuple_to_values(#c_seq{body=B0}=Seq, Arity) ->
- Seq#c_seq{body=tuple_to_values(B0, Arity)};
-tuple_to_values(#c_let{body=B0}=Let, Arity) ->
- Let#c_let{body=tuple_to_values(B0, Arity)};
-tuple_to_values(#c_receive{clauses=Cs0,timeout=Timeout,action=A0}=Rec, Arity) ->
- Cs = [tuple_to_values(E, Arity) || E <- Cs0],
- A = case Timeout of
- #c_literal{val=infinity} -> A0;
- _ -> tuple_to_values(A0, Arity)
- end,
- Rec#c_receive{clauses=Cs,action=A};
-tuple_to_values(#c_clause{body=B0}=Clause, Arity) ->
- B = tuple_to_values(B0, Arity),
- Clause#c_clause{body=B};
-tuple_to_values(Expr, _) ->
- case will_fail(Expr) of
- true -> Expr;
- false -> erlang:error({not_handled,Expr})
- end.
-
%% simplify_let(Let, Sub) -> Expr | impossible
%% If the argument part of an let contains a complex expression, such
%% as a let or a sequence, move the original let body into the complex
@@ -2166,7 +2238,7 @@ move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner,
Arg = body(Arg0, Sub0),
ScopeSub0 = sub_subst_scope(Sub0#sub{t=[]}),
{OuterVs,ScopeSub} = pattern_list(OuterVs0, ScopeSub0),
-
+
OuterBody = body(OuterBody0, ScopeSub),
{InnerVs,Sub} = pattern_list(InnerVs0, Sub0),
@@ -2244,50 +2316,179 @@ move_let_into_expr(_Let, _Expr, _Sub) -> impossible.
is_failing_clause(#c_clause{body=B}) ->
will_fail(B).
+%% opt_case_in_let(Let) -> Let'
+%% Try to avoid building tuples that are immediately matched.
+%% A common pattern is:
+%%
+%% {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end
+%%
+%% In Core Erlang the pattern would look like this:
+%%
+%% let <V> = case E of
+%% ... -> ... {Val1,Val2}
+%% ...
+%% end,
+%% in case V of
+%% {A,B} -> ... <use A and B> ...
+%% end
+%%
+%% Rewrite this to:
+%%
+%% let <V1,V2> = case E of
+%% ... -> ... <Val1,Val2>
+%% ...
+%% end,
+%% in
+%% let <V> = {V1,V2}
+%% in case V of
+%% {A,B} -> ... <use A and B> ...
+%% end
+%%
+%% Note that the second 'case' is unchanged. The other optimizations
+%% in this module will eliminate the building of the tuple and
+%% rewrite the second case to:
+%%
+%% case <V1,V2> of
+%% <A,B> -> ... <use A and B> ...
+%% end
+%%
+
+opt_case_in_let(#c_let{vars=Vs,arg=Arg0,body=B}=Let0) ->
+ case matches_data(Vs, B) of
+ {yes,TypeSig} ->
+ case delay_build(Arg0, TypeSig) of
+ no ->
+ Let0;
+ {yes,Vars,Arg,Data} ->
+ InnerLet = Let0#c_let{arg=Data},
+ Let0#c_let{vars=Vars,arg=Arg,body=InnerLet}
+ end;
+ no ->
+ Let0
+ end.
+
+matches_data([#c_var{name=V}], #c_case{arg=#c_var{name=V},
+ clauses=[#c_clause{pats=[P]}|_]}) ->
+ case cerl:is_data(P) of
+ false ->
+ no;
+ true ->
+ case cerl:data_type(P) of
+ {atomic,_} ->
+ no;
+ Type ->
+ {yes,{Type,cerl:data_arity(P)}}
+ end
+ end;
+matches_data(_, _) -> no.
+
+delay_build(Core, TypeSig) ->
+ case cerl:is_data(Core) of
+ true -> no;
+ false -> delay_build_1(Core, TypeSig)
+ end.
+
+delay_build_1(Core0, TypeSig) ->
+ try delay_build_expr(Core0, TypeSig) of
+ Core ->
+ {Type,Arity} = TypeSig,
+ Vars = make_vars([], Arity),
+ Data = cerl:ann_make_data([compiler_generated], Type, Vars),
+ {yes,Vars,Core,Data}
+ catch
+ throw:impossible ->
+ no
+ end.
+
+delay_build_cs([#c_clause{body=B0}=C0|Cs], TypeSig) ->
+ B = delay_build_expr(B0, TypeSig),
+ C = C0#c_clause{body=B},
+ [C|delay_build_cs(Cs, TypeSig)];
+delay_build_cs([], _) -> [].
+
+delay_build_expr(Core, {Type,Arity}=TypeSig) ->
+ case cerl:is_data(Core) of
+ false ->
+ delay_build_expr_1(Core, TypeSig);
+ true ->
+ case {cerl:data_type(Core),cerl:data_arity(Core)} of
+ {Type,Arity} ->
+ core_lib:make_values(cerl:data_es(Core));
+ {_,_} ->
+ throw(impossible)
+ end
+ end.
+
+delay_build_expr_1(#c_case{clauses=Cs0}=Case, TypeSig) ->
+ Cs = delay_build_cs(Cs0, TypeSig),
+ Case#c_case{clauses=Cs};
+delay_build_expr_1(#c_let{body=B0}=Let, TypeSig) ->
+ B = delay_build_expr(B0, TypeSig),
+ Let#c_let{body=B};
+delay_build_expr_1(#c_receive{clauses=Cs0,
+ timeout=Timeout,
+ action=A0}=Rec, TypeSig) ->
+ Cs = delay_build_cs(Cs0, TypeSig),
+ A = case Timeout of
+ #c_literal{val=infinity} -> A0;
+ _ -> delay_build_expr(A0, TypeSig)
+ end,
+ Rec#c_receive{clauses=Cs,action=A};
+delay_build_expr_1(#c_seq{body=B0}=Seq, TypeSig) ->
+ B = delay_build_expr(B0, TypeSig),
+ Seq#c_seq{body=B};
+delay_build_expr_1(Core, _TypeSig) ->
+ case will_fail(Core) of
+ true -> Core;
+ false -> throw(impossible)
+ end.
+
%% opt_simple_let(#c_let{}, Context, Sub) -> CoreTerm
%% Optimize a let construct that does not contain any lets in
%% in its argument.
-opt_simple_let(#c_let{arg=Arg0}=Let, Ctxt, Sub0) ->
- Arg = body(Arg0, value, Sub0), %This is a body
+opt_simple_let(Let0, Ctxt, Sub) ->
+ case opt_not_in_let(Let0) of
+ #c_let{}=Let ->
+ opt_simple_let_0(Let, Ctxt, Sub);
+ Expr ->
+ expr(Expr, Ctxt, Sub)
+ end.
+
+opt_simple_let_0(#c_let{arg=Arg0}=Let, Ctxt, Sub) ->
+ Arg = body(Arg0, value, Sub), %This is a body
case will_fail(Arg) of
true -> Arg;
- false -> opt_simple_let_1(Let, Arg, Ctxt, Sub0)
+ false -> opt_simple_let_1(Let, Arg, Ctxt, Sub)
end.
opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) ->
%% Optimise let and add new substitutions.
- {Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0),
- BodySub = case {Vs,Args} of
- {[V],[A]} ->
- case is_bool_expr(A, Sub0) of
- true ->
- update_types(V, [#c_literal{val=true}], Sub1);
- false ->
- Sub1
- end;
- {_,_} -> Sub1
- end,
- B = body(B0, Ctxt, BodySub),
- Arg = core_lib:make_values(Args),
- opt_simple_let_2(Let, Vs, Arg, B, Ctxt, Sub1).
-
-opt_simple_let_2(Let0, Vs0, Arg0, Body, Ctxt, Sub) ->
+ {Vs1,Args,Sub1} = let_substs(Vs0, Arg0, Sub0),
+ BodySub = update_let_types(Vs1, Args, Sub1),
+ B1 = body(B0, Ctxt, BodySub),
+ Arg1 = core_lib:make_values(Args),
+ {Vs,Arg,B} = opt_not_in_let(Vs1, Arg1, B1),
+ opt_simple_let_2(Let, Vs, Arg, B, B0, Ctxt, Sub1).
+
+opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) ->
case {Vs0,Arg0,Body} of
- {[#c_var{name=N1}],Arg,#c_var{name=N2}} ->
+ {[#c_var{name=N1}],Arg1,#c_var{name=N2}} ->
case N1 =:= N2 of
true ->
%% let <Var> = Arg in <Var> ==> Arg
- Arg;
+ Arg1;
false ->
%% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar
+ Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody, Ctxt),
expr(#c_seq{arg=Arg,body=Body}, Ctxt,
sub_new_preserve_types(Sub))
end;
{[],#c_values{es=[]},_} ->
%% No variables left.
Body;
- {_,Arg,#c_literal{}} ->
+ {Vs,Arg1,#c_literal{}} ->
+ Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt),
E = case Ctxt of
effect ->
%% Throw away the literal body.
@@ -2299,22 +2500,50 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, Ctxt, Sub) ->
#c_seq{arg=Arg,body=Body}
end,
expr(E, Ctxt, sub_new_preserve_types(Sub));
- {Vs,Arg,Body} ->
+ {Vs,Arg1,Body} ->
%% If none of the variables are used in the body, we can
%% rewrite the let to a sequence:
%% let <Var> = Arg in BodyWithoutVar ==>
%% seq Arg BodyWithoutVar
case is_any_var_used(Vs, Body) of
false ->
+ Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt),
expr(#c_seq{arg=Arg,body=Body}, Ctxt,
sub_new_preserve_types(Sub));
true ->
- Let1 = Let0#c_let{vars=Vs,arg=Arg,body=Body},
- Let2 = opt_case_in_let(Let1, Sub),
+ Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body},
+ Let2 = opt_bool_case_in_let(Let1, Sub),
opt_case_in_let_arg(Let2, Ctxt, Sub)
end
end.
+%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody, Context) -> Arg'
+%% Try to suppress false warnings when a variable is not used.
+%% For instance, we don't expect a warning for useless building in:
+%%
+%% R = #r{}, %No warning expected.
+%% R#r.f %Optimization would remove the reference to R.
+%%
+%% To avoid false warnings, we will check whether the variables were
+%% referenced in the original unoptimized code. If they were, we will
+%% consider the warning false and suppress it.
+
+maybe_suppress_warnings(Arg, _, _, effect) ->
+ %% Don't suppress any warnings in effect context.
+ Arg;
+maybe_suppress_warnings(Arg, Vs, PrevBody, value) ->
+ case suppress_warning(Arg) of
+ true ->
+ Arg; %Already suppressed.
+ false ->
+ case is_any_var_used(Vs, PrevBody) of
+ true ->
+ cerl:set_ann(Arg, [compiler_generated]);
+ false ->
+ Arg
+ end
+ end.
+
move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg,
body=InnerArg0}=Outer,
clauses=InnerClauses}=Inner, Sub) ->
@@ -2402,7 +2631,7 @@ move_case_into_arg(_, _) ->
%% <> 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
@@ -2476,6 +2705,7 @@ is_boolean_type(Var, Sub) ->
is_int_type(Var, Sub) ->
case get_type(Var, Sub) of
none -> maybe;
+ integer -> yes;
C -> yes_no(cerl:is_c_int(C))
end.
@@ -2490,8 +2720,58 @@ is_tuple_type(Var, Sub) ->
yes_no(true) -> yes;
yes_no(false) -> no.
+%%%
+%%% Update type information.
+%%%
+
+update_let_types(Vs, Args, Sub) when is_list(Args) ->
+ update_let_types_1(Vs, Args, Sub);
+update_let_types(_Vs, _Arg, Sub) ->
+ %% The argument is a complex expression (such as a 'case')
+ %% 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(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(bit_size, [_]) -> true;
+returns_integer('bsl', [_,_]) -> true;
+returns_integer('bsr', [_,_]) -> true;
+returns_integer(byte_size, [_]) -> true;
+returns_integer(length, [_]) -> true;
+returns_integer('rem', [_,_]) -> 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:cerl(), [type_info()], sub()) -> sub().
+
update_types(Expr, Pat, #sub{t=Tdb0}=Sub) ->
Tdb = update_types_1(Expr, Pat, Tdb0),
Sub#sub{t=Tdb}.
@@ -2511,6 +2791,8 @@ update_types_2(V, [#c_tuple{}=P], Types) ->
orddict:store(V, P, Types);
update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) ->
orddict:store(V, bool, Types);
+update_types_2(V, [Type], Types) when is_atom(Type) ->
+ orddict:store(V, Type, Types);
update_types_2(_, _, Types) -> Types.
%% kill_types(V, Tdb) -> Tdb'
@@ -2777,7 +3059,7 @@ bsm_ensure_no_partition_after([#c_clause{pats=Ps}|Cs], Pos) ->
bsm_problem(P, bin_partition)
end;
bsm_ensure_no_partition_after([], _) -> ok.
-
+
bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P);
bsm_could_match_binary(#c_cons{}) -> false;
bsm_could_match_binary(#c_tuple{}) -> false;
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 8c1a0c08ac..7eec9dd62b 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -69,10 +69,8 @@
stk=[], %Stack table
res=[]}). %Reserved regs: [{reserved,I,V}]
-module({Mod,Exp,Attr,Forms}, Options) ->
- put(?MODULE, Options),
+module({Mod,Exp,Attr,Forms}, _Options) ->
{Fs,St} = functions(Forms, {atom,Mod}),
- erase(?MODULE),
{ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}.
functions(Forms, AtomMod) ->
@@ -924,7 +922,7 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) ->
select_map(Scs, V, Tf, Vf, Bef, St0) ->
Reg = fetch_var(V, Bef),
{Is,Aft,St1} =
- match_fmf(fun(#l{ke={val_clause,{map,_,Es},B},i=I,vdb=Vdb}, Fail, St1) ->
+ match_fmf(fun(#l{ke={val_clause,{map,exact,_,Es},B},i=I,vdb=Vdb}, Fail, St1) ->
select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1)
end, Vf, St0, Scs),
{[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}.
@@ -1523,9 +1521,11 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef,
List = [cg_reg_arg(K,Int0),cg_reg_arg(V,Int0)],
Live = max_reg(Bef#sr.reg),
- Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)},
- Aft = clear_dead(Int1, Le#l.i, Vdb),
- Target = fetch_reg(R, Int1#sr.reg),
+
+ %% The target register can reuse one of the source registers.
+ Aft0 = clear_dead(Int0, Le#l.i, Vdb),
+ Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)},
+ Target = fetch_reg(R, Aft#sr.reg),
I = case Op of
assoc -> put_map_assoc;
@@ -1557,9 +1557,11 @@ set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef,
List = flatmap(fun({K,V}) -> [K,cg_reg_arg(V,Int0)] end, Pairs),
Live = max_reg(Bef#sr.reg),
- Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)},
- Aft = clear_dead(Int1, Le#l.i, Vdb),
- Target = fetch_reg(R, Int1#sr.reg),
+
+ %% The target register can reuse one of the source registers.
+ Aft0 = clear_dead(Int0, Le#l.i, Vdb),
+ Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)},
+ Target = fetch_reg(R, Aft#sr.reg),
I = case Op of
assoc -> put_map_assoc;
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 9dd6b319a3..c954d21e59 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -78,7 +78,7 @@
splitwith/2,keyfind/3,sort/1,foreach/2,droplast/1,last/1]).
-import(ordsets, [add_element/2,del_element/2,is_element/2,
union/1,union/2,intersection/2,subtract/2]).
--import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1,
+-import(cerl, [ann_c_cons/3,ann_c_tuple/2,c_tuple/1,
ann_c_map/3]).
-include("core_parse.hrl").
@@ -758,30 +758,28 @@ make_bool_switch_guard(L, E, V, T, F) ->
{clause,NegL,[V],[],[V]}
]}.
-expr_map(M0,Es0,A,St0) ->
- {M1,Mps,St1} = safe(M0, St0),
+expr_map(M0, Es0, A, St0) ->
+ {M1,Eps0,St1} = safe(M0, St0),
case is_valid_map_src(M1) of
true ->
- case {M1,Es0} of
- {#c_var{}, []} ->
- %% transform M#{} to is_map(M)
- {Vpat,St2} = new_var(St1),
- {Fpat,St3} = new_var(St2),
- Cs = [#iclause{
- anno=A,
- pats=[Vpat],
- guard=[#icall{anno=#a{anno=A},
+ {M2,Eps1,St2} = map_build_pairs(M1, Es0, A, St1),
+ M3 = case Es0 of
+ [] -> M1;
+ [_|_] -> M2
+ end,
+ Cs = [#iclause{
+ anno=#a{anno=[compiler_generated|A]},
+ pats=[],
+ guard=[#icall{anno=#a{anno=A},
module=#c_literal{anno=A,val=erlang},
name=#c_literal{anno=A,val=is_map},
- args=[Vpat]}],
- body=[Vpat]}],
- Fc = fail_clause([Fpat], A, #c_literal{val=badarg}),
- {#icase{anno=#a{anno=A},args=[M1],clauses=Cs,fc=Fc},Mps,St3};
- {_,_} ->
- {M2,Eps,St2} = map_build_pairs(M1, Es0, A, St1),
- {M2,Mps++Eps,St2}
- end;
- false -> throw({bad_map,bad_map})
+ args=[M1]}],
+ body=[M3]}],
+ Fc = fail_clause([], [eval_failure|A], #c_literal{val=badarg}),
+ Eps = Eps0 ++ Eps1,
+ {#icase{anno=#a{anno=A},args=[],clauses=Cs,fc=Fc},Eps,St2};
+ false ->
+ throw({bad_map,bad_map})
end.
map_build_pairs(Map, Es0, Ann, St0) ->
@@ -1623,49 +1621,30 @@ pattern_map_pairs(Ps, St) ->
{CMapPair,EpsP,Sti1} = pattern_map_pair(P,Sti0),
{CMapPair, {EpsM++EpsP,Sti1}}
end, {[],St}, Ps),
- {pat_alias_map_pairs(CMapPairs,[]),Eps,St1}.
-
-%% remove cluddering annotations
-pattern_map_clean_key(#c_literal{val=V}) -> {literal,V};
-pattern_map_clean_key(#c_var{name=V}) -> {var,V}.
-
-pat_alias_map_pairs(Ps1,Ps2) ->
- Ps = Ps1 ++ Ps2,
- F = fun(#c_map_pair{key=Ck,val=Cv},Dbi) ->
- K = pattern_map_clean_key(Ck),
- case dict:find(K,Dbi) of
- {ok,Cvs} -> dict:store(K,[Cv|Cvs],Dbi);
- _ -> dict:store(K,[Cv],Dbi)
- end
- end,
- Kdb = lists:foldl(F,dict:new(),Ps),
- pat_alias_map_pairs(Ps,Kdb,sets:new()).
-
-pat_alias_map_pairs([],_,_) -> [];
-pat_alias_map_pairs([#c_map_pair{key=Ck}=Pair|Pairs],Kdb,Set) ->
- K = pattern_map_clean_key(Ck),
- case sets:is_element(K,Set) of
- true ->
- pat_alias_map_pairs(Pairs,Kdb,Set);
- false ->
- Cvs = dict:fetch(K,Kdb),
- Cv = pat_alias_map_pair_values(Cvs),
- Set1 = sets:add_element(K,Set),
- [Pair#c_map_pair{val=Cv}|pat_alias_map_pairs(Pairs,Kdb,Set1)]
- end.
-
-pat_alias_map_pair_values([Cv]) -> Cv;
-pat_alias_map_pair_values([Cv1,Cv2|Cvs]) ->
- pat_alias_map_pair_values([pat_alias(Cv1,Cv2)|Cvs]).
+ {pat_alias_map_pairs(CMapPairs),Eps,St1}.
pattern_map_pair({map_field_exact,L,K,V}, St0) ->
- {Ck,EpsK,St1} = safe_pattern_expr(K,St0),
+ {Ck,EpsK,St1} = safe_pattern_expr(K, St0),
{Cv,EpsV,St2} = pattern(V, St1),
- {#c_map_pair{anno=lineno_anno(L,St2),
+ {#c_map_pair{anno=lineno_anno(L, St2),
op=#c_literal{val=exact},
key=Ck,
val=Cv},EpsK++EpsV,St2}.
+pat_alias_map_pairs(Ps) ->
+ D = foldl(fun(#c_map_pair{key=K0}=Pair, D0) ->
+ K = cerl:set_ann(K0, []),
+ dict:append(K, Pair, D0)
+ end, dict:new(), Ps),
+ pat_alias_map_pairs_1(dict:to_list(D)).
+
+pat_alias_map_pairs_1([{_,[#c_map_pair{val=V0}=Pair|Vs]}|T]) ->
+ V = foldl(fun(#c_map_pair{val=V}, Pat) ->
+ pat_alias(V, Pat)
+ end, V0, Vs),
+ [Pair#c_map_pair{val=V}|pat_alias_map_pairs_1(T)];
+pat_alias_map_pairs_1([]) -> [].
+
%% pat_bin([BinElement], State) -> [BinSeg].
pat_bin(Ps, St) -> [pat_segment(P, St) || P <- Ps].
@@ -1681,48 +1660,55 @@ pat_segment({bin_element,_,Val,Size,[Type,{unit,Unit}|Flags]}, St) ->
%% pat_alias(CorePat, CorePat) -> AliasPat.
%% Normalise aliases. Trap bad aliases by throwing 'nomatch'.
-pat_alias(#c_var{name=V1}, P2) -> #c_alias{var=#c_var{name=V1},pat=P2};
-pat_alias(P1, #c_var{name=V2}) -> #c_alias{var=#c_var{name=V2},pat=P1};
-
-%% alias cons
-pat_alias(#c_cons{}=Cons, #c_literal{anno=A,val=[H|T]}=S) ->
- pat_alias(Cons, ann_c_cons_skel(A, #c_literal{anno=A,val=H},
- S#c_literal{val=T}));
-pat_alias(#c_literal{anno=A,val=[H|T]}=S, #c_cons{}=Cons) ->
- pat_alias(ann_c_cons_skel(A, #c_literal{anno=A,val=H},
- S#c_literal{val=T}), Cons);
-pat_alias(#c_cons{anno=Anno,hd=H1,tl=T1}, #c_cons{hd=H2,tl=T2}) ->
- ann_c_cons(Anno, pat_alias(H1, H2), pat_alias(T1, T2));
-
-%% alias tuples
-pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_literal{val=T}) when is_tuple(T) ->
- Es2 = [#c_literal{val=E} || E <- tuple_to_list(T)],
- ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
-pat_alias(#c_literal{anno=Anno,val=T}, #c_tuple{es=Es2}) when is_tuple(T) ->
- Es1 = [#c_literal{val=E} || E <- tuple_to_list(T)],
- ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
-pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_tuple{es=Es2}) ->
- ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
-
-%% alias maps
-%% There are no literals in maps patterns (patterns are always abstract)
-pat_alias(#c_map{es=Es1}=M,#c_map{es=Es2}) ->
- M#c_map{es=pat_alias_map_pairs(Es1,Es2)};
-
-pat_alias(#c_alias{var=V1,pat=P1},
- #c_alias{var=V2,pat=P2}) ->
- if V1 =:= V2 -> #c_alias{var=V1,pat=pat_alias(P1, P2)};
- true -> #c_alias{var=V1,pat=#c_alias{var=V2,pat=pat_alias(P1, P2)}}
+pat_alias(#c_var{name=V1}=P, #c_var{name=V1}) -> P;
+pat_alias(#c_var{name=V1}=Var,
+ #c_alias{var=#c_var{name=V2},pat=Pat}=Alias) ->
+ if
+ V1 =:= V2 ->
+ Alias;
+ true ->
+ Alias#c_alias{pat=pat_alias(Var, Pat)}
end;
-pat_alias(#c_alias{var=V1,pat=P1}, P2) ->
- #c_alias{var=V1,pat=pat_alias(P1, P2)};
-pat_alias(P1, #c_alias{var=V2,pat=P2}) ->
- #c_alias{var=V2,pat=pat_alias(P1, P2)};
+pat_alias(#c_var{}=P1, P2) -> #c_alias{var=P1,pat=P2};
+
+pat_alias(#c_alias{var=#c_var{name=V1}}=Alias, #c_var{name=V1}) ->
+ Alias;
+pat_alias(#c_alias{var=#c_var{name=V1}=Var1,pat=P1},
+ #c_alias{var=#c_var{name=V2}=Var2,pat=P2}) ->
+ Pat = pat_alias(P1, P2),
+ if
+ V1 =:= V2 ->
+ #c_alias{var=Var1,pat=Pat};
+ true ->
+ pat_alias(Var1, pat_alias(Var2, Pat))
+ end;
+pat_alias(#c_alias{var=#c_var{}=Var,pat=P1}, P2) ->
+ #c_alias{var=Var,pat=pat_alias(P1, P2)};
+
+pat_alias(#c_map{es=Es1}=M, #c_map{es=Es2}) ->
+ M#c_map{es=pat_alias_map_pairs(Es1 ++ Es2)};
+
+pat_alias(P1, #c_var{}=Var) ->
+ #c_alias{var=Var,pat=P1};
+pat_alias(P1, #c_alias{pat=P2}=Alias) ->
+ Alias#c_alias{pat=pat_alias(P1, P2)};
+
pat_alias(P1, P2) ->
- case {set_anno(P1, []),set_anno(P2, [])} of
- {P,P} -> P;
+ %% Aliases between binaries are not allowed, so the only
+ %% legal patterns that remain are data patterns.
+ case cerl:is_data(P1) andalso cerl:is_data(P2) of
+ false -> throw(nomatch);
+ true -> ok
+ end,
+ Type = cerl:data_type(P1),
+ case cerl:data_type(P2) of
+ Type -> ok;
_ -> throw(nomatch)
- end.
+ end,
+ Es1 = cerl:data_es(P1),
+ Es2 = cerl:data_es(P2),
+ Es = pat_alias_list(Es1, Es2),
+ cerl:make_data(Type, Es).
%% pat_alias_list([A1], [A2]) -> [A].
@@ -1819,7 +1805,7 @@ uclauses(Lcs, Ks, St0) ->
uclause(Cl0, Ks, St0) ->
{Cl1,_Pvs,Used,New,St1} = uclause(Cl0, Ks, Ks, St0),
- A0 = get_ianno(Cl1),
+ A0 = get_anno(Cl1),
A = A0#a{us=Used,ns=New},
{Cl1#iclause{anno=A},St1}.
@@ -2006,7 +1992,7 @@ ufun_clauses(Lcs, Ks, St0) ->
ufun_clause(Cl0, Ks, St0) ->
{Cl1,Pvs,Used,_,St1} = uclause(Cl0, [], Ks, St0),
- A0 = get_ianno(Cl1),
+ A0 = get_anno(Cl1),
A = A0#a{us=subtract(intersection(Used, Ks), Pvs),ns=[]},
{Cl1#iclause{anno=A},St1}.
@@ -2354,12 +2340,6 @@ lineno_anno(L, St) ->
[Line] ++ St#core.file
end.
-get_ianno(Ce) ->
- case get_anno(Ce) of
- #a{}=A -> A;
- A when is_list(A) -> #a{anno=A}
- end.
-
get_lineno_anno(Ce) ->
case get_anno(Ce) of
#a{anno=A} -> A;
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 08e84efc1b..0ac1aaf158 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -273,17 +273,7 @@ expr(#c_tuple{anno=A,es=Ces}, Sub, St0) ->
{Kes,Ep,St1} = atomic_list(Ces, Sub, St0),
{#k_tuple{anno=A,es=Kes},Ep,St1};
expr(#c_map{anno=A,arg=Var,es=Ces}, Sub, St0) ->
- try expr_map(A,Var,Ces,Sub,St0) of
- {_,_,_}=Res -> Res
- catch
- throw:bad_map ->
- St1 = add_warning(get_line(A), bad_map, A, St0),
- Erl = #c_literal{val=erlang},
- Name = #c_literal{val=error},
- Args = [#c_literal{val=badarg}],
- Error = #c_call{anno=A,module=Erl,name=Name,args=Args},
- expr(Error, Sub, St1)
- end;
+ expr_map(A, Var, Ces, Sub, St0);
expr(#c_binary{anno=A,segments=Cv}, Sub, St0) ->
try atomic_bin(Cv, Sub, St0) of
{Kv,Ep,St1} ->
@@ -506,19 +496,9 @@ translate_fc(Args) ->
[#c_literal{val=function_clause},make_list(Args)].
expr_map(A,Var0,Ces,Sub,St0) ->
- %% An extra pass of validation of Map src because of inlining
{Var,Mps,St1} = expr(Var0, Sub, St0),
- case is_valid_map_src(Var) of
- true ->
- {Km,Eps,St2} = map_split_pairs(A, Var, Ces, Sub, St1),
- {Km,Eps++Mps,St2};
- false -> throw(bad_map)
- end.
-
-is_valid_map_src(#k_map{}) -> true;
-is_valid_map_src(#k_literal{val=M}) when is_map(M) -> true;
-is_valid_map_src(#k_var{}) -> true;
-is_valid_map_src(_) -> false.
+ {Km,Eps,St2} = map_split_pairs(A, Var, Ces, Sub, St1),
+ {Km,Eps++Mps,St2}.
map_split_pairs(A, Var, Ces, Sub, St0) ->
%% 1. Force variables.
@@ -2024,9 +2004,7 @@ format_error(nomatch_shadow) ->
format_error(bad_call) ->
"invalid module and/or function name; this call will always fail";
format_error(bad_segment_size) ->
- "binary construction will fail because of a type mismatch";
-format_error(bad_map) ->
- "map construction will fail because of a type mismatch".
+ "binary construction will fail because of a type mismatch".
add_warning(none, Term, Anno, #kern{ws=Ws}=St) ->
File = get_file(Anno),
diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl
index cd4b5fd674..75bd188479 100644
--- a/lib/compiler/src/v3_life.erl
+++ b/lib/compiler/src/v3_life.erl
@@ -270,7 +270,7 @@ match(#k_select{anno=A,var=V,types=Kts}, Ls0, I, Ctxt, Vdb0) ->
end,
Vdb1 = use_vars(union(A#k.us, Ls1), I, Vdb0),
Ts = [type_clause(Tc, Ls1, I+1, Ctxt, Vdb1) || Tc <- Kts],
- #l{ke={select,literal2(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno};
+ #l{ke={select,literal(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno};
match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Ctxt, Vdb0) ->
Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0),
Cs = [guard_clause(G, Ls, I+1, Ctxt, Vdb1) || G <- Kcs],
@@ -297,7 +297,7 @@ val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Ctxt0, Vdb0) ->
_ -> Ctxt0
end,
B = match(Kb, Ls1, I+1, Ctxt, Vdb1),
- #l{ke={val_clause,literal2(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}.
+ #l{ke={val_clause,literal(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}.
guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) ->
Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0),
@@ -350,6 +350,7 @@ atomic_list(Ks) -> [atomic(K) || K <- Ks].
%% literal_list([Klit]) -> [Lit].
literal(#k_var{name=N}, _) -> {var,N};
+literal(#k_literal{val=I}, _) -> {literal,I};
literal(#k_int{val=I}, _) -> {integer,I};
literal(#k_float{val=F}, _) -> {float,F};
literal(#k_atom{val=N}, _) -> {atom,N};
@@ -358,58 +359,29 @@ literal(#k_nil{}, _) -> nil;
literal(#k_cons{hd=H,tl=T}, Ctxt) ->
{cons,[literal(H, Ctxt),literal(T, Ctxt)]};
literal(#k_binary{segs=V}, Ctxt) ->
- {binary,literal(V, Ctxt)};
+ {binary,literal(V, Ctxt)};
+literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) ->
+ %% Only occurs in patterns.
+ {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs,[literal(Seg, Ctxt)]};
literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) ->
{bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs,
[literal(Seg, Ctxt),literal(N, Ctxt)]};
+literal(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) ->
+ %% Only occurs in patterns.
+ {bin_int,Ctxt,literal(S, Ctxt),U,Fs,Int,
+ [literal(N, Ctxt)]};
literal(#k_bin_end{}, Ctxt) ->
{bin_end,Ctxt};
literal(#k_tuple{es=Es}, Ctxt) ->
{tuple,literal_list(Es, Ctxt)};
-literal(#k_map{op=Op,var=Var,es=Es}, Ctxt) ->
- {map,Op,literal(Var, Ctxt),literal_list(Es, Ctxt)};
+literal(#k_map{op=Op,var=Var,es=Es0}, Ctxt) ->
+ {map,Op,literal(Var, Ctxt),literal_list(Es0, Ctxt)};
literal(#k_map_pair{key=K,val=V}, Ctxt) ->
- {map_pair,literal(K, Ctxt),literal(V, Ctxt)};
-literal(#k_literal{val=V}, _Ctxt) ->
- {literal,V}.
+ {map_pair,literal(K, Ctxt),literal(V, Ctxt)}.
literal_list(Ks, Ctxt) ->
[literal(K, Ctxt) || K <- Ks].
-literal2(#k_var{name=N}, _) -> {var,N};
-literal2(#k_literal{val=I}, _) -> {literal,I};
-literal2(#k_int{val=I}, _) -> {integer,I};
-literal2(#k_float{val=F}, _) -> {float,F};
-literal2(#k_atom{val=N}, _) -> {atom,N};
-%%literal2(#k_char{val=C}, _) -> {char,C};
-literal2(#k_nil{}, _) -> nil;
-literal2(#k_cons{hd=H,tl=T}, Ctxt) ->
- {cons,[literal2(H, Ctxt),literal2(T, Ctxt)]};
-literal2(#k_binary{segs=V}, Ctxt) ->
- {binary,literal2(V, Ctxt)};
-literal2(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) ->
- {bin_seg,Ctxt,literal2(S, Ctxt),U,T,Fs,[literal2(Seg, Ctxt)]};
-literal2(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) ->
- {bin_seg,Ctxt,literal2(S, Ctxt),U,T,Fs,
- [literal2(Seg, Ctxt),literal2(N, Ctxt)]};
-literal2(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) ->
- {bin_int,Ctxt,literal2(S, Ctxt),U,Fs,Int,
- [literal2(N, Ctxt)]};
-literal2(#k_bin_end{}, Ctxt) ->
- {bin_end,Ctxt};
-literal2(#k_tuple{es=Es}, Ctxt) ->
- {tuple,literal_list2(Es, Ctxt)};
-literal2(#k_map{op=Op,es=Es}, Ctxt) ->
- {map,Op,literal_list2(Es, Ctxt)};
-literal2(#k_map_pair{key=K,val=V}, Ctxt) ->
- {map_pair,literal2(K, Ctxt),literal2(V, Ctxt)}.
-
-literal_list2(Ks, Ctxt) ->
- [literal2(K, Ctxt) || K <- Ks].
-
-%% literal_bin(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}) ->
-%% {bin_seg,literal(S),U,T,Fs,[literal(Seg),literal(N)]}
-
%% is_gc_bif(Name, Arity) -> true|false
%% Determines whether the BIF Name/Arity might do a GC.
diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl
index 3199440d84..4d7f444c4f 100644
--- a/lib/compiler/test/andor_SUITE.erl
+++ b/lib/compiler/test/andor_SUITE.erl
@@ -370,6 +370,11 @@ combined(Config) when is_list(Config) ->
?line true = ?COMB(false, blurf, true),
?line true = ?COMB(true, true, blurf),
+ false = simple_comb(false, false),
+ false = simple_comb(false, true),
+ false = simple_comb(true, false),
+ true = simple_comb(true, true),
+
ok.
-undef(COMB).
@@ -396,6 +401,13 @@ comb(A, B, C) ->
end,
id(Res).
+simple_comb(A, B) ->
+ %% Use Res twice, to ensure that a careless optimization of 'not'
+ %% doesn't leave Res as a free variable.
+ Res = A andalso B,
+ _ = id(not Res),
+ Res.
+
%% Test that a boolean expression in a case expression is properly
%% optimized (in particular, that the error behaviour is correct).
in_case(Config) when is_list(Config) ->
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index c441f9f284..1b1c7db0e8 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -122,7 +122,7 @@ yrange(Config) when is_list(Config) ->
{{move,{x,1},{y,-1}},5,
{invalid_store,{y,-1},term}}},
{{t,sum_2,2},
- {{bif,'+',{f,0},[{x,0},{y,1024}],{x,0}},8,
+ {{bif,'+',{f,0},[{x,0},{y,1024}],{x,0}},7,
{uninitialized_reg,{y,1024}}}},
{{t,sum_3,2},
{{move,{x,1},{y,1024}},5,limit}},
@@ -133,11 +133,11 @@ yrange(Config) when is_list(Config) ->
stack(Config) when is_list(Config) ->
Errors = do_val(stack, Config),
- [{{t,a,2},{return,11,{stack_frame,2}}},
+ [{{t,a,2},{return,9,{stack_frame,2}}},
{{t,b,2},{{deallocate,2},4,{allocated,none}}},
{{t,bad_1,0},{{allocate_zero,2,10},4,{{x,9},not_live}}},
{{t,bad_2,0},{{move,{y,0},{x,0}},5,{unassigned,{y,0}}}},
- {{t,c,2},{{deallocate,2},12,{allocated,none}}},
+ {{t,c,2},{{deallocate,2},10,{allocated,none}}},
{{t,d,2},
{{allocate,2,2},5,{existing_stack_frame,{size,2}}}},
{{t,e,2},{{deallocate,5},6,{allocated,2}}}] = Errors,
@@ -145,18 +145,18 @@ stack(Config) when is_list(Config) ->
call_last(Config) when is_list(Config) ->
Errors = do_val(call_last, Config),
- ?line [{{t,a,1},{{call_last,1,{f,8},2},11,{allocated,1}}},
- {{t,b,1},
- {{call_ext_last,2,{extfunc,lists,seq,2},2},
- 11,
- {allocated,1}}}] = Errors,
+ [{{t,a,1},{{call_last,1,{f,8},2},9,{allocated,1}}},
+ {{t,b,1},
+ {{call_ext_last,2,{extfunc,lists,seq,2},2},
+ 10,
+ {allocated,1}}}] = Errors,
ok.
merge_undefined(Config) when is_list(Config) ->
Errors = do_val(merge_undefined, Config),
[{{t,handle_call,2},
{{call_ext,2,{extfunc,debug,filter,2}},
- 23,
+ 22,
{uninitialized_reg,{y,0}}}}] = Errors,
ok.
@@ -166,10 +166,10 @@ uninit(Config) when is_list(Config) ->
[{{t,sum_1,2},
{{move,{y,0},{x,0}},5,{uninitialized_reg,{y,0}}}},
{{t,sum_2,2},
- {{call,1,{f,8}},6,{uninitialized_reg,{y,0}}}},
+ {{call,1,{f,8}},5,{uninitialized_reg,{y,0}}}},
{{t,sum_3,2},
{{bif,'+',{f,0},[{x,0},{y,0}],{x,0}},
- 7,
+ 6,
{unassigned,{y,0}}}}] = Errors,
ok.
@@ -198,7 +198,7 @@ overwrite_trytag(Config) when is_list(Config) ->
Errors = do_val(overwrite_trytag, Config),
?line
[{{overwrite_trytag,foo,1},
- {{kill,{y,2}},9,{trytag,_}}}] = Errors,
+ {{kill,{y,2}},8,{trytag,_}}}] = Errors,
ok.
accessing_tags(Config) when is_list(Config) ->
@@ -335,7 +335,7 @@ state_after_fault_in_catch(Config) when is_list(Config) ->
no_exception_in_catch(Config) when is_list(Config) ->
Errors = do_val(no_exception_in_catch, Config),
[{{no_exception_in_catch,nested_of_1,4},
- {{move,{x,3},{x,0}},91,{uninitialized_reg,{x,3}}}}] = Errors,
+ {{move,{x,3},{x,0}},88,{uninitialized_reg,{x,3}}}}] = Errors,
ok.
undef_label(Config) when is_list(Config) ->
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index 512aada203..bc82eaf5aa 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -88,6 +88,7 @@ t_element(Config) when is_list(Config) ->
{_,_,_}=Tup ->
?line {'EXIT',{badarg,_}} = (catch element(4, Tup))
end,
+ {'EXIT',{badarg,_}} = (catch element(1, tuple_size(Tuple))),
ok.
@@ -106,6 +107,7 @@ setelement(Config) when is_list(Config) ->
?line error = setelement_crash_2({a,b,c,d,e,f}, <<42>>),
{'EXIT',{badarg,_}} = (catch setelement(1, not_a_tuple, New)),
+ {'EXIT',{badarg,_}} = (catch setelement(3, {a,b}, New)),
ok.
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index 8db47ffa40..08279d9408 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -1802,6 +1802,12 @@ bad_guards(Config) when is_list(Config) ->
fc(catch bad_guards_2(#{a=>0,b=>0}, [x])),
fc(catch bad_guards_2(not_a_map, [x])),
fc(catch bad_guards_2(42, [x])),
+
+ fc(catch bad_guards_3(#{a=>0,b=>0}, [])),
+ fc(catch bad_guards_3(#{a=>0,b=>0}, [x])),
+ fc(catch bad_guards_3(not_a_map, [x])),
+ fc(catch bad_guards_3(42, [x])),
+
ok.
%% beam_bool used to produce GC BIF instructions whose
@@ -1813,6 +1819,12 @@ bad_guards_1(X, [_]) when {{X}}, -X ->
bad_guards_2(M, [_]) when M#{a := 0, b => 0}, map_size(M) ->
ok.
+%% beam_type used to produce an GC BIF instruction whose Live operand
+%% included uninitialized registers.
+
+bad_guards_3(M, [_]) when is_map(M) andalso M#{a := 0, b => 0}, length(M) ->
+ ok.
+
%% Call this function to turn off constant propagation.
id(I) -> I.
diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl
index 7522ee985f..9aec0b3d4e 100644
--- a/lib/compiler/test/match_SUITE.erl
+++ b/lib/compiler/test/match_SUITE.erl
@@ -141,6 +141,13 @@ aliases(Config) when is_list(Config) ->
?line {a,b} = list_alias2([a,b]),
?line {a,b} = list_alias3([a,b]),
+ %% Non-matching aliases.
+ none = mixed_aliases(<<42>>),
+ none = mixed_aliases([b]),
+ none = mixed_aliases([d]),
+ none = mixed_aliases({a,42}),
+ none = mixed_aliases(42),
+
ok.
str_alias(V) ->
@@ -244,6 +251,12 @@ list_alias2([X,Y]=[a,b]) ->
list_alias3([X,b]=[a,Y]) ->
{X,Y}.
+mixed_aliases(<<X:8>> = x) -> {a,X};
+mixed_aliases([b] = <<X:8>>) -> {b,X};
+mixed_aliases(<<X:8>> = {a,X}) -> {c,X};
+mixed_aliases([X] = <<X:8>>) -> {d,X};
+mixed_aliases(_) -> none.
+
%% OTP-7018.
match_in_call(Config) when is_list(Config) ->
diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl
index 6663985ad7..d0b7c71be8 100644
--- a/lib/compiler/test/warnings_SUITE.erl
+++ b/lib/compiler/test/warnings_SUITE.erl
@@ -39,7 +39,7 @@
guard/1,bad_arith/1,bool_cases/1,bad_apply/1,
files/1,effect/1,bin_opt_info/1,bin_construction/1,
comprehensions/1,maps/1,redundant_boolean_clauses/1,
- latin1_fallback/1,underscore/1]).
+ latin1_fallback/1,underscore/1,no_warnings/1]).
% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(2)).
@@ -65,7 +65,7 @@ groups() ->
bad_arith,bool_cases,bad_apply,files,effect,
bin_opt_info,bin_construction,comprehensions,maps,
redundant_boolean_clauses,latin1_fallback,
- underscore]}].
+ underscore,no_warnings]}].
init_per_suite(Config) ->
Config.
@@ -281,7 +281,6 @@ bad_arith(Config) when is_list(Config) ->
{3,sys_core_fold,{eval_failure,badarith}},
{9,sys_core_fold,nomatch_guard},
{9,sys_core_fold,{eval_failure,badarith}},
- {9,sys_core_fold,{no_effect,{erlang,is_integer,1}}},
{10,sys_core_fold,nomatch_guard},
{10,sys_core_fold,{eval_failure,badarith}},
{15,sys_core_fold,{eval_failure,badarith}}
@@ -580,11 +579,11 @@ maps(Config) when is_list(Config) ->
<<"
t() ->
M = {a,[]},
- {'EXIT',{badarg,_}} = (catch(M#{ a => 1})),
+ {'EXIT',{badarg,_}} = (catch(M#{ a => 1 })),
ok.
">>,
[],
- {warnings,[{4,v3_kernel,bad_map}]}},
+ {warnings,[{4,sys_core_fold,{eval_failure,badarg}}]}},
{bad_map_src2,
<<"
t() ->
@@ -594,7 +593,7 @@ maps(Config) when is_list(Config) ->
id(I) -> I.
">>,
[inline],
- {warnings,[{4,v3_kernel,bad_map}]}},
+ []},
{bad_map_src3,
<<"
t() ->
@@ -719,6 +718,27 @@ underscore(Config) when is_list(Config) ->
ok.
+no_warnings(Config) when is_list(Config) ->
+ Ts = [{no_warnings,
+ <<"-record(r, {s=ordsets:new(),a,b}).
+
+ a() ->
+ R = #r{}, %No warning expected.
+ {R#r.a,R#r.b}.
+
+ b(X) ->
+ T = true,
+ Var = [X], %No warning expected.
+ case T of
+ false -> Var;
+ true -> []
+ end.
+ ">>,
+ [],
+ []}],
+ run(Config, Ts),
+ ok.
+
%%%
%%% End of test cases.
%%%
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-17 18:47:10 +0000