aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/src/Makefile6
-rw-r--r--lib/compiler/src/beam_a.erl3
-rw-r--r--lib/compiler/src/beam_block.erl26
-rw-r--r--lib/compiler/src/beam_bool.erl3
-rw-r--r--lib/compiler/src/beam_clean.erl25
-rw-r--r--lib/compiler/src/beam_dead.erl686
-rw-r--r--lib/compiler/src/beam_flatten.erl3
-rw-r--r--lib/compiler/src/beam_jump.erl63
-rw-r--r--lib/compiler/src/beam_peep.erl15
-rw-r--r--lib/compiler/src/beam_split.erl4
-rw-r--r--lib/compiler/src/beam_type.erl52
-rw-r--r--lib/compiler/src/beam_utils.erl39
-rw-r--r--lib/compiler/src/beam_validator.erl328
-rw-r--r--lib/compiler/src/beam_z.erl14
-rw-r--r--lib/compiler/src/cerl.erl66
-rw-r--r--lib/compiler/src/cerl_clauses.erl46
-rw-r--r--lib/compiler/src/cerl_inline.erl36
-rw-r--r--lib/compiler/src/cerl_trees.erl4
-rw-r--r--lib/compiler/src/compile.erl5
-rw-r--r--lib/compiler/src/compiler.app.src1
-rw-r--r--lib/compiler/src/core_lib.erl63
-rw-r--r--lib/compiler/src/core_lint.erl104
-rw-r--r--lib/compiler/src/core_parse.hrl3
-rw-r--r--lib/compiler/src/core_parse.yrl98
-rw-r--r--lib/compiler/src/core_pp.erl26
-rw-r--r--lib/compiler/src/core_scan.erl6
-rw-r--r--lib/compiler/src/erl_bifs.erl1
-rw-r--r--lib/compiler/src/sys_core_fold.erl1445
-rw-r--r--lib/compiler/src/sys_core_fold_lists.erl386
-rw-r--r--lib/compiler/src/sys_core_inline.erl8
-rw-r--r--lib/compiler/src/sys_pre_expand.erl53
-rw-r--r--lib/compiler/src/v3_codegen.erl89
-rw-r--r--lib/compiler/src/v3_core.erl675
-rw-r--r--lib/compiler/src/v3_kernel.erl213
-rw-r--r--lib/compiler/src/v3_kernel.hrl2
-rw-r--r--lib/compiler/src/v3_life.erl56
-rw-r--r--lib/compiler/test/Makefile5
-rw-r--r--lib/compiler/test/andor_SUITE.erl22
-rw-r--r--lib/compiler/test/beam_utils_SUITE.erl236
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl212
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/bad_dsetel.S6
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S2
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/bin_match.S64
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/compiler_bug.S38
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/dead_code.S25
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/erl_prim_loader.beambin17460 -> 0 bytes
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/freg_range.S4
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/freg_state.S2
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S14
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/illegal_instruction.S26
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/map_field_lists.S29
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S3
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/no_exception_in_catch.S4
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/stack.S4
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/undef_label.S22
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/uninit.S16
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/xrange.S4
-rw-r--r--lib/compiler/test/bs_bit_binaries_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_construct_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl28
-rw-r--r--lib/compiler/test/compilation_SUITE.erl8
-rw-r--r--lib/compiler/test/compile_SUITE.erl91
-rw-r--r--lib/compiler/test/compile_SUITE_data/dialyzer_test.erl39
-rw-r--r--lib/compiler/test/core_SUITE_data/map_core_test.core12
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl59
-rw-r--r--lib/compiler/test/error_SUITE.erl25
-rw-r--r--lib/compiler/test/float_SUITE.erl2
-rw-r--r--lib/compiler/test/guard_SUITE.erl257
-rw-r--r--lib/compiler/test/lc_SUITE.erl102
-rw-r--r--lib/compiler/test/map_SUITE.erl387
-rw-r--r--lib/compiler/test/match_SUITE.erl32
-rw-r--r--lib/compiler/test/misc_SUITE.erl17
-rw-r--r--lib/compiler/test/receive_SUITE.erl38
-rw-r--r--lib/compiler/test/record_SUITE.erl8
-rw-r--r--lib/compiler/test/test_lib.erl23
-rw-r--r--lib/compiler/test/trycatch_SUITE.erl20
-rw-r--r--lib/compiler/test/warnings_SUITE.erl83
77 files changed, 4195 insertions, 2431 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index c6d09d85eb..7c4cebdc28 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -81,6 +81,7 @@ MODULES = \
rec_env \
sys_core_dsetel \
sys_core_fold \
+ sys_core_fold_lists \
sys_core_inline \
sys_pre_attributes \
sys_pre_expand \
@@ -158,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
# ----------------------------------------------------
@@ -187,6 +192,7 @@ $(EBIN)/core_parse.beam: core_parse.hrl $(EGEN)/core_parse.erl
$(EBIN)/core_pp.beam: core_parse.hrl
$(EBIN)/sys_core_dsetel.beam: core_parse.hrl
$(EBIN)/sys_core_fold.beam: core_parse.hrl
+$(EBIN)/sys_core_fold_lists.beam: core_parse.hrl
$(EBIN)/sys_core_inline.beam: core_parse.hrl
$(EBIN)/sys_pre_expand.beam: ../../stdlib/include/erl_bits.hrl
$(EBIN)/v3_codegen.beam: v3_life.hrl
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 7a30c68593..5216f39296 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -155,7 +155,8 @@ collect(remove_message) -> {set,[],[],remove_message};
collect({put_map,F,Op,S,D,R,{list,Puts}}) ->
{set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}};
collect({get_map_elements,F,S,{list,Gets}}) ->
- {set,Gets,[S],{get_map_elements,F}};
+ {Ss,Ds} = beam_utils:split_even(Gets),
+ {set,Ds,[S|Ss],{get_map_elements,F}};
collect({'catch',R,L}) -> {set,[R],[],{'catch',L}};
collect(fclearerror) -> {set,[],[],fclearerror};
collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror};
@@ -183,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)];
@@ -251,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,
@@ -268,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([]) -> [].
@@ -427,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_clean.erl b/lib/compiler/src/beam_clean.erl
index b653998252..b68b8702e0 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -234,31 +234,6 @@ replace([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D) when Lbl =/= 0 ->
replace(Is, [{bs_init,{f,label(Lbl, D)},Info,Live,Ss,Dst}|Acc], D);
replace([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D) when Lbl =/= 0 ->
replace(Is, [{bs_put,{f,label(Lbl, D)},Info,Ss}|Acc], D);
-replace([{bs_init2,{f,Lbl},Sz,Words,R,F,Dst}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bs_init2,{f,label(Lbl, D)},Sz,Words,R,F,Dst}|Acc], D);
-replace([{bs_init_bits,{f,Lbl},Sz,Words,R,F,Dst}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bs_init_bits,{f,label(Lbl, D)},Sz,Words,R,F,Dst}|Acc], D);
-replace([{bs_put_integer,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bs_put_integer,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D);
-replace([{bs_put_utf8=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D);
-replace([{bs_put_utf16=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D);
-replace([{bs_put_utf32=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D);
-replace([{bs_put_binary,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bs_put_binary,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D);
-replace([{bs_put_float,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bs_put_float,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D);
-replace([{bs_add,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bs_add,{f,label(Lbl, D)},Src,Dst}|Acc], D);
-replace([{bs_append,{f,Lbl},_,_,_,_,_,_,_}=I0|Is], Acc, D) when Lbl =/= 0 ->
- I = setelement(2, I0, {f,label(Lbl, D)}),
- replace(Is, [I|Acc], D);
-replace([{bs_utf8_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{I,{f,label(Lbl, D)},Src,Dst}|Acc], D);
-replace([{bs_utf16_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{I,{f,label(Lbl, D)},Src,Dst}|Acc], D);
replace([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D)
when Lbl =/= 0 ->
replace(Is, [{I,{f,label(Lbl, D)},Op,Src,Dst,Live,List}|Acc], D);
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index b15adfa889..f4515ba2a7 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -21,112 +21,10 @@
-export([module/2]).
-%%% The following optimisations are done:
-%%%
-%%% (1) In this code
-%%%
-%%% move DeadValue {x,0}
-%%% jump L2
-%%% .
-%%% .
-%%% .
-%%% L2: move Anything {x,0}
-%%% .
-%%% .
-%%% .
-%%%
-%%% the first assignment to {x,0} has no effect (is dead),
-%%% so it can be removed. Besides removing a move instruction,
-%%% if the move was preceeded by a label, the resulting code
-%%% will look this
-%%%
-%%% L1: jump L2
-%%% .
-%%% .
-%%% .
-%%% L2: move Anything {x,0}
-%%% .
-%%% .
-%%% .
-%%%
-%%% which can be further optimized by the jump optimizer (beam_jump).
-%%%
-%%% (2) In this code
-%%%
-%%% L1: move AtomLiteral {x,0}
-%%% jump L2
-%%% .
-%%% .
-%%% .
-%%% L2: test is_atom FailLabel {x,0}
-%%% select_val {x,0}, FailLabel [... AtomLiteral => L3...]
-%%% .
-%%% .
-%%% .
-%%% L3: ...
-%%%
-%%% FailLabel: ...
-%%%
-%%% the first code fragment can be changed to
-%%%
-%%% L1: move AtomLiteral {x,0}
-%%% jump L3
-%%%
-%%% If the literal is not included in the table of literals in the
-%%% select_val instruction, the first code fragment will instead be
-%%% rewritten as:
-%%%
-%%% L1: move AtomLiteral {x,0}
-%%% jump FailLabel
-%%%
-%%% The move instruction will be removed by optimization (1) above,
-%%% if the code following the L3 label overwrites {x,0}.
-%%%
-%%% The code following the L2 label will be kept, but it will be removed later
-%%% by the jump optimizer.
-%%%
-%%% (3) In this code
-%%%
-%%% test is_eq_exact ALabel Src Dst
-%%% move Src Dst
-%%%
-%%% the move instruction can be removed.
-%%% Same thing for
-%%%
-%%% test is_nil ALabel Dst
-%%% move [] Dst
-%%%
-%%%
-%%% (4) In this code
-%%%
-%%% select_val {x,Reg}, ALabel [... Literal => L1...]
-%%% .
-%%% .
-%%% .
-%%% L1: move Literal {x,Reg}
-%%%
-%%% we can remove the move instruction.
-%%%
-%%% (5) In the following code
-%%%
-%%% bif '=:=' Fail Src1 Src2 {x,0}
-%%% jump L1
-%%% .
-%%% .
-%%% .
-%%% L1: select_val {x,0}, ALabel [... true => L2..., ...false => L3...]
-%%% .
-%%% .
-%%% .
-%%% L2: .... L3: ....
-%%%
-%%% the first two instructions can be replaced with
-%%%
-%%% test is_eq_exact L3 Src1 Src2
-%%% jump L2
-%%%
-%%% provided that {x,0} is killed at both L2 and L3.
-%%%
+%%% Dead code is code that is executed but has no effect. This
+%%% optimization pass either removes dead code or jumps around it,
+%%% potentially making it unreachable and a target for the
+%%% the beam_jump pass.
-import(lists, [mapfoldl/3,reverse/1]).
@@ -173,12 +71,39 @@ move_move_into_block([I|Is], Acc) ->
move_move_into_block([], Acc) -> reverse(Acc).
%%%
-%%% Scan instructions in execution order and remove dead code.
+%%% Scan instructions in execution order and remove redundant 'move'
+%%% instructions. 'move' instructions are redundant if we know that
+%%% the register already contains the value being assigned, as in the
+%%% following code:
+%%%
+%%% test is_eq_exact SomeLabel Src Dst
+%%% move Src Dst
+%%%
+%%% or in:
+%%%
+%%% test is_nil SomeLabel Dst
+%%% move nil Dst
+%%%
+%%% or in:
+%%%
+%%% select_val Register FailLabel [... Literal => L1...]
+%%% .
+%%% .
+%%% .
+%%% L1: move Literal Register
+%%%
+%%% Also add extra labels to help the second backward pass.
%%%
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);
@@ -205,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);
@@ -215,15 +142,13 @@ forward([{test,is_eq_exact,_,[Dst,Src]}=I,{move,Src,Dst}|Is], D, Lc, Acc) ->
forward([I|Is], D, Lc, Acc);
forward([{test,is_nil,_,[Dst]}=I,{move,nil,Dst}|Is], D, Lc, Acc) ->
forward([I|Is], D, Lc, Acc);
-forward([{test,is_eq_exact,_,_}=I|Is], D, Lc, Acc) ->
- case Is of
- [{label,_}|_] -> forward(Is, D, Lc, [I|Acc]);
- _ -> forward(Is, D, Lc+1, [{label,Lc},I|Acc])
- end;
-forward([{test,is_ne_exact,_,_}=I|Is], D, Lc, Acc) ->
- case Is of
- [{label,_}|_] -> forward(Is, D, Lc, [I|Acc]);
- _ -> forward(Is, D, Lc+1, [{label,Lc},I|Acc])
+forward([{test,_,_,_}=I|Is]=Is0, D, Lc, Acc) ->
+ %% Help the second, backward pass to by inserting labels after
+ %% relational operators so that they can be skipped if they are
+ %% known to be true.
+ case useful_to_insert_label(Is0) of
+ false -> forward(Is, D, Lc, [I|Acc]);
+ true -> forward(Is, D, Lc+1, [{label,Lc},I|Acc])
end;
forward([I|Is], D, Lc, Acc) ->
forward(Is, D, Lc, [I|Acc]);
@@ -239,9 +164,49 @@ update_value_dict([Lit,{f,Lbl}|T], Reg, D0) ->
update_value_dict(T, Reg, D);
update_value_dict([], _, D) -> D.
+useful_to_insert_label([_,{label,_}|_]) ->
+ false;
+useful_to_insert_label([{test,Op,_,_}|_]) ->
+ case Op of
+ is_lt -> true;
+ is_ge -> true;
+ is_eq_exact -> true;
+ is_ne_exact -> true;
+ _ -> false
+ end.
+
+%%%
+%%% Scan instructions in reverse execution order and try to
+%%% shortcut branch instructions.
+%%%
+%%% For example, in this code:
+%%%
+%%% move Literal Register
+%%% jump L1
+%%% .
+%%% .
+%%% .
+%%% L1: test is_{integer,atom} FailLabel Register
+%%% select_val {x,0} FailLabel [... Literal => L2...]
+%%% .
+%%% .
+%%% .
+%%% L2: ...
%%%
-%%% Scan instructions in reverse execution order and remove dead code.
+%%% the 'selectval' instruction will always transfer control to L2,
+%%% so we can just as well jump to L2 directly by rewriting the
+%%% first part of the sequence like this:
%%%
+%%% move Literal Register
+%%% jump L2
+%%%
+%%% If register Register is killed at label L2, we can remove the
+%%% 'move' instruction, leaving just the 'jump' instruction:
+%%%
+%%% jump L2
+%%%
+%%% These transformations may leave parts of the code unreachable.
+%%% The beam_jump pass will remove the unreachable code.
backward(Is, D) ->
backward(Is, D, []).
@@ -277,15 +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,Src,Reg}=Move0|Is], D, Acc) ->
- {To,Move} = case Src of
- {atom,Val0} ->
- To1 = shortcut_select_label(To0, Reg, Val0, D),
- {To2,Val} = shortcut_boolean_label(To1, Reg, Val0, D),
- {To2,{move,{atom,Val},Reg}};
- _ ->
- {shortcut_label(To0, D),Move0}
- end,
+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]);
@@ -301,28 +259,25 @@ backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) ->
To = shortcut_bs_start_match(To0, Src, D),
I = {test,bs_start_match2,{f,To},Live,Info,Dst},
backward(Is, D, [I|Acc]);
-backward([{test,is_eq_exact,{f,To0},[Reg,{atom,Val}]=Ops}|Is], D, Acc) ->
- To1 = shortcut_bs_test(To0, Is, D),
- To = shortcut_fail_label(To1, Reg, Val, D),
- I = combine_eqs(To, Ops, D, Acc),
- backward(Is, D, [I|Acc]);
backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) ->
To1 = shortcut_bs_test(To0, Is, D),
To2 = shortcut_label(To1, D),
+ To3 = shortcut_rel_op(To2, Op, Ops0, D),
+
%% Try to shortcut a repeated test:
%%
%% test Op {f,Fail1} Operands test Op {f,Fail2} Operands
%% . . . ==> ...
%% Fail1: test Op {f,Fail2} Operands Fail1: test Op {f,Fail2} Operands
%%
- To = case beam_utils:code_at(To2, D) of
- [{test,Op,{f,To3},Ops}|_] ->
+ To = case beam_utils:code_at(To3, D) of
+ [{test,Op,{f,To4},Ops}|_] ->
case equal_ops(Ops0, Ops) of
- true -> To3;
- false -> To2
+ true -> To4;
+ false -> To3
end;
_Code ->
- To2
+ To3
end,
I = case Op of
is_eq_exact -> combine_eqs(To, Ops0, D, Acc);
@@ -367,8 +322,8 @@ equal_ops([Op|T0], [Op|T1]) ->
equal_ops([], []) -> true;
equal_ops(_, _) -> false.
-shortcut_select_list([{_,Val}=Lit,{f,To0}|T], Reg, D, Acc) ->
- To = shortcut_select_label(To0, Reg, Val, D),
+shortcut_select_list([Lit,{f,To0}|T], Reg, D, Acc) ->
+ To = shortcut_select_label(To0, Reg, Lit, D),
shortcut_select_list(T, Reg, D, [{f,To},Lit|Acc]);
shortcut_select_list([], _, _, Acc) -> reverse(Acc).
@@ -378,58 +333,29 @@ shortcut_label(To0, D) ->
_ -> To0
end.
-shortcut_select_label(To0, Reg, Val, D) ->
- case beam_utils:code_at(To0, D) of
- [{jump,{f,To}}|_] ->
- shortcut_select_label(To, Reg, Val, D);
- [{test,is_atom,_,[Reg]},{select,select_val,Reg,{f,Fail},Map}|_] ->
- To = find_select_val(Map, Val, Fail),
- shortcut_select_label(To, Reg, Val, D);
- [{test,is_eq_exact,{f,_},[Reg,{atom,Val}]},{label,To}|_] when is_atom(Val) ->
- shortcut_select_label(To, Reg, Val, D);
- [{test,is_eq_exact,{f,_},[Reg,{atom,Val}]},{jump,{f,To}}|_] when is_atom(Val) ->
- shortcut_select_label(To, Reg, Val, D);
- [{test,is_eq_exact,{f,To},[Reg,{atom,AnotherVal}]}|_]
- when is_atom(Val), Val =/= AnotherVal ->
- shortcut_select_label(To, Reg, Val, D);
- [{test,is_ne_exact,{f,To},[Reg,{atom,Val}]}|_] when is_atom(Val) ->
- shortcut_select_label(To, Reg, Val, D);
- [{test,is_ne_exact,{f,_},[Reg,{atom,_}]},{label,To}|_] when is_atom(Val) ->
- shortcut_select_label(To, Reg, Val, D);
- [{test,is_tuple,{f,To},[Reg]}|_] when is_atom(Val) ->
- shortcut_select_label(To, Reg, Val, D);
- _ ->
- To0
- end.
+shortcut_select_label(To, Reg, Lit, D) ->
+ shortcut_rel_op(To, is_ne_exact, [Reg,Lit], D).
-shortcut_fail_label(To0, Reg, Val, D) ->
- case beam_utils:code_at(To0, D) of
- [{jump,{f,To}}|_] ->
- shortcut_fail_label(To, Reg, Val, D);
- [{test,is_eq_exact,{f,To},[Reg,{atom,Val}]}|_] when is_atom(Val) ->
- shortcut_fail_label(To, Reg, Val, D);
- _ ->
- To0
- end.
-
-shortcut_boolean_label(To0, Reg, Bool0, D) when is_boolean(Bool0) ->
- case beam_utils:code_at(To0, D) of
- [{line,_},{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] ->
- Bool = not Bool0,
- {shortcut_select_label(To, Reg, Bool, D),Bool};
- _ ->
- {To0,Bool0}
- end;
-shortcut_boolean_label(To, _, Bool, _) -> {To,Bool}.
-
-find_select_val([{_,Val},{f,To}|_], Val, _) -> To;
-find_select_val([{_,_}, {f,_}|T], Val, Fail) ->
- find_select_val(T, Val, Fail);
-find_select_val([], _, Fail) -> Fail.
+%% Replace a comparison operator with a test instruction and a jump.
+%% For example, if we have this code:
+%%
+%% bif '=:=' Fail Src1 Src2 {x,0}
+%% jump L1
+%% .
+%% .
+%% .
+%% L1: select_val {x,0} FailLabel [... true => L2..., ...false => L3...]
+%%
+%% the first two instructions can be replaced with
+%%
+%% test is_eq_exact L3 Src1 Src2
+%% jump L2
+%%
+%% provided that {x,0} is killed at both L2 and L3.
replace_comp_op(To, Reg, Op, Ops, D) ->
- False = comp_op_find_shortcut(To, Reg, false, D),
- True = comp_op_find_shortcut(To, Reg, true, D),
+ False = comp_op_find_shortcut(To, Reg, {atom,false}, D),
+ True = comp_op_find_shortcut(To, Reg, {atom,true}, D),
[bif_to_test(Op, Ops, False),{jump,{f,True}}].
comp_op_find_shortcut(To0, Reg, Val, D) ->
@@ -461,9 +387,9 @@ not_possible() -> throw(not_possible).
%%
%% is_eq_exact F1 Reg Lit1 select_val Reg F2 [ Lit1 L1
%% L1: . Lit2 L2 ]
-%% .
-%% . ==>
-%% .
+%% .
+%% . ==>
+%% .
%% F1: is_eq_exact F2 Reg Lit2 F1: is_eq_exact F2 Reg Lit2
%% L2: .... L2:
%%
@@ -488,31 +414,26 @@ remove_from_list(Lit, [Val,{f,_}=Fail|T]) ->
[Val,Fail|remove_from_list(Lit, T)];
remove_from_list(_, []) -> [].
-%% shortcut_bs_test(TargetLabel, [Instruction], D) -> TargetLabel'
-%% Try to shortcut the failure label for a bit syntax matching.
-%% We know that the binary contains at least Bits bits after
-%% the latest save point.
+%% shortcut_bs_test(TargetLabel, ReversedInstructions, D) -> TargetLabel'
+%% Try to shortcut the failure label for bit syntax matching.
shortcut_bs_test(To, Is, D) ->
shortcut_bs_test_1(beam_utils:code_at(To, D), Is, To, D).
-shortcut_bs_test_1([{bs_restore2,Reg,SavePoint}|Is], PrevIs, To, D) ->
- shortcut_bs_test_2(Is, {Reg,SavePoint}, PrevIs, To, D);
-shortcut_bs_test_1([_|_], _, To, _) -> To.
-
-shortcut_bs_test_2([{label,_}|Is], Save, PrevIs, To, D) ->
- shortcut_bs_test_2(Is, Save, PrevIs, To, D);
-shortcut_bs_test_2([{test,bs_test_tail2,{f,To},[_,TailBits]}|_],
- {Reg,_Point} = RP, PrevIs, To0, D) ->
- case count_bits_matched(PrevIs, RP, 0) of
+shortcut_bs_test_1([{bs_restore2,Reg,SavePoint},
+ {label,_},
+ {test,bs_test_tail2,{f,To},[_,TailBits]}|_],
+ PrevIs, To0, D) ->
+ case count_bits_matched(PrevIs, {Reg,SavePoint}, 0) of
Bits when Bits > TailBits ->
%% This instruction will fail. We know because a restore has been
- %% done from the previous point SavePoint in the binary, and we also know
- %% that the binary contains at least Bits bits from SavePoint.
+ %% done from the previous point SavePoint in the binary, and we
+ %% also know that the binary contains at least Bits bits from
+ %% SavePoint.
%%
%% Since we will skip a bs_restore2 if we shortcut to label To,
- %% we must now make sure that code at To does not depend on the position
- %% in the context in any way.
+ %% we must now make sure that code at To does not depend on
+ %% the position in the context in any way.
case shortcut_bs_pos_used(To, Reg, D) of
false -> To;
true -> To0
@@ -520,8 +441,19 @@ shortcut_bs_test_2([{test,bs_test_tail2,{f,To},[_,TailBits]}|_],
_Bits ->
To0
end;
-shortcut_bs_test_2([_|_], _, _, To, _) -> To.
+shortcut_bs_test_1([_|_], _, To, _) -> To.
+%% counts_bits_matched(ReversedInstructions, SavePoint, Bits) -> Bits'
+%% Given a reversed instruction stream, determine the minimum number
+%% of bits that will be matched by bit syntax instructions up to the
+%% given save point.
+
+count_bits_matched([{test,bs_get_utf8,{f,_},_,_,_}|Is], SavePoint, Bits) ->
+ count_bits_matched(Is, SavePoint, Bits+8);
+count_bits_matched([{test,bs_get_utf16,{f,_},_,_,_}|Is], SavePoint, Bits) ->
+ count_bits_matched(Is, SavePoint, Bits+16);
+count_bits_matched([{test,bs_get_utf32,{f,_},_,_,_}|Is], SavePoint, Bits) ->
+ count_bits_matched(Is, SavePoint, Bits+32);
count_bits_matched([{test,_,_,_,[_,Sz,U,{field_flags,_}],_}|Is], SavePoint, Bits) ->
case Sz of
{integer,N} -> count_bits_matched(Is, SavePoint, Bits+N*U);
@@ -545,20 +477,332 @@ shortcut_bs_pos_used_1(Is, Reg, D) ->
not beam_utils:is_killed(Reg, Is, D).
%% shortcut_bs_start_match(TargetLabel, Reg) -> TargetLabel
-%% A failing bs_start_match2 instruction means that the source
-%% cannot be a binary, so there is no need to jump bs_context_to_binary/1
-%% or another bs_start_match2 instruction.
+%% A failing bs_start_match2 instruction means that the source (Reg)
+%% cannot be a binary. That means that it is safe to skip
+%% bs_context_to_binary instructions operating on Reg, and
+%% bs_start_match2 instructions operating on Reg.
shortcut_bs_start_match(To, Reg, D) ->
- shortcut_bs_start_match_1(beam_utils:code_at(To, D), Reg, To).
+ shortcut_bs_start_match_1(beam_utils:code_at(To, D), Reg, To, D).
+
+shortcut_bs_start_match_1([{bs_context_to_binary,Reg}|Is], Reg, To, D) ->
+ shortcut_bs_start_match_1(Is, Reg, To, D);
+shortcut_bs_start_match_1([{jump,{f,To}}|_], Reg, _, D) ->
+ Code = beam_utils:code_at(To, D),
+ shortcut_bs_start_match_1(Code, Reg, To, D);
+shortcut_bs_start_match_1([{test,bs_start_match2,{f,To},_,[Reg|_],_}|_],
+ Reg, _, D) ->
+ Code = beam_utils:code_at(To, D),
+ shortcut_bs_start_match_1(Code, Reg, To, D);
+shortcut_bs_start_match_1(_, _, To, _) ->
+ To.
-shortcut_bs_start_match_1([{bs_context_to_binary,Reg}|Is], Reg, To) ->
- shortcut_bs_start_match_2(Is, Reg, To);
-shortcut_bs_start_match_1(_, _, To) -> To.
+%% shortcut_rel_op(FailLabel, Operator, [Operand], D) -> FailLabel'
+%% Try to shortcut the given test instruction. Example:
+%%
+%% is_ge L1 {x,0} 48
+%% .
+%% .
+%% .
+%% L1: is_ge L2 {x,0} 65
+%%
+%% The first test instruction can be rewritten to "is_ge L2 {x,0} 48"
+%% since the instruction at L1 will also fail.
+%%
+%% If there are instructions between L1 and the other test instruction
+%% it may still be possible to do the shortcut. For example:
+%%
+%% L1: is_eq_exact L3 {x,0} 92
+%% is_ge L2 {x,0} 65
+%%
+%% Since the first test instruction failed, we know that {x,0} must
+%% be less than 48; therefore, we know that {x,0} cannot be equal to
+%% 92 and the jump to L3 cannot happen.
+
+shortcut_rel_op(To, Op, Ops, D) ->
+ case normalize_op({test,Op,{f,To},Ops}) of
+ {{NormOp,A,B},_} ->
+ Normalized = {negate_op(NormOp),A,B},
+ shortcut_rel_op_fp(To, Normalized, D);
+ {_,_} ->
+ To;
+ error ->
+ To
+ end.
-shortcut_bs_start_match_2([{jump,{f,To}}|_], _, _) ->
- To;
-shortcut_bs_start_match_2([{test,bs_start_match2,{f,To},_,[Reg|_],_}|_], Reg, _) ->
- To;
-shortcut_bs_start_match_2(_Is, _Reg, To) ->
- To.
+shortcut_rel_op_fp(To0, Normalized, D) ->
+ Code = beam_utils:code_at(To0, D),
+ case shortcut_any_label(Code, Normalized) of
+ error ->
+ To0;
+ To ->
+ shortcut_rel_op_fp(To, Normalized, D)
+ end.
+
+%% shortcut_any_label([Instruction], PrevCondition) -> FailLabel | error
+%% Using PrevCondition (a previous condition known to be true),
+%% try to shortcut to another failure label.
+
+shortcut_any_label([{jump,{f,Lbl}}|_], _Prev) ->
+ Lbl;
+shortcut_any_label([{label,Lbl}|_], _Prev) ->
+ Lbl;
+shortcut_any_label([{select,select_val,R,{f,Fail},L}|_], Prev) ->
+ shortcut_selectval(L, R, Fail, Prev);
+shortcut_any_label([I|Is], Prev) ->
+ case normalize_op(I) of
+ error ->
+ error;
+ {Normalized,Fail} ->
+ %% We have a relational operator.
+ case will_succeed(Prev, Normalized) of
+ no ->
+ %% This test instruction will always branch
+ %% to Fail.
+ Fail;
+ yes ->
+ %% This test instruction will never branch,
+ %% so we will look at the next instruction.
+ shortcut_any_label(Is, Prev);
+ maybe ->
+ %% May or may not branch. From now on, we can only
+ %% shortcut to the this specific failure label
+ %% Fail.
+ shortcut_specific_label(Is, Fail, Prev)
+ end
+ end.
+
+%% shortcut_specific_label([Instruction], FailLabel, PrevCondition) ->
+%% FailLabel | error
+%% We have previously encountered a test instruction that may or
+%% may not branch to FailLabel. Therefore we are only allowed
+%% to do the shortcut to the same fail label (FailLabel).
+
+shortcut_specific_label([{label,_}|Is], Fail, Prev) ->
+ shortcut_specific_label(Is, Fail, Prev);
+shortcut_specific_label([{select,select_val,R,{f,F},L}|_], Fail, Prev) ->
+ case shortcut_selectval(L, R, F, Prev) of
+ Fail -> Fail;
+ _ -> error
+ end;
+shortcut_specific_label([I|Is], Fail, Prev) ->
+ case normalize_op(I) of
+ error ->
+ error;
+ {Normalized,Fail} ->
+ case will_succeed(Prev, Normalized) of
+ no ->
+ %% Will branch to FailLabel.
+ Fail;
+ yes ->
+ %% Will definitely never branch.
+ shortcut_specific_label(Is, Fail, Prev);
+ maybe ->
+ %% May branch, but still OK since it will branch
+ %% to FailLabel.
+ shortcut_specific_label(Is, Fail, Prev)
+ end;
+ {Normalized,_} ->
+ %% This test instruction will branch to a different
+ %% fail label, if it branches at all.
+ case will_succeed(Prev, Normalized) of
+ yes ->
+ %% Still OK, since the branch will never be
+ %% taken.
+ shortcut_specific_label(Is, Fail, Prev);
+ no ->
+ %% Give up. The branch will definitely be taken
+ %% to a different fail label.
+ error;
+ maybe ->
+ %% Give up. If the branch is taken, it will be
+ %% to a different fail label.
+ error
+ end
+ end.
+
+
+%% shortcut_selectval(List, Reg, Fail, PrevCond) -> FailLabel | error
+%% Try to shortcut a selectval instruction. A selectval instruction
+%% is equivalent to the following instruction sequence:
+%%
+%% is_ne_exact L1 Reg Value1
+%% .
+%% .
+%% .
+%% is_ne_exact LN Reg ValueN
+%% jump DefaultFailLabel
+%%
+shortcut_selectval([Val,{f,Lbl}|T], R, Fail, Prev) ->
+ case will_succeed(Prev, {'=/=',R,get_literal(Val)}) of
+ yes -> shortcut_selectval(T, R, Fail, Prev);
+ no -> Lbl;
+ maybe -> error
+ end;
+shortcut_selectval([], _, Fail, _) -> Fail.
+
+%% will_succeed(PrevCondition, Condition) -> yes | no | maybe
+%% PrevCondition is a condition known to be true. This function
+%% will tell whether Condition will succeed.
+
+will_succeed({Op1,Reg,A}, {Op2,Reg,B}) ->
+ will_succeed_1(Op1, A, Op2, B);
+will_succeed({'=:=',Reg,{literal,A}}, {TypeTest,Reg}) ->
+ case erlang:TypeTest(A) of
+ false -> no;
+ true -> yes
+ end;
+will_succeed({_,_,_}, maybe) ->
+ maybe;
+will_succeed({_,_,_}, Test) when is_tuple(Test) ->
+ maybe.
+
+will_succeed_1('=:=', A, '<', B) ->
+ if
+ B =< A -> no;
+ true -> yes
+ end;
+will_succeed_1('=:=', A, '=<', B) ->
+ if
+ B < A -> no;
+ true -> yes
+ end;
+will_succeed_1('=:=', A, '=:=', B) ->
+ if
+ A =:= B -> yes;
+ true -> no
+ end;
+will_succeed_1('=:=', A, '=/=', B) ->
+ if
+ A =:= B -> no;
+ true -> yes
+ end;
+will_succeed_1('=:=', A, '>=', B) ->
+ if
+ B > A -> no;
+ true -> yes
+ end;
+will_succeed_1('=:=', A, '>', B) ->
+ if
+ B >= A -> no;
+ true -> yes
+ end;
+
+will_succeed_1('=/=', A, '=/=', B) when A =:= B -> yes;
+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 -> 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 -> 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 -> 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 -> 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 -> yes;
+will_succeed_1('>', A, '>', B) when B < A -> yes;
+
+will_succeed_1(_, _, _, _) -> maybe.
+
+%% normalize_op(Instruction) -> {Normalized,FailLabel} | error
+%% Normalized = {Operator,Register,Literal} |
+%% {TypeTest,Register} |
+%% maybe
+%% Operation = '<' | '=<' | '=:=' | '=/=' | '>=' | '>'
+%% TypeTest = is_atom | is_integer ...
+%% Literal = {literal,Term}
+%%
+%% Normalize a relational operator to facilitate further
+%% comparisons between operators. Always make the register
+%% operand the first operand. Thus the following instruction:
+%%
+%% {test,is_ge,{f,99},{integer,13},{x,0}}
+%%
+%% will be normalized to:
+%%
+%% {'=<',{x,0},{literal,13}}
+%%
+%% NOTE: Bit syntax test instructions are scary. They may change the
+%% state of match contexts and update registers, so we don't dare
+%% mess with them.
+
+normalize_op({test,is_ge,{f,Fail},Ops}) ->
+ normalize_op_1('>=', Ops, Fail);
+normalize_op({test,is_lt,{f,Fail},Ops}) ->
+ normalize_op_1('<', Ops, Fail);
+normalize_op({test,is_eq_exact,{f,Fail},Ops}) ->
+ normalize_op_1('=:=', Ops, Fail);
+normalize_op({test,is_ne_exact,{f,Fail},Ops}) ->
+ normalize_op_1('=/=', Ops, Fail);
+normalize_op({test,is_nil,{f,Fail},[R]}) ->
+ normalize_op_1('=:=', [R,nil], Fail);
+normalize_op({test,Op,{f,Fail},[R]}) ->
+ case erl_internal:new_type_test(Op, 1) of
+ true -> {{Op,R},Fail};
+ false -> {maybe,Fail}
+ end;
+normalize_op({test,_,{f,Fail},_}=I) ->
+ case beam_utils:is_pure_test(I) of
+ true -> {maybe,Fail};
+ false -> error
+ end;
+normalize_op(_) ->
+ error.
+
+normalize_op_1(Op, [Op1,Op2], Fail) ->
+ case {get_literal(Op1),get_literal(Op2)} of
+ {error,error} ->
+ %% Both operands are registers.
+ {maybe,Fail};
+ {error,Lit} ->
+ {{Op,Op1,Lit},Fail};
+ {Lit,error} ->
+ {{turn_op(Op),Op2,Lit},Fail};
+ {_,_} ->
+ %% Both operands are literals. Can probably only
+ %% happen if the Core Erlang optimizations passes were
+ %% turned off, so don't bother trying to do something
+ %% smart here.
+ {maybe,Fail}
+ end.
+
+turn_op('<') -> '>';
+turn_op('>=') -> '=<';
+turn_op('=:='=Op) -> Op;
+turn_op('=/='=Op) -> Op.
+
+negate_op('>=') -> '<';
+negate_op('<') -> '>=';
+negate_op('=<') -> '>';
+negate_op('>') -> '=<';
+negate_op('=:=') -> '=/=';
+negate_op('=/=') -> '=:='.
+
+get_literal({atom,Val}) ->
+ {literal,Val};
+get_literal({integer,Val}) ->
+ {literal,Val};
+get_literal({float,Val}) ->
+ {literal,Val};
+get_literal(nil) ->
+ {literal,[]};
+get_literal({literal,_}=Lit) ->
+ Lit;
+get_literal({_,_}) -> error.
diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl
index 46835bece1..54e06df995 100644
--- a/lib/compiler/src/beam_flatten.erl
+++ b/lib/compiler/src/beam_flatten.erl
@@ -63,8 +63,7 @@ norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I};
norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2};
norm({set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}) ->
{put_map,F,Op,S,D,R,{list,Puts}};
-norm({set,Gets,[S],{get_map_elements,F}}) ->
- {get_map_elements,F,S,{list,Gets}};
+%% get_map_elements is always handled in beam_split (moved out of block)
norm({set,[],[],remove_message}) -> remove_message;
norm({set,[],[],fclearerror}) -> fclearerror;
norm({set,[],[],fcheckerror}) -> {fcheckerror,{f,0}}.
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index b952139f2c..ba71d4efae 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -166,6 +166,12 @@ share_1([{label,L}=Lbl|Is], Dict0, Seq, Acc) ->
end;
share_1([{func_info,_,_,_}=I|Is], _, [], Acc) ->
reverse(Is, [I|Acc]);
+share_1([{'try',_,_}=I|Is], Dict0, Seq, Acc) ->
+ Dict = clean_non_sharable(Dict0),
+ share_1(Is, Dict, [I|Seq], Acc);
+share_1([{try_case,_}=I|Is], Dict0, Seq, Acc) ->
+ Dict = clean_non_sharable(Dict0),
+ share_1(Is, Dict, [I|Seq], Acc);
share_1([I|Is], Dict, Seq, Acc) ->
case is_unreachable_after(I) of
false ->
@@ -174,6 +180,24 @@ share_1([I|Is], Dict, Seq, Acc) ->
share_1(Is, Dict, [I], Acc)
end.
+clean_non_sharable(Dict) ->
+ %% We are passing in or out of a 'try' block. Remove
+ %% sequences that should not shared over the boundaries
+ %% of a 'try' block. Since the end of the sequence must match,
+ %% the only possible match between a sequence outside and
+ %% a sequence inside the 'try' block is a sequence that ends
+ %% with an instruction that causes an exception. Any sequence
+ %% that causes an exception must contain a line/1 instruction.
+ dict:filter(fun(K, _V) -> sharable_with_try(K) end, Dict).
+
+sharable_with_try([{line,_}|_]) ->
+ %% This sequence may cause an exception and may potentially
+ %% match a sequence on the other side of the 'try' block
+ %% boundary.
+ false;
+sharable_with_try([_|Is]) ->
+ sharable_with_try(Is);
+sharable_with_try([]) -> true.
%% Eliminate all fallthroughs. Return the result reversed.
@@ -295,12 +319,6 @@ opt([{test,_,{f,_}=Lbl,_,_,_}=I|Is], Acc, St) ->
opt(Is, [I|Acc], label_used(Lbl, St));
opt([{select,_,_R,Fail,Vls}=I|Is], Acc, St) ->
skip_unreachable(Is, [I|Acc], label_used([Fail|Vls], St));
-opt([{label,L}=I|Is], Acc, #st{entry=L}=St) ->
- %% NEVER move the entry label.
- opt(Is, [I|Acc], St);
-opt([{label,L1},{jump,{f,L2}}=I|Is], [Prev|Acc], St0) ->
- St = St0#st{mlbl=dict:append(L2, L1, St0#st.mlbl)},
- opt([Prev,I|Is], Acc, label_used({f,L2}, St));
opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) ->
case dict:find(Lbl, Mlbl) of
{ok,Lbls} ->
@@ -310,9 +328,20 @@ opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) ->
insert_labels([Lbl|Lbls], Is, Acc, St);
error -> opt(Is, [I|Acc], St0)
end;
-opt([{jump,{f,Lbl}},{label,Lbl}=I|Is], Acc, St) ->
- opt([I|Is], Acc, St);
-opt([{jump,Lbl}=I|Is], Acc, St) ->
+opt([{jump,{f,_}=X}|[{label,_},{jump,X}|_]=Is], Acc, St) ->
+ opt(Is, Acc, St);
+opt([{jump,{f,Lbl}}|[{label,Lbl}|_]=Is], Acc, St) ->
+ opt(Is, Acc, St);
+opt([{jump,{f,L}=Lbl}=I|Is], Acc0, #st{mlbl=Mlbl0}=St0) ->
+ %% All labels before this jump instruction should now be
+ %% moved to the location of the jump's target.
+ {Lbls,Acc} = collect_labels(Acc0, St0),
+ St = case Lbls of
+ [] -> St0;
+ [_|_] ->
+ Mlbl = dict:append_list(L, Lbls, Mlbl0),
+ St0#st{mlbl=Mlbl}
+ end,
skip_unreachable(Is, [I|Acc], label_used(Lbl, St));
%% Optimization: quickly handle some common instructions that don't
%% have any failure labels and where is_unreachable_after(I) =:= false.
@@ -349,6 +378,17 @@ insert_fc_labels([L|Ls], Mlbl, Acc0) ->
end;
insert_fc_labels([], _, Acc) -> Acc.
+collect_labels(Is, #st{entry=Entry}) ->
+ collect_labels_1(Is, Entry, []).
+
+collect_labels_1([{label,Entry}|_]=Is, Entry, Acc) ->
+ %% Never move the entry label.
+ {Acc,Is};
+collect_labels_1([{label,L}|Is], Entry, Acc) ->
+ collect_labels_1(Is, Entry, [L|Acc]);
+collect_labels_1(Is, _Entry, Acc) ->
+ {Acc,Is}.
+
%% label_defined(Is, Label) -> true | false.
%% Test whether the label Label is defined at the start of the instruction
%% sequence, possibly preceeded by other label definitions.
@@ -435,14 +475,14 @@ is_label_used_in(Lbl, Is) ->
is_label_used_in_1(Is, Lbl, gb_sets:empty()).
is_label_used_in_1([{block,Block}|Is], Lbl, Empty) ->
- lists:any(fun(I) -> is_label_used_in_2(I, Lbl) end, Block)
+ lists:any(fun(I) -> is_label_used_in_block(I, Lbl) end, Block)
orelse is_label_used_in_1(Is, Lbl, Empty);
is_label_used_in_1([I|Is], Lbl, Empty) ->
Used = ulbl(I, Empty),
gb_sets:is_member(Lbl, Used) orelse is_label_used_in_1(Is, Lbl, Empty);
is_label_used_in_1([], _, _) -> false.
-is_label_used_in_2({set,_,_,Info}, Lbl) ->
+is_label_used_in_block({set,_,_,Info}, Lbl) ->
case Info of
{bif,_,{f,F}} -> F =:= Lbl;
{alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl;
@@ -452,7 +492,6 @@ is_label_used_in_2({set,_,_,Info}, Lbl) ->
{put_tuple,_} -> false;
{get_tuple_element,_} -> false;
{set_tuple_element,_} -> false;
- {get_map_elements,{f,F}} -> F =:= Lbl;
{line,_} -> false;
_ when is_atom(Info) -> false
end.
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_split.erl b/lib/compiler/src/beam_split.erl
index 688bba9a94..0c62b0bf3d 100644
--- a/lib/compiler/src/beam_split.erl
+++ b/lib/compiler/src/beam_split.erl
@@ -53,8 +53,8 @@ split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is],
Bl, Acc) when Lbl =/= 0 ->
split_block(Is, [], [{put_map,Fail,Op,S,D,R,{list,Puts}}|
make_block(Bl, Acc)]);
-split_block([{set,Gets,[S],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc)
- when Lbl =/= 0 ->
+split_block([{set,Ds,[S|Ss],{get_map_elements,Fail}}|Is], Bl, Acc) ->
+ Gets = beam_utils:join_even(Ss,Ds),
split_block(Is, [], [{get_map_elements,Fail,S,{list,Gets}}|make_block(Bl, Acc)]);
split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) ->
split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]);
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index 58c0f765ae..26c933481a 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -106,6 +106,20 @@ simplify_basic_1([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Acc) ->
Ts = update(I, Ts0),
simplify_basic_1(Is, Ts, [I|Acc])
end;
+simplify_basic_1([{test,is_map,_,[R]}=I|Is], Ts0, Acc) ->
+ case tdb_find(R, Ts0) of
+ map -> simplify_basic_1(Is, Ts0, Acc);
+ _Other ->
+ Ts = update(I, Ts0),
+ simplify_basic_1(Is, Ts, [I|Acc])
+ end;
+simplify_basic_1([{test,is_nonempty_list,_,[R]}=I|Is], Ts0, Acc) ->
+ case tdb_find(R, Ts0) of
+ nonempty_list -> simplify_basic_1(Is, Ts0, Acc);
+ _Other ->
+ Ts = update(I, Ts0),
+ simplify_basic_1(Is, Ts, [I|Acc])
+ end;
simplify_basic_1([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Acc0) ->
Acc = case tdb_find(R, Ts0) of
{atom,_}=Atom -> Acc0;
@@ -230,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;
@@ -315,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),
- flt_liveness_1(Is, Regs, [I|Acc]);
-flt_liveness_1([{'%live',_}=I|Is], Regs, Acc) ->
+ Regs = x_live(Ds, Regs0),
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.
@@ -350,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) ->
@@ -402,6 +417,10 @@ update({test,is_float,_Fail,[Src]}, Ts0) ->
tdb_update([{Src,float}], Ts0);
update({test,test_arity,_Fail,[Src,Arity]}, Ts0) ->
tdb_update([{Src,{tuple,Arity,[]}}], Ts0);
+update({test,is_map,_Fail,[Src]}, Ts0) ->
+ tdb_update([{Src,map}], Ts0);
+update({test,is_nonempty_list,_Fail,[Src]}, Ts0) ->
+ tdb_update([{Src,nonempty_list}], Ts0);
update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) ->
case tdb_find(Reg, Ts) of
error ->
@@ -451,6 +470,7 @@ is_math_bif(erf, 1) -> true;
is_math_bif(erfc, 1) -> true;
is_math_bif(exp, 1) -> true;
is_math_bif(log, 1) -> true;
+is_math_bif(log2, 1) -> true;
is_math_bif(log10, 1) -> true;
is_math_bif(sqrt, 1) -> true;
is_math_bif(atan2, 2) -> true;
@@ -710,6 +730,8 @@ merge_type_info(NewType, _) ->
verify_type(NewType),
NewType.
+verify_type(map) -> ok;
+verify_type(nonempty_list) -> ok;
verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok;
verify_type({tuple,Sz,[_]}) when is_integer(Sz) -> ok;
verify_type({tuple_element,_,_}) -> ok;
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index 8ca368c167..7704690f86 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -26,6 +26,8 @@
code_at/2,bif_to_test/3,is_pure_test/1,
live_opt/1,delete_live_annos/1,combine_heap_needs/2]).
+-export([join_even/2,split_even/1]).
+
-import(lists, [member/2,sort/1,reverse/1,splitwith/2]).
-record(live,
@@ -185,7 +187,7 @@ is_pure_test({test,is_lt,_,[_,_]}) -> true;
is_pure_test({test,is_nil,_,[_]}) -> true;
is_pure_test({test,is_nonempty_list,_,[_]}) -> true;
is_pure_test({test,test_arity,_,[_,_]}) -> true;
-is_pure_test({test,has_map_fields,_,[_,{list,_}]}) -> true;
+is_pure_test({test,has_map_fields,_,[_|_]}) -> true;
is_pure_test({test,Op,_,Ops}) ->
erl_internal:new_type_test(Op, length(Ops)).
@@ -194,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) ->
@@ -215,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)];
@@ -364,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 ->
@@ -552,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)
@@ -575,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)
@@ -676,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),
@@ -756,13 +753,9 @@ live_opt([{line,_}=I|Is], Regs, D, Acc) ->
live_opt(Is, Regs, D, [I|Acc]);
%% The following instructions can occur if the "compilation" has been
-%% started from a .S file using the 'asm' option.
+%% started from a .S file using the 'from_asm' option.
live_opt([{trim,_,_}=I|Is], Regs, D, Acc) ->
live_opt(Is, Regs, D, [I|Acc]);
-live_opt([{allocate,_,Live}=I|Is], _, D, Acc) ->
- live_opt(Is, live_call(Live), D, [I|Acc]);
-live_opt([{allocate_heap,_,_,Live}=I|Is], _, D, Acc) ->
- live_opt(Is, live_call(Live), D, [I|Acc]);
live_opt([{'%',_}=I|Is], Regs, D, Acc) ->
live_opt(Is, Regs, D, [I|Acc]);
live_opt([{recv_set,_}=I|Is], Regs, D, Acc) ->
@@ -832,3 +825,15 @@ x_live([_|Rs], Regs) -> x_live(Rs, Regs);
x_live([], Regs) -> Regs.
is_live(X, Regs) -> ((Regs bsr X) band 1) =:= 1.
+
+%% split_even/1
+%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]}
+split_even(Rs) -> split_even(Rs,[],[]).
+split_even([],Ss,Ds) -> {reverse(Ss),reverse(Ds)};
+split_even([S,D|Rs],Ss,Ds) ->
+ split_even(Rs,[S|Ss],[D|Ds]).
+
+%% join_even/1
+%% {[1,3,5],[2,4,6]} -> [1,2,3,4,5,6]
+join_even([],[]) -> [];
+join_even([S|Ss],[D|Ds]) -> [S,D|join_even(Ss,Ds)].
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 9d5563d13b..4d4536b79c 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -22,7 +22,6 @@
%% Avoid warning for local function error/1 clashing with autoimported BIF.
-compile({no_auto_import,[error/1]}).
--export([file/1, files/1]).
%% Interface for compiler.
-export([module/2, format_error/1]).
@@ -40,38 +39,12 @@
-define(DBG_FORMAT(F, D), ok).
-endif.
-%%%
-%%% API functions.
-%%%
-
--spec file(file:filename()) -> 'ok' | {'error', term()}.
-
-file(Name) when is_list(Name) ->
- case case filename:extension(Name) of
- ".S" -> s_file(Name);
- ".beam" -> beam_file(Name)
- end of
- [] -> ok;
- Es -> {error,Es}
- end.
-
--spec files([file:filename()]) -> 'ok'.
-
-files([F|Fs]) ->
- ?DBG_FORMAT("# Verifying: ~p~n", [F]),
- case file(F) of
- ok -> ok;
- {error,Es} ->
- io:format("~tp:~n~ts~n", [F,format_error(Es)])
- end,
- files(Fs);
-files([]) -> ok.
-
%% To be called by the compiler.
module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts)
when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) ->
case validate(Mod, Fs) of
- [] -> {ok,Code};
+ [] ->
+ {ok,Code};
Es0 ->
Es = [{?MODULE,E} || E <- Es0],
{error,[{atom_to_list(Mod),Es}]}
@@ -79,12 +52,6 @@ module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts)
-spec format_error(term()) -> iolist().
-format_error([]) -> [];
-format_error([{{M,F,A},{I,Off,Desc}}|Es]) ->
- [io_lib:format(" ~p:~p/~p+~p:~n ~p - ~p~n",
- [M,F,A,Off,I,Desc])|format_error(Es)];
-format_error([Error|Es]) ->
- [format_error(Error)|format_error(Es)];
format_error({{_M,F,A},{I,Off,limit}}) ->
io_lib:format(
"function ~p/~p+~p:~n"
@@ -103,8 +70,6 @@ format_error({{_M,F,A},{I,Off,Desc}}) ->
" Internal consistency check failed - please report this bug.~n"
" Instruction: ~p~n"
" Error: ~p:~n", [F,A,Off,I,Desc]);
-format_error({Module,Error}) ->
- [Module:format_error(Error)];
format_error(Error) ->
io_lib:format("~p~n", [Error]).
@@ -112,36 +77,6 @@ format_error(Error) ->
%%% Local functions follow.
%%%
-s_file(Name) ->
- {ok,Is} = file:consult(Name),
- {module,Module} = lists:keyfind(module, 1, Is),
- Fs = find_functions(Is),
- validate(Module, Fs).
-
-find_functions(Fs) ->
- find_functions_1(Fs, none, [], []).
-
-find_functions_1([{function,Name,Arity,Entry}|Is], Func, FuncAcc, Acc0) ->
- Acc = add_func(Func, FuncAcc, Acc0),
- find_functions_1(Is, {Name,Arity,Entry}, [], Acc);
-find_functions_1([I|Is], Func, FuncAcc, Acc) ->
- find_functions_1(Is, Func, [I|FuncAcc], Acc);
-find_functions_1([], Func, FuncAcc, Acc) ->
- reverse(add_func(Func, FuncAcc, Acc)).
-
-add_func(none, _, Acc) -> Acc;
-add_func({Name,Arity,Entry}, Is, Acc) ->
- [{function,Name,Arity,Entry,reverse(Is)}|Acc].
-
-beam_file(Name) ->
- try beam_disasm:file(Name) of
- {error,beam_lib,Reason} -> [{beam_lib,Reason}];
- #beam_file{module=Module, code=Code0} ->
- Code = normalize_disassembled_code(Code0),
- validate(Module, Code)
- catch _:_ -> [disassembly_failed]
- end.
-
%%%
%%% The validator follows.
%%%
@@ -196,23 +131,16 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
try validate_1(Code, Name, Ar, Entry, Ft) of
_ -> validate_0(Module, Fs, Ft)
catch
- Error ->
+ throw:Error ->
+ %% Controlled error.
[Error|validate_0(Module, Fs, Ft)];
- error:Error ->
- [validate_error(Error, Module, Name, Ar)|validate_0(Module, Fs, Ft)]
+ Class:Error ->
+ %% Crash.
+ Stack = erlang:get_stacktrace(),
+ io:fwrite("Function: ~w/~w\n", [Name,Ar]),
+ erlang:raise(Class, Error, Stack)
end.
--ifdef(DEBUG).
-validate_error(Error, Module, Name, Ar) ->
- exit(validate_error_1(Error, Module, Name, Ar)).
--else.
-validate_error(Error, Module, Name, Ar) ->
- validate_error_1(Error, Module, Name, Ar).
--endif.
-validate_error_1(Error, Module, Name, Ar) ->
- {{Module,Name,Ar},
- {internal_error,'_',{Error,erlang:get_stacktrace()}}}.
-
-type index() :: non_neg_integer().
-type reg_tab() :: gb_trees:tree(index(), 'none' | {'value', _}).
@@ -225,7 +153,6 @@ validate_error_1(Error, Module, Name, Ar) ->
hf=0, %Available heap size for floats.
fls=undefined, %Floating point state.
ct=[], %List of hot catch/try labels
- bsm=undefined, %Bit syntax matching state.
bits=undefined, %Number of bits in bit syntax binary.
setelem=false %Previous instruction was setelement/3.
}).
@@ -308,7 +235,7 @@ labels_1([{label,L}|Is], R) ->
labels_1([{line,_}|Is], R) ->
labels_1(Is, R);
labels_1(Is, R) ->
- {lists:reverse(R),Is}.
+ {reverse(R),Is}.
init_state(Arity) ->
Xs = init_regs(Arity, term),
@@ -403,10 +330,6 @@ valfun_1({init,{y,_}=Reg}, Vst) ->
set_type_y(initialized, Reg, Vst);
valfun_1({test_heap,Heap,Live}, Vst) ->
test_heap(Heap, Live, Vst);
-valfun_1({bif,_Op,nofail,Src,Dst}, Vst) ->
- %% The 'nofail' atom only occurs in disassembled code.
- validate_src(Src, Vst),
- set_type_reg(term, Dst, Vst);
valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) ->
case is_bif_safe(Op, length(Src)) of
false ->
@@ -432,18 +355,12 @@ valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) ->
valfun_1({put,Src}, Vst) ->
assert_term(Src, Vst),
eat_heap(1, Vst);
-valfun_1({put_string,Sz,_,Dst}, Vst0) when is_integer(Sz) ->
- Vst = eat_heap(2*Sz, Vst0),
- set_type_reg(cons, Dst, Vst);
%% Instructions for optimization of selective receives.
valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) ->
Vst;
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) ->
@@ -602,8 +519,6 @@ valfun_4({call_ext_last,Live,Func,StkSize},
tail_call(Func, Live, Vst);
valfun_4({call_ext_last,_,_,_}, #vst{current=#st{numy=NumY}}) ->
error({allocated,NumY});
-valfun_4({make_fun,_,_,Live}, Vst) ->
- call('fun', Live, Vst);
valfun_4({make_fun2,_,_,_,Live}, Vst) ->
call(make_fun, Live, Vst);
%% Other BIFs
@@ -620,8 +535,6 @@ valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) ->
TupleType = upgrade_tuple_type({tuple,[get_tuple_size(PosType)]}, TupleType0),
Vst = set_type(TupleType, Tuple, Vst1),
set_type_reg(term, Dst, Vst);
-valfun_4({raise,{f,_}=Fail,Src,Dst}, Vst) ->
- valfun_4({bif,raise,Fail,Src,Dst}, Vst);
valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) ->
validate_src(Src, Vst0),
Vst = branch_state(Fail, Vst0),
@@ -738,32 +651,6 @@ valfun_4({bs_save2,Ctx,SavePoint}, Vst) ->
valfun_4({bs_restore2,Ctx,SavePoint}, Vst) ->
bsm_restore(Ctx, SavePoint, Vst);
-%% Bit syntax instructions.
-valfun_4({bs_start_match,{f,_Fail}=F,Src}, Vst) ->
- valfun_4({test,bs_start_match,F,[Src]}, Vst);
-valfun_4({test,bs_start_match,{f,Fail},[Src]}, Vst) ->
- assert_term(Src, Vst),
- bs_start_match(branch_state(Fail, Vst));
-
-valfun_4({bs_save,SavePoint}, Vst) ->
- bs_assert_state(Vst),
- bs_save(SavePoint, Vst);
-valfun_4({bs_restore,SavePoint}, Vst) ->
- bs_assert_state(Vst),
- bs_assert_savepoint(SavePoint, Vst),
- Vst;
-valfun_4({test,bs_skip_bits,{f,Fail},[Src,_,_]}, Vst) ->
- bs_assert_state(Vst),
- assert_term(Src, Vst),
- branch_state(Fail, Vst);
-valfun_4({test,bs_test_tail,{f,Fail},_}, Vst) ->
- bs_assert_state(Vst),
- branch_state(Fail, Vst);
-valfun_4({test,_,{f,Fail},[_,_,_,Dst]}, Vst0) ->
- bs_assert_state(Vst0),
- Vst = branch_state(Fail, Vst0),
- set_type_reg({integer,[]}, Dst, Vst);
-
%% Other test instructions.
valfun_4({test,is_float,{f,Lbl},[Float]}, Vst) ->
assert_term(Float, Vst),
@@ -779,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);
@@ -795,9 +690,6 @@ valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) ->
valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) ->
assert_term(A, Vst),
set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst));
-valfun_4({bs_bits_to_bytes,{f,Fail},Src,Dst}, Vst) ->
- assert_term(Src, Vst),
- set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst));
valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
verify_live(Live, Vst0),
if
@@ -868,16 +760,6 @@ valfun_4({bs_put_utf32,{f,Fail},_,Src}=I, Vst0) ->
assert_term(Src, Vst0),
Vst = bs_align_check(I, Vst0),
branch_state(Fail, Vst);
-%% Old bit syntax construction (before R10B).
-valfun_4({bs_init,_,_}, Vst) ->
- bs_zero_bits(Vst);
-valfun_4({bs_need_buf,_}, Vst) -> Vst;
-valfun_4({bs_final,{f,Fail},Dst}, Vst0) ->
- Vst = branch_state(Fail, Vst0),
- set_type_reg(binary, Dst, Vst);
-valfun_4({bs_final2,Src,Dst}, Vst0) ->
- assert_term(Src, Vst0),
- set_type_reg(binary, Dst, Vst0);
%% Map instructions.
valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) ->
verify_put_map(Fail, Src, Dst, Live, List, Vst);
@@ -889,26 +771,30 @@ 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),
- Lits = mmap(fun(L,_R) -> [L] end, List),
- assert_strict_literal_termorder(Lits),
+ Keys = extract_map_keys(List),
+ assert_strict_literal_termorder(Keys),
verify_get_map_pair(List,Vst0,Vst1).
+extract_map_keys([Key,_Val|T]) ->
+ [Key|extract_map_keys(T)];
+extract_map_keys([]) -> [].
+
verify_get_map_pair([],_,Vst) -> Vst;
verify_get_map_pair([Src,Dst|Vs],Vst0,Vsti) ->
assert_term(Src, Vst0),
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.
@@ -936,9 +822,6 @@ validate_bs_skip_utf(Fail, Ctx, Live, Vst0) ->
%%
val_dsetel({move,_,_}, Vst) ->
Vst;
-val_dsetel({put_string,0,{string,""},_}, Vst) ->
- %% An empty string is OK since it doesn't build anything.
- Vst;
val_dsetel({call_ext,3,{extfunc,erlang,setelement,3}}, #vst{current=St}=Vst) ->
Vst#vst{current=St#st{setelem=true}};
val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) ->
@@ -972,7 +855,7 @@ call(Name, Live, #vst{current=St}=Vst) ->
Type when Type =/= exception ->
%% Type is never 'exception' because it has been handled earlier.
Xs = gb_trees_from_list([{0,Type}]),
- Vst#vst{current=St#st{x=Xs,f=init_fregs(),bsm=undefined}}
+ Vst#vst{current=St#st{x=Xs,f=init_fregs()}}
end.
%% Tail call.
@@ -1030,7 +913,7 @@ allocate(_, _, _, _, #vst{current=#st{numy=Numy}}) ->
error({existing_stack_frame,{size,Numy}}).
deallocate(#vst{current=St}=Vst) ->
- Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none,bsm=undefined}}.
+ Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none}}.
test_heap(Heap, Live, Vst0) ->
verify_live(Live, Vst0),
@@ -1038,7 +921,7 @@ test_heap(Heap, Live, Vst0) ->
heap_alloc(Heap, Vst).
heap_alloc(Heap, #vst{current=St0}=Vst) ->
- St1 = kill_heap_allocation(St0#st{bsm=undefined}),
+ St1 = kill_heap_allocation(St0),
St = heap_alloc_1(Heap, St1),
Vst#vst{current=St}.
@@ -1122,72 +1005,30 @@ assert_freg_set(Fr, _) -> error({bad_source,Fr}).
%%% Maps
-%% ensure that a list of literals has a strict
-%% ascending term order (also meaning unique literals)
-assert_strict_literal_termorder(Ls) ->
- Vs = lists:map(fun (L) -> get_literal(L) end, Ls),
+%% A single item list may be either a list or a register.
+%%
+%% A list with more than item must contain literals in
+%% ascending term order.
+%%
+%% An empty list is not allowed.
+
+assert_strict_literal_termorder([]) ->
+ %% There is no reason to use the get_map_elements and
+ %% has_map_fields instructions with empty lists.
+ error(empty_field_list);
+assert_strict_literal_termorder([_]) ->
+ ok;
+assert_strict_literal_termorder([_,_|_]=Ls) ->
+ Vs = [get_literal(L) || L <- Ls],
case check_strict_value_termorder(Vs) of
true -> ok;
- false -> error({not_strict_order, Ls})
+ false -> error(not_strict_order)
end.
-%% usage:
-%% mmap(fun(A,B) -> [{A,B}] end, [1,2,3,4]),
-%% [{1,2},{3,4}]
-
-mmap(F,List) ->
- {arity,Ar} = erlang:fun_info(F,arity),
- mmap(F,Ar,List).
-mmap(_F,_,[]) -> [];
-mmap(F,Ar,List) ->
- {Hd,Tl} = lists:split(Ar,List),
- apply(F,Hd) ++ mmap(F,Ar,Tl).
-
-check_strict_value_termorder([]) -> true;
-check_strict_value_termorder([_]) -> true;
-check_strict_value_termorder([V1,V2]) ->
- erts_internal:cmp_term(V1,V2) < 0;
-check_strict_value_termorder([V1,V2|Vs]) ->
- case erts_internal:cmp_term(V1,V2) < 0 of
- true -> check_strict_value_termorder([V2|Vs]);
- false -> false
- end.
-
-%%%
-%%% Binary matching.
-%%%
-%%% Possible values for the bsm field (=bit syntax matching state).
-%%%
-%%% undefined - Undefined (initial state). No matching instructions allowed.
-%%%
-%%% (gb set) - The gb set contains the defined save points.
-%%%
-%%% The bsm field is reset to 'undefined' by instructions that may cause a
-%%% a garbage collection (might move the binary) and/or context switch
-%%% (may invalidate the save points).
-
-bs_start_match(#vst{current=#st{bsm=undefined}=St}=Vst) ->
- Vst#vst{current=St#st{bsm=gb_sets:empty()}};
-bs_start_match(Vst) ->
- %% Must retain save points here - it is possible to restore back
- %% to a previous binary.
- Vst.
-
-bs_save(Reg, #vst{current=#st{bsm=Saved}=St}=Vst)
- when is_integer(Reg), Reg < ?MAXREG ->
- Vst#vst{current=St#st{bsm=gb_sets:add(Reg, Saved)}};
-bs_save(_, _) -> error(limit).
-
-bs_assert_savepoint(Reg, #vst{current=#st{bsm=Saved}}) ->
- case gb_sets:is_member(Reg, Saved) of
- false -> error({no_save_point,Reg});
- true -> ok
- end.
-
-bs_assert_state(#vst{current=#st{bsm=undefined}}) ->
- error(no_bs_match_state);
-bs_assert_state(_) -> ok.
-
+check_strict_value_termorder([V1|[V2|_]=Vs]) ->
+ erts_internal:cmp_term(V1, V2) < 0 andalso
+ check_strict_value_termorder(Vs);
+check_strict_value_termorder([_]) -> true.
%%%
%%% New binary matching instructions.
@@ -1387,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)).
@@ -1469,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
@@ -1523,14 +1366,13 @@ merge_states(L, St, Branched) when L =/= 0 ->
{value,OtherSt} -> merge_states_1(St, OtherSt)
end.
-merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0,bsm=Bsm0}=St,
- #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1,bsm=Bsm1}) ->
+merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0}=St,
+ #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1}) ->
NumY = merge_stk(NumY0, NumY1),
Xs = merge_regs(Xs0, Xs1),
Ys = merge_y_regs(Ys0, Ys1),
Ct = merge_ct(Ct0, Ct1),
- Bsm = merge_bsm(Bsm0, Bsm1),
- St#st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct,bsm=Bsm}.
+ St#st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct}.
merge_stk(S, S) -> S;
merge_stk(_, _) -> undecided.
@@ -1613,10 +1455,6 @@ merge_types(T1, T2) when T1 =/= T2 ->
%% Too different. All we know is that the type is a 'term'.
term.
-merge_bsm(undefined, _) -> undefined;
-merge_bsm(_, undefined) -> undefined;
-merge_bsm(Bsm0, Bsm1) -> gb_sets:intersection(Bsm0, Bsm1).
-
tuple_sz([Sz]) -> Sz;
tuple_sz(Sz) -> Sz.
@@ -1723,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;
@@ -1752,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;
@@ -1816,6 +1656,7 @@ return_type_math(erf, 1) -> {float,[]};
return_type_math(erfc, 1) -> {float,[]};
return_type_math(exp, 1) -> {float,[]};
return_type_math(log, 1) -> {float,[]};
+return_type_math(log2, 1) -> {float,[]};
return_type_math(log10, 1) -> {float,[]};
return_type_math(sqrt, 1) -> {float,[]};
return_type_math(atan2, 2) -> {float,[]};
@@ -1837,52 +1678,3 @@ error(Error) -> exit(Error).
-else.
error(Error) -> throw(Error).
-endif.
-
-
-%%%
-%%% Rewrite disassembled code to the same format as we used internally
-%%% to not have to worry later.
-%%%
-
-normalize_disassembled_code(Fs) ->
- Index = ndc_index(Fs, []),
- ndc(Fs, Index, []).
-
-ndc_index([{function,Name,Arity,Entry,_Code}|Fs], Acc) ->
- ndc_index(Fs, [{{Name,Arity},Entry}|Acc]);
-ndc_index([], Acc) ->
- gb_trees:from_orddict(lists:sort(Acc)).
-
-ndc([{function,Name,Arity,Entry,Code0}|Fs], D, Acc) ->
- Code = ndc_1(Code0, D, []),
- ndc(Fs, D, [{function,Name,Arity,Entry,Code}|Acc]);
-ndc([], _, Acc) -> reverse(Acc).
-
-ndc_1([{call=Op,A,{_,F,A}}|Is], D, Acc) ->
- ndc_1(Is, D, [{Op,A,{f,gb_trees:get({F,A}, D)}}|Acc]);
-ndc_1([{call_only=Op,A,{_,F,A}}|Is], D, Acc) ->
- ndc_1(Is, D, [{Op,A,{f,gb_trees:get({F,A}, D)}}|Acc]);
-ndc_1([{call_last=Op,A,{_,F,A},Sz}|Is], D, Acc) ->
- ndc_1(Is, D, [{Op,A,{f,gb_trees:get({F,A}, D)},Sz}|Acc]);
-ndc_1([{arithbif,Op,F,Src,Dst}|Is], D, Acc) ->
- ndc_1(Is, D, [{bif,Op,F,Src,Dst}|Acc]);
-ndc_1([{arithfbif,Op,F,Src,Dst}|Is], D, Acc) ->
- ndc_1(Is, D, [{bif,Op,F,Src,Dst}|Acc]);
-ndc_1([{test,bs_start_match2=Op,F,[A1,Live,A3,Dst]}|Is], D, Acc) ->
- ndc_1(Is, D, [{test,Op,F,Live,[A1,A3],Dst}|Acc]);
-ndc_1([{test,bs_get_binary2=Op,F,[A1,Live,A3,A4,A5,Dst]}|Is], D, Acc) ->
- ndc_1(Is, D, [{test,Op,F,Live,[A1,A3,A4,A5],Dst}|Acc]);
-ndc_1([{test,bs_get_float2=Op,F,[A1,Live,A3,A4,A5,Dst]}|Is], D, Acc) ->
- ndc_1(Is, D, [{test,Op,F,Live,[A1,A3,A4,A5],Dst}|Acc]);
-ndc_1([{test,bs_get_integer2=Op,F,[A1,Live,A3,A4,A5,Dst]}|Is], D, Acc) ->
- ndc_1(Is, D, [{test,Op,F,Live,[A1,A3,A4,A5],Dst}|Acc]);
-ndc_1([{test,bs_get_utf8=Op,F,[A1,Live,A3,Dst]}|Is], D, Acc) ->
- ndc_1(Is, D, [{test,Op,F,Live,[A1,A3],Dst}|Acc]);
-ndc_1([{test,bs_get_utf16=Op,F,[A1,Live,A3,Dst]}|Is], D, Acc) ->
- ndc_1(Is, D, [{test,Op,F,Live,[A1,A3],Dst}|Acc]);
-ndc_1([{test,bs_get_utf32=Op,F,[A1,Live,A3,Dst]}|Is], D, Acc) ->
- ndc_1(Is, D, [{test,Op,F,Live,[A1,A3],Dst}|Acc]);
-ndc_1([I|Is], D, Acc) ->
- ndc_1(Is, D, [I|Acc]);
-ndc_1([], _, Acc) ->
- reverse(Acc).
diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl
index c2a6ef604e..0c7bef9183 100644
--- a/lib/compiler/src/beam_z.erl
+++ b/lib/compiler/src/beam_z.erl
@@ -79,17 +79,9 @@ undo_rename({put_map,Fail,assoc,S,D,R,L}) ->
undo_rename({put_map,Fail,exact,S,D,R,L}) ->
{put_map_exact,Fail,S,D,R,L};
undo_rename({test,has_map_fields,Fail,[Src|List]}) ->
- {test,has_map_fields,Fail,Src,{list,[to_typed_literal(V)||V<-List]}};
-undo_rename({get_map_elements,Fail,Src,{list, List}}) ->
- {get_map_elements,Fail,Src,{list,[to_typed_literal(V)||V<-List]}};
+ {test,has_map_fields,Fail,Src,{list,List}};
+undo_rename({get_map_elements,Fail,Src,{list,List}}) ->
+ {get_map_elements,Fail,Src,{list,List}};
undo_rename({select,I,Reg,Fail,List}) ->
{I,Reg,Fail,{list,List}};
undo_rename(I) -> I.
-
-%% to_typed_literal(Arg)
-%% transform Arg to specific literal i.e. float | integer | atom if applicable
-to_typed_literal({literal, V}) when is_float(V) -> {float, V};
-to_typed_literal({literal, V}) when is_atom(V) -> {atom, V};
-to_typed_literal({literal, V}) when is_integer(V) -> {integer, V};
-to_typed_literal({literal, []}) -> nil;
-to_typed_literal(V) -> V.
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 9d6768b157..8367a1e19e 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -123,11 +123,14 @@
bitstr_flags/1,
%% keep map exports here for now
+ c_map_pattern/1,
+ is_c_map/1,
map_es/1,
map_arg/1,
update_c_map/3,
c_map/1, is_c_map_empty/1,
ann_c_map/2, ann_c_map/3,
+ ann_c_map_pattern/2,
map_pair_op/1,map_pair_key/1,map_pair_val/1,
update_c_map_pair/4,
c_map_pair/2,
@@ -135,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").
@@ -431,6 +435,8 @@ is_literal_term([H | T]) ->
is_literal_term(T) when is_tuple(T) ->
is_literal_term_list(tuple_to_list(T));
is_literal_term(B) when is_bitstring(B) -> true;
+is_literal_term(M) when is_map(M) ->
+ is_literal_term_list(maps:to_list(M));
is_literal_term(_) ->
false.
@@ -1577,6 +1583,20 @@ ann_make_list(_, [], Node) ->
%% ---------------------------------------------------------------------
%% maps
+%% @spec is_c_map(Node::cerl()) -> boolean()
+%%
+%% @doc Returns <code>true</code> if <code>Node</code> is an abstract
+%% map constructor, otherwise <code>false</code>.
+
+-spec is_c_map(cerl()) -> boolean().
+
+is_c_map(#c_map{}) ->
+ true;
+is_c_map(#c_literal{val = V}) when is_map(V) ->
+ true;
+is_c_map(_) ->
+ false.
+
-spec map_es(c_map()) -> [c_map_pair()].
map_es(#c_map{es = Es}) ->
@@ -1590,7 +1610,17 @@ map_arg(#c_map{arg=M}) ->
-spec c_map([c_map_pair()]) -> c_map().
c_map(Pairs) ->
- #c_map{es=Pairs}.
+ ann_c_map([], Pairs).
+
+-spec c_map_pattern([c_map_pair()]) -> c_map().
+
+c_map_pattern(Pairs) ->
+ #c_map{es=Pairs, is_pat=true}.
+
+-spec ann_c_map_pattern([term()], [c_map_pair()]) -> c_map().
+
+ann_c_map_pattern(As, Pairs) ->
+ #c_map{anno=As, es=Pairs, is_pat=true}.
-spec is_c_map_empty(c_map() | c_literal()) -> boolean().
@@ -1598,25 +1628,13 @@ is_c_map_empty(#c_map{ es=[] }) -> true;
is_c_map_empty(#c_literal{val=M}) when is_map(M),map_size(M) =:= 0 -> true;
is_c_map_empty(_) -> false.
--spec ann_c_map([term()], [cerl()]) -> c_map() | c_literal().
+-spec ann_c_map([term()], [c_map_pair()]) -> c_map() | c_literal().
-ann_c_map(As,Es) ->
+ann_c_map(As, Es) ->
ann_c_map(As, #c_literal{val=#{}}, Es).
-spec ann_c_map([term()], c_map() | c_literal(), [c_map_pair()]) -> c_map() | c_literal().
-ann_c_map(As,#c_literal{val=Mval}=M,Es) when is_map(Mval), map_size(Mval) =:= 0 ->
- Pairs = [[Ck,Cv]||#c_map_pair{key=Ck,val=Cv}<-Es],
- IsLit = lists:foldl(fun(Pair,Res) ->
- Res andalso is_lit_list(Pair)
- end, true, Pairs),
- Fun = fun(Pair) -> [K,V] = lit_list_vals(Pair), {K,V} end,
- case IsLit of
- false ->
- #c_map{arg=M, es=Es, anno=As };
- true ->
- #c_literal{anno=As, val=maps:from_list(lists:map(Fun, Pairs))}
- end;
ann_c_map(As,#c_literal{val=M},Es) when is_map(M) ->
fold_map_pairs(As,Es,M);
ann_c_map(As,M,Es) ->
@@ -1644,14 +1662,14 @@ fold_map_pairs(As,[#c_map_pair{op=#c_literal{val=exact},key=Ck,val=Cv}=E|Es],M)
end;
false ->
#c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As }
- end;
-fold_map_pairs(As,Es,M) ->
- #c_map{arg=#c_literal{val=M,anno=As}, es=Es, anno=As }.
+ end.
-%-spec update_c_map(c_map() | c_literal(), [c_map_pair()]) -> c_map() | c_literal().
+-spec update_c_map(c_map(), cerl(), [cerl()]) -> c_map() | c_literal().
-update_c_map(Old,M,Es) ->
- #c_map{arg=M, es = Es, anno = get_ann(Old)}.
+update_c_map(#c_map{is_pat=true}=Old, M, Es) ->
+ Old#c_map{arg=M, es=Es};
+update_c_map(#c_map{is_pat=false}=Old, M, Es) ->
+ ann_c_map(get_ann(Old), M, Es).
map_pair_key(#c_map_pair{key=K}) -> K.
map_pair_val(#c_map_pair{val=V}) -> V.
@@ -3063,10 +3081,12 @@ pat_vars(Node, Vs) ->
map ->
pat_list_vars(map_es(Node), Vs);
map_pair ->
- pat_list_vars([map_pair_op(Node),map_pair_key(Node),map_pair_val(Node)],Vs);
+ %% map_pair_key is not a pattern var, excluded
+ pat_list_vars([map_pair_op(Node),map_pair_val(Node)],Vs);
binary ->
pat_list_vars(binary_segments(Node), Vs);
bitstr ->
+ %% bitstr_size is not a pattern var, excluded
pat_vars(bitstr_val(Node), Vs);
alias ->
pat_vars(alias_pat(Node), [alias_var(Node) | Vs])
diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl
index 87bd47c08b..ef74c5b76f 100644
--- a/lib/compiler/src/cerl_clauses.erl
+++ b/lib/compiler/src/cerl_clauses.erl
@@ -354,29 +354,29 @@ match(P, E, Bs) ->
{false, Bs}
end
end;
- map ->
- %% The most we can do is to say "definitely no match" if a
- %% map pattern is matched against non-map data.
- case E of
- any ->
- {false, Bs};
- _ ->
- case type(E) of
- literal ->
- case is_map(concrete(E)) of
- false ->
- none;
- true ->
- {false, Bs}
- end;
- cons ->
- none;
- tuple ->
- none;
- _ ->
- {false, Bs}
- end
- end;
+ map ->
+ %% The most we can do is to say "definitely no match" if a
+ %% map pattern is matched against non-map data.
+ case E of
+ any ->
+ {false, Bs};
+ _ ->
+ case type(E) of
+ literal ->
+ case is_map(concrete(E)) of
+ false ->
+ none;
+ true ->
+ {false, Bs}
+ end;
+ cons ->
+ none;
+ tuple ->
+ none;
+ _ ->
+ {false, Bs}
+ end
+ end;
_ ->
match_1(P, E, Bs)
end.
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index 75740e8b9d..f8489a800b 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -1341,23 +1341,23 @@ i_bitstr(E, Ren, Env, S) ->
S3 = count_size(weight(bitstr), S2),
{update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}.
-i_map(E, Ctx, Ren, Env, S) ->
+i_map(E, Ctx, Ren, Env, S0) ->
%% Visit the segments for value.
- {M1, S1} = i(map_arg(E), value, Ren, Env, S),
+ {M1, S1} = i(map_arg(E), value, Ren, Env, S0),
{Es, S2} = mapfoldl(fun (E, S) ->
i_map_pair(E, Ctx, Ren, Env, S)
end, S1, map_es(E)),
S3 = count_size(weight(map), S2),
{update_c_map(E, M1,Es), S3}.
-i_map_pair(E, Ctx, Ren, Env, S) ->
- %% It is not necessary to visit the Op and Key fields,
- %% since these are always literals.
- {Val, S1} = i(map_pair_val(E), Ctx, Ren, Env, S),
+i_map_pair(E, Ctx, Ren, Env, S0) ->
+ %% It is not necessary to visit the Op field
+ %% since it is always a literal.
+ {Key, S1} = i(map_pair_key(E), value, Ren, Env, S0),
+ {Val, S2} = i(map_pair_val(E), Ctx, Ren, Env, S1),
Op = map_pair_op(E),
- Key = map_pair_key(E),
- S2 = count_size(weight(map_pair), S1),
- {update_c_map_pair(E, Op, Key, Val), S2}.
+ S3 = count_size(weight(map_pair), S2),
+ {update_c_map_pair(E, Op, Key, Val), S3}.
%% This is a simplified version of `i_pattern', for lists of parameter
@@ -1420,15 +1420,11 @@ i_pattern(E, Ren, Env, Ren0, Env0, S) ->
S2 = count_size(weight(binary), S1),
{update_c_binary(E, Es), S2};
map ->
- %% map patterns should not have args
- M = map_arg(E),
-
{Es, S1} = mapfoldl(fun (E, S) ->
i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S)
- end,
- S, map_es(E)),
+ end, S, map_es(E)),
S2 = count_size(weight(map), S1),
- {update_c_map(E, M, Es), S2};
+ {update_c_map(E, map_arg(E), Es), S2};
_ ->
case is_literal(E) of
true ->
@@ -1464,12 +1460,12 @@ i_bitstr_pattern(E, Ren, Env, Ren0, Env0, S) ->
i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S) ->
%% It is not necessary to visit the Op it is always a literal.
- %% Same goes for Key
- {Val, S1} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S),
+ %% Key is an expression
+ {Key, S1} = i(map_pair_key(E), value, Ren0, Env0, S),
+ {Val, S2} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S1),
Op = map_pair_op(E), %% should be 'exact' literal
- Key = map_pair_key(E),
- S2 = count_size(weight(map_pair), S1),
- {update_c_map_pair(E, Op, Key, Val), S2}.
+ S3 = count_size(weight(map_pair), S2),
+ {update_c_map_pair(E, Op, Key, Val), S3}.
%% ---------------------------------------------------------------------
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index e53bdd4efb..b93da8e97f 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -520,9 +520,9 @@ variables(T, S) ->
tuple ->
vars_in_list(tuple_es(T), S);
map ->
- vars_in_list(map_es(T), S);
+ vars_in_list([map_arg(T)|map_es(T)], S);
map_pair ->
- vars_in_list([map_pair_op(T),map_pair_key(T), map_pair_val(T)], S);
+ vars_in_list([map_pair_op(T),map_pair_key(T),map_pair_val(T)], S);
'let' ->
Vs = variables(let_body(T), S),
Vs1 = var_list_names(let_vars(T)),
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index c7d91070f6..f347438509 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -431,11 +431,6 @@ pass(from_core) ->
{".core",[?pass(parse_core)|core_passes()]};
pass(from_asm) ->
{".S",[?pass(beam_consult_asm)|asm_passes()]};
-pass(asm) ->
- %% TODO: remove 'asm' in 18.0
- io:format("compile:file/2 option 'asm' has been deprecated and will be~n"
- "removed in the 18.0 release. Use 'from_asm' instead.~n"),
- pass(from_asm);
pass(from_beam) ->
{".beam",[?pass(read_beam_file)|binary_passes()]};
pass(_) -> none.
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index 8f68915f8e..fbaa7a96fe 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -56,6 +56,7 @@
rec_env,
sys_core_dsetel,
sys_core_fold,
+ sys_core_fold_lists,
sys_core_inline,
sys_pre_attributes,
sys_pre_expand,
diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl
index 0d95971f91..66319dbd36 100644
--- a/lib/compiler/src/core_lib.erl
+++ b/lib/compiler/src/core_lib.erl
@@ -20,6 +20,12 @@
-module(core_lib).
+-deprecated({get_anno,1,next_major_release}).
+-deprecated({set_anno,2,next_major_release}).
+-deprecated({is_literal,1,next_major_release}).
+-deprecated({is_literal_list,1,next_major_release}).
+-deprecated({literal_value,1,next_major_release}).
+
-export([get_anno/1,set_anno/2]).
-export([is_literal/1,is_literal_list/1]).
-export([literal_value/1]).
@@ -33,59 +39,27 @@
%%
-spec get_anno(cerl:cerl()) -> term().
-get_anno(C) -> element(2, C).
+get_anno(C) -> cerl:get_ann(C).
-spec set_anno(cerl:cerl(), term()) -> cerl:cerl().
-set_anno(C, A) -> setelement(2, C, A).
+set_anno(C, A) -> cerl:set_ann(C, A).
-spec is_literal(cerl:cerl()) -> boolean().
-is_literal(#c_literal{}) -> true;
-is_literal(#c_cons{hd=H,tl=T}) ->
- is_literal(H) andalso is_literal(T);
-is_literal(#c_tuple{es=Es}) -> is_literal_list(Es);
-is_literal(#c_binary{segments=Es}) -> is_lit_bin(Es);
-is_literal(_) -> false.
+is_literal(Cerl) ->
+ cerl:is_literal(cerl:fold_literal(Cerl)).
-spec is_literal_list([cerl:cerl()]) -> boolean().
is_literal_list(Es) -> lists:all(fun is_literal/1, Es).
-is_lit_bin(Es) ->
- lists:all(fun (#c_bitstr{val=E,size=S}) ->
- is_literal(E) andalso is_literal(S)
- end, Es).
-
%% Return the value of LitExpr.
-spec literal_value(cerl:c_literal() | cerl:c_binary() |
cerl:c_map() | cerl:c_cons() | cerl:c_tuple()) -> term().
-literal_value(#c_literal{val=V}) -> V;
-literal_value(#c_binary{segments=Es}) ->
- list_to_binary([literal_value_bin(Bit) || Bit <- Es]);
-literal_value(#c_cons{hd=H,tl=T}) ->
- [literal_value(H)|literal_value(T)];
-literal_value(#c_tuple{es=Es}) ->
- list_to_tuple(literal_value_list(Es));
-literal_value(#c_map{arg=Cm,es=Cmps}) ->
- M = literal_value(Cm),
- lists:foldl(fun(#c_map_pair{ key=Ck, val=Cv },Mi) ->
- K = literal_value(Ck),
- V = literal_value(Cv),
- maps:put(K,V,Mi)
- end, M, Cmps).
-
-literal_value_list(Vals) -> [literal_value(V) || V <- Vals].
-
-literal_value_bin(#c_bitstr{val=Val,size=Sz,unit=U,type=T,flags=Fs}) ->
- %% We will only handle literals constructed by make_literal/1.
- %% Could be made more general in the future if the need arises.
- 8 = literal_value(Sz),
- 1 = literal_value(U),
- integer = literal_value(T),
- [unsigned,big] = literal_value(Fs),
- literal_value(Val).
+literal_value(Cerl) ->
+ cerl:concrete(cerl:fold_literal(Cerl)).
%% Make a suitable values structure, expr or values, depending on Expr.
-spec make_values([cerl:cerl()] | cerl:cerl()) -> cerl:cerl().
@@ -236,10 +210,15 @@ vu_pat_seg_list(V, Ss, St) ->
end
end, St, Ss).
-vu_map_pairs(V, [#c_map_pair{val=Pat}|T], St0) ->
- case vu_pattern(V, Pat, St0) of
- {true,_}=St -> St;
- St -> vu_map_pairs(V, T, St)
+vu_map_pairs(V, [#c_map_pair{key=Key,val=Pat}|T], St0) ->
+ case vu_expr(V, Key) of
+ true ->
+ {true,false};
+ false ->
+ case vu_pattern(V, Pat, St0) of
+ {true,_}=St -> St;
+ St -> vu_map_pairs(V, T, St)
+ end
end;
vu_map_pairs(_, [], St) -> St.
diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl
index 25df33a287..f62b2bb0ba 100644
--- a/lib/compiler/src/core_lint.erl
+++ b/lib/compiler/src/core_lint.erl
@@ -33,9 +33,6 @@
%% Values only as multiple values/variables/patterns.
%% Return same number of values as requested
%% Correct number of arguments
-%%
-%% Checks to add:
-%%
%% Consistency of values/variables
%% Consistency of function return values/calls.
%%
@@ -176,7 +173,7 @@ check_exports(Es, St) ->
end.
check_attrs(As, St) ->
- case all(fun ({#c_literal{},V}) -> core_lib:is_literal(V);
+ case all(fun ({#c_literal{},#c_literal{}}) -> true;
(_) -> false
end, As) of
true -> St;
@@ -211,7 +208,7 @@ functions(Fs, Def, St0) ->
function({#c_var{name={_,_}},B}, Def, St) ->
%% Body must be a fun!
case B of
- #c_fun{} -> expr(B, Def, any, St);
+ #c_fun{} -> expr(B, Def, 1, St);
_ -> add_error({illegal_expr,St#lint.func}, St)
end.
@@ -247,40 +244,42 @@ gbody(E, Def, Rt, St0) ->
false -> St1
end.
-gexpr(#c_var{name=N}, Def, _Rt, St) when is_atom(N); is_integer(N) ->
- expr_var(N, Def, St);
-gexpr(#c_literal{}, _Def, _Rt, St) -> St;
-gexpr(#c_cons{hd=H,tl=T}, Def, _Rt, St) ->
- gexpr_list([H,T], Def, St);
-gexpr(#c_tuple{es=Es}, Def, _Rt, St) ->
- gexpr_list(Es, Def, St);
-gexpr(#c_map{es=Es}, Def, _Rt, St) ->
- gexpr_list(Es, Def, St);
-gexpr(#c_map_pair{key=K,val=V}, Def, _Rt, St) ->
- gexpr_list([K,V], Def, St);
-gexpr(#c_binary{segments=Ss}, Def, _Rt, St) ->
- gbitstr_list(Ss, Def, St);
+gexpr(#c_var{name=N}, Def, Rt, St) when is_atom(N); is_integer(N) ->
+ return_match(Rt, 1, expr_var(N, Def, St));
+gexpr(#c_literal{}, _Def, Rt, St) ->
+ return_match(Rt, 1, St);
+gexpr(#c_cons{hd=H,tl=T}, Def, Rt, St) ->
+ return_match(Rt, 1, gexpr_list([H,T], Def, St));
+gexpr(#c_tuple{es=Es}, Def, Rt, St) ->
+ return_match(Rt, 1, gexpr_list(Es, Def, St));
+gexpr(#c_map{es=Es}, Def, Rt, St) ->
+ return_match(Rt, 1, gexpr_list(Es, Def, St));
+gexpr(#c_map_pair{key=K,val=V}, Def, Rt, St) ->
+ return_match(Rt, 1, gexpr_list([K,V], Def, St));
+gexpr(#c_binary{segments=Ss}, Def, Rt, St) ->
+ return_match(Rt, 1, gbitstr_list(Ss, Def, St));
gexpr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) ->
- St1 = gexpr(Arg, Def, any, St0), %Ignore values
- gbody(B, Def, Rt, St1);
+ St1 = gexpr(Arg, Def, 1, St0),
+ return_match(Rt, 1, gbody(B, Def, Rt, St1));
gexpr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) ->
St1 = gbody(Arg, Def, let_varcount(Vs), St0), %This is a guard body
{Lvs,St2} = variable_list(Vs, St1),
gbody(B, union(Lvs, Def), Rt, St2);
gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record},
args=[Arg,#c_literal{val=Tag},#c_literal{val=Size}]},
- Def, 1, St) when is_atom(Tag), is_integer(Size) ->
- gexpr(Arg, Def, 1, St);
+ Def, Rt, St) when is_atom(Tag), is_integer(Size) ->
+ return_match(Rt, 1, gexpr(Arg, Def, 1, St));
gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}},
- _Def, 1, St) ->
- add_error({illegal_guard,St#lint.func}, St);
+ _Def, Rt, St) ->
+ return_match(Rt, 1, add_error({illegal_guard,St#lint.func}, St));
gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As},
- Def, 1, St) when is_atom(Name) ->
+ Def, Rt, St0) when is_atom(Name) ->
+ St1 = return_match(Rt, 1, St0),
case is_guard_bif(Name, length(As)) of
true ->
- gexpr_list(As, Def, St);
+ gexpr_list(As, Def, St1);
false ->
- add_error({illegal_guard,St#lint.func}, St)
+ add_error({illegal_guard,St1#lint.func}, St1)
end;
gexpr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) ->
gexpr_list(As, Def, St0);
@@ -319,23 +318,25 @@ is_guard_bif(Name, Arity) ->
%% expr(Expr, Defined, RetCount, State) -> State.
-expr(#c_var{name={_,_}=FA}, Def, _Rt, St) ->
- expr_fname(FA, Def, St);
-expr(#c_var{name=N}, Def, _Rt, St) -> expr_var(N, Def, St);
-expr(#c_literal{}, _Def, _Rt, St) -> St;
-expr(#c_cons{hd=H,tl=T}, Def, _Rt, St) ->
- expr_list([H,T], Def, St);
-expr(#c_tuple{es=Es}, Def, _Rt, St) ->
- expr_list(Es, Def, St);
-expr(#c_map{es=Es}, Def, _Rt, St) ->
- expr_list(Es, Def, St);
-expr(#c_map_pair{key=K,val=V},Def,_Rt,St) ->
- expr_list([K,V],Def,St);
-expr(#c_binary{segments=Ss}, Def, _Rt, St) ->
- bitstr_list(Ss, Def, St);
+expr(#c_var{name={_,_}=FA}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_fname(FA, Def, St));
+expr(#c_var{name=N}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_var(N, Def, St));
+expr(#c_literal{}, _Def, Rt, St) ->
+ return_match(Rt, 1, St);
+expr(#c_cons{hd=H,tl=T}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_list([H,T], Def, St));
+expr(#c_tuple{es=Es}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_list(Es, Def, St));
+expr(#c_map{es=Es}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_list(Es, Def, St));
+expr(#c_map_pair{key=K,val=V}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_list([K,V], Def, St));
+expr(#c_binary{segments=Ss}, Def, Rt, St) ->
+ return_match(Rt, 1, bitstr_list(Ss, Def, St));
expr(#c_fun{vars=Vs,body=B}, Def, Rt, St0) ->
{Vvs,St1} = variable_list(Vs, St0),
- return_match(Rt, 1, body(B, union(Vvs, Def), any, St1));
+ return_match(Rt, 1, body(B, union(Vvs, Def), 1, St1));
expr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) ->
St1 = expr(Arg, Def, 1, St0),
body(B, Def, Rt, St1);
@@ -361,15 +362,26 @@ expr(#c_receive{clauses=Cs,timeout=T,action=A}, Def, Rt, St0) ->
St1 = expr(T, Def, 1, St0),
St2 = body(A, Def, Rt, St1),
clauses(Cs, Def, 1, Rt, St2);
-expr(#c_apply{op=Op,args=As}, Def, _Rt, St0) ->
+expr(#c_apply{op=Op,args=As}, Def, Rt, St0) ->
St1 = apply_op(Op, Def, length(As), St0),
- expr_list(As, Def, St1);
+ return_match(Rt, 1, expr_list(As, Def, St1));
+expr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As},
+ Def, Rt, St0) when is_atom(Name) ->
+ St1 = expr_list(As, Def, St0),
+ case erl_bifs:is_exit_bif(erlang, Name, length(As)) of
+ true -> St1;
+ false -> return_match(Rt, 1, St1)
+ end;
expr(#c_call{module=M,name=N,args=As}, Def, _Rt, St0) ->
St1 = expr(M, Def, 1, St0),
St2 = expr(N, Def, 1, St1),
expr_list(As, Def, St2);
-expr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) ->
- expr_list(As, Def, St0);
+expr(#c_primop{name=#c_literal{val=A},args=As}, Def, Rt, St0) when is_atom(A) ->
+ St1 = expr_list(As, Def, St0),
+ case A of
+ match_fail -> St1;
+ _ -> return_match(Rt, 1, St1)
+ end;
expr(#c_catch{body=B}, Def, Rt, St) ->
return_match(Rt, 1, body(B, Def, 1, St));
expr(#c_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Def, Rt, St0) ->
diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl
index 4a00535360..7fd4a82e4e 100644
--- a/lib/compiler/src/core_parse.hrl
+++ b/lib/compiler/src/core_parse.hrl
@@ -72,7 +72,8 @@
-record(c_map, {anno=[],
arg=#c_literal{val=#{}} :: cerl:c_var() | cerl:c_literal(),
- es :: [cerl:c_map_pair()]}).
+ es :: [cerl:c_map_pair()],
+ is_pat=false :: boolean()}).
-record(c_map_pair, {anno=[],
op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'},
diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl
index a66ad4235f..eeb9f5dba7 100644
--- a/lib/compiler/src/core_parse.yrl
+++ b/lib/compiler/src/core_parse.yrl
@@ -58,7 +58,8 @@ Terminals
%% Separators
-'(' ')' '{' '}' '[' ']' '|' ',' '->' '=' '/' '<' '>' ':' '-|' '#' '~' '::'
+'(' ')' '{' '}' '[' ']' '|' ',' '->' '=' '/' '<' '>' ':' '-|' '#'
+'~' '=>' ':='
%% Keywords (atoms are assumed to always be single-quoted).
@@ -123,7 +124,7 @@ function_definition ->
{'$1','$3'}.
anno_fun -> '(' fun_expr '-|' annotation ')' :
- core_lib:set_anno('$2', '$4').
+ cerl:set_ann('$2', '$4').
anno_fun -> fun_expr : '$1'.
%% Constant terms for annotations and attributes.
@@ -162,7 +163,7 @@ tail_constant -> ',' constant tail_constant : ['$2'|'$3'].
%% ( ( V -| <anno> ) = ( {a} -| <anno> ) -| <anno> )
anno_pattern -> '(' other_pattern '-|' annotation ')' :
- core_lib:set_anno('$2', '$4').
+ cerl:set_ann('$2', '$4').
anno_pattern -> other_pattern : '$1'.
anno_pattern -> anno_variable : '$1'.
@@ -182,23 +183,24 @@ atomic_pattern -> atomic_literal : '$1'.
tuple_pattern -> '{' '}' : c_tuple([]).
tuple_pattern -> '{' anno_patterns '}' : c_tuple('$2').
-map_pattern -> '~' '{' '}' '~' : #c_map{es=[]}.
+map_pattern -> '~' '{' '}' '~' : c_map_pattern([]).
map_pattern -> '~' '{' map_pair_patterns '}' '~' :
- #c_map{es=lists:sort('$3')}.
+ c_map_pattern(lists:sort('$3')).
map_pair_patterns -> map_pair_pattern : ['$1'].
map_pair_patterns -> map_pair_pattern ',' map_pair_patterns : ['$1' | '$3'].
-map_pair_pattern -> '~' '<' anno_pattern ',' anno_pattern '>' :
- #c_map_pair{op=#c_literal{val=exact},key='$3',val='$5'}.
+map_pair_pattern -> anno_expression ':=' anno_pattern :
+ #c_map_pair{op=#c_literal{val=exact},
+ key='$1',val='$3'}.
cons_pattern -> '[' anno_pattern tail_pattern :
- #c_cons{hd='$2',tl='$3'}.
+ c_cons('$2', '$3').
tail_pattern -> ']' : #c_literal{val=[]}.
tail_pattern -> '|' anno_pattern ']' : '$2'.
tail_pattern -> ',' anno_pattern tail_pattern :
- #c_cons{hd='$2',tl='$3'}.
+ c_cons('$2', '$3').
binary_pattern -> '#' '{' '}' '#' : #c_binary{segments=[]}.
binary_pattern -> '#' '{' segment_patterns '}' '#' : #c_binary{segments='$3'}.
@@ -206,7 +208,7 @@ binary_pattern -> '#' '{' segment_patterns '}' '#' : #c_binary{segments='$3'}.
segment_patterns -> segment_pattern ',' segment_patterns : ['$1' | '$3'].
segment_patterns -> segment_pattern : ['$1'].
-segment_pattern -> '#' '<' anno_pattern '>' '(' anno_patterns ')':
+segment_pattern -> '#' '<' anno_pattern '>' '(' anno_expressions ')':
case '$6' of
[S,U,T,Fs] ->
#c_bitstr{val='$3',size=S,unit=U,type=T,flags=Fs};
@@ -222,7 +224,7 @@ anno_variables -> anno_variable : ['$1'].
anno_variable -> variable : '$1'.
anno_variable -> '(' variable '-|' annotation ')' :
- core_lib:set_anno('$2', '$4').
+ cerl:set_ann('$2', '$4').
%% Expressions
%% Must split expressions into two levels as nested value expressions
@@ -230,7 +232,7 @@ anno_variable -> '(' variable '-|' annotation ')' :
anno_expression -> expression : '$1'.
anno_expression -> '(' expression '-|' annotation ')' :
- core_lib:set_anno('$2', '$4').
+ cerl:set_ann('$2', '$4').
anno_expressions -> anno_expression ',' anno_expressions : ['$1' | '$3'].
anno_expressions -> anno_expression : ['$1'].
@@ -279,15 +281,15 @@ cons_literal -> '[' literal tail_literal : c_cons('$2', '$3').
tail_literal -> ']' : #c_literal{val=[]}.
tail_literal -> '|' literal ']' : '$2'.
-tail_literal -> ',' literal tail_literal : #c_cons{hd='$2',tl='$3'}.
+tail_literal -> ',' literal tail_literal : c_cons('$2', '$3').
tuple -> '{' '}' : c_tuple([]).
tuple -> '{' anno_expressions '}' : c_tuple('$2').
-map_expr -> '~' '{' '}' '~' : #c_map{es=[]}.
-map_expr -> '~' '{' map_pairs '}' '~' : #c_map{es='$3'}.
-map_expr -> '~' '{' map_pairs '|' variable '}' '~' : #c_map{arg='$5',es='$3'}.
-map_expr -> '~' '{' map_pairs '|' map_expr '}' '~' : #c_map{arg='$5',es='$3'}.
+map_expr -> '~' '{' '}' '~' : c_map([]).
+map_expr -> '~' '{' map_pairs '}' '~' : c_map('$3').
+map_expr -> '~' '{' map_pairs '|' variable '}' '~' : ann_c_map([], '$5', '$3').
+map_expr -> '~' '{' map_pairs '|' map_expr '}' '~' : ann_c_map([], '$5', '$3').
map_pairs -> map_pair : ['$1'].
map_pairs -> map_pair ',' map_pairs : ['$1' | '$3'].
@@ -295,10 +297,10 @@ map_pairs -> map_pair ',' map_pairs : ['$1' | '$3'].
map_pair -> map_pair_assoc : '$1'.
map_pair -> map_pair_exact : '$1'.
-map_pair_assoc -> '::' '<' anno_expression ',' anno_expression'>' :
- #c_map_pair{op=#c_literal{val=assoc},key='$3',val='$5'}.
-map_pair_exact -> '~' '<' anno_expression ',' anno_expression'>' :
- #c_map_pair{op=#c_literal{val=exact},key='$3',val='$5'}.
+map_pair_assoc -> anno_expression '=>' anno_expression :
+ #c_map_pair{op=#c_literal{val=assoc},key='$1',val='$3'}.
+map_pair_exact -> anno_expression ':=' anno_expression :
+ #c_map_pair{op=#c_literal{val=exact},key='$1',val='$3'}.
cons -> '[' anno_expression tail : c_cons('$2', '$3').
@@ -307,7 +309,7 @@ tail -> '|' anno_expression ']' : '$2'.
tail -> ',' anno_expression tail : c_cons('$2', '$3').
binary -> '#' '{' '}' '#' : #c_literal{val = <<>>}.
-binary -> '#' '{' segments '}' '#' : #c_binary{segments='$3'}.
+binary -> '#' '{' segments '}' '#' : make_binary('$3').
segments -> segment ',' segments : ['$1' | '$3'].
segments -> segment : ['$1'].
@@ -326,7 +328,7 @@ function_name -> atom '/' integer :
anno_function_name -> function_name : '$1'.
anno_function_name -> '(' function_name '-|' annotation ')' :
- core_lib:set_anno('$2', '$4').
+ cerl:set_ann('$2', '$4').
let_vars -> anno_variable : ['$1'].
let_vars -> '<' '>' : [].
@@ -354,7 +356,7 @@ anno_clauses -> anno_clause : ['$1'].
anno_clause -> clause : '$1'.
anno_clause -> '(' clause '-|' annotation ')' :
- core_lib:set_anno('$2', '$4').
+ cerl:set_ann('$2', '$4').
clause -> clause_pattern 'when' anno_expression '->' anno_expression :
#c_clause{pats='$1',guard='$3',body='$5'}.
@@ -410,9 +412,55 @@ Erlang code.
-include("core_parse.hrl").
--import(cerl, [c_cons/2,c_tuple/1]).
+-import(cerl, [ann_c_map/3,c_cons/2,c_map/1,c_map_pattern/1,c_tuple/1]).
tok_val(T) -> element(3, T).
tok_line(T) -> element(2, T).
+%% make_binary([#c_bitstr{}]) -> #c_binary{} | #c_literal{}
+%% Create either #c_binary{} or #c_literal{} from the binary segments.
+%% In certain contexts, such as keys for maps, only literals and
+%% variables are allowed, so we must not create a #c_binary{}
+%% record in those situation.
+%%
+%% To keep this function simple, we use a crude heuristic. We will
+%% assume that Core Erlang has been produced by core_pp. If the
+%% segments *could* have been output from a literal binary by
+%% core_pp, we will create a #c_literal{}. Otherwise we will create a
+%% #c_binary{} record.
+
+make_binary(Segs) ->
+ try make_lit_bin(<<>>, Segs) of
+ Bs when is_bitstring(Bs) ->
+ #c_literal{val=Bs}
+ catch
+ throw:impossible ->
+ #c_binary{segments=Segs}
+ end.
+
+make_lit_bin(Acc, [#c_bitstr{val=I0,size=Sz0,unit=U0,type=Type0,flags=F0}|T]) ->
+ I = get_lit_val(I0),
+ Sz = get_lit_val(Sz0),
+ U = get_lit_val(U0),
+ Type = get_lit_val(Type0),
+ F = get_lit_val(F0),
+ if
+ is_integer(I), U =:= 1, Type =:= integer, F =:= [unsigned,big] ->
+ ok;
+ true ->
+ throw(impossible)
+ end,
+ if
+ Sz =< 8, T =:= [] ->
+ <<Acc/binary,I:Sz>>;
+ Sz =:= 8 ->
+ make_lit_bin(<<Acc/binary,I:8>>, T);
+ true ->
+ throw(impossible)
+ end;
+make_lit_bin(Acc, []) -> Acc.
+
+get_lit_val(#c_literal{val=Val}) -> Val;
+get_lit_val(_) -> throw(impossible).
+
%% vim: syntax=erlang
diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl
index 83412ecdd7..9cfca88e8c 100644
--- a/lib/compiler/src/core_pp.erl
+++ b/lib/compiler/src/core_pp.erl
@@ -45,7 +45,7 @@ format(Node) ->
format(Node, #ctxt{}).
maybe_anno(Node, Fun, Ctxt) ->
- As = core_lib:get_anno(Node),
+ As = cerl:get_ann(Node),
case get_line(As) of
none ->
maybe_anno(Node, Fun, Ctxt, As);
@@ -125,8 +125,8 @@ format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) ->
_ -> assoc
end,
Cpairs = [#c_map_pair{op=#c_literal{val=Op},
- key=#c_literal{val=V},
- val=#c_literal{val=K}} || {K,V} <- Pairs],
+ key=#c_literal{val=K},
+ val=#c_literal{val=V}} || {K,V} <- Pairs],
format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt);
format_1(#c_var{name={I,A}}, _) ->
[core_atom(I),$/,integer_to_list(A)];
@@ -183,15 +183,9 @@ format_1(#c_map{arg=Var,es=Es}, Ctxt) ->
"}~"
];
format_1(#c_map_pair{op=#c_literal{val=assoc},key=K,val=V}, Ctxt) ->
- ["::<",
- format_hseq([K,V], ",", add_indent(Ctxt, 1), fun format/2),
- ">"
- ];
+ format_map_pair("=>", K, V, Ctxt);
format_1(#c_map_pair{op=#c_literal{val=exact},key=K,val=V}, Ctxt) ->
- ["~<",
- format_hseq([K,V], ",", add_indent(Ctxt, 1), fun format/2),
- ">"
- ];
+ format_map_pair(":=", K, V, Ctxt);
format_1(#c_cons{hd=H,tl=T}, Ctxt) ->
Txt = ["["|format(H, add_indent(Ctxt, 1))],
[Txt|format_list_tail(T, add_indent(Ctxt, width(Txt, Ctxt)))];
@@ -201,7 +195,7 @@ format_1(#c_alias{var=V,pat=P}, Ctxt) ->
Txt = [format(V, Ctxt)|" = "],
[Txt|format(P, add_indent(Ctxt, width(Txt, Ctxt)))];
format_1(#c_let{vars=Vs0,arg=A,body=B}, Ctxt) ->
- Vs = [core_lib:set_anno(V, []) || V <- Vs0],
+ Vs = [cerl:set_ann(V, []) || V <- Vs0],
case is_simple_term(A) of
false ->
Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent),
@@ -219,7 +213,7 @@ format_1(#c_let{vars=Vs0,arg=A,body=B}, Ctxt) ->
["let ",
format_values(Vs, add_indent(Ctxt, 4)),
" = ",
- format(core_lib:set_anno(A, []), Ctxt1),
+ format(cerl:set_ann(A, []), Ctxt1),
nl_indent(Ctxt),
"in "
| format(B, add_indent(Ctxt, 4))
@@ -448,6 +442,12 @@ format_list_tail(#c_cons{anno=[],hd=H,tl=T}, Ctxt) ->
format_list_tail(Tail, Ctxt) ->
["|",format(Tail, add_indent(Ctxt, 1)),"]"].
+format_map_pair(Op, K, V, Ctxt0) ->
+ Ctxt1 = add_indent(Ctxt0, 1),
+ Txt = format(K, set_class(Ctxt1, expr)),
+ Ctxt2 = add_indent(Ctxt0, width(Txt, Ctxt1)),
+ [Txt,Op,format(V, Ctxt2)].
+
indent(Ctxt) -> indent(Ctxt#ctxt.indent, Ctxt).
indent(N, _) when N =< 0 -> "";
diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl
index b7799b373a..8ab20b1982 100644
--- a/lib/compiler/src/core_scan.erl
+++ b/lib/compiler/src/core_scan.erl
@@ -271,8 +271,10 @@ scan1("->" ++ Cs, Toks, Pos) ->
scan1(Cs, [{'->',Pos}|Toks], Pos);
scan1("-|" ++ Cs, Toks, Pos) ->
scan1(Cs, [{'-|',Pos}|Toks], Pos);
-scan1("::" ++ Cs, Toks, Pos) ->
- scan1(Cs, [{'::',Pos}|Toks], Pos);
+scan1(":=" ++ Cs, Toks, Pos) ->
+ scan1(Cs, [{':=',Pos}|Toks], Pos);
+scan1("=>" ++ Cs, Toks, Pos) ->
+ scan1(Cs, [{'=>',Pos}|Toks], Pos);
scan1([C|Cs], Toks, Pos) -> %Punctuation character
P = list_to_atom([C]),
scan1(Cs, [{P,Pos}|Toks], Pos);
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index 6c75538194..bcc2297250 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -134,6 +134,7 @@ is_pure(math, erf, 1) -> true;
is_pure(math, erfc, 1) -> true;
is_pure(math, exp, 1) -> true;
is_pure(math, log, 1) -> true;
+is_pure(math, log2, 1) -> true;
is_pure(math, log10, 1) -> true;
is_pure(math, pow, 2) -> true;
is_pure(math, sin, 1) -> true;
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index ed8f609082..0d020578f5 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -96,6 +96,10 @@
t=[], %Types
in_guard=false}). %In guard or not.
+-type type_info() :: cerl:cerl() | 'bool' | 'integer'.
+-type yes_no_maybe() :: 'yes' | 'no' | 'maybe'.
+-type sub() :: #sub{}.
+
-spec module(cerl:c_module(), [compile:option()]) ->
{'ok', cerl:c_module(), [_]}.
@@ -293,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
@@ -313,7 +318,7 @@ expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) ->
Fs1 = map(fun ({Name,Fb}) ->
{Name,expr(Fb, {letrec,Ctxt}, Sub)}
end, Fs0),
- B1 = body(B0, value, Sub),
+ B1 = body(B0, Ctxt, Sub),
Letrec#c_letrec{defs=Fs1,body=B1};
expr(#c_case{}=Case0, Ctxt, Sub) ->
%% Ideally, the compiler should only emit warnings when there is
@@ -462,10 +467,7 @@ is_safe_simple(#c_call{module=#c_literal{val=erlang},
case erl_internal:bool_op(Name, NumArgs) of
true ->
%% Boolean operators are safe if the arguments are boolean.
- all(fun(#c_var{name=V}) -> is_boolean_type(V, Sub);
- (#c_literal{val=Lit}) -> is_boolean(Lit);
- (_) -> false
- end, Args);
+ all(fun(C) -> is_boolean_type(C, Sub) =:= yes end, Args);
false ->
%% We need a rather complicated test to ensure that
%% we only allow safe calls that are allowed in a guard.
@@ -607,14 +609,6 @@ eval_binary_1([#c_bitstr{val=#c_literal{val=Val},size=#c_literal{val=Sz},
error:_ ->
throw(impossible)
end;
-eval_binary_1([#c_bitstr{val=#c_literal{},size=#c_literal{},
- unit=#c_literal{},type=#c_literal{},
- flags=#c_cons{}=Flags}=Bitstr|Ss], Acc0) ->
- case cerl:fold_literal(Flags) of
- #c_literal{} = Flags1 ->
- eval_binary_1([Bitstr#c_bitstr{flags=Flags1}|Ss], Acc0);
- _ -> throw(impossible)
- end;
eval_binary_1([], Acc) -> Acc;
eval_binary_1(_, _) -> throw(impossible).
@@ -688,23 +682,15 @@ count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64).
%% a rewritten expression consisting of a sequence of
%% the arguments only is returned.
-useless_call(effect, #c_call{anno=Anno,
- module=#c_literal{val=Mod},
+useless_call(effect, #c_call{module=#c_literal{val=Mod},
name=#c_literal{val=Name},
args=Args}=Call) ->
A = length(Args),
case erl_bifs:is_safe(Mod, Name, A) of
false ->
case erl_bifs:is_pure(Mod, Name, A) of
- true ->
- case member(result_not_wanted, Anno) of
- false ->
- add_warning(Call, result_ignored);
- true ->
- ok
- end;
- false ->
- ok
+ true -> add_warning(Call, result_ignored);
+ false -> ok
end,
no;
true ->
@@ -730,385 +716,23 @@ make_effect_seq([], _) -> void().
call(#c_call{args=As}=Call, #c_literal{val=M}=M0, #c_literal{val=N}=N0, Sub) ->
case get(no_inline_list_funcs) of
true ->
- call_0(Call, M0, N0, As, Sub);
+ call_1(Call, M0, N0, As, Sub);
false ->
- call_1(Call, M, N, As, Sub)
+ case sys_core_fold_lists:call(Call, M, N, As) of
+ none ->
+ call_1(Call, M, N, As, Sub);
+ Core ->
+ expr(Core, Sub)
+ end
+
end;
call(#c_call{args=As}=Call, M, N, Sub) ->
- call_0(Call, M, N, As, Sub).
+ call_1(Call, M, N, As, Sub).
-call_0(Call, M, N, As0, Sub) ->
+call_1(Call, M, N, As0, Sub) ->
As1 = expr_list(As0, value, Sub),
fold_call(Call#c_call{args=As1}, M, N, As1, Sub).
-%% We inline some very common higher order list operations.
-%% We use the same evaluation order as the library function.
-
-call_1(#c_call{anno=Anno}, lists, all, [Arg1,Arg2], Sub) ->
- Loop = #c_var{name={'lists^all',1}},
- F = #c_var{name='F'},
- Xs = #c_var{name='Xs'},
- X = #c_var{name='X'},
- Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]},
- CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true},
- body=#c_apply{anno=Anno, op=Loop, args=[Xs]}},
- CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
- body=#c_literal{val=false}},
- CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
- body=match_fail(Anno, Err1)},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]},
- clauses = [CC1, CC2, CC3]}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
- guard=#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=is_function},
- args=[F, #c_literal{val=1}]},
- body=#c_literal{val=true}},
- Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=match_fail([{function_name,{'lists^all',1}}|Anno], Err2)},
- Fun = #c_fun{vars=[Xs],
- body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
- L = #c_var{name='L'},
- expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
- body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
- Sub);
-call_1(#c_call{anno=Anno}, lists, any, [Arg1,Arg2], Sub) ->
- Loop = #c_var{name={'lists^any',1}},
- F = #c_var{name='F'},
- Xs = #c_var{name='Xs'},
- X = #c_var{name='X'},
- Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]},
- CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true},
- body=#c_literal{val=true}},
- CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
- body=#c_apply{anno=Anno, op=Loop, args=[Xs]}},
- CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
- body=match_fail(Anno, Err1)},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]},
- clauses = [CC1, CC2, CC3]}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
- guard=#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=is_function},
- args=[F, #c_literal{val=1}]},
- body=#c_literal{val=false}},
- Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=match_fail([{function_name,{'lists^any',1}}|Anno], Err2)},
- Fun = #c_fun{vars=[Xs],
- body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
- L = #c_var{name='L'},
- expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
- body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
- Sub);
-call_1(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2], Sub) ->
- Loop = #c_var{name={'lists^foreach',1}},
- F = #c_var{name='F'},
- Xs = #c_var{name='Xs'},
- X = #c_var{name='X'},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=#c_seq{arg=#c_apply{anno=Anno, op=F, args=[X]},
- body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
- guard=#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=is_function},
- args=[F, #c_literal{val=1}]},
- body=#c_literal{val=ok}},
- Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=match_fail([{function_name,{'lists^foreach',1}}|Anno], Err)},
- Fun = #c_fun{vars=[Xs],
- body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
- L = #c_var{name='L'},
- expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
- body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
- Sub);
-call_1(#c_call{anno=Anno}, lists, map, [Arg1,Arg2], Sub) ->
- Loop = #c_var{name={'lists^map',1}},
- F = #c_var{name='F'},
- Xs = #c_var{name='Xs'},
- X = #c_var{name='X'},
- H = #c_var{name='H'},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=#c_let{vars=[H], arg=#c_apply{anno=Anno,
- op=F,
- args=[X]},
- body=#c_cons{hd=H,
- anno=[compiler_generated],
- tl=#c_apply{anno=Anno,
- op=Loop,
- args=[Xs]}}}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
- guard=#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=is_function},
- args=[F, #c_literal{val=1}]},
- body=#c_literal{val=[]}},
- Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=match_fail([{function_name,{'lists^map',1}}|Anno], Err)},
- Fun = #c_fun{vars=[Xs],
- body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
- L = #c_var{name='L'},
- expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
- body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
- Sub);
-call_1(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2], Sub) ->
- Loop = #c_var{name={'lists^flatmap',1}},
- F = #c_var{name='F'},
- Xs = #c_var{name='Xs'},
- X = #c_var{name='X'},
- H = #c_var{name='H'},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=#c_let{vars=[H],
- arg=#c_apply{anno=Anno, op=F, args=[X]},
- body=#c_call{anno=[compiler_generated|Anno],
- module=#c_literal{val=erlang},
- name=#c_literal{val='++'},
- args=[H,
- #c_apply{anno=Anno,
- op=Loop,
- args=[Xs]}]}}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
- guard=#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=is_function},
- args=[F, #c_literal{val=1}]},
- body=#c_literal{val=[]}},
- Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=match_fail([{function_name,{'lists^flatmap',1}}|Anno], Err)},
- Fun = #c_fun{vars=[Xs],
- body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
- L = #c_var{name='L'},
- expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
- body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
- Sub);
-call_1(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2], Sub) ->
- Loop = #c_var{name={'lists^filter',1}},
- F = #c_var{name='F'},
- Xs = #c_var{name='Xs'},
- X = #c_var{name='X'},
- B = #c_var{name='B'},
- Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]},
- CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true},
- body=#c_cons{anno=[compiler_generated], hd=X, tl=Xs}},
- CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
- body=Xs},
- CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
- body=match_fail(Anno, Err1)},
- Case = #c_case{arg=B, clauses = [CC1, CC2, CC3]},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=#c_let{vars=[B],
- arg=#c_apply{anno=Anno, op=F, args=[X]},
- body=#c_let{vars=[Xs],
- arg=#c_apply{anno=Anno,
- op=Loop,
- args=[Xs]},
- body=Case}}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
- guard=#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=is_function},
- args=[F, #c_literal{val=1}]},
- body=#c_literal{val=[]}},
- Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=match_fail([{function_name,{'lists^filter',1}}|Anno], Err2)},
- Fun = #c_fun{vars=[Xs],
- body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
- L = #c_var{name='L'},
- expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
- body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
- Sub);
-call_1(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3], Sub) ->
- Loop = #c_var{name={'lists^foldl',2}},
- F = #c_var{name='F'},
- Xs = #c_var{name='Xs'},
- X = #c_var{name='X'},
- A = #c_var{name='A'},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=#c_apply{anno=Anno,
- op=Loop,
- args=[Xs, #c_apply{anno=Anno,
- op=F,
- args=[X, A]}]}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
- guard=#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=is_function},
- args=[F, #c_literal{val=2}]},
- body=A},
- Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=match_fail([{function_name,{'lists^foldl',2}}|Anno], Err)},
- Fun = #c_fun{vars=[Xs, A],
- body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
- L = #c_var{name='L'},
- expr(#c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
- body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}},
- Sub);
-call_1(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3], Sub) ->
- Loop = #c_var{name={'lists^foldr',2}},
- F = #c_var{name='F'},
- Xs = #c_var{name='Xs'},
- X = #c_var{name='X'},
- A = #c_var{name='A'},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=#c_apply{anno=Anno,
- op=F,
- args=[X, #c_apply{anno=Anno,
- op=Loop,
- args=[Xs, A]}]}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
- guard=#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=is_function},
- args=[F, #c_literal{val=2}]},
- body=A},
- Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=match_fail([{function_name,{'lists^foldr',2}}|Anno], Err)},
- Fun = #c_fun{vars=[Xs, A],
- body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
- L = #c_var{name='L'},
- expr(#c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
- body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}},
- Sub);
-call_1(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3], Sub) ->
- Loop = #c_var{name={'lists^mapfoldl',2}},
- F = #c_var{name='F'},
- Xs = #c_var{name='Xs'},
- X = #c_var{name='X'},
- Avar = #c_var{name='A'},
- Match =
- fun (A, P, E) ->
- C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E},
- Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]},
- C2 = #c_clause{pats=[X], guard=#c_literal{val=true},
- body=match_fail(Anno, Err)},
- #c_case{arg=A, clauses=[C1, C2]}
- end,
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=Match(#c_apply{anno=Anno, op=F, args=[X, Avar]},
- #c_tuple{es=[X, Avar]},
-%%% Tuple passing version
- Match(#c_apply{anno=Anno,
- op=Loop,
- args=[Xs, Avar]},
- #c_tuple{es=[Xs, Avar]},
- #c_tuple{anno=[compiler_generated],
- es=[#c_cons{anno=[compiler_generated],
- hd=X, tl=Xs},
- Avar]})
-%%% Multiple-value version
-%%% #c_let{vars=[Xs,A],
-%%% %% The tuple here will be optimised
-%%% %% away later; no worries.
-%%% arg=#c_apply{op=Loop, args=[Xs, A]},
-%%% body=#c_values{es=[#c_cons{hd=X, tl=Xs},
-%%% A]}}
- )},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
- guard=#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=is_function},
- args=[F, #c_literal{val=2}]},
-%%% Tuple passing version
- body=#c_tuple{anno=[compiler_generated],
- es=[#c_literal{val=[]}, Avar]}},
-%%% Multiple-value version
-%%% body=#c_values{es=[#c_literal{val=[]}, A]}},
- Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=match_fail([{function_name,{'lists^mapfoldl',2}}|Anno], Err)},
- Fun = #c_fun{vars=[Xs, Avar],
- body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
- L = #c_var{name='L'},
- expr(#c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
- body=#c_letrec{defs=[{Loop,Fun}],
-%%% Tuple passing version
- body=#c_apply{anno=Anno,
- op=Loop,
- args=[L, Avar]}}},
-%%% Multiple-value version
-%%% body=#c_let{vars=[Xs, A],
-%%% arg=#c_apply{op=Loop,
-%%% args=[L, A]},
-%%% body=#c_tuple{es=[Xs, A]}}}},
- Sub);
-call_1(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) ->
- Loop = #c_var{name={'lists^mapfoldr',2}},
- F = #c_var{name='F'},
- Xs = #c_var{name='Xs'},
- X = #c_var{name='X'},
- Avar = #c_var{name='A'},
- Match =
- fun (A, P, E) ->
- C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E},
- Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]},
- C2 = #c_clause{pats=[X], guard=#c_literal{val=true},
- body=match_fail(Anno, Err)},
- #c_case{arg=A, clauses=[C1, C2]}
- end,
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
-%%% Tuple passing version
- body=Match(#c_apply{anno=Anno,
- op=Loop,
- args=[Xs, Avar]},
- #c_tuple{es=[Xs, Avar]},
- Match(#c_apply{anno=Anno, op=F, args=[X, Avar]},
- #c_tuple{es=[X, Avar]},
- #c_tuple{anno=[compiler_generated],
- es=[#c_cons{anno=[compiler_generated],
- hd=X, tl=Xs}, Avar]}))
-%%% Multiple-value version
-%%% body=#c_let{vars=[Xs,A],
-%%% %% The tuple will be optimised away
-%%% arg=#c_apply{op=Loop, args=[Xs, A]},
-%%% body=Match(#c_apply{op=F, args=[X, A]},
-%%% #c_tuple{es=[X, A]},
-%%% #c_values{es=[#c_cons{hd=X, tl=Xs},
-%%% A]})}
- },
- C2 = #c_clause{pats=[#c_literal{val=[]}],
- guard=#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=is_function},
- args=[F, #c_literal{val=2}]},
-%%% Tuple passing version
- body=#c_tuple{anno=[compiler_generated],
- es=[#c_literal{val=[]}, Avar]}},
-%%% Multiple-value version
-%%% body=#c_values{es=[#c_literal{val=[]}, A]}},
- Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=match_fail([{function_name,{'lists^mapfoldr',2}}|Anno], Err)},
- Fun = #c_fun{vars=[Xs, Avar],
- body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
- L = #c_var{name='L'},
- expr(#c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
- body=#c_letrec{defs=[{Loop,Fun}],
-%%% Tuple passing version
- body=#c_apply{anno=Anno,
- op=Loop,
- args=[L, Avar]}}},
-%%% Multiple-value version
-%%% body=#c_let{vars=[Xs, A],
-%%% arg=#c_apply{op=Loop,
-%%% args=[L, A]},
-%%% body=#c_tuple{es=[Xs, A]}}}},
- Sub);
-call_1(#c_call{module=M, name=N}=Call, _, _, As, Sub) ->
- call_0(Call, M, N, As, Sub).
-
-match_fail(Anno, Arg) ->
- #c_primop{anno=Anno,
- name=#c_literal{val='match_fail'},
- args=[Arg]}.
-
%% fold_call(Call, Mod, Name, Args, Sub) -> Expr.
%% Try to safely evaluate the call. Just try to evaluate arguments,
%% do the call and convert return values to literals. If this
@@ -1133,29 +757,33 @@ fold_call_1(Call, Mod, Name, Args, Sub) ->
true -> fold_call_2(Call, Mod, Name, Args, Sub)
end.
-fold_call_2(Call, Module, Name, Args0, Sub) ->
- try
- Args = [core_lib:literal_value(A) || A <- Args0],
- try apply(Module, Name, Args) of
- Val ->
- case cerl:is_literal_term(Val) of
- true ->
- #c_literal{val=Val};
- false ->
- %% Successful evaluation, but it was not
- %% possible to express the computed value as a literal.
- Call
- end
- catch
- error:Reason ->
- %% Evaluation of the function failed. Warn and replace
- %% the call with a call to erlang:error/1.
- eval_failure(Call, Reason)
- end
+fold_call_2(Call, Module, Name, Args, Sub) ->
+ case all(fun cerl:is_literal/1, Args) of
+ true ->
+ %% All arguments are literals.
+ fold_lit_args(Call, Module, Name, Args);
+ false ->
+ %% At least one non-literal argument.
+ fold_non_lit_args(Call, Module, Name, Args, Sub)
+ end.
+
+fold_lit_args(Call, Module, Name, Args0) ->
+ Args = [cerl:concrete(A) || A <- Args0],
+ try apply(Module, Name, Args) of
+ Val ->
+ case cerl:is_literal_term(Val) of
+ true ->
+ cerl:abstract(Val);
+ false ->
+ %% Successful evaluation, but it was not possible
+ %% to express the computed value as a literal.
+ Call
+ end
catch
- error:_ ->
- %% There was at least one non-literal argument.
- fold_non_lit_args(Call, Module, Name, Args0, Sub)
+ error:Reason ->
+ %% Evaluation of the function failed. Warn and replace
+ %% the call with a call to erlang:error/1.
+ eval_failure(Call, Reason)
end.
%% fold_non_lit_args(Call, Module, Name, Args, Sub) -> Expr.
@@ -1194,36 +822,43 @@ fold_non_lit_args(Call, _, _, _, _) -> 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=core_lib:get_anno(Call),val=Bool};
-eval_rel_op(Call, '=:=', [#c_var{name=V}=Var,#c_literal{val=true}], Sub) ->
+ #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(V, Sub) of
- true -> Var;
- false -> Call
+ 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) of
+eval_rel_op(Call, '==', Ops, Sub) ->
+ case is_exact_eq_ok(Ops, Sub) of
true ->
- Name = #c_literal{anno=core_lib:get_anno(Call),val='=:='},
+ 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=core_lib:get_anno(Call),val='=/='},
+ 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([#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);
@@ -1247,40 +882,31 @@ is_non_numeric_tuple(_Tuple, 0) -> true.
%% 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},#c_var{name=V}=Res], Sub) ->
- case is_boolean_type(V, Sub) of
- true -> Res;
- false-> Call
- end;
-eval_bool_op(Call, 'and', [#c_var{name=V}=Res,#c_literal{val=true}], Sub) ->
- case is_boolean_type(V, Sub) of
- true -> Res;
- false-> Call
- end;
-eval_bool_op(Call, 'and', [#c_literal{val=false}=Res,#c_var{name=V}], Sub) ->
- case is_boolean_type(V, Sub) of
- true -> Res;
- false-> Call
- end;
-eval_bool_op(Call, 'and', [#c_var{name=V},#c_literal{val=false}=Res], Sub) ->
- case is_boolean_type(V, Sub) of
- true -> Res;
- false-> Call
- end;
+
+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, #c_var{name=V}, Sub) ->
- case is_boolean_type(V, Sub) of
- true -> #c_literal{val=true};
- false -> Call
- end;
-eval_is_boolean(_, #c_cons{}, _) ->
- #c_literal{val=false};
-eval_is_boolean(_, #c_tuple{}, _) ->
- #c_literal{val=false};
-eval_is_boolean(Call, _, _) ->
- Call.
+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
@@ -1330,36 +956,33 @@ eval_append(Call, X, Y) ->
%% Evaluates element/2 if the position Pos is a literal and
%% the shape of the tuple Tuple is known.
%%
-eval_element(Call, #c_literal{val=Pos}, #c_tuple{es=Es}, _Types) when is_integer(Pos) ->
- if
- 1 =< Pos, Pos =< length(Es) ->
- lists:nth(Pos, Es);
- true ->
- eval_failure(Call, badarg)
- end;
-eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types)
+eval_element(Call, #c_literal{val=Pos}, Tuple, Types)
when is_integer(Pos) ->
- case orddict:find(V, Types#sub.t) of
- {ok,#c_tuple{es=Elements}} ->
+ case get_type(Tuple, Types) of
+ none ->
+ Call;
+ Type ->
+ Es = case cerl:is_c_tuple(Type) of
+ false -> [];
+ true -> cerl:tuple_es(Type)
+ end,
if
- 1 =< Pos, Pos =< length(Elements) ->
- El = lists:nth(Pos, Elements),
+ 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
end;
true ->
+ %% Index outside tuple or not a tuple.
eval_failure(Call, badarg)
- end;
- {ok,_} ->
- eval_failure(Call, badarg);
- error ->
- Call
+ end
end;
-eval_element(Call, Pos, Tuple, _Types) ->
- case is_not_integer(Pos) orelse is_not_tuple(Tuple) of
+eval_element(Call, Pos, Tuple, Sub) ->
+ case is_int_type(Pos, Sub) =:= no orelse
+ is_tuple_type(Tuple, Sub) =:= no of
true ->
eval_failure(Call, badarg);
false ->
@@ -1369,58 +992,55 @@ eval_element(Call, Pos, Tuple, _Types) ->
%% eval_is_record(Call, Var, Tag, Size, Types) -> Val.
%% Evaluates is_record/3 using type information.
%%
-eval_is_record(Call, #c_var{name=V}, #c_literal{val=NeededTag}=Lit,
+eval_is_record(Call, Term, #c_literal{val=NeededTag},
#c_literal{val=Size}, Types) ->
- case orddict:find(V, Types#sub.t) of
- {ok,#c_tuple{es=[#c_literal{val=Tag}|_]=Es}} ->
- Lit#c_literal{val=Tag =:= NeededTag andalso
- length(Es) =:= Size};
- _ ->
- Call
+ case get_type(Term, Types) of
+ none ->
+ Call;
+ Type ->
+ Es = case cerl:is_c_tuple(Type) of
+ false -> [];
+ true -> cerl:tuple_es(Type)
+ end,
+ case Es of
+ [#c_literal{val=Tag}|_] ->
+ Bool = Tag =:= NeededTag andalso
+ length(Es) =:= Size,
+ #c_literal{val=Bool};
+ _ ->
+ #c_literal{val=false}
+ end
end;
eval_is_record(Call, _, _, _, _) -> Call.
-%% is_not_integer(Core) -> true | false.
-%% Returns true if Core is definitely not an integer.
-
-is_not_integer(#c_literal{val=Val}) when not is_integer(Val) -> true;
-is_not_integer(#c_tuple{}) -> true;
-is_not_integer(#c_cons{}) -> true;
-is_not_integer(#c_map{}) -> true;
-is_not_integer(_) -> false.
-
-%% is_not_tuple(Core) -> true | false.
-%% Returns true if Core is definitely not a tuple.
-
-is_not_tuple(#c_literal{val=Val}) when not is_tuple(Val) -> true;
-is_not_tuple(#c_cons{}) -> true;
-is_not_tuple(#c_map{}) -> true;
-is_not_tuple(_) -> false.
-
%% 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
@@ -1500,7 +1120,7 @@ clause(#c_clause{pats=Ps0,guard=G0,body=B0}=Cl, Cexpr, Ctxt, Sub0) ->
let_substs(Vs0, As0, Sub0) ->
{Vs1,Sub1} = pattern_list(Vs0, Sub0),
{Vs2,As1,Ss} = let_substs_1(Vs1, As0, Sub1),
- Sub2 = scope_add([V || #c_var{name=V} <- Vs2], Sub1),
+ Sub2 = sub_add_scope([V || #c_var{name=V} <- Vs2], Sub1),
{Vs2,As1,
foldl(fun ({V,S}, Sub) -> sub_set_name(V, S, Sub) end, Sub2, Ss)}.
@@ -1535,7 +1155,7 @@ pattern(#c_var{}=Pat, Isub, Osub) ->
true ->
V1 = make_var_name(),
Pat1 = #c_var{name=V1},
- {Pat1,sub_set_var(Pat, Pat1, scope_add([V1], Osub))};
+ {Pat1,sub_set_var(Pat, Pat1, sub_add_scope([V1], Osub))};
false ->
{Pat,sub_del_var(Pat, Osub)}
end;
@@ -1605,6 +1225,7 @@ is_subst(_) -> false.
%% sub_del_var(Var, #sub{}) -> #sub{}.
%% sub_subst_var(Var, Value, #sub{}) -> [{Name,Value}].
%% sub_is_val(Var, #sub{}) -> boolean().
+%% sub_add_scope(#sub{}) -> #sub{}
%% sub_subst_scope(#sub{}) -> #sub{}
%%
%% We use the variable name as key so as not have problems with
@@ -1615,9 +1236,10 @@ is_subst(_) -> false.
%% In addition to the list of substitutions, we also keep track of
%% all variable currently live (the scope).
%%
-%% sub_subst_scope/1 adds dummy substitutions for all variables
-%% in the scope in order to force renaming if variables in the
-%% scope occurs as pattern variables.
+%% sub_add_scope/2 adds variables to the scope. sub_subst_scope/1
+%% adds dummy substitutions for all variables in the scope in order
+%% to force renaming if variables in the scope occurs as pattern
+%% variables.
sub_new() -> #sub{v=orddict:new(),s=gb_trees:empty(),t=[]}.
@@ -1657,6 +1279,12 @@ sub_subst_var(#c_var{name=V}, Val, #sub{v=S0}) ->
%% Fold chained substitutions.
[{V,Val}] ++ [ {K,Val} || {K,#c_var{name=V1}} <- S0, V1 =:= V].
+sub_add_scope(Vs, #sub{s=Scope0}=Sub) ->
+ Scope = foldl(fun(V, S) when is_integer(V); is_atom(V) ->
+ gb_sets:add(V, S)
+ end, Scope0, Vs),
+ Sub#sub{s=Scope}.
+
sub_subst_scope(#sub{v=S0,s=Scope}=Sub) ->
S = [{-1,#c_var{name=Sv}} || Sv <- gb_sets:to_list(Scope)]++S0,
Sub#sub{v=S}.
@@ -1704,7 +1332,7 @@ clauses(E, [C0|Cs], Ctxt, Sub, LitExpr) ->
{yes,yes} ->
case LitExpr of
false ->
- Line = get_line(core_lib:get_anno(C1)),
+ Line = get_line(cerl:get_ann(C1)),
shadow_warning(Cs, Line);
true ->
%% If the case expression is a literal,
@@ -1938,7 +1566,7 @@ opt_bool_case_guard(#c_case{arg=Arg,clauses=Cs0}=Case) ->
Case;
true ->
Cs = opt_bool_case_guard(Arg, Cs0),
- Case#c_case{arg=#c_values{anno=core_lib:get_anno(Arg),es=[]},
+ Case#c_case{arg=#c_values{anno=cerl:get_ann(Arg),es=[]},
clauses=Cs}
end.
@@ -1986,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),
@@ -1993,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
@@ -2048,12 +1690,31 @@ case_opt_args([], Cs, _Sub, _LitExpr, Acc) ->
%% Try to expand one argument to several arguments (if tuple/list)
%% or to remove a literal argument.
%%
-case_opt_arg(E0, Sub, Cs0, LitExpr) ->
- E = maybe_replace_var(E0, Sub),
- case cerl:is_data(E) of
+case_opt_arg(E0, Sub, Cs, LitExpr) ->
+ case cerl:is_c_var(E0) of
+ false ->
+ case_opt_arg_1(E0, Cs, LitExpr);
+ true ->
+ case case_will_var_match(Cs) of
+ true ->
+ %% All clauses will match a variable in the
+ %% current position. Don't expand this variable
+ %% (that can only make the code worse).
+ {error,Cs};
+ false ->
+ %% If possible, expand this variable to a previously
+ %% matched term.
+ E = case_expand_var(E0, Sub),
+ case_opt_arg_1(E, Cs, LitExpr)
+ end
+ end.
+
+case_opt_arg_1(E0, Cs0, LitExpr) ->
+ case cerl:is_data(E0) of
false ->
{error,Cs0};
true ->
+ E = case_opt_compiler_generated(E0),
Cs = case_opt_nomatch(E, Cs0, LitExpr),
case cerl:data_type(E) of
{atomic,_} ->
@@ -2063,18 +1724,42 @@ case_opt_arg(E0, Sub, Cs0, LitExpr) ->
end
end.
-%% maybe_replace_var(Expr0, Sub) -> Expr
+%% case_will_var_match([Clause]) -> true | false.
+%% Return if all clauses will match a variable in the
+%% current position.
+%%
+case_will_var_match(Cs) ->
+ all(fun({[P|_],_,_,_}) ->
+ case cerl_clauses:match(P, any) of
+ {true,_} -> true;
+ _ -> false
+ end
+ end, Cs).
+
+
+%% case_opt_compiler_generated(Core) -> Core'
+%% Mark Core expressions as compiler generated to ensure that
+%% no warnings are generated if they turn out to be unused.
+%% To pretty-printed Core Erlang easier to read, don't mark
+%% constructs that can't cause warnings to be emitted.
+%%
+case_opt_compiler_generated(Core) ->
+ F = fun(C) ->
+ case cerl:type(C) of
+ alias -> C;
+ var -> C;
+ _ -> cerl:set_ann(C, [compiler_generated])
+ end
+ end,
+ cerl_trees:map(F, Core).
+
+
+%% case_expand_var(Expr0, Sub) -> Expr
%% If Expr0 is a variable that has been previously matched and
%% is known to be a tuple, return the tuple instead. Otherwise
%% return Expr0 unchanged.
%%
-maybe_replace_var(E, Sub) ->
- case cerl:is_c_var(E) of
- false -> E;
- true -> maybe_replace_var_1(E, Sub)
- end.
-
-maybe_replace_var_1(E, #sub{t=Tdb}) ->
+case_expand_var(E, #sub{t=Tdb}) ->
case orddict:find(cerl:var_name(E), Tdb) of
{ok,T0} ->
case cerl:is_c_tuple(T0) of
@@ -2091,9 +1776,8 @@ maybe_replace_var_1(E, #sub{t=Tdb}) ->
%% operator will fail when used in map
%% construction (only the '=>' operator is allowed
%% when constructing a map from scratch).
- ToData = fun coerce_to_data/1,
try
- cerl_trees:map(ToData, T0)
+ cerl_trees:map(fun coerce_to_data/1, T0)
catch
throw:impossible ->
%% Something unsuitable was found (map or
@@ -2147,8 +1831,9 @@ case_opt_nomatch(_, [], _) -> [].
%% will match, and we can remove the corresponding pattern from
%% each clause.
%%
-%% The only complication is if the literal is a binary. Binary
-%% pattern matching is tricky, so we will give up in that case.
+%% The only complication is if the literal is a binary or map.
+%% In general, it is difficult to know whether a binary or
+%% map pattern will match, so we give up in that case.
case_opt_lit(Lit, Cs0) ->
try case_opt_lit_1(Lit, Cs0) of
@@ -2175,6 +1860,10 @@ case_opt_lit_1(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) ->
case_opt_lit_1(_, []) -> [].
%% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses}
+%% The case expression is a non-atomic data constructor (cons
+%% or tuple). We can know at compile time whether each clause
+%% will match, and we can delay the building of the data to
+%% the clauses where it is actually needed.
case_opt_data(E, Cs0) ->
Es = cerl:data_es(E),
@@ -2184,45 +1873,48 @@ case_opt_data(E, Cs0) ->
{ok,Es,Cs}
catch
throw:impossible ->
+ %% The pattern contained a binary or map.
{error,Cs0}
end.
-case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) ->
- {ok,Ps1,Bs1} = case_data_pat(P, TypeSig),
- [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|
- case_opt_data_1(Cs, Es, TypeSig)];
+case_opt_data_1([{[P0|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) ->
+ P = case_opt_compiler_generated(P0),
+ BindTo = #c_var{name=dummy},
+ {Ps1,[{BindTo,_}|Bs1]} = case_data_pat_alias(P, BindTo, TypeSig, []),
+ [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|case_opt_data_1(Cs, Es, TypeSig)];
case_opt_data_1([], _, _) -> [].
-%% case_data_pat(Pattern, Type, Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error.
-
-case_data_pat(P, TypeSig) ->
- case cerl:is_data(P) of
- false ->
- case_data_pat_var(P, TypeSig);
- true ->
- {ok,cerl:data_es(P),[]}
- end.
-
-%% case_data_pat_var(Pattern, {DataType,ArityType}) ->
-%% {ok,[Pattern],[{AliasVar,Pat}]}
-
-case_data_pat_var(P, {Type,Arity}=TypeSig) ->
- %% If the entire case statement is evaluated in an effect
- %% context (e.g. "case {A,B} of ... end, ok"), there will
- %% be a warning that a term is constructed but never used.
- %% To avoid that warning, we must annotate the data
- %% constructor as compiler generated.
- Ann = [compiler_generated|cerl:get_ann(P)],
+case_data_pat_alias(P, BindTo0, TypeSig, Bs0) ->
case cerl:type(P) of
- var ->
- Vars = make_vars(cerl:get_ann(P), Arity),
- {ok,Vars,[{P,cerl:ann_make_data(Ann, Type, Vars)}]};
alias ->
- V = cerl:alias_var(P),
- Apat = cerl:alias_pat(P),
- {ok,Ps,Bs} = case_data_pat(Apat, TypeSig),
- {ok,Ps,[{V,cerl:ann_make_data(Ann, Type,
- pat_to_expr_list(Ps))}|Bs]}
+ %% Recursively handle the pattern and bind to
+ %% the alias variable.
+ BindTo = cerl:alias_var(P),
+ Apat0 = cerl:alias_pat(P),
+ Ann = [compiler_generated],
+ Apat = cerl:set_ann(Apat0, Ann),
+ {Ps,Bs} = case_data_pat_alias(Apat, BindTo, TypeSig, Bs0),
+ {Ps,[{BindTo0,BindTo}|Bs]};
+ var ->
+ %% Here we will need to actually build the data and bind
+ %% it to the variable.
+ {Type,Arity} = TypeSig,
+ Vars = make_vars([], Arity),
+ Ann = [compiler_generated],
+ Data = cerl:ann_make_data(Ann, Type, Vars),
+ Bs = [{BindTo0,P},{P,Data}|Bs0],
+ {Vars,Bs};
+ _ ->
+ %% Since case_opt_nomatch/3 has removed all clauses that
+ %% cannot match, we KNOW that this clause must match and
+ %% that the pattern must be a data constructor.
+ %% Here we must build the data and bind it to the variable.
+ {Type,_} = TypeSig,
+ DataEs = cerl:data_es(P),
+ Vars = pat_to_expr_list(DataEs),
+ Ann = [compiler_generated],
+ Data = cerl:ann_make_data(Ann, Type, Vars),
+ {DataEs,[{BindTo0,Data}]}
end.
%% pat_to_expr(Pattern) -> Expression.
@@ -2269,58 +1961,130 @@ make_var_name() ->
list_to_atom("fol"++integer_to_list(N)).
letify(Bs, Body) ->
+ Ann = cerl:get_ann(Body),
foldr(fun({V,Val}, B) ->
- letify(V, Val, B)
+ cerl:ann_c_let(Ann, [V], Val, B)
end, Body, Bs).
-letify(#c_var{name=Vname}=Var, Val, Body) ->
- case core_lib:is_var_used(Vname, Body) of
- true ->
- A = element(2, Body),
- #c_let{anno=A,vars=[Var],arg=Val,body=Body};
- false -> Body
- end.
-
-%% 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_not_in_let(Vs, Arg, Body) ->
+ {Vs,Arg,Body}.
-opt_case_in_let_1(V, Arg, Cs) ->
- try
- opt_case_in_let_2(V, Arg, Cs)
- catch
- _:_ -> impossible
+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}|_]) ->
-
- %% 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.)
-
- 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}.
+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.
+
+%% inverse_rel_op(Op) -> no | RevOp
+
+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
@@ -2362,18 +2126,15 @@ 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);
is_bool_expr(#c_let{body=B}, Sub) ->
%% Binding of multiple variables.
is_bool_expr(B, Sub);
-is_bool_expr(#c_literal{val=Bool}, _) when is_boolean(Bool) ->
- true;
-is_bool_expr(#c_var{name=V}, Sub) ->
- is_boolean_type(V, Sub);
-is_bool_expr(_, _) -> false.
+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);
@@ -2451,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
@@ -2509,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),
@@ -2587,86 +2316,232 @@ move_let_into_expr(_Let, _Expr, _Sub) -> impossible.
is_failing_clause(#c_clause{body=B}) ->
will_fail(B).
-scope_add(Vs, #sub{s=Scope0}=Sub) ->
- Scope = foldl(fun(V, S) when is_integer(V); is_atom(V) ->
- gb_sets:add(V, S)
- end, Scope0, Vs),
- Sub#sub{s=Scope}.
+%% 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, Body0, effect, Sub) ->
- case {Vs0,Arg0,Body0} of
- {[],#c_values{es=[]},Body} ->
- %% No variables left (because of substitutions).
- Body;
- {[_|_],Arg,#c_literal{}} ->
- %% The body is a literal. That means that we can ignore
- %% it and that the return value is Arg revisited in
- %% effect context.
- body(Arg, effect, sub_new_preserve_types(Sub));
- {Vs,Arg,Body} ->
- %% Since we are in effect context, there is a chance
- %% that the body no longer references the variables.
- %% In that case we can construct a sequence and visit
- %% that in effect context:
- %% let <Var> = Arg in BodyWithoutVar ==> seq Arg BodyWithoutVar
- case is_any_var_used(Vs, Body) of
- false ->
- expr(#c_seq{arg=Arg,body=Body}, effect, sub_new_preserve_types(Sub));
- true ->
- Let = Let0#c_let{vars=Vs,arg=Arg,body=Body},
- opt_case_in_let_arg(opt_case_in_let(Let, Sub), effect, Sub)
- end
- end;
-opt_simple_let_2(Let, Vs0, Arg0, Body, value, 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
- expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub))
+ 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{}} ->
- %% The variable is not used in the body. The argument
- %% can be evaluated in effect context to simplify it.
- expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub));
- {Vs,Arg,Body} ->
- opt_case_in_let_arg(
- opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}, Sub),
- value, Sub)
+ {Vs,Arg1,#c_literal{}} ->
+ Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt),
+ E = case Ctxt of
+ effect ->
+ %% Throw away the literal body.
+ Arg;
+ value ->
+ %% Since the variable is not used in the body, we
+ %% can rewrite the let to a sequence.
+ %% let <Var> = Arg in Literal ==> seq Arg Literal
+ #c_seq{arg=Arg,body=Body}
+ end,
+ expr(E, Ctxt, sub_new_preserve_types(Sub));
+ {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=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,
@@ -2756,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
@@ -2789,14 +2664,114 @@ is_any_var_used([#c_var{name=V}|Vs], Expr) ->
end;
is_any_var_used([], _) -> false.
-is_boolean_type(V, #sub{t=Tdb}) ->
+%%%
+%%% Retrieving information about types.
+%%%
+
+-spec get_type(cerl:cerl(), #sub{}) -> type_info() | 'none'.
+
+get_type(#c_var{name=V}, #sub{t=Tdb}) ->
case orddict:find(V, Tdb) of
- {ok,bool} -> true;
- _ -> false
+ {ok,Type} -> Type;
+ error -> 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.
+
+-spec is_tuple_type(cerl:cerl(), sub()) -> yes_no_maybe().
+
+is_tuple_type(Var, Sub) ->
+ case get_type(Var, Sub) of
+ none -> maybe;
+ C -> yes_no(cerl:is_c_tuple(C))
+ end.
+
+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}.
@@ -2816,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'
@@ -3082,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;
@@ -3116,11 +3093,11 @@ add_bin_opt_info(Core, Term) ->
end.
add_warning(Core, Term) ->
- case is_compiler_generated(Core) of
+ case suppress_warning(Core) of
true ->
ok;
false ->
- Anno = core_lib:get_anno(Core),
+ Anno = cerl:get_ann(Core),
Line = get_line(Anno),
File = get_file(Anno),
Key = {?MODULE,warnings},
@@ -3141,9 +3118,17 @@ get_file([{file,File}|_]) -> File;
get_file([_|T]) -> get_file(T);
get_file([]) -> "no_file". % should not happen
+suppress_warning(Core) ->
+ is_compiler_generated(Core) orelse
+ is_result_unwanted(Core).
+
is_compiler_generated(Core) ->
- Anno = core_lib:get_anno(Core),
- member(compiler_generated, Anno).
+ Ann = cerl:get_ann(Core),
+ member(compiler_generated, Ann).
+
+is_result_unwanted(Core) ->
+ Ann = cerl:get_ann(Core),
+ member(result_not_wanted, Ann).
get_warnings() ->
ordsets:from_list((erase({?MODULE,warnings}))).
diff --git a/lib/compiler/src/sys_core_fold_lists.erl b/lib/compiler/src/sys_core_fold_lists.erl
new file mode 100644
index 0000000000..49dc59052a
--- /dev/null
+++ b/lib/compiler/src/sys_core_fold_lists.erl
@@ -0,0 +1,386 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2015. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Purpose : Inline high order lists functions from the lists module.
+
+-module(sys_core_fold_lists).
+
+-export([call/4]).
+
+-include("core_parse.hrl").
+
+%% We inline some very common higher order list operations.
+%% We use the same evaluation order as the library function.
+
+-spec call(cerl:c_call(), atom(), atom(), [cerl:cerl()]) ->
+ 'none' | cerl:cerl().
+
+call(#c_call{anno=Anno}, lists, all, [Arg1,Arg2]) ->
+ Loop = #c_var{name={'lists^all',1}},
+ F = #c_var{name='F'},
+ Xs = #c_var{name='Xs'},
+ X = #c_var{name='X'},
+ Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]},
+ CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true},
+ body=#c_apply{anno=Anno, op=Loop, args=[Xs]}},
+ CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
+ body=#c_literal{val=false}},
+ CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
+ body=match_fail(Anno, Err1)},
+ C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]},
+ clauses = [CC1, CC2, CC3]}},
+ C2 = #c_clause{pats=[#c_literal{val=[]}],
+ guard=#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=is_function},
+ args=[F, #c_literal{val=1}]},
+ body=#c_literal{val=true}},
+ Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
+ C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ body=match_fail([{function_name,{'lists^all',1}}|Anno], Err2)},
+ Fun = #c_fun{vars=[Xs],
+ body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
+ L = #c_var{name='L'},
+ #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
+ body=#c_letrec{defs=[{Loop,Fun}],
+ body=#c_apply{anno=Anno, op=Loop, args=[L]}}};
+call(#c_call{anno=Anno}, lists, any, [Arg1,Arg2]) ->
+ Loop = #c_var{name={'lists^any',1}},
+ F = #c_var{name='F'},
+ Xs = #c_var{name='Xs'},
+ X = #c_var{name='X'},
+ Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]},
+ CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true},
+ body=#c_literal{val=true}},
+ CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
+ body=#c_apply{anno=Anno, op=Loop, args=[Xs]}},
+ CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
+ body=match_fail(Anno, Err1)},
+ C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]},
+ clauses = [CC1, CC2, CC3]}},
+ C2 = #c_clause{pats=[#c_literal{val=[]}],
+ guard=#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=is_function},
+ args=[F, #c_literal{val=1}]},
+ body=#c_literal{val=false}},
+ Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
+ C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ body=match_fail([{function_name,{'lists^any',1}}|Anno], Err2)},
+ Fun = #c_fun{vars=[Xs],
+ body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
+ L = #c_var{name='L'},
+ #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
+ body=#c_letrec{defs=[{Loop,Fun}],
+ body=#c_apply{anno=Anno, op=Loop, args=[L]}}};
+call(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2]) ->
+ Loop = #c_var{name={'lists^foreach',1}},
+ F = #c_var{name='F'},
+ Xs = #c_var{name='Xs'},
+ X = #c_var{name='X'},
+ C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ body=#c_seq{arg=#c_apply{anno=Anno, op=F, args=[X]},
+ body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}},
+ C2 = #c_clause{pats=[#c_literal{val=[]}],
+ guard=#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=is_function},
+ args=[F, #c_literal{val=1}]},
+ body=#c_literal{val=ok}},
+ Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
+ C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ body=match_fail([{function_name,{'lists^foreach',1}}|Anno], Err)},
+ Fun = #c_fun{vars=[Xs],
+ body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
+ L = #c_var{name='L'},
+ #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
+ body=#c_letrec{defs=[{Loop,Fun}],
+ body=#c_apply{anno=Anno, op=Loop, args=[L]}}};
+call(#c_call{anno=Anno}, lists, map, [Arg1,Arg2]) ->
+ Loop = #c_var{name={'lists^map',1}},
+ F = #c_var{name='F'},
+ Xs = #c_var{name='Xs'},
+ X = #c_var{name='X'},
+ H = #c_var{name='H'},
+ C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ body=#c_let{vars=[H], arg=#c_apply{anno=Anno,
+ op=F,
+ args=[X]},
+ body=#c_cons{hd=H,
+ anno=[compiler_generated],
+ tl=#c_apply{anno=Anno,
+ op=Loop,
+ args=[Xs]}}}},
+ C2 = #c_clause{pats=[#c_literal{val=[]}],
+ guard=#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=is_function},
+ args=[F, #c_literal{val=1}]},
+ body=#c_literal{val=[]}},
+ Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
+ C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ body=match_fail([{function_name,{'lists^map',1}}|Anno], Err)},
+ Fun = #c_fun{vars=[Xs],
+ body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
+ L = #c_var{name='L'},
+ #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
+ body=#c_letrec{defs=[{Loop,Fun}],
+ body=#c_apply{anno=Anno, op=Loop, args=[L]}}};
+call(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2]) ->
+ Loop = #c_var{name={'lists^flatmap',1}},
+ F = #c_var{name='F'},
+ Xs = #c_var{name='Xs'},
+ X = #c_var{name='X'},
+ H = #c_var{name='H'},
+ C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ body=#c_let{vars=[H],
+ arg=#c_apply{anno=Anno, op=F, args=[X]},
+ body=#c_call{anno=[compiler_generated|Anno],
+ module=#c_literal{val=erlang},
+ name=#c_literal{val='++'},
+ args=[H,
+ #c_apply{anno=Anno,
+ op=Loop,
+ args=[Xs]}]}}},
+ C2 = #c_clause{pats=[#c_literal{val=[]}],
+ guard=#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=is_function},
+ args=[F, #c_literal{val=1}]},
+ body=#c_literal{val=[]}},
+ Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
+ C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ body=match_fail([{function_name,{'lists^flatmap',1}}|Anno], Err)},
+ Fun = #c_fun{vars=[Xs],
+ body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
+ L = #c_var{name='L'},
+ #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
+ body=#c_letrec{defs=[{Loop,Fun}],
+ body=#c_apply{anno=Anno, op=Loop, args=[L]}}};
+call(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2]) ->
+ Loop = #c_var{name={'lists^filter',1}},
+ F = #c_var{name='F'},
+ Xs = #c_var{name='Xs'},
+ X = #c_var{name='X'},
+ B = #c_var{name='B'},
+ Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]},
+ CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true},
+ body=#c_cons{anno=[compiler_generated], hd=X, tl=Xs}},
+ CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
+ body=Xs},
+ CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
+ body=match_fail(Anno, Err1)},
+ Case = #c_case{arg=B, clauses = [CC1, CC2, CC3]},
+ C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ body=#c_let{vars=[B],
+ arg=#c_apply{anno=Anno, op=F, args=[X]},
+ body=#c_let{vars=[Xs],
+ arg=#c_apply{anno=Anno,
+ op=Loop,
+ args=[Xs]},
+ body=Case}}},
+ C2 = #c_clause{pats=[#c_literal{val=[]}],
+ guard=#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=is_function},
+ args=[F, #c_literal{val=1}]},
+ body=#c_literal{val=[]}},
+ Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
+ C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ body=match_fail([{function_name,{'lists^filter',1}}|Anno], Err2)},
+ Fun = #c_fun{vars=[Xs],
+ body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
+ L = #c_var{name='L'},
+ #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
+ body=#c_letrec{defs=[{Loop,Fun}],
+ body=#c_apply{anno=Anno, op=Loop, args=[L]}}};
+call(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3]) ->
+ Loop = #c_var{name={'lists^foldl',2}},
+ F = #c_var{name='F'},
+ Xs = #c_var{name='Xs'},
+ X = #c_var{name='X'},
+ A = #c_var{name='A'},
+ C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ body=#c_apply{anno=Anno,
+ op=Loop,
+ args=[Xs, #c_apply{anno=Anno,
+ op=F,
+ args=[X, A]}]}},
+ C2 = #c_clause{pats=[#c_literal{val=[]}],
+ guard=#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=is_function},
+ args=[F, #c_literal{val=2}]},
+ body=A},
+ Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]},
+ C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ body=match_fail([{function_name,{'lists^foldl',2}}|Anno], Err)},
+ Fun = #c_fun{vars=[Xs, A],
+ body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
+ L = #c_var{name='L'},
+ #c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
+ body=#c_letrec{defs=[{Loop,Fun}],
+ body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}};
+call(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3]) ->
+ Loop = #c_var{name={'lists^foldr',2}},
+ F = #c_var{name='F'},
+ Xs = #c_var{name='Xs'},
+ X = #c_var{name='X'},
+ A = #c_var{name='A'},
+ C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ body=#c_apply{anno=Anno,
+ op=F,
+ args=[X, #c_apply{anno=Anno,
+ op=Loop,
+ args=[Xs, A]}]}},
+ C2 = #c_clause{pats=[#c_literal{val=[]}],
+ guard=#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=is_function},
+ args=[F, #c_literal{val=2}]},
+ body=A},
+ Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]},
+ C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ body=match_fail([{function_name,{'lists^foldr',2}}|Anno], Err)},
+ Fun = #c_fun{vars=[Xs, A],
+ body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
+ L = #c_var{name='L'},
+ #c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
+ body=#c_letrec{defs=[{Loop,Fun}],
+ body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}};
+call(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3]) ->
+ Loop = #c_var{name={'lists^mapfoldl',2}},
+ F = #c_var{name='F'},
+ Xs = #c_var{name='Xs'},
+ X = #c_var{name='X'},
+ Avar = #c_var{name='A'},
+ Match =
+ fun (A, P, E) ->
+ C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E},
+ Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]},
+ C2 = #c_clause{pats=[X], guard=#c_literal{val=true},
+ body=match_fail(Anno, Err)},
+ #c_case{arg=A, clauses=[C1, C2]}
+ end,
+ C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ body=Match(#c_apply{anno=Anno, op=F, args=[X, Avar]},
+ #c_tuple{es=[X, Avar]},
+%%% Tuple passing version
+ Match(#c_apply{anno=Anno,
+ op=Loop,
+ args=[Xs, Avar]},
+ #c_tuple{es=[Xs, Avar]},
+ #c_tuple{anno=[compiler_generated],
+ es=[#c_cons{anno=[compiler_generated],
+ hd=X, tl=Xs},
+ Avar]})
+%%% Multiple-value version
+%%% #c_let{vars=[Xs,A],
+%%% %% The tuple here will be optimised
+%%% %% away later; no worries.
+%%% arg=#c_apply{op=Loop, args=[Xs, A]},
+%%% body=#c_values{es=[#c_cons{hd=X, tl=Xs},
+%%% A]}}
+ )},
+ C2 = #c_clause{pats=[#c_literal{val=[]}],
+ guard=#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=is_function},
+ args=[F, #c_literal{val=2}]},
+%%% Tuple passing version
+ body=#c_tuple{anno=[compiler_generated],
+ es=[#c_literal{val=[]}, Avar]}},
+%%% Multiple-value version
+%%% body=#c_values{es=[#c_literal{val=[]}, A]}},
+ Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]},
+ C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ body=match_fail([{function_name,{'lists^mapfoldl',2}}|Anno], Err)},
+ Fun = #c_fun{vars=[Xs, Avar],
+ body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
+ L = #c_var{name='L'},
+ #c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
+ body=#c_letrec{defs=[{Loop,Fun}],
+%%% Tuple passing version
+ body=#c_apply{anno=Anno,
+ op=Loop,
+ args=[L, Avar]}}};
+%%% Multiple-value version
+%%% body=#c_let{vars=[Xs, A],
+%%% arg=#c_apply{op=Loop,
+%%% args=[L, A]},
+%%% body=#c_tuple{es=[Xs, A]}}}};
+call(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3]) ->
+ Loop = #c_var{name={'lists^mapfoldr',2}},
+ F = #c_var{name='F'},
+ Xs = #c_var{name='Xs'},
+ X = #c_var{name='X'},
+ Avar = #c_var{name='A'},
+ Match =
+ fun (A, P, E) ->
+ C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E},
+ Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]},
+ C2 = #c_clause{pats=[X], guard=#c_literal{val=true},
+ body=match_fail(Anno, Err)},
+ #c_case{arg=A, clauses=[C1, C2]}
+ end,
+ C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+%%% Tuple passing version
+ body=Match(#c_apply{anno=Anno,
+ op=Loop,
+ args=[Xs, Avar]},
+ #c_tuple{es=[Xs, Avar]},
+ Match(#c_apply{anno=Anno, op=F, args=[X, Avar]},
+ #c_tuple{es=[X, Avar]},
+ #c_tuple{anno=[compiler_generated],
+ es=[#c_cons{anno=[compiler_generated],
+ hd=X, tl=Xs}, Avar]}))
+%%% Multiple-value version
+%%% body=#c_let{vars=[Xs,A],
+%%% %% The tuple will be optimised away
+%%% arg=#c_apply{op=Loop, args=[Xs, A]},
+%%% body=Match(#c_apply{op=F, args=[X, A]},
+%%% #c_tuple{es=[X, A]},
+%%% #c_values{es=[#c_cons{hd=X, tl=Xs},
+%%% A]})}
+ },
+ C2 = #c_clause{pats=[#c_literal{val=[]}],
+ guard=#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=is_function},
+ args=[F, #c_literal{val=2}]},
+%%% Tuple passing version
+ body=#c_tuple{anno=[compiler_generated],
+ es=[#c_literal{val=[]}, Avar]}},
+%%% Multiple-value version
+%%% body=#c_values{es=[#c_literal{val=[]}, A]}},
+ Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]},
+ C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ body=match_fail([{function_name,{'lists^mapfoldr',2}}|Anno], Err)},
+ Fun = #c_fun{vars=[Xs, Avar],
+ body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
+ L = #c_var{name='L'},
+ #c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
+ body=#c_letrec{defs=[{Loop,Fun}],
+%%% Tuple passing version
+ body=#c_apply{anno=Anno,
+ op=Loop,
+ args=[L, Avar]}}};
+%%% Multiple-value version
+%%% body=#c_let{vars=[Xs, A],
+%%% arg=#c_apply{op=Loop,
+%%% args=[L, A]},
+%%% body=#c_tuple{es=[Xs, A]}}}};
+call(_, _, _, _) ->
+ none.
+
+match_fail(Ann, Arg) ->
+ Name = cerl:abstract(match_fail),
+ Args = [Arg],
+ cerl:ann_c_primop(Ann, Name, Args).
diff --git a/lib/compiler/src/sys_core_inline.erl b/lib/compiler/src/sys_core_inline.erl
index 9f93acb666..1e3a735e9b 100644
--- a/lib/compiler/src/sys_core_inline.erl
+++ b/lib/compiler/src/sys_core_inline.erl
@@ -195,10 +195,10 @@ kill_id_anns(Body) ->
A = kill_id_anns_1(A0),
CFun#c_fun{anno=A};
(Expr) ->
- %% Mark everything as compiler generated to suppress
- %% bogus warnings.
- A = compiler_generated(core_lib:get_anno(Expr)),
- core_lib:set_anno(Expr, A)
+ %% Mark everything as compiler generated to
+ %% suppress bogus warnings.
+ A = compiler_generated(cerl:get_ann(Expr)),
+ cerl:set_ann(Expr, A)
end, Body).
kill_id_anns_1([{'id',_}|As]) ->
diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index 761ae8409c..f99307c865 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -33,12 +33,15 @@
-include("../include/erl_bits.hrl").
+-type fa() :: {atom(), arity()}.
+
-record(expand, {module=[], %Module name
exports=[], %Exports
imports=[], %Imports
compile=[], %Compile flags
attributes=[], %Attributes
callbacks=[], %Callbacks
+ optional_callbacks=[] :: [fa()], %Optional callbacks
defined, %Defined functions (gb_set)
vcount=0, %Variable counter
func=[], %Current function
@@ -99,7 +102,21 @@ define_functions(Forms, #expand{defined=Predef}=St) ->
module_attrs(#expand{attributes=Attributes}=St) ->
Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes],
Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs],
- {Attrs,St#expand{callbacks=Callbacks}}.
+ OptionalCallbacks = get_optional_callbacks(Attrs),
+ {Attrs,St#expand{callbacks=Callbacks,
+ optional_callbacks=OptionalCallbacks}}.
+
+get_optional_callbacks(Attrs) ->
+ L = [O ||
+ {attribute, _, optional_callbacks, O} <- Attrs,
+ is_fa_list(O)],
+ lists:append(L).
+
+is_fa_list([{FuncName, Arity}|L])
+ when is_atom(FuncName), is_integer(Arity), Arity >= 0 ->
+ is_fa_list(L);
+is_fa_list([]) -> true;
+is_fa_list(_) -> false.
module_predef_funcs(St) ->
{Mpf1,St1}=module_predef_func_beh_info(St),
@@ -108,19 +125,24 @@ module_predef_funcs(St) ->
module_predef_func_beh_info(#expand{callbacks=[]}=St) ->
{[], St};
-module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined,
+module_predef_func_beh_info(#expand{callbacks=Callbacks,
+ optional_callbacks=OptionalCallbacks,
+ defined=Defined,
exports=Exports}=St) ->
PreDef=[{behaviour_info,1}],
PreExp=PreDef,
- {[gen_beh_info(Callbacks)],
+ {[gen_beh_info(Callbacks, OptionalCallbacks)],
St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined),
exports=union(from_list(PreExp), Exports)}}.
-gen_beh_info(Callbacks) ->
+gen_beh_info(Callbacks, OptionalCallbacks) ->
List = make_list(Callbacks),
+ OptionalList = make_optional_list(OptionalCallbacks),
{function,0,behaviour_info,1,
[{clause,0,[{atom,0,callbacks}],[],
- [List]}]}.
+ [List]},
+ {clause,0,[{atom,0,optional_callbacks}],[],
+ [OptionalList]}]}.
make_list([]) -> {nil,0};
make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) ->
@@ -130,6 +152,14 @@ make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) ->
{integer,0,Arity}]},
make_list(Rest)}.
+make_optional_list([]) -> {nil,0};
+make_optional_list([{Name,Arity}|Rest]) ->
+ {cons,0,
+ {tuple,0,
+ [{atom,0,Name},
+ {integer,0,Arity}]},
+ make_optional_list(Rest)}.
+
module_predef_funcs_mod_info(St) ->
PreDef = [{module_info,0},{module_info,1}],
PreExp = PreDef,
@@ -232,9 +262,18 @@ pattern({map,Line,Ps}, St0) ->
{TPs,St1} = pattern_list(Ps, St0),
{{map,Line,TPs},St1};
pattern({map_field_exact,Line,K0,V0}, St0) ->
- {K,St1} = expr(K0, St0),
+ %% Key should be treated as an expression
+ %% but since expressions are not allowed yet,
+ %% process it through pattern .. and handle assoc
+ %% (normalise unary op integer -> integer)
+ {K,St1} = pattern(K0, St0),
{V,St2} = pattern(V0, St1),
{{map_field_exact,Line,K,V},St2};
+pattern({map_field_assoc,Line,K0,V0}, St0) ->
+ %% when keys are Maps
+ {K,St1} = pattern(K0, St0),
+ {V,St2} = pattern(V0, St1),
+ {{map_field_assoc,Line,K,V},St2};
%%pattern({struct,Line,Tag,Ps}, St0) ->
%% {TPs,TPsvs,St1} = pattern_list(Ps, St0),
%% {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1};
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 47a357c23d..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) ->
@@ -210,7 +208,7 @@ need_heap_0([], H, Acc) ->
need_heap_1(#l{ke={set,_,{binary,_}},i=I}, H) ->
{need_heap_need(I, H),0};
-need_heap_1(#l{ke={set,_,{map,_,_}},i=I}, H) ->
+need_heap_1(#l{ke={set,_,{map,_,_,_}},i=I}, H) ->
{need_heap_need(I, H),0};
need_heap_1(#l{ke={set,_,Val}}, H) ->
%% Just pass through adding to needed heap.
@@ -643,10 +641,6 @@ select_val_cg(tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) ->
[{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis];
select_val_cg(tuple, R, Vls, Tf, Vf, Sis) ->
[{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis];
-select_val_cg(map, R, [_Val,{f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) ->
- [{test,is_map,{f,Fail},[R]}|Sis];
-select_val_cg(map, R, [_Val,{f,Lbl}|_], Tf, _Vf, [{label,Lbl}|Sis]) ->
- [{test,is_map,{f,Tf},[R]}|Sis];
select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) ->
[{test,is_eq_exact,{f,Fail},[R,{Type,Val}]}|Sis];
select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) ->
@@ -928,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}.
@@ -947,27 +941,34 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) ->
%% Assume keys are term-sorted
Rsrc = fetch_var(Src, Bef),
- {{HasKs,GetVs},Aft} = lists:foldr(fun
- ({map_pair,Key,{var,V}},{{HasKsi,GetVsi},Int0}) ->
+ {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} = lists:foldr(fun
+ ({map_pair,{var,K},{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) ->
case vdb_find(V, Vdb) of
{V,_,L} when L =< I ->
- {{[Key|HasKsi],GetVsi},Int0};
+ RK = fetch_var(K,Int0),
+ {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0};
_Other ->
Reg1 = put_reg(V, Int0#sr.reg),
Int1 = Int0#sr{reg=Reg1},
- {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi]},Int1}
+ RK = fetch_var(K,Int0),
+ RV = fetch_reg(V,Reg1),
+ {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1}
+ end;
+ ({map_pair,Key,{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) ->
+ case vdb_find(V, Vdb) of
+ {V,_,L} when L =< I ->
+ {{[Key|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0};
+ _Other ->
+ Reg1 = put_reg(V, Int0#sr.reg),
+ Int1 = Int0#sr{reg=Reg1},
+ {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi],HasVarVsi,GetVarVsi},Int1}
end
- end, {{[],[]},Bef}, Vs),
-
- Code = case {HasKs,GetVs} of
- {HasKs,[]} ->
- [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}}];
- {[],GetVs} ->
- [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}}];
- {HasKs,GetVs} ->
- [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}},
- {get_map_elements, {f,Fail},Rsrc,{list,GetVs}}]
- end,
+ end, {{[],[],[],[]},Bef}, Vs),
+
+ Code = [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}} || HasKs =/= []] ++
+ [{test,has_map_fields,{f,Fail},Rsrc,{list,[K]}} || K <- HasVarKs] ++
+ [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}} || GetVs =/= []] ++
+ [{get_map_elements, {f,Fail},Rsrc,{list,[K,V]}} || [K,V] <- GetVarVs],
{Code, Aft, St}.
@@ -1504,9 +1505,41 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef,
%% Now generate the complete code for constructing the binary.
Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a),
{Sis++Code,Aft,St};
+% Map single variable key
+set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef,
+ #cg{in_catch=InCatch,bfail=Bfail}=St) ->
+
+ Fail = {f,Bfail},
+ {Sis,Int0} =
+ case InCatch of
+ true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb);
+ false -> {[],Bef}
+ end,
+ SrcReg = cg_reg_arg(Map,Int0),
+ Line = line(Le#l.a),
+
+ List = [cg_reg_arg(K,Int0),cg_reg_arg(V,Int0)],
+
+ Live = max_reg(Bef#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;
+ exact -> put_map_exact
+ end,
+ {Sis++[Line]++[{I,Fail,SrcReg,Target,Live,{list,List}}],Aft,St};
+
+% Map (possibly) multiple literal keys
set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef,
#cg{in_catch=InCatch,bfail=Bfail}=St) ->
+ %% assert key literals
+ [] = [Var||{map_pair,{var,_}=Var,_} <- Es],
+
Fail = {f,Bfail},
{Sis,Int0} =
case InCatch of
@@ -1524,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 59ec0d4199..c954d21e59 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -66,6 +66,7 @@
%% match arguments are novars
%% case arguments are novars
%% receive timeouts are novars
+%% binaries and maps are novars
%% let/set arguments are expressions
%% fun is not a safe
@@ -77,8 +78,8 @@
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,
- ann_c_map/2, ann_c_map/3]).
+-import(cerl, [ann_c_cons/3,ann_c_tuple/2,c_tuple/1,
+ ann_c_map/3]).
-include("core_parse.hrl").
@@ -105,7 +106,9 @@
-record(iset, {anno=#a{},var,arg}).
-record(itry, {anno=#a{},args,vars,body,evars,handler}).
-record(ifilter, {anno=#a{},arg}).
--record(igen, {anno=#a{},acc_pat,acc_guard,skip_pat,tail,tail_pat,arg}).
+-record(igen, {anno=#a{},ceps=[],acc_pat,acc_guard,
+ skip_pat,tail,tail_pat,arg}).
+-record(isimple, {anno=#a{},term :: cerl:cerl()}).
-type iapply() :: #iapply{}.
-type ibinary() :: #ibinary{}.
@@ -124,11 +127,12 @@
-type itry() :: #itry{}.
-type ifilter() :: #ifilter{}.
-type igen() :: #igen{}.
+-type isimple() :: #isimple{}.
-type i() :: iapply() | ibinary() | icall() | icase() | icatch()
| iclause() | ifun() | iletrec() | imatch() | iprimop()
| iprotect() | ireceive1() | ireceive2() | iset() | itry()
- | ifilter() | igen().
+ | ifilter() | igen() | isimple().
-type warning() :: {file:filename(), [{integer(), module(), term()}]}.
@@ -169,60 +173,81 @@ form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) ->
attribute({attribute,Line,Name,Val}) ->
{#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}.
+%% function_dump(module_info,_,_,_) -> ok;
+%% function_dump(Name,Arity,Format,Terms) ->
+%% io:format("~w/~w " ++ Format,[Name,Arity]++Terms),
+%% ok.
+
function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) ->
- %%ok = io:fwrite("~p - ", [{Name,Arity}]),
St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]},
{B0,St1} = body(Cs0, Name, Arity, St0),
- %%ok = io:fwrite("1", []),
- %%ok = io:fwrite("~w:~p~n", [?LINE,B0]),
+ %% ok = function_dump(Name,Arity,"body:~n~p~n",[B0]),
{B1,St2} = ubody(B0, St1),
- %%ok = io:fwrite("2", []),
- %%ok = io:fwrite("~w:~p~n", [?LINE,B1]),
+ %% ok = function_dump(Name,Arity,"ubody:~n~p~n",[B1]),
{B2,#core{ws=Ws}} = cbody(B1, St2),
- %%ok = io:fwrite("3~n", []),
- %%ok = io:fwrite("~w:~p~n", [?LINE,B2]),
+ %% ok = function_dump(Name,Arity,"cbody:~n~p~n",[B2]),
{{#c_var{name={Name,Arity}},B2},Ws}.
body(Cs0, Name, Arity, St0) ->
Anno = lineno_anno(element(2, hd(Cs0)), St0),
{Args,St1} = new_vars(Anno, Arity, St0),
- {Cs1,St2} = clauses(Cs0, St1),
- {Ps,St3} = new_vars(Arity, St2), %Need new variables here
- Fc = function_clause(Ps, Anno, {Name,Arity}),
- {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}.
+ case clauses(Cs0, St1) of
+ {Cs1,[],St2} ->
+ {Ps,St3} = new_vars(Arity, St2), %Need new variables here
+ Fc = function_clause(Ps, Anno, {Name,Arity}),
+ {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3};
+ {Cs1,Eps,St2} ->
+ %% We have pre-expressions from patterns and
+ %% these needs to be letified before matching
+ %% since only bound variables are allowed
+ AnnoGen = #a{anno=[compiler_generated]},
+ {Ps1,St3} = new_vars(Arity, St2), %Need new variables here
+ Fc1 = function_clause(Ps1, Anno, {Name,Arity}),
+ {Ps2,St4} = new_vars(Arity, St3), %Need new variables here
+ Fc2 = function_clause(Ps2, Anno, {Name,Arity}),
+ Case = #icase{anno=AnnoGen,args=Args,
+ clauses=Cs1,
+ fc=Fc2},
+ {#ifun{anno=#a{anno=Anno},id=[],vars=Args,
+ clauses=[#iclause{anno=AnnoGen,pats=Ps1,
+ guard=[#c_literal{val=true}],
+ body=Eps ++ [Case]}],
+ fc=Fc1},St4}
+ end.
%% clause(Clause, State) -> {Cclause,State} | noclause.
%% clauses([Clause], State) -> {[Cclause],State}.
%% Convert clauses. Trap bad pattern aliases and remove clause from
%% clause list.
-clauses([C0|Cs0], St0) ->
+clauses([C0|Cs0],St0) ->
case clause(C0, St0) of
- {noclause,St} -> clauses(Cs0, St);
- {C,St1} ->
- {Cs,St2} = clauses(Cs0, St1),
- {[C|Cs],St2}
+ {noclause,_,St} -> clauses(Cs0,St);
+ {C,Eps1,St1} ->
+ {Cs,Eps2,St2} = clauses(Cs0, St1),
+ {[C|Cs],Eps1++Eps2,St2}
end;
-clauses([], St) -> {[],St}.
+clauses([],St) -> {[],[],St}.
clause({clause,Lc,H0,G0,B0}, St0) ->
try head(H0, St0) of
- H1 ->
- {G1,St1} = guard(G0, St0),
- {B1,St2} = exprs(B0, St1),
- Anno = lineno_anno(Lc, St2),
- {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},St2}
+ {H1,Eps,St1} ->
+ {G1,St2} = guard(G0, St1),
+ {B1,St3} = exprs(B0, St2),
+ Anno = lineno_anno(Lc, St3),
+ {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},Eps,St3}
catch
throw:nomatch ->
St = add_warning(Lc, nomatch, St0),
- {noclause,St} %Bad pattern
+ {noclause,[],St} %Bad pattern
end.
clause_arity({clause,_,H0,_,_}) -> length(H0).
-%% head([P], State) -> [P].
+%% head([P], State) -> {[P],[Cexpr],State}.
-head(Ps, St) -> pattern_list(Ps, St).
+head(Ps, St) ->
+ pattern_list(Ps, St).
%% guard([Expr], State) -> {[Cexpr],State}.
%% Build an explict and/or tree of guard alternatives, then traverse
@@ -266,13 +291,15 @@ gexpr({protect,Line,Arg}, Bools0, St0) ->
{#iprotect{anno=#a{anno=Anno},body=Eps++[E]},[],Bools0,St}
end;
gexpr({op,L,'andalso',E1,E2}, Bools, St0) ->
- {#c_var{name=V0},St} = new_var(L, St0),
+ Anno = lineno_anno(L, St0),
+ {#c_var{name=V0},St} = new_var(Anno, St0),
V = {var,L,V0},
False = {atom,L,false},
E = make_bool_switch_guard(L, E1, V, E2, False),
gexpr(E, Bools, St);
gexpr({op,L,'orelse',E1,E2}, Bools, St0) ->
- {#c_var{name=V0},St} = new_var(L, St0),
+ Anno = lineno_anno(L, St0),
+ {#c_var{name=V0},St} = new_var(Anno, St0),
V = {var,L,V0},
True = {atom,L,true},
E = make_bool_switch_guard(L, E1, V, True, E2),
@@ -361,33 +388,30 @@ gexpr_test(E0, Bools0, St0) ->
Lanno = Anno#a.anno,
{New,St2} = new_var(Lanno, St1),
Bools = [New|Bools0],
- {#icall{anno=Anno, %Must have an #a{}
- module=#c_literal{anno=Lanno,val=erlang},
- name=#c_literal{anno=Lanno,val='=:='},
- args=[New,#c_literal{anno=Lanno,val=true}]},
+ {icall_eq_true(New),
Eps0 ++ [#iset{anno=Anno,var=New,arg=E1}],Bools,St2}
end;
_ ->
- Anno = get_ianno(E1),
Lanno = get_lineno_anno(E1),
+ ACompGen = #a{anno=[compiler_generated]},
case is_simple(E1) of
true ->
Bools = [E1|Bools0],
- {#icall{anno=Anno, %Must have an #a{}
- module=#c_literal{anno=Lanno,val=erlang},
- name=#c_literal{anno=Lanno,val='=:='},
- args=[E1,#c_literal{anno=Lanno,val=true}]},Eps0,Bools,St1};
+ {icall_eq_true(E1),Eps0,Bools,St1};
false ->
{New,St2} = new_var(Lanno, St1),
Bools = [New|Bools0],
- {#icall{anno=Anno, %Must have an #a{}
- module=#c_literal{anno=Lanno,val=erlang},
- name=#c_literal{anno=Lanno,val='=:='},
- args=[New,#c_literal{anno=Lanno,val=true}]},
- Eps0 ++ [#iset{anno=Anno,var=New,arg=E1}],Bools,St2}
+ {icall_eq_true(New),
+ Eps0 ++ [#iset{anno=ACompGen,var=New,arg=E1}],Bools,St2}
end
end.
+icall_eq_true(Arg) ->
+ #icall{anno=#a{anno=[compiler_generated]},
+ module=#c_literal{val=erlang},
+ name=#c_literal{val='=:='},
+ args=[Arg,#c_literal{val=true}]}.
+
force_booleans(Vs0, E, Eps, St) ->
Vs1 = [set_anno(V, []) || V <- Vs0],
Vs = unforce(E, Eps, Vs1),
@@ -397,16 +421,15 @@ force_booleans_1([], E, Eps, St) ->
{E,Eps,St};
force_booleans_1([V|Vs], E0, Eps0, St0) ->
{E1,Eps1,St1} = force_safe(E0, St0),
- Lanno = element(2, V),
- Anno = #a{anno=Lanno},
- Call = #icall{anno=Anno,module=#c_literal{anno=Lanno,val=erlang},
- name=#c_literal{anno=Lanno,val=is_boolean},
+ ACompGen = #a{anno=[compiler_generated]},
+ Call = #icall{anno=ACompGen,module=#c_literal{val=erlang},
+ name=#c_literal{val=is_boolean},
args=[V]},
- {New,St} = new_var(Lanno, St1),
- Iset = #iset{anno=Anno,var=New,arg=Call},
+ {New,St} = new_var([], St1),
+ Iset = #iset{var=New,arg=Call},
Eps = Eps0 ++ Eps1 ++ [Iset],
- E = #icall{anno=Anno,
- module=#c_literal{anno=Lanno,val=erlang},name=#c_literal{anno=Lanno,val='and'},
+ E = #icall{anno=ACompGen,
+ module=#c_literal{val=erlang},name=#c_literal{val='and'},
args=[E1,New]},
force_booleans_1(Vs, E, Eps, St).
@@ -493,43 +516,28 @@ exprs([], St) -> {[],St}.
%% Generate an internal core expression.
expr({var,L,V}, St) -> {#c_var{anno=lineno_anno(L, St),name=V},[],St};
-expr({char,L,C}, St) -> {#c_literal{anno=lineno_anno(L, St),val=C},[],St};
-expr({integer,L,I}, St) -> {#c_literal{anno=lineno_anno(L, St),val=I},[],St};
-expr({float,L,F}, St) -> {#c_literal{anno=lineno_anno(L, St),val=F},[],St};
-expr({atom,L,A}, St) -> {#c_literal{anno=lineno_anno(L, St),val=A},[],St};
-expr({nil,L}, St) -> {#c_literal{anno=lineno_anno(L, St),val=[]},[],St};
-expr({string,L,S}, St) -> {#c_literal{anno=lineno_anno(L, St),val=S},[],St};
+expr({char,L,C}, St) -> {#c_literal{anno=full_anno(L, St),val=C},[],St};
+expr({integer,L,I}, St) -> {#c_literal{anno=full_anno(L, St),val=I},[],St};
+expr({float,L,F}, St) -> {#c_literal{anno=full_anno(L, St),val=F},[],St};
+expr({atom,L,A}, St) -> {#c_literal{anno=full_anno(L, St),val=A},[],St};
+expr({nil,L}, St) -> {#c_literal{anno=full_anno(L, St),val=[]},[],St};
+expr({string,L,S}, St) -> {#c_literal{anno=full_anno(L, St),val=S},[],St};
expr({cons,L,H0,T0}, St0) ->
{H1,Hps,St1} = safe(H0, St0),
{T1,Tps,St2} = safe(T0, St1),
- A = lineno_anno(L, St2),
+ A = full_anno(L, St2),
{annotate_cons(A, H1, T1, St2),Hps ++ Tps,St2};
expr({lc,L,E,Qs0}, St0) ->
{Qs1,St1} = preprocess_quals(L, Qs0, St0),
lc_tq(L, E, Qs1, #c_literal{anno=lineno_anno(L, St1),val=[]}, St1);
expr({bc,L,E,Qs}, St) ->
- bc_tq(L, E, Qs, {nil,L}, St);
+ bc_tq(L, E, Qs, St);
expr({tuple,L,Es0}, St0) ->
{Es1,Eps,St1} = safe_list(Es0, St0),
A = record_anno(L, St1),
{annotate_tuple(A, Es1, St1),Eps,St1};
expr({map,L,Es0}, St0) ->
- % erl_lint should make sure only #{ K => V } are allowed
- % in map construction.
- try map_pair_list(Es0, St0) of
- {Es1,Eps,St1} ->
- A = lineno_anno(L, St1),
- {ann_c_map(A,Es1),Eps,St1}
- catch
- throw:{bad_map,Warning} ->
- St = add_warning(L, Warning, St0),
- LineAnno = lineno_anno(L, St),
- As = [#c_literal{anno=LineAnno,val=badarg}],
- {#icall{anno=#a{anno=LineAnno}, %Must have an #a{}
- module=#c_literal{anno=LineAnno,val=erlang},
- name=#c_literal{anno=LineAnno,val=error},
- args=As},[],St}
- end;
+ map_build_pairs(#c_literal{val=#{}}, Es0, full_anno(L, St0), St0);
expr({map,L,M0,Es0}, St0) ->
try expr_map(M0,Es0,lineno_anno(L, St0),St0) of
{_,_,_}=Res -> Res
@@ -544,7 +552,7 @@ expr({map,L,M0,Es0}, St0) ->
args=As},[],St}
end;
expr({bin,L,Es0}, St0) ->
- try expr_bin(Es0, lineno_anno(L, St0), St0) of
+ try expr_bin(Es0, full_anno(L, St0), St0) of
{_,_,_}=Res -> Res
catch
throw:bad_binary ->
@@ -562,26 +570,26 @@ expr({block,_,Es0}, St0) ->
{E1,Eps,St2} = expr(last(Es0), St1),
{E1,Es1 ++ Eps,St2};
expr({'if',L,Cs0}, St0) ->
- {Cs1,St1} = clauses(Cs0, St0),
+ {Cs1,Ceps,St1} = clauses(Cs0, St0),
Lanno = lineno_anno(L, St1),
Fc = fail_clause([], Lanno, #c_literal{val=if_clause}),
- {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},[],St1};
+ {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},Ceps,St1};
expr({'case',L,E0,Cs0}, St0) ->
{E1,Eps,St1} = novars(E0, St0),
- {Cs1,St2} = clauses(Cs0, St1),
+ {Cs1,Ceps,St2} = clauses(Cs0, St1),
{Fpat,St3} = new_var(St2),
Lanno = lineno_anno(L, St2),
Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=case_clause},Fpat])),
- {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps,St3};
+ {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps++Ceps,St3};
expr({'receive',L,Cs0}, St0) ->
- {Cs1,St1} = clauses(Cs0, St0),
- {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1}, [], St1};
+ {Cs1,Ceps,St1} = clauses(Cs0, St0),
+ {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1},Ceps, St1};
expr({'receive',L,Cs0,Te0,Tes0}, St0) ->
{Te1,Teps,St1} = novars(Te0, St0),
{Tes1,St2} = exprs(Tes0, St1),
- {Cs1,St3} = clauses(Cs0, St2),
+ {Cs1,Ceps,St3} = clauses(Cs0, St2),
{#ireceive2{anno=#a{anno=lineno_anno(L, St3)},
- clauses=Cs1,timeout=Te1,action=Tes1},Teps,St3};
+ clauses=Cs1,timeout=Te1,action=Tes1},Teps++Ceps,St3};
expr({'try',L,Es0,[],Ecs,[]}, St0) ->
%% 'try ... catch ... end'
{Es1,St1} = exprs(Es0, St0),
@@ -595,7 +603,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) ->
%% 'try ... of ... catch ... end'
{Es1,St1} = exprs(Es0, St0),
{V,St2} = new_var(St1), %This name should be arbitrary
- {Cs1,St3} = clauses(Cs0, St2),
+ {Cs1,Ceps,St3} = clauses(Cs0, St2),
{Fpat,St4} = new_var(St3),
Lanno = lineno_anno(L, St4),
Fc = fail_clause([Fpat], Lanno,
@@ -604,7 +612,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) ->
{#itry{anno=#a{anno=lineno_anno(L, St5)},args=Es1,
vars=[V],body=[#icase{anno=#a{anno=Lanno},args=[V],clauses=Cs1,fc=Fc}],
evars=Evs,handler=Hs},
- [],St5};
+ Ceps,St5};
expr({'try',L,Es0,[],[],As0}, St0) ->
%% 'try ... after ... end'
{Es1,St1} = exprs(Es0, St0),
@@ -634,11 +642,11 @@ expr({'catch',L,E0}, St0) ->
Lanno = lineno_anno(L, St1),
{#icatch{anno=#a{anno=Lanno},body=Eps ++ [E1]},[],St1};
expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) ->
- Lanno = lineno_anno(L, St),
+ Lanno = full_anno(L, St),
{#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St};
expr({'fun',L,{function,M,F,A}}, St0) ->
{As,Aps,St1} = safe_list([M,F,A], St0),
- Lanno = lineno_anno(L, St1),
+ Lanno = full_anno(L, St1),
{#icall{anno=#a{anno=Lanno},
module=#c_literal{val=erlang},
name=#c_literal{val=make_fun},
@@ -649,13 +657,9 @@ expr({named_fun,L,'_',Cs,Id}, St) ->
fun_tq(Id, Cs, L, St, unnamed);
expr({named_fun,L,Name,Cs,Id}, St) ->
fun_tq(Id, Cs, L, St, {named,Name});
-expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) ->
+expr({call,L,{remote,_,M,F},As0}, St0) ->
{[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0),
- Lanno = lineno_anno(L, St1),
- Anno = case Wanted of
- false -> [result_not_wanted|Lanno];
- true -> Lanno
- end,
+ Anno = full_anno(L, St1),
{#icall{anno=#a{anno=Anno},module=M1,name=F1,args=As1},Aps,St1};
expr({call,Lc,{atom,Lf,F},As0}, St0) ->
{As1,Aps,St1} = safe_list(As0, St0),
@@ -673,24 +677,24 @@ expr({match,L,P0,E0}, St0) ->
{var,_,'_'} -> St0#core{wanted=false};
_ -> St0
end,
- {E2,Eps,St2} = novars(E1, St1),
+ {E2,Eps1,St2} = novars(E1, St1),
St3 = St2#core{wanted=St0#core.wanted},
- P2 = try
- pattern(P1, St3)
+ {P2,Eps2,St4} = try
+ pattern(P1, St3)
catch
throw:Thrown ->
- Thrown
+ {Thrown,[],St3}
end,
- {Fpat,St4} = new_var(St3),
- Lanno = lineno_anno(L, St4),
+ {Fpat,St5} = new_var(St4),
+ Lanno = lineno_anno(L, St5),
Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])),
case P2 of
nomatch ->
- St = add_warning(L, nomatch, St4),
+ St = add_warning(L, nomatch, St5),
{#icase{anno=#a{anno=Lanno},
- args=[E2],clauses=[],fc=Fc},Eps,St};
+ args=[E2],clauses=[],fc=Fc},Eps1++Eps2,St};
Other when not is_atom(Other) ->
- {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4}
+ {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1++Eps2,St5}
end;
expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) ->
%% Optimise '++' here because of the list comprehension algorithm.
@@ -704,26 +708,28 @@ expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) ->
{Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St2),
{Y,Mps++Yps,St};
expr({op,L,'andalso',E1,E2}, St0) ->
- {#c_var{name=V0},St} = new_var(L, St0),
+ Anno = lineno_anno(L, St0),
+ {#c_var{name=V0},St} = new_var(Anno, St0),
V = {var,L,V0},
False = {atom,L,false},
E = make_bool_switch(L, E1, V, E2, False, St0),
expr(E, St);
expr({op,L,'orelse',E1,E2}, St0) ->
- {#c_var{name=V0},St} = new_var(L, St0),
+ Anno = lineno_anno(L, St0),
+ {#c_var{name=V0},St} = new_var(Anno, St0),
V = {var,L,V0},
True = {atom,L,true},
E = make_bool_switch(L, E1, V, True, E2, St0),
expr(E, St);
expr({op,L,Op,A0}, St0) ->
{A1,Aps,St1} = safe(A0, St0),
- LineAnno = lineno_anno(L, St1),
+ LineAnno = full_anno(L, St1),
{#icall{anno=#a{anno=LineAnno}, %Must have an #a{}
module=#c_literal{anno=LineAnno,val=erlang},
name=#c_literal{anno=LineAnno,val=Op},args=[A1]},Aps,St1};
expr({op,L,Op,L0,R0}, St0) ->
{As,Aps,St1} = safe_list([L0,R0], St0),
- LineAnno = lineno_anno(L, St1),
+ LineAnno = full_anno(L, St1),
{#icall{anno=#a{anno=LineAnno}, %Must have an #a{}
module=#c_literal{anno=LineAnno,val=erlang},
name=#c_literal{anno=LineAnno,val=Op},args=As},Aps,St1}.
@@ -752,83 +758,58 @@ 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};
- {_,_} ->
- {Es1,Eps,St2} = map_pair_list(Es0, St1),
- {ann_c_map(A,M1,Es1),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) ->
+ {Es,Pre,St1} = map_build_pairs_1(Es0, St0),
+ {ann_c_map(Ann, Map, Es),Pre,St1}.
+
+map_build_pairs_1([{Op0,L,K0,V0}|Es], St0) ->
+ {K,Pre0,St1} = safe(K0, St0),
+ {V,Pre1,St2} = safe(V0, St1),
+ {Pairs,Pre2,St3} = map_build_pairs_1(Es, St2),
+ As = lineno_anno(L, St3),
+ Op = map_op(Op0),
+ Pair = cerl:ann_c_map_pair(As, Op, K, V),
+ {[Pair|Pairs],Pre0++Pre1++Pre2,St3};
+map_build_pairs_1([], St) ->
+ {[],[],St}.
+
+map_op(map_field_assoc) -> #c_literal{val=assoc};
+map_op(map_field_exact) -> #c_literal{val=exact}.
+
is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true;
-is_valid_map_src(#c_map{}) -> true;
is_valid_map_src(#c_var{}) -> true;
is_valid_map_src(_) -> false.
-map_pair_list(Es, St) ->
- foldr(fun
- ({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) ->
- {K1,Ep0,St1} = safe(K0, St0),
- K = ensure_valid_map_key(K1),
- {V,Ep1,St2} = safe(V0, St1),
- A = lineno_anno(L, St2),
- Pair = #c_map_pair{op=#c_literal{val=assoc},anno=A,key=K,val=V},
- {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2};
- ({map_field_exact,L,K0,V0}, {Ces,Esp,St0}) ->
- {K1,Ep0,St1} = safe(K0, St0),
- K = ensure_valid_map_key(K1),
- {V,Ep1,St2} = safe(V0, St1),
- A = lineno_anno(L, St2),
- Pair = #c_map_pair{op=#c_literal{val=exact},anno=A,key=K,val=V},
- {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2}
- end, {[],[],St}, Es).
-
-ensure_valid_map_key(K0) ->
- case coalesced_map_key(K0) of
- {ok,K1} -> K1;
- error -> throw({bad_map,bad_map_key})
- end.
-
-coalesced_map_key(#c_literal{}=K) -> {ok,K};
-%% Dialyzer hack redux
-%% DO coalesce tuples and list in maps for dialyzer
-%% Dialyzer tries to break this apart, don't let it
-coalesced_map_key(#c_tuple{}=K) ->
- case core_lib:is_literal(K) of
- true -> {ok,cerl:fold_literal(K)};
- false -> error
- end;
-coalesced_map_key(#c_cons{}=K) ->
- case core_lib:is_literal(K) of
- true -> {ok,cerl:fold_literal(K)};
- false -> error
- end;
-coalesced_map_key(_) -> error.
-
%% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}.
try_exception(Ecs0, St0) ->
%% Note that Tag is not needed for rethrow - it is already in Info.
{Evs,St1} = new_vars(3, St0), % Tag, Value, Info
- {Ecs1,St2} = clauses(Ecs0, St1),
+ {Ecs1,Ceps,St2} = clauses(Ecs0, St1),
[_,Value,Info] = Evs,
Ec = #iclause{anno=#a{anno=[compiler_generated]},
pats=[c_tuple(Evs)],guard=[#c_literal{val=true}],
@@ -836,15 +817,15 @@ try_exception(Ecs0, St0) ->
name=#c_literal{val=raise},
args=[Info,Value]}]},
Hs = [#icase{anno=#a{},args=[c_tuple(Evs)],clauses=Ecs1,fc=Ec}],
- {Evs,Hs,St2}.
+ {Evs,Ceps++Hs,St2}.
try_after(As, St0) ->
%% See above.
- {Evs,St1} = new_vars(3, St0), % Tag, Value, Info
+ {Evs,St1} = new_vars(3, St0), % Tag, Value, Info
[_,Value,Info] = Evs,
- B = As ++ [#iprimop{anno=#a{}, %Must have an #a{}
- name=#c_literal{val=raise},
- args=[Info,Value]}],
+ B = As ++ [#iprimop{anno=#a{}, % Must have an #a{}
+ name=#c_literal{val=raise},
+ args=[Info,Value]}],
Ec = #iclause{anno=#a{anno=[compiler_generated]},
pats=[c_tuple(Evs)],guard=[#c_literal{val=true}],
body=B},
@@ -978,20 +959,21 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) ->
fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) ->
Arity = clause_arity(hd(Cs0)),
- {Cs1,St1} = clauses(Cs0, St0),
+ {Cs1,Ceps,St1} = clauses(Cs0, St0),
{Args,St2} = new_vars(Arity, St1),
{Ps,St3} = new_vars(Arity, St2), %Need new variables here
- Anno = lineno_anno(L, St3),
+ Anno = full_anno(L, St3),
Fc = function_clause(Ps, Anno, {Name,Arity}),
Fun = #ifun{anno=#a{anno=Anno},
id=[{id,Id}], %We KNOW!
vars=Args,clauses=Cs1,fc=Fc,name=NameInfo},
- {Fun,[],St3}.
+ {Fun,Ceps,St3}.
%% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}.
%% This TQ from Simon PJ pp 127-138.
-lc_tq(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard,
+lc_tq(Line, E, [#igen{anno=GAnno,ceps=Ceps,
+ acc_pat=AccPat,acc_guard=AccGuard,
skip_pat=SkipPat,tail=Tail,tail_pat=TailPat,
arg={Pre,Arg}}|Qs], Mc, St0) ->
{Name,St1} = new_fun_name("lc", St0),
@@ -1026,7 +1008,7 @@ lc_tq(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard,
Fun = #ifun{anno=LAnno,id=[],vars=[Var],clauses=Cs,fc=Fc},
{#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,1},Fun}],
body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg]}]},
- [],St4};
+ Ceps,St4};
lc_tq(Line, E, [#ifilter{}=Filter|Qs], Mc, St) ->
filter_tq(Line, E, Filter, Mc, St, Qs, fun lc_tq/5);
lc_tq(Line, E0, [], Mc0, St0) ->
@@ -1040,7 +1022,7 @@ lc_tq(Line, E0, [], Mc0, St0) ->
%% This TQ from Gustafsson ERLANG'05.
%% More could be transformed before calling bc_tq.
-bc_tq(Line, Exp, Qs0, _, St0) ->
+bc_tq(Line, Exp, Qs0, St0) ->
{BinVar,St1} = new_var(St0),
{Sz,SzPre,St2} = bc_initial_size(Exp, Qs0, St1),
{Qs,St3} = preprocess_quals(Line, Qs0, St2),
@@ -1051,7 +1033,8 @@ bc_tq(Line, Exp, Qs0, _, St0) ->
args=[Sz]}}] ++ BcPre,
{E,Pre,St}.
-bc_tq1(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard,
+bc_tq1(Line, E, [#igen{anno=GAnno,ceps=Ceps,
+ acc_pat=AccPat,acc_guard=AccGuard,
skip_pat=SkipPat,tail=Tail,tail_pat=TailPat,
arg={Pre,Arg}}|Qs], Mc, St0) ->
{Name,St1} = new_fun_name("lbc", St0),
@@ -1089,7 +1072,7 @@ bc_tq1(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard,
Fun = #ifun{anno=LAnno,id=[],vars=Vars,clauses=Cs,fc=Fc},
{#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,2},Fun}],
body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg,Mc]}]},
- [],St4};
+ Ceps,St4};
bc_tq1(Line, E, [#ifilter{}=Filter|Qs], Mc, St) ->
filter_tq(Line, E, Filter, Mc, St, Qs, fun bc_tq1/5);
bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) ->
@@ -1153,7 +1136,7 @@ preprocess_quals(Line, [Q|Qs0], St0, Acc) ->
{Gen,St} = generator(Line, Q, Gs, St0),
preprocess_quals(Line, Qs, St, [Gen|Acc]);
false ->
- LAnno = #a{anno=lineno_anno(get_anno(Q), St0)},
+ LAnno = #a{anno=lineno_anno(get_qual_anno(Q), St0)},
case is_guard_test(Q) of
true ->
%% When a filter is a guard test, its argument in the
@@ -1178,6 +1161,11 @@ is_generator({generate,_,_,_}) -> true;
is_generator({b_generate,_,_,_}) -> true;
is_generator(_) -> false.
+%% Retrieve the annotation from an Erlang AST form.
+%% (Use get_anno/1 to retrieve the annotation from Core Erlang forms).
+
+get_qual_anno(Abstract) -> element(2, Abstract).
+
%%
%% Generators are abstracted as sextuplets:
%% - acc_pat is the accumulator pattern, e.g. [Pat|Tail] for Pat <- Expr.
@@ -1200,7 +1188,7 @@ is_generator(_) -> false.
generator(Line, {generate,Lg,P0,E}, Gs, St0) ->
LA = lineno_anno(Line, St0),
GA = lineno_anno(Lg, St0),
- {Head,St1} = list_gen_pattern(P0, Line, St0),
+ {Head,Ceps,St1} = list_gen_pattern(P0, Line, St0),
{[Tail,Skip],St2} = new_vars(2, St1),
{Cg,St3} = lc_guard_tests(Gs, St2),
{AccPat,SkipPat} = case Head of
@@ -1220,25 +1208,27 @@ generator(Line, {generate,Lg,P0,E}, Gs, St0) ->
ann_c_cons(LA, Skip, Tail)}
end,
{Ce,Pre,St4} = safe(E, St3),
- Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat,
+ Gen = #igen{anno=#a{anno=GA},ceps=Ceps,
+ acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat,
tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Pre,Ce}},
{Gen,St4};
generator(Line, {b_generate,Lg,P,E}, Gs, St0) ->
LA = lineno_anno(Line, St0),
GA = lineno_anno(Lg, St0),
- Cp = #c_binary{segments=Segs} = pattern(P, St0),
+ {Cp = #c_binary{segments=Segs},[],St1} = pattern(P, St0),
+
%% The function append_tail_segment/2 keeps variable patterns as-is, making
%% it possible to have the same skip clause removal as with list generators.
- {AccSegs,Tail,TailSeg,St1} = append_tail_segment(Segs, St0),
+ {AccSegs,Tail,TailSeg,St2} = append_tail_segment(Segs, St1),
AccPat = Cp#c_binary{segments=AccSegs},
- {Cg,St2} = lc_guard_tests(Gs, St1),
- {SkipSegs,St3} = emasculate_segments(AccSegs, St2),
+ {Cg,St3} = lc_guard_tests(Gs, St2),
+ {SkipSegs,St4} = emasculate_segments(AccSegs, St3),
SkipPat = Cp#c_binary{segments=SkipSegs},
- {Ce,Pre,St4} = safe(E, St3),
+ {Ce,Pre,St5} = safe(E, St4),
Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat,
tail=Tail,tail_pat=#c_binary{anno=LA,segments=[TailSeg]},
arg={Pre,Ce}},
- {Gen,St4}.
+ {Gen,St5}.
append_tail_segment(Segs, St0) ->
{Var,St} = new_var(St0),
@@ -1267,9 +1257,9 @@ lc_guard_tests(Gs0, St0) ->
list_gen_pattern(P0, Line, St) ->
try
- {pattern(P0, St),St}
+ pattern(P0,St)
catch
- nomatch -> {nomatch,add_warning(Line, nomatch, St)}
+ nomatch -> {nomatch,[],add_warning(Line, nomatch, St)}
end.
%%%
@@ -1489,9 +1479,22 @@ force_novars(#iapply{}=App, St) -> {App,[],St};
force_novars(#icall{}=Call, St) -> {Call,[],St};
force_novars(#ifun{}=Fun, St) -> {Fun,[],St}; %These are novars too
force_novars(#ibinary{}=Bin, St) -> {Bin,[],St};
+force_novars(#c_map{}=Bin, St) -> {Bin,[],St};
force_novars(Ce, St) ->
force_safe(Ce, St).
+
+%% safe_pattern_expr(Expr, State) -> {Cexpr,[PreExpr],State}.
+%% only literals and variables are safe expressions in patterns
+safe_pattern_expr(E,St0) ->
+ case safe(E,St0) of
+ {#c_var{},_,_}=Safe -> Safe;
+ {#c_literal{},_,_}=Safe -> Safe;
+ {Ce,Eps,St1} ->
+ {V,St2} = new_var(St1),
+ {V,Eps++[#iset{var=V,arg=Ce}],St2}
+ end.
+
%% safe(Expr, State) -> {Safe,[PreExpr],State}.
%% Generate an internal safe expression. These are simples without
%% binaries which can fail. At this level we do not need to do a
@@ -1566,90 +1569,90 @@ fold_match({match,L,P0,E0}, P) ->
{{match,L,P0,P1},E1};
fold_match(E, P) -> {P,E}.
-%% pattern(Pattern, State) -> CorePat.
+%% pattern(Pattern, State) -> {CorePat,[PreExp],State}.
%% Transform a pattern by removing line numbers. We also normalise
%% aliases in patterns to standard form, {alias,Pat,[Var]}.
-
-pattern({var,L,V}, St) -> #c_var{anno=lineno_anno(L, St),name=V};
-pattern({char,L,C}, St) -> #c_literal{anno=lineno_anno(L, St),val=C};
-pattern({integer,L,I}, St) -> #c_literal{anno=lineno_anno(L, St),val=I};
-pattern({float,L,F}, St) -> #c_literal{anno=lineno_anno(L, St),val=F};
-pattern({atom,L,A}, St) -> #c_literal{anno=lineno_anno(L, St),val=A};
-pattern({string,L,S}, St) -> #c_literal{anno=lineno_anno(L, St),val=S};
-pattern({nil,L}, St) -> #c_literal{anno=lineno_anno(L, St),val=[]};
+%%
+%% In patterns we may have expressions
+%% 1) Binaries -> #c_bitstr{size=Expr}
+%% 2) Maps -> #c_map_pair{key=Expr}
+%%
+%% Both of these may generate pre-expressions since only bound variables
+%% or literals are allowed for these in core patterns.
+%%
+%% Therefor, we need to drag both the state and the collection of pre-expression
+%% around in the whole pattern transformation tree.
+
+pattern({var,L,V}, St) -> {#c_var{anno=lineno_anno(L, St),name=V},[],St};
+pattern({char,L,C}, St) -> {#c_literal{anno=lineno_anno(L, St),val=C},[],St};
+pattern({integer,L,I}, St) -> {#c_literal{anno=lineno_anno(L, St),val=I},[],St};
+pattern({float,L,F}, St) -> {#c_literal{anno=lineno_anno(L, St),val=F},[],St};
+pattern({atom,L,A}, St) -> {#c_literal{anno=lineno_anno(L, St),val=A},[],St};
+pattern({string,L,S}, St) -> {#c_literal{anno=lineno_anno(L, St),val=S},[],St};
+pattern({nil,L}, St) -> {#c_literal{anno=lineno_anno(L, St),val=[]},[],St};
pattern({cons,L,H,T}, St) ->
- annotate_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St), St);
+ {Ph,Eps1,St1} = pattern(H, St),
+ {Pt,Eps2,St2} = pattern(T, St1),
+ {annotate_cons(lineno_anno(L, St), Ph, Pt, St2),Eps1++Eps2,St2};
pattern({tuple,L,Ps}, St) ->
- annotate_tuple(record_anno(L, St), pattern_list(Ps, St), St);
-pattern({map,L,Ps}, St) ->
- #c_map{anno=lineno_anno(L, St), es=pattern_map_pairs(Ps, St)};
+ {Ps1,Eps,St1} = pattern_list(Ps,St),
+ {annotate_tuple(record_anno(L, St), Ps1, St),Eps,St1};
+pattern({map,L,Pairs}, St0) ->
+ {Ps,Eps,St1} = pattern_map_pairs(Pairs, St0),
+ {#c_map{anno=lineno_anno(L, St1),es=Ps,is_pat=true},Eps,St1};
pattern({bin,L,Ps}, St) ->
%% We don't create a #ibinary record here, since there is
%% no need to hold any used/new annotations in a pattern.
- #c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)};
+ {#c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)},[],St};
pattern({match,_,P1,P2}, St) ->
- pat_alias(pattern(P1, St), pattern(P2, St)).
+ {Cp1,Eps1,St1} = pattern(P1,St),
+ {Cp2,Eps2,St2} = pattern(P2,St1),
+ {pat_alias(Cp1,Cp2),Eps1++Eps2,St2}.
%% pattern_map_pairs([MapFieldExact],State) -> [#c_map_pairs{}]
pattern_map_pairs(Ps, St) ->
- %% check literal key uniqueness (dict is needed)
- %% pattern all pairs
- {CMapPairs, Kdb} = lists:mapfoldl(fun
- (P,Kdbi) ->
- #c_map_pair{key=Ck,val=Cv} = CMapPair = pattern_map_pair(P,St),
- K = core_lib:literal_value(Ck),
- case dict:find(K,Kdbi) of
- {ok, Vs} ->
- {CMapPair, dict:store(K,[Cv|Vs],Kdbi)};
- _ ->
- {CMapPair, dict:store(K,[Cv],Kdbi)}
- end
- end, dict:new(), Ps),
- pattern_alias_map_pairs(CMapPairs,Kdb,dict:new(),St).
-
-pattern_alias_map_pairs([],_,_,_) -> [];
-pattern_alias_map_pairs([#c_map_pair{key=Ck}=Pair|Pairs],Kdb,Kset,St) ->
- %% alias same keys if needed
- K = core_lib:literal_value(Ck),
- case dict:find(K,Kset) of
- {ok,processed} ->
- pattern_alias_map_pairs(Pairs,Kdb,Kset,St);
- _ ->
- Cvs = dict:fetch(K,Kdb),
- Cv = pattern_alias_map_pair_patterns(Cvs),
- Kset1 = dict:store(K, processed, Kset),
- [Pair#c_map_pair{val=Cv}|pattern_alias_map_pairs(Pairs,Kdb,Kset1,St)]
- end.
-
-pattern_alias_map_pair_patterns([Cv]) -> Cv;
-pattern_alias_map_pair_patterns([Cv1,Cv2|Cvs]) ->
- pattern_alias_map_pair_patterns([pat_alias(Cv1,Cv2)|Cvs]).
-
-pattern_map_pair({map_field_exact,L,K,V},St) ->
- #c_map_pair{anno=lineno_anno(L, St),
- op=#c_literal{val=exact},
- key=pattern_map_key(K,St),
- val=pattern(V, St)}.
-
-pattern_map_key(K,St) ->
- %% Throws 'nomatch' if the key can't be a literal
- %% this will be a cryptic error message but it is better than nothing
- case expr(K,St) of
- {Key0,[],_} ->
- %% Dialyzer hack redux
- case coalesced_map_key(Key0) of
- {ok,Key1} -> Key1;
- error -> throw(nomatch)
- end;
- _ -> throw(nomatch)
- end.
+ %% check literal key uniqueness
+ %% - guaranteed via aliasing map pairs
+ %% pattern all pairs in two steps
+ %% 1) Construct Core Pattern
+ %% 2) Alias Keys in Core Pattern
+ {CMapPairs, {Eps,St1}} = lists:mapfoldl(fun
+ (P,{EpsM,Sti0}) ->
+ {CMapPair,EpsP,Sti1} = pattern_map_pair(P,Sti0),
+ {CMapPair, {EpsM++EpsP,Sti1}}
+ end, {[],St}, Ps),
+ {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),
+ {Cv,EpsV,St2} = pattern(V, St1),
+ {#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].
-pat_segment({bin_element,_,Term,Size,[Type,{unit,Unit}|Flags]}, St) ->
- #c_bitstr{val=pattern(Term, St),size=pattern(Size, St),
+pat_segment({bin_element,_,Val,Size,[Type,{unit,Unit}|Flags]}, St) ->
+ {Pval,[],St1} = pattern(Val,St),
+ {Psize,[],_St2} = pattern(Size,St1),
+ #c_bitstr{val=Pval,size=Psize,
unit=#c_literal{val=Unit},
type=#c_literal{val=Type},
flags=#c_literal{val=Flags}}.
@@ -1657,38 +1660,55 @@ pat_segment({bin_element,_,Term,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};
-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));
-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));
-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].
@@ -1697,9 +1717,15 @@ pat_alias_list([A1|A1s], [A2|A2s]) ->
pat_alias_list([], []) -> [];
pat_alias_list(_, _) -> throw(nomatch).
-%% pattern_list([P], State) -> [P].
+%% pattern_list([P], State) -> {[P],Exprs,St}
+
+pattern_list([P0|Ps0], St0) ->
+ {P1,Eps,St1} = pattern(P0, St0),
+ {Ps1,Epsl,St2} = pattern_list(Ps0, St1),
+ {[P1|Ps1], Eps ++ Epsl, St2};
+pattern_list([], St) ->
+ {[],[],St}.
-pattern_list(Ps, St) -> [pattern(P, St) || P <- Ps].
%% make_vars([Name]) -> [{Var,Name}].
@@ -1721,7 +1747,7 @@ new_var_name(#core{vcount=C}=St) ->
new_var(St) ->
new_var([], St).
-new_var(Anno, St0) ->
+new_var(Anno, St0) when is_list(Anno) ->
{New,St} = new_var_name(St0),
{#c_var{anno=Anno,name=New},St}.
@@ -1779,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}.
@@ -1948,11 +1974,11 @@ uexpr(#ibinary{anno=A,segments=Ss}, _, St) ->
uexpr(#c_literal{}=Lit, _, St) ->
Anno = get_anno(Lit),
{set_anno(Lit, #a{us=[],anno=Anno}),St};
-uexpr(Lit, _, St) ->
- true = is_simple(Lit), %Sanity check!
- Vs = lit_vars(Lit),
- Anno = get_anno(Lit),
- {set_anno(Lit, #a{us=Vs,anno=Anno}),St}.
+uexpr(Simple, _, St) ->
+ true = is_simple(Simple), %Sanity check!
+ Vs = lit_vars(Simple),
+ Anno = get_anno(Simple),
+ {#isimple{anno=#a{us=Vs,anno=Anno},term=Simple},St}.
uexpr_list(Les0, Ks, St0) ->
mapfoldl(fun (Le, St) -> uexpr(Le, Ks, St) end, St0, Les0).
@@ -1966,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}.
@@ -1999,9 +2025,14 @@ upattern(#c_tuple{es=Es0}=Tuple, Ks, St0) ->
upattern(#c_map{es=Es0}=Map, Ks, St0) ->
{Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0),
{Map#c_map{es=Es1},Esg,Esv,Eus,St1};
-upattern(#c_map_pair{op=#c_literal{val=exact},val=V0}=MapPair, Ks, St0) ->
- {V,Vg,Vv,Vu,St1} = upattern(V0, Ks, St0),
- {MapPair#c_map_pair{val=V},Vg,Vv,Vu,St1};
+upattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,Ks,St0) ->
+ {V,Vg,Vn,Vu,St1} = upattern(V0, Ks, St0),
+ % A variable key must be considered used here
+ Ku = case K0 of
+ #c_var{name=Name} -> [Name];
+ _ -> []
+ end,
+ {Pair#c_map_pair{val=V},Vg,Vn,union(Ku,Vu),St1};
upattern(#c_binary{segments=Es0}=Bin, Ks, St0) ->
{Es1,Esg,Esv,Eus,St1} = upat_bin(Es0, Ks, St0),
{Bin#c_binary{segments=Es1},Esg,Esv,Eus,St1};
@@ -2124,7 +2155,8 @@ cguard(Gs, St0) ->
cexprs([#iset{var=#c_var{name=Name}=Var}=Iset], As, St) ->
%% Make return value explicit, and make Var true top level.
- cexprs([Iset,Var#c_var{anno=#a{us=[Name]}}], As, St);
+ Isimple = #isimple{anno=#a{us=[Name]},term=Var},
+ cexprs([Iset,Isimple], As, St);
cexprs([Le], As, St0) ->
{Ce,Es,Us,St1} = cexpr(Le, As, St0),
Exp = make_vars(As), %The export variables
@@ -2239,12 +2271,9 @@ cexpr(#c_literal{}=Lit, _As, St) ->
Anno = get_anno(Lit),
Vs = Anno#a.us,
{set_anno(Lit, Anno#a.anno),[],Vs,St};
-cexpr(Lit, _As, St) ->
- true = is_simple(Lit), %Sanity check!
- Anno = get_anno(Lit),
- Vs = Anno#a.us,
- %%Vs = lit_vars(Lit),
- {set_anno(Lit, Anno#a.anno),[],Vs,St}.
+cexpr(#isimple{anno=#a{us=Vs},term=Simple}, _As, St) ->
+ true = is_simple(Simple), %Sanity check!
+ {Simple,[],Vs,St}.
cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) ->
{Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export!
@@ -2267,11 +2296,6 @@ lit_vars(#c_map_pair{key=K,val=V}, Vs) -> lit_vars(K, lit_vars(V, Vs));
lit_vars(#c_var{name=V}, Vs) -> add_element(V, Vs);
lit_vars(_, Vs) -> Vs. %These are atomic
-% lit_bin_vars(Segs, Vs) ->
-% foldl(fun (#c_bitstr{val=V,size=S}, Vs0) ->
-% lit_vars(V, lit_vars(S, Vs0))
-% end, Vs, Segs).
-
lit_list_vars(Ls) -> lit_list_vars(Ls, []).
lit_list_vars(Ls, Vs) ->
@@ -2290,16 +2314,21 @@ record_anno(L, St) when L >= ?REC_OFFSET ->
true ->
[record | lineno_anno(L - ?REC_OFFSET, St)];
false ->
- lineno_anno(L, St)
+ full_anno(L, St)
end;
record_anno(L, St) when L < -?REC_OFFSET ->
case member(dialyzer, St#core.opts) of
true ->
[record | lineno_anno(L + ?REC_OFFSET, St)];
false ->
- lineno_anno(L, St)
+ full_anno(L, St)
end;
record_anno(L, St) ->
+ full_anno(L, St).
+
+full_anno(L, #core{wanted=false}=St) ->
+ [result_not_wanted|lineno_anno(L, St)];
+full_anno(L, #core{wanted=true}=St) ->
lineno_anno(L, St).
lineno_anno(L, St) ->
@@ -2311,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;
@@ -2372,8 +2395,6 @@ format_error(nomatch) ->
"pattern cannot possibly match";
format_error(bad_binary) ->
"binary construction will fail because of a type mismatch";
-format_error(bad_map_key) ->
- "map construction will fail because of none literal key (large binaries are not literals)";
format_error(bad_map) ->
"map construction will fail because of a type mismatch".
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 40d2f72b4c..0ac1aaf158 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -131,12 +131,12 @@ module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) ->
{ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas,
body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}.
-attributes([{#c_literal{val=Name},Val}|As]) ->
+attributes([{#c_literal{val=Name},#c_literal{val=Val}}|As]) ->
case include_attribute(Name) of
false ->
attributes(As);
true ->
- [{Name,core_lib:literal_value(Val)}|attributes(As)]
+ [{Name,Val}|attributes(As)]
end;
attributes([]) -> [].
@@ -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,82 +496,87 @@ 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) ->
- %% two steps
- %% 1. force variables
- %% 2. remove multiples
- Pairs0 = [{Op,K,V} || #c_map_pair{op=#c_literal{val=Op},key=K,val=V} <- Ces],
+ %% 1. Force variables.
+ %% 2. Group adjacent pairs with literal keys.
+ %% 3. Within each such group, remove multiple assignments to the same key.
+ %% 4. Partition each group according to operator ('=>' and ':=').
+ Pairs0 = [{Op,K,V} ||
+ #c_map_pair{op=#c_literal{val=Op},key=K,val=V} <- Ces],
{Pairs,Esp,St1} = foldr(fun
({Op,K0,V0}, {Ops,Espi,Sti0}) when Op =:= assoc; Op =:= exact ->
- {K,[],Sti1} = expr(K0, Sub, Sti0),
- {V,Ep,Sti2} = atomic(V0, Sub, Sti1),
- {[{Op,K,V}|Ops],Ep ++ Espi,Sti2}
+ {K,Eps1,Sti1} = atomic(K0, Sub, Sti0),
+ {V,Eps2,Sti2} = atomic(V0, Sub, Sti1),
+ {[{Op,K,V}|Ops],Eps1 ++ Eps2 ++ Espi,Sti2}
end, {[],[],St0}, Pairs0),
-
- case map_group_pairs(Pairs) of
- {Assoc,[]} ->
- Kes = [#k_map_pair{key=K,val=V}||{_,{assoc,K,V}} <- Assoc],
- {#k_map{anno=A,op=assoc,var=Var,es=Kes},Esp,St1};
- {[],Exact} ->
- Kes = [#k_map_pair{key=K,val=V}||{_,{exact,K,V}} <- Exact],
- {#k_map{anno=A,op=exact,var=Var,es=Kes},Esp,St1};
- {Assoc,Exact} ->
- Kes1 = [#k_map_pair{key=K,val=V}||{_,{assoc,K,V}} <- Assoc],
- {Mvar,Em,St2} = force_atomic(#k_map{anno=A,op=assoc,var=Var,es=Kes1},St1),
- Kes2 = [#k_map_pair{key=K,val=V}||{_,{exact,K,V}} <- Exact],
- {#k_map{anno=A,op=exact,var=Mvar,es=Kes2},Esp ++ Em,St2}
-
+ map_split_pairs_1(A, Var, Pairs, Esp, St1).
+
+map_split_pairs_1(A, Map0, [{Op,Key,Val}|Pairs1]=Pairs0, Esp0, St0) ->
+ {Map1,Em,St1} = force_atomic(Map0, St0),
+ case Key of
+ #k_var{} ->
+ %% Don't combine variable keys with other keys.
+ Kes = [#k_map_pair{key=Key,val=Val}],
+ Map = #k_map{anno=A,op=Op,var=Map1,es=Kes},
+ map_split_pairs_1(A, Map, Pairs1, Esp0 ++ Em, St1);
+ _ ->
+ %% Literal key. Split off all literal keys.
+ {L,Pairs} = splitwith(fun({_,#k_var{},_}) -> false;
+ ({_,_,_}) -> true
+ end, Pairs0),
+ {Map,Esp,St2} = map_group_pairs(A, Map1, L, Esp0 ++ Em, St1),
+ map_split_pairs_1(A, Map, Pairs, Esp, St2)
+ end;
+map_split_pairs_1(_, Map, [], Esp, St0) ->
+ {Map,Esp,St0}.
+
+map_group_pairs(A, Var, Pairs0, Esp, St0) ->
+ Pairs = map_remove_dup_keys(Pairs0),
+ Assoc = [#k_map_pair{key=K,val=V} || {_,{assoc,K,V}} <- Pairs],
+ Exact = [#k_map_pair{key=K,val=V} || {_,{exact,K,V}} <- Pairs],
+ case {Assoc,Exact} of
+ {[_|_],[]} ->
+ {#k_map{anno=A,op=assoc,var=Var,es=Assoc},Esp,St0};
+ {[],[_|_]} ->
+ {#k_map{anno=A,op=exact,var=Var,es=Exact},Esp,St0};
+ {[_|_],[_|_]} ->
+ Map = #k_map{anno=A,op=assoc,var=Var,es=Assoc},
+ {Mvar,Em,St1} = force_atomic(Map, St0),
+ {#k_map{anno=A,op=exact,var=Mvar,es=Exact},Esp ++ Em,St1}
end.
-%% Group map by Assoc operations and Exact operations
+map_remove_dup_keys(Es) ->
+ dict:to_list(map_remove_dup_keys(Es, dict:new())).
-map_group_pairs(Es) ->
- Groups = dict:to_list(map_group_pairs(Es,dict:new())),
- partition(fun({_,{Op,_,_}}) -> Op =:= assoc end, Groups).
-
-map_group_pairs([{assoc,K,V}|Es0],Used0) ->
- Used1 = case map_key_is_used(K,Used0) of
- {ok, {assoc,_,_}} -> map_key_set_used(K,{assoc,K,V},Used0);
- {ok, {exact,_,_}} -> map_key_set_used(K,{exact,K,V},Used0);
- _ -> map_key_set_used(K,{assoc,K,V},Used0)
- end,
- map_group_pairs(Es0,Used1);
-map_group_pairs([{exact,K,V}|Es0],Used0) ->
- Used1 = case map_key_is_used(K,Used0) of
- {ok, {assoc,_,_}} -> map_key_set_used(K,{assoc,K,V},Used0);
- {ok, {exact,_,_}} -> map_key_set_used(K,{exact,K,V},Used0);
- _ -> map_key_set_used(K,{exact,K,V},Used0)
- end,
- map_group_pairs(Es0,Used1);
-map_group_pairs([],Used) ->
- Used.
-
-map_key_set_used(K,How,Used) ->
- dict:store(map_key_clean(K),How,Used).
-
-map_key_is_used(K,Used) ->
- dict:find(map_key_clean(K),Used).
+map_remove_dup_keys([{assoc,K0,V}|Es0],Used0) ->
+ K = map_key_clean(K0),
+ Op = case dict:find(K, Used0) of
+ {ok,{exact,_,_}} -> exact;
+ _ -> assoc
+ end,
+ Used1 = dict:store(K, {Op,K0,V}, Used0),
+ map_remove_dup_keys(Es0, Used1);
+map_remove_dup_keys([{exact,K0,V}|Es0],Used0) ->
+ K = map_key_clean(K0),
+ Op = case dict:find(K, Used0) of
+ {ok,{assoc,_,_}} -> assoc;
+ _ -> exact
+ end,
+ Used1 = dict:store(K, {Op,K0,V}, Used0),
+ map_remove_dup_keys(Es0, Used1);
+map_remove_dup_keys([], Used) -> Used.
-%% Be explicit instead of using set_kanno(K,[])
-map_key_clean(#k_literal{val=V}) -> {k_literal,V};
-map_key_clean(#k_int{val=V}) -> {k_int,V};
-map_key_clean(#k_float{val=V}) -> {k_float,V};
-map_key_clean(#k_atom{val=V}) -> {k_atom,V};
-map_key_clean(#k_nil{}) -> k_nil.
+%% Be explicit instead of using set_kanno(K, []).
+map_key_clean(#k_var{name=V}) -> {var,V};
+map_key_clean(#k_literal{val=V}) -> {lit,V};
+map_key_clean(#k_int{val=V}) -> {lit,V};
+map_key_clean(#k_float{val=V}) -> {lit,V};
+map_key_clean(#k_atom{val=V}) -> {lit,V};
+map_key_clean(#k_nil{}) -> {lit,[]}.
%% call_type(Module, Function, Arity) -> call | bif | apply | error.
@@ -660,12 +655,12 @@ atomic_bin([#c_bitstr{anno=A,val=E0,size=S0,unit=U0,type=T,flags=Fs0}|Es0],
{E,Ap1,St1} = atomic(E0, Sub, St0),
{S1,Ap2,St2} = atomic(S0, Sub, St1),
validate_bin_element_size(S1),
- U1 = core_lib:literal_value(U0),
- Fs1 = core_lib:literal_value(Fs0),
+ U1 = cerl:concrete(U0),
+ Fs1 = cerl:concrete(Fs0),
{Es,Ap3,St3} = atomic_bin(Es0, Sub, St2),
{#k_bin_seg{anno=A,size=S1,
unit=U1,
- type=core_lib:literal_value(T),
+ type=cerl:concrete(T),
flags=Fs1,
seg=E,next=Es},
Ap1++Ap2++Ap3,St3};
@@ -757,23 +752,22 @@ flatten_alias(#c_alias{var=V,pat=P}) ->
flatten_alias(Pat) -> {[],Pat}.
pattern_map_pairs(Ces0, Isub, Osub0, St0) ->
- %% It is assumed that all core keys are literals
- %% It is later assumed that these keys are term sorted
- %% so we need to sort them here
- Ces1 = lists:sort(fun
- (#c_map_pair{key=CkA},#c_map_pair{key=CkB}) ->
- A = core_lib:literal_value(CkA),
- B = core_lib:literal_value(CkB),
- erts_internal:cmp_term(A,B) < 0
- end, Ces0),
%% pattern the pair keys and values as normal
{Kes,{Osub1,St1}} = lists:mapfoldl(fun
(#c_map_pair{anno=A,key=Ck,val=Cv},{Osubi0,Sti0}) ->
- {Kk,Osubi1,Sti1} = pattern(Ck, Isub, Osubi0, Sti0),
- {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi1, Sti1),
+ {Kk,[],Sti1} = expr(Ck, Isub, Sti0),
+ {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi0, Sti1),
{#k_map_pair{anno=A,key=Kk,val=Kv},{Osubi2,Sti2}}
- end, {Osub0, St0}, Ces1),
- {Kes,Osub1,St1}.
+ end, {Osub0, St0}, Ces0),
+ %% It is later assumed that these keys are term sorted
+ %% so we need to sort them here
+ Kes1 = lists:sort(fun
+ (#k_map_pair{key=KkA},#k_map_pair{key=KkB}) ->
+ A = map_key_clean(KkA),
+ B = map_key_clean(KkB),
+ erts_internal:cmp_term(A,B) < 0
+ end, Kes),
+ {Kes1,Osub1,St1}.
pattern_bin(Es, Isub, Osub0, St0) ->
{Kbin,{_,Osub},St} = pattern_bin_1(Es, Isub, Osub0, St0),
@@ -793,8 +787,8 @@ pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0],
%% problems.
#k_atom{val=bad_size}
end,
- U0 = core_lib:literal_value(U),
- Fs0 = core_lib:literal_value(Fs),
+ U0 = cerl:concrete(U),
+ Fs0 = cerl:concrete(Fs),
%%ok= io:fwrite("~w: ~p~n", [?LINE,{B0,S,U0,Fs0}]),
{E,Osub1,St2} = pattern(E0, Isub0, Osub0, St1),
Isub1 = case E0 of
@@ -805,7 +799,7 @@ pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0],
{Es,{Isub,Osub},St3} = pattern_bin_1(Es0, Isub1, Osub1, St2),
{#k_bin_seg{anno=A,size=S,
unit=U0,
- type=core_lib:literal_value(T),
+ type=cerl:concrete(T),
flags=Fs0,
seg=E,next=Es},
{Isub,Osub},St3};
@@ -1550,13 +1544,11 @@ arg_val(Arg, C) ->
{set_kanno(S, []),U,T,Fs}
end;
#k_map{op=exact,es=Es} ->
- Keys = [begin
- #k_map_pair{key=#k_literal{val=Key}} = Pair,
- Key
- end || Pair <- Es],
- %% multiple keys may have the same name
- %% do not use ordsets
- lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Keys)
+ lists:sort(fun(A,B) ->
+ %% on the form K :: {'lit' | 'var', term()}
+ %% lit < var as intended
+ erts_internal:cmp_term(A,B) < 0
+ end, [map_key_clean(Key) || #k_map_pair{key=Key} <- Es])
end.
%% ubody_used_vars(Expr, State) -> [UsedVar]
@@ -1943,6 +1935,7 @@ lit_list_vars(Ps) ->
%% pat_vars(Pattern) -> {[UsedVarName],[NewVarName]}.
%% Return variables in a pattern. All variables are new variables
%% except those in the size field of binary segments.
+%% and map_pair keys
pat_vars(#k_var{name=N}) -> {[],[N]};
%%pat_vars(#k_char{}) -> {[],[]};
@@ -1967,8 +1960,10 @@ pat_vars(#k_tuple{es=Es}) ->
pat_list_vars(Es);
pat_vars(#k_map{es=Es}) ->
pat_list_vars(Es);
-pat_vars(#k_map_pair{val=V}) ->
- pat_vars(V).
+pat_vars(#k_map_pair{key=K,val=V}) ->
+ {U1,New} = pat_vars(V),
+ {[], U2} = pat_vars(K),
+ {union(U1,U2),New}.
pat_list_vars(Ps) ->
foldl(fun (P, {Used0,New0}) ->
@@ -2009,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_kernel.hrl b/lib/compiler/src/v3_kernel.hrl
index ab66445f73..b008285d9f 100644
--- a/lib/compiler/src/v3_kernel.hrl
+++ b/lib/compiler/src/v3_kernel.hrl
@@ -38,7 +38,7 @@
-record(k_nil, {anno=[]}).
-record(k_tuple, {anno=[],es}).
--record(k_map, {anno=[],var,op,es}).
+-record(k_map, {anno=[],var=#k_literal{val=#{}},op,es}).
-record(k_map_pair, {anno=[],key,val}).
-record(k_cons, {anno=[],hd,tl}).
-record(k_binary, {anno=[],segs}).
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/Makefile b/lib/compiler/test/Makefile
index 0b56a49cd6..73d52a48bc 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -11,6 +11,7 @@ MODULES= \
beam_validator_SUITE \
beam_disasm_SUITE \
beam_except_SUITE \
+ beam_utils_SUITE \
bs_bincomp_SUITE \
bs_bit_binaries_SUITE \
bs_construct_SUITE \
@@ -40,6 +41,7 @@ NO_OPT= \
andor \
apply \
beam_except \
+ beam_utils \
bs_construct \
bs_match \
bs_utf \
@@ -59,6 +61,7 @@ NO_OPT= \
INLINE= \
andor \
apply \
+ beam_utils \
bs_bincomp \
bs_bit_binaries \
bs_construct \
@@ -108,7 +111,7 @@ RELSYSDIR = $(RELEASE_PATH)/compiler_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +clint
+ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +clint +clint0
EBIN = .
diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl
index b5408ecd8f..4d7f444c4f 100644
--- a/lib/compiler/test/andor_SUITE.erl
+++ b/lib/compiler/test/andor_SUITE.erl
@@ -33,7 +33,7 @@ all() ->
[{group,p}].
groups() ->
- [{p,test_lib:parallel(),
+ [{p,[parallel],
[t_case,t_and_or,t_andalso,t_orelse,inside,overlap,
combined,in_case,before_and_inside_if]}].
@@ -173,7 +173,13 @@ t_and_or(Config) when is_list(Config) ->
true = (fun (X = true) when X or true or X -> true end)(True),
- ok.
+ Tuple = id({a,b}),
+ case Tuple of
+ {_,_} ->
+ {'EXIT',{badarg,_}} = (catch true and Tuple)
+ end,
+
+ ok.
t_andalso(Config) when is_list(Config) ->
Bs = [true,false],
@@ -364,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).
@@ -390,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_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl
new file mode 100644
index 0000000000..d2e24cb5ae
--- /dev/null
+++ b/lib/compiler/test/beam_utils_SUITE.erl
@@ -0,0 +1,236 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2015. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(beam_utils_SUITE).
+
+-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ apply_fun/1,apply_mf/1,bs_init/1,bs_save/1,
+ is_not_killed/1,is_not_used_at/1,
+ select/1,y_catch/1]).
+-export([id/1]).
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ test_lib:recompile(?MODULE),
+ [{group,p}].
+
+groups() ->
+ [{p,[parallel],
+ [apply_fun,
+ apply_mf,
+ bs_init,
+ bs_save,
+ is_not_killed,
+ is_not_used_at,
+ select,
+ y_catch
+ ]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+apply_fun(_Config) ->
+ 3 = do_apply_fun(false, false),
+ 3 = do_apply_fun(false, true),
+ 3 = do_apply_fun(true, false),
+ 2 = do_apply_fun(true, true),
+ ok.
+
+do_apply_fun(X, Y) ->
+ F = fun(I) -> I+1 end,
+ Arg = case X andalso id(Y) of
+ true -> 1;
+ false -> 2
+ end,
+ F(Arg).
+
+apply_mf(_Config) ->
+ ok = do_apply_mf_used({a,b}, ?MODULE, id),
+ error = do_apply_mf_used([a], ?MODULE, id),
+ {'EXIT',{{case_clause,{[],b}},_}} = (catch do_apply_mf_used({[],b}, ?MODULE, id)),
+
+ error = do_apply_mf_killed({error,[a]}, ?MODULE, id),
+ ok = do_apply_mf_killed([b], ?MODULE, id),
+ {'EXIT',{{case_clause,{a,[b]}},_}} = (catch do_apply_mf_killed({a,[b]}, ?MODULE, id)),
+ {'EXIT',{{case_clause,{error,[]}},_}} = (catch do_apply_mf_killed({error,[]}, ?MODULE, id)),
+
+ ok.
+
+do_apply_mf_used(Arg, Mod, Func) ->
+ Res = case id(Arg) of
+ {Decoded,_} when Decoded =/= [] ->
+ ok;
+ List when is_list(List) ->
+ error
+ end,
+ Mod:Func(Res).
+
+do_apply_mf_killed(Arg, Mod, Func) ->
+ Res = case id(Arg) of
+ {Tag,Decoded} when Decoded =/= [], Tag =:= error ->
+ error;
+ List when is_list(List) ->
+ ok
+ end,
+ Mod:Func(Res).
+
+bs_init(_Config) ->
+ <<7>> = do_bs_init_1([?MODULE], 7),
+ error = do_bs_init_1([?MODULE], 0.0),
+ error = do_bs_init_1([?MODULE], -43),
+ error = do_bs_init_1([?MODULE], 42),
+
+ <<>> = do_bs_init_2([]),
+ <<0:32,((1 bsl 32)-1):32>> = do_bs_init_2([0,(1 bsl 32)-1]),
+ {'EXIT',{badarg,_}} = (catch do_bs_init_2([0.5])),
+ {'EXIT',{badarg,_}} = (catch do_bs_init_2([-1])),
+ {'EXIT',{badarg,_}} = (catch do_bs_init_2([1 bsl 32])),
+ ok.
+
+do_bs_init_1([?MODULE], Sz) ->
+ if
+ is_integer(Sz), Sz >= -42, Sz < 42 ->
+ id(<<Sz:8>>);
+ true ->
+ error
+ end.
+
+do_bs_init_2(SigNos) ->
+ << <<SigNo:32>> ||
+ SigNo <- SigNos,
+ (is_integer(SigNo) andalso SigNo >= 0 andalso SigNo < (1 bsl 32)) orelse
+ erlang:error(badarg)
+ >>.
+
+
+bs_save(_Config) ->
+ {a,30,<<>>} = do_bs_save(<<1:1,30:5>>),
+ {b,127,<<>>} = do_bs_save(<<1:1,31:5,0:1,127:7>>),
+ {c,127,<<>>} = do_bs_save(<<1:1,31:5,1:1,127:7>>),
+ {c,127,<<>>} = do_bs_save(<<0:1,31:5,1:1,127:7>>),
+ {d,1024,<<>>} = do_bs_save(<<0:1,31:5>>),
+ ok.
+
+do_bs_save(<<_:1, Tag:5, T/binary>>) when Tag < 31 ->
+ {a,Tag,T};
+do_bs_save(<<1:1, 31:5, 0:1, Tag:7, T/binary>>) ->
+ {b,Tag,T};
+do_bs_save(<<_:1, 31:5, 1:1, Tag:7, T/binary>>) ->
+ {c,Tag,T};
+do_bs_save(<<_:1, 31:5, T/binary>>) ->
+ {d,1024,T}.
+
+is_not_killed(_Config) ->
+ {Pid,Ref} = spawn_monitor(fun() -> exit(banan) end),
+ receive
+ {'DOWN', Ref, process, Pid, banan} ->
+ ok
+ end,
+ receive after 0 -> ok end.
+
+is_not_used_at(_Config) ->
+ {a,b} = do_is_not_used_at(a, [{a,b}]),
+ {a,b} = do_is_not_used_at(a, [x,{a,b}]),
+ {a,b} = do_is_not_used_at(a, [{x,y},{a,b}]),
+ none = do_is_not_used_at(z, [{a,b}]),
+ none = do_is_not_used_at(a, [x]),
+ none = do_is_not_used_at(a, [{x,y}]),
+ ok.
+
+do_is_not_used_at(Key, [P|Ps]) ->
+ if
+ tuple_size(P) >= 1, element(1, P) =:= Key ->
+ P;
+ true ->
+ do_is_not_used_at(Key, Ps)
+ end;
+do_is_not_used_at(_Key, []) -> none.
+
+-record(select, {fixed=false}).
+
+select(_Config) ->
+ a = do_select(#select{}, 0, 0),
+ b = do_select(#select{}, 0, 1),
+ c = do_select(#select{fixed=true}, 0, 0),
+ c = do_select(#select{fixed=true}, 0, 1),
+ ok.
+
+do_select(Head, OldSize, BSize) ->
+ Overwrite0 =
+ if
+ OldSize =:= BSize -> same;
+ true -> true
+ end,
+ Overwrite =
+ if
+ Head#select.fixed =/= false ->
+ false;
+ true ->
+ Overwrite0
+ end,
+ if
+ Overwrite =:= same ->
+ a;
+ Overwrite ->
+ b;
+ true ->
+ c
+ end.
+
+y_catch(_Config) ->
+ ok = try
+ do_y_catch(<<"<?xmlX">>, {state}),
+ failed
+ catch
+ throw:{<<"<?xmlX">>,{state}} ->
+ ok
+ end.
+
+do_y_catch(<<"<?xml",Rest0/binary>> = Bytes, State0) ->
+ {Rest1,State1} =
+ case do_y_catch_1(Rest0, State0) of
+ false ->
+ {Bytes,State0};
+ true ->
+ {_XmlAttributes, R, S} = do_y_catch_2(Rest0),
+ {R,S}
+ end,
+ case catch id({Rest1,State1}) of
+ Other ->
+ throw(Other)
+ end.
+
+do_y_catch_1(<<_,_/binary>>, _) ->
+ false.
+
+do_y_catch_2(_) -> {a,b,c}.
+
+
+%% The identity function.
+id(I) -> I.
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index 626f89ba7a..1b1c7db0e8 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -21,16 +21,17 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
- beam_files/1,compiler_bug/1,stupid_but_valid/1,
+ compiler_bug/1,stupid_but_valid/1,
xrange/1,yrange/1,stack/1,call_last/1,merge_undefined/1,
uninit/1,unsafe_catch/1,
- dead_code/1,mult_labels/1,
+ dead_code/1,
overwrite_catchtag/1,overwrite_trytag/1,accessing_tags/1,bad_catch_try/1,
cons_guard/1,
freg_range/1,freg_uninit/1,freg_state/1,
- bin_match/1,bad_bin_match/1,bin_aligned/1,bad_dsetel/1,
+ bad_bin_match/1,bin_aligned/1,bad_dsetel/1,
state_after_fault_in_catch/1,no_exception_in_catch/1,
- undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1]).
+ undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1,
+ map_field_lists/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -47,18 +48,19 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
test_lib:recompile(?MODULE),
- [beam_files,{group,p}].
+ [{group,p}].
groups() ->
[{p,test_lib:parallel(),
[compiler_bug,stupid_but_valid,xrange,
yrange,stack,call_last,merge_undefined,uninit,
- unsafe_catch,dead_code,mult_labels,
+ unsafe_catch,dead_code,
overwrite_catchtag,overwrite_trytag,accessing_tags,
bad_catch_try,cons_guard,freg_range,freg_uninit,
- freg_state,bin_match,bad_bin_match,bin_aligned,bad_dsetel,
+ freg_state,bad_bin_match,bin_aligned,bad_dsetel,
state_after_fault_in_catch,no_exception_in_catch,
- undef_label,illegal_instruction,failing_gc_guard_bif]}].
+ undef_label,illegal_instruction,failing_gc_guard_bif,
+ map_field_lists]}].
init_per_suite(Config) ->
Config.
@@ -72,33 +74,19 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-
-beam_files(Config) when is_list(Config) ->
- ?line DataDir = proplists:get_value(data_dir, Config),
- ?line Wc = filename:join([DataDir,"..","..","*","*.beam"]),
- %% Must have at least two files here, or there will be
- %% a grammatical error in the output of the io:format/2 call below. ;-)
- ?line [_,_|_] = Fs = filelib:wildcard(Wc),
- ?line io:format("~p files\n", [length(Fs)]),
- test_lib:p_run(fun do_beam_file/1, Fs).
-
-
-do_beam_file(F) ->
- case beam_validator:file(F) of
- ok ->
- ok;
- {error,Es} ->
- io:format("File: ~s", [F]),
- io:format("Error: ~p\n", [Es]),
- error
- end.
-
compiler_bug(Config) when is_list(Config) ->
%% Check that the compiler returns an error if we try to
%% assemble one of the bad '.S' files.
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "stack"),
- ?line error = compile:file(File, [asm,report_errors,binary,time]),
+ Data = ?config(data_dir, Config),
+ File = filename:join(Data, "compiler_bug"),
+ error = compile:file(File, [from_asm,report_errors,time]),
+
+ %% Make sure that the error was reported by
+ %% the beam_validator module.
+ {error,
+ [{"compiler_bug",
+ [{beam_validator,_}]}],
+ []} = compile:file(File, [from_asm,return_errors,time]),
ok.
%% The following code is stupid but it should compile.
@@ -134,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}},
@@ -145,31 +133,31 @@ yrange(Config) when is_list(Config) ->
stack(Config) when is_list(Config) ->
Errors = do_val(stack, Config),
- ?line [{{t,a,2},{return,11,{stack_frame,2}}},
- {{t,b,2},{{deallocate,2},4,{allocated,none}}},
- {{t,c,2},{{deallocate,2},12,{allocated,none}}},
- {{t,d,2},
- {{allocate,2,2},5,{existing_stack_frame,{size,2}}}},
- {{t,e,2},{{deallocate,5},6,{allocated,2}}},
- {{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}}}}] = Errors,
+ [{{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},10,{allocated,none}}},
+ {{t,d,2},
+ {{allocate,2,2},5,{existing_stack_frame,{size,2}}}},
+ {{t,e,2},{{deallocate,5},6,{allocated,2}}}] = Errors,
ok.
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),
- ?line [{{t,handle_call,2},
- {{call_ext,2,{extfunc,debug,filter,2}},
- 22,
- {uninitialized_reg,{y,0}}}}] = Errors,
+ [{{t,handle_call,2},
+ {{call_ext,2,{extfunc,debug,filter,2}},
+ 22,
+ {uninitialized_reg,{y,0}}}}] = Errors,
ok.
uninit(Config) when is_list(Config) ->
@@ -178,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,10}},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.
@@ -199,10 +187,6 @@ dead_code(Config) when is_list(Config) ->
[] = do_val(dead_code, Config),
ok.
-mult_labels(Config) when is_list(Config) ->
- [] = do_val(erl_prim_loader, Config, ".beam"),
- ok.
-
overwrite_catchtag(Config) when is_list(Config) ->
Errors = do_val(overwrite_catchtag, Config),
?line
@@ -214,16 +198,15 @@ 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) ->
Errors = do_val(accessing_tags, Config),
- ?line
- [{{accessing_tags,foo,1},
- {{move,{y,0},{x,0}},6,{catchtag,_}}},
- {{accessing_tags,bar,1},
- {{move,{y,0},{x,0}},6,{trytag,_}}}] = Errors,
+ [{{accessing_tags,bar,1},
+ {{move,{y,0},{x,0}},6,{trytag,_}}},
+ {{accessing_tags,foo,1},
+ {{move,{y,0},{x,0}},6,{catchtag,_}}}] = Errors,
ok.
bad_catch_try(Config) when is_list(Config) ->
@@ -310,13 +293,6 @@ freg_state(Config) when is_list(Config) ->
{fclearerror,5,{bad_floating_point_state,cleared}}}] = Errors,
ok.
-bin_match(Config) when is_list(Config) ->
- Errors = do_val(bin_match, Config),
- ?line
- [{{t,t,1},{{bs_save,0},4,no_bs_match_state}},
- {{t,x,1},{{bs_restore,1},16,{no_save_point,1}}}] = Errors,
- ok.
-
bad_bin_match(Config) when is_list(Config) ->
[{{t,t,1},{return,5,{match_context,{x,0}}}}] =
do_val(bad_bin_match, Config),
@@ -340,36 +316,69 @@ bad_dsetel(Config) when is_list(Config) ->
?line
[{{t,t,1},
{{set_tuple_element,{x,1},{x,0},1},
- 15,
+ 17,
illegal_context_for_set_tuple_element}}] = Errors,
ok.
state_after_fault_in_catch(Config) when is_list(Config) ->
Errors = do_val(state_after_fault_in_catch, Config),
- [{{t,foo,1},
- {{move,{x,1},{x,0}},10,{uninitialized_reg,{x,1}}}},
- {{state_after_fault_in_catch,if_end,1},
+ [{{state_after_fault_in_catch,badmatch,1},
{{move,{x,1},{x,0}},9,{uninitialized_reg,{x,1}}}},
{{state_after_fault_in_catch,case_end,1},
{{move,{x,1},{x,0}},9,{uninitialized_reg,{x,1}}}},
- {{state_after_fault_in_catch,badmatch,1},
- {{move,{x,1},{x,0}},9,{uninitialized_reg,{x,1}}}}] = Errors,
+ {{state_after_fault_in_catch,if_end,1},
+ {{move,{x,1},{x,0}},9,{uninitialized_reg,{x,1}}}},
+ {{t,foo,1},
+ {{move,{x,1},{x,0}},10,{uninitialized_reg,{x,1}}}}] = Errors,
ok.
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) ->
- Errors = do_val(undef_label, Config),
+ M = {undef_label,
+ [{t,1}],
+ [],
+ [{function,t,1,2,
+ [{label,1},
+ {func_info,{atom,undef_label},{atom,t},1},
+ {label,2},
+ {test,is_eq_exact,{f,42},[{x,0},{atom,x}]},
+ {move,{atom,ok},{x,0}},
+ return]},
+ {function,x,1,17,
+ [{label,3},
+ {func_info,{atom,undef_label},{atom,x},1},
+ {label,4},
+ return]}],
+ 5},
+ Errors = beam_val(M),
[{{undef_label,t,1},{undef_labels,[42]}},
{{undef_label,x,1},{return,4,no_entry_label}}] = Errors,
ok.
illegal_instruction(Config) when is_list(Config) ->
- Errors = do_val(illegal_instruction, Config),
+ M = {illegal_instruction,
+ [{t,1},{x,1},{y,0}],
+ [],
+ [{function,t,1,2,
+ [{label,1},
+ {func_info,{atom,illegal_instruction},{atom,t},1},
+ {label,2},
+ {my_illegal_instruction,{x,0}},
+ return]},
+ {function,x,1,4,
+ [{label,3},
+ bad_func_info,
+ {label,4},
+ {my_illegal_instruction,{x,0}},
+ return]},
+ {function,y,0,17,[]}],
+ 5},
+ Errors = beam_val(M),
[{{illegal_instruction,t,1},
{{my_illegal_instruction,{x,0}},4,unknown_instruction}},
{{'_',x,1},{bad_func_info,1,illegal_instruction}},
@@ -407,19 +416,40 @@ process_request_foo(_) ->
process_request_bar(Pid, [Response]) when is_pid(Pid) ->
Response.
+map_field_lists(Config) ->
+ Errors = do_val(map_field_lists, Config),
+ [{{map_field_lists,x,1},
+ {{test,has_map_fields,{f,1},{x,0},
+ {list,[{atom,z},{atom,a}]}},
+ 5,
+ not_strict_order}},
+ {{map_field_lists,y,1},
+ {{test,has_map_fields,{f,3},{x,0},{list,[]}},
+ 5,
+ empty_field_list}}
+ ] = Errors.
%%%-------------------------------------------------------------------------
-do_val(Name, Config) ->
- do_val(Name, Config, ".S").
-
-do_val(Name, Config, Type) ->
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, atom_to_list(Name)++Type),
- ?line case beam_validator:file(File) of
- {error,Errors} ->
- ?line io:format("~p:~n~s",
- [File,beam_validator:format_error(Errors)]),
- Errors;
- ok -> []
- end.
+do_val(Mod, Config) ->
+ Data = ?config(data_dir, Config),
+ Base = atom_to_list(Mod),
+ File = filename:join(Data, Base),
+ case compile:file(File, [from_asm,no_postopt,return_errors]) of
+ {error,L,[]} ->
+ [{Base,Errors0}] = L,
+ Errors = [E || {beam_validator,E} <- Errors0],
+ _ = [io:put_chars(beam_validator:format_error(E)) ||
+ E <- Errors],
+ Errors;
+ {ok,Mod} ->
+ []
+ end.
+
+beam_val(M) ->
+ Name = atom_to_list(element(1, M)),
+ {error,[{Name,Errors0}]} = beam_validator:module(M, []),
+ Errors = [E || {beam_validator,E} <- Errors0],
+ _ = [io:put_chars(beam_validator:format_error(E)) ||
+ E <- Errors],
+ Errors.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/bad_dsetel.S b/lib/compiler/test/beam_validator_SUITE_data/bad_dsetel.S
index 279b2fa97f..9630d73a93 100644
--- a/lib/compiler/test/beam_validator_SUITE_data/bad_dsetel.S
+++ b/lib/compiler/test/beam_validator_SUITE_data/bad_dsetel.S
@@ -1,4 +1,4 @@
-{module, t}. %% version = 0
+{module, bad_dsetel}. %% version = 0
{exports, [{module_info,0},{module_info,1},{t,1}]}.
@@ -21,7 +21,9 @@
{move,{integer,3},{x,0}}.
{call_ext,3,{extfunc,erlang,setelement,3}}.
{test_heap,6,1}.
- {put_string,3,{string,"abc"},{x,1}}.
+ {put_list,{integer,99},nil,{x,1}}.
+ {put_list,{integer,98},{x,1},{x,1}}.
+ {put_list,{integer,97},{x,1},{x,1}}.
{set_tuple_element,{x,1},{x,0},1}.
{'%live',1}.
{deallocate,0}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S b/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S
index 2f353fbd25..a59f7ccc03 100644
--- a/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S
+++ b/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S
@@ -1,4 +1,4 @@
-{module, t}. %% version = 0
+{module, bin_aligned}. %% version = 0
{exports, [{decode,1},{module_info,0},{module_info,1}]}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/bin_match.S b/lib/compiler/test/beam_validator_SUITE_data/bin_match.S
deleted file mode 100644
index 96df0f7933..0000000000
--- a/lib/compiler/test/beam_validator_SUITE_data/bin_match.S
+++ /dev/null
@@ -1,64 +0,0 @@
-{module, bin_match}. %% version = 0
-
-{exports, [{t,1}]}.
-
-{attributes, []}.
-
-{labels, 8}.
-
-
-{function, t, 1, 2}.
- {label,1}.
- {func_info,{atom,t},{atom,t},1}.
- {label,2}.
-%% {test,bs_start_match,{f,1},[{x,0}]}.
- {bs_save,0}.
- {test,bs_get_integer,
- {f,3},
- [{integer,8},1,{field_flags,[aligned,unsigned,big]},{x,1}]}.
- {test,bs_get_integer,
- {f,3},
- [{integer,8},1,{field_flags,[aligned,unsigned,big]},{x,2}]}.
- {test,bs_test_tail,{f,3},[0]}.
- {test_heap,3,3}.
- {put_tuple,2,{x,0}}.
- {put,{x,1}}.
- {put,{x,2}}.
- {'%live',1}.
- return.
- {label,3}.
- {bs_restore,0}.
- {test,bs_get_integer,
- {f,1},
- [{integer,32},1,{field_flags,[aligned,unsigned,big]},{x,1}]}.
- {test,bs_test_tail,{f,1},[0]}.
- {move,{x,1},{x,0}}.
- return.
-
-{function, x, 1, 5}.
- {label,4}.
- {func_info,{atom,t},{atom,x},1}.
- {label,5}.
- {test,bs_start_match,{f,4},[{x,0}]}.
- {bs_save,0}.
- {test,bs_get_integer,
- {f,6},
- [{integer,8},1,{field_flags,[aligned,unsigned,big]},{x,1}]}.
- {test,bs_get_integer,
- {f,6},
- [{integer,8},1,{field_flags,[aligned,unsigned,big]},{x,2}]}.
- {test,bs_test_tail,{f,6},[0]}.
- {test_heap,3,3}.
- {put_tuple,2,{x,0}}.
- {put,{x,1}}.
- {put,{x,2}}.
- {'%live',1}.
- return.
- {label,6}.
- {bs_restore,1}.
- {test,bs_get_integer,
- {f,4},
- [{integer,32},1,{field_flags,[aligned,unsigned,big]},{x,1}]}.
- {test,bs_test_tail,{f,4},[0]}.
- {move,{x,1},{x,0}}.
- return.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/compiler_bug.S b/lib/compiler/test/beam_validator_SUITE_data/compiler_bug.S
new file mode 100644
index 0000000000..ba27bf5c47
--- /dev/null
+++ b/lib/compiler/test/beam_validator_SUITE_data/compiler_bug.S
@@ -0,0 +1,38 @@
+{module, compiler_bug}. %% version = 0
+
+{exports, [{module_info,0},{module_info,1},{sum,2}]}.
+
+{attributes, []}.
+
+{labels, 7}.
+
+
+{function, sum, 2, 2}.
+ {label,1}.
+ {line,[{location,"compiler_bug.erl",4}]}.
+ {func_info,{atom,compiler_bug},{atom,sum},2}.
+ {label,2}.
+ {line,[{location,"compiler_bug.erl",5}]}.
+ {gc_bif,'+',{f,0},2,[{y,0},{y,1}],{x,0}}.
+ return.
+
+
+{function, module_info, 0, 4}.
+ {label,3}.
+ {line,[]}.
+ {func_info,{atom,compiler_bug},{atom,module_info},0}.
+ {label,4}.
+ {move,{atom,compiler_bug},{x,0}}.
+ {line,[]}.
+ {call_ext_only,1,{extfunc,erlang,get_module_info,1}}.
+
+
+{function, module_info, 1, 6}.
+ {label,5}.
+ {line,[]}.
+ {func_info,{atom,compiler_bug},{atom,module_info},1}.
+ {label,6}.
+ {move,{x,0},{x,1}}.
+ {move,{atom,compiler_bug},{x,0}}.
+ {line,[]}.
+ {call_ext_only,2,{extfunc,erlang,get_module_info,2}}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/dead_code.S b/lib/compiler/test/beam_validator_SUITE_data/dead_code.S
index f964f98fba..c114664ba0 100644
--- a/lib/compiler/test/beam_validator_SUITE_data/dead_code.S
+++ b/lib/compiler/test/beam_validator_SUITE_data/dead_code.S
@@ -1,10 +1,10 @@
{module, dead_code}. %% version = 0
-{exports, [{execute,0},{module_info,0},{module_info,1}]}.
+{exports, [{execute,0}]}.
{attributes, []}.
-{labels, 10}.
+{labels, 6}.
{function, execute, 0, 2}.
@@ -12,7 +12,6 @@
{func_info,{atom,dead_code},{atom,execute},0}.
{label,2}.
{allocate,0,0}.
- {'%live',0}.
{call_ext,0,{extfunc,foo,fie,0}}.
{test,is_ne,{f,4},[{x,0},{integer,0}]}.
{test,is_ne,{f,4},[{x,0},{integer,1}]}.
@@ -22,27 +21,7 @@
{case_end,{x,0}}.
{label,4}.
{move,{atom,ok},{x,0}}.
- {'%live',1}.
{deallocate,0}.
return.
- {'%','Moved code'}.
{label,5}.
{case_end,{x,0}}.
-
-
-{function, module_info, 0, 7}.
- {label,6}.
- {func_info,{atom,dead_code},{atom,module_info},0}.
- {label,7}.
- {move,nil,{x,0}}.
- {'%live',1}.
- return.
-
-
-{function, module_info, 1, 9}.
- {label,8}.
- {func_info,{atom,dead_code},{atom,module_info},1}.
- {label,9}.
- {move,nil,{x,0}}.
- {'%live',1}.
- return.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/erl_prim_loader.beam b/lib/compiler/test/beam_validator_SUITE_data/erl_prim_loader.beam
deleted file mode 100644
index dd58a88e42..0000000000
--- a/lib/compiler/test/beam_validator_SUITE_data/erl_prim_loader.beam
+++ /dev/null
Binary files differ
diff --git a/lib/compiler/test/beam_validator_SUITE_data/freg_range.S b/lib/compiler/test/beam_validator_SUITE_data/freg_range.S
index ee583a923e..b3ebff3ade 100644
--- a/lib/compiler/test/beam_validator_SUITE_data/freg_range.S
+++ b/lib/compiler/test/beam_validator_SUITE_data/freg_range.S
@@ -1,10 +1,10 @@
{module, freg_range}. %% version = 0
-{exports, [{module_info,0},{module_info,1},{prod,2},{sum,2},{sum_prod,3}]}.
+{exports, [{sum_1,2},{sum_2,2},{sum_3,2},{sum_4,2}]}.
{attributes, []}.
-{labels, 8}.
+{labels, 9}.
{function, sum_1, 2, 2}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/freg_state.S b/lib/compiler/test/beam_validator_SUITE_data/freg_state.S
index ff4d7548ae..7466763482 100644
--- a/lib/compiler/test/beam_validator_SUITE_data/freg_state.S
+++ b/lib/compiler/test/beam_validator_SUITE_data/freg_state.S
@@ -1,6 +1,6 @@
{module, freg_state}. %% version = 0
-{exports, []}.
+{exports, [{sum_1,2},{sum_2,2},{sum_3,2},{sum_4,2},{sum_5,2}]}.
{attributes, []}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S b/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S
index f8d805d9ec..71e833446a 100644
--- a/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S
+++ b/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S
@@ -1,10 +1,10 @@
{module, freg_uninit}. %% version = 0
-{exports, []}.
+{exports, [{sum_1,2},{sum_2,2}]}.
{attributes, []}.
-{labels, 8}.
+{labels, 7}.
{function, sum_1, 2, 2}.
@@ -14,7 +14,6 @@
{fconv,{x,0},{fr,0}}.
fclearerror.
{bif,fadd,{f,0},[{fr,0},{fr,1}],{fr,0}}.
- {'%live',1}.
return.
@@ -26,7 +25,12 @@
{fconv,{x,1},{fr,1}}.
fclearerror.
{fcheckerror,{f,0}}.
- {call,2,{f,8}}.
+ {call,2,{f,6}}.
{bif,fadd,{f,0},[{fr,0},{fr,1}],{fr,0}}.
- {'%live',1}.
+ return.
+
+{function, foo, 2, 6}.
+ {label,5}.
+ {func_info,{atom,t},{atom,foo},2}.
+ {label,6}.
return.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/illegal_instruction.S b/lib/compiler/test/beam_validator_SUITE_data/illegal_instruction.S
deleted file mode 100644
index d6e92abc71..0000000000
--- a/lib/compiler/test/beam_validator_SUITE_data/illegal_instruction.S
+++ /dev/null
@@ -1,26 +0,0 @@
-{module, illegal_instruction}. %% version = 0
-
-{exports, []}.
-
-{attributes, []}.
-
-{labels, 7}.
-
-
-{function, t, 1, 2}.
- {label,1}.
- {func_info,{atom,illegal_instruction},{atom,t},1}.
- {label,2}.
- {my_illegal_instruction,{x,0}}.
- return.
-
-
-{function, x, 1, 4}.
- {label,3}.
- bad_func_info.
- {label,4}.
- {my_illegal_instruction,{x,0}}.
- return.
-
-{function, y, 0, 17}.
- \ No newline at end of file
diff --git a/lib/compiler/test/beam_validator_SUITE_data/map_field_lists.S b/lib/compiler/test/beam_validator_SUITE_data/map_field_lists.S
new file mode 100644
index 0000000000..9af68c82d4
--- /dev/null
+++ b/lib/compiler/test/beam_validator_SUITE_data/map_field_lists.S
@@ -0,0 +1,29 @@
+{module, map_field_lists}. %% version = 0
+
+{exports, [{x,1},{y,1}]}.
+
+{attributes, []}.
+
+{labels, 5}.
+
+
+{function, x, 1, 2}.
+ {label,1}.
+ {line,[{location,"map_field_lists.erl",4}]}.
+ {func_info,{atom,map_field_lists},{atom,x},1}.
+ {label,2}.
+ {test,is_map,{f,1},[{x,0}]}.
+ {test,has_map_fields,{f,1},{x,0},{list,[{atom,z},{atom,a}]}}.
+ {move,{atom,ok},{x,0}}.
+ return.
+
+
+{function, y, 1, 4}.
+ {label,3}.
+ {line,[{location,"map_field_lists.erl",7}]}.
+ {func_info,{atom,map_field_lists},{atom,y},1}.
+ {label,4}.
+ {test,is_map,{f,3},[{x,0}]}.
+ {test,has_map_fields,{f,3},{x,0},{list,[]}}.
+ {move,{atom,ok},{x,0}}.
+ return.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S b/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S
index 3d76127824..481d55045d 100644
--- a/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S
+++ b/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S
@@ -22,7 +22,8 @@
{label,4}.
{allocate_heap,1,6,2}.
{move,{x,1},{y,0}}.
- {put_string,2,{string,"~p"},{x,0}}.
+ {put_list,{integer,112},nil,{x,0}}.
+ {put_list,{integer,126},{x,0},{x,0}}.
{put_list,{y,0},nil,{x,1}}.
{'%live',2}.
{call_ext,2,{extfunc,io,format,2}}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/no_exception_in_catch.S b/lib/compiler/test/beam_validator_SUITE_data/no_exception_in_catch.S
index e08a718a39..1a5b417a5f 100644
--- a/lib/compiler/test/beam_validator_SUITE_data/no_exception_in_catch.S
+++ b/lib/compiler/test/beam_validator_SUITE_data/no_exception_in_catch.S
@@ -26,7 +26,7 @@
{call_ext,1,{extfunc,erlang,erase,1}}.
{move,{atom,nested},{x,0}}.
{call_ext,1,{extfunc,erlang,erase,1}}.
- {bif,self,nofail,[],{x,0}}.
+ {bif,self,{f,0},[],{x,0}}.
{'try',{y,8},{f,13}}.
{'try',{y,7},{f,11}}.
{'try',{y,6},{f,9}}.
@@ -34,7 +34,7 @@
%% Because the following instructions can't possible throw an exception,
%% label 7 used to get no state. Now the try_end itself will save the state.
{move,{x,0},{y,4}}.
- {bif,self,nofail,[],{x,0}}.
+ {bif,self,{f,0},[],{x,0}}.
{'%live',1}.
{try_end,{y,5}}.
{test,is_eq_exact,{f,15},[{x,0},{y,4}]}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/stack.S b/lib/compiler/test/beam_validator_SUITE_data/stack.S
index 244c22a2f9..e4356a9d00 100644
--- a/lib/compiler/test/beam_validator_SUITE_data/stack.S
+++ b/lib/compiler/test/beam_validator_SUITE_data/stack.S
@@ -1,10 +1,10 @@
{module, stack}. %% version = 0
-{exports, [{a,2},{b,2},{c,2},{d,2},{e,2}]}.
+{exports, [{a,2},{b,2},{c,2},{d,2},{e,2},{bad_1,0},{bad_2,0},{foo,0}]}.
{attributes, []}.
-{labels, 21}.
+{labels, 17}.
{function, a, 2, 2}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/undef_label.S b/lib/compiler/test/beam_validator_SUITE_data/undef_label.S
deleted file mode 100644
index dd29066bf4..0000000000
--- a/lib/compiler/test/beam_validator_SUITE_data/undef_label.S
+++ /dev/null
@@ -1,22 +0,0 @@
-{module, undef_label}. %% version = 0
-
-{exports, []}.
-
-{attributes, []}.
-
-{labels, 7}.
-
-
-{function, t, 1, 2}.
- {label,1}.
- {func_info,{atom,undef_label},{atom,t},1}.
- {label,2}.
- {test,is_eq_exact,{f,42},[{x,0},{atom,x}]}.
- {move,{atom,ok},{x,0}}.
- return.
-
-{function, x, 1, 17}.
- {label,3}.
- {func_info,{atom,undef_label},{atom,x},1}.
- {label,4}.
- return.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/uninit.S b/lib/compiler/test/beam_validator_SUITE_data/uninit.S
index 1a45c31411..9a66f4f7d6 100644
--- a/lib/compiler/test/beam_validator_SUITE_data/uninit.S
+++ b/lib/compiler/test/beam_validator_SUITE_data/uninit.S
@@ -1,9 +1,11 @@
{module, uninit}. %% version = 0
-{exports, []}.
+{exports, [{sum_1,2},{sum_2,2},{sum_3,2}]}.
{attributes, []}.
+{labels, 9}.
+
{function, sum_1, 2, 2}.
{label,1}.
{func_info,{atom,t},{atom,sum_1},2}.
@@ -11,7 +13,7 @@
{allocate,1,2}.
{move,{y,0},{x,0}}.
{'%live',1}.
- {call,1,{f,10}}.
+ {call,1,{f,8}}.
{bif,'+',{f,0},[{x,0},{y,0}],{x,0}}.
{'%live',1}.
{deallocate,1}.
@@ -23,7 +25,7 @@
{label,4}.
{allocate,1,2}.
{'%live',1}.
- {call,1,{f,10}}.
+ {call,1,{f,8}}.
{bif,'+',{f,0},[{x,0},{y,0}],{x,0}}.
{'%live',1}.
{deallocate,1}.
@@ -35,14 +37,14 @@
{label,6}.
{allocate_zero,1,2}.
{'%live',1}.
- {call,1,{f,10}}.
+ {call,1,{f,8}}.
{bif,'+',{f,0},[{x,0},{y,0}],{x,0}}.
{'%live',1}.
{deallocate,1}.
return.
-{function, id, 1, 10}.
- {label,9}.
+{function, id, 1, 8}.
+ {label,7}.
{func_info,{atom,t},{atom,id},1}.
- {label,10}.
+ {label,8}.
return.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/xrange.S b/lib/compiler/test/beam_validator_SUITE_data/xrange.S
index 3abbdffbc2..c6f20288f7 100644
--- a/lib/compiler/test/beam_validator_SUITE_data/xrange.S
+++ b/lib/compiler/test/beam_validator_SUITE_data/xrange.S
@@ -1,10 +1,10 @@
{module, xrange}. %% version = 0
-{exports, [{module_info,0},{module_info,1},{prod,2},{sum,2},{sum_prod,3}]}.
+{exports, [{sum_1,2},{sum_2,2},{sum_3,2},{sum_4,2}]}.
{attributes, []}.
-{labels, 8}.
+{labels, 9}.
{function, sum_1, 2, 2}.
diff --git a/lib/compiler/test/bs_bit_binaries_SUITE.erl b/lib/compiler/test/bs_bit_binaries_SUITE.erl
index 8609a490f5..2433e7621e 100644
--- a/lib/compiler/test/bs_bit_binaries_SUITE.erl
+++ b/lib/compiler/test/bs_bit_binaries_SUITE.erl
@@ -37,7 +37,7 @@ all() ->
[{group,p}].
groups() ->
- [{p,test_lib:parallel(),
+ [{p,[parallel],
[misc,horrid_match,test_bitstr,test_bit_size,
asymmetric_tests,big_asymmetric_tests,
binary_to_and_from_list,big_binary_to_and_from_list,
diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl
index ce39de2a82..9df874c387 100644
--- a/lib/compiler/test/bs_construct_SUITE.erl
+++ b/lib/compiler/test/bs_construct_SUITE.erl
@@ -39,7 +39,7 @@ all() ->
[{group,p}].
groups() ->
- [{p,test_lib:parallel(),
+ [{p,[parallel],
[two,test1,fail,float_bin,in_guard,in_catch,
nasty_literals,side_effect,opt,otp_7556,float_arith,
otp_8054]}].
diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl
index 10e3451e8f..f7af56afcc 100644
--- a/lib/compiler/test/bs_match_SUITE.erl
+++ b/lib/compiler/test/bs_match_SUITE.erl
@@ -48,7 +48,7 @@ all() ->
[{group,p}].
groups() ->
- [{p,test_lib:parallel(),
+ [{p,[parallel],
[fun_shadow,int_float,otp_5269,null_fields,wiger,
bin_tail,save_restore,shadowed_size_var,
partitioned_bs_match,function_clause,unit,
@@ -368,11 +368,20 @@ partitioned_bs_match_3(Var, <<_>>) -> Var;
partitioned_bs_match_3(1, 2) -> ok.
function_clause(Config) when is_list(Config) ->
- ?line ok = function_clause_1(<<0,7,0,7,42>>),
- ?line fc(function_clause_1, [<<0,1,2,3>>],
- catch function_clause_1(<<0,1,2,3>>)),
- ?line fc(function_clause_1, [<<0,1,2,3>>],
- catch function_clause_1(<<0,7,0,1,2,3>>)),
+ ok = function_clause_1(<<0,7,0,7,42>>),
+ fc(function_clause_1, [<<0,1,2,3>>],
+ catch function_clause_1(<<0,1,2,3>>)),
+ fc(function_clause_1, [<<0,1,2,3>>],
+ catch function_clause_1(<<0,7,0,1,2,3>>)),
+
+ ok = function_clause_2(<<0,7,0,7,42>>),
+ ok = function_clause_2(<<255>>),
+ ok = function_clause_2(<<13:4>>),
+ fc(function_clause_2, [<<0,1,2,3>>],
+ catch function_clause_2(<<0,1,2,3>>)),
+ fc(function_clause_2, [<<0,1,2,3>>],
+ catch function_clause_2(<<0,7,0,1,2,3>>)),
+
ok.
function_clause_1(<<0:8,7:8,T/binary>>) ->
@@ -380,6 +389,13 @@ function_clause_1(<<0:8,7:8,T/binary>>) ->
function_clause_1(<<_:8>>) ->
ok.
+function_clause_2(<<0:8,7:8,T/binary>>) ->
+ function_clause_2(T);
+function_clause_2(<<_:8>>) ->
+ ok;
+function_clause_2(<<_:4>>) ->
+ ok.
+
unit(Config) when is_list(Config) ->
?line 42 = peek1(<<42>>),
?line 43 = peek1(<<43,1,2>>),
diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl
index f7b1dbdddf..296774e083 100644
--- a/lib/compiler/test/compilation_SUITE.erl
+++ b/lib/compiler/test/compilation_SUITE.erl
@@ -436,7 +436,7 @@ self_compile_1(Config, Prefix, Opts) ->
%% Compile the compiler. (In this node to get better coverage.)
?line CompA = make_compiler_dir(Priv, Prefix++"compiler_a"),
?line VsnA = Version ++ ".0",
- ?line compile_compiler(compiler_src(), CompA, VsnA, [clint|Opts]),
+ compile_compiler(compiler_src(), CompA, VsnA, [clint0,clint|Opts]),
%% Compile the compiler again using the newly compiled compiler.
%% (In another node because reloading the compiler would disturb cover.)
@@ -611,12 +611,10 @@ otp_7345(Config) when is_list(Config) ->
otp_7345(ObjRef, _RdEnv, Args) ->
Cid = ObjRef#contextId.cid,
- _DpRef =
- #dpRef{cid = Cid,
+ _ = #dpRef{cid = Cid,
ms_device_context_id = cid_id,
tlli = #ptmsi{value = 0}},
- _QosProfile =
- #qosProfileBssgp{peak_bit_rate_msb = 0,
+ _ = #qosProfileBssgp{peak_bit_rate_msb = 0,
peak_bit_rate_lsb = 80,
t_a_precedence = 49},
[Cpdu|_] = Args,
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 8cb7d1b55b..1c96abe017 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -30,7 +30,7 @@
other_output/1, encrypted_abstr/1,
bad_record_use1/1, bad_record_use2/1, strict_record/1,
missing_testheap/1, cover/1, env/1, core/1, asm/1,
- sys_pre_attributes/1]).
+ sys_pre_attributes/1, dialyzer/1]).
-export([init/3]).
@@ -47,7 +47,7 @@ all() ->
other_output, encrypted_abstr,
{group, bad_record_use}, strict_record,
missing_testheap, cover, env, core, asm,
- sys_pre_attributes].
+ sys_pre_attributes, dialyzer].
groups() ->
[{bad_record_use, [],
@@ -365,7 +365,7 @@ listings_big(Config) when is_list(Config) ->
?line do_listing(Big, TargetDir, dkern, ".kernel"),
?line Target = filename:join(TargetDir, big),
- ?line {ok,big} = compile:file(Target, [asm,{outdir,TargetDir}]),
+ {ok,big} = compile:file(Target, [from_asm,{outdir,TargetDir}]),
%% Cleanup.
?line ok = file:delete(Target ++ ".beam"),
@@ -748,42 +748,65 @@ env_1(Simple, Target) ->
%% compile the generated Core Erlang files.
core(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(5)),
- ?line PrivDir = ?config(priv_dir, Config),
- ?line Outdir = filename:join(PrivDir, "core"),
- ?line ok = file:make_dir(Outdir),
+ PrivDir = ?config(priv_dir, Config),
+ Outdir = filename:join(PrivDir, "core"),
+ ok = file:make_dir(Outdir),
- ?line Wc = filename:join(filename:dirname(code:which(?MODULE)), "*.beam"),
- ?line TestBeams = filelib:wildcard(Wc),
- ?line Abstr = [begin {ok,{Mod,[{abstract_code,
+ Wc = filename:join(filename:dirname(code:which(?MODULE)), "*.beam"),
+ TestBeams = filelib:wildcard(Wc),
+ Abstr = [begin {ok,{Mod,[{abstract_code,
{raw_abstract_v1,Abstr}}]}} =
beam_lib:chunks(Beam, [abstract_code]),
{Mod,Abstr} end || Beam <- TestBeams],
- ?line Res = test_lib:p_run(fun(F) -> do_core(F, Outdir) end, Abstr),
- ?line test_server:timetrap_cancel(Dog),
- Res.
-
+ test_lib:p_run(fun(F) -> do_core(F, Outdir) end, Abstr).
do_core({M,A}, Outdir) ->
try
- {ok,M,Core} = compile:forms(A, [to_core,report]),
- CoreFile = filename:join(Outdir, atom_to_list(M)++".core"),
- CorePP = core_pp:format(Core),
- ok = file:write_file(CoreFile, CorePP),
- case compile:file(CoreFile, [clint,from_core,binary]) of
- {ok,M,_} ->
- ok = file:delete(CoreFile);
- Other ->
- io:format("*** core_lint failure '~p' for ~s\n",
- [Other,CoreFile]),
- error
- end
- catch Class:Error ->
+ do_core_1(M, A, Outdir)
+ catch
+ throw:{error,Error} ->
+ io:format("*** compilation failure '~p' for module ~s\n",
+ [Error,M]),
+ error;
+ Class:Error ->
io:format("~p: ~p ~p\n~p\n",
[M,Class,Error,erlang:get_stacktrace()]),
error
end.
+do_core_1(M, A, Outdir) ->
+ {ok,M,Core0} = compile:forms(A, [to_core]),
+ CoreFile = filename:join(Outdir, atom_to_list(M)++".core"),
+ CorePP = core_pp:format(Core0),
+ ok = file:write_file(CoreFile, CorePP),
+
+ %% Parse the .core file and return the result as Core Erlang Terms.
+ Core = case compile:file(CoreFile, [report_errors,from_core,no_copt,to_core,binary]) of
+ {ok,M,Core1} -> Core1;
+ Other -> throw({error,Other})
+ end,
+ ok = file:delete(CoreFile),
+
+ %% Compile as usual (including optimizations).
+ compile_forms(Core, [clint,from_core,binary]),
+
+ %% Don't optimize to test that we are not dependent
+ %% on the Core Erlang optmimization passes.
+ %% (Example of a previous bug: The core_parse pass
+ %% would not turn map literals into #c_literal{}
+ %% records; if sys_core_fold was run it would fix
+ %% that; if sys_core_fold was not run v3_kernel would
+ %% crash.)
+ compile_forms(Core, [clint,from_core,no_copt,binary]),
+
+ ok.
+
+compile_forms(Forms, Opts) ->
+ case compile:forms(Forms, [report_errors|Opts]) of
+ {ok,[],_} -> ok;
+ Other -> throw({error,Other})
+ end.
+
%% Compile to Beam assembly language (.S) and then try to
%% run .S through the compiler again.
@@ -854,6 +877,20 @@ sys_pre_attributes(Config) ->
[report,verbose]),
ok.
+%% Test the dialyzer option to cover more code.
+dialyzer(Config) ->
+ Priv = ?config(priv_dir, Config),
+ file:set_cwd(?config(data_dir, Config)),
+ Opts = [{outdir,Priv},report_errors],
+ M = dialyzer_test,
+ {ok,M} = c:c(M, [dialyzer|Opts]),
+ [{a,b,c}] = M:M(),
+
+ %% Cover huge line numbers without the 'dialyzer' option.
+ {ok,M} = c:c(M, Opts),
+ [{a,b,c}] = M:M(),
+ ok.
+
%%%
%%% Utilities.
%%%
diff --git a/lib/compiler/test/compile_SUITE_data/dialyzer_test.erl b/lib/compiler/test/compile_SUITE_data/dialyzer_test.erl
new file mode 100644
index 0000000000..ed65ff9c43
--- /dev/null
+++ b/lib/compiler/test/compile_SUITE_data/dialyzer_test.erl
@@ -0,0 +1,39 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2015. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(dialyzer_test).
+-export([?MODULE/0,turtle/0,test/1,huge/1]).
+
+-record(turtle, {a,b,c}).
+-record(tortoise, {a,b,c}).
+
+?MODULE() ->
+ [{a,b,c}].
+
+turtle() ->
+ #turtle{a=1,b=2,c=3}.
+
+test(T) ->
+ {T#tortoise.a,T#tortoise.b}.
+
+-file("dialyzer_test", 100000000).
+
+huge(X) ->
+ #turtle{a=42,b=100,c=511},
+ X#tortoise.a.
diff --git a/lib/compiler/test/core_SUITE_data/map_core_test.core b/lib/compiler/test/core_SUITE_data/map_core_test.core
index 2aa853d450..a75f6cf24f 100644
--- a/lib/compiler/test/core_SUITE_data/map_core_test.core
+++ b/lib/compiler/test/core_SUITE_data/map_core_test.core
@@ -7,11 +7,11 @@ module 'map_core_test' ['map_core_test'/0,
fun () ->
let <_cor0> =
%% Line 15
- ~{::<'check','ok'>,::<1337,#{#<104>(8,1,'integer',['unsigned'|['big']]),
+ ~{'check'=>'ok',1337=>#{#<104>(8,1,'integer',['unsigned'|['big']]),
#<101>(8,1,'integer',['unsigned'|['big']]),
#<108>(8,1,'integer',['unsigned'|['big']]),
#<108>(8,1,'integer',['unsigned'|['big']]),
- #<111>(8,1,'integer',['unsigned'|['big']])}#>,::<'val',0>}~
+ #<111>(8,1,'integer',['unsigned'|['big']])}#,'val'=>0}~
in let <M> =
%% Line 15
apply 'id'/1
@@ -23,7 +23,7 @@ module 'map_core_test' ['map_core_test'/0,
in %% Line 16
case apply 'call'/2
(M, _cor2) of
- <~{~<1337,#{#<104>(8,1,'integer',['unsigned'|['big']]),
+ <~{1337:=#{#<104>(8,1,'integer',['unsigned'|['big']]),
#<101>(8,1,'integer',['unsigned'|['big']]),
#<108>(8,1,'integer',['unsigned'|['big']]),
#<108>(8,1,'integer',['unsigned'|['big']]),
@@ -39,7 +39,7 @@ module 'map_core_test' ['map_core_test'/0,
#<32>(8,1,'integer',['unsigned'|['big']]),
#<53>(8,1,'integer',['unsigned'|['big']]),
#<32>(8,1,'integer',['unsigned'|['big']]),
- #<54>(8,1,'integer',['unsigned'|['big']])}#>,~<'check','ok'>,~<'val',21>}~> when 'true' ->
+ #<54>(8,1,'integer',['unsigned'|['big']])}#,'check':='ok','val':=21}~> when 'true' ->
%% Line 17
'ok'
( <_cor3> when 'true' ->
@@ -51,7 +51,7 @@ module 'map_core_test' ['map_core_test'/0,
%% Line 20
fun (_cor1,_cor0) ->
case <_cor1,_cor0> of
- <M = ~{~<1337,Bin>,~<'check',_cor8>,~<'val',Val>}~,[V|Vs]> when 'true' ->
+ <M = ~{1337:=Bin,'check':=_cor8,'val':=Val}~,[V|Vs]> when 'true' ->
let <_cor3> =
%% Line 21
call 'erlang':'+'
@@ -67,7 +67,7 @@ module 'map_core_test' ['map_core_test'/0,
(Val, V)
in let <_cor5> =
%% Line 21
- ~{~<1337,_cor4>,~<'val',_cor2>|M}~
+ ~{1337:=_cor4,'val':=_cor2|M}~
in %% Line 21
apply 'call'/2
(_cor5, Vs)
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index 2de17e7653..bc82eaf5aa 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -23,7 +23,8 @@
t_element/1,setelement/1,t_length/1,append/1,t_apply/1,bifs/1,
eq/1,nested_call_in_case/1,guard_try_catch/1,coverage/1,
unused_multiple_values_error/1,unused_multiple_values/1,
- multiple_aliases/1,redundant_boolean_clauses/1,mixed_matching_clauses/1]).
+ multiple_aliases/1,redundant_boolean_clauses/1,
+ mixed_matching_clauses/1,unnecessary_building/1]).
-export([foo/0,foo/1,foo/2,foo/3]).
@@ -36,11 +37,12 @@ all() ->
[{group,p}].
groups() ->
- [{p,test_lib:parallel(),
+ [{p,[parallel],
[t_element,setelement,t_length,append,t_apply,bifs,
eq,nested_call_in_case,guard_try_catch,coverage,
unused_multiple_values_error,unused_multiple_values,
- multiple_aliases,redundant_boolean_clauses,mixed_matching_clauses]}].
+ multiple_aliases,redundant_boolean_clauses,
+ mixed_matching_clauses,unnecessary_building]}].
init_per_suite(Config) ->
@@ -86,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.
@@ -104,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.
@@ -195,7 +199,10 @@ foo(A, B, C) ->
A + B + C.
bifs(Config) when is_list(Config) ->
- ?line <<1,2,3,4>> = id(list_to_binary([1,2,3,4])),
+ <<1,2,3,4>> = id(list_to_binary([1,2,3,4])),
+ K = {a,key},
+ V = {a,value},
+ {ok,#{K:=V}} = id(list_to_tuple([ok,#{K=>V}])),
ok.
-define(CMP_SAME(A0, B), (fun(A) -> true = A == B, false = A /= B end)(id(A0))).
@@ -252,6 +259,8 @@ do_guard_try_catch(K, V) ->
false
end.
+-record(cover_opt_guard_try, {list=[]}).
+
coverage(Config) when is_list(Config) ->
?line {'EXIT',{{case_clause,{a,b,c}},_}} =
(catch cover_will_match_list_type({a,b,c})),
@@ -261,6 +270,9 @@ coverage(Config) when is_list(Config) ->
?line error = cover_will_match_lit_list(),
{ok,[a]} = cover_is_safe_bool_expr(a),
+ ok = cover_opt_guard_try(#cover_opt_guard_try{list=[a]}),
+ error = cover_opt_guard_try(#cover_opt_guard_try{list=[]}),
+
%% Make sure that we don't attempt to make literals
%% out of pids. (Putting a pid into a #c_literal{}
%% would crash later compiler passes.)
@@ -273,6 +285,12 @@ coverage(Config) when is_list(Config) ->
error = bsm_an_inlined(<<1,2,3>>, Config),
error = bsm_an_inlined([], Config),
+ %% Cover eval_rel_op/4.
+ Tuple = id({a,b}),
+ false = case Tuple of
+ {_,_} ->
+ Tuple =:= true
+ end,
ok.
cover_will_match_list_type(A) ->
@@ -314,6 +332,14 @@ cover_is_safe_bool_expr(X) ->
false
end.
+cover_opt_guard_try(Msg) ->
+ if
+ length(Msg#cover_opt_guard_try.list) =/= 1 ->
+ error;
+ true ->
+ ok
+ end.
+
bsm_an_inlined(<<_:8>>, _) -> ok;
bsm_an_inlined(_, _) -> error.
@@ -400,4 +426,29 @@ mixed_matching_clauses(Config) when is_list(Config) ->
end,
ok.
+unnecessary_building(Config) when is_list(Config) ->
+ Term1 = do_unnecessary_building_1(test_lib:id(a)),
+ [{a,a},{a,a}] = Term1,
+ 7 = erts_debug:size(Term1),
+
+ %% The Input term should not be rebuilt (thus, it should
+ %% only be counted once in the size of the combined term).
+ Input = test_lib:id({a,b,c}),
+ Term2 = test_lib:id(do_unnecessary_building_2(Input)),
+ {b,[{a,b,c},none],x} = Term2,
+ 4+4+4+2 = erts_debug:size([Term2|Input]),
+
+ ok.
+
+do_unnecessary_building_1(S) ->
+ %% The tuple must only be built once.
+ F0 = F1 = {S,S},
+ [F0,F1].
+
+do_unnecessary_building_2({a,_,_}=T) ->
+ %% The T term should not be rebuilt.
+ {b,
+ [_,_] = [T,none],
+ x}.
+
id(I) -> I.
diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl
index bd877bb528..0d23f12fb5 100644
--- a/lib/compiler/test/error_SUITE.erl
+++ b/lib/compiler/test/error_SUITE.erl
@@ -23,7 +23,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
head_mismatch_line/1,warnings_as_errors/1, bif_clashes/1,
- transforms/1,forbidden_maps/1,bad_utf8/1]).
+ transforms/1,maps_warnings/1,bad_utf8/1]).
%% Used by transforms/1 test case.
-export([parse_transform/2]).
@@ -37,7 +37,7 @@ all() ->
groups() ->
[{p,test_lib:parallel(),
[head_mismatch_line,warnings_as_errors,bif_clashes,
- transforms,forbidden_maps,bad_utf8]}].
+ transforms,maps_warnings,bad_utf8]}].
init_per_suite(Config) ->
Config.
@@ -241,17 +241,30 @@ parse_transform(_, _) ->
error(too_bad).
-forbidden_maps(Config) when is_list(Config) ->
- Ts1 = [{map_illegal_use_of_pattern,
+maps_warnings(Config) when is_list(Config) ->
+ Ts1 = [{map_ok_use_of_pattern,
<<"
- -export([t/0]).
+ -export([t/1]).
+ t(K) ->
+ #{K := 1 = V} = id(#{<<\"hi all\">> => 1}),
+ V.
+ id(I) -> I.
+ ">>,
+ [return],
+ []},
+ {map_illegal_use_of_pattern,
+ <<"
+ -export([t/0,t/2]).
+ t(K,#{ K := V }) -> V.
t() ->
V = 32,
#{<<\"hi\",V,\"all\">> := 1} = id(#{<<\"hi all\">> => 1}).
id(I) -> I.
">>,
[return],
- {error,[{5,erl_lint,{illegal_map_key_variable,'V'}}], []}}],
+ {error,[{3,erl_lint,{unbound_var,'K'}},
+ {6,erl_lint,illegal_map_key}],[]}}
+ ],
[] = run2(Config, Ts1),
ok.
diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl
index afc04fd440..fb8da37f4f 100644
--- a/lib/compiler/test/float_SUITE.erl
+++ b/lib/compiler/test/float_SUITE.erl
@@ -118,6 +118,7 @@ math_functions(Config) when is_list(Config) ->
?line 0.0 = math:sinh(0),
?line 1.0 = math:cosh(0),
?line 0.0 = math:tanh(0),
+ 1.0 = math:log2(2),
?line 1.0 = math:log10(10),
?line -1.0 = math:cos(math:pi()),
?line 1.0 = math:exp(0),
@@ -136,6 +137,7 @@ math_functions(Config) when is_list(Config) ->
?line 0.0 = math:sinh(id(0)),
?line 1.0 = math:cosh(id(0)),
?line 0.0 = math:tanh(id(0)),
+ 1.0 = math:log2(id(2)),
?line 1.0 = math:log10(id(10)),
?line 1.0 = math:exp(id(0)),
?line 0.0 = math:log(id(1)),
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index 34bfdeb1e5..08279d9408 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -30,7 +30,7 @@
old_guard_tests/1,
build_in_guard/1,gbif/1,
t_is_boolean/1,is_function_2/1,
- tricky/1,rel_ops/1,literal_type_tests/1,
+ tricky/1,rel_ops/1,rel_op_combinations/1,literal_type_tests/1,
basic_andalso_orelse/1,traverse_dcd/1,
check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1,
bad_constants/1,bad_guards/1]).
@@ -42,12 +42,13 @@ all() ->
[{group,p}].
groups() ->
- [{p,test_lib:parallel(),
+ [{p,[parallel],
[misc,const_cond,basic_not,complex_not,nested_nots,
semicolon,complex_semicolon,comma,or_guard,
more_or_guards,complex_or_guards,and_guard,xor_guard,
more_xor_guards,build_in_guard,old_guard_tests,gbif,
- t_is_boolean,is_function_2,tricky,rel_ops,
+ t_is_boolean,is_function_2,tricky,
+ rel_ops,rel_op_combinations,
literal_type_tests,basic_andalso_orelse,traverse_dcd,
check_qlc_hrl,andalso_semi,t_tuple_size,binary_part,
bad_constants,bad_guards]}].
@@ -330,7 +331,15 @@ complex_semicolon(Config) when is_list(Config) ->
?line ok = csemi6({a,b}, 0),
?line ok = csemi6({}, 3),
?line ok = csemi6({a,b,c}, 3),
-
+
+ %% 7
+ error = csemi7(#{a=>1}, 1, 0),
+ error = csemi7(<<>>, 1, 0),
+ ok = csemi7(#{a=>1}, 3, 0),
+ ok = csemi7(#{a=>1}, 0, 3),
+ ok = csemi7(#{a=>1}, 3, 3),
+ ok = csemi7(#{a=>1, b=>3}, 0, 0),
+
ok.
csemi1(Type, Val) when is_list(Val), Type == float;
@@ -442,6 +451,9 @@ csemi5(_, _) -> error.
csemi6(A, B) when hd([tuple_size(A)]) > 1; abs(B) > 2 -> ok;
csemi6(_, _) -> error.
+csemi7(A, B, C) when A#{a:=B} > #{a=>1}; abs(C) > 2 -> ok;
+csemi7(_, _, _) -> error.
+
comma(Config) when is_list(Config) ->
%% ',' combinations of literal true/false.
@@ -1122,6 +1134,231 @@ rel_ops(Config) when is_list(Config) ->
-undef(TestOp).
+rel_op_combinations(Config) when is_list(Config) ->
+ Digits0 = lists:seq(16#0030, 16#0039) ++
+ lists:seq(16#0660, 16#0669) ++
+ lists:seq(16#06F0, 16#06F9),
+ Digits = gb_sets:from_list(Digits0),
+ rel_op_combinations_1(16#0700, Digits),
+
+ BrokenRange0 = lists:seq(3, 5) ++
+ lists:seq(10, 12) ++ lists:seq(14, 20),
+ BrokenRange = gb_sets:from_list(BrokenRange0),
+ rel_op_combinations_2(30, BrokenRange),
+
+ Red0 = [{I,2*I} || I <- lists:seq(0, 50)] ++
+ [{I,5*I} || I <- lists:seq(51, 80)],
+ Red = gb_trees:from_orddict(Red0),
+ rel_op_combinations_3(100, Red).
+
+rel_op_combinations_1(0, _) ->
+ ok;
+rel_op_combinations_1(N, Digits) ->
+ Bool = gb_sets:is_member(N, Digits),
+ Bool = is_digit_1(N),
+ Bool = is_digit_2(N),
+ Bool = is_digit_3(N),
+ Bool = is_digit_4(N),
+ Bool = is_digit_5(N),
+ Bool = is_digit_6(N),
+ Bool = is_digit_7(N),
+ Bool = is_digit_8(N),
+ rel_op_combinations_1(N-1, Digits).
+
+is_digit_1(X) when 16#0660 =< X, X =< 16#0669 -> true;
+is_digit_1(X) when 16#0030 =< X, X =< 16#0039 -> true;
+is_digit_1(X) when 16#06F0 =< X, X =< 16#06F9 -> true;
+is_digit_1(_) -> false.
+
+is_digit_2(X) when (16#0030-1) < X, X =< 16#0039 -> true;
+is_digit_2(X) when (16#0660-1) < X, X =< 16#0669 -> true;
+is_digit_2(X) when (16#06F0-1) < X, X =< 16#06F9 -> true;
+is_digit_2(_) -> false.
+
+is_digit_3(X) when 16#0660 =< X, X < (16#0669+1) -> true;
+is_digit_3(X) when 16#0030 =< X, X < (16#0039+1) -> true;
+is_digit_3(X) when 16#06F0 =< X, X < (16#06F9+1) -> true;
+is_digit_3(_) -> false.
+
+is_digit_4(X) when (16#0660-1) < X, X < (16#0669+1) -> true;
+is_digit_4(X) when (16#0030-1) < X, X < (16#0039+1) -> true;
+is_digit_4(X) when (16#06F0-1) < X, X < (16#06F9+1) -> true;
+is_digit_4(_) -> false.
+
+is_digit_5(X) when X >= 16#0660, X =< 16#0669 -> true;
+is_digit_5(X) when X >= 16#0030, X =< 16#0039 -> true;
+is_digit_5(X) when X >= 16#06F0, X =< 16#06F9 -> true;
+is_digit_5(_) -> false.
+
+is_digit_6(X) when X > (16#0660-1), X =< 16#0669 -> true;
+is_digit_6(X) when X > (16#0030-1), X =< 16#0039 -> true;
+is_digit_6(X) when X > (16#06F0-1), X =< 16#06F9 -> true;
+is_digit_6(_) -> false.
+
+is_digit_7(X) when 16#0660 =< X, X =< 16#0669 -> true;
+is_digit_7(X) when 16#0030 =< X, X =< 16#003A, X =/= 16#003A -> true;
+is_digit_7(X) when 16#06F0 =< X, X =< 16#06F9 -> true;
+is_digit_7(_) -> false.
+
+is_digit_8(X) when X =< 16#0039, X > (16#0030-1) -> true;
+is_digit_8(X) when X =< 16#06F9, X > (16#06F0-1) -> true;
+is_digit_8(X) when X =< 16#0669, X > (16#0660-1) -> true;
+is_digit_8(16#0670) -> false;
+is_digit_8(_) -> false.
+
+rel_op_combinations_2(0, _) ->
+ ok;
+rel_op_combinations_2(N, Range) ->
+ Bool = gb_sets:is_member(N, Range),
+ Bool = broken_range_1(N),
+ Bool = broken_range_2(N),
+ Bool = broken_range_3(N),
+ Bool = broken_range_4(N),
+ Bool = broken_range_5(N),
+ Bool = broken_range_6(N),
+ Bool = broken_range_7(N),
+ Bool = broken_range_8(N),
+ Bool = broken_range_9(N),
+ Bool = broken_range_10(N),
+ Bool = broken_range_11(N),
+ Bool = broken_range_12(N),
+ Bool = broken_range_13(N),
+ rel_op_combinations_2(N-1, Range).
+
+broken_range_1(X) when X >= 10, X =< 20, X =/= 13 -> true;
+broken_range_1(X) when X >= 3, X =< 5 -> true;
+broken_range_1(_) -> false.
+
+broken_range_2(X) when X >= 10, X =< 12 -> true;
+broken_range_2(X) when X >= 14, X =< 20 -> true;
+broken_range_2(X) when X >= 3, X =< 5 -> true;
+broken_range_2(_) -> false.
+
+broken_range_3(X) when X >= 10, X =< 12 -> true;
+broken_range_3(X) when X >= 14, X < 21 -> true;
+broken_range_3(3) -> true;
+broken_range_3(4) -> true;
+broken_range_3(5) -> true;
+broken_range_3(_) -> false.
+
+broken_range_4(X) when X =< 5, X >= 3 -> true;
+broken_range_4(X) when X >= 10, X =< 20, X =/= 13 -> true;
+broken_range_4(X) when X =< 100 -> false;
+broken_range_4(_) -> false.
+
+broken_range_5(X) when X >= 10, X =< 20, X =/= 13 -> true;
+broken_range_5(X) when X > 2, X =< 5 -> true;
+broken_range_5(_) -> false.
+
+broken_range_6(X) when X >= 10, X =< 20, X =/= 13 -> true;
+broken_range_6(X) when X > 2, X < 6 -> true;
+broken_range_6(_) -> false.
+
+broken_range_7(X) when X > 2, X < 6 -> true;
+broken_range_7(X) when X >= 10, X =< 20, X =/= 13 -> true;
+broken_range_7(X) when X > 30 -> false;
+broken_range_7(_) -> false.
+
+broken_range_8(X) when X >= 10, X =< 20, X =/= 13 -> true;
+broken_range_8(X) when X =:= 3 -> true;
+broken_range_8(X) when X >= 3, X =< 5 -> true;
+broken_range_8(_) -> false.
+
+broken_range_9(X) when X >= 10, X =< 20, X =/= 13 -> true;
+broken_range_9(X) when X =:= 13 -> false;
+broken_range_9(X) when X >= 3, X =< 5 -> true;
+broken_range_9(_) -> false.
+
+broken_range_10(X) when X >= 3, X =< 5 -> true;
+broken_range_10(X) when X >= 10, X =< 20, X =/= 13 -> true;
+broken_range_10(X) when X =/= 13 -> false;
+broken_range_10(_) -> false.
+
+broken_range_11(X) when X >= 10, X =< 20, X =/= 13 -> true;
+broken_range_11(X) when is_tuple(X), X =:= 10 -> true;
+broken_range_11(X) when X >= 3, X =< 5 -> true;
+broken_range_11(_) -> false.
+
+broken_range_12(X) when X >= 3, X =< 5 -> true;
+broken_range_12(X) when X >= 10, X =< 20, X =/= 13 -> true;
+broken_range_12(X) when X < 30, X > 20 -> false;
+broken_range_12(_) -> false.
+
+broken_range_13(X) when X >= 10, X =< 20, 13 =/= X -> true;
+broken_range_13(X) when X >= 3, X =< 5 -> true;
+broken_range_13(_) -> false.
+
+rel_op_combinations_3(0, _) ->
+ ok;
+rel_op_combinations_3(N, Red) ->
+ Val = case gb_trees:lookup(N, Red) of
+ none -> none;
+ {value,V} -> V
+ end,
+ Val = redundant_1(N),
+ Val = redundant_2(N),
+ Val = redundant_3(N),
+ Val = redundant_4(N),
+ Val = redundant_5(N),
+ Val = redundant_6(N),
+ Val = redundant_7(N),
+ Val = redundant_8(N),
+ Val = redundant_9(N),
+ Val = redundant_10(N),
+ Val = redundant_11(N),
+ rel_op_combinations_3(N-1, Red).
+
+redundant_1(X) when X >= 51, X =< 80 -> 5*X;
+redundant_1(X) when X < 51 -> 2*X;
+redundant_1(_) -> none.
+
+redundant_2(X) when X < 51 -> 2*X;
+redundant_2(X) when X >= 51, X =< 80 -> 5*X;
+redundant_2(_) -> none.
+
+redundant_3(X) when X < 51 -> 2*X;
+redundant_3(X) when X =< 80, X >= 51 -> 5*X;
+redundant_3(X) when X =/= 100 -> none;
+redundant_3(_) -> none.
+
+redundant_4(X) when X < 51 -> 2*X;
+redundant_4(X) when X =< 80, X > 50 -> 5*X;
+redundant_4(X) when X =/= 100 -> none;
+redundant_4(_) -> none.
+
+redundant_5(X) when X < 51 -> 2*X;
+redundant_5(X) when X > 50, X < 81 -> 5*X;
+redundant_5(X) when X =< 10 -> none;
+redundant_5(_) -> none.
+
+redundant_6(X) when X > 50, X =< 80 -> 5*X;
+redundant_6(X) when X < 51 -> 2*X;
+redundant_6(_) -> none.
+
+redundant_7(X) when is_integer(X), X >= 51, X =< 80 -> 5*X;
+redundant_7(X) when is_integer(X), X < 51 -> 2*X;
+redundant_7(_) -> none.
+
+redundant_8(X) when X >= 51, X =< 80 -> 5*X;
+redundant_8(X) when X < 51 -> 2*X;
+redundant_8(_) -> none.
+
+redundant_9(X) when X >= 51, X =< 80 -> 5*X;
+redundant_9(X) when X < 51 -> 2*X;
+redundant_9(90) -> none;
+redundant_9(X) when X =/= 90 -> none;
+redundant_9(_) -> none.
+
+redundant_10(X) when X >= 51, X =< 80 -> 5*X;
+redundant_10(X) when X < 51 -> 2*X;
+redundant_10(90) -> none;
+redundant_10(X) when X =:= 90 -> none;
+redundant_10(_) -> none.
+
+redundant_11(X) when X < 51 -> 2*X;
+redundant_11(X) when X =:= 10 -> 2*X;
+redundant_11(X) when X >= 51, X =< 80 -> 5*X;
+redundant_11(_) -> none.
%% Test type tests on literal values. (From emulator test suites.)
literal_type_tests(Config) when is_list(Config) ->
@@ -1565,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
@@ -1576,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/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl
index 398398a397..62bada1407 100644
--- a/lib/compiler/test/lc_SUITE.erl
+++ b/lib/compiler/test/lc_SUITE.erl
@@ -18,12 +18,12 @@
%%
-module(lc_SUITE).
--author('[email protected]').
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
basic/1,deeply_nested/1,no_generator/1,
- empty_generator/1,no_export/1]).
+ empty_generator/1,no_export/1,shadow/1,
+ effect/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -31,10 +31,18 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
test_lib:recompile(?MODULE),
- [basic, deeply_nested, no_generator, empty_generator, no_export].
+ [{group,p}].
groups() ->
- [].
+ [{p,test_lib:parallel(),
+ [basic,
+ deeply_nested,
+ no_generator,
+ empty_generator,
+ no_export,
+ shadow,
+ effect
+ ]}].
init_per_suite(Config) ->
Config.
@@ -59,34 +67,34 @@ end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
ok.
basic(Config) when is_list(Config) ->
- ?line L0 = lists:seq(1, 10),
- ?line L1 = my_map(fun(X) -> {x,X} end, L0),
- ?line L1 = [{x,X} || X <- L0],
- ?line L0 = my_map(fun({x,X}) -> X end, L1),
- ?line [1,2,3,4,5] = [X || X <- L0, X < 6],
- ?line [4,5,6] = [X || X <- L0, X > 3, X < 7],
- ?line [] = [X || X <- L0, X > 32, X < 7],
- ?line [1,3,5,7,9] = [X || X <- L0, odd(X)],
- ?line [2,4,6,8,10] = [X || X <- L0, not odd(X)],
- ?line [1,3,5,9] = [X || X <- L0, odd(X), X =/= 7],
- ?line [2,4,8,10] = [X || X <- L0, not odd(X), X =/= 6],
+ L0 = lists:seq(1, 10),
+ L1 = my_map(fun(X) -> {x,X} end, L0),
+ L1 = [{x,X} || X <- L0],
+ L0 = my_map(fun({x,X}) -> X end, L1),
+ [1,2,3,4,5] = [X || X <- L0, X < 6],
+ [4,5,6] = [X || X <- L0, X > 3, X < 7],
+ [] = [X || X <- L0, X > 32, X < 7],
+ [1,3,5,7,9] = [X || X <- L0, odd(X)],
+ [2,4,6,8,10] = [X || X <- L0, not odd(X)],
+ [1,3,5,9] = [X || X <- L0, odd(X), X =/= 7],
+ [2,4,8,10] = [X || X <- L0, not odd(X), X =/= 6],
%% Append is specially handled.
- ?line [1,3,5,9,2,4,8,10] = [X || X <- L0, odd(X), X =/= 7] ++
+ [1,3,5,9,2,4,8,10] = [X || X <- L0, odd(X), X =/= 7] ++
[X || X <- L0, not odd(X), X =/= 6],
%% Guards BIFs are evaluated in guard context. Weird, but true.
- ?line [{a,b,true},{x,y,true,true}] = [X || X <- tuple_list(), element(3, X)],
+ [{a,b,true},{x,y,true,true}] = [X || X <- tuple_list(), element(3, X)],
%% Filter expressions with andalso/orelse.
- ?line "abc123" = alphanum("?abc123.;"),
+ "abc123" = alphanum("?abc123.;"),
%% Error cases.
- ?line [] = [{xx,X} || X <- L0, element(2, X) == no_no_no],
- ?line {'EXIT',_} = (catch [X || X <- L1, list_to_atom(X) == dum]),
- ?line [] = [X || X <- L1, X+1 < 2],
- ?line {'EXIT',_} = (catch [X || X <- L1, odd(X)]),
- ?line fc([x], catch [E || E <- id(x)]),
+ [] = [{xx,X} || X <- L0, element(2, X) == no_no_no],
+ {'EXIT',_} = (catch [X || X <- L1, list_to_atom(X) == dum]),
+ [] = [X || X <- L1, X+1 < 2],
+ {'EXIT',_} = (catch [X || X <- L1, odd(X)]),
+ fc([x], catch [E || E <- id(x)]),
ok.
tuple_list() ->
@@ -116,12 +124,12 @@ deeply_nested_1() ->
X16 <- [4],X17 <- [3],X18 <- [fun() -> X16+X17 end],X19 <- [2],X20 <- [1]].
no_generator(Config) when is_list(Config) ->
- ?line Seq = lists:seq(-10, 17),
- ?line [no_gen_verify(no_gen(A, B), A, B) || A <- Seq, B <- Seq],
+ Seq = lists:seq(-10, 17),
+ [no_gen_verify(no_gen(A, B), A, B) || A <- Seq, B <- Seq],
%% Literal expression, for coverage.
- ?line [a] = [a || true],
- ?line [a,b,c] = [a || true] ++ [b,c],
+ [a] = [a || true],
+ [a,b,c] = [a || true] ++ [b,c],
ok.
no_gen(A, B) ->
@@ -174,13 +182,51 @@ no_gen_eval(Fun, Res) ->
no_gen_one_more(A, B) -> A + 1 =:= B.
empty_generator(Config) when is_list(Config) ->
- ?line [] = [X || {X} <- [], (false or (X/0 > 3))],
+ [] = [X || {X} <- [], (false or (X/0 > 3))],
ok.
no_export(Config) when is_list(Config) ->
[] = [ _X = a || false ] ++ [ _X = a || false ],
ok.
+%% Test that variables in list comprehensions are
+%% correctly shadowed.
+
+shadow(Config) when is_list(Config) ->
+ Shadowed = nomatch,
+ _ = id(Shadowed), %Eliminate warning.
+ L = [{Shadowed,Shadowed+1} || Shadowed <- lists:seq(7, 9)],
+ [{7,8},{8,9},{9,10}] = id(L),
+ [8,9] = id([Shadowed || {_,Shadowed} <- id(L),
+ Shadowed < 10]),
+ ok.
+
+effect(Config) when is_list(Config) ->
+ [{42,{a,b,c}}] =
+ do_effect(fun(F, L) ->
+ [F({V1,V2}) ||
+ #{<<1:500>>:=V1,<<2:301>>:=V2} <- L],
+ ok
+ end, id([#{},x,#{<<1:500>>=>42,<<2:301>>=>{a,b,c}}])),
+
+ %% Will trigger the time-trap timeout if not tail-recursive.
+ case ?MODULE of
+ lc_SUITE ->
+ _ = [{'EXIT',{badarg,_}} =
+ (catch binary_to_atom(<<C/utf8>>, utf8)) ||
+ C <- lists:seq(16#10000, 16#FFFFF)];
+ _ ->
+ ok
+ end,
+
+ ok.
+
+do_effect(Lc, L) ->
+ put(?MODULE, []),
+ F = fun(V) -> put(?MODULE, [V|get(?MODULE)]) end,
+ ok = Lc(F, L),
+ lists:reverse(erase(?MODULE)).
+
id(I) -> I.
fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args,_}|_]}}) -> ok;
diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl
index 403b7e8405..cfa8262701 100644
--- a/lib/compiler/test/map_SUITE.erl
+++ b/lib/compiler/test/map_SUITE.erl
@@ -21,6 +21,7 @@
]).
-export([
+ %% literals
t_build_and_match_literals/1,
t_update_literals/1,t_match_and_update_literals/1,
t_update_map_expressions/1,
@@ -32,6 +33,15 @@
t_map_size/1,
t_build_and_match_aliasing/1,
+ %% variables
+ t_build_and_match_variables/1,
+ t_update_assoc_variables/1,t_update_exact_variables/1,
+ t_nested_pattern_expressions/1,
+ t_guard_update_variables/1,
+ t_guard_sequence_variables/1,
+ t_guard_sequence_mixed/1,
+ t_frequency_table/1,
+
%% warnings
t_warn_useless_build/1,
t_warn_pair_key_overloaded/1,
@@ -51,7 +61,10 @@
suite() -> [].
-all() -> [
+all() ->
+ test_lib:recompile(?MODULE),
+ [
+ %% literals
t_build_and_match_literals,
t_update_literals, t_match_and_update_literals,
t_update_map_expressions,
@@ -62,6 +75,15 @@ all() -> [
t_map_size,
t_build_and_match_aliasing,
+ %% variables
+ t_build_and_match_variables,
+ t_update_assoc_variables,t_update_exact_variables,
+ t_nested_pattern_expressions,
+ t_guard_update_variables,
+ t_guard_sequence_variables,
+ t_guard_sequence_mixed,
+ t_frequency_table,
+
%% warnings
t_warn_useless_build,
t_warn_pair_key_overloaded,
@@ -73,6 +95,7 @@ all() -> [
t_build_and_match_nil,
t_build_and_match_structure,
+
%% errors in 17.0-rc1
t_update_values,
t_expand_map_update,
@@ -119,6 +142,11 @@ t_build_and_match_literals(Config) when is_list(Config) ->
%% nil key
#{[]:=ok,1:=2} = id(#{[]=>ok,1=>2}),
+ #{1:=2,[]:=ok,1:=2} = id(#{[]=>ok,1=>2}),
+
+ %% pseudo literals
+ #{ -3 := yep } = id(#{ -3 => yep }),
+ #{ <<0:358>> := "three" } = id(#{<<0:358>> =>"three"}),
%% error case
{'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))),
@@ -126,10 +154,10 @@ t_build_and_match_literals(Config) when is_list(Config) ->
{'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))),
{'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))),
{'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))),
- {'EXIT',{badarg,_}} = (catch id(#{<<0:258>> =>"three"})),
{'EXIT',{{badmatch,_},_}} = (catch (#{#{"a"=>42} := 3}=id(#{#{"a"=>3}=>42}))),
ok.
+
t_build_and_match_aliasing(Config) when is_list(Config) ->
M1 = id(#{a=>1,b=>2,c=>3,d=>4}),
#{c:=C1=_=_=C2} = M1,
@@ -143,6 +171,19 @@ t_build_and_match_aliasing(Config) when is_list(Config) ->
M2 = id(#{"a"=>1,"b"=>2,"c"=>3,"d"=>4}),
#{"a":=A2,"a":=A2,"a":=A2,"b":=B2,"b":=B2,"b":=2} = M2,
#{"a":=_,"a":=_,"a":=_,"b":=_,"b":=_,"b":=2} = M2,
+
+ #{a:=A1,a:=A1,a:=A1,b:=B1,b:=B1} = #{a:=A1,a:=A1,a:=A1,b:=B1,b:=B1,b:=2} = M1,
+ #{"a":=A3,"b":=B3} = #{"a":=A3,"a":=A3} = #{"b":=B3,"b":=2} = M2,
+
+ #{"a":=1,"b":=2,"c":=3,"d":=4} = #{"a":=A4,"b":=B4} = #{"a":=A4,"a":=A4} = #{"b":=B4,"d":=4} = M2,
+ #{"a":=A5,"b":=B5} = #{"a":=A5,"a":=A5} = #{"b":=B5,"d":=4} = #{"a":=1,"b":=2,"c":=3,"d":=4} = M2,
+ #{"a":=_,"b":=_} = #{"a":=_,"a":=_} = #{"b":=_,"d":=4} = #{"a":=1,"b":=2,"c":=3,"d":=4} = M2,
+
+ M3 = id(#{<<12:300>>=>1,<<13:300>>=>2}),
+ #{<<12:300>> := V1, <<13:300>> := V2} = #{<<13:300>> := V2, <<12:300>> := V1} = M3,
+ #{<<12:300>> := 1, <<13:300>> := 2} = #{<<13:300>> := _, <<12:300>> := _} = M3,
+ #{<<13:300>> := _, <<12:300>> := _} = #{<<12:300>> := 1, <<13:300>> := 2} = M3,
+
ok.
t_map_size(Config) when is_list(Config) ->
@@ -241,11 +282,14 @@ t_update_assoc(Config) when is_list(Config) ->
#{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2,
M2 = M0#{3.0:=wrong,3.0=>new},
+ % Can't handle directly yet
+ Bin = <<0:257>>,
+ #{ Bin := val } = id(M0#{<<0:257>> => val}), %% binary limitation
+
%% Errors cases.
BadMap = id(badmap),
{'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}),
{'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}),
- {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> => val}), %% limitation
ok.
t_update_exact(Config) when is_list(Config) ->
@@ -275,14 +319,22 @@ t_update_exact(Config) when is_list(Config) ->
{'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}),
{'EXIT',{badarg,_}} = (catch <<>>#{nonexisting:=val}),
{'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation
+
+ %% A workaround for a bug allowed an empty map to be updated.
+ {'EXIT',{badarg,_}} = (catch (id(#{}))#{a:=1}),
+ {'EXIT',{badarg,_}} = (catch #{}#{a:=1}),
+ Empty = #{},
+ {'EXIT',{badarg,_}} = (catch Empty#{a:=1}),
ok.
t_update_values(Config) when is_list(Config) ->
V0 = id(1337),
M0 = #{ a => 1, val => V0},
V1 = get_val(M0),
- M1 = M0#{ val := [V0,V1], "wazzup" => 42 },
+ M1 = id(M0#{ val := [V0,V1], "wazzup" => 42 }),
[1337, {some_val, 1337}] = get_val(M1),
+ M2 = id(M1#{ <<42:333>> => 1337 }),
+ {bin_key,1337} = get_val(M2),
N = 110,
List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)],
@@ -308,6 +360,7 @@ t_export(Config) when is_list(Config) ->
check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok.
+get_val(#{ <<42:333>> := V }) -> {bin_key, V};
get_val(#{ "wazzup" := _, val := V}) -> V;
get_val(#{ val := V }) -> {some_val, V}.
@@ -437,7 +490,10 @@ guard_receive_loop() ->
t_list_comprehension(Config) when is_list(Config) ->
- [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]],
+ [#{k:=1},#{k:=2},#{k:=3}] = id([#{k=>I} || I <- [1,2,3]]),
+ Ls = id([#{<<2:301>> => I, "wat" => I + 1} || I <- [1,2,3]]),
+ [#{<<2:301>>:=1,"wat":=2},#{<<2:301>>:=2,"wat":=3},#{<<2:301>>:=3,"wat":=4}] = Ls,
+ [{1,2},{2,3},{3,4}] = id([{I2,I1} || #{"wat" := I1, <<2:301>> := I2} <- Ls]),
ok.
t_guard_fun(Config) when is_list(Config) ->
@@ -585,6 +641,7 @@ t_build_and_match_nil(Config) when is_list(Config) ->
"treat" => V2,
[] => V1 }),
#{ [] := V3, [] := V3 } = id(#{ [] => V1, [] => V3 }),
+ #{ <<1>> := V3, [] := V1 } = id(#{ [] => V1, <<1>> => V3 }),
ok.
t_build_and_match_structure(Config) when is_list(Config) ->
@@ -601,5 +658,325 @@ t_build_and_match_structure(Config) when is_list(Config) ->
end,
ok.
+%% simple build and match variables
+t_build_and_match_variables(Config) when is_list(Config) ->
+ K0 = id(#{}),
+ K1 = id(1), V1 = id(a),
+ K2 = id(2), V2 = id(b),
+ K3 = id(3), V3 = id("c"),
+ K4 = id("4"), V4 = id("d"),
+ K5 = id(<<"5">>), V5 = id(<<"e">>),
+ K6 = id({"6",7}), V6 = id("f"),
+ K7 = id(#{ "a" => 3 }),
+ #{K1:=V1} = id(#{K1=>V1}),
+ #{K1:=V1,K2:=V2} = id(#{K1=>V1,K2=>V2}),
+ #{K1:=V1,K2:=V2,K3:=V3} = id(#{K1=>V1,K2=>V2,K3=>V3}),
+ #{K1:=V1,K2:=V2,K3:=V3,K4:=V4} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4}),
+ #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5}),
+ #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5,K6:=V6} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5,K6=>V6}),
+
+ #{K5:=X,K5:=X=3,K4:=4} = id(#{K5=>3,K4=>4}),
+ #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{K5=>3,K4=>4}),
+ #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{<<"5">>=>3,K4=>4}),
+
+ #{ K4:=#{ K3:=#{K1:=V1, K2:=V2}}, K5:=V5} =
+ id(#{ K5=>V5, K4=>#{ K3=>#{K2 => V2, K1 => V1}}}),
+ #{ K4 := #{ K5 := Res }, K6 := Res} = id(#{K4=>#{K5 => 99}, K6 => 99}),
+
+ %% has keys
+ #{a :=_,b :=_,K1:=_,K2:=_,K3:=V3,K4:=ResKey,K4:=ResKey,"4":=ResKey,"4":="ok"} =
+ id(#{ a=>1, b=>1, K1=>V1, K2=>V2, K3=>V3, K4=>"nope", "4"=>"ok" }),
+
+ %% function
+ ok = match_function_map_neg_keys(#{ -1 => a, -2 => b, -3 => c }),
+
+ %% map key
+ #{ K0 := 42 } = id(#{ K0 => 42 }),
+ #{ K7 := 42 } = id(#{ K7 => 42 }),
+
+ %% nil key
+ KNIL = id([]),
+ #{KNIL:=ok,1:=2} = id(#{KNIL=>ok,1=>2}),
+
+ Bin = <<0:258>>,
+ #{ Bin := "three" } = id(#{<<0:258>> =>"three"}),
+
+ %% error case
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3,x:=2} = id(#{K5=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=2} = id(#{K5=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id({a,b,c}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(#{K6=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(K7))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K7:=3} = id(#{K7=>42}))),
+ ok.
+
+
+match_function_map_neg_keys(#{ -1 := a, -2 := b, -3 := c }) -> ok.
+
+t_update_assoc_variables(Config) when is_list(Config) ->
+ K1 = id(1),
+ K2 = id(2),
+ K3 = id(3.0),
+ K4 = id(4),
+ K5 = id(5),
+ K6 = id(2.0),
+
+ M0 = #{K1=>a,K2=>b,K3=>c,K4=>d,K5=>e},
+
+ M1 = M0#{K1=>42,K2=>100,K4=>[a,b,c]},
+ #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1,
+ #{1:=42,2:=b,4:=d,5:=e,2.0:=100,K3:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,K6=>100,4.0=>[a,b,c]},
+
+ M2 = M0#{K3=>new},
+ #{1:=a,2:=b,K3:=new,4:=d,5:=e} = M2,
+ M2 = M0#{3.0:=wrong,K3=>new},
+
+ #{ <<0:258>> := val } = id(M0#{<<0:258>> => val}), %% binary limitation
+
+ %% Errors cases.
+ BadMap = id(badmap),
+ {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}),
+ {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}),
+ ok.
+
+t_update_exact_variables(Config) when is_list(Config) ->
+ K1 = id(1),
+ K2 = id(2),
+ K3 = id(3.0),
+ K4 = id(4),
+
+ M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}),
+
+ M1 = M0#{K1:=42,K2:=100,K4:=[a,b,c]},
+ #{1:=42,2:=100,3.0:=c,K4:=[a,b,c],5:=e} = M1,
+ M1 = M0#{K1:=wrong,1:=also_wrong,K1=>42,2=>wrong,K2:=100,4:=[a,b,c]},
+
+ M2 = M0#{K3:=new},
+ #{1:=a,K2:=b,3.0:=new,K4:=d,5:=e} = M2,
+ M2 = M0#{3.0=>wrong,K3:=new},
+ true = M2 =/= M0#{3=>right,3.0:=new},
+ #{ 3 := right, 3.0 := new } = M0#{3=>right,K3:=new},
+
+ M3 = id(#{ 1 => val}),
+ #{1 := update2,1.0 := new_val4} = M3#{
+ 1.0 => new_val1, K1 := update, K1=> update3,
+ K1 := update2, 1.0 := new_val2, 1.0 => new_val3,
+ 1.0 => new_val4 },
+
+ #{ "wat" := 3, 2 := a } = id(#{ "wat" => 1, K2 => 2 }#{ K2 := a, "wat" := 3 }),
+
+ %% Errors cases.
+ {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })),
+ {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}),
+ {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}),
+ {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}),
+ {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}),
+ {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting:=val}),
+ {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation
+ ok.
+
+t_nested_pattern_expressions(Config) when is_list(Config) ->
+ K1 = id("hello"),
+ %K2 = id({ok}),
+ [_,_,#{ <<"hi">> := wat, K1 := 42 }|_] = id([k,k,#{<<"hi">> => wat, K1 => 42}]),
+ [_,_,#{ -1 := wat, K1 := 42 }|_] = id([k,k,#{-1 => wat, K1 => 42}]),
+ [_,_,{#{ -1 := #{ {-3,<<0:300>>} := V1 }, K1 := 42 },3}|_] = id([k,k,{#{-1 => #{{-3,<<0:300>>}=>"hi"}, K1 => 42},3}]),
+ "hi" = V1,
+ %[k,#{ {-1,K1,[]} := {wat,K1}, K2 := 42 }|_] = id([k,#{{-1,K1,[]} => {wat,K1}, K2 => 42}]),
+ %[k,#{ [-1,K2,[]] := {wat,K1}, K1 := 42 }|_] = id([k,#{[-1,K2,[]] => {wat,K1}, K1 => 42}]),
+
+ M0 = id(#{ <<33:333>> => 1, <<332:333>> => ok, a => ok, wat => yep, watzor => ok }),
+ F0 = map_nested_pattern_funs(M0),
+ F1 = F0(wat),
+ F2 = F1(watzor),
+ {yep,ok} = F2(M0),
+ ok.
+
+map_nested_pattern_funs(M) ->
+ K0 = id(a),
+ fun(K1) ->
+ case M of
+ #{ K0 := ok, K1 := yep, <<33:333>> := 1 } ->
+ fun(K2) ->
+ case M of
+ #{ K2 := ok, K1 := yep, <<33:333>> := 1 } ->
+ fun
+ (#{ <<332:333>> := ok, K1 := V1, K2 := V2 }) ->
+ {V1,V2}
+ end
+ end
+ end
+ end
+ end.
+
+t_guard_update_variables(Config) when is_list(Config) ->
+ error = map_guard_update_variables(n,#{},#{}),
+ first = map_guard_update_variables(x,#{}, #{x=>first}),
+ second = map_guard_update_variables(x,#{y=>old}, #{x=>second,y=>old}),
+ third = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>third,y=>old}),
+ fourth = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>4,y=>new}),
+ ok.
+
+map_guard_update_variables(K,M1,M2) when M1#{K=>first} =:= M2 -> first;
+map_guard_update_variables(K,M1,M2) when M1#{K=>second} =:= M2 -> second;
+map_guard_update_variables(K,M1,M2) when M1#{K:=third} =:= M2 -> third;
+map_guard_update_variables(K,M1,M2) when M1#{K:=4,y=>new} =:= M2 -> fourth;
+map_guard_update_variables(_,_,_) -> error.
+
+t_guard_sequence_variables(Config) when is_list(Config) ->
+ {1,"a"} = map_guard_sequence_var_1(a,#{seq=>1,a=>id("a"),b=>no}),
+ {2,"b"} = map_guard_sequence_var_1(b,#{seq=>2,b=>id("b"),a=>no}),
+ {3,"c"} = map_guard_sequence_var_1(a,#{seq=>3,a=>id("c"),b=>no}),
+ {4,"d"} = map_guard_sequence_var_1(b,#{seq=>4,b=>id("d"),a=>no}),
+ {4,4} = map_guard_sequence_var_1(seq,#{seq=>4}),
+ {4,4,y} = map_guard_sequence_var_1(seq,#{seq=>4,b=>id("d"),a=>y}),
+ {5,"d"} = map_guard_sequence_var_1(b,#{seq=>5,b=>id("d"),a=>y}),
+
+ %% error case
+ {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_var_1("a",#{seq=>4,val=>id("e")})),
+ ok.
+
+
+map_guard_sequence_var_1(K,M) ->
+ case M of
+ #{seq:=1=Seq, K:=Val} -> {Seq,Val};
+ #{seq:=2=Seq, K:=Val} -> {Seq,Val};
+ #{seq:=3=Seq, K:=Val} -> {Seq,Val};
+ #{K:=4=Seq, K:=Val1,a:=Val2} -> {Seq,Val1,Val2};
+ #{seq:=4=Seq, K:=Val} -> {Seq,Val};
+ #{K:=4=Seq, K:=Val} -> {Seq,Val};
+ #{seq:=5=Seq, K:=Val} -> {Seq,Val}
+ end.
+
+
+t_guard_sequence_mixed(Config) when is_list(Config) ->
+ M0 = id(#{ a=>1, b=>1, c=>1, d=>1, e=>1, f=>1, g=>1, h=>1 }),
+ M1 = id(M0#{ d := 3 }),
+ 1 = map_guard_sequence_mixed(a,d,M1),
+ M2 = id(M1#{ b := 2, d := 4, h := 2 }),
+ 2 = map_guard_sequence_mixed(a,d,M2),
+ M3 = id(M2#{ b := 3, e := 5, g := 3 }),
+ 3 = map_guard_sequence_mixed(a,e,M3),
+ M4 = id(M3#{ c := 4, e := 6, h := 1 }),
+ 4 = map_guard_sequence_mixed(a,e,M4),
+ M5 = id(M4#{ c := 5, f := 7, g := 2 }),
+ 5 = map_guard_sequence_mixed(a,f,M5),
+ M6 = id(M5#{ c := 6, f := 8, h := 3 }),
+ 6 = map_guard_sequence_mixed(a,f,M6),
+
+ %% error case
+ {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_mixed(a,b,M0)),
+ ok.
+
+map_guard_sequence_mixed(K1,K2,M) ->
+ case M of
+ #{ K1 := 1, b := 1, K2 := 3, g := 1} -> 1;
+ #{ K1 := 1, b := 2, K2 := 4, h := 2} -> 2;
+ #{ K1 := 1, b := 3, K2 := 5, g := 3} -> 3;
+ #{ K1 := 1, c := 4, K2 := 6, h := 1} -> 4;
+ #{ K1 := 1, c := 5, K2 := 7, g := 2} -> 5;
+ #{ K1 := 1, c := 6, K2 := 8, h := 3} -> 6
+ end.
+
+
+
+t_frequency_table(Config) when is_list(Config) ->
+ random:seed({13,1337,54}), % pseudo random
+ N = 100000,
+ Ts = rand_terms(N),
+ #{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}),
+ ok = check_frequency(Ts,Tf),
+ ok.
+
+
+frequency_table([T|Ts], M) ->
+ case M of
+ #{ n := N, tf := #{ T := C } = F } ->
+ frequency_table(Ts,M#{ n := N + 1, tf := F#{ T := C + 1 }});
+ #{ n := N, tf := F } ->
+ frequency_table(Ts,M#{ n := N + 1, tf := F#{ T => 1 }})
+ end;
+frequency_table([], M) -> M.
+
+
+check_frequency(Ts,Tf) ->
+ check_frequency(Ts,Tf,dict:new()).
+
+check_frequency([T|Ts],Tf,D) ->
+ case dict:find(T,D) of
+ error -> check_frequency(Ts,Tf,dict:store(T,1,D));
+ {ok,C} -> check_frequency(Ts,Tf,dict:store(T,C+1,D))
+ end;
+check_frequency([],Tf,D) ->
+ validate_frequency(dict:to_list(D),Tf).
+
+validate_frequency([{T,C}|Fs],Tf) ->
+ case Tf of
+ #{ T := C } -> validate_frequency(Fs,Tf);
+ _ -> error
+ end;
+validate_frequency([], _) -> ok.
+
+
+%% aux
+
+rand_terms(0) -> [];
+rand_terms(N) -> [rand_term()|rand_terms(N-1)].
+
+rand_term() ->
+ case random:uniform(6) of
+ 1 -> rand_binary();
+ 2 -> rand_number();
+ 3 -> rand_atom();
+ 4 -> rand_tuple();
+ 5 -> rand_list();
+ 6 -> rand_map()
+ end.
+
+rand_binary() ->
+ case random:uniform(3) of
+ 1 -> <<>>;
+ 2 -> <<"hi">>;
+ 3 -> <<"message text larger than 64 bytes. yep, message text larger than 64 bytes.">>
+ end.
+
+rand_number() ->
+ case random:uniform(3) of
+ 1 -> random:uniform(5);
+ 2 -> float(random:uniform(5));
+ 3 -> 1 bsl (63 + random:uniform(3))
+ end.
+
+rand_atom() ->
+ case random:uniform(3) of
+ 1 -> hi;
+ 2 -> some_atom;
+ 3 -> some_other_atom
+ end.
+
+
+rand_tuple() ->
+ case random:uniform(3) of
+ 1 -> {ok, rand_term()}; % careful
+ 2 -> {1, 2, 3};
+ 3 -> {<<"yep">>, 1337}
+ end.
+
+rand_list() ->
+ case random:uniform(3) of
+ 1 -> "hi";
+ 2 -> [1,rand_term()]; % careful
+ 3 -> [improper|list]
+ end.
+
+rand_map() ->
+ case random:uniform(3) of
+ 1 -> #{ hi => 3 };
+ 2 -> #{ wat => rand_term(), other => 3 }; % careful
+ 3 -> #{ hi => 42, other => 42, yet_anoter => 1337 }
+ end.
+
+
+
%% Use this function to avoid compile-time evaluation of an expression.
id(I) -> I.
diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl
index 1e778dca24..9aec0b3d4e 100644
--- a/lib/compiler/test/match_SUITE.erl
+++ b/lib/compiler/test/match_SUITE.erl
@@ -22,7 +22,8 @@
init_per_group/2,end_per_group/2,
pmatch/1,mixed/1,aliases/1,match_in_call/1,
untuplify/1,shortcut_boolean/1,letify_guard/1,
- selectify/1,underscore/1,match_map/1,coverage/1]).
+ selectify/1,underscore/1,match_map/1,map_vars_used/1,
+ coverage/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -33,10 +34,10 @@ all() ->
[{group,p}].
groups() ->
- [{p,test_lib:parallel(),
+ [{p,[parallel],
[pmatch,mixed,aliases,match_in_call,untuplify,
shortcut_boolean,letify_guard,selectify,
- underscore,match_map,coverage]}].
+ underscore,match_map,map_vars_used,coverage]}].
init_per_suite(Config) ->
@@ -140,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) ->
@@ -243,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) ->
@@ -419,6 +433,18 @@ do_match_map_2(Map) ->
Tuple
end.
+map_vars_used(Config) when is_list(Config) ->
+ {some,value} = do_map_vars_used(a, b, #{{a,b}=>42,v=>{some,value}}),
+ ok.
+
+do_map_vars_used(X, Y, Map) ->
+ case {X,Y} of
+ T ->
+ %% core_lib:is_var_used/2 would not consider T used.
+ #{T:=42,v:=Val} = Map,
+ Val
+ end.
+
coverage(Config) when is_list(Config) ->
%% Cover beam_dead.
ok = coverage_1(x, a),
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index 44c7161530..68a31f14d5 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -60,7 +60,7 @@ all() ->
[{group,p}].
groups() ->
- [{p,[],%%test_lib:parallel(),
+ [{p,[],
[tobias,empty_string,md5,silly_coverage,
confused_literals,integer_encoding,override_bif]}].
@@ -225,14 +225,15 @@ silly_coverage(Config) when is_list(Config) ->
{label,2}|non_proper_list]}],99},
?line expect_error(fun() -> beam_bool:module(BoolInput, []) end),
- %% beam_dead
+ %% beam_dead. This is tricky. Our function must look OK to
+ %% beam_utils:clean_labels/1, but must crash beam_dead.
DeadInput = {?MODULE,[{foo,0}],[],
[{function,foo,0,2,
[{label,1},
{func_info,{atom,?MODULE},{atom,foo},0},
{label,2},
- {jump,bad}]}],99},
- ?line expect_error(fun() -> beam_block:module(DeadInput, []) end),
+ {test,is_eq_exact,{f,1},[bad,operands]}]}],99},
+ expect_error(fun() -> beam_dead:module(DeadInput, []) end),
%% beam_clean
CleanInput = {?MODULE,[{foo,0}],[],
@@ -279,6 +280,14 @@ silly_coverage(Config) when is_list(Config) ->
{label,2}|non_proper_list]}],99},
expect_error(fun() -> beam_z:module(BeamZInput, []) end),
+ %% beam_validator.
+ BeamValInput = {?MODULE,[{foo,0}],[],
+ [{function,foo,0,2,
+ [{label,1},
+ {func_info,{atom,?MODULE},{atom,foo},0},
+ {label,2}|non_proper_list]}],99},
+ expect_error(fun() -> beam_validator:module(BeamValInput, []) end),
+
ok.
expect_error(Fun) ->
diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl
index 00a6e900d4..fb82bf6101 100644
--- a/lib/compiler/test/receive_SUITE.erl
+++ b/lib/compiler/test/receive_SUITE.erl
@@ -187,12 +187,13 @@ ref_opt(Config) when is_list(Config) ->
end.
ref_opt_1(Config) ->
- ?line DataDir = ?config(data_dir, Config),
- ?line PrivDir = ?config(priv_dir, Config),
+ DataDir = ?config(data_dir, Config),
+ PrivDir = ?config(priv_dir, Config),
Sources = filelib:wildcard(filename:join([DataDir,"ref_opt","*.{erl,S}"])),
- ?line test_lib:p_run(fun(Src) ->
- do_ref_opt(Src, PrivDir)
- end, Sources),
+ test_lib:p_run(fun(Src) ->
+ do_ref_opt(Src, PrivDir)
+ end, Sources),
+ cover_recv_instructions(),
ok.
do_ref_opt(Source, PrivDir) ->
@@ -202,9 +203,9 @@ do_ref_opt(Source, PrivDir) ->
{outdir,PrivDir}] ++
[from_asm || Ext =:= ".S" ]),
Base = filename:rootname(filename:basename(Source), Ext),
- code:purge(list_to_atom(Base)),
- BeamFile = filename:join(PrivDir, Base),
- code:load_abs(BeamFile),
+ code:purge(list_to_atom(Base)),
+ BeamFile = filename:join(PrivDir, Base),
+ code:load_abs(BeamFile),
ok = Mod:Mod(),
{beam_file,Mod,_,_,_,Code} = beam_disasm:file(BeamFile),
case Base of
@@ -232,6 +233,27 @@ collect_recv_opt_instrs(Code) ->
end] || {function,_,_,_,Is} <- Code],
lists:append(L).
+cover_recv_instructions() ->
+ %% We want to cover the handling of recv_mark and recv_set in beam_utils.
+ %% Since those instructions are introduced in a late optimization pass,
+ %% beam_utils:live_opt() will not see them unless the compilation is
+ %% started from a .S file. The compile_SUITE:asm/1 test case will
+ %% compile all test suite files to .S and then run them through the
+ %% compiler again.
+ %%
+ %% Here will we will ensure that this modules contains recv_mark
+ %% and recv_set instructions.
+ Pid = spawn_link(fun() ->
+ receive {Parent,Ref} ->
+ Parent ! Ref
+ end
+ end),
+ Ref = make_ref(),
+ Pid ! {self(),Ref},
+ receive
+ Ref -> ok
+ end.
+
export(Config) when is_list(Config) ->
Ref = make_ref(),
?line self() ! {result,Ref,42},
diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl
index f736e14bf6..8cc90026ec 100644
--- a/lib/compiler/test/record_SUITE.erl
+++ b/lib/compiler/test/record_SUITE.erl
@@ -246,6 +246,14 @@ record_test_2(Config) when is_list(Config) ->
?line Barf = update_barf(Barf0),
?line #barf{a="abc",b=1} = id(Barf),
+ %% Test optimization of is_record/3.
+ false = case id({a,b}) of
+ {_,_}=Tuple -> is_record(Tuple, foo)
+ end,
+ false = case id(true) of
+ true=Bool -> is_record(Bool, foo)
+ end,
+
ok.
record_test_3(Config) when is_list(Config) ->
diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl
index a8befbecd9..a5e2855f8c 100644
--- a/lib/compiler/test/test_lib.erl
+++ b/lib/compiler/test/test_lib.erl
@@ -18,11 +18,13 @@
%%
-module(test_lib).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-compile({no_auto_import,[binary_part/2]}).
--export([recompile/1,parallel/0,uniq/0,opt_opts/1,get_data_dir/1,
+-export([id/1,recompile/1,parallel/0,uniq/0,opt_opts/1,get_data_dir/1,
smoke_disasm/1,p_run/2,binary_part/2]).
+id(I) -> I.
+
recompile(Mod) when is_atom(Mod) ->
case whereis(cover_server) of
undefined -> ok;
@@ -44,6 +46,10 @@ smoke_disasm(File) when is_list(File) ->
Res = beam_disasm:file(File),
{beam_file,_Mod} = {element(1, Res),element(2, Res)}.
+%% If we are running cover, we don't want to run test cases that
+%% invokes the compiler in parallel, as doing so would probably
+%% be slower than running them sequentially.
+
parallel() ->
case ?t:is_cover() orelse erlang:system_info(schedulers) =:= 1 of
true -> [];
@@ -90,13 +96,18 @@ get_data_dir(Config) ->
%% Will fail the test case if there were any errors.
p_run(Test, List) ->
+ S = erlang:system_info(schedulers),
N = case ?t:is_cover() of
false ->
- erlang:system_info(schedulers);
+ S + 1;
true ->
- %% Cover is running. Using more than one process
- %% will probably only slow down compilation.
- 1
+ %% Cover is running. Using too many processes
+ %% could slow us down. Measurements on my computer
+ %% showed that using 4 parallel processes was
+ %% slightly faster than using 3. Using more than
+ %% 4 would not buy us much and could actually be
+ %% slower.
+ max(S, 4)
end,
p_run_loop(Test, List, N, [], 0, 0).
diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl
index 4530d08c77..80d93fbfa4 100644
--- a/lib/compiler/test/trycatch_SUITE.erl
+++ b/lib/compiler/test/trycatch_SUITE.erl
@@ -24,7 +24,8 @@
catch_oops/1,after_oops/1,eclectic/1,rethrow/1,
nested_of/1,nested_catch/1,nested_after/1,
nested_horrid/1,last_call_optimization/1,bool/1,
- plain_catch_coverage/1,andalso_orelse/1,get_in_try/1]).
+ plain_catch_coverage/1,andalso_orelse/1,get_in_try/1,
+ hockey/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -35,11 +36,12 @@ all() ->
[{group,p}].
groups() ->
- [{p,test_lib:parallel(),
+ [{p,[parallel],
[basic,lean_throw,try_of,try_after,catch_oops,
after_oops,eclectic,rethrow,nested_of,nested_catch,
nested_after,nested_horrid,last_call_optimization,
- bool,plain_catch_coverage,andalso_orelse,get_in_try]}].
+ bool,plain_catch_coverage,andalso_orelse,get_in_try,
+ hockey]}].
init_per_suite(Config) ->
@@ -790,7 +792,6 @@ nested_after_1({X1,C1,V1},
nested_horrid(Config) when is_list(Config) ->
- _V = {make_ref(),nested_horrid,4.711},
{[true,true],{[true,1.0],1.0}} =
nested_horrid_1({true,void,void}, 1.0),
ok.
@@ -944,3 +945,14 @@ get_valid_line([_|T]=Path, Annotations) ->
_:not_found ->
get_valid_line(T, Annotations)
end.
+
+hockey(_) ->
+ {'EXIT',{{badmatch,_},[_|_]}} = (catch hockey()),
+ ok.
+
+hockey() ->
+ %% beam_jump used to generate a call into the try block.
+ %% beam_validator disapproved.
+ receive _ -> (b = fun() -> ok end)
+ + hockey, +x after 0 -> ok end, try (a = fun() -> ok end) + hockey, +
+ y catch _ -> ok end.
diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl
index 0637041873..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]).
+ latin1_fallback/1,underscore/1,no_warnings/1]).
% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(2)).
@@ -64,7 +64,8 @@ groups() ->
[pattern,pattern2,pattern3,pattern4,guard,
bad_arith,bool_cases,bad_apply,files,effect,
bin_opt_info,bin_construction,comprehensions,maps,
- redundant_boolean_clauses,latin1_fallback]}].
+ redundant_boolean_clauses,latin1_fallback,
+ underscore,no_warnings]}].
init_per_suite(Config) ->
Config.
@@ -284,7 +285,7 @@ bad_arith(Config) when is_list(Config) ->
{10,sys_core_fold,{eval_failure,badarith}},
{15,sys_core_fold,{eval_failure,badarith}}
] }}],
- ?line [] = run(Config, Ts),
+ [] = run(Config, Ts),
ok.
bool_cases(Config) when is_list(Config) ->
@@ -578,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() ->
@@ -592,7 +593,7 @@ maps(Config) when is_list(Config) ->
id(I) -> I.
">>,
[inline],
- {warnings,[{4,v3_kernel,bad_map}]}},
+ []},
{bad_map_src3,
<<"
t() ->
@@ -601,7 +602,7 @@ maps(Config) when is_list(Config) ->
">>,
[],
{warnings,[{3,v3_core,bad_map}]}},
- {bad_map_literal_key,
+ {ok_map_literal_key,
<<"
t() ->
V = id(1),
@@ -614,7 +615,7 @@ maps(Config) when is_list(Config) ->
id(I) -> I.
">>,
[],
- {warnings,[{6,v3_core,nomatch}]}}],
+ []}],
run(Config, Ts),
ok.
@@ -678,6 +679,66 @@ latin1_fallback(Conf) when is_list(Conf) ->
ok.
+underscore(Config) when is_list(Config) ->
+ S0 = <<"f(A) ->
+ _VAR1 = <<A>>,
+ _VAR2 = {ok,A},
+ _VAR3 = [A],
+ ok.
+ g(A) ->
+ _VAR1 = A/0,
+ _VAR2 = date(),
+ ok.
+ h() ->
+ _VAR1 = fun() -> ok end,
+ ok.
+ i(A) ->
+ _VAR1 = #{A=>42},
+ ok.
+ ">>,
+ Ts0 = [{underscore0,
+ S0,
+ [],
+ {warnings,[{2,sys_core_fold,useless_building},
+ {3,sys_core_fold,useless_building},
+ {4,sys_core_fold,useless_building},
+ {7,sys_core_fold,result_ignored},
+ {8,sys_core_fold,{no_effect,{erlang,date,0}}},
+ {11,sys_core_fold,useless_building},
+ {14,sys_core_fold,useless_building}
+ ]}}],
+ [] = run(Config, Ts0),
+
+ %% Replace all "_VAR<digit>" variables with a plain underscore.
+ %% Now there should be no warnings.
+ S1 = re:replace(S0, "_VAR\\d+", "_", [global]),
+ io:format("~s\n", [S1]),
+ Ts1 = [{underscore1,S1,[],[]}],
+ [] = run(Config, Ts1),
+
+ 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.
%%%
@@ -699,10 +760,10 @@ run(Config, Tests) ->
%% Compiles a test module and returns the list of errors and warnings.
run_test(Conf, Test0, Warnings) ->
- Mod = "warnings_"++test_lib:uniq(),
- Filename = Mod ++ ".erl",
+ Module = "warnings_"++test_lib:uniq(),
+ Filename = Module ++ ".erl",
?line DataDir = ?privdir,
- Test = ["-module(", Mod, "). ", Test0],
+ Test = ["-module(", Module, "). ", Test0],
?line File = filename:join(DataDir, Filename),
?line Opts = [binary,export_all,return|Warnings],
?line ok = file:write_file(File, Test),