aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/doc/src/book.xml4
-rw-r--r--lib/compiler/doc/src/compile.xml21
-rw-r--r--lib/compiler/doc/src/fascicules.xml2
-rw-r--r--lib/compiler/doc/src/notes_history.xml4
-rw-r--r--lib/compiler/doc/src/part_notes.xml4
-rw-r--r--lib/compiler/doc/src/part_notes_history.xml4
-rw-r--r--lib/compiler/doc/src/ref_man.xml4
-rw-r--r--lib/compiler/src/beam_a.erl6
-rw-r--r--lib/compiler/src/beam_asm.erl2
-rw-r--r--lib/compiler/src/beam_block.erl27
-rw-r--r--lib/compiler/src/beam_bsm.erl1
-rw-r--r--lib/compiler/src/beam_clean.erl30
-rw-r--r--lib/compiler/src/beam_dict.erl20
-rw-r--r--lib/compiler/src/beam_disasm.erl58
-rw-r--r--lib/compiler/src/beam_except.erl10
-rw-r--r--lib/compiler/src/beam_flatten.erl5
-rw-r--r--lib/compiler/src/beam_jump.erl16
-rw-r--r--lib/compiler/src/beam_split.erl7
-rw-r--r--lib/compiler/src/beam_type.erl6
-rw-r--r--lib/compiler/src/beam_utils.erl8
-rw-r--r--lib/compiler/src/beam_validator.erl100
-rw-r--r--lib/compiler/src/beam_z.erl16
-rw-r--r--lib/compiler/src/cerl.erl68
-rw-r--r--lib/compiler/src/cerl_inline.erl48
-rw-r--r--lib/compiler/src/cerl_trees.erl48
-rw-r--r--lib/compiler/src/compile.erl39
-rw-r--r--lib/compiler/src/compiler.appup.src22
-rw-r--r--lib/compiler/src/core_lib.erl4
-rw-r--r--lib/compiler/src/core_lint.erl19
-rw-r--r--lib/compiler/src/core_parse.hrl9
-rw-r--r--lib/compiler/src/core_parse.yrl37
-rw-r--r--lib/compiler/src/core_pp.erl21
-rw-r--r--lib/compiler/src/core_scan.erl5
-rwxr-xr-xlib/compiler/src/genop.tab8
-rw-r--r--lib/compiler/src/rec_env.erl5
-rw-r--r--lib/compiler/src/sys_core_dsetel.erl12
-rw-r--r--lib/compiler/src/sys_core_fold.erl725
-rw-r--r--lib/compiler/src/sys_pre_expand.erl35
-rw-r--r--lib/compiler/src/v3_codegen.erl114
-rw-r--r--lib/compiler/src/v3_core.erl724
-rw-r--r--lib/compiler/src/v3_kernel.erl153
-rw-r--r--lib/compiler/src/v3_kernel.hrl2
-rw-r--r--lib/compiler/src/v3_kernel_pp.erl18
-rw-r--r--lib/compiler/src/v3_life.erl14
-rw-r--r--lib/compiler/test/Makefile3
-rw-r--r--lib/compiler/test/andor_SUITE.erl6
-rw-r--r--lib/compiler/test/beam_except_SUITE.erl10
-rw-r--r--lib/compiler/test/bs_bincomp_SUITE.erl38
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl15
-rw-r--r--lib/compiler/test/compilation_SUITE.erl16
-rw-r--r--lib/compiler/test/compile_SUITE.erl123
-rw-r--r--lib/compiler/test/compile_SUITE_data/small.erl48
-rw-r--r--lib/compiler/test/compile_SUITE_data/small_maps.erl16
-rw-r--r--lib/compiler/test/core_SUITE.erl9
-rw-r--r--lib/compiler/test/core_SUITE_data/eval_case.core34
-rw-r--r--lib/compiler/test/core_SUITE_data/map_core_test.core95
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl43
-rw-r--r--lib/compiler/test/error_SUITE.erl19
-rw-r--r--lib/compiler/test/fun_SUITE.erl13
-rw-r--r--lib/compiler/test/inline_SUITE.erl3
-rw-r--r--lib/compiler/test/inline_SUITE_data/maps_inline_test.erl70
-rw-r--r--lib/compiler/test/map_SUITE.erl534
-rw-r--r--lib/compiler/test/warnings_SUITE.erl10
63 files changed, 2812 insertions, 778 deletions
diff --git a/lib/compiler/doc/src/book.xml b/lib/compiler/doc/src/book.xml
index fc56a837d5..45b49fe46d 100644
--- a/lib/compiler/doc/src/book.xml
+++ b/lib/compiler/doc/src/book.xml
@@ -1,10 +1,10 @@
-<?xml version="1.0" encoding="latin1" ?>
+<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE book SYSTEM "book.dtd">
<book xmlns:xi="http://www.w3.org/2001/XInclude">
<header titlestyle="normal">
<copyright>
- <year>1997</year><year>2009</year>
+ <year>1997</year><year>2013</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml
index f1238f27a6..c66c8ea4bf 100644
--- a/lib/compiler/doc/src/compile.xml
+++ b/lib/compiler/doc/src/compile.xml
@@ -1,10 +1,10 @@
-<?xml version="1.0" encoding="latin1" ?>
+<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE erlref SYSTEM "erlref.dtd">
<erlref>
<header>
<copyright>
- <year>1996</year><year>2012</year>
+ <year>1996</year><year>2013</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -350,12 +350,18 @@ module.beam: module.erl \
parsed code before the code is checked for errors.</p>
</item>
- <tag><c>asm</c></tag>
+ <tag><c>from_asm</c></tag>
<item>
<p>The input file is expected to be assembler code (default
file suffix ".S"). Note that the format of assembler files
- is not documented, and may change between releases - this
- option is primarily for internal debugging use.</p>
+ is not documented, and may change between releases.</p>
+ </item>
+
+ <tag><c>from_core</c></tag>
+ <item>
+ <p>The input file is expected to be core code (default
+ file suffix ".core"). Note that the format of core files
+ is not documented, and may change between releases.</p>
</item>
<tag><c>no_strict_record_tests</c></tag>
@@ -402,6 +408,11 @@ module.beam: module.erl \
<code>-compile({no_auto_import,[error/1]}).</code>
</item>
+ <tag><c>no_auto_import</c></tag>
+ <item>
+ <p>Do not auto import any functions from the module <c>erlang</c>.</p>
+ </item>
+
<tag><c>no_line_info</c></tag>
<item>
diff --git a/lib/compiler/doc/src/fascicules.xml b/lib/compiler/doc/src/fascicules.xml
index 43090b4aed..fadd37eefb 100644
--- a/lib/compiler/doc/src/fascicules.xml
+++ b/lib/compiler/doc/src/fascicules.xml
@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="latin1" ?>
+<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE fascicules SYSTEM "fascicules.dtd">
<fascicules>
diff --git a/lib/compiler/doc/src/notes_history.xml b/lib/compiler/doc/src/notes_history.xml
index db0dc2f683..9e8934f416 100644
--- a/lib/compiler/doc/src/notes_history.xml
+++ b/lib/compiler/doc/src/notes_history.xml
@@ -1,10 +1,10 @@
-<?xml version="1.0" encoding="latin1" ?>
+<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE chapter SYSTEM "chapter.dtd">
<chapter>
<header>
<copyright>
- <year>2006</year><year>2009</year>
+ <year>2006</year><year>2013</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
diff --git a/lib/compiler/doc/src/part_notes.xml b/lib/compiler/doc/src/part_notes.xml
index e730e3f7e2..0c1fdd567d 100644
--- a/lib/compiler/doc/src/part_notes.xml
+++ b/lib/compiler/doc/src/part_notes.xml
@@ -1,10 +1,10 @@
-<?xml version="1.0" encoding="latin1" ?>
+<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE part SYSTEM "part.dtd">
<part xmlns:xi="http://www.w3.org/2001/XInclude">
<header>
<copyright>
- <year>2004</year><year>2009</year>
+ <year>2004</year><year>2013</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
diff --git a/lib/compiler/doc/src/part_notes_history.xml b/lib/compiler/doc/src/part_notes_history.xml
index 12366f0006..a4909f156e 100644
--- a/lib/compiler/doc/src/part_notes_history.xml
+++ b/lib/compiler/doc/src/part_notes_history.xml
@@ -1,11 +1,11 @@
-<?xml version="1.0" encoding="latin1" ?>
+<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE part SYSTEM "part.dtd">
<part>
<header>
<copyright>
<year>2006</year>
- <year>2011</year>
+ <year>2013</year>
<holder>Ericsson AB, All Rights Reserved</holder>
</copyright>
<legalnotice>
diff --git a/lib/compiler/doc/src/ref_man.xml b/lib/compiler/doc/src/ref_man.xml
index 74fe45aa77..6478ad4b11 100644
--- a/lib/compiler/doc/src/ref_man.xml
+++ b/lib/compiler/doc/src/ref_man.xml
@@ -1,10 +1,10 @@
-<?xml version="1.0" encoding="latin1" ?>
+<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE application SYSTEM "application.dtd">
<application xmlns:xi="http://www.w3.org/2001/XInclude">
<header>
<copyright>
- <year>1996</year><year>2009</year>
+ <year>1996</year><year>2013</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl
index c590c5e35b..fe4f473846 100644
--- a/lib/compiler/src/beam_a.erl
+++ b/lib/compiler/src/beam_a.erl
@@ -88,6 +88,12 @@ rename_instr({bs_private_append=I,F,Sz,U,Src,Flags,Dst}) ->
{bs_init,F,{I,U,Flags},none,[Sz,Src],Dst};
rename_instr(bs_init_writable=I) ->
{bs_init,{f,0},I,1,[{x,0}],{x,0}};
+rename_instr({put_map_assoc,Fail,S,D,R,L}) ->
+ {put_map,Fail,assoc,S,D,R,L};
+rename_instr({put_map_exact,Fail,S,D,R,L}) ->
+ {put_map,Fail,exact,S,D,R,L};
+rename_instr({test,has_map_fields,Fail,Src,{list,List}}) ->
+ {test,has_map_fields,Fail,[Src|List]};
rename_instr({select_val=I,Reg,Fail,{list,List}}) ->
{select,I,Reg,Fail,List};
rename_instr({select_tuple_arity=I,Reg,Fail,{list,List}}) ->
diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index 112b087f3c..f8cf178d2e 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -324,6 +324,8 @@ make_op({gc_bif,Bif,Fail,Live,Args,Dest}, Dict) ->
encode_op(BifOp, [Fail,Live,{extfunc,erlang,Bif,Arity}|Args++[Dest]],Dict);
make_op({bs_add=Op,Fail,[Src1,Src2,Unit],Dest}, Dict) ->
encode_op(Op, [Fail,Src1,Src2,Unit,Dest], Dict);
+make_op({test,Cond,Fail,Src,{list,_}=Ops}, Dict) ->
+ encode_op(Cond, [Fail,Src,Ops], Dict);
make_op({test,Cond,Fail,Ops}, Dict) when is_list(Ops) ->
encode_op(Cond, [Fail|Ops], Dict);
make_op({test,Cond,Fail,Live,[Op|Ops],Dst}, Dict) when is_list(Ops) ->
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index cf5244e1ce..7a30c68593 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -123,15 +123,24 @@ is_last_bool([], _) -> false.
collect_block(Is) ->
collect_block(Is, []).
+collect_block([{allocate,N,R}|Is0], Acc) ->
+ {Inits,Is} = lists:splitwith(fun ({init,{y,_}}) -> true;
+ (_) -> false
+ end, Is0),
+ collect_block(Is, [{set,[],[],{alloc,R,{nozero,N,0,Inits}}}|Acc]);
collect_block([{allocate_zero,Ns,R},{test_heap,Nh,R}|Is], Acc) ->
- collect_block(Is, [{set,[],[],{alloc,R,{no_opt,Ns,Nh,[]}}}|Acc]);
+ collect_block(Is, [{set,[],[],{alloc,R,{zero,Ns,Nh,[]}}}|Acc]);
collect_block([I|Is]=Is0, Acc) ->
case collect(I) of
error -> {reverse(Acc),Is0};
Instr -> collect_block(Is, [Instr|Acc])
end.
+collect({allocate,N,R}) -> {set,[],[],{alloc,R,{nozero,N,0,[]}}};
collect({allocate_zero,N,R}) -> {set,[],[],{alloc,R,{zero,N,0,[]}}};
+collect({allocate_heap,Ns,Nh,R}) -> {set,[],[],{alloc,R,{nozero,Ns,Nh,[]}}};
+collect({allocate_heap_zero,Ns,Nh,R}) -> {set,[],[],{alloc,R,{zero,Ns,Nh,[]}}};
+collect({init,D}) -> {set,[D],[],init};
collect({test_heap,N,R}) -> {set,[],[],{alloc,R,{nozero,nostack,N,[]}}};
collect({bif,N,F,As,D}) -> {set,[D],As,{bif,N,F}};
collect({gc_bif,N,F,R,As,D}) -> {set,[D],As,{alloc,R,{gc_bif,N,F}}};
@@ -143,7 +152,15 @@ collect({get_tuple_element,S,I,D}) -> {set,[D],[S],{get_tuple_element,I}};
collect({set_tuple_element,S,D,I}) -> {set,[],[S,D],{set_tuple_element,I}};
collect({get_list,S,D1,D2}) -> {set,[D1,D2],[S],get_list};
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}};
collect({'catch',R,L}) -> {set,[R],[],{'catch',L}};
+collect(fclearerror) -> {set,[],[],fclearerror};
+collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror};
+collect({fmove,S,D}) -> {set,[D],[S],fmove};
+collect({fconv,S,D}) -> {set,[D],[S],fconv};
collect(_) -> error.
%% embed_lines([Instruction]) -> [Instruction]
@@ -223,6 +240,7 @@ move_allocates_2(Alloc, [], Acc) ->
alloc_may_pass({set,_,_,{alloc,_,_}}) -> false;
alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false;
+alloc_may_pass({set,_,_,{get_map_elements,_}}) -> false;
alloc_may_pass({set,_,_,put_list}) -> false;
alloc_may_pass({set,_,_,put}) -> false;
alloc_may_pass({set,_,_,_}) -> true.
@@ -273,7 +291,11 @@ opt_moves([X0,Y0], Is0) ->
not_possible -> {[X,Y0],Is2};
{X,_} -> {[X,Y0],Is2};
{Y,Is} -> {[X,Y],Is}
- end.
+ end;
+opt_moves(Ds, Is) ->
+ %% multiple destinations -> pass through
+ {Ds,Is}.
+
%% opt_move(Dest, [Instruction]) -> {UpdatedDest,[Instruction]} | not_possible
%% If there is a {move,Dest,FinalDest} instruction
@@ -370,6 +392,7 @@ gen_init(Fs, Regs, Y, Acc) ->
init_yreg([{set,_,_,{bif,_,_}}|_], Reg) -> Reg;
init_yreg([{set,_,_,{alloc,_,{gc_bif,_,_}}}|_], Reg) -> Reg;
+init_yreg([{set,_,_,{alloc,_,{put_map,_,_}}}|_], Reg) -> Reg;
init_yreg([{set,Ds,_,_}|Is], Reg) -> init_yreg(Is, add_yregs(Ds, Reg));
init_yreg(_Is, Reg) -> Reg.
diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl
index fdfcb08125..d54c2a9fde 100644
--- a/lib/compiler/src/beam_bsm.erl
+++ b/lib/compiler/src/beam_bsm.erl
@@ -209,6 +209,7 @@ btb_reaches_match_2([{call,Arity,{f,Lbl}}|Is], Regs, D) ->
btb_reaches_match_2([{apply,Arity}|Is], Regs, D) ->
btb_call(Arity+2, apply, Regs, Is, D);
btb_reaches_match_2([{call_fun,Live}=I|Is], Regs, D) ->
+ btb_ensure_not_used([{x,Live}], I, Regs),
btb_call(Live, I, Regs, Is, D);
btb_reaches_match_2([{make_fun2,_,_,_,Live}|Is], Regs, D) ->
btb_call(Live, make_fun2, Regs, Is, D);
diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl
index 9d89e21a4e..b653998252 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -234,6 +234,36 @@ 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);
+replace([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D) when Lbl =/= 0 ->
+ replace(Is, [{I,{f,label(Lbl, D)},Src,List}|Acc], D);
replace([I|Is], Acc, D) ->
replace(Is, [I|Acc], D);
replace([], Acc, _) -> Acc.
diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl
index 212b9fb03a..ea51673fa3 100644
--- a/lib/compiler/src/beam_dict.erl
+++ b/lib/compiler/src/beam_dict.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1998-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
@@ -29,16 +29,24 @@
-type label() :: non_neg_integer().
+-type index() :: non_neg_integer().
+
+-type atom_tab() :: gb_trees:tree(atom(), index()).
+-type import_tab() :: gb_trees:tree(mfa(), index()).
+-type fname_tab() :: gb_trees:tree(Name :: term(), index()).
+-type line_tab() :: gb_trees:tree({Fname :: index(), Line :: term()}, index()).
+-type literal_tab() :: dict:dict(Literal :: term(), index()).
+
-record(asm,
- {atoms = gb_trees:empty() :: gb_tree(), %{Atom,Index}
+ {atoms = gb_trees:empty() :: atom_tab(),
exports = [] :: [{label(), arity(), label()}],
locals = [] :: [{label(), arity(), label()}],
- imports = gb_trees:empty() :: gb_tree(), %{{M,F,A},Index}
+ imports = gb_trees:empty() :: import_tab(),
strings = <<>> :: binary(), %String pool
lambdas = [], %[{...}]
- literals = dict:new() :: dict(), %Format: {Literal,Number}
- fnames = gb_trees:empty() :: gb_tree(), %{Name,Index}
- lines = gb_trees:empty() :: gb_tree(), %{{Fname,Line},Index}
+ literals = dict:new() :: literal_tab(),
+ fnames = gb_trees:empty() :: fname_tab(),
+ lines = gb_trees:empty() :: line_tab(),
num_lines = 0 :: non_neg_integer(), %Number of line instructions
next_import = 0 :: non_neg_integer(),
string_offset = 0 :: non_neg_integer(),
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index 1a8bbcee22..4bdfe4e0c2 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2000-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
@@ -37,7 +37,8 @@
%%-----------------------------------------------------------------------
--type literals() :: 'none' | gb_tree().
+-type index() :: non_neg_integer().
+-type literals() :: 'none' | gb_trees:tree(index(), term()).
-type symbolic_tag() :: 'a' | 'f' | 'h' | 'i' | 'u' | 'x' | 'y' | 'z'.
-type disasm_tag() :: symbolic_tag() | 'fr' | 'atom' | 'float' | 'literal'.
-type disasm_term() :: 'nil' | {disasm_tag(), _}.
@@ -216,7 +217,8 @@ optional_chunk(F, ChunkTag) ->
%%-----------------------------------------------------------------------
-type l_info() :: {non_neg_integer(), {_,_,_,_,_,_}}.
--spec beam_disasm_lambdas('none' | binary(), gb_tree()) -> 'none' | [l_info()].
+-spec beam_disasm_lambdas('none' | binary(), gb_trees:tree(index(), _)) ->
+ 'none' | [l_info()].
beam_disasm_lambdas(none, _) -> none;
beam_disasm_lambdas(<<_:32,Tab/binary>>, Atoms) ->
@@ -365,6 +367,14 @@ disasm_instr(B, Bs, Atoms, Literals) ->
disasm_select_inst(select_val, Bs, Atoms, Literals);
select_tuple_arity ->
disasm_select_inst(select_tuple_arity, Bs, Atoms, Literals);
+ put_map_assoc ->
+ disasm_map_inst(put_map_assoc, Arity, Bs, Atoms, Literals);
+ put_map_exact ->
+ disasm_map_inst(put_map_exact, Arity, Bs, Atoms, Literals);
+ get_map_elements ->
+ disasm_map_inst(get_map_elements, Arity, Bs, Atoms, Literals);
+ has_map_fields ->
+ disasm_map_inst(has_map_fields, Arity, Bs, Atoms, Literals);
_ ->
try decode_n_args(Arity, Bs, Atoms, Literals) of
{Args, RestBs} ->
@@ -395,6 +405,16 @@ disasm_select_inst(Inst, Bs, Atoms, Literals) ->
{List, RestBs} = decode_n_args(Len, Bs4, Atoms, Literals),
{{Inst, [X,F,{Z,U,List}]}, RestBs}.
+disasm_map_inst(Inst, Arity, Bs0, Atoms, Literals) ->
+ {Args0,Bs1} = decode_n_args(Arity, Bs0, Atoms, Literals),
+ %% no droplast ..
+ [Z|Args1] = lists:reverse(Args0),
+ Args = lists:reverse(Args1),
+ {U, Bs2} = decode_arg(Bs1, Atoms, Literals),
+ {u, Len} = U,
+ {List, RestBs} = decode_n_args(Len, Bs2, Atoms, Literals),
+ {{Inst, Args ++ [{Z,U,List}]}, RestBs}.
+
%%-----------------------------------------------------------------------
%% decode_arg([Byte]) -> {Arg, [Byte]}
%%
@@ -417,11 +437,12 @@ decode_arg([B|Bs]) ->
decode_int(Tag, B, Bs)
end.
--spec decode_arg([byte(),...], gb_tree(), literals()) -> {disasm_term(), [byte()]}.
+-spec decode_arg([byte(),...], gb_trees:tree(index(), _), literals()) ->
+ {disasm_term(), [byte()]}.
decode_arg([B|Bs0], Atoms, Literals) ->
Tag = decode_tag(B band 2#111),
- ?NO_DEBUG('Tag = ~p, B = ~p, Bs = ~p~n', [Tag, B, Bs]),
+ ?NO_DEBUG('Tag = ~p, B = ~p, Bs = ~p~n', [Tag, B, Bs0]),
case Tag of
z ->
decode_z_tagged(Tag, B, Bs0, Literals);
@@ -1119,6 +1140,33 @@ resolve_inst({line,[Index]},_,_,_) ->
{line,resolve_arg(Index)};
%%
+%% 17.0
+%%
+resolve_inst({put_map_assoc,Args},_,_,_) ->
+ [FLbl,Src,Dst,{u,N},{{z,1},{u,_Len},List0}] = Args,
+ List = resolve_args(List0),
+ {put_map_assoc,FLbl,Src,Dst,N,{list,List}};
+
+resolve_inst({put_map_exact,Args},_,_,_) ->
+ [FLbl,Src,Dst,{u,N},{{z,1},{u,_Len},List0}] = Args,
+ List = resolve_args(List0),
+ {put_map_exact,FLbl,Src,Dst,N,{list,List}};
+
+resolve_inst({is_map,Args0},_,_,_) ->
+ [FLbl|Args] = resolve_args(Args0),
+ {test, is_map, FLbl, Args};
+
+resolve_inst({has_map_fields,Args0},_,_,_) ->
+ [FLbl,Src,{{z,1},{u,_Len},List0}] = Args0,
+ List = resolve_args(List0),
+ {test,has_map_fields,FLbl,Src,{list,List}};
+
+resolve_inst({get_map_elements,Args0},_,_,_) ->
+ [FLbl,Src,{{z,1},{u,_Len},List0}] = Args0,
+ List = resolve_args(List0),
+ {get_map_elements,FLbl,Src,{list,List}};
+
+%%
%% Catches instructions that are not yet handled.
%%
resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}).
diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl
index e5ec1bd904..d261809765 100644
--- a/lib/compiler/src/beam_except.erl
+++ b/lib/compiler/src/beam_except.erl
@@ -131,9 +131,13 @@ translate_exception(_, _, _, _) -> no.
fix_block(Is, 0) ->
reverse(Is);
-fix_block(Is0, Words) ->
- [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is] = reverse(Is0),
- [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is].
+fix_block(Is, Words) ->
+ fix_block_1(reverse(Is), Words).
+
+fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is], Words) ->
+ [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is];
+fix_block_1([I|Is], Words) ->
+ [I|fix_block_1(Is, Words)].
dig_out_block_fc([{set,[],[],{alloc,Live,_}}|Bl]) ->
case dig_out_fc(Bl, Live-1, nil) of
diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl
index 25428c0c10..46835bece1 100644
--- a/lib/compiler/src/beam_flatten.erl
+++ b/lib/compiler/src/beam_flatten.erl
@@ -51,6 +51,7 @@ norm_block([], Acc) -> Acc.
norm({set,[D],As,{bif,N,F}}) -> {bif,N,F,As,D};
norm({set,[D],As,{alloc,R,{gc_bif,N,F}}}) -> {gc_bif,N,F,R,As,D};
+norm({set,[D],[],init}) -> {init,D};
norm({set,[D],[S],move}) -> {move,S,D};
norm({set,[D],[S],fmove}) -> {fmove,S,D};
norm({set,[D],[S],fconv}) -> {fconv,S,D};
@@ -60,6 +61,10 @@ norm({set,[],[S],put}) -> {put,S};
norm({set,[D],[S],{get_tuple_element,I}}) -> {get_tuple_element,S,I,D};
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}};
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 b29a3565e4..0fc8d45c80 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -202,19 +202,19 @@ is_label(_) -> false.
move(Is) ->
move_1(Is, [], []).
-move_1([I|Is], End0, Acc0) ->
+move_1([I|Is], Ends, Acc0) ->
case is_exit_instruction(I) of
false ->
- move_1(Is, End0, [I|Acc0]);
+ move_1(Is, Ends, [I|Acc0]);
true ->
- case extract_seq(Acc0, [I|End0]) of
+ case extract_seq(Acc0, [I]) of
no ->
- move_1(Is, End0, [I|Acc0]);
+ move_1(Is, Ends, [I|Acc0]);
{yes,End,Acc} ->
- move_1(Is, End, Acc)
+ move_1(Is, [End|Ends], Acc)
end
end;
-move_1([], End, Acc) -> reverse(Acc, End).
+move_1([], Ends, Acc) -> reverse(Acc, lists:append(reverse(Ends))).
extract_seq([{line,_}=Line|Is], Acc) ->
extract_seq(Is, [Line|Acc]);
@@ -527,6 +527,10 @@ ulbl({bs_init,Lbl,_,_,_,_}, Used) ->
mark_used(Lbl, Used);
ulbl({bs_put,Lbl,_,_}, Used) ->
mark_used(Lbl, Used);
+ulbl({put_map,Lbl,_Op,_Src,_Dst,_Live,_List}, Used) ->
+ mark_used(Lbl, Used);
+ulbl({get_map_elements,Lbl,_Src,_List}, Used) ->
+ mark_used(Lbl, Used);
ulbl(_, Used) -> Used.
mark_used({f,0}, Used) -> Used;
diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl
index cacaaebffe..688bba9a94 100644
--- a/lib/compiler/src/beam_split.erl
+++ b/lib/compiler/src/beam_split.erl
@@ -49,6 +49,13 @@ split_block([{set,[R],As,{bif,N,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 ->
split_block([{set,[R],As,{alloc,Live,{gc_bif,N,{f,Lbl}=Fail}}}|Is], Bl, Acc)
when Lbl =/= 0 ->
split_block(Is, [], [{gc_bif,N,Fail,Live,As,R}|make_block(Bl, Acc)]);
+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(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)]);
split_block([{set,[],[],{line,_}=Line}|Is], Bl, Acc) ->
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index 3ec57a67da..58c0f765ae 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -142,6 +142,12 @@ simplify_float(Is0, Ts0) ->
throw:not_possible -> not_possible
end.
+simplify_float_1([{set,[],[],fclearerror}|Is], Ts, Rs, Acc) ->
+ simplify_float_1(Is, Ts, Rs, clearerror(Acc));
+simplify_float_1([{set,[],[],fcheckerror}|Is], Ts, Rs, Acc) ->
+ simplify_float_1(Is, Ts, Rs, checkerror(Acc));
+simplify_float_1([{set,[{fr,_}],_,_}=I|Is], Ts, Rs, Acc) ->
+ simplify_float_1(Is, Ts, Rs, [I|Acc]);
simplify_float_1([{set,[D0],[A0],{alloc,_,{gc_bif,'-',{f,0}}}}=I|Is]=Is0,
Ts0, Rs0, Acc0) ->
case tdb_find(A0, Ts0) of
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index e9911fefd9..27034aecce 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -152,6 +152,7 @@ bif_to_test(is_function, [_]=Ops, Fail) -> {test,is_function,Fail,Ops};
bif_to_test(is_function, [_,_]=Ops, Fail) -> {test,is_function2,Fail,Ops};
bif_to_test(is_integer, [_]=Ops, Fail) -> {test,is_integer,Fail,Ops};
bif_to_test(is_list, [_]=Ops, Fail) -> {test,is_list,Fail,Ops};
+bif_to_test(is_map, [_]=Ops, Fail) -> {test,is_map,Fail,Ops};
bif_to_test(is_number, [_]=Ops, Fail) -> {test,is_number,Fail,Ops};
bif_to_test(is_pid, [_]=Ops, Fail) -> {test,is_pid,Fail,Ops};
bif_to_test(is_port, [_]=Ops, Fail) -> {test,is_port,Fail,Ops};
@@ -184,6 +185,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,Op,_,Ops}) ->
erl_internal:new_type_test(Op, length(Ops)).
@@ -759,6 +761,12 @@ 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) ->
+ live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{recv_mark,_}=I|Is], Regs, D, Acc) ->
+ live_opt(Is, Regs, D, [I|Acc]);
live_opt([], _, _, Acc) -> Acc.
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 48f5135aca..9d5563d13b 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2004-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
@@ -213,9 +213,12 @@ 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', _}).
+
-record(st, %Emulation state
- {x=init_regs(0, term) :: gb_tree(), %x register info.
- y=init_regs(0, initialized) :: gb_tree(), %y register info.
+ {x=init_regs(0, term) :: reg_tab(),%x register info.
+ y=init_regs(0, initialized) :: reg_tab(),%y register info.
f=init_fregs(), %
numy=none, %Number of y registers.
h=0, %Available heap size.
@@ -227,11 +230,16 @@ validate_error_1(Error, Module, Name, Ar) ->
setelem=false %Previous instruction was setelement/3.
}).
+-type label() :: integer().
+-type label_set() :: gb_sets:set(label()).
+-type branched_tab() :: gb_trees:tree(label(), #st{}).
+-type ft_tab() :: gb_trees:tree().
+
-record(vst, %Validator state
{current=none :: #st{} | 'none', %Current state
- branched=gb_trees:empty() :: gb_tree(), %States at jumps
- labels=gb_sets:empty() :: gb_set(), %All defined labels
- ft=gb_trees:empty() :: gb_tree() %Some other functions
+ branched=gb_trees:empty() :: branched_tab(), %States at jumps
+ labels=gb_sets:empty() :: label_set(), %All defined labels
+ ft=gb_trees:empty() :: ft_tab() %Some other functions
% in the module (those that start with bs_start_match2).
}).
@@ -574,6 +582,7 @@ valfun_4({apply,Live}, Vst) ->
valfun_4({apply_last,Live,_}, Vst) ->
tail_call(apply, Live+2, Vst);
valfun_4({call_fun,Live}, Vst) ->
+ validate_src([{x,Live}], Vst),
call('fun', Live+1, Vst);
valfun_4({call,Live,Func}, Vst) ->
call(Func, Live, Vst);
@@ -769,6 +778,10 @@ valfun_4({test,is_nonempty_list,{f,Lbl},[Cons]}, Vst) ->
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_strict_literal_termorder(List),
+ branch_state(Lbl, Vst);
valfun_4({test,_Op,{f,Lbl},Src}, Vst) ->
validate_src(Src, Vst),
branch_state(Lbl, Vst);
@@ -865,9 +878,38 @@ valfun_4({bs_final,{f,Fail},Dst}, Vst0) ->
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);
+valfun_4({put_map_exact,{f,Fail},Src,Dst,Live,{list,List}}, Vst) ->
+ verify_put_map(Fail, Src, Dst, Live, List, Vst);
+valfun_4({get_map_elements,{f,Fail},Src,{list,List}}, Vst) ->
+ verify_get_map(Fail, Src, List, Vst);
valfun_4(_, _) ->
error(unknown_instruction).
+verify_get_map(Fail, Src, List, Vst0) ->
+ assert_term(Src, Vst0),
+ Vst1 = branch_state(Fail, Vst0),
+ Lits = mmap(fun(L,_R) -> [L] end, List),
+ assert_strict_literal_termorder(Lits),
+ verify_get_map_pair(List,Vst0,Vst1).
+
+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) ->
+ 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).
+
%%
%% Common code for validating bs_get* instructions.
%%
@@ -888,7 +930,7 @@ validate_bs_skip_utf(Fail, Ctx, Live, Vst0) ->
branch_state(Fail, Vst).
%%
-%% Special state handling for setelement/3 and the set_tuple_element/3 instruction.
+%% Special state handling for setelement/3 and set_tuple_element/3 instructions.
%% A possibility for garbage collection must not occur between setelement/3 and
%% set_tuple_element/3.
%%
@@ -1078,6 +1120,39 @@ assert_freg_set({fr,Fr}=Freg, #vst{current=#st{f=Fregs}})
end;
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),
+ case check_strict_value_termorder(Vs) of
+ true -> ok;
+ false -> error({not_strict_order, Ls})
+ 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.
%%%
@@ -1313,6 +1388,7 @@ assert_term(Src, Vst) ->
%% number Integer or Float of unknown value
%%
+
assert_type(WantedType, Term, Vst) ->
assert_type(WantedType, get_term_type(Term, Vst)).
@@ -1328,7 +1404,6 @@ assert_type({tuple_element,I}, {tuple,Sz})
assert_type(Needed, Actual) ->
error({bad_type,{needed,Needed},{actual,Actual}}).
-
%% upgrade_tuple_type(NewTupleType, OldType) -> TupleType.
%% upgrade_tuple_type/2 is used when linear code finds out more and
%% more information about a tuple type, so that the type gets more
@@ -1409,6 +1484,15 @@ get_term_type_1({y,Y}=Reg, #vst{current=#st{y=Ys}}) when is_integer(Y) ->
get_term_type_1(Src, _) -> error({bad_source,Src}).
+%% get_literal(Src) -> literal_value().
+get_literal(nil) -> [];
+get_literal({atom,A}) when is_atom(A) -> A;
+get_literal({float,F}) when is_float(F) -> F;
+get_literal({integer,I}) when is_integer(I) -> I;
+get_literal({literal,L}) -> L;
+get_literal(T) -> error({not_literal,T}).
+
+
branch_arities([], _, #vst{}=Vst) -> Vst;
branch_arities([Sz,{f,L}|T], Tuple, #vst{current=St}=Vst0)
when is_integer(Sz) ->
diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl
index 8c6b0c916d..c2a6ef604e 100644
--- a/lib/compiler/src/beam_z.erl
+++ b/lib/compiler/src/beam_z.erl
@@ -74,6 +74,22 @@ undo_rename({bs_init,F,{I,Extra,U,Flags},Live,[Sz,Src],Dst}) ->
{I,F,Sz,Extra,Live,U,Src,Flags,Dst};
undo_rename({bs_init,_,bs_init_writable=I,_,_,_}) ->
I;
+undo_rename({put_map,Fail,assoc,S,D,R,L}) ->
+ {put_map_assoc,Fail,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]}};
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 4b74d60e9f..3c121f3b04 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -120,7 +120,17 @@
update_c_bitstr/5, update_c_bitstr/6, ann_c_bitstr/5,
ann_c_bitstr/6, is_c_bitstr/1, bitstr_val/1, bitstr_size/1,
bitstr_bitsize/1, bitstr_unit/1, bitstr_type/1,
- bitstr_flags/1]).
+ bitstr_flags/1,
+
+ %% keep map exports here for now
+ map_es/1,
+ map_val/1,
+ update_c_map/3,
+ ann_c_map/3,
+ map_pair_op/1,map_pair_key/1,map_pair_val/1,
+ update_c_map_pair/4,
+ ann_c_map_pair/4
+ ]).
-export_type([c_binary/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, c_literal/0,
c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]).
@@ -145,6 +155,8 @@
-type c_let() :: #c_let{}.
-type c_letrec() :: #c_letrec{}.
-type c_literal() :: #c_literal{}.
+-type c_map() :: #c_map{}.
+-type c_map_pair() :: #c_map_pair{}.
-type c_module() :: #c_module{}.
-type c_primop() :: #c_primop{}.
-type c_receive() :: #c_receive{}.
@@ -155,9 +167,10 @@
-type c_var() :: #c_var{}.
-type cerl() :: c_alias() | c_apply() | c_binary() | c_bitstr()
- | c_call() | c_case() | c_catch() | c_clause() | c_cons()
+ | c_call() | c_case() | c_catch() | c_clause() | c_cons()
| c_fun() | c_let() | c_letrec() | c_literal()
- | c_module() | c_primop() | c_receive() | c_seq()
+ | c_map() | c_map_pair()
+ | c_module() | c_primop() | c_receive() | c_seq()
| c_try() | c_tuple() | c_values() | c_var().
%% =====================================================================
@@ -250,8 +263,8 @@
-type ctype() :: 'alias' | 'apply' | 'binary' | 'bitrst' | 'call' | 'case'
| 'catch' | 'clause' | 'cons' | 'fun' | 'let' | 'letrec'
- | 'literal' | 'module' | 'primop' | 'receive' | 'seq' | 'try'
- | 'tuple' | 'values' | 'var'.
+ | 'literal' | 'map' | 'module' | 'primop' | 'receive' | 'seq'
+ | 'try' | 'tuple' | 'values' | 'var'.
-spec type(cerl()) -> ctype().
@@ -268,6 +281,8 @@ type(#c_fun{}) -> 'fun';
type(#c_let{}) -> 'let';
type(#c_letrec{}) -> letrec;
type(#c_literal{}) -> literal;
+type(#c_map{}) -> map;
+type(#c_map_pair{}) -> map_pair;
type(#c_module{}) -> module;
type(#c_primop{}) -> primop;
type(#c_receive{}) -> 'receive';
@@ -1558,6 +1573,38 @@ ann_make_list(_, [], Node) ->
%% ---------------------------------------------------------------------
+%% maps
+
+-spec map_es(c_map()) -> [cerl()].
+
+map_es(#c_map{es = Es}) ->
+ Es.
+
+-spec map_val(c_map()) -> cerl().
+map_val(#c_map{var = M}) ->
+ M.
+
+ann_c_map(As,M,Es) ->
+ #c_map{var=M,es = Es, anno = As }.
+
+update_c_map(Old,M,Es) ->
+ #c_map{var=M, es = Es, anno = get_ann(Old)}.
+
+map_pair_key(#c_map_pair{key=K}) -> K.
+map_pair_val(#c_map_pair{val=V}) -> V.
+map_pair_op(#c_map_pair{op=Op}) -> Op.
+
+-spec ann_c_map_pair([term()], cerl(), cerl(), cerl()) ->
+ c_map_pair().
+
+ann_c_map_pair(As,Op,K,V) ->
+ #c_map_pair{op=Op, key = K, val=V, anno = As}.
+
+update_c_map_pair(Old,Op,K,V) ->
+ #c_map_pair{op=Op, key=K, val=V, anno = get_ann(Old)}.
+
+
+%% ---------------------------------------------------------------------
%% @spec c_tuple(Elements::[cerl()]) -> cerl()
%%
@@ -2945,6 +2992,10 @@ pat_vars(Node, Vs) ->
pat_vars(cons_hd(Node), pat_vars(cons_tl(Node), Vs));
tuple ->
pat_list_vars(tuple_es(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);
binary ->
pat_list_vars(binary_segments(Node), Vs);
bitstr ->
@@ -3803,7 +3854,6 @@ data_type(#c_cons{}) ->
data_type(#c_tuple{}) ->
tuple.
-
%% @spec data_es(Node::cerl()) -> [cerl()]
%%
%% @doc Returns the list of subtrees of a data constructor node. If
@@ -3835,7 +3885,6 @@ data_es(#c_cons{hd = H, tl = T}) ->
data_es(#c_tuple{es = Es}) ->
Es.
-
%% @spec data_arity(Node::cerl()) -> integer()
%%
%% @doc Returns the number of subtrees of a data constructor
@@ -3892,7 +3941,6 @@ ann_make_data(As, {atomic, V}, []) -> #c_literal{val = V, anno = As};
ann_make_data(As, cons, [H, T]) -> ann_c_cons(As, H, T);
ann_make_data(As, tuple, Es) -> ann_c_tuple(As, Es).
-
%% @spec update_data(Old::cerl(), Type::dtype(),
%% Elements::[cerl()]) -> cerl()
%% @see make_data/2
@@ -4022,6 +4070,10 @@ subtrees(T) ->
[[cons_hd(T)], [cons_tl(T)]];
tuple ->
[tuple_es(T)];
+ map ->
+ [map_es(T)];
+ map_pair ->
+ [[map_pair_op(T)],[map_pair_key(T)],[map_pair_val(T)]];
'let' ->
[let_vars(T), [let_arg(T)], [let_body(T)]];
seq ->
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index c6de63c69f..44293bb8ce 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -63,7 +63,11 @@
receive_clauses/1, receive_timeout/1, seq_arg/1,
seq_body/1, set_ann/2, try_arg/1, try_body/1, try_vars/1,
try_evars/1, try_handler/1, tuple_es/1, tuple_arity/1,
- type/1, values_es/1, var_name/1]).
+ type/1, values_es/1, var_name/1,
+ map_val/1, map_es/1, update_c_map/3,
+ update_c_map_pair/4,
+ map_pair_op/1, map_pair_key/1, map_pair_val/1
+ ]).
-import(lists, [foldl/3, foldr/3, mapfoldl/3, reverse/1]).
@@ -128,6 +132,8 @@ weight(call) -> 3; % Assume remote-calls as efficient as `apply'.
weight(primop) -> 2; % Assume more efficient than `apply'.
weight(binary) -> 4; % Initialisation base cost.
weight(bitstr) -> 3; % Coding/decoding a value; like a primop.
+weight(map) -> 4; % Initialisation base cost.
+weight(map_pair) -> 3; % Coding/decoding a value; like a primop.
weight(module) -> 1. % Like a letrec with a constant body
%% These "reference" structures are used for variables and function
@@ -333,6 +339,8 @@ i(E, Ctxt, Ren, Env, S0) ->
i_catch(E, Ctxt, Ren, Env, S);
binary ->
i_binary(E, Ren, Env, S);
+ map ->
+ i_map(E, Ctxt, Ren, Env, S);
module ->
i_module(E, Ctxt, Ren, Env, S)
end
@@ -1324,6 +1332,25 @@ 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) ->
+ %% Visit the segments for value.
+ {M1, S1} = i(map_val(E), value, Ren, Env, S),
+ {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),
+ 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}.
+
+
%% This is a simplified version of `i_pattern', for lists of parameter
%% variables only. It does not modify the state.
@@ -1383,6 +1410,16 @@ i_pattern(E, Ren, Env, Ren0, Env0, S) ->
S, binary_segments(E)),
S2 = count_size(weight(binary), S1),
{update_c_binary(E, Es), S2};
+ map ->
+ %% map patterns should not have vals
+ M = map_val(E),
+
+ {Es, S1} = mapfoldl(fun (E, S) ->
+ i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S)
+ end,
+ S, map_es(E)),
+ S2 = count_size(weight(map), S1),
+ {update_c_map(E, M, Es), S2};
_ ->
case is_literal(E) of
true ->
@@ -1416,6 +1453,15 @@ i_bitstr_pattern(E, Ren, Env, Ren0, Env0, S) ->
S3 = count_size(weight(bitstr), S2),
{update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}.
+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),
+ 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}.
+
%% ---------------------------------------------------------------------
%% Other central inlining functions
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index 1e3755025f..2ebeab243f 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -55,7 +55,15 @@
update_c_let/4, update_c_letrec/3, update_c_module/5,
update_c_primop/3, update_c_receive/4, update_c_seq/3,
update_c_try/6, update_c_tuple/2, update_c_tuple_skel/2,
- update_c_values/2, values_es/1, var_name/1]).
+ update_c_values/2, values_es/1, var_name/1,
+
+ map_val/1, map_es/1,
+ ann_c_map/3,
+ update_c_map/3,
+ map_pair_key/1,map_pair_val/1,map_pair_op/1,
+ ann_c_map_pair/4,
+ update_c_map_pair/4
+ ]).
%% ---------------------------------------------------------------------
@@ -129,6 +137,12 @@ map_1(F, T) ->
map(F, cons_tl(T)));
tuple ->
update_c_tuple_skel(T, map_list(F, tuple_es(T)));
+ map ->
+ update_c_map(T, map(F,map_val(T)), map_list(F, map_es(T)));
+ map_pair ->
+ update_c_map_pair(T, map(F, map_pair_op(T)),
+ map(F, map_pair_key(T)),
+ map(F, map_pair_val(T)));
'let' ->
update_c_let(T, map_list(F, let_vars(T)),
map(F, let_arg(T)),
@@ -235,6 +249,14 @@ fold_1(F, S, T) ->
fold(F, fold(F, S, cons_hd(T)), cons_tl(T));
tuple ->
fold_list(F, S, tuple_es(T));
+ map ->
+ fold_list(F, S, map_es(T));
+ map_pair ->
+ fold(F,
+ fold(F,
+ fold(F, S, map_pair_op(T)),
+ map_pair_key(T)),
+ map_pair_val(T));
'let' ->
fold(F, fold(F, fold_list(F, S, let_vars(T)),
let_arg(T)),
@@ -349,6 +371,15 @@ mapfold(F, S0, T) ->
tuple ->
{Ts, S1} = mapfold_list(F, S0, tuple_es(T)),
F(update_c_tuple_skel(T, Ts), S1);
+ map ->
+ {M , S1} = mapfold(F, S0, map_val(T)),
+ {Ts, S2} = mapfold_list(F, S1, map_es(T)),
+ F(update_c_map(T, M, Ts), S2);
+ map_pair ->
+ {Op, S1} = mapfold(F, S0, map_pair_op(T)),
+ {Key, S2} = mapfold(F, S1, map_pair_key(T)),
+ {Val, S3} = mapfold(F, S2, map_pair_val(T)),
+ F(update_c_map_pair(T,Op,Key,Val), S3);
'let' ->
{Vs, S1} = mapfold_list(F, S0, let_vars(T)),
{A, S2} = mapfold(F, S1, let_arg(T)),
@@ -488,6 +519,10 @@ variables(T, S) ->
variables(cons_tl(T), S));
tuple ->
vars_in_list(tuple_es(T), S);
+ map ->
+ vars_in_list(map_es(T), S);
+ map_pair ->
+ 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)),
@@ -688,6 +723,17 @@ label(T, N, Env) ->
{Ts, N1} = label_list(tuple_es(T), N, Env),
{As, N2} = label_ann(T, N1),
{ann_c_tuple_skel(As, Ts), N2};
+ map ->
+ {M, N1} = label(map_val(T), N, Env),
+ {Ts, N2} = label_list(map_es(T), N1, Env),
+ {As, N3} = label_ann(T, N2),
+ {ann_c_map(As, M, Ts), N3};
+ map_pair ->
+ {Op, N1} = label(map_pair_op(T), N, Env),
+ {Val, N2} = label(map_pair_key(T), N1, Env),
+ {Key, N3} = label(map_pair_val(T), N2, Env),
+ {As, N4} = label_ann(T, N3),
+ {ann_c_map_pair(As,Op,Key,Val), N4};
'let' ->
{A, N1} = label(let_arg(T), N, Env),
{Vs, N2, Env1} = label_vars(let_vars(T), N1, Env),
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 47d446273b..b88f9792a5 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -230,12 +230,25 @@ format_error({undef_parse_transform,M}) ->
format_error({core_transform,M,R}) ->
io_lib:format("error in core transform '~s': ~tp", [M, R]);
format_error({crash,Pass,Reason}) ->
- io_lib:format("internal error in ~p;\ncrash reason: ~tp", [Pass,Reason]);
+ io_lib:format("internal error in ~p;\ncrash reason: ~ts", [Pass,format_error_reason(Reason)]);
format_error({bad_return,Pass,Reason}) ->
- io_lib:format("internal error in ~p;\nbad return value: ~tp", [Pass,Reason]);
+ io_lib:format("internal error in ~p;\nbad return value: ~ts", [Pass,format_error_reason(Reason)]);
format_error({module_name,Mod,Filename}) ->
- io_lib:format("Module name '~s' does not match file name '~ts'",
- [Mod,Filename]).
+ io_lib:format("Module name '~s' does not match file name '~ts'", [Mod,Filename]).
+
+format_error_reason({Reason, Stack}) when is_list(Stack) ->
+ StackFun = fun
+ (escript, run, 2) -> true;
+ (escript, start, 1) -> true;
+ (init, start_it, 1) -> true;
+ (init, start_em, 1) -> true;
+ (_Mod, _Fun, _Arity) -> false
+ end,
+ FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end,
+ [io_lib:format("~tp", [Reason]),"\n\n",
+ lib:format_stacktrace(1, erlang:get_stacktrace(), StackFun, FormatFun)];
+format_error_reason(Reason) ->
+ io_lib:format("~tp", [Reason]).
%% The compile state record.
-record(compile, {filename="" :: file:filename(),
@@ -417,6 +430,9 @@ pass(from_core) ->
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()]};
@@ -606,9 +622,11 @@ core_passes() ->
[{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/1},
{iff,doldinline,{listing,"oldinline"}},
?pass(core_fold_module),
+ {iff,dcorefold,{listing,"corefold"}},
{core_inline_module,fun test_core_inliner/1,fun core_inline_module/1},
{iff,dinline,{listing,"inline"}},
- {core_fold_after_inline,fun test_core_inliner/1,fun core_fold_module/1},
+ {core_fold_after_inlining,fun test_any_inliner/1,
+ fun core_fold_module_after_inlining/1},
?pass(core_transforms)]},
{iff,dcopt,{listing,"copt"}},
{iff,'to_core',{done,"core"}}]}
@@ -1130,6 +1148,12 @@ core_fold_module(#compile{code=Code0,options=Opts,warnings=Warns}=St) ->
{ok,Code,Ws} = sys_core_fold:module(Code0, Opts),
{ok,St#compile{code=Code,warnings=Warns ++ Ws}}.
+core_fold_module_after_inlining(#compile{code=Code0,options=Opts}=St) ->
+ %% Inlining may produce code that generates spurious warnings.
+ %% Ignore all warnings.
+ {ok,Code,_Ws} = sys_core_fold:module(Code0, Opts),
+ {ok,St#compile{code=Code}}.
+
test_old_inliner(#compile{options=Opts}) ->
%% The point of this test is to avoid loading the old inliner
%% if we know that it will not be used.
@@ -1148,6 +1172,9 @@ test_core_inliner(#compile{options=Opts}) ->
end, Opts)
end.
+test_any_inliner(St) ->
+ test_old_inliner(St) orelse test_core_inliner(St).
+
core_old_inliner(#compile{code=Code0,options=Opts}=St) ->
{ok,Code} = sys_core_inline:module(Code0, Opts),
{ok,St#compile{code=Code}}.
@@ -1613,7 +1640,7 @@ compile_beam(File0, _OutFile, Opts) ->
compile_asm(File0, _OutFile, Opts) ->
File = shorten_filename(File0),
- case file(File, [asm|make_erl_options(Opts)]) of
+ case file(File, [from_asm|make_erl_options(Opts)]) of
{ok,_Mod} -> ok;
Other -> Other
end.
diff --git a/lib/compiler/src/compiler.appup.src b/lib/compiler/src/compiler.appup.src
index 54a63833e6..fe273b269c 100644
--- a/lib/compiler/src/compiler.appup.src
+++ b/lib/compiler/src/compiler.appup.src
@@ -1 +1,21 @@
-{"%VSN%",[],[]}.
+%% -*- erlang -*-
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 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
+%% 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%
+{"%VSN%",
+ [{<<".*">>,[{restart_application, compiler}]}],
+ [{<<".*">>,[{restart_application, compiler}]}]
+}.
diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl
index 824be9ff7f..ed181e3baa 100644
--- a/lib/compiler/src/core_lib.erl
+++ b/lib/compiler/src/core_lib.erl
@@ -105,6 +105,10 @@ vu_expr(V, #c_cons{hd=H,tl=T}) ->
vu_expr(V, H) orelse vu_expr(V, T);
vu_expr(V, #c_tuple{es=Es}) ->
vu_expr_list(V, Es);
+vu_expr(V, #c_map{var=M,es=Es}) ->
+ vu_expr(V, M) orelse vu_expr_list(V, Es);
+vu_expr(V, #c_map_pair{key=Key,val=Val}) ->
+ vu_expr_list(V, [Key,Val]);
vu_expr(V, #c_binary{segments=Ss}) ->
vu_seg_list(V, Ss);
vu_expr(V, #c_fun{vars=Vs,body=B}) ->
diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl
index 67d37ff1fc..36165245a6 100644
--- a/lib/compiler/src/core_lint.erl
+++ b/lib/compiler/src/core_lint.erl
@@ -254,6 +254,10 @@ 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_seq{arg=Arg,body=B}, Def, Rt, St0) ->
@@ -278,6 +282,7 @@ gexpr(#c_case{arg=Arg,clauses=Cs}, Def, Rt, St0) ->
St1 = gbody(Arg, Def, PatCount, St0),
clauses(Cs, Def, PatCount, Rt, St1);
gexpr(_Core, _, _, St) ->
+ %%io:fwrite("clint gexpr: ~p~n", [_Core]),
add_error({illegal_guard,St#lint.func}, St).
%% gexpr_list([Expr], Defined, State) -> State.
@@ -303,6 +308,10 @@ 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_fun{vars=Vs,body=B}, Def, Rt, St0) ->
@@ -355,7 +364,7 @@ expr(#c_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Def, Rt, St0) ->
{Ens,St5} = variable_list(Evs, St4),
body(H, union(Ens, Def), Rt, St5);
expr(_Other, _, _, St) ->
- %%io:fwrite("clint: ~p~n", [_Other]),
+ %%io:fwrite("clint expr: ~p~n", [_Other]),
add_error({illegal_expr,St#lint.func}, St).
%% expr_list([Expr], Defined, State) -> State.
@@ -454,13 +463,19 @@ pattern(#c_cons{hd=H,tl=T}, Def, Ps, St) ->
pattern_list([H,T], Def, Ps, St);
pattern(#c_tuple{es=Es}, Def, Ps, St) ->
pattern_list(Es, Def, Ps, St);
+pattern(#c_map{es=Es}, Def, Ps, St) ->
+ pattern_list(Es, Def, Ps, St);
+pattern(#c_map_pair{op=#c_literal{val=exact},key=K,val=V},Def,Ps,St) ->
+ pattern_list([K,V],Def,Ps,St);
pattern(#c_binary{segments=Ss}, Def, Ps, St0) ->
St = pat_bin_tail_check(Ss, St0),
pat_bin(Ss, Def, Ps, St);
pattern(#c_alias{var=V,pat=P}, Def, Ps, St0) ->
{Vvs,St1} = variable(V, Ps, St0),
pattern(P, Def, union(Vvs, Ps), St1);
-pattern(_, _, Ps, St) -> {Ps,add_error({not_pattern,St#lint.func}, St)}.
+pattern(_Other, _, Ps, St) ->
+ %%io:fwrite("clint pattern: ~p~n", [_Other]),
+ {Ps,add_error({not_pattern,St#lint.func}, St)}.
pat_var(N, _Def, Ps, St) ->
case is_element(N, Ps) of
diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl
index 0b8f4d8895..d54715ef59 100644
--- a/lib/compiler/src/core_parse.hrl
+++ b/lib/compiler/src/core_parse.hrl
@@ -96,3 +96,12 @@
-record(c_values, {anno=[], es}). % es :: [Tree]
-record(c_var, {anno=[], name :: cerl:var_name()}).
+
+-record(c_map_pair, {anno=[],
+ op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'},
+ key,
+ val}).
+
+-record(c_map, {anno=[],
+ var=#c_literal{val=[]} :: #c_var{} | #c_literal{},
+ es :: [#c_map_pair{}]}).
diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl
index 4e98a8c2da..b8db0f683a 100644
--- a/lib/compiler/src/core_parse.yrl
+++ b/lib/compiler/src/core_parse.yrl
@@ -21,6 +21,8 @@
%% Have explicit productions for annotated phrases named anno_XXX.
%% This just does an XXX and adds the annotation.
+Expect 1.
+
Nonterminals
module_definition module_export module_attribute module_defs
@@ -44,6 +46,9 @@ receive_expr timeout try_expr
sequence catch_expr
variable clause clause_pattern
+map_expr map_pairs map_pair map_pair_assoc map_pair_exact
+map_pattern map_pair_patterns map_pair_pattern
+
annotation anno_fun anno_expression anno_expressions
anno_variable anno_variables anno_pattern anno_patterns
anno_function_name
@@ -53,7 +58,7 @@ Terminals
%% Separators
-'(' ')' '{' '}' '[' ']' '|' ',' '->' '=' '/' '<' '>' ':' '-|' '#'
+'(' ')' '{' '}' '[' ']' '|' ',' '->' '=' '/' '<' '>' ':' '-|' '#' '~' '::'
%% Keywords (atoms are assumed to always be single-quoted).
@@ -166,6 +171,7 @@ anno_patterns -> anno_pattern : ['$1'].
other_pattern -> atomic_pattern : '$1'.
other_pattern -> tuple_pattern : '$1'.
+other_pattern -> map_pattern : '$1'.
other_pattern -> cons_pattern : '$1'.
other_pattern -> binary_pattern : '$1'.
other_pattern -> anno_variable '=' anno_pattern :
@@ -176,6 +182,16 @@ atomic_pattern -> atomic_literal : '$1'.
tuple_pattern -> '{' '}' : c_tuple([]).
tuple_pattern -> '{' anno_patterns '}' : c_tuple('$2').
+map_pattern -> '~' '{' '}' '~' : #c_map{es=[]}.
+map_pattern -> '~' '{' map_pair_patterns '}' '~' :
+ #c_map{es=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'}.
+
cons_pattern -> '[' anno_pattern tail_pattern :
#c_cons{hd='$2',tl='$3'}.
@@ -240,6 +256,7 @@ single_expression -> primop_expr : '$1'.
single_expression -> try_expr : '$1'.
single_expression -> sequence : '$1'.
single_expression -> catch_expr : '$1'.
+single_expression -> map_expr : '$1'.
literal -> atomic_literal : '$1'.
literal -> tuple_literal : '$1'.
@@ -267,6 +284,22 @@ tail_literal -> ',' literal tail_literal : #c_cons{hd='$2',tl='$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 -> variable '~' '{' '}' '~' : #c_map{var='$1',es=[]}.
+map_expr -> variable '~' '{' map_pairs '}' '~' : #c_map{var='$1',es='$4'}.
+
+map_pairs -> map_pair : ['$1'].
+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'}.
+
cons -> '[' anno_expression tail : c_cons('$2', '$3').
tail -> ']' : #c_literal{val=[]}.
@@ -381,3 +414,5 @@ Erlang code.
tok_val(T) -> element(3, T).
tok_line(T) -> element(2, T).
+
+%% vim: syntax=erlang
diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl
index 1f91a52be3..faa26ec6df 100644
--- a/lib/compiler/src/core_pp.erl
+++ b/lib/compiler/src/core_pp.erl
@@ -161,6 +161,27 @@ format_1(#c_tuple{es=Es}, Ctxt) ->
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
$}
];
+format_1(#c_map{var=#c_var{}=Var,es=Es}, Ctxt) ->
+ [format_1(Var, Ctxt),
+ "~{",
+ format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
+ "}~"
+ ];
+format_1(#c_map{es=Es}, Ctxt) ->
+ ["~{",
+ format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
+ "}~"
+ ];
+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_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_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)))];
diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl
index c0dfecd1dc..b7799b373a 100644
--- a/lib/compiler/src/core_scan.erl
+++ b/lib/compiler/src/core_scan.erl
@@ -1,8 +1,7 @@
-%% -*- coding: utf-8 -*-
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2013. 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
@@ -272,6 +271,8 @@ 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/genop.tab b/lib/compiler/src/genop.tab
index ebc9b1c85b..7d6bf56ccb 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -528,3 +528,11 @@ BEAM_FORMAT_NUMBER=0
# R15A
153: line/1
+
+# R17
+
+154: put_map_assoc/5
+155: put_map_exact/5
+156: is_map/2
+157: has_map_fields/3
+158: get_map_elements/3
diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl
index 31a1f8b0b7..555a331bd7 100644
--- a/lib/compiler/src/rec_env.erl
+++ b/lib/compiler/src/rec_env.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2001-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
@@ -72,6 +72,7 @@ test_1({custom, F} = Type, N, Env) when is_integer(N), N > 0 ->
test_1(_,0, Env) ->
Env.
-endif.
+%%@clear
%% Representation:
@@ -95,7 +96,7 @@ test_1(_,0, Env) ->
%% =====================================================================
%% @type environment(). An abstract environment.
--type mapping() :: {'map', dict()} | {'rec', dict(), dict()}.
+-type mapping() :: {'map', dict:dict()} | {'rec', dict:dict(), dict:dict()}.
-type environment() :: [mapping(),...].
%% =====================================================================
diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl
index f6696992b9..60d83763f8 100644
--- a/lib/compiler/src/sys_core_dsetel.erl
+++ b/lib/compiler/src/sys_core_dsetel.erl
@@ -102,6 +102,13 @@ visit(Env, #c_literal{}=R) ->
visit(Env0, #c_tuple{es=Es0}=R) ->
{Es1,Env1} = visit_list(Env0, Es0),
{R#c_tuple{es=Es1}, Env1};
+visit(Env0, #c_map{es=Es0}=R) ->
+ {Es1,Env1} = visit_list(Env0, Es0),
+ {R#c_map{es=Es1}, Env1};
+visit(Env0, #c_map_pair{key=K0,val=V0}=R) ->
+ {K,Env1} = visit(Env0, K0),
+ {V,Env2} = visit(Env1, V0),
+ {R#c_map_pair{key=K,val=V}, Env2};
visit(Env0, #c_cons{hd=H0,tl=T0}=R) ->
{H1,Env1} = visit(Env0, H0),
{T1,Env2} = visit(Env1, T0),
@@ -212,6 +219,11 @@ visit_pat(Env0, #c_var{name=V}, Vs) ->
{[V|Vs], dict:store(V, 0, Env0)};
visit_pat(Env0, #c_tuple{es=Es}, Vs) ->
visit_pats(Es, Env0, Vs);
+visit_pat(Env0, #c_map{es=Es}, Vs) ->
+ visit_pats(Es, Env0, Vs);
+visit_pat(Env0, #c_map_pair{op=#c_literal{val=exact},key=V,val=K}, Vs0) ->
+ {Vs1, Env1} = visit_pat(Env0, V, Vs0),
+ visit_pat(Env1, K, Vs1);
visit_pat(Env0, #c_cons{hd=H,tl=T}, Vs0) ->
{Vs1, Env1} = visit_pat(Env0, H, Vs0),
visit_pat(Env1, T, Vs1);
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index cda3f7d81e..eb9c302334 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -70,7 +70,7 @@
-export([module/2,format_error/1]).
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2,
- reverse/1,reverse/2,member/2,nth/2,flatten/1]).
+ reverse/1,reverse/2,member/2,nth/2,flatten/1,unzip/1]).
-import(cerl, [ann_c_cons/3,ann_c_tuple/2]).
@@ -246,6 +246,16 @@ expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) ->
value ->
ann_c_tuple(Anno, Es)
end;
+expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) ->
+ Es = pair_list(Es0, Ctxt, Sub),
+ case Ctxt of
+ effect ->
+ add_warning(Map, useless_building),
+ expr(make_effect_seq(Es, Sub), Ctxt, Sub);
+ value ->
+ V = expr(V0, Ctxt, Sub),
+ Map#c_map{var=V,es=Es}
+ end;
expr(#c_binary{segments=Ss}=Bin0, Ctxt, Sub) ->
%% Warn for useless building, but always build the binary
%% anyway to preserve a possible exception.
@@ -295,6 +305,10 @@ expr(#c_let{}=Let, Ctxt, Sub) ->
%% Now recursively re-process the new expression.
expr(Expr, Ctxt, sub_new_preserve_types(Sub))
end;
+expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) ->
+ %% This is named fun in an 'effect' context. Warn and ignore.
+ add_warning(Letrec, useless_building),
+ void();
expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) ->
Fs1 = map(fun ({Name,Fb}) ->
{Name,expr(Fb, {letrec,Ctxt}, Sub)}
@@ -302,18 +316,54 @@ expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) ->
B1 = body(B0, value, Sub),
Letrec#c_letrec{defs=Fs1,body=B1};
expr(#c_case{}=Case0, Ctxt, Sub) ->
+ %% Ideally, the compiler should only emit warnings when there is
+ %% a real mistake in the code being compiled. We use the follow
+ %% heuristics in an attempt to approach that ideal:
+ %%
+ %% * If the guard for a clause always fails, we will emit a
+ %% warning.
+ %%
+ %% * If a case expression is a literal, we will emit no warnings
+ %% for clauses that will not match or for clauses that are
+ %% shadowed after a clause that will always match. That means
+ %% that code such as:
+ %%
+ %% case ?DEBUG of
+ %% false -> ok;
+ %% true -> ...
+ %% end
+ %%
+ %% (where ?DEBUG expands to either 'true' or 'false') will not
+ %% produce any warnings.
+ %%
+ %% * If the case expression is not literal, warnings will be
+ %% emitted for every clause that don't match and for all
+ %% clauses following a clause that will always match.
+ %%
+ %% * If no clause will ever match, there will be a warning
+ %% (in addition to any warnings that may have been emitted
+ %% according to the rules above).
+ %%
case opt_bool_case(Case0) of
#c_case{arg=Arg0,clauses=Cs0}=Case1 ->
Arg1 = body(Arg0, value, Sub),
- {Arg2,Cs1} = case_opt(Arg1, Cs0),
- Cs2 = clauses(Arg2, Cs1, Case1, Ctxt, Sub),
- Case = eval_case(Case1#c_case{arg=Arg2,clauses=Cs2}, Sub),
- bsm_an(Case);
+ LitExpr = cerl:is_literal(Arg1),
+ {Arg2,Cs1} = case_opt(Arg1, Cs0, Sub),
+ Cs2 = clauses(Arg2, Cs1, Ctxt, Sub, LitExpr),
+ Case = Case1#c_case{arg=Arg2,clauses=Cs2},
+ warn_no_clause_match(Case1, Case),
+ Expr = eval_case(Case, Sub),
+ case move_case_into_arg(Case, Sub) of
+ impossible ->
+ bsm_an(Expr);
+ Other ->
+ expr(Other, Ctxt, sub_new_preserve_types(Sub))
+ end;
Other ->
expr(Other, Ctxt, Sub)
end;
expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) ->
- Cs1 = clauses(#c_var{name='_'}, Cs0, Recv, Ctxt, Sub), %This is all we know
+ Cs1 = clauses(#c_var{name='_'}, Cs0, Ctxt, Sub, false),
T1 = expr(T0, value, Sub),
A1 = body(A0, Ctxt, Sub),
Recv#c_receive{clauses=Cs1,timeout=T1,action=A1};
@@ -377,6 +427,16 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0)
expr_list(Es, Ctxt, Sub) ->
[expr(E, Ctxt, Sub) || E <- Es].
+pair_list(Es, Ctxt, Sub) ->
+ [pair(E, Ctxt, Sub) || E <- Es].
+
+pair(#c_map_pair{key=K,val=V}, effect, Sub) ->
+ make_effect_seq([K,V], Sub);
+pair(#c_map_pair{key=K0,val=V0}=Pair, value=Ctxt, Sub) ->
+ K = expr(K0, Ctxt, Sub),
+ V = expr(V0, Ctxt, Sub),
+ Pair#c_map_pair{key=K,val=V}.
+
bitstr_list(Es, Sub) ->
[bitstr(E, Sub) || E <- Es].
@@ -547,6 +607,14 @@ 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).
@@ -646,7 +714,7 @@ useless_call(effect, #c_call{anno=Anno,
useless_call(_, _) -> no.
%% make_effect_seq([Expr], Sub) -> #c_seq{}|void()
-%% Convert a list of epressions evaluated in effect context to a chain of
+%% Convert a list of expressions evaluated in effect context to a chain of
%% #c_seq{}. The body in the innermost #c_seq{} will be void().
%% Anything that will not have any effect will be thrown away.
@@ -1452,14 +1520,14 @@ let_subst_list([], [], _) -> {[],[],[]}.
%%pattern(Pat, Sub) -> pattern(Pat, Sub, Sub).
-pattern(#c_var{name=V0}=Pat, Isub, Osub) ->
+pattern(#c_var{}=Pat, Isub, Osub) ->
case sub_is_val(Pat, Isub) of
true ->
V1 = make_var_name(),
Pat1 = #c_var{name=V1},
{Pat1,sub_set_var(Pat, Pat1, scope_add([V1], Osub))};
false ->
- {Pat,sub_del_var(Pat, scope_add([V0], Osub))}
+ {Pat,sub_del_var(Pat, Osub)}
end;
pattern(#c_literal{}=Pat, _, Osub) -> {Pat,Osub};
pattern(#c_cons{anno=Anno,hd=H0,tl=T0}, Isub, Osub0) ->
@@ -1469,6 +1537,9 @@ pattern(#c_cons{anno=Anno,hd=H0,tl=T0}, Isub, Osub0) ->
pattern(#c_tuple{anno=Anno,es=Es0}, Isub, Osub0) ->
{Es1,Osub1} = pattern_list(Es0, Isub, Osub0),
{ann_c_tuple(Anno, Es1),Osub1};
+pattern(#c_map{anno=Anno,es=Es0}=Map, Isub, Osub0) ->
+ {Es1,Osub1} = map_pair_pattern_list(Es0, Isub, Osub0),
+ {Map#c_map{anno=Anno,es=Es1},Osub1};
pattern(#c_binary{segments=V0}=Pat, Isub, Osub0) ->
{V1,Osub1} = bin_pattern_list(V0, Isub, Osub0),
{Pat#c_binary{segments=V1},Osub1};
@@ -1478,6 +1549,23 @@ pattern(#c_alias{var=V0,pat=P0}=Pat, Isub, Osub0) ->
Osub = update_types(V1, [P1], Osub2),
{Pat#c_alias{var=V1,pat=P1},Osub}.
+map_pair_pattern_list(Ps0, Isub, Osub0) ->
+ {Ps,{_,Osub}} = mapfoldl(fun map_pair_pattern/2, {Isub,Osub0}, Ps0),
+ {Ps,Osub}.
+
+map_pair_pattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,{Isub,Osub0}) ->
+ {K,Osub1} = case cerl:type(K0) of
+ binary ->
+ K1 = eval_binary(K0),
+ case cerl:type(K1) of
+ literal -> {K1,Osub0};
+ _ -> pattern(K0,Isub,Osub0)
+ end;
+ _ -> pattern(K0,Isub,Osub0)
+ end,
+ {V,Osub} = pattern(V0,Isub,Osub1),
+ {Pair#c_map_pair{key=K,val=V},{Isub,Osub}}.
+
bin_pattern_list(Ps0, Isub, Osub0) ->
{Ps,{_,Osub}} = mapfoldl(fun bin_pattern/2, {Isub,Osub0}, Ps0),
{Ps,Osub}.
@@ -1522,6 +1610,9 @@ is_subst(_) -> false.
%% chains so we never have to search more than once. Use orddict so
%% we know the format.
%%
+%% 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.
@@ -1548,8 +1639,17 @@ sub_set_name(V, Val, #sub{v=S,s=Scope,t=Tdb0}=Sub) ->
Tdb = copy_type(V, Val, Tdb1),
Sub#sub{v=orddict:store(V, Val, S),s=gb_sets:add(V, Scope),t=Tdb}.
-sub_del_var(#c_var{name=V}, #sub{v=S,t=Tdb}=Sub) ->
- Sub#sub{v=orddict:erase(V, S),t=kill_types(V, Tdb)}.
+sub_del_var(#c_var{name=V}, #sub{v=S,s=Scope,t=Tdb}=Sub) ->
+ %% Profiling shows that for programs with many record operations,
+ %% sub_del_var/2 is a bottleneck. Since the scope contains all
+ %% variables that are live, we know that V cannot be present in S
+ %% if it is not in the scope.
+ case gb_sets:is_member(V, Scope) of
+ false ->
+ Sub#sub{s=gb_sets:insert(V, Scope)};
+ true ->
+ Sub#sub{v=orddict:erase(V, S),t=kill_types(V, Tdb)}
+ end.
sub_subst_var(#c_var{name=V}, Val, #sub{v=S0}) ->
%% Fold chained substitutions.
@@ -1559,47 +1659,50 @@ 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}.
-sub_is_val(#c_var{name=V}, #sub{v=S}) ->
- v_is_value(V, S).
-
-v_is_value(Var, Sub) ->
- any(fun ({_,#c_var{name=Val}}) when Val =:= Var -> true;
- (_) -> false
- end, Sub).
-
-%% clauses(E, [Clause], TopLevel, Context, Sub) -> [Clause].
-%% Trim the clauses by removing all clauses AFTER the first one which
-%% is guaranteed to match. Also remove all trivially false clauses.
-
-clauses(E, Cs0, TopLevel, Ctxt, Sub) ->
- Cs = clauses_1(E, Cs0, Ctxt, Sub),
-
- %% Here we want to warn if no clauses whatsoever will ever
- %% match, because that is probably a mistake.
- case all(fun is_compiler_generated/1, Cs) andalso
- any(fun(C) -> not is_compiler_generated(C) end, Cs0) of
+sub_is_val(#c_var{name=V}, #sub{v=S,s=Scope}) ->
+ %% When the bottleneck in sub_del_var/2 was eliminated, this
+ %% became the new bottleneck. Since the scope contains all
+ %% live variables, a variable V can only be the target for
+ %% a substitution if it is in the scope.
+ gb_sets:is_member(V, Scope) andalso v_is_value(V, S).
+
+v_is_value(Var, [{_,#c_var{name=Var}}|_]) -> true;
+v_is_value(Var, [_|T]) -> v_is_value(Var, T);
+v_is_value(_, []) -> false.
+
+%% warn_no_clause_match(CaseOrig, CaseOpt) -> ok
+%% Generate a warning if none of the user-specified clauses
+%% will match.
+
+warn_no_clause_match(CaseOrig, CaseOpt) ->
+ OrigCs = cerl:case_clauses(CaseOrig),
+ OptCs = cerl:case_clauses(CaseOpt),
+ case any(fun(C) -> not is_compiler_generated(C) end, OrigCs) andalso
+ all(fun is_compiler_generated/1, OptCs) of
true ->
%% The original list of clauses did contain at least one
%% user-specified clause, but none of them will match.
%% That is probably a mistake.
- add_warning(TopLevel, no_clause_match);
+ add_warning(CaseOrig, no_clause_match);
false ->
%% Either there were user-specified clauses left in
%% the transformed clauses, or else none of the original
%% clauses were user-specified to begin with (as in 'andalso').
ok
- end,
+ end.
- Cs.
+%% clauses(E, [Clause], TopLevel, Context, Sub) -> [Clause].
+%% Trim the clauses by removing all clauses AFTER the first one which
+%% is guaranteed to match. Also remove all trivially false clauses.
-clauses_1(E, [C0|Cs], Ctxt, Sub) ->
+clauses(E, [C0|Cs], Ctxt, Sub, LitExpr) ->
#c_clause{pats=Ps,guard=G} = C1 = clause(C0, E, Ctxt, Sub),
%%ok = io:fwrite("~w: ~p~n", [?LINE,{E,Ps}]),
case {will_match(E, Ps),will_succeed(G)} of
{yes,yes} ->
- Line = get_line(core_lib:get_anno(C1)),
- case core_lib:is_literal(E) of
+ case LitExpr of
false ->
+ Line = get_line(core_lib:get_anno(C1)),
shadow_warning(Cs, Line);
true ->
%% If the case expression is a literal,
@@ -1608,15 +1711,13 @@ clauses_1(E, [C0|Cs], Ctxt, Sub) ->
ok
end,
[C1]; %Skip the rest
- {no,_Suc} ->
- clauses_1(E, Cs, Ctxt, Sub); %Skip this clause
- {_Mat,no} ->
+ {_Mat,no} -> %Guard fails.
add_warning(C1, nomatch_guard),
- clauses_1(E, Cs, Ctxt, Sub); %Skip this clause
+ clauses(E, Cs, Ctxt, Sub, LitExpr); %Skip this clause
{_Mat,_Suc} ->
- [C1|clauses_1(E, Cs, Ctxt, Sub)]
+ [C1|clauses(E, Cs, Ctxt, Sub, LitExpr)]
end;
-clauses_1(_, [], _, _) -> [].
+clauses(_, [], _, _, _) -> [].
shadow_warning([C|Cs], none) ->
add_warning(C, nomatch_shadow),
@@ -1634,69 +1735,18 @@ will_succeed(#c_literal{val=true}) -> yes;
will_succeed(#c_literal{val=false}) -> no;
will_succeed(_Guard) -> maybe.
-%% will_match(Expr, [Pattern]) -> yes | maybe | no.
-%% Test if we know whether a match will succeed/fail or just don't
-%% know. Be conservative.
+%% will_match(Expr, [Pattern]) -> yes | maybe.
+%% We KNOW that this function is only used after optimizations
+%% in case_opt/4. Therefore clauses that can definitely not match
+%% have already been pruned.
will_match(#c_values{es=Es}, Ps) ->
- will_match_list(Es, Ps, yes);
+ will_match_1(cerl_clauses:match_list(Ps, Es));
will_match(E, [P]) ->
- will_match_1(E, P).
-
-will_match_1(_E, #c_var{}) -> yes; %Will always match
-will_match_1(E, #c_alias{pat=P}) -> %Pattern decides
- will_match_1(E, P);
-will_match_1(#c_var{}, _P) -> maybe;
-will_match_1(#c_tuple{es=Es}, #c_tuple{es=Ps}) ->
- will_match_list(Es, Ps, yes);
-will_match_1(#c_literal{val=Lit}, P) ->
- will_match_lit(Lit, P);
-will_match_1(_, _) -> maybe.
-
-will_match_list([E|Es], [P|Ps], M) ->
- case will_match_1(E, P) of
- yes -> will_match_list(Es, Ps, M);
- maybe -> will_match_list(Es, Ps, maybe);
- no -> no
- end;
-will_match_list([], [], M) -> M.
-
-will_match_lit(Cons, #c_cons{hd=Hp,tl=Tp}) ->
- case Cons of
- [H|T] ->
- case will_match_lit(H, Hp) of
- yes -> will_match_lit(T, Tp);
- Other -> Other
- end;
- _ ->
- no
- end;
-will_match_lit(Tuple, #c_tuple{es=Es}) ->
- case is_tuple(Tuple) andalso tuple_size(Tuple) =:= length(Es) of
- true -> will_match_lit_list(tuple_to_list(Tuple), Es);
- false -> no
- end;
-will_match_lit(Bin, #c_binary{}) ->
- case is_bitstring(Bin) of
- true -> maybe;
- false -> no
- end;
-will_match_lit(_, #c_var{}) ->
- yes;
-will_match_lit(Lit, #c_alias{pat=P}) ->
- will_match_lit(Lit, P);
-will_match_lit(Lit1, #c_literal{val=Lit2}) ->
- case Lit1 =:= Lit2 of
- true -> yes;
- false -> no
- end.
+ will_match_1(cerl_clauses:match(P, E)).
-will_match_lit_list([H|T], [P|Ps]) ->
- case will_match_lit(H, P) of
- yes -> will_match_lit_list(T, Ps);
- Other -> Other
- end;
-will_match_lit_list([], []) -> yes.
+will_match_1({false,_}) -> maybe;
+will_match_1({true,_}) -> yes.
%% opt_bool_case(CoreExpr) - CoreExpr'.
%% Do various optimizations to case statement that has a
@@ -1895,166 +1945,274 @@ opt_bool_case_guard(Arg, [#c_clause{pats=[#c_literal{val=false}]}=Fc,Tc]) ->
%% last clause is guaranteed to match so if there is only one clause
%% with a pattern containing only variables then rewrite to a let.
-eval_case(#c_case{arg=#c_var{name=V},
- clauses=[#c_clause{pats=[P],guard=G,body=B}|_]}=Case,
- #sub{t=Tdb}=Sub) ->
- case orddict:find(V, Tdb) of
- {ok,Type} ->
- case {will_match_type(P, Type),will_succeed(G)} of
- {yes,yes} ->
- {Ps,Es} = remove_non_vars(P, Type),
- expr(#c_let{vars=Ps,arg=#c_values{es=Es},body=B},
- sub_new(Sub));
- {_,_} ->
- eval_case_1(Case, Sub)
- end;
- error -> eval_case_1(Case, Sub)
- end;
-eval_case(Case, Sub) -> eval_case_1(Case, Sub).
-
-eval_case_1(#c_case{arg=E,clauses=[#c_clause{pats=Ps,body=B}]}=Case, Sub) ->
- case is_var_pat(Ps) of
- true -> expr(#c_let{vars=Ps,arg=E,body=B}, sub_new(Sub));
- false -> eval_case_2(E, Ps, B, Case)
- end;
-eval_case_1(Case, _) -> Case.
-
-eval_case_2(E, [P], B, Case) ->
- %% Recall that there is only one clause and that it is guaranteed to match.
- %% If E and P are literals, they must be the same literal and the body
- %% can be used directly as there are no variables that need to be bound.
- %% Otherwise, P could be an alias meaning that two or more variables
- %% would be bound to E. We don't bother to optimize that case as it
- %% is rather uncommon.
- case core_lib:is_literal(E) andalso core_lib:is_literal(P) of
- false -> Case;
- true -> B
- end;
-eval_case_2(_, _, _, Case) -> Case.
-
-is_var_pat(Ps) ->
- all(fun (#c_var{}) -> true;
- (_Pat) -> false
- end, Ps).
-
-will_match_type(#c_tuple{es=Es}, #c_tuple{es=Ps}) ->
- will_match_list_type(Es, Ps);
-will_match_type(#c_literal{val=Atom}, #c_literal{val=Atom}) -> yes;
-will_match_type(#c_var{}, #c_var{}) -> yes;
-will_match_type(#c_var{}, #c_alias{}) -> yes;
-will_match_type(_, _) -> no.
-
-will_match_list_type([E|Es], [P|Ps]) ->
- case will_match_type(E, P) of
- yes -> will_match_list_type(Es, Ps);
- no -> no
- end;
-will_match_list_type([], []) -> yes;
-will_match_list_type(_, _) -> no. %Different length
-
-remove_non_vars(Ps0, Es0) ->
- {Ps,Es} = remove_non_vars(Ps0, Es0, [], []),
- {reverse(Ps),reverse(Es)}.
-
-remove_non_vars(#c_tuple{es=Ps}, #c_tuple{es=Es}, Pacc, Eacc) ->
- remove_non_vars_list(Ps, Es, Pacc, Eacc);
-remove_non_vars(#c_var{}=Var, #c_alias{var=Evar}, Pacc, Eacc) ->
- {[Var|Pacc],[Evar|Eacc]};
-remove_non_vars(#c_var{}=Var, #c_var{}=Evar, Pacc, Eacc) ->
- {[Var|Pacc],[Evar|Eacc]};
-remove_non_vars(P, E, Pacc, Eacc) ->
- true = core_lib:is_literal(P) andalso core_lib:is_literal(E), %Assertion.
- {Pacc,Eacc}.
-
-remove_non_vars_list([P|Ps], [E|Es], Pacc0, Eacc0) ->
- {Pacc,Eacc} = remove_non_vars(P, E, Pacc0, Eacc0),
- remove_non_vars_list(Ps, Es, Pacc, Eacc);
-remove_non_vars_list([], [], Pacc, Eacc) ->
- {Pacc,Eacc}.
+eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,
+ guard=#c_literal{val=true},
+ body=B}]}=Case, Sub) ->
+ Es = case cerl:is_c_values(E) of
+ true -> cerl:values_es(E);
+ false -> [E]
+ end,
+ %% Consider:
+ %%
+ %% case SomeSideEffect() of
+ %% X=Y -> ...
+ %% end
+ %%
+ %% We must not rewrite it to:
+ %%
+ %% let <X,Y> = <SomeSideEffect(),SomeSideEffect()> in ...
+ %%
+ %% because SomeSideEffect() would be evaluated twice.
+ %%
+ %% Instead we must evaluate the case expression in an outer let
+ %% like this:
+ %%
+ %% let NewVar = SomeSideEffect() in
+ %% let <X,Y> = <NewVar,NewVar> in ...
+ %%
+ Vs = make_vars([], length(Es)),
+ case cerl_clauses:match_list(Ps0, Vs) of
+ {false,_} ->
+ %% This can only happen if the Core Erlang code is
+ %% handwritten or generated by another code generator
+ %% than v3_core. Assuming that the Core Erlang program
+ %% is correct, the clause will always match at run-time.
+ Case;
+ {true,Bs} ->
+ {Ps,As} = unzip(Bs),
+ InnerLet = cerl:c_let(Ps, core_lib:make_values(As), B),
+ Let = cerl:c_let(Vs, E, InnerLet),
+ expr(Let, sub_new(Sub))
+ end;
+eval_case(Case, _) -> Case.
%% case_opt(CaseArg, [Clause]) -> {CaseArg,[Clause]}.
-%% Try and optimise case by avoid building a tuple in
-%% the case expression. Instead of building a tuple
-%% in the case expression, combine the elements into
-%% multiple "values". If a clause refers to the tuple
-%% in the case expression (that was not built), introduce
-%% a let into the guard and/or body to build the tuple.
+%% Try and optimise a case by avoid building tuples or lists
+%% in the case expression. Instead combine the variable parts
+%% of the case expression to multiple "values". If a clause
+%% refers to the constructed term in the case expression (which
+%% was not built), introduce a let into the guard and/or body to
+%% build the term.
%%
-%% case {Expr1,Expr2} of case <Expr1,Expr2> of
-%% {P1,P2} -> ... <P1,P2> -> ...
+%% case {ok,[Expr1,Expr2]} of case <Expr1,Expr2> of
+%% {ok,[P1,P2]} -> ... <P1,P2> -> ...
%% . ==> .
%% . .
%% . .
-%% Var -> <Var1,Var2> ->
-%% ... Var ... let <Var> = {Var1,Var2}
-%% in ... Var ...
+%% Var -> <Var1,Var2> ->
+%% ... Var ... let <Var> = {ok,[Var1,Var2]}
+%% in ... Var ...
%% . .
%% . .
%% . .
-%% end. end.
+%% end. end.
%%
-case_opt(#c_tuple{anno=A,es=Es}, Cs0) ->
- Cs1 = case_opt_cs(Cs0, length(Es)),
- {core_lib:set_anno(core_lib:make_values(Es), A),Cs1};
-case_opt(Arg, Cs) -> {Arg,Cs}.
-
-case_opt_cs([#c_clause{pats=Ps0,guard=G,body=B}=C|Cs], Arity) ->
- case case_tuple_pat(Ps0, Arity) of
- {ok,Ps1,Avs} ->
- Flet = fun ({V,Pat}, Body) -> letify(V, Pat, Body) end,
- [C#c_clause{pats=Ps1,
- guard=foldl(Flet, G, Avs),
- body=foldl(Flet, B, Avs)}|case_opt_cs(Cs, Arity)];
- error -> %Can't match
- add_warning(C, nomatch_clause_type),
- case_opt_cs(Cs, Arity)
+case_opt(Arg, Cs0, Sub) ->
+ Cs1 = [{cerl:clause_pats(C),C,[],[]} || C <- Cs0],
+ Args0 = case cerl:is_c_values(Arg) of
+ false -> [Arg];
+ true -> cerl:values_es(Arg)
+ end,
+ LitExpr = cerl:is_literal(Arg),
+ {Args,Cs2} = case_opt_args(Args0, Cs1, Sub, LitExpr, []),
+ Cs = [cerl:update_c_clause(C,
+ reverse(Ps),
+ letify(Bs, cerl:clause_guard(C)),
+ letify(Bs, cerl:clause_body(C))) ||
+ {[],C,Ps,Bs} <- Cs2],
+ {core_lib:make_values(Args),Cs}.
+
+case_opt_args([A0|As0], Cs0, Sub, LitExpr, Acc) ->
+ case case_opt_arg(A0, Sub, Cs0, LitExpr) of
+ error ->
+ %% Nothing to be done. Move on to the next argument.
+ Cs = [{Ps,C,[P|PsAcc],Bs} || {[P|Ps],C,PsAcc,Bs} <- Cs0],
+ case_opt_args(As0, Cs, Sub, LitExpr, [A0|Acc]);
+ {ok,As1,Cs} ->
+ %% The argument was either expanded (from tuple/list) or
+ %% removed (literal).
+ case_opt_args(As1++As0, Cs, Sub, LitExpr, Acc)
+ end;
+case_opt_args([], Cs, _Sub, _LitExpr, Acc) ->
+ {reverse(Acc),Cs}.
+
+%% case_opt_arg(Expr, Sub, Clauses0, LitExpr) ->
+%% {ok,Args,Clauses} | error
+%% Try to expand one argument to several arguments (if tuple/list)
+%% or to remove a literal argument.
+%%
+case_opt_arg(E0, Sub, Cs, LitExpr) ->
+ E = maybe_replace_var(E0, Sub),
+ case cerl:is_data(E) of
+ false ->
+ error;
+ true ->
+ case cerl:data_type(E) of
+ {atomic,_} ->
+ case_opt_lit(E, Cs, LitExpr);
+ _ ->
+ case_opt_data(E, Cs, LitExpr)
+ end
+ end.
+
+%% maybe_replace_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 orddict:find(cerl:var_name(E), Tdb) of
+ {ok,T0} ->
+ case cerl:is_c_tuple(T0) of
+ false ->
+ E;
+ true ->
+ cerl_trees:map(fun(C) ->
+ case cerl:is_c_alias(C) of
+ false -> C;
+ true -> cerl:alias_pat(C)
+ end
+ end, T0)
+ end;
+ error ->
+ E
+ end.
+
+%% case_opt_lit(Literal, Clauses0, LitExpr) ->
+%% {ok,[],Clauses} | error
+%% The current part of the case expression is a literal. That
+%% means that we will know at compile-time whether a clause
+%% 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.
+
+case_opt_lit(Lit, Cs0, LitExpr) ->
+ try case_opt_lit_1(Cs0, Lit, LitExpr) of
+ Cs ->
+ {ok,[],Cs}
+ catch
+ throw:impossible ->
+ error
+ end.
+
+case_opt_lit_1([{[P|Ps],C,PsAcc,Bs0}|Cs], E, LitExpr) ->
+ case cerl_clauses:match(P, E) of
+ none ->
+ %% The pattern will not match the literal. Remove the clause.
+ %% Unless the entire case expression is a literal, also
+ %% emit a warning.
+ case LitExpr of
+ false -> add_warning(C, nomatch_clause_type);
+ true -> ok
+ end,
+ case_opt_lit_1(Cs, E, LitExpr);
+ {true,Bs} ->
+ %% The pattern matches the literal. Remove the pattern
+ %% and update the bindings.
+ [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_1(Cs, E, LitExpr)];
+ {false,_} ->
+ %% Binary literal and pattern. We are not sure whether
+ %% the pattern will match.
+ throw(impossible)
end;
-case_opt_cs([], _) -> [].
+case_opt_lit_1([], _, _) -> [].
+
+%% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses}
-%% case_tuple_pat([Pattern], Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error.
+case_opt_data(E, Cs0, LitExpr) ->
+ Es = cerl:data_es(E),
+ Cs = case_opt_data_1(Cs0, Es,
+ {cerl:data_type(E),cerl:data_arity(E)},
+ LitExpr),
+ {ok,Es,Cs}.
+
+case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig, LitExpr) ->
+ case case_data_pat(P, TypeSig) of
+ {ok,Ps1,Bs1} ->
+ [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|
+ case_opt_data_1(Cs, Es, TypeSig,LitExpr)];
+ error ->
+ case LitExpr of
+ false -> add_warning(C, nomatch_clause_type);
+ true -> ok
+ end,
+ case_opt_data_1(Cs, Es, TypeSig, LitExpr)
+ end;
+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 ->
+ case {cerl:data_type(P),cerl:data_arity(P)} of
+ TypeSig ->
+ {ok,cerl:data_es(P),[]};
+ {_,_} ->
+ error
+ end
+ end.
-case_tuple_pat([#c_tuple{es=Ps}], Arity) when length(Ps) =:= Arity ->
- {ok,Ps,[]};
-case_tuple_pat([#c_literal{val=T}], Arity) when tuple_size(T) =:= Arity ->
- Ps = [#c_literal{val=E} || E <- tuple_to_list(T)],
- {ok,Ps,[]};
-case_tuple_pat([#c_var{anno=Anno0}=V], Arity) ->
- Vars = make_vars(Anno0, 1, Arity),
+%% 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 tuple as
- %% compiler generated.
-
- Anno = [compiler_generated|Anno0],
- {ok,Vars,[{V,#c_tuple{anno=Anno,es=Vars}}]};
-case_tuple_pat([#c_alias{var=V,pat=P}], Arity) ->
- case case_tuple_pat([P], Arity) of
- {ok,Ps,Avs} ->
- Anno0 = core_lib:get_anno(P),
- Anno = [compiler_generated|Anno0],
- {ok,Ps,[{V,#c_tuple{anno=Anno,es=unalias_pat_list(Ps)}}|Avs]};
- error ->
+ %% To avoid that warning, we must annotate the data
+ %% constructor as compiler generated.
+ Ann = [compiler_generated|cerl:get_ann(P)],
+ 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),
+ case case_data_pat(Apat, TypeSig) of
+ {ok,Ps,Bs} ->
+ {ok,Ps,[{V,cerl:ann_make_data(Ann, Type, unalias_pat_list(Ps))}|Bs]};
+ error ->
+ error
+ end;
+ _ ->
error
- end;
-case_tuple_pat(_, _) -> error.
+ end.
%% unalias_pat(Pattern) -> Pattern.
%% Remove all the aliases in a pattern but using the alias variables
%% instead of the values. We KNOW they will be bound.
-unalias_pat(#c_alias{var=V}) -> V;
-unalias_pat(#c_cons{anno=Anno,hd=H0,tl=T0}) ->
- H1 = unalias_pat(H0),
- T1 = unalias_pat(T0),
- ann_c_cons(Anno, H1, T1);
-unalias_pat(#c_tuple{anno=Anno,es=Ps}) ->
- ann_c_tuple(Anno, unalias_pat_list(Ps));
-unalias_pat(Atomic) -> Atomic.
+unalias_pat(P) ->
+ case cerl:is_c_alias(P) of
+ true ->
+ cerl:alias_var(P);
+ false ->
+ case cerl:is_data(P) of
+ false ->
+ P;
+ true ->
+ Es = unalias_pat_list(cerl:data_es(P)),
+ cerl:update_data(P, cerl:data_type(P), Es)
+ end
+ end.
unalias_pat_list(Ps) -> [unalias_pat(P) || P <- Ps].
+make_vars(A, Max) ->
+ make_vars(A, 1, Max).
+
make_vars(A, I, Max) when I =< Max ->
[make_var(A)|make_vars(A, I+1, Max)];
make_vars(_, _, _) -> [].
@@ -2067,6 +2225,11 @@ make_var_name() ->
put(new_var_num, N+1),
list_to_atom("fol"++integer_to_list(N)).
+letify(Bs, Body) ->
+ foldr(fun({V,Val}, B) ->
+ letify(V, Val, B)
+ end, Body, Bs).
+
letify(#c_var{name=Vname}=Var, Val, Body) ->
case core_lib:is_var_used(Vname, Body) of
true ->
@@ -2087,7 +2250,7 @@ opt_case_in_let_0([#c_var{name=V}], Arg,
case is_simple_case_arg(Arg) andalso
not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of
true ->
- opt_bool_case(Case#c_case{arg=Arg});
+ expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new());
false ->
Let
end;
@@ -2342,6 +2505,25 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
Case#c_case{arg=Cexpr,clauses=[Ca,Cb]};
{_,_,_} -> impossible
end;
+move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
+ #c_seq{arg=Sarg0,body=Sbody0}=Seq, Sub0) ->
+ %%
+ %% let <Lvars> = do <Seq-arg>
+ %% <Seq-body>
+ %% in <Let-body>
+ %%
+ %% ==>
+ %%
+ %% do <Seq-arg>
+ %% let <Lvars> = <Seq-body>
+ %% in <Let-body>
+ %%
+ Sarg = body(Sarg0, Sub0),
+ Sbody1 = body(Sbody0, Sub0),
+ {Lvs,Sbody,Sub} = let_substs(Lvs0, Sbody1, Sub0),
+ Lbody = body(Lbody0, Sub),
+ Seq#c_seq{arg=Sarg,body=Let#c_let{vars=Lvs,arg=core_lib:make_values(Sbody),
+ body=Lbody}};
move_let_into_expr(_Let, _Expr, _Sub) -> impossible.
is_failing_clause(#c_clause{body=B}) ->
@@ -2429,6 +2611,77 @@ opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) ->
value, Sub)
end.
+move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg,
+ body=InnerArg0}=Outer,
+ clauses=InnerClauses}=Inner, Sub) ->
+ %%
+ %% case let <OuterVars> = <OuterArg> in <InnerArg> of
+ %% <InnerClauses>
+ %% end
+ %%
+ %% ==>
+ %%
+ %% let <OuterVars> = <OuterArg>
+ %% in case <InnerArg> of <InnerClauses> end
+ %%
+ ScopeSub0 = sub_subst_scope(Sub#sub{t=[]}),
+ {OuterVars,ScopeSub} = pattern_list(OuterVars0, ScopeSub0),
+ InnerArg = body(InnerArg0, ScopeSub),
+ Outer#c_let{vars=OuterVars,arg=OuterArg,
+ body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}};
+move_case_into_arg(#c_case{arg=#c_case{arg=OuterArg,
+ clauses=[OuterCa0,OuterCb]}=Outer,
+ clauses=InnerClauses}=Inner0, Sub) ->
+ case is_failing_clause(OuterCb) of
+ true ->
+ #c_clause{pats=OuterPats0,guard=OuterGuard0,
+ body=InnerArg0} = OuterCa0,
+ %%
+ %% case case <OuterArg> of
+ %% <OuterPats> when <OuterGuard> -> <InnerArg>
+ %% <OuterCb>
+ %% ...
+ %% end of
+ %% <InnerClauses>
+ %% end
+ %%
+ %% ==>
+ %%
+ %% case <OuterArg> of
+ %% <OuterPats> when <OuterGuard> ->
+ %% case <InnerArg> of <InnerClauses> end
+ %% <OuterCb>
+ %% end
+ %%
+ ScopeSub0 = sub_subst_scope(Sub#sub{t=[]}),
+ {OuterPats,ScopeSub} = pattern_list(OuterPats0, ScopeSub0),
+ OuterGuard = guard(OuterGuard0, ScopeSub),
+ InnerArg = body(InnerArg0, ScopeSub),
+ Inner = Inner0#c_case{arg=InnerArg,clauses=InnerClauses},
+ OuterCa = OuterCa0#c_clause{pats=OuterPats,guard=OuterGuard,
+ body=Inner},
+ Outer#c_case{arg=OuterArg,
+ clauses=[OuterCa,OuterCb]};
+ false ->
+ impossible
+ end;
+move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer,
+ clauses=InnerClauses}=Inner, _Sub) ->
+ %%
+ %% case do <OuterArg> <InnerArg> of
+ %% <InnerClauses>
+ %% end
+ %%
+ %% ==>
+ %%
+ %% do <OuterArg>
+ %% case <InnerArg> of <InerClauses> end
+ %%
+ Outer#c_seq{arg=OuterArg,
+ body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}};
+move_case_into_arg(_, _) ->
+ impossible.
+
%% In guards only, rewrite a case in a let argument like
%%
%% let <Var> = case <> of
diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index 7d918a55ed..9998043013 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -228,6 +228,13 @@ pattern({cons,Line,H,T}, St0) ->
pattern({tuple,Line,Ps}, St0) ->
{TPs,St1} = pattern_list(Ps, St0),
{{tuple,Line,TPs},St1};
+pattern({map,Line,Ps}, St0) ->
+ {TPs,St1} = pattern_list(Ps, St0),
+ {{map,Line,TPs},St1};
+pattern({map_field_exact,Line,K0,V0}, St0) ->
+ {K,St1} = pattern(K0, St0),
+ {V,St2} = pattern(V0, St1),
+ {{map_field_exact,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};
@@ -321,6 +328,20 @@ expr({tuple,Line,Es0}, St0) ->
%%expr({struct,Line,Tag,Es0}, Vs, St0) ->
%% {Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0),
%% {{tuple,Line,[{atom,Line,Tag}|Es1]},Esvs,Esus,St1};
+expr({map,Line,Es0}, St0) ->
+ {Es1,St1} = expr_list(Es0, St0),
+ {{map,Line,Es1},St1};
+expr({map,Line,Var,Es0}, St0) ->
+ {Es1,St1} = expr_list(Es0, St0),
+ {{map,Line,Var,Es1},St1};
+expr({map_field_assoc,Line,K0,V0}, St0) ->
+ {K,St1} = expr(K0, St0),
+ {V,St2} = expr(V0, St1),
+ {{map_field_assoc,Line,K,V},St2};
+expr({map_field_exact,Line,K0,V0}, St0) ->
+ {K,St1} = expr(K0, St0),
+ {V,St2} = expr(V0, St1),
+ {{map_field_exact,Line,K,V},St2};
expr({bin,Line,Es0}, St0) ->
{Es1,St1} = expr_bin(Es0, St0),
{{bin,Line,Es1},St1};
@@ -344,6 +365,8 @@ expr({'receive',Line,Cs0,To0,ToEs0}, St0) ->
{{'receive',Line,Cs,To,ToEs},St3};
expr({'fun',Line,Body}, St) ->
fun_tq(Line, Body, St);
+expr({named_fun,Line,Name,Cs}, St) ->
+ fun_tq(Line, Cs, St, Name);
expr({call,Line,{atom,La,N}=Atom,As0}, St0) ->
{As,St1} = expr_list(As0, St0),
Ar = length(As),
@@ -475,6 +498,11 @@ fun_tq(Lf, {clauses,Cs0}, St0) ->
Index = Uniq = 0,
{{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}.
+fun_tq(Line, Cs0, St0, Name) ->
+ {Cs1,St1} = fun_clauses(Cs0, St0),
+ {Fname,St2} = new_fun_name(St1, Name),
+ {{named_fun,Line,Name,Cs1,{0,0,Fname}},St2}.
+
fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) ->
{H,St1} = head(H0, St0),
{G,St2} = guard(G0, St1),
@@ -485,9 +513,12 @@ fun_clauses([], St) -> {[],St}.
%% new_fun_name(State) -> {FunName,State}.
-new_fun_name(#expand{func=F,arity=A,fcount=I}=St) ->
+new_fun_name(St) ->
+ new_fun_name(St, 'fun').
+
+new_fun_name(#expand{func=F,arity=A,fcount=I}=St, FName) ->
Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A)
- ++ "-fun-" ++ integer_to_list(I) ++ "-",
+ ++ "-" ++ atom_to_list(FName) ++ "-" ++ integer_to_list(I) ++ "-",
{list_to_atom(Name),St#expand{fcount=I+1}}.
%% pattern_bin([Element], State) -> {[Element],[Variable],[UsedVar],State}.
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 6a13495523..e00ee1f3ad 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -210,6 +210,8 @@ 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_need(I, H),0};
need_heap_1(#l{ke={set,_,Val}}, H) ->
%% Just pass through adding to needed heap.
{[],H + case Val of
@@ -453,8 +455,11 @@ basic_block([Le|Les], Acc) ->
end;
no_block -> {reverse(Acc, [Le]),Les}
end.
+
+%% sets that may garbage collect are not allowed in basic blocks.
collect_block({set,_,{binary,_}}) -> no_block;
+collect_block({set,_,{map,_,_,_}}) -> no_block;
collect_block({set,_,_}) -> include;
collect_block({call,{var,_}=Var,As,_Rs}) -> {block_end,As++[Var]};
collect_block({call,Func,As,_Rs}) -> {block_end,As++func_vars(Func)};
@@ -594,14 +599,13 @@ top_level_block(Keis, Bef, MaxRegs, _St) ->
%% number to the outer catch, which is wrong.
turn_yregs(0, Tp, _) -> Tp;
-turn_yregs(El, Tp, MaxY) when element(1, element(El, Tp)) =:= yy ->
- turn_yregs(El-1, setelement(El, Tp, {y,MaxY-element(2, element(El, Tp))}), MaxY);
-turn_yregs(El, Tp, MaxY) when is_list(element(El, Tp)) ->
- New = map(fun ({yy,YY}) -> {y,MaxY-YY};
- (Other) -> Other end, element(El, Tp)),
- turn_yregs(El-1, setelement(El, Tp, New), MaxY);
turn_yregs(El, Tp, MaxY) ->
- turn_yregs(El-1, Tp, MaxY).
+ turn_yregs(El-1,setelement(El,Tp,turn_yreg(element(El,Tp),MaxY)),MaxY).
+
+turn_yreg({yy,YY},MaxY) -> {y,MaxY-YY};
+turn_yreg({list,Ls},MaxY) -> {list, turn_yreg(Ls,MaxY)};
+turn_yreg(Ts,MaxY) when is_list(Ts) -> [turn_yreg(T,MaxY)||T<-Ts];
+turn_yreg(Other,_MaxY) -> Other.
%% select_cg(Sclause, V, TypeFail, ValueFail, StackReg, State) ->
%% {Is,StackReg,State}.
@@ -623,6 +627,8 @@ select_cg(#l{ke={type_clause,bin_int,S}}, {var,V}, Tf, _Vf, Bef, St) ->
select_bin_segs(S, V, Tf, Bef, St);
select_cg(#l{ke={type_clause,bin_end,[S]}}, {var,V}, Tf, _Vf, Bef, St) ->
select_bin_end(S, V, Tf, Bef, St);
+select_cg(#l{ke={type_clause,map,S}}, {var,V}, Tf, Vf, Bef, St) ->
+ select_map(S, V, Tf, Vf, Bef, St);
select_cg(#l{ke={type_clause,Type,Scs}}, {var,V}, Tf, Vf, Bef, St0) ->
{Vis,{Aft,St1}} =
mapfoldl(fun (S, {Int,Sta}) ->
@@ -637,6 +643,10 @@ 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]) ->
@@ -915,6 +925,53 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) ->
{Es,{Aft,_}} = flatmapfoldl(F, {Bef,0}, Vs),
{Es,Aft,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) ->
+ select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1)
+ end, Vf, St0, Scs),
+ {[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}.
+
+select_map_val(V, Es, B, Fail, I, Vdb, Bef, St0) ->
+ {Eis,Int,St1} = select_extract_map(V, Es, Fail, I, Vdb, Bef, St0),
+ {Bis,Aft,St2} = match_cg(B, Fail, Int, St1),
+ {Eis++Bis,Aft,St2}.
+
+select_extract_map(_, [], _, _, _, Bef, St) -> {[],Bef,St};
+select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) ->
+ %% First split the instruction flow
+ %% We want one set of each
+ %% 1) has_map_fields (no target registers)
+ %% 2) get_map_elements (with target registers)
+ %% Assume keys are term-sorted
+ Rsrc = fetch_var(Src, Bef),
+
+ {{HasKs,GetVs},Aft} = lists:foldr(fun
+ ({map_pair,Key,{var,V}},{{HasKsi,GetVsi},Int0}) ->
+ case vdb_find(V, Vdb) of
+ {V,_,L} when L =< I ->
+ {{[Key|HasKsi],GetVsi},Int0};
+ _Other ->
+ Reg1 = put_reg(V, Int0#sr.reg),
+ Int1 = Int0#sr{reg=Reg1},
+ {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi]},Int1}
+ end
+ end, {{[],[]},Bef}, Vs),
+
+ Code = case {HasKs,GetVs} of
+ {[],[]} -> {[],Aft,St};
+ {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,
+ {Code, Aft, St}.
+
+
select_extract_cons(Src, [{var,Hd}, {var,Tl}], I, Vdb, Bef, St) ->
{Es,Aft} = case {vdb_find(Hd, Vdb), vdb_find(Tl, Vdb)} of
{{_,_,Lhd}, {_,_,Ltl}} when Lhd =< I, Ltl =< I ->
@@ -1408,7 +1465,7 @@ catch_cg(C, {var,R}, Le, Vdb, Bef, St0) ->
%% annotation must reflect this and make sure that the return
%% variable is allocated first.
%%
-%% put_list for constructing a cons is an atomic instruction
+%% put_list and put_map are atomic instructions, both of
%% which can safely resuse one of the source registers as target.
set_cg([{var,R}], {cons,Es}, Le, Vdb, Bef, St) ->
@@ -1448,6 +1505,35 @@ 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};
+set_cg([{var,R}], {map,Op,Map,Es}, 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),
+
+ %% The instruction needs to store keys in term sorted order
+ %% All keys has to be unique here
+ Pairs = map_pair_strip_and_termsort(Es),
+
+ %% fetch registers for values to be put into the map
+ 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),
+
+ I = case Op of
+ assoc -> put_map_assoc;
+ exact -> put_map_exact
+ end,
+ {Sis++[Line]++[{I,Fail,SrcReg,Target,Live,{list,List}}],Aft,St};
set_cg([{var,R}], Con, Le, Vdb, Bef, St) ->
%% Find a place for the return register first.
Int = Bef#sr{reg=put_reg(R, Bef#sr.reg)},
@@ -1460,16 +1546,24 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) ->
end,
{Ais,clear_dead(Int, Le#l.i, Vdb),St}.
+map_pair_strip_and_termsort(Es) ->
+ %% format in
+ %% [{map_pair,K,V}]
+ %% where K is for example {integer, 1} and we want to sort on 1.
+ Ls = [{K,V}||{_,K,V}<-Es],
+ lists:sort(fun({{_,A},_},{{_,B},_}) -> erts_internal:cmp_term(A,B) < 0 end, Ls).
+
%%%
%%% Code generation for constructing binaries.
%%%
cg_binary([{bs_put_binary,Fail,{atom,all},U,_Flags,Src}|PutCode],
Target, Temp, Fail, MaxRegs, Anno) ->
+ Line = line(Anno),
Live = cg_live(Target, MaxRegs),
SzCode = cg_bitstr_size(PutCode, Target, Temp, Fail, Live),
BinFlags = {field_flags,[]},
- Code = SzCode ++
+ Code = [Line|SzCode] ++
[case member(single_use, Anno) of
true ->
{bs_private_append,Fail,Target,U,Src,BinFlags,Target};
@@ -1930,7 +2024,7 @@ load_vars(Vs, Regs) ->
foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs).
%% put_reg(Val, Regs) -> Regs.
-%% find_reg(Val, Regs) -> ok{r{R}} | error.
+%% find_reg(Val, Regs) -> {ok,r{R}} | error.
%% fetch_reg(Val, Regs) -> r{R}.
%% Functions to interface the registers.
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 01bb8635cd..a50b46bd7b 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -74,7 +74,7 @@
-export([module/2,format_error/1]).
-import(lists, [reverse/1,reverse/2,map/2,member/2,foldl/3,foldr/3,mapfoldl/3,
- splitwith/2,keyfind/3,sort/1,foreach/2]).
+ 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]).
@@ -92,7 +92,7 @@
-record(icase, {anno=#a{},args,clauses,fc}).
-record(icatch, {anno=#a{},body}).
-record(iclause, {anno=#a{},pats,pguard=[],guard,body}).
--record(ifun, {anno=#a{},id,vars,clauses,fc}).
+-record(ifun, {anno=#a{},id,vars,clauses,fc,name=unnamed}).
-record(iletrec, {anno=#a{},defs,body}).
-record(imatch, {anno=#a{},pat,guard=[],arg,fc}).
-record(iprimop, {anno=#a{},name,args}).
@@ -101,6 +101,8 @@
-record(ireceive2, {anno=#a{},clauses,timeout,action}).
-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}).
-type iapply() :: #iapply{}.
-type ibinary() :: #ibinary{}.
@@ -117,10 +119,13 @@
-type ireceive2() :: #ireceive2{}.
-type iset() :: #iset{}.
-type itry() :: #itry{}.
+-type ifilter() :: #ifilter{}.
+-type igen() :: #igen{}.
-type i() :: iapply() | ibinary() | icall() | icase() | icatch()
| iclause() | ifun() | iletrec() | imatch() | iprimop()
- | iprotect() | ireceive1() | ireceive2() | iset() | itry().
+ | iprotect() | ireceive1() | ireceive2() | iset() | itry()
+ | ifilter() | igen().
-type warning() :: {file:filename(), [{integer(), module(), term()}]}.
@@ -226,13 +231,13 @@ guard(Gs0, St0) ->
Gt1 = guard_tests(Gt0),
L = element(2, Gt1),
{op,L,'or',Gt1,Rhs}
- end, guard_tests(last(Gs0)), first(Gs0)),
+ end, guard_tests(last(Gs0)), droplast(Gs0)),
{Gs,St} = gexpr_top(Gs1, St0#core{in_guard=true}),
{Gs,St#core{in_guard=false}}.
guard_tests(Gs) ->
L = element(2, hd(Gs)),
- {protect,L,foldr(fun (G, Rhs) -> {op,L,'and',G,Rhs} end, last(Gs), first(Gs))}.
+ {protect,L,foldr(fun (G, Rhs) -> {op,L,'and',G,Rhs} end, last(Gs), droplast(Gs))}.
%% gexpr_top(Expr, State) -> {Cexpr,State}.
%% Generate an internal core expression of a guard test. Explicitly
@@ -479,14 +484,26 @@ expr({cons,L,H0,T0}, St0) ->
{T1,Tps,St2} = safe(T0, St1),
A = lineno_anno(L, St2),
{ann_c_cons(A, H1, T1),Hps ++ Tps,St2};
-expr({lc,L,E,Qs}, St) ->
- lc_tq(L, E, Qs, #c_literal{anno=lineno_anno(L, St),val=[]}, St);
+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);
expr({tuple,L,Es0}, St0) ->
{Es1,Eps,St1} = safe_list(Es0, St0),
A = lineno_anno(L, St1),
{ann_c_tuple(A, Es1),Eps,St1};
+expr({map,L,Es0}, St0) ->
+ % erl_lint should make sure only #{ K => V } are allowed
+ % in map construction.
+ {Es1,Eps,St1} = map_pair_list(Es0, St0),
+ A = lineno_anno(L, St1),
+ {#c_map{anno=A,es=Es1},Eps,St1};
+expr({map,L,M0,Es0}, St0) ->
+ {M1,Mps,St1} = safe(M0, St0),
+ {Es1,Eps,St2} = map_pair_list(Es0, St1),
+ A = lineno_anno(L, St2),
+ {#c_map{anno=A,var=M1,es=Es1},Mps++Eps,St2};
expr({bin,L,Es0}, St0) ->
try expr_bin(Es0, lineno_anno(L, St0), St0) of
{_,_,_}=Res -> Res
@@ -502,7 +519,7 @@ expr({bin,L,Es0}, St0) ->
end;
expr({block,_,Es0}, St0) ->
%% Inline the block directly.
- {Es1,St1} = exprs(first(Es0), St0),
+ {Es1,St1} = exprs(droplast(Es0), St0),
{E1,Eps,St2} = expr(last(Es0), St1),
{E1,Es1 ++ Eps,St2};
expr({'if',L,Cs0}, St0) ->
@@ -553,16 +570,23 @@ expr({'try',L,Es0,[],[],As0}, St0) ->
%% 'try ... after ... end'
{Es1,St1} = exprs(Es0, St0),
{As1,St2} = exprs(As0, St1),
- {Evs,Hs0,St3} = try_after(As1, St2),
- %% We must kill the id for any funs in the duplicated after body,
- %% to avoid getting two local functions having the same name.
- Hs = kill_id_anns(Hs0),
+ {Name,St3} = new_fun_name("after", St2),
{V,St4} = new_var(St3), % (must not exist in As1)
- %% TODO: this duplicates the 'after'-code; should lift to function.
- Lanno = lineno_anno(L, St4),
- {#itry{anno=#a{anno=Lanno},args=Es1,vars=[V],body=As1++[V],
- evars=Evs,handler=Hs},
- [],St4};
+ LA = lineno_anno(L, St4),
+ Lanno = #a{anno=LA},
+ Fc = function_clause([], LA, {Name,0}),
+ Fun = #ifun{anno=Lanno,id=[],vars=[],
+ clauses=[#iclause{anno=Lanno,pats=[],
+ guard=[#c_literal{val=true}],
+ body=As1}],
+ fc=Fc},
+ App = #iapply{anno=#a{anno=[compiler_generated|LA]},
+ op=#c_var{anno=LA,name={Name,0}},args=[]},
+ {Evs,Hs,St5} = try_after([App], St4),
+ Try = #itry{anno=Lanno,args=Es1,vars=[V],body=[App,V],evars=Evs,handler=Hs},
+ Letrec = #iletrec{anno=Lanno,defs=[{{Name,0},Fun}],
+ body=[Try]},
+ {Letrec,[],St5};
expr({'try',L,Es,Cs,Ecs,As}, St0) ->
%% 'try ... [of ...] [catch ...] after ... end'
expr({'try',L,[{'try',L,Es,Cs,Ecs,[]}],[],[],As}, St0);
@@ -581,7 +605,11 @@ expr({'fun',L,{function,M,F,A}}, St0) ->
name=#c_literal{val=make_fun},
args=As},Aps,St1};
expr({'fun',L,{clauses,Cs},Id}, St) ->
- fun_tq(Id, Cs, L, St);
+ fun_tq(Id, Cs, L, St, unnamed);
+expr({named_fun,L,'_',Cs,Id}, St) ->
+ fun_tq(Id, Cs, L, St, unnamed);
+expr({named_fun,L,Name,Cs,{Index,Uniq,_Fname}}, St) ->
+ fun_tq({Index,Uniq,Name}, Cs, L, St, {named, Name});
expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) ->
{[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0),
Lanno = lineno_anno(L, St1),
@@ -625,7 +653,7 @@ expr({match,L,P0,E0}, St0) ->
Other when not is_atom(Other) ->
{#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4}
end;
-expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) ->
+expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) ->
%% Optimise '++' here because of the list comprehension algorithm.
%%
%% To avoid achieving quadratic complexity if there is a chain of
@@ -633,7 +661,8 @@ expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) ->
%% evaluation of More now. Evaluating More here could also reduce the
%% number variables in the environment for letrec.
{Mc,Mps,St1} = safe(More, St0),
- {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St1),
+ {Qs,St2} = preprocess_quals(Llc, Qs0, St1),
+ {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),
@@ -684,6 +713,21 @@ make_bool_switch_guard(L, E, V, T, F) ->
{clause,NegL,[V],[],[V]}
]}.
+map_pair_list(Es, St) ->
+ foldr(fun
+ ({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) ->
+ {K,Ep0,St1} = safe(K0, St0),
+ {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}) ->
+ {K,Ep0,St1} = safe(K0, St0),
+ {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).
%% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}.
@@ -836,9 +880,9 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) ->
flags=#c_literal{val=Flags}},
Eps ++ Eps2,St2}.
-%% fun_tq(Id, [Clauses], Line, State) -> {Fun,[PreExp],State}.
+%% fun_tq(Id, [Clauses], Line, State, NameInfo) -> {Fun,[PreExp],State}.
-fun_tq({_,_,Name}=Id, Cs0, L, St0) ->
+fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) ->
Arity = clause_arity(hd(Cs0)),
{Cs1,St1} = clauses(Cs0, St0),
{Args,St2} = new_vars(Arity, St1),
@@ -847,138 +891,50 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0) ->
Fc = function_clause(Ps, Anno, {Name,Arity}),
Fun = #ifun{anno=#a{anno=Anno},
id=[{id,Id}], %We KNOW!
- vars=Args,clauses=Cs1,fc=Fc},
+ vars=Args,clauses=Cs1,fc=Fc,name=NameInfo},
{Fun,[],St3}.
%% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}.
%% This TQ from Simon PJ pp 127-138.
-%% This gets a bit messy as we must transform all directly here. We
-%% recognise guard tests and try to fold them together and join to a
-%% preceding generators, this should give us better and more compact
-%% code.
-lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], Mc, St0) ->
- {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
+lc_tq(Line, E, [#igen{anno=GAnno,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),
- {Head,St2} = new_var(St1),
- {Tname,St3} = new_var_name(St2),
- LA = lineno_anno(Line, St3),
- LAnno = #a{anno=LA},
- Tail = #c_var{anno=LA,name=Tname},
- {Arg,St4} = new_var(St3),
- {Nc,[],St5} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St4),
- {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat!
- {Lc,Lps,St7} = lc_tq(Line, E, Qs1, Nc, St6),
- {Pc,St8} = list_gen_pattern(P, Line, St7),
- {Gc,Gps,St9} = safe(G, St8), %Will be a function argument!
- Fc = function_clause([Arg], LA, {Name,1}),
-
- %% Avoid constructing a default clause if the list comprehension
- %% only has a variable as generator and there are no guard
- %% tests. In other words, if the comprehension is equivalent to
- %% lists:map/2.
- Cs0 = case {Guardc, Pc} of
- {[], #c_var{}} ->
- [#iclause{anno=LAnno,
- pats=[#c_literal{anno=LA,val=[]}],guard=[],
- body=[Mc]}];
- _ ->
- [#iclause{anno=#a{anno=[compiler_generated|LA]},
- pats=[ann_c_cons(LA, Head, Tail)],
- guard=[],
- body=[Nc]},
- #iclause{anno=LAnno,
- pats=[#c_literal{anno=LA,val=[]}],guard=[],
- body=[Mc]}]
- end,
- Cs = case Pc of
- nomatch -> Cs0;
- _ ->
- [#iclause{anno=LAnno,
- pats=[ann_c_cons(LA, Pc, Tail)],
- guard=Guardc,
- body=Lps ++ [Lc]}|Cs0]
- end,
- Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc},
- {#iletrec{anno=LAnno,defs=[{{Name,1},Fun}],
- body=Gps ++ [#iapply{anno=LAnno,
- op=#c_var{anno=LA,name={Name,1}},
- args=[Gc]}]},
- [],St9};
-lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) ->
- {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
- {Name,St1} = new_fun_name("blc", St0),
LA = lineno_anno(Line, St1),
LAnno = #a{anno=LA},
- HeadBinPattern = pattern(P, St1),
- #c_binary{segments=Ps0} = HeadBinPattern,
- {Ps,Tail,St2} = append_tail_segment(Ps0, St1),
- {EPs,St3} = emasculate_segments(Ps, St2),
- Pattern = HeadBinPattern#c_binary{segments=Ps},
- EPattern = HeadBinPattern#c_binary{segments=EPs},
- {Arg,St4} = new_var(St3),
- {Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat!
- Tname = Tail#c_var.name,
- {Nc,[],St6} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St5),
- {Bc,Bps,St7} = lc_tq(Line, E, Qs1, Nc, St6),
- {Gc,Gps,St10} = safe(G, St7), %Will be a function argument!
- Fc = function_clause([Arg], LA, {Name,1}),
- {TailSegList,_,St} = append_tail_segment([], St10),
- Cs = [#iclause{anno=#a{anno=[compiler_generated|LA]},
- pats=[Pattern],
- guard=Guardc,
- body=Bps ++ [Bc]},
- #iclause{anno=#a{anno=[compiler_generated|LA]},
- pats=[EPattern],
- guard=[],
- body=[#iapply{anno=LAnno,
- op=#c_var{anno=LA,name={Name,1}},
- args=[Tail]}]},
- #iclause{anno=LAnno,
- pats=[#c_binary{anno=LA,segments=TailSegList}],guard=[],
- body=[Mc]}],
- Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc},
- {#iletrec{anno=LAnno,defs=[{{Name,1},Fun}],
- body=Gps ++ [#iapply{anno=LAnno,
- op=#c_var{anno=LA,name={Name,1}},
- args=[Gc]}]},
- [],St};
-lc_tq(Line, E, [Fil0|Qs0], Mc, St0) ->
- %% Special case sequences guard tests.
- LA = lineno_anno(element(2, Fil0), St0),
- LAnno = #a{anno=LA},
- case is_guard_test(Fil0) of
- true ->
- {Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0),
- {Lc,Lps,St1} = lc_tq(Line, E, Qs1, Mc, St0),
- {Gs,St2} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat!
- {#icase{anno=LAnno,
- args=[],
- clauses=[#iclause{anno=LAnno,pats=[],
- guard=Gs,body=Lps ++ [Lc]}],
- fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
- pats=[],guard=[],body=[Mc]}},
- [],St2};
- false ->
- {Lc,Lps,St1} = lc_tq(Line, E, Qs0, Mc, St0),
- {Fpat,St2} = new_var(St1),
- Fc = fail_clause([Fpat], LA,
- c_tuple([#c_literal{val=case_clause},Fpat])),
- %% Do a novars little optimisation here.
- {Filc,Fps,St3} = novars(Fil0, St2),
- {#icase{anno=LAnno,
- args=[Filc],
- clauses=[#iclause{anno=LAnno,
- pats=[#c_literal{anno=LA,val=true}],
- guard=[],
- body=Lps ++ [Lc]},
- #iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
- pats=[#c_literal{anno=LA,val=false}],
- guard=[],
- body=[Mc]}],
- fc=Fc},
- Fps,St3}
- end;
+ F = #c_var{anno=LA,name={Name,1}},
+ Nc = #iapply{anno=GAnno,op=F,args=[Tail]},
+ {Var,St2} = new_var(St1),
+ Fc = function_clause([Var], LA, {Name,1}),
+ TailClause = #iclause{anno=LAnno,pats=[TailPat],guard=[],body=[Mc]},
+ Cs0 = case {AccPat,AccGuard} of
+ {SkipPat,[]} ->
+ %% Skip and accumulator patterns are the same and there is
+ %% no guard, no need to generate a skip clause.
+ [TailClause];
+ _ ->
+ [#iclause{anno=#a{anno=[compiler_generated|LA]},
+ pats=[SkipPat],guard=[],body=[Nc]},
+ TailClause]
+ end,
+ {Cs,St4} = case AccPat of
+ nomatch ->
+ %% The accumulator pattern never matches, no need
+ %% for an accumulator clause.
+ {Cs0,St2};
+ _ ->
+ {Lc,Lps,St3} = lc_tq(Line, E, Qs, Nc, St2),
+ {[#iclause{anno=LAnno,pats=[AccPat],guard=AccGuard,
+ body=Lps ++ [Lc]}|Cs0],
+ St3}
+ end,
+ 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};
+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) ->
{H1,Hps,St1} = safe(E0, St0),
{T1,Tps,St} = force_safe(Mc0, St1),
@@ -988,143 +944,60 @@ lc_tq(Line, E0, [], Mc0, St0) ->
%% bc_tq(Line, Exp, [Qualifier], More, State) -> {LetRec,[PreExp],State}.
%% This TQ from Gustafsson ERLANG'05.
-%% This gets a bit messy as we must transform all directly here. We
-%% recognise guard tests and try to fold them together and join to a
-%% preceding generators, this should give us better and more compact
-%% code.
%% More could be transformed before calling bc_tq.
-bc_tq(Line, Exp, Qualifiers, _, St0) ->
+bc_tq(Line, Exp, Qs0, _, St0) ->
{BinVar,St1} = new_var(St0),
- {Sz,SzPre,St2} = bc_initial_size(Exp, Qualifiers, St1),
- {E,BcPre,St} = bc_tq1(Line, Exp, Qualifiers, BinVar, St2),
+ {Sz,SzPre,St2} = bc_initial_size(Exp, Qs0, St1),
+ {Qs,St3} = preprocess_quals(Line, Qs0, St2),
+ {E,BcPre,St} = bc_tq1(Line, Exp, Qs, BinVar, St3),
Pre = SzPre ++
[#iset{var=BinVar,
arg=#iprimop{name=#c_literal{val=bs_init_writable},
args=[Sz]}}] ++ BcPre,
{E,Pre,St}.
-bc_tq1(Line, E, [{generate,Lg,P,G}|Qs0], AccExpr, St0) ->
- {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
- {Name,St1} = new_fun_name("lbc", St0),
- LA = lineno_anno(Line, St1),
- {[Head,Tail,AccVar],St2} = new_vars(LA, 3, St1),
- LAnno = #a{anno=LA},
- {Arg,St3} = new_var(St2),
- NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name},
- {var,Lg,AccVar#c_var.name}]},
- {Guardc,St4} = lc_guard_tests(Gs, St3), %These are always flat!
- {Lc,Lps,St5} = bc_tq1(Line, E, Qs1, AccVar, St4),
- {Nc,Nps,St6} = expr(NewMore, St5),
- {Pc,St7} = list_gen_pattern(P, Line, St6),
- {Gc,Gps,St8} = safe(G, St7), %Will be a function argument!
- Fc = function_clause([Arg,AccVar], LA, {Name,2}),
- Cs0 = case {Guardc, Pc} of
- {[], #c_var{}} ->
- [#iclause{anno=LAnno,
- pats=[#c_literal{anno=LA,val=[]},AccVar],guard=[],
- body=[AccVar]}];
- _ ->
- [#iclause{anno=#a{anno=[compiler_generated|LA]},
- pats=[ann_c_cons(LA, Head, Tail),AccVar],
- guard=[],
- body=Nps ++ [Nc]},
- #iclause{anno=LAnno,
- pats=[#c_literal{anno=LA,val=[]},AccVar],guard=[],
- body=[AccVar]}]
- end,
- Cs = case Pc of
- nomatch -> Cs0;
- _ ->
- Body = Lps ++ Nps ++ [#iset{var=AccVar,arg=Lc},Nc],
- [#iclause{anno=LAnno,
- pats=[ann_c_cons(LA,Pc,Tail),AccVar],
- guard=Guardc,
- body=Body}|Cs0]
- end,
- Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc},
- {#iletrec{anno=LAnno,defs=[{{Name,2},Fun}],
- body=Gps ++ [#iapply{anno=LAnno,
- op=#c_var{anno=LA,name={Name,2}},
- args=[Gc,AccExpr]}]},
- [],St8};
-bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
- {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
+bc_tq1(Line, E, [#igen{anno=GAnno,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),
LA = lineno_anno(Line, St1),
- {AccVar,St2} = new_var(LA, St1),
LAnno = #a{anno=LA},
- HeadBinPattern = pattern(P, St2),
- #c_binary{segments=Ps0} = HeadBinPattern,
- {Ps,Tail,St3} = append_tail_segment(Ps0, St2),
- {EPs,St4} = emasculate_segments(Ps, St3),
- Pattern = HeadBinPattern#c_binary{segments=Ps},
- EPattern = HeadBinPattern#c_binary{segments=EPs},
- {Arg,St5} = new_var(St4),
- NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name},
- {var,Lg,AccVar#c_var.name}]},
- {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat!
- {Bc,Bps,St7} = bc_tq1(Line, E, Qs1, AccVar, St6),
- {Nc,Nps,St8} = expr(NewMore, St7),
- {Gc,Gps,St9} = safe(G, St8), %Will be a function argument!
- Fc = function_clause([Arg,AccVar], LA, {Name,2}),
- Body = Bps ++ Nps ++ [#iset{var=AccVar,arg=Bc},Nc],
- {TailSegList,_,St} = append_tail_segment([], St9),
- Cs = [#iclause{anno=LAnno,
- pats=[Pattern,AccVar],
- guard=Guardc,
- body=Body},
- #iclause{anno=#a{anno=[compiler_generated|LA]},
- pats=[EPattern,AccVar],
- guard=[],
- body=Nps ++ [Nc]},
- #iclause{anno=LAnno,
- pats=[#c_binary{anno=LA,segments=TailSegList},AccVar],
- guard=[],
- body=[AccVar]}],
- Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc},
- {#iletrec{anno=LAnno,defs=[{{Name,2},Fun}],
- body=Gps ++ [#iapply{anno=LAnno,
- op=#c_var{anno=LA,name={Name,2}},
- args=[Gc,AccExpr]}]},
- [],St};
-bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) ->
- %% Special case sequences guard tests.
- LA = lineno_anno(element(2, Fil0), St0),
- LAnno = #a{anno=LA},
- case is_guard_test(Fil0) of
- true ->
- {Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0),
- {Bc,Bps,St1} = bc_tq1(Line, E, Qs1, AccVar, St0),
- {Gs,St} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat!
- {#icase{anno=LAnno,
- args=[],
- clauses=[#iclause{anno=LAnno,
- pats=[],
- guard=Gs,body=Bps ++ [Bc]}],
- fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
- pats=[],guard=[],body=[AccVar]}},
- [],St};
- false ->
- {Bc,Bps,St1} = bc_tq1(Line, E, Qs0, AccVar, St0),
- {Fpat,St2} = new_var(St1),
- Fc = fail_clause([Fpat], LA,
- c_tuple([#c_literal{val=case_clause},Fpat])),
- %% Do a novars little optimisation here.
- {Filc,Fps,St} = novars(Fil0, St2),
- {#icase{anno=LAnno,
- args=[Filc],
- clauses=[#iclause{anno=LAnno,
- pats=[#c_literal{anno=LA,val=true}],
- guard=[],
- body=Bps ++ [Bc]},
- #iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
- pats=[#c_literal{anno=LA,val=false}],
- guard=[],
- body=[AccVar]}],
- fc=Fc},
- Fps,St}
- end;
+ {Vars=[_,AccVar],St2} = new_vars(LA, 2, St1),
+ F = #c_var{anno=LA,name={Name,2}},
+ Nc = #iapply{anno=GAnno,op=F,args=[Tail,AccVar]},
+ Fc = function_clause(Vars, LA, {Name,2}),
+ TailClause = #iclause{anno=LAnno,pats=[TailPat,AccVar],guard=[],
+ body=[AccVar]},
+ Cs0 = case {AccPat,AccGuard} of
+ {SkipPat,[]} ->
+ %% Skip and accumulator patterns are the same and there is
+ %% no guard, no need to generate a skip clause.
+ [TailClause];
+ _ ->
+ [#iclause{anno=#a{anno=[compiler_generated|LA]},
+ pats=[SkipPat,AccVar],guard=[],body=[Nc]},
+ TailClause]
+ end,
+ {Cs,St4} = case AccPat of
+ nomatch ->
+ %% The accumulator pattern never matches, no need
+ %% for an accumulator clause.
+ {Cs0,St2};
+ _ ->
+ {Bc,Bps,St3} = bc_tq1(Line, E, Qs, AccVar, St2),
+ Body = Bps ++ [#iset{var=AccVar,arg=Bc},Nc],
+ {[#iclause{anno=LAnno,
+ pats=[AccPat,AccVar],guard=AccGuard,
+ body=Body}|Cs0],
+ St3}
+ end,
+ 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};
+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) ->
{E,Pre,St} = expr({bin,Bl,[{bin_element,Bl,
{var,Bl,AccVar#c_var.name},
@@ -1132,31 +1005,154 @@ bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) ->
[binary,{unit,1}]}|Elements]}, St0),
#a{anno=A} = Anno0 = get_anno(E),
Anno = Anno0#a{anno=[compiler_generated,single_use|A]},
- %%Anno = Anno0#a{anno=[compiler_generated|A]},
{set_anno(E, Anno),Pre,St}.
-append_tail_segment(Segs, St) ->
- app_tail_seg(Segs, St, []).
-
-app_tail_seg([#c_bitstr{val=Var0,size=#c_literal{val=all}}=Seg0]=L,
- St0, Acc) ->
- case Var0 of
- #c_var{name='_'} ->
- {Var,St} = new_var(St0),
- Seg = Seg0#c_bitstr{val=Var},
- {reverse(Acc, [Seg]),Var,St};
- #c_var{} ->
- {reverse(Acc, L),Var0,St0}
+%% filter_tq(Line, Expr, Filter, Mc, State, [Qualifier], TqFun) ->
+%% {Case,[PreExpr],State}.
+%% Transform an intermediate comprehension filter to its intermediate case
+%% representation.
+
+filter_tq(Line, E, #ifilter{anno=#a{anno=LA}=LAnno,arg={Pre,Arg}},
+ Mc, St0, Qs, TqFun) ->
+ %% The filter is an expression, it is compiled to a case of degree 1 with
+ %% 3 clauses, one accumulating, one skipping and the final one throwing
+ %% {case_clause,Value} where Value is the result of the filter and is not a
+ %% boolean.
+ {Lc,Lps,St1} = TqFun(Line, E, Qs, Mc, St0),
+ {FailPat,St2} = new_var(St1),
+ Fc = fail_clause([FailPat], LA,
+ c_tuple([#c_literal{val=case_clause},FailPat])),
+ {#icase{anno=LAnno#a{anno=[list_comprehension|LA]},args=[Arg],
+ clauses=[#iclause{anno=LAnno,
+ pats=[#c_literal{val=true}],guard=[],
+ body=Lps ++ [Lc]},
+ #iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
+ pats=[#c_literal{val=false}],guard=[],
+ body=[Mc]}],
+ fc=Fc},
+ Pre,St2};
+filter_tq(Line, E, #ifilter{anno=#a{anno=LA}=LAnno,arg=Guard},
+ Mc, St0, Qs, TqFun) when is_list(Guard) ->
+ %% Otherwise it is a guard, compiled to a case of degree 0 with 2 clauses,
+ %% the first matches if the guard succeeds and the comprehension continues
+ %% or the second one is selected and the current element is skipped.
+ {Lc,Lps,St1} = TqFun(Line, E, Qs, Mc, St0),
+ {#icase{anno=LAnno#a{anno=[list_comprehension|LA]},args=[],
+ clauses=[#iclause{anno=LAnno,pats=[],guard=Guard,body=Lps ++ [Lc]}],
+ fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
+ pats=[],guard=[],body=[Mc]}},
+ [],St1}.
+
+%% preprocess_quals(Line, [Qualifier], State) -> {[Qualifier'],State}.
+%% Preprocess a list of Erlang qualifiers into its intermediate representation,
+%% represented as a list of #igen{} and #ifilter{} records. We recognise guard
+%% tests and try to fold them together and join to a preceding generators, this
+%% should give us better and more compact code.
+
+preprocess_quals(Line, Qs, St) ->
+ preprocess_quals(Line, Qs, St, []).
+
+preprocess_quals(Line, [Q|Qs0], St0, Acc) ->
+ case is_generator(Q) of
+ true ->
+ {Gs,Qs} = splitwith(fun is_guard_test/1, Qs0),
+ {Gen,St} = generator(Line, Q, Gs, St0),
+ preprocess_quals(Line, Qs, St, [Gen|Acc]);
+ false ->
+ LAnno = #a{anno=lineno_anno(get_anno(Q), St0)},
+ case is_guard_test(Q) of
+ true ->
+ %% When a filter is a guard test, its argument in the
+ %% #ifilter{} record is a list as returned by
+ %% lc_guard_tests/2.
+ {Gs,Qs} = splitwith(fun is_guard_test/1, Qs0),
+ {Cg,St} = lc_guard_tests([Q|Gs], St0),
+ Filter = #ifilter{anno=LAnno,arg=Cg},
+ preprocess_quals(Line, Qs, St, [Filter|Acc]);
+ false ->
+ %% Otherwise, it is a pair {Pre,Arg} as in a generator
+ %% input.
+ {Ce,Pre,St} = novars(Q, St0),
+ Filter = #ifilter{anno=LAnno,arg={Pre,Ce}},
+ preprocess_quals(Line, Qs0, St, [Filter|Acc])
+ end
end;
-app_tail_seg([H|T], St, Acc) ->
- app_tail_seg(T, St, [H|Acc]);
-app_tail_seg([], St0, Acc) ->
+preprocess_quals(_, [], St, Acc) ->
+ {reverse(Acc),St}.
+
+is_generator({generate,_,_,_}) -> true;
+is_generator({b_generate,_,_,_}) -> true;
+is_generator(_) -> false.
+
+%%
+%% Generators are abstracted as sextuplets:
+%% - acc_pat is the accumulator pattern, e.g. [Pat|Tail] for Pat <- Expr.
+%% - acc_guard is the list of guards immediately following the current
+%% generator in the qualifier list input.
+%% - skip_pat is the skip pattern, e.g. <<X,_:X,Tail/bitstring>> for
+%% <<X,1:X>> <= Expr.
+%% - tail is the variable used in AccPat and SkipPat bound to the rest of the
+%% generator input.
+%% - tail_pat is the tail pattern, respectively [] and <<_/bitstring>> for list
+%% and bit string generators.
+%% - arg is a pair {Pre,Arg} where Pre is the list of expressions to be
+%% inserted before the comprehension function and Arg is the expression
+%% that it should be passed.
+%%
+
+%% generator(Line, Generator, Guard, State) -> {Generator',State}.
+%% Transform a given generator into its #igen{} representation.
+
+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),
+ {[Tail,Skip],St2} = new_vars(2, St1),
+ {Cg,St3} = lc_guard_tests(Gs, St2),
+ {AccPat,SkipPat} = case Head of
+ #c_var{} ->
+ %% If the generator pattern is a variable, the
+ %% pattern from the accumulator clause can be
+ %% reused in the skip one. lc_tq and bc_tq1 takes
+ %% care of dismissing the latter in that case.
+ Cons = ann_c_cons(LA, Head, Tail),
+ {Cons,Cons};
+ nomatch ->
+ %% If it never matches, there is no need for
+ %% an accumulator clause.
+ {nomatch,ann_c_cons(LA, Skip, Tail)};
+ _ ->
+ {ann_c_cons(LA, Head, Tail),
+ 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,
+ 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),
+ %% 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),
+ AccPat = Cp#c_binary{segments=AccSegs},
+ {Cg,St2} = lc_guard_tests(Gs, St1),
+ {SkipSegs,St3} = emasculate_segments(AccSegs, St2),
+ SkipPat = Cp#c_binary{segments=SkipSegs},
+ {Ce,Pre,St4} = safe(E, St3),
+ 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}.
+
+append_tail_segment(Segs, St0) ->
{Var,St} = new_var(St0),
Tail = #c_bitstr{val=Var,size=#c_literal{val=all},
unit=#c_literal{val=1},
type=#c_literal{val=binary},
flags=#c_literal{val=[unsigned,big]}},
- {reverse(Acc, [Tail]),Var,St}.
+ {Segs++[Tail],Var,Tail,St}.
emasculate_segments(Segs, St) ->
emasculate_segments(Segs, St, []).
@@ -1167,7 +1163,7 @@ emasculate_segments([B|Rest], St0, Acc) ->
{Var,St1} = new_var(St0),
emasculate_segments(Rest, St1, [B#c_bitstr{val=Var}|Acc]);
emasculate_segments([], St, Acc) ->
- {lists:reverse(Acc),St}.
+ {reverse(Acc),St}.
lc_guard_tests([], St) -> {[],St};
lc_guard_tests(Gs0, St0) ->
@@ -1482,6 +1478,8 @@ pattern({cons,L,H,T}, St) ->
ann_c_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St));
pattern({tuple,L,Ps}, St) ->
ann_c_tuple(lineno_anno(L, St), pattern_list(Ps, St));
+pattern({map,L,Ps}, St) ->
+ #c_map{anno=lineno_anno(L, St), es=pattern_map_pairs(Ps, St)};
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.
@@ -1489,6 +1487,61 @@ pattern({bin,L,Ps}, St) ->
pattern({match,_,P1,P2}, St) ->
pat_alias(pattern(P1, St), pattern(P2, St)).
+%% 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) ->
+ %% FIXME: Better way to construct literals? or missing case
+ %% {Key,_,_} = expr(K, St),
+ Key = case K of
+ {bin,L,Es0} ->
+ case constant_bin(Es0) of
+ error ->
+ throw(badmatch);
+ Bin ->
+ #c_literal{anno=lineno_anno(L,St),val=Bin}
+ end;
+ _ ->
+ pattern(K,St)
+ end,
+ #c_map_pair{anno=lineno_anno(L, St),
+ op=#c_literal{val=exact},
+ key=Key,
+ val=pattern(V, St)}.
+
+
%% pat_bin([BinElement], State) -> [BinSeg].
pat_bin(Ps, St) -> [pat_segment(P, St) || P <- Ps].
@@ -1546,15 +1599,6 @@ pat_alias_list(_, _) -> throw(nomatch).
pattern_list(Ps, St) -> [pattern(P, St) || P <- Ps].
-%% first([A]) -> [A].
-%% last([A]) -> A.
-
-first([_]) -> [];
-first([H|T]) -> [H|first(T)].
-
-last([L]) -> L;
-last([_|T]) -> last(T).
-
%% make_vars([Name]) -> [{Var,Name}].
make_vars(Vs) -> [ #c_var{name=V} || V <- Vs ].
@@ -1637,13 +1681,13 @@ uclause(#iclause{anno=Anno,pats=Ps0,guard=G0,body=B0}, Pks, Ks0, St0) ->
uguard([], [], _, St) -> {[],St};
uguard(Pg, [], Ks, St) ->
%% No guard, so fold together equality tests.
- uguard(first(Pg), [last(Pg)], Ks, St);
+ uguard(droplast(Pg), [last(Pg)], Ks, St);
uguard(Pg, Gs0, Ks, St0) ->
%% Gs0 must contain at least one element here.
{Gs3,St5} = foldr(fun (T, {Gs1,St1}) ->
{L,St2} = new_var(St1),
{R,St3} = new_var(St2),
- {[#iset{var=L,arg=T}] ++ first(Gs1) ++
+ {[#iset{var=L,arg=T}] ++ droplast(Gs1) ++
[#iset{var=R,arg=last(Gs1)},
#icall{anno=#a{}, %Must have an #a{}
module=#c_literal{val=erlang},
@@ -1720,13 +1764,18 @@ uexpr(#icase{anno=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) ->
Used = union(used_in_any(As1), used_in_any(Cs1)),
New = new_in_all(Cs1),
{#icase{anno=A#a{us=Used,ns=New},args=As1,clauses=Cs1,fc=Fc1},St3};
-uexpr(#ifun{anno=A,id=Id,vars=As,clauses=Cs0,fc=Fc0}, Ks0, St0) ->
+uexpr(#ifun{anno=A0,id=Id,vars=As,clauses=Cs0,fc=Fc0,name=Name}, Ks0, St0) ->
Avs = lit_list_vars(As),
- Ks1 = union(Avs, Ks0),
- {Cs1,St1} = ufun_clauses(Cs0, Ks1, St0),
- {Fc1,St2} = ufun_clause(Fc0, Ks1, St1),
- Used = subtract(intersection(used_in_any(Cs1), Ks0), Avs),
- {#ifun{anno=A#a{us=Used,ns=[]},id=Id,vars=As,clauses=Cs1,fc=Fc1},St2};
+ Ks1 = case Name of
+ unnamed -> Ks0;
+ {named,FName} -> union(subtract([FName], Avs), Ks0)
+ end,
+ Ks2 = union(Avs, Ks1),
+ {Cs1,St1} = ufun_clauses(Cs0, Ks2, St0),
+ {Fc1,St2} = ufun_clause(Fc0, Ks2, St1),
+ Used = subtract(intersection(used_in_any(Cs1), Ks1), Avs),
+ A1 = A0#a{us=Used,ns=[]},
+ {#ifun{anno=A1,id=Id,vars=As,clauses=Cs1,fc=Fc1,name=Name},St2};
uexpr(#iapply{anno=A,op=Op,args=As}, _, St) ->
Used = union(lit_vars(Op), lit_list_vars(As)),
{#iapply{anno=A#a{us=Used},op=Op,args=As},St};
@@ -1822,6 +1871,12 @@ upattern(#c_cons{hd=H0,tl=T0}=Cons, Ks, St0) ->
upattern(#c_tuple{es=Es0}=Tuple, Ks, St0) ->
{Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0),
{Tuple#c_tuple{es=Es1},Esg,Esv,Eus,St1};
+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_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};
@@ -2021,15 +2076,25 @@ cexpr(#itry{anno=A,args=La,vars=Vs,body=Lb,evars=Evs,handler=Lh}, As, St0) ->
cexpr(#icatch{anno=A,body=Les}, _As, St0) ->
{Ces,_Us1,St1} = cexprs(Les, [], St0), %Never export!
{#c_catch{body=Ces},[],A#a.us,St1};
-cexpr(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) ->
- {Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export!
- {Cfc,St2} = cclause(Lfc, [], St1),
- Anno = A#a.anno,
- {#c_fun{anno=Id++Anno,vars=Args,
- body=#c_case{anno=Anno,
- arg=set_anno(core_lib:make_values(Args), Anno),
- clauses=Ccs ++ [Cfc]}},
- [],A#a.us,St2};
+cexpr(#ifun{name=unnamed}=Fun, As, St0) ->
+ cfun(Fun, As, St0);
+cexpr(#ifun{anno=#a{us=Us0}=A0,name={named,Name},fc=#iclause{pats=Ps}}=Fun0,
+ As, St0) ->
+ case is_element(Name, Us0) of
+ false ->
+ cfun(Fun0, As, St0);
+ true ->
+ A1 = A0#a{us=del_element(Name, Us0)},
+ Fun1 = Fun0#ifun{anno=A1},
+ {#c_fun{body=Body}=CFun0,[],Us1,St1} = cfun(Fun1, As, St0),
+ RecVar = #c_var{name={Name,length(Ps)}},
+ Let = #c_let{vars=[#c_var{name=Name}],arg=RecVar,body=Body},
+ CFun1 = CFun0#c_fun{body=Let},
+ Letrec = #c_letrec{anno=A0#a.anno,
+ defs=[{RecVar,CFun1}],
+ body=RecVar},
+ {Letrec,[],Us1,St1}
+ end;
cexpr(#iapply{anno=A,op=Op,args=Args}, _As, St) ->
{#c_apply{anno=A#a.anno,op=Op,args=Args},[],A#a.us,St};
cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St) ->
@@ -2056,23 +2121,15 @@ cexpr(Lit, _As, St) ->
%%Vs = lit_vars(Lit),
{set_anno(Lit, Anno#a.anno),[],Vs,St}.
-%% Kill the id annotations for any fun inside the expression.
-%% Necessary when duplicating code in try ... after.
-
-kill_id_anns(#ifun{clauses=Cs0}=Fun) ->
- Cs = kill_id_anns(Cs0),
- Fun#ifun{clauses=Cs,id=[]};
-kill_id_anns(#a{}=A) ->
- %% Optimization: Don't waste time searching for funs inside annotations.
- A;
-kill_id_anns([H|T]) ->
- [kill_id_anns(H)|kill_id_anns(T)];
-kill_id_anns([]) -> [];
-kill_id_anns(Tuple) when is_tuple(Tuple) ->
- L0 = tuple_to_list(Tuple),
- L = kill_id_anns(L0),
- list_to_tuple(L);
-kill_id_anns(Other) -> Other.
+cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) ->
+ {Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export!
+ {Cfc,St2} = cclause(Lfc, [], St1),
+ Anno = A#a.anno,
+ {#c_fun{anno=Id++Anno,vars=Args,
+ body=#c_case{anno=Anno,
+ arg=set_anno(core_lib:make_values(Args), Anno),
+ clauses=Ccs ++ [Cfc]}},
+ [],A#a.us,St2}.
%% lit_vars(Literal) -> [Var].
@@ -2150,6 +2207,9 @@ is_simple(#c_literal{}) -> true;
is_simple(#c_cons{hd=H,tl=T}) ->
is_simple(H) andalso is_simple(T);
is_simple(#c_tuple{es=Es}) -> is_simple_list(Es);
+is_simple(#c_map{es=Es}) -> is_simple_list(Es);
+is_simple(#c_map_pair{key=K,val=V}) ->
+ is_simple(K) andalso is_simple(V);
is_simple(_) -> false.
-spec is_simple_list([cerl:cerl()]) -> boolean().
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 65f1251099..5675572092 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -81,7 +81,7 @@
-export([module/2,format_error/1]).
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,
- keymember/3,keyfind/3,partition/2]).
+ keymember/3,keyfind/3,partition/2,droplast/1,last/1]).
-import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]).
-import(cerl, [c_tuple/1]).
@@ -272,6 +272,9 @@ expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) ->
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,var=Var0,es=Ces}, Sub, St0) ->
+ {Var,[],St1} = expr(Var0, Sub, St0),
+ map_split_pairs(A, Var, Ces, Sub, St1);
expr(#c_binary{anno=A,segments=Cv}, Sub, St0) ->
try atomic_bin(Cv, Sub, St0) of
{Kv,Ep,St1} ->
@@ -347,7 +350,7 @@ expr(#c_case{arg=Ca,clauses=Ccs}, Sub, St0) ->
{Kvs,Pv,St2} = match_vars(Ka, St1), %Must have variables here!
{Km,St3} = kmatch(Kvs, Ccs, Sub, St2),
Match = flatten_seq(build_match(Kvs, Km)),
- {last(Match),Pa ++ Pv ++ first(Match),St3};
+ {last(Match),Pa ++ Pv ++ droplast(Match),St3};
expr(#c_receive{anno=A,clauses=Ccs0,timeout=Ce,action=Ca}, Sub, St0) ->
{Ke,Pe,St1} = atomic(Ce, Sub, St0), %Force this to be atomic!
{Rvar,St2} = new_var(St1),
@@ -493,6 +496,71 @@ translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) ->
translate_fc(Args) ->
[#c_literal{val=function_clause},make_list(Args)].
+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],
+ {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}
+ 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},Em ++ Esp,St2}
+
+ end.
+
+%% Group map by Assoc operations and Exact operations
+
+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).
+
+%% 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;
+map_key_clean(#k_var{name=V}) -> {k_var,V}.
+
+
%% call_type(Module, Function, Arity) -> call | bif | apply | error.
%% Classify the call.
call_type(#c_literal{val=M}, #c_literal{val=F}, Ar) when is_atom(M), is_atom(F) ->
@@ -648,6 +716,9 @@ pattern(#c_cons{anno=A,hd=Ch,tl=Ct}, Isub, Osub0, St0) ->
pattern(#c_tuple{anno=A,es=Ces}, Isub, Osub0, St0) ->
{Kes,Osub1,St1} = pattern_list(Ces, Isub, Osub0, St0),
{#k_tuple{anno=A,es=Kes},Osub1,St1};
+pattern(#c_map{anno=A,es=Ces}, Isub, Osub0, St0) ->
+ {Kes,Osub1,St1} = pattern_map_pairs(Ces, Isub, Osub0, St0),
+ {#k_map{anno=A,op=exact,es=Kes},Osub1,St1};
pattern(#c_binary{anno=A,segments=Cv}, Isub, Osub0, St0) ->
{Kv,Osub1,St1} = pattern_bin(Cv, Isub, Osub0, St0),
{#k_binary{anno=A,segs=Kv},Osub1,St1};
@@ -662,6 +733,25 @@ flatten_alias(#c_alias{var=V,pat=P}) ->
{[V|Vs],Pat};
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),
+ {#k_map_pair{anno=A,key=Kk,val=Kv},{Osubi2,Sti2}}
+ end, {Osub0, St0}, Ces1),
+ {Kes,Osub1,St1}.
+
pattern_bin(Es, Isub, Osub0, St0) ->
{Kbin,{_,Osub},St} = pattern_bin_1(Es, Isub, Osub0, St0),
{Kbin,Osub,St}.
@@ -826,15 +916,6 @@ foldr2(Fun, Acc0, [E1|L1], [E2|L2]) ->
foldr2(Fun, Acc1, L1, L2);
foldr2(_, Acc, [], []) -> Acc.
-%% first([A]) -> [A].
-%% last([A]) -> A.
-
-last([L]) -> L;
-last([_|T]) -> last(T).
-
-first([_]) -> [];
-first([H|T]) -> [H|first(T)].
-
%% This code implements the algorithm for an optimizing compiler for
%% pattern matching given "The Implementation of Functional
%% Programming Languages" by Simon Peyton Jones. The code is much
@@ -1015,7 +1096,8 @@ match_con_1([U|_Us] = L, Cs, Def, St0) ->
%% Extract clauses for different constructors (types).
%%ok = io:format("match_con ~p~n", [Cs]),
Ttcs = select_types([k_binary], Cs) ++ select_bin_con(Cs) ++
- select_types([k_cons,k_tuple,k_atom,k_float,k_int,k_nil,k_literal], Cs),
+ select_types([k_cons,k_tuple,k_map,k_atom,k_float,k_int,
+ k_nil,k_literal], Cs),
%%ok = io:format("ttcs = ~p~n", [Ttcs]),
{Scs,St1} =
mapfoldl(fun ({T,Tcs}, St) ->
@@ -1251,10 +1333,9 @@ group_value(k_cons, Cs) -> [Cs]; %These are single valued
group_value(k_nil, Cs) -> [Cs];
group_value(k_binary, Cs) -> [Cs];
group_value(k_bin_end, Cs) -> [Cs];
-group_value(k_bin_seg, Cs) ->
- group_bin_seg(Cs);
-group_value(k_bin_int, Cs) ->
- [Cs];
+group_value(k_bin_seg, Cs) -> group_bin_seg(Cs);
+group_value(k_bin_int, Cs) -> [Cs];
+group_value(k_map, Cs) -> group_map(Cs);
group_value(_, Cs) ->
%% group_value(Cs).
Cd = foldl(fun (C, Gcs0) -> dict:append(clause_val(C), C, Gcs0) end,
@@ -1267,6 +1348,12 @@ group_bin_seg([C1|Cs]) ->
[[C1|More]|group_bin_seg(Rest)];
group_bin_seg([]) -> [].
+group_map([C1|Cs]) ->
+ V1 = clause_val(C1),
+ {More,Rest} = splitwith(fun (C) -> clause_val(C) =:= V1 end, Cs),
+ [[C1|More]|group_map(Rest)];
+group_map([]) -> [].
+
%% Profiling shows that this quadratic implementation account for a big amount
%% of the execution time if there are many values.
% group_value([C|Cs]) ->
@@ -1315,6 +1402,13 @@ get_match(#k_bin_int{}=BinInt, St0) ->
get_match(#k_tuple{es=Es}, St0) ->
{Mes,St1} = new_vars(length(Es), St0),
{#k_tuple{es=Mes},Mes,St1};
+get_match(#k_map{op=exact,es=Es0}, St0) ->
+ {Mes,St1} = new_vars(length(Es0), St0),
+ {Es,_} = mapfoldl(fun
+ (#k_map_pair{}=Pair, [V|Vs]) ->
+ {Pair#k_map_pair{val=V},Vs}
+ end, Mes, Es0),
+ {#k_map{op=exact,es=Es},Mes,St1};
get_match(M, St) ->
{M,[],St}.
@@ -1331,7 +1425,11 @@ new_clauses(Cs0, U, St) ->
[S,N|As];
#k_bin_int{next=N} ->
[N|As];
- _Other -> As
+ #k_map{op=exact,es=Es} ->
+ Vals = [V || #k_map_pair{val=V} <- Es],
+ Vals ++ As;
+ _Other ->
+ As
end,
Vs = arg_alias(Arg),
Osub1 = foldl(fun (#k_var{name=V}, Acc) ->
@@ -1406,6 +1504,7 @@ arg_con(Arg) ->
#k_nil{} -> k_nil;
#k_cons{} -> k_cons;
#k_tuple{} -> k_tuple;
+ #k_map{} -> k_map;
#k_binary{} -> k_binary;
#k_bin_end{} -> k_bin_end;
#k_bin_seg{} -> k_bin_seg;
@@ -1426,7 +1525,15 @@ arg_val(Arg, C) ->
{#k_var{name=get_vsub(V, Isub)},U,T,Fs};
_ ->
{set_kanno(S, []),U,T,Fs}
- end
+ 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)
end.
%% ubody_used_vars(Expr, State) -> [UsedVar]
@@ -1795,6 +1902,10 @@ lit_vars(#k_atom{}) -> [];
lit_vars(#k_nil{}) -> [];
lit_vars(#k_cons{hd=H,tl=T}) ->
union(lit_vars(H), lit_vars(T));
+lit_vars(#k_map{var=Var,es=Es}) ->
+ lit_list_vars([Var|Es]);
+lit_vars(#k_map_pair{key=K,val=V}) ->
+ union(lit_vars(K), lit_vars(V));
lit_vars(#k_binary{segs=V}) -> lit_vars(V);
lit_vars(#k_bin_end{}) -> [];
lit_vars(#k_bin_seg{size=Size,seg=S,next=N}) ->
@@ -1830,7 +1941,11 @@ pat_vars(#k_bin_int{size=Size}) ->
{U,[]};
pat_vars(#k_bin_end{}) -> {[],[]};
pat_vars(#k_tuple{es=Es}) ->
- pat_list_vars(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_list_vars(Ps) ->
foldl(fun (P, {Used0,New0}) ->
diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl
index fb8baf398b..ab66445f73 100644
--- a/lib/compiler/src/v3_kernel.hrl
+++ b/lib/compiler/src/v3_kernel.hrl
@@ -38,6 +38,8 @@
-record(k_nil, {anno=[]}).
-record(k_tuple, {anno=[],es}).
+-record(k_map, {anno=[],var,op,es}).
+-record(k_map_pair, {anno=[],key,val}).
-record(k_cons, {anno=[],hd,tl}).
-record(k_binary, {anno=[],segs}).
-record(k_bin_seg, {anno=[],size,unit,type,flags,seg,next}).
diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl
index e363a5387a..b4e486f97c 100644
--- a/lib/compiler/src/v3_kernel_pp.erl
+++ b/lib/compiler/src/v3_kernel_pp.erl
@@ -104,6 +104,24 @@ format_1(#k_tuple{es=Es}, Ctxt) ->
format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
$}
];
+format_1(#k_map{var=#k_var{}=Var,es=Es}, Ctxt) ->
+ [$~,${,
+ format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
+ " | ",format_1(Var, Ctxt),
+ $},$~
+ ];
+format_1(#k_map{op=assoc,es=Es}, Ctxt) ->
+ ["~{",
+ format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
+ "}~"
+ ];
+format_1(#k_map{es=Es}, Ctxt) ->
+ ["::{",
+ format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
+ "}::"
+ ];
+format_1(#k_map_pair{key=K,val=V}, Ctxt) ->
+ ["<",format(K, Ctxt),",",format(V, Ctxt),">"];
format_1(#k_binary{segs=S}, Ctxt) ->
["#<",format(S, ctxt_bump_indent(Ctxt, 2)),">#"];
format_1(#k_bin_seg{next=Next}=S, Ctxt) ->
diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl
index 2cc3493570..c4f54a7970 100644
--- a/lib/compiler/src/v3_life.erl
+++ b/lib/compiler/src/v3_life.erl
@@ -323,7 +323,9 @@ type(k_tuple) -> tuple;
type(k_binary) -> binary;
type(k_bin_seg) -> bin_seg;
type(k_bin_int) -> bin_int;
-type(k_bin_end) -> bin_end.
+type(k_bin_end) -> bin_end;
+type(k_map) -> map;
+type(k_map_pair) -> map_pair.
%% variable(Klit) -> Lit.
%% var_list([Klit]) -> [Lit].
@@ -365,6 +367,10 @@ 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_pair{key=K,val=V}, Ctxt) ->
+ {map_pair,literal(K, Ctxt),literal(V, Ctxt)};
literal(#k_literal{val=V}, _Ctxt) ->
{literal,V}.
@@ -393,7 +399,11 @@ literal2(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) ->
literal2(#k_bin_end{}, Ctxt) ->
{bin_end,Ctxt};
literal2(#k_tuple{es=Es}, Ctxt) ->
- {tuple,literal_list2(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].
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index 51b3064589..0b56a49cd6 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -26,6 +26,7 @@ MODULES= \
guard_SUITE \
inline_SUITE \
lc_SUITE \
+ map_SUITE \
match_SUITE \
misc_SUITE \
num_bif_SUITE \
@@ -47,6 +48,7 @@ NO_OPT= \
fun \
guard \
lc \
+ map \
match \
misc \
num_bif \
@@ -67,6 +69,7 @@ INLINE= \
fun \
guard \
lc \
+ map \
match \
misc \
num_bif \
diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl
index 4ffbe07e32..7bef0aa27c 100644
--- a/lib/compiler/test/andor_SUITE.erl
+++ b/lib/compiler/test/andor_SUITE.erl
@@ -194,6 +194,9 @@ t_andalso(Config) when is_list(Config) ->
?line false = id(false) andalso not id(glurf),
?line false = false andalso not id(glurf),
+ true = begin (X1 = true) andalso X1, X1 end,
+ false = false = begin (X2 = false) andalso X2, X2 end,
+
ok.
t_orelse(Config) when is_list(Config) ->
@@ -224,6 +227,9 @@ t_orelse(Config) when is_list(Config) ->
?line true = id(true) orelse not id(glurf),
?line true = true orelse not id(glurf),
+ true = begin (X1 = true) orelse X1, X1 end,
+ false = begin (X2 = false) orelse X2, X2 end,
+
ok.
t_andalso_1({X,Y}) ->
diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl
index bf67eedd5f..d088863c5c 100644
--- a/lib/compiler/test/beam_except_SUITE.erl
+++ b/lib/compiler/test/beam_except_SUITE.erl
@@ -57,6 +57,11 @@ coverage(_) ->
{'EXIT',{undef,[{erlang,error,[a,b,c],_}|_]}} =
(catch erlang:error(a, b, c)),
+
+ {'EXIT',{badarith,[{?MODULE,bar,1,[File,{line,9}]}|_]}} =
+ (catch bar(x)),
+ {'EXIT',{{case_clause,{1}},[{?MODULE,bar,1,[File,{line,9}]}|_]}} =
+ (catch bar(0)),
ok.
-file("fake.erl", 1).
@@ -65,3 +70,8 @@ fc(a) -> %Line 2
fc(L) when length(L) > 2 -> %Line 4
%% Not the same as a "real" function_clause error.
error(function_clause, [L]). %Line 6
+%% Would crash the compiler.
+bar(X) -> %Line 8
+ case {X+1} of %Line 9
+ 1 -> ok %Line 10
+ end. %Line 11
diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl
index f6d8b1c532..4450405695 100644
--- a/lib/compiler/test/bs_bincomp_SUITE.erl
+++ b/lib/compiler/test/bs_bincomp_SUITE.erl
@@ -25,7 +25,7 @@
init_per_group/2,end_per_group/2,
byte_aligned/1,bit_aligned/1,extended_byte_aligned/1,
extended_bit_aligned/1,mixed/1,filters/1,trim_coverage/1,
- nomatch/1,sizes/1,tail/1]).
+ nomatch/1,sizes/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -35,7 +35,7 @@ all() ->
test_lib:recompile(?MODULE),
[byte_aligned, bit_aligned, extended_byte_aligned,
extended_bit_aligned, mixed, filters, trim_coverage,
- nomatch, sizes, tail].
+ nomatch, sizes].
groups() ->
[].
@@ -290,40 +290,6 @@ sizes(Config) when is_list(Config) ->
?line cs_end(),
ok.
-tail(Config) when is_list(Config) ->
- ?line [] = tail_1(<<0:7>>),
- ?line [0] = tail_1(<<0>>),
- ?line [0] = tail_1(<<0:12>>),
- ?line [0,0] = tail_1(<<0:20>>),
-
- ?line [] = tail_2(<<0:7>>),
- ?line [42] = tail_2(<<0>>),
- ?line [] = tail_2(<<0:12>>),
- ?line [42,42] = tail_2(<<0,1>>),
-
- ?line <<>> = tail_3(<<0:7>>),
- ?line <<42>> = tail_3(<<0>>),
- ?line <<42>> = tail_3(<<0:12>>),
- ?line <<42,42>> = tail_3(<<0:20>>),
-
- ?line [] = tail_4(<<0:15>>),
- ?line [7] = tail_4(<<7,8>>),
- ?line [9] = tail_4(<<9,17:12>>),
- ok.
-
-tail_1(Bits) ->
- [X || <<X:8/integer, _/bits>> <= Bits].
-
-tail_2(Bits) ->
- [42 || <<_:8/integer, _/bytes>> <= Bits].
-
-tail_3(Bits) ->
- << <<42>> || <<_:8/integer, _/bits>> <= Bits >>.
-
-tail_4(Bits) ->
- [X || <<X:8/integer, Tail/bits>> <= Bits, bit_size(Tail) >= 8].
-
-
cs_init() ->
erts_debug:set_internal_state(available_internal_state, true),
ok.
diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl
index 9f15845d33..149b9bbb8f 100644
--- a/lib/compiler/test/bs_match_SUITE.erl
+++ b/lib/compiler/test/bs_match_SUITE.erl
@@ -34,7 +34,7 @@
otp_7188/1,otp_7233/1,otp_7240/1,otp_7498/1,
match_string/1,zero_width/1,bad_size/1,haystack/1,
cover_beam_bool/1,matched_out_size/1,follow_fail_branch/1,
- no_partition/1]).
+ no_partition/1,calling_a_binary/1]).
-export([coverage_id/1,coverage_external_ignore/2]).
@@ -59,7 +59,7 @@ groups() ->
matching_and_andalso,otp_7188,otp_7233,otp_7240,
otp_7498,match_string,zero_width,bad_size,haystack,
cover_beam_bool,matched_out_size,follow_fail_branch,
- no_partition]}].
+ no_partition,calling_a_binary]}].
init_per_suite(Config) ->
@@ -1178,6 +1178,17 @@ no_partition_2([], a5) ->
no_partition_2(42.0, a6) ->
six.
+calling_a_binary(Config) when is_list(Config) ->
+ [] = call_binary(<<>>, []),
+ {'EXIT',{badarg,_}} = (catch call_binary(<<1>>, [])),
+ {'EXIT',{badarg,_}} = (catch call_binary(<<1,2,3>>, [])),
+ ok.
+
+call_binary(<<>>, Acc) ->
+ Acc;
+call_binary(<<H,T/bits>>, Acc) ->
+ T(<<Acc/binary,H>>).
+
check(F, R) ->
R = F().
diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl
index d517029b1b..f7b1dbdddf 100644
--- a/lib/compiler/test/compilation_SUITE.erl
+++ b/lib/compiler/test/compilation_SUITE.erl
@@ -196,7 +196,7 @@ redundant_case_1(_) -> d.
failure(Module, Conf) ->
?line Src = filename:join(?config(data_dir, Conf), atom_to_list(Module)),
?line Out = ?config(priv_dir,Conf),
- ?line io:format("Compiling: ~s\n", [Src]),
+ ?line io:format("Compiling: ~ts\n", [Src]),
?line CompRc = compile:file(Src, [{outdir,Out},return,time]),
?line io:format("Result: ~p\n",[CompRc]),
?line case CompRc of
@@ -278,6 +278,16 @@ try_it(StartNode, Module, Conf) ->
?line ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]),
?line test_server:timetrap_cancel(LastDog),
+ AsmDog = test_server:timetrap(test_server:minutes(10)),
+ io:format("Compiling (from assembly): ~s\n", [Src]),
+ {ok,_} = compile:file(Src, [to_asm,{outdir,Out},report|OtherOpts]),
+ Asm = filename:join(Out, lists:concat([Module, ".S"])),
+ CompRc3 = compile:file(Asm, [from_asm,{outdir,Out},report|OtherOpts]),
+ io:format("Result: ~p\n",[CompRc3]),
+ {ok,_} = CompRc3,
+ ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]),
+ test_server:timetrap_cancel(AsmDog),
+
case StartNode of
false -> ok;
true -> ?line test_server:stop_node(Node)
@@ -466,8 +476,8 @@ self_compile_node(CompilerDir, OutDir, Version, Opts) ->
ok.
compile_compiler(Files, OutDir, Version, InlineOpts) ->
- io:format("~s", [code:which(compile)]),
- io:format("Compiling ~s into ~s", [Version,OutDir]),
+ io:format("~ts", [code:which(compile)]),
+ io:format("Compiling ~s into ~ts", [Version,OutDir]),
Opts = [report,
bin_opt_info,
{outdir,OutDir},
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index be01ea713d..8cb7d1b55b 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -24,7 +24,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
- app_test/1,
+ app_test/1,appup_test/1,
file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1,
binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1,
other_output/1, encrypted_abstr/1,
@@ -42,7 +42,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
test_lib:recompile(?MODULE),
- [app_test, file_1, forms_2, module_mismatch, big_file, outdir,
+ [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir,
binary, makedep, cond_and_ifdef, listings, listings_big,
other_output, encrypted_abstr,
{group, bad_record_use}, strict_record,
@@ -71,6 +71,10 @@ end_per_group(_GroupName, Config) ->
app_test(Config) when is_list(Config) ->
?line ?t:app_test(compiler).
+%% Test that the Application upgrade file has no `basic' errors.";
+appup_test(Config) when is_list(Config) ->
+ ok = ?t:appup_test(compiler).
+
%% Tests that we can compile and run a simple Erlang program,
%% using compile:file/1.
@@ -286,57 +290,67 @@ cond_and_ifdef(Config) when is_list(Config) ->
ok.
listings(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(8)),
- ?line DataDir = ?config(data_dir, Config),
- ?line PrivDir = ?config(priv_dir, Config),
- ?line Simple = filename:join(DataDir, simple),
- ?line TargetDir = filename:join(PrivDir, listings),
- ?line ok = file:make_dir(TargetDir),
+ Dog = test_server:timetrap(test_server:minutes(8)),
+ DataDir = ?config(data_dir, Config),
+ PrivDir = ?config(priv_dir, Config),
+ ok = do_file_listings(DataDir, PrivDir, [
+ "simple",
+ "small",
+ "small_maps"
+ ]),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+do_file_listings(_, _, []) -> ok;
+do_file_listings(DataDir, PrivDir, [File|Files]) ->
+ Simple = filename:join(DataDir, File),
+ TargetDir = filename:join(PrivDir, listings),
+ ok = file:make_dir(TargetDir),
%% Test all dedicated listing options.
- ?line do_listing(Simple, TargetDir, 'S'),
- ?line do_listing(Simple, TargetDir, 'E'),
- ?line do_listing(Simple, TargetDir, 'P'),
- ?line do_listing(Simple, TargetDir, dpp, ".pp"),
- ?line do_listing(Simple, TargetDir, dabstr, ".abstr"),
- ?line do_listing(Simple, TargetDir, dexp, ".expand"),
- ?line do_listing(Simple, TargetDir, dcore, ".core"),
- ?line do_listing(Simple, TargetDir, doldinline, ".oldinline"),
- ?line do_listing(Simple, TargetDir, dinline, ".inline"),
- ?line do_listing(Simple, TargetDir, dcore, ".core"),
- ?line do_listing(Simple, TargetDir, dcopt, ".copt"),
- ?line do_listing(Simple, TargetDir, dsetel, ".dsetel"),
- ?line do_listing(Simple, TargetDir, dkern, ".kernel"),
- ?line do_listing(Simple, TargetDir, dlife, ".life"),
- ?line do_listing(Simple, TargetDir, dcg, ".codegen"),
- ?line do_listing(Simple, TargetDir, dblk, ".block"),
- ?line do_listing(Simple, TargetDir, dbool, ".bool"),
- ?line do_listing(Simple, TargetDir, dtype, ".type"),
- ?line do_listing(Simple, TargetDir, ddead, ".dead"),
- ?line do_listing(Simple, TargetDir, djmp, ".jump"),
- ?line do_listing(Simple, TargetDir, dclean, ".clean"),
- ?line do_listing(Simple, TargetDir, dpeep, ".peep"),
- ?line do_listing(Simple, TargetDir, dopt, ".optimize"),
+ do_listing(Simple, TargetDir, 'S'),
+ do_listing(Simple, TargetDir, 'E'),
+ do_listing(Simple, TargetDir, 'P'),
+ do_listing(Simple, TargetDir, dpp, ".pp"),
+ do_listing(Simple, TargetDir, dabstr, ".abstr"),
+ do_listing(Simple, TargetDir, dexp, ".expand"),
+ do_listing(Simple, TargetDir, dcore, ".core"),
+ do_listing(Simple, TargetDir, doldinline, ".oldinline"),
+ do_listing(Simple, TargetDir, dinline, ".inline"),
+ do_listing(Simple, TargetDir, dcore, ".core"),
+ do_listing(Simple, TargetDir, dcopt, ".copt"),
+ do_listing(Simple, TargetDir, dsetel, ".dsetel"),
+ do_listing(Simple, TargetDir, dkern, ".kernel"),
+ do_listing(Simple, TargetDir, dlife, ".life"),
+ do_listing(Simple, TargetDir, dcg, ".codegen"),
+ do_listing(Simple, TargetDir, dblk, ".block"),
+ do_listing(Simple, TargetDir, dbool, ".bool"),
+ do_listing(Simple, TargetDir, dtype, ".type"),
+ do_listing(Simple, TargetDir, ddead, ".dead"),
+ do_listing(Simple, TargetDir, djmp, ".jump"),
+ do_listing(Simple, TargetDir, dclean, ".clean"),
+ do_listing(Simple, TargetDir, dpeep, ".peep"),
+ do_listing(Simple, TargetDir, dopt, ".optimize"),
%% First clean up.
- ?line Listings = filename:join(PrivDir, listings),
- ?line lists:foreach(fun(F) -> ok = file:delete(F) end,
- filelib:wildcard(filename:join(Listings, "*"))),
+ Listings = filename:join(PrivDir, listings),
+ lists:foreach(fun(F) -> ok = file:delete(F) end,
+ filelib:wildcard(filename:join(Listings, "*"))),
%% Test options that produce a listing file if 'binary' is not given.
- ?line do_listing(Simple, TargetDir, to_pp, ".P"),
- ?line do_listing(Simple, TargetDir, to_exp, ".E"),
- ?line do_listing(Simple, TargetDir, to_core0, ".core"),
- ?line ok = file:delete(filename:join(Listings, "simple.core")),
- ?line do_listing(Simple, TargetDir, to_core, ".core"),
- ?line do_listing(Simple, TargetDir, to_kernel, ".kernel"),
+ do_listing(Simple, TargetDir, to_pp, ".P"),
+ do_listing(Simple, TargetDir, to_exp, ".E"),
+ do_listing(Simple, TargetDir, to_core0, ".core"),
+ ok = file:delete(filename:join(Listings, File ++ ".core")),
+ do_listing(Simple, TargetDir, to_core, ".core"),
+ do_listing(Simple, TargetDir, to_kernel, ".kernel"),
%% Final clean up.
- ?line lists:foreach(fun(F) -> ok = file:delete(F) end,
- filelib:wildcard(filename:join(Listings, "*"))),
- ?line ok = file:del_dir(Listings),
- ?line test_server:timetrap_cancel(Dog),
- ok.
+ lists:foreach(fun(F) -> ok = file:delete(F) end,
+ filelib:wildcard(filename:join(Listings, "*"))),
+ ok = file:del_dir(Listings),
+
+ do_file_listings(DataDir,PrivDir,Files).
listings_big(Config) when is_list(Config) ->
?line Dog = test_server:timetrap(test_server:minutes(10)),
@@ -415,11 +429,11 @@ encrypted_abstr(Config) when is_list(Config) ->
?line {Simple,Target} = files(Config, "encrypted_abstr"),
Res = case has_crypto() of
- no ->
+ false ->
%% No crypto.
?line encrypted_abstr_no_crypto(Simple, Target),
{comment,"The crypto application is missing or broken"};
- yes ->
+ true ->
%% Simulate not having crypto by removing
%% the crypto application from the path.
?line OldPath = code:get_path(),
@@ -511,6 +525,7 @@ write_crypt_file(Contents0) ->
ok = file:write_file(".erlang.crypt", Contents).
encrypted_abstr_no_crypto(Simple, Target) ->
+ io:format("simpe: ~p~n", [Simple]),
?line TargetDir = filename:dirname(Target),
?line Key = "ablurf123BX#$;3",
?line error = compile:file(Simple,
@@ -525,11 +540,11 @@ verify_abstract(Target) ->
has_crypto() ->
try
crypto:start(),
- crypto:info(),
+ <<_,_,_,_,_>> = crypto:rand_bytes(5),
crypto:stop(),
- yes
+ true
catch
- error:_ -> no
+ error:_ -> false
end.
install_crypto_key(Key) ->
@@ -769,8 +784,8 @@ do_core({M,A}, Outdir) ->
error
end.
-%% Compile to Beam assembly language (.S) and the try to
-%% run .S throught the compiler again.
+%% Compile to Beam assembly language (.S) and then try to
+%% run .S through the compiler again.
asm(Config) when is_list(Config) ->
?line Dog = test_server:timetrap(test_server:minutes(20)),
@@ -791,10 +806,10 @@ do_asm(Beam, Outdir) ->
try
{ok,M,Asm} = compile:forms(A, ['S']),
AsmFile = filename:join(Outdir, atom_to_list(M)++".S"),
- {ok,Fd} = file:open(AsmFile, [write]),
+ {ok,Fd} = file:open(AsmFile, [write,{encoding,utf8}]),
beam_listing:module(Fd, Asm),
ok = file:close(Fd),
- case compile:file(AsmFile, [from_asm,no_postopt,binary,report]) of
+ case compile:file(AsmFile, [from_asm,binary,report]) of
{ok,M,_} ->
ok = file:delete(AsmFile);
Other ->
diff --git a/lib/compiler/test/compile_SUITE_data/small.erl b/lib/compiler/test/compile_SUITE_data/small.erl
new file mode 100644
index 0000000000..37cd270e50
--- /dev/null
+++ b/lib/compiler/test/compile_SUITE_data/small.erl
@@ -0,0 +1,48 @@
+-module(small).
+
+-export([go/0,go/2]).
+
+
+-small_attribute({value,3}).
+
+go() -> go(3, 3.0).
+go(A,B) ->
+ V1 = A + B,
+ V2 = A * B,
+ V3 = V1 / V2,
+ V4 = V3 / 0.3,
+ V5 = V1 + V2 + V3 + V4,
+ try
+ R = call(<<"wazzup">>, A),
+ {A,B,V5,R,t(),recv()}
+ catch
+ C:E ->
+ {error, C, E}
+ end.
+
+-spec call(binary(), term()) -> binary().
+
+call(<<"wa", B/binary>>,V) when is_integer(V) -> B;
+call(B,_) -> B.
+
+t() ->
+ <<23:32, V:14, _:2, B/binary>> = id(<<"wazzup world">>),
+ {V,B}.
+
+recv() ->
+ F = fun() ->
+ receive
+ 1 -> ok;
+ 2 -> ok;
+ 3 -> ok;
+ a -> ok;
+ _ -> none
+ after 0 -> tmo
+ end
+ end,
+ tmo = F(),
+ ok.
+
+
+id(I) -> I.
+
diff --git a/lib/compiler/test/compile_SUITE_data/small_maps.erl b/lib/compiler/test/compile_SUITE_data/small_maps.erl
new file mode 100644
index 0000000000..a17a136a7d
--- /dev/null
+++ b/lib/compiler/test/compile_SUITE_data/small_maps.erl
@@ -0,0 +1,16 @@
+-module(small_maps).
+
+-export([go/0,go/1]).
+
+go() ->
+ go(1337).
+
+go(V0) ->
+ M0 = #{ a => 1, val => V0},
+ V1 = get_val(M0),
+ M1 = M0#{ val := [V0,V1] },
+ {some_val,[1337,{some_val,1337}]} = get_val(M1),
+ ok.
+
+get_val(#{ "wazzup" := _, val := V}) -> V;
+get_val(#{ val := V }) -> {some_val, V}.
diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl
index a40dc32d59..aa222c48de 100644
--- a/lib/compiler/test/core_SUITE.erl
+++ b/lib/compiler/test/core_SUITE.erl
@@ -23,7 +23,8 @@
init_per_testcase/2,end_per_testcase/2,
dehydrated_itracer/1,nested_tries/1,
seq_in_guard/1,make_effect_seq/1,eval_is_boolean/1,
- unsafe_case/1,nomatch_shadow/1,reversed_annos/1]).
+ unsafe_case/1,nomatch_shadow/1,reversed_annos/1,
+ map_core_test/1,eval_case/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -48,7 +49,9 @@ all() ->
groups() ->
[{p,test_lib:parallel(),
[dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq,
- eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos]}].
+ eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos,
+ map_core_test,eval_case
+ ]}].
init_per_suite(Config) ->
@@ -72,6 +75,8 @@ end_per_group(_GroupName, Config) ->
?comp(unsafe_case).
?comp(nomatch_shadow).
?comp(reversed_annos).
+?comp(map_core_test).
+?comp(eval_case).
try_it(Mod, Conf) ->
Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)),
diff --git a/lib/compiler/test/core_SUITE_data/eval_case.core b/lib/compiler/test/core_SUITE_data/eval_case.core
new file mode 100644
index 0000000000..f2776e2b1f
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/eval_case.core
@@ -0,0 +1,34 @@
+module 'eval_case' ['eval_case'/0]
+ attributes []
+'eval_case'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ case apply 'do_case'/0() of
+ <'ok'> when 'true' ->
+ 'ok'
+ ( <_cor0> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor0})
+ -| ['compiler_generated'] )
+ end
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'eval_case',0}}] )
+ -| ['compiler_generated'] )
+ end
+'do_case'/0 =
+ fun () ->
+ case let <_cor0> =
+ apply 'id'/1(42)
+ in let <_cor1> =
+ call 'erlang':'+'
+ (_cor0, 7)
+ in {'x',_cor1} of
+ <{'x',49}> when 'true' ->
+ 'ok'
+ end
+'id'/1 =
+ fun (_cor0) -> _cor0
+end
diff --git a/lib/compiler/test/core_SUITE_data/map_core_test.core b/lib/compiler/test/core_SUITE_data/map_core_test.core
new file mode 100644
index 0000000000..7ece8a8bbd
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/map_core_test.core
@@ -0,0 +1,95 @@
+module 'map_core_test' ['map_core_test'/0,
+ 'module_info'/0,
+ 'module_info'/1]
+ attributes []
+'map_core_test'/0 =
+ %% Line 14
+ fun () ->
+ let <_cor0> =
+ %% Line 15
+ ~{::<'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>}~
+ in let <M> =
+ %% Line 15
+ apply 'id'/1
+ (_cor0)
+ in let <_cor2> =
+ %% Line 16
+ apply 'id'/1
+ ([1|[2|[3|[4|[5|[6]]]]]])
+ in %% Line 16
+ case apply 'call'/2
+ (M, _cor2) of
+ <~{~<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']]),
+ #<32>(8,1,'integer',['unsigned'|['big']]),
+ #<49>(8,1,'integer',['unsigned'|['big']]),
+ #<32>(8,1,'integer',['unsigned'|['big']]),
+ #<50>(8,1,'integer',['unsigned'|['big']]),
+ #<32>(8,1,'integer',['unsigned'|['big']]),
+ #<51>(8,1,'integer',['unsigned'|['big']]),
+ #<32>(8,1,'integer',['unsigned'|['big']]),
+ #<52>(8,1,'integer',['unsigned'|['big']]),
+ #<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' ->
+ %% Line 17
+ 'ok'
+ ( <_cor3> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor3})
+ -| ['compiler_generated'] )
+ end
+'call'/2 =
+ %% Line 20
+ fun (_cor1,_cor0) ->
+ case <_cor1,_cor0> of
+ <M = ~{~<1337,Bin>,~<'check',_cor8>,~<'val',Val>}~,[V|Vs]> when 'true' ->
+ let <_cor3> =
+ %% Line 21
+ call 'erlang':'+'
+ (V, 48)
+ in let <_cor4> =
+ %% Line 21
+ #{#<Bin>('all',8,'binary',['unsigned'|['big']]),
+ #<32>(8,1,'integer',['unsigned'|['big']]),
+ #<_cor3>(8,1,'integer',['unsigned'|['big']])}#
+ in let <_cor2> =
+ %% Line 21
+ call 'erlang':'+'
+ (Val, V)
+ in let <_cor5> =
+ %% Line 21
+ M~{~<1337,_cor4>,~<'val',_cor2>}~
+ in %% Line 21
+ apply 'call'/2
+ (_cor5, Vs)
+ %% Line 22
+ <M,[]> when 'true' ->
+ M
+ ( <_cor7,_cor6> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor7,_cor6})
+ -| [{'function_name',{'call',2}}] )
+ -| ['compiler_generated'] )
+ end
+'id'/1 =
+ %% Line 24
+ fun (_cor0) ->
+ _cor0
+'module_info'/0 =
+ fun () ->
+ call 'erlang':'get_module_info'
+ ('map_core_test')
+'module_info'/1 =
+ fun (_cor0) ->
+ call 'erlang':'get_module_info'
+ ('map_core_test', _cor0)
+end \ No newline at end of file
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index a5a4e62a42..8151dc1b16 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -22,7 +22,8 @@
init_per_group/2,end_per_group/2,
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]).
+ unused_multiple_values_error/1,unused_multiple_values/1,
+ multiple_aliases/1]).
-export([foo/0,foo/1,foo/2,foo/3]).
@@ -38,7 +39,8 @@ groups() ->
[{p,test_lib: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]}].
+ unused_multiple_values_error,unused_multiple_values,
+ multiple_aliases]}].
init_per_suite(Config) ->
@@ -249,6 +251,12 @@ coverage(Config) when is_list(Config) ->
case list_to_pid("<0.42.0>") of
Pid when is_pid(Pid) -> ok
end,
+
+ %% Cover the non-variable case in bsm_do_an/4.
+ ok = bsm_an_inlined(<<1>>, Config),
+ error = bsm_an_inlined(<<1,2,3>>, Config),
+ error = bsm_an_inlined([], Config),
+
ok.
cover_will_match_list_type(A) ->
@@ -290,7 +298,8 @@ cover_is_safe_bool_expr(X) ->
false
end.
-id(I) -> I.
+bsm_an_inlined(<<_:8>>, _) -> ok;
+bsm_an_inlined(_, _) -> error.
unused_multiple_values_error(Config) when is_list(Config) ->
PrivDir = ?config(priv_dir, Config),
@@ -329,3 +338,31 @@ do_something(I) ->
put(unused_multiple_values,
[I|get(unused_multiple_values)]),
I.
+
+
+%% Make sure that multiple aliases does not cause
+%% the case expression to be evaluated twice.
+multiple_aliases(Config) when is_list(Config) ->
+ do_ma(fun() ->
+ X = Y = run_once(),
+ {X,Y}
+ end, {ok,ok}),
+ do_ma(fun() ->
+ case {true,run_once()} of
+ {true=A=B,ok=X=Y} ->
+ {A,B,X,Y}
+ end
+ end, {true,true,ok,ok}),
+ ok.
+
+do_ma(Fun, Expected) when is_function(Fun, 0) ->
+ Expected = Fun(),
+ ran_once = erase(run_once),
+ ok.
+
+run_once() ->
+ undefined = put(run_once, ran_once),
+ ok.
+
+
+id(I) -> I.
diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl
index 859c4571ea..5cdf429a5f 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]).
+ transforms/1,forbidden_maps/1]).
%% Used by transforms/1 test case.
-export([parse_transform/2]).
@@ -36,7 +36,7 @@ all() ->
groups() ->
[{p,test_lib:parallel(),
- [head_mismatch_line,warnings_as_errors,bif_clashes,transforms]}].
+ [head_mismatch_line,warnings_as_errors,bif_clashes,transforms,forbidden_maps]}].
init_per_suite(Config) ->
Config.
@@ -240,6 +240,21 @@ parse_transform(_, _) ->
error(too_bad).
+forbidden_maps(Config) when is_list(Config) ->
+ Ts1 = [{map_illegal_use_of_pattern,
+ <<"
+ -export([t/0]).
+ t() ->
+ V = 32,
+ #{<<\"hi\",V,\"all\">> := 1} = id(#{<<\"hi all\">> => 1}).
+ id(I) -> I.
+ ">>,
+ [return],
+ {error,[{5,erl_lint,{illegal_map_key_variable,'V'}}], []}}],
+ [] = run2(Config, Ts1),
+ ok.
+
+
run(Config, Tests) ->
?line File = test_filename(Config),
run(Tests, File, dont_write_beam).
diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl
index 6067ee8e06..e35692efd1 100644
--- a/lib/compiler/test/fun_SUITE.erl
+++ b/lib/compiler/test/fun_SUITE.erl
@@ -21,7 +21,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1,
- external/1]).
+ external/1,eep37/1]).
%% Internal export.
-export([call_me/1]).
@@ -32,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
test_lib:recompile(?MODULE),
- [test1,overwritten_fun,otp_7202,bif_fun,external].
+ [test1,overwritten_fun,otp_7202,bif_fun,external,eep37].
groups() ->
[].
@@ -197,5 +197,14 @@ external(Config) when is_list(Config) ->
call_me(I) ->
{ok,I}.
+eep37(Config) when is_list(Config) ->
+ F = fun Fact(N) when N > 0 -> N * Fact(N - 1); Fact(0) -> 1 end,
+ Add = fun _(N) -> N + 1 end,
+ UnusedName = fun BlackAdder(N) -> N + 42 end,
+ 720 = F(6),
+ 10 = Add(9),
+ 50 = UnusedName(8),
+ ok.
+
id(I) ->
I.
diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl
index e5c2d4f73a..47851e680b 100644
--- a/lib/compiler/test/inline_SUITE.erl
+++ b/lib/compiler/test/inline_SUITE.erl
@@ -37,7 +37,7 @@ all() ->
groups() ->
[{p,test_lib:parallel(),
[attribute,bsdecode,bsdes,barnes2,decode1,smith,fname,
- itracer,pseudoknot,comma_splitter,lists,really_inlined,otp_7223,
+ itracer,pseudoknot,maps_inline_test,comma_splitter,lists,really_inlined,otp_7223,
coverage]}].
init_per_suite(Config) ->
@@ -85,6 +85,7 @@ attribute(Config) when is_list(Config) ->
?comp(pseudoknot).
?comp(comma_splitter).
?comp(fname).
+?comp(maps_inline_test).
try_inline(Mod, Config) ->
Node = ?config(testing_node, Config),
diff --git a/lib/compiler/test/inline_SUITE_data/maps_inline_test.erl b/lib/compiler/test/inline_SUITE_data/maps_inline_test.erl
new file mode 100644
index 0000000000..d9762e2647
--- /dev/null
+++ b/lib/compiler/test/inline_SUITE_data/maps_inline_test.erl
@@ -0,0 +1,70 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013. 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(maps_inline_test).
+
+-export([?MODULE/0]).
+
+?MODULE() ->
+ 21 = mval(#{val => 1}) +
+ mval(#{val => 2}) +
+ mval(#{val => 3}) +
+ mval(#{val => 4}) +
+ mval(#{val => 5}) +
+ mval(#{val => 6}),
+
+ 21 = gval(#{id => 1}) +
+ gval(#{id => 2}) +
+ gval(#{id => 3}) +
+ gval(#{id => 4}) +
+ gval(#{id => 5}) +
+ gval(#{id => 6}),
+
+ 21 = sval(#{id => 1}) +
+ sval(#{id => 2}) +
+ sval(#{id => 3}) +
+ sval(#{id => 4}) +
+ sval(#{id => 5}) +
+ sval(#{id => 6}),
+
+ M = #{v => 1, m => #{v => 21, m => #{v => 7, m => 13}}},
+
+ 42 = decompose(M).
+
+% switch key orders
+decompose(#{ m := M, v := V}) when is_map(M) ->
+ V + decompose(M);
+decompose(#{ v := V, m := M}) -> V + M.
+
+
+mval(#{val := V}) -> V.
+
+sval(#{id := 1}) -> 6;
+sval(#{id := 2}) -> 5;
+sval(#{id := 3}) -> 4;
+sval(#{id := 4}) -> 3;
+sval(#{id := 5}) -> 2;
+sval(#{id := 6}) -> 1.
+
+gval(M) when is_map(M) andalso M =:= #{ id => 1} -> 1;
+gval(M) when is_map(M) andalso M =:= #{ id => 2} -> 4;
+gval(M) when is_map(M) andalso M =:= #{ id => 3} -> 2;
+gval(M) when is_map(M) andalso M =:= #{ id => 4} -> 5;
+gval(M) when is_map(M) andalso M =:= #{ id => 5} -> 3;
+gval(M) when is_map(M) andalso M =:= #{ id => 6} -> 6.
diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl
new file mode 100644
index 0000000000..b4baef461b
--- /dev/null
+++ b/lib/compiler/test/map_SUITE.erl
@@ -0,0 +1,534 @@
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013. 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(map_SUITE).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2
+ ]).
+
+-export([
+ t_build_and_match_literals/1,
+ t_update_literals/1,t_match_and_update_literals/1,
+ t_update_map_expressions/1,
+ t_update_assoc/1,t_update_exact/1,
+ t_guard_bifs/1, t_guard_sequence/1, t_guard_update/1,
+ t_guard_receive/1, t_guard_fun/1,
+ t_list_comprehension/1,
+ t_map_sort_literals/1,
+ t_map_size/1,
+ t_build_and_match_aliasing/1,
+
+ %% warnings
+ t_warn_useless_build/1,
+ t_warn_pair_key_overloaded/1,
+
+ %% not covered in 17.0-rc1
+ t_build_and_match_over_alloc/1,
+ t_build_and_match_empty_val/1,
+ t_build_and_match_val/1,
+
+ %% errors in 17.0-rc1
+ t_update_values/1
+ ]).
+
+suite() -> [].
+
+all() -> [
+ t_build_and_match_literals,
+ t_update_literals, t_match_and_update_literals,
+ t_update_map_expressions,
+ t_update_assoc,t_update_exact,
+ t_guard_bifs, t_guard_sequence, t_guard_update,
+ t_guard_receive,t_guard_fun, t_list_comprehension,
+ t_map_sort_literals,
+ t_map_size,
+ t_build_and_match_aliasing,
+
+ %% warnings
+ t_warn_useless_build,
+ t_warn_pair_key_overloaded,
+
+ %% not covered in 17.0-rc1
+ t_build_and_match_over_alloc,
+ t_build_and_match_empty_val,
+ t_build_and_match_val,
+
+ %% errors in 17.0-rc1
+ t_update_values
+ ].
+
+groups() -> [].
+
+init_per_suite(Config) -> Config.
+end_per_suite(_Config) -> ok.
+
+init_per_group(_GroupName, Config) -> Config.
+end_per_group(_GroupName, Config) -> Config.
+
+%% tests
+
+t_build_and_match_literals(Config) when is_list(Config) ->
+ #{} = id(#{}),
+ #{1:=a} = id(#{1=>a}),
+ #{1:=a,2:=b} = id(#{1=>a,2=>b}),
+ #{1:=a,2:=b,3:="c"} = id(#{1=>a,2=>b,3=>"c"}),
+ #{1:=a,2:=b,3:="c","4":="d"} = id(#{1=>a,2=>b,3=>"c","4"=>"d"}),
+ #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>} =
+ id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>}),
+ #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f"} =
+ id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f"}),
+ #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} =
+ id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}),
+
+ #{<<"hi all">> := 1} = id(#{<<"hi",32,"all">> => 1}),
+
+ #{a:=X,a:=X=3,b:=4} = id(#{a=>3,b=>4}), % weird but ok =)
+
+ #{ a:=#{ b:=#{c := third, b:=second}}, b:=first} =
+ id(#{ b=>first, a=>#{ b=>#{c => third, b=> second}}}),
+
+ M = #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first},
+ M = #{ map_1:=#{ map_2:=#{value_3 := third}, value_2:= second}, value_1:=first} =
+ id(#{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}),
+
+ %% error case
+ {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{x:=2} = id(#{x=>3}))),
+ {'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"}))),
+ 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,
+ true = C1 =:= C2,
+ #{a:=A,a:=A,a:=A,b:=B,b:=B} = M1,
+ #{a:=A,a:=A,a:=A,b:=B,b:=B,b:=2} = M1,
+ #{a:=A=1,a:=A,a:=A,b:=B=2,b:=B,b:=2} = M1,
+ #{c:=C1, c:=_, c:=3, c:=_, c:=C2} = M1,
+ #{c:=C=_=3=_=C} = M1,
+
+ 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,
+ ok.
+
+t_map_size(Config) when is_list(Config) ->
+ 0 = map_size(id(#{})),
+ 1 = map_size(id(#{a=>1})),
+ 1 = map_size(id(#{a=>"wat"})),
+ 2 = map_size(id(#{a=>1, b=>2})),
+ 3 = map_size(id(#{a=>1, b=>2, b=>"3","33"=><<"n">>})),
+
+ true = map_is_size(#{a=>1}, 1),
+ true = map_is_size(#{a=>1, a=>2}, 1),
+ M = #{ "a" => 1, "b" => 2},
+ true = map_is_size(M, 2),
+ false = map_is_size(M, 3),
+ true = map_is_size(M#{ "a" => 2}, 2),
+ false = map_is_size(M#{ "c" => 2}, 2),
+
+ %% Error cases.
+ {'EXIT',{badarg,_}} = (catch map_size([])),
+ {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)),
+ {'EXIT',{badarg,_}} = (catch map_size(1)),
+ ok.
+
+map_is_size(M,N) when map_size(M) =:= N -> true;
+map_is_size(_,_) -> false.
+
+% test map updates without matching
+t_update_literals(Config) when is_list(Config) ->
+ Map = #{x=>1,y=>2,z=>3,q=>4},
+ #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [
+ {"a","1"},{"b","2"},{"c","3"},{"d","4"}
+ ]),
+ ok.
+
+loop_update_literals_x_q(Map, []) -> Map;
+loop_update_literals_x_q(Map, [{X,Q}|Vs]) ->
+ loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs).
+
+% test map updates with matching
+t_match_and_update_literals(Config) when is_list(Config) ->
+ Map = #{x=>0,y=>"untouched",z=>"also untouched",q=>1},
+ #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [
+ {1,2},{3,4},{5,6},{7,8}
+ ]),
+ M0 = id(#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
+ 4 => number, 18446744073709551629 => wat}),
+ M1 = id(#{}),
+ M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
+ 4 => number, 18446744073709551629 => wat},
+ M0 = M2,
+
+ #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number },
+ ok.
+
+loop_match_and_update_literals_x_q(Map, []) -> Map;
+loop_match_and_update_literals_x_q(#{q:=Q0,x:=X0} = Map, [{X,Q}|Vs]) ->
+ loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs).
+
+
+t_update_map_expressions(Config) when is_list(Config) ->
+ M = maps:new(),
+ #{ a := 1 } = M#{a => 1},
+
+ #{ b := 2 } = (maps:new())#{ b => 2 },
+
+ #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 },
+ #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 },
+
+ %% Test need to be in a fun.
+ %% This tests that let expr optimisation in sys_core_fold
+ %% covers maps correctly.
+ F = fun() ->
+ M0 = id(#{ "a" => [1,2,3] }),
+ #{ "a" := _ } = M0,
+ M0#{ "a" := b }
+ end,
+
+ #{ "a" := b } = F(),
+
+ %% Error cases, FIXME: should be 'badmap'?
+ {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }),
+ {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }),
+ ok.
+
+
+t_update_assoc(Config) when is_list(Config) ->
+ M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}),
+
+ M1 = M0#{1=>42,2=>100,4=>[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,3.0:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,2.0=>100,4.0=>[a,b,c]},
+
+ M2 = M0#{3.0=>new},
+ #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2,
+ M2 = M0#{3.0:=wrong,3.0=>new},
+
+ %% Errors cases.
+ BadMap = id(badmap),
+ {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}),
+
+ ok.
+
+t_update_exact(Config) when is_list(Config) ->
+ M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}),
+
+ M1 = M0#{1:=42,2:=100,4:=[a,b,c]},
+ #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1,
+ M1 = M0#{1:=wrong,1=>42,2=>wrong,2:=100,4:=[a,b,c]},
+
+ M2 = M0#{3.0:=new},
+ #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2,
+ M2 = M0#{3.0=>wrong,3.0:=new},
+ true = M2 =/= M0#{3=>right,3.0:=new},
+ #{ 3 := right, 3.0 := new } = M0#{3=>right,3.0:=new},
+
+ M3 = id(#{ 1 => val}),
+ #{1 := update2,1.0 := new_val4} = M3#{
+ 1.0 => new_val1, 1 := update, 1=> update3,
+ 1 := update2, 1.0 := new_val2, 1.0 => new_val3,
+ 1.0 => new_val4 },
+
+ %% 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}),
+ 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 },
+ [1337, {some_val, 1337}] = get_val(M1),
+
+ N = 110,
+ List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)],
+
+ {_,_,#{val2 := {1,2,3,"wat",N}, val1 := [N,1,2,3,N]}} = lists:foldl(fun
+ ({V2,V3},{Old2,Old3,Mi}) ->
+ ok = check_val(Mi,Old2,Old3),
+ #{ val1 := Old2, val2 := Old3 } = Mi,
+ {V2,V3, Mi#{ val1 := id(V2), val2 := V1, val2 => id(V3)}}
+ end, {none, none, #{val1=>none,val2=>none}},List),
+ ok.
+
+check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok.
+
+get_val(#{ "wazzup" := _, val := V}) -> V;
+get_val(#{ val := V }) -> {some_val, V}.
+
+t_guard_bifs(Config) when is_list(Config) ->
+ true = map_guard_head(#{a=>1}),
+ false = map_guard_head([]),
+ true = map_guard_body(#{a=>1}),
+ false = map_guard_body({}),
+ true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }),
+ false = map_guard_pattern("list"),
+ ok.
+
+map_guard_head(M) when is_map(M) -> true;
+map_guard_head(_) -> false.
+
+map_guard_body(M) -> is_map(M).
+
+map_guard_pattern(#{}) -> true;
+map_guard_pattern(_) -> false.
+
+t_guard_sequence(Config) when is_list(Config) ->
+ {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}),
+ {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}),
+ {3, "c"} = map_guard_sequence_1(#{seq=>3,val=>id("c")}),
+ {4, "d"} = map_guard_sequence_1(#{seq=>4,val=>id("d")}),
+ {5, "e"} = map_guard_sequence_1(#{seq=>5,val=>id("e")}),
+
+ {1,M1} = map_guard_sequence_2(M1 = id(#{a=>3})),
+ {2,M2} = map_guard_sequence_2(M2 = id(#{a=>4, b=>4})),
+ {3,gg,M3} = map_guard_sequence_2(M3 = id(#{a=>gg, b=>4})),
+ {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(#{a=>sc, b=>3, c=>sc2})),
+ {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(#{a=>kk, b=>other, c=>sc2})),
+
+ %% error case
+ {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>id("e")})),
+ {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})),
+ ok.
+
+map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val};
+map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val};
+map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val};
+map_guard_sequence_1(#{seq:=4=Seq, val:=Val}) -> {Seq,Val};
+map_guard_sequence_1(#{seq:=5=Seq, val:=Val}) -> {Seq,Val}.
+
+map_guard_sequence_2(#{ a:=3 }=M) -> {1, M};
+map_guard_sequence_2(#{ a:=4 }=M) -> {2, M};
+map_guard_sequence_2(#{ a:=X, a:=X, b:=4 }=M) -> {3,X,M};
+map_guard_sequence_2(#{ a:=X, a:=Y, b:=3 }=M) when X =:= Y -> {4,X,Y,M};
+map_guard_sequence_2(#{ a:=X, a:=Y }=M) when X =:= Y -> {5,X,Y,M}.
+
+
+t_guard_update(Config) when is_list(Config) ->
+ error = map_guard_update(#{},#{}),
+ first = map_guard_update(#{}, #{x=>first}),
+ second = map_guard_update(#{y=>old}, #{x=>second,y=>old}),
+ third = map_guard_update(#{x=>old,y=>old}, #{x=>third,y=>old}),
+ ok.
+
+map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first;
+map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second;
+map_guard_update(M1, M2) when M1#{x:=third} =:= M2 -> third;
+map_guard_update(_, _) -> error.
+
+t_guard_receive(Config) when is_list(Config) ->
+ M0 = #{ id => 0 },
+ Pid = spawn_link(fun() -> guard_receive_loop() end),
+ Big = 36893488147419103229,
+ B1 = <<"some text">>,
+ B2 = <<"was appended">>,
+ B3 = <<B1/binary, B2/binary>>,
+
+ #{id:=1, res:=Big} = M1 = call(Pid, M0#{op=>sub,in=>{1 bsl 65, 3}}),
+ #{id:=2, res:=26} = M2 = call(Pid, M1#{op=>idiv,in=>{53,2}}),
+ #{id:=3, res:=832} = M3 = call(Pid, M2#{op=>imul,in=>{26,32}}),
+ #{id:=4, res:=4} = M4 = call(Pid, M3#{op=>add,in=>{1,3}}),
+ #{id:=5, res:=Big} = M5 = call(Pid, M4#{op=>sub,in=>{1 bsl 65, 3}}),
+ #{id:=6, res:=B3} = M6 = call(Pid, M5#{op=>"append",in=>{B1,B2}}),
+ #{id:=7, res:=4} = _ = call(Pid, M6#{op=>add,in=>{1,3}}),
+
+
+ %% update old maps and check id update
+ #{id:=2, res:=B3} = call(Pid, M1#{op=>"append",in=>{B1,B2}}),
+ #{id:=5, res:=99} = call(Pid, M4#{op=>add,in=>{33, 66}}),
+
+ %% cleanup
+ done = call(Pid, done),
+ ok.
+
+call(Pid, M) ->
+ Pid ! {self(), M}, receive {Pid, Res} -> Res end.
+
+guard_receive_loop() ->
+ receive
+ {Pid, #{ id:=Id, op:="append", in:={X,Y}}=M} when is_binary(X), is_binary(Y) ->
+ Pid ! {self(), M#{ id=>Id+1, res=><<X/binary,Y/binary>>}},
+ guard_receive_loop();
+ {Pid, #{ id:=Id, op:=add, in:={X,Y}}} ->
+ Pid ! {self(), #{ id=>Id+1, res=>X+Y}},
+ guard_receive_loop();
+ {Pid, #{ id:=Id, op:=sub, in:={X,Y}}=M} ->
+ Pid ! {self(), M#{ id=>Id+1, res=>X-Y}},
+ guard_receive_loop();
+ {Pid, #{ id:=Id, op:=idiv, in:={X,Y}}=M} ->
+ Pid ! {self(), M#{ id=>Id+1, res=>X div Y}},
+ guard_receive_loop();
+ {Pid, #{ id:=Id, op:=imul, in:={X,Y}}=M} ->
+ Pid ! {self(), M#{ id=>Id+1, res=>X * Y}},
+ guard_receive_loop();
+ {Pid, done} ->
+ Pid ! {self(), done};
+ {Pid, Other} ->
+ Pid ! {error, Other},
+ guard_receive_loop()
+ end.
+
+
+t_list_comprehension(Config) when is_list(Config) ->
+ [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]],
+ ok.
+
+t_guard_fun(Config) when is_list(Config) ->
+ F1 = fun
+ (#{s:=v,v:=V}) -> {v,V};
+ (#{s:=t,v:={V,V}}) -> {t,V};
+ (#{s:=l,v:=[V,V]}) -> {l,V}
+ end,
+
+ F2 = fun
+ (#{s:=T,v:={V,V}}) -> {T,V};
+ (#{s:=T,v:=[V,V]}) -> {T,V};
+ (#{s:=T,v:=V}) -> {T,V}
+ end,
+ V = <<"hi">>,
+
+ {v,V} = F1(#{s=>v,v=>V}),
+ {t,V} = F1(#{s=>t,v=>{V,V}}),
+ {l,V} = F1(#{s=>l,v=>[V,V]}),
+
+ {v,V} = F2(#{s=>v,v=>V}),
+ {t,V} = F2(#{s=>t,v=>{V,V}}),
+ {l,V} = F2(#{s=>l,v=>[V,V]}),
+
+ %% error case
+ case (catch F1(#{s=>none,v=>none})) of
+ {'EXIT', {function_clause,[{?MODULE,_,[#{s:=none,v:=none}],_}|_]}} -> ok;
+ {'EXIT', {{case_clause,_},_}} -> {comment,inlined};
+ Other ->
+ test_server:fail({no_match, Other})
+ end.
+
+
+t_map_sort_literals(Config) when is_list(Config) ->
+ % test relation
+
+ %% size order
+ true = #{ a => 1, b => 2} < id(#{ a => 1, b => 1, c => 1}),
+ true = #{ b => 1, a => 1} < id(#{ c => 1, a => 1, b => 1}),
+ false = #{ c => 1, b => 1, a => 1} < id(#{ c => 1, a => 1}),
+
+ %% key order
+ true = id(#{ a => 1 }) < id(#{ b => 1}),
+ false = id(#{ b => 1 }) < id(#{ a => 1}),
+ true = id(#{ a => 1, b => 1, c => 1 }) < id(#{ b => 1, c => 1, d => 1}),
+ true = id(#{ b => 1, c => 1, d => 1 }) > id(#{ a => 1, b => 1, c => 1}),
+ true = id(#{ c => 1, b => 1, a => 1 }) < id(#{ b => 1, c => 1, d => 1}),
+ true = id(#{ "a" => 1 }) < id(#{ <<"a">> => 1}),
+ false = id(#{ <<"a">> => 1 }) < id(#{ "a" => 1}),
+ false = id(#{ 1 => 1 }) < id(#{ 1.0 => 1}),
+ false = id(#{ 1.0 => 1 }) < id(#{ 1 => 1}),
+
+ %% value order
+ true = id(#{ a => 1 }) < id(#{ a => 2}),
+ false = id(#{ a => 2 }) < id(#{ a => 1}),
+ false = id(#{ a => 2, b => 1 }) < id(#{ a => 1, b => 3}),
+ true = id(#{ a => 1, b => 1 }) < id(#{ a => 1, b => 3}),
+
+ true = id(#{ "a" => "hi", b => 134 }) == id(#{ b => 134,"a" => "hi"}),
+
+ %% lists:sort
+
+ SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}],
+ [#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]),
+ [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs),
+ [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)),
+
+ ok.
+
+t_warn_pair_key_overloaded(Config) when is_list(Config) ->
+ #{ "hi1" := 42 } = id(#{ "hi1" => 1, "hi1" => 42 }),
+
+ #{ "hi1" := 1337, "hi2" := [2], "hi3" := 3 } = id(#{
+ "hi1" => erlang:atom_to_binary(?MODULE,utf8),
+ "hi1" => erlang:binary_to_atom(<<"wazzup">>,utf8),
+ "hi1" => erlang:binary_to_float(<<"3.1416">>),
+ "hi1" => erlang:float_to_binary(3.1416),
+ "hi2" => erlang:pid_to_list(self()),
+ "hi3" => erlang:float_to_binary(3.1416),
+ "hi2" => lists:subtract([1,2],[1]),
+ "hi3" => +3,
+ "hi1" => erlang:min(1,2),
+ "hi1" => erlang:hash({1,2},35),
+ "hi1" => erlang:phash({1,2},33),
+ "hi1" => erlang:phash2({1,2},34),
+ "hi1" => erlang:integer_to_binary(1337),
+ "hi1" => erlang:binary_to_integer(<<"1337">>),
+ "hi4" => erlang:float_to_binary(3.1416)
+ }),
+ ok.
+
+t_warn_useless_build(Config) when is_list(Config) ->
+ [#{ a => id(I)} || I <- [1,2,3]],
+ ok.
+
+t_build_and_match_over_alloc(Config) when is_list(Config) ->
+ Ls = id([1,2,3]),
+ V0 = [a|Ls],
+ M0 = id(#{ "a" => V0 }),
+ #{ "a" := V1 } = M0,
+ V2 = id([c|Ls]),
+ M2 = id(#{ "a" => V2 }),
+ #{ "a" := V3 } = M2,
+ {[a,1,2,3],[c,1,2,3]} = id({V1,V3}),
+ ok.
+
+t_build_and_match_empty_val(Config) when is_list(Config) ->
+ F = fun(#{ "hi":=_,{1,2}:=_,1337:=_}) -> ok end,
+ ok = F(id(#{"hi"=>ok,{1,2}=>ok,1337=>ok})),
+
+ %% error case
+ case (catch (F(id(#{"hi"=>ok})))) of
+ {'EXIT',{function_clause,_}} -> ok;
+ {'EXIT', {{case_clause,_},_}} -> {comment,inlined};
+ Other ->
+ test_server:fail({no_match, Other})
+ end.
+
+t_build_and_match_val(Config) when is_list(Config) ->
+ F = fun
+ (#{ "hi" := first, v := V}) -> {1,V};
+ (#{ "hi" := second, v := V}) -> {2,V}
+ end,
+
+
+ {1,"hello"} = F(id(#{"hi"=>first,v=>"hello"})),
+ {2,"second"} = F(id(#{"hi"=>second,v=>"second"})),
+
+ %% error case
+ case (catch (F(id(#{"hi"=>ok})))) of
+ {'EXIT',{function_clause,_}} -> ok;
+ {'EXIT', {{case_clause,_},_}} -> {comment,inlined};
+ Other ->
+ test_server:fail({no_match, Other})
+ end.
+
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl
index 810b2b48c9..16d15a59e5 100644
--- a/lib/compiler/test/warnings_SUITE.erl
+++ b/lib/compiler/test/warnings_SUITE.erl
@@ -117,6 +117,7 @@ pattern2(Config) when is_list(Config) ->
Source,
[nowarn_unused_vars],
{warnings,[{2,sys_core_fold,{nomatch_shadow,1}},
+ {4,sys_core_fold,no_clause_match},
{5,sys_core_fold,nomatch_clause_type},
{6,sys_core_fold,nomatch_clause_type}]}}],
?line [] = run(Config, Ts),
@@ -389,6 +390,10 @@ effect(Config) when is_list(Config) ->
<<X:8>>;
unused_fun ->
fun() -> {ok,X} end;
+ unused_named_fun ->
+ fun F(0) -> 1;
+ F(N) -> N*F(N-1)
+ end;
unused_atom ->
ignore; %no warning
unused_nil ->
@@ -483,8 +488,9 @@ effect(Config) when is_list(Config) ->
{22,sys_core_fold,{no_effect,{erlang,is_integer,1}}},
{24,sys_core_fold,useless_building},
{26,sys_core_fold,useless_building},
- {32,sys_core_fold,{no_effect,{erlang,'=:=',2}}},
- {34,sys_core_fold,{no_effect,{erlang,get_cookie,0}}}]}}],
+ {28,sys_core_fold,useless_building},
+ {36,sys_core_fold,{no_effect,{erlang,'=:=',2}}},
+ {38,sys_core_fold,{no_effect,{erlang,get_cookie,0}}}]}}],
?line [] = run(Config, Ts),
ok.