aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/src')
-rw-r--r--lib/compiler/src/beam_a.erl2
-rw-r--r--lib/compiler/src/beam_asm.erl2
-rw-r--r--lib/compiler/src/beam_block.erl12
-rw-r--r--lib/compiler/src/beam_clean.erl4
-rw-r--r--lib/compiler/src/beam_dict.erl20
-rw-r--r--lib/compiler/src/beam_disasm.erl52
-rw-r--r--lib/compiler/src/beam_flatten.erl4
-rw-r--r--lib/compiler/src/beam_jump.erl2
-rw-r--r--lib/compiler/src/beam_split.erl4
-rw-r--r--lib/compiler/src/beam_utils.erl1
-rw-r--r--lib/compiler/src/beam_validator.erl91
-rw-r--r--lib/compiler/src/beam_z.erl12
-rw-r--r--lib/compiler/src/cerl.erl17
-rw-r--r--lib/compiler/src/cerl_inline.erl26
-rw-r--r--lib/compiler/src/cerl_trees.erl20
-rw-r--r--lib/compiler/src/compiler.appup.src22
-rwxr-xr-xlib/compiler/src/genop.tab6
-rw-r--r--lib/compiler/src/rec_env.erl4
-rw-r--r--lib/compiler/src/sys_core_fold.erl3
-rw-r--r--lib/compiler/src/v3_codegen.erl35
-rw-r--r--lib/compiler/src/v3_core.erl547
-rw-r--r--lib/compiler/src/v3_kernel.erl32
-rw-r--r--lib/compiler/src/v3_kernel_pp.erl2
23 files changed, 541 insertions, 379 deletions
diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl
index 3dfa67a771..fe4f473846 100644
--- a/lib/compiler/src/beam_a.erl
+++ b/lib/compiler/src/beam_a.erl
@@ -92,6 +92,8 @@ 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 3723cc19e1..7a30c68593 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -154,8 +154,8 @@ 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_element,F,S,K,D}) ->
- {set,[D],[S],{get_map_element,K,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};
@@ -240,7 +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_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.
@@ -291,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
diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl
index 55f985ad0e..b653998252 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -262,8 +262,8 @@ replace([{bs_utf16_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 ->
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_element=I,{f,Lbl},Src,Key,Dst}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{I,{f,label(Lbl, D)},Src,Key,Dst}|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 57fdf95677..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) ->
@@ -366,9 +368,13 @@ disasm_instr(B, Bs, Atoms, Literals) ->
select_tuple_arity ->
disasm_select_inst(select_tuple_arity, Bs, Atoms, Literals);
put_map_assoc ->
- disasm_map_inst(put_map_assoc, Bs, Atoms, Literals);
+ disasm_map_inst(put_map_assoc, Arity, Bs, Atoms, Literals);
put_map_exact ->
- disasm_map_inst(put_map_exact, Bs, Atoms, Literals);
+ 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} ->
@@ -399,16 +405,15 @@ 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, Bs0, Atoms, Literals) ->
- {F, Bs1} = decode_arg(Bs0, Atoms, Literals),
- {S, Bs2} = decode_arg(Bs1, Atoms, Literals),
- {X, Bs3} = decode_arg(Bs2, Atoms, Literals),
- {N, Bs4} = decode_arg(Bs3, Atoms, Literals),
- {Z, Bs5} = decode_arg(Bs4, Atoms, Literals),
- {U, Bs6} = decode_arg(Bs5, Atoms, Literals),
- {u, Len} = U,
- {List, RestBs} = decode_n_args(Len, Bs6, Atoms, Literals),
- {{Inst, [F,S,X,N,{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]}
@@ -432,7 +437,8 @@ 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),
@@ -1150,13 +1156,15 @@ resolve_inst({is_map,Args0},_,_,_) ->
[FLbl|Args] = resolve_args(Args0),
{test, is_map, FLbl, Args};
-resolve_inst({has_map_field,Args0},_,_,_) ->
- [FLbl|Args] = resolve_args(Args0),
- {test,has_map_field,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_element,Args},_,_,_) ->
- [FLbl,Src,Key,Dst] = resolve_args(Args),
- {get_map_element,FLbl,Src,Key,Dst};
+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.
diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl
index 534bc6d954..46835bece1 100644
--- a/lib/compiler/src/beam_flatten.erl
+++ b/lib/compiler/src/beam_flatten.erl
@@ -63,8 +63,8 @@ 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,[D],[S],{get_map_element,K,F}}) ->
- {get_map_element,F,S,K,D};
+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 1f720b94c3..0fc8d45c80 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -529,7 +529,7 @@ 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_element,Lbl,_Src,_Key,_Dst}, Used) ->
+ulbl({get_map_elements,Lbl,_Src,_List}, Used) ->
mark_used(Lbl, Used);
ulbl(_, Used) -> Used.
diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl
index 638a4826ea..688bba9a94 100644
--- a/lib/compiler/src/beam_split.erl
+++ b/lib/compiler/src/beam_split.erl
@@ -53,9 +53,9 @@ 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,[D],[S],{get_map_element,K,{f,Lbl}=Fail}}|Is], Bl, Acc)
+split_block([{set,Gets,[S],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc)
when Lbl =/= 0 ->
- split_block(Is, [], [{get_map_element,Fail,S,K,D}|make_block(Bl, Acc)]);
+ 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_utils.erl b/lib/compiler/src/beam_utils.erl
index a3f16cfa8f..27034aecce 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -185,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)).
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 682f7adbc2..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).
}).
@@ -770,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);
@@ -871,18 +883,27 @@ 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_element,{f,Fail},Src,Key,Dst}, Vst0) ->
- assert_term(Src, Vst0),
- assert_term(Key, Vst0),
- Vst = branch_state(Fail, Vst0),
- set_type_reg(term, Dst, 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),
- [assert_term(Term, Vst0) || Term <- List],
+ foreach(fun (Term) -> assert_term(Term, Vst0) end, List),
assert_term(Src, Vst0),
Vst1 = heap_alloc(0, Vst0),
Vst2 = branch_state(Fail, Vst1),
@@ -909,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.
%%
@@ -1099,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.
%%%
@@ -1334,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)).
@@ -1349,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
@@ -1430,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 9953a48710..c2a6ef604e 100644
--- a/lib/compiler/src/beam_z.erl
+++ b/lib/compiler/src/beam_z.erl
@@ -78,6 +78,18 @@ 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 60a8559950..3c121f3b04 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -124,8 +124,9 @@
%% keep map exports here for now
map_es/1,
- update_c_map/2,
- ann_c_map/2,
+ 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
@@ -1579,11 +1580,15 @@ ann_make_list(_, [], Node) ->
map_es(#c_map{es = Es}) ->
Es.
-ann_c_map(As, Es) ->
- #c_map{es = Es, anno = As }.
+-spec map_val(c_map()) -> cerl().
+map_val(#c_map{var = M}) ->
+ M.
-update_c_map(Old, Es) ->
- #c_map{es = Es, anno = get_ann(Old)}.
+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.
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index 3837b57750..44293bb8ce 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -64,7 +64,7 @@
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,
- map_es/1, update_c_map/2,
+ 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
]).
@@ -1334,12 +1334,12 @@ i_bitstr(E, Ren, Env, S) ->
i_map(E, Ctx, Ren, Env, S) ->
%% Visit the segments for value.
- {Es, S1} = mapfoldl(fun (E, S) ->
- i_map_pair(E, Ctx, Ren, Env, S)
- end,
- S, map_es(E)),
- S2 = count_size(weight(map), S1),
- {update_c_map(E, Es), S2}.
+ {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,
@@ -1411,13 +1411,15 @@ i_pattern(E, Ren, Env, Ren0, Env0, S) ->
S2 = count_size(weight(binary), S1),
{update_c_binary(E, Es), S2};
map ->
+ %% map patterns should not have 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)),
+ 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, Es), S2};
+ {update_c_map(E, M, Es), S2};
_ ->
case is_literal(E) of
true ->
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index 2542841eef..2ebeab243f 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -57,9 +57,9 @@
update_c_try/6, update_c_tuple/2, update_c_tuple_skel/2,
update_c_values/2, values_es/1, var_name/1,
- map_es/1,
- ann_c_map/2,
- update_c_map/2,
+ 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
@@ -138,7 +138,7 @@ map_1(F, T) ->
tuple ->
update_c_tuple_skel(T, map_list(F, tuple_es(T)));
map ->
- update_c_map(T, map_list(F, map_es(T)));
+ 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)),
@@ -372,8 +372,9 @@ mapfold(F, S0, T) ->
{Ts, S1} = mapfold_list(F, S0, tuple_es(T)),
F(update_c_tuple_skel(T, Ts), S1);
map ->
- {Ts, S1} = mapfold_list(F, S0, map_es(T)),
- F(update_c_map(T, Ts), S1);
+ {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)),
@@ -723,9 +724,10 @@ label(T, N, Env) ->
{As, N2} = label_ann(T, N1),
{ann_c_tuple_skel(As, Ts), N2};
map ->
- {Ts, N1} = label_list(map_es(T), N, Env),
- {As, N2} = label_ann(T, N1),
- {ann_c_map(As, Ts), N2};
+ {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),
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/genop.tab b/lib/compiler/src/genop.tab
index 79b467f949..7d6bf56ccb 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -529,10 +529,10 @@ BEAM_FORMAT_NUMBER=0
153: line/1
-# R16
+# R17
154: put_map_assoc/5
155: put_map_exact/5
156: is_map/2
-157: has_map_field/3
-158: get_map_element/4
+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 a31413251a..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
@@ -96,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_fold.erl b/lib/compiler/src/sys_core_fold.erl
index e2b9213891..eb9c302334 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -3146,9 +3146,6 @@ format_error(result_ignored) ->
"(suppress the warning by assigning the expression to the _ variable)";
format_error(useless_building) ->
"a term is constructed, but never used";
-format_error({map_pair_key_overloaded,K}) ->
- M = io_lib:format("the key ~p is used multiple times in map value association",[K]),
- flatten(M);
format_error(bin_opt_alias) ->
"INFO: the '=' operator will prevent delayed sub binary optimization";
format_error(bin_partition) ->
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 4d155c0fd0..e00ee1f3ad 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -938,22 +938,39 @@ select_map_val(V, Es, B, 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) ->
- F = fun ({map_pair,Key,{var,V}}, Int0) ->
- Rsrc = fetch_var(Src, Int0),
+ %% 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 ->
- {[{test,has_map_field,{f,Fail},[Rsrc,Key]}],Int0};
+ {{[Key|HasKsi],GetVsi},Int0};
_Other ->
Reg1 = put_reg(V, Int0#sr.reg),
Int1 = Int0#sr{reg=Reg1},
- {[{get_map_element,{f,Fail},
- Rsrc,Key,fetch_reg(V, Reg1)}],
- Int1}
+ {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi]},Int1}
end
- end,
- {Es,Aft} = flatmapfoldl(F, Bef, Vs),
- {Es,Aft,St}.
+ 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
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index ec5deb6905..a50b46bd7b 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -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()}]}.
@@ -479,8 +484,9 @@ 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) ->
@@ -647,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
@@ -655,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),
@@ -889,136 +896,45 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) ->
%% 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),
- CGAnno = #a{anno=[list_comprehension|LA]},
- 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=CGAnno,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},
- CGAnno = #a{anno=[list_comprehension|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=CGAnno,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},
- CGAnno = #a{anno=[list_comprehension|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=CGAnno,
- 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=CGAnno,
- 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),
@@ -1028,146 +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},
- CGAnno = #a{anno=[list_comprehension|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=CGAnno,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},
- CGAnno = #a{anno=[list_comprehension|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=CGAnno,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},
- CGAnno = #a{anno=[list_comprehension|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=CGAnno,
- 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=CGAnno,
- 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},
@@ -1175,16 +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}.
+%% 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;
+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]}},
- {Segs++[Tail],Var,St}.
+ {Segs++[Tail],Var,Tail,St}.
emasculate_segments(Segs, St) ->
emasculate_segments(Segs, St, []).
@@ -1195,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) ->
@@ -1511,8 +1479,50 @@ pattern({cons,L,H,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=sort(pattern_list(Ps, St))};
-pattern({map_field_exact,L,K,V}, 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.
+ #c_binary{anno=lineno_anno(L, St),segments=pat_bin(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
@@ -1529,13 +1539,8 @@ pattern({map_field_exact,L,K,V}, St) ->
#c_map_pair{anno=lineno_anno(L, St),
op=#c_literal{val=exact},
key=Key,
- val=pattern(V, 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.
- #c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)};
-pattern({match,_,P1,P2}, St) ->
- pat_alias(pattern(P1, St), pattern(P2, St)).
+ val=pattern(V, St)}.
+
%% pat_bin([BinElement], State) -> [BinSeg].
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index bc5ca0314a..5675572092 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -496,7 +496,6 @@ translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) ->
translate_fc(Args) ->
[#c_literal{val=function_clause},make_list(Args)].
- %{Kes,Ep,St2} = map_pairs(Ces, Sub, St1),
map_split_pairs(A, Var, Ces, Sub, St0) ->
%% two steps
%% 1. force variables
@@ -718,12 +717,8 @@ 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_list(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_map_pair{op=#c_literal{val=exact},anno=A,key=Ck,val=Cv},Isub, Osub0, St0) ->
- {Kk,Osub1,St1} = pattern(Ck, Isub, Osub0, St0),
- {Kv,Osub2,St2} = pattern(Cv, Isub, Osub1, St1),
- {#k_map_pair{anno=A,key=Kk,val=Kv},Osub2,St2};
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};
@@ -738,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}.
@@ -1388,13 +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{es=Es0}, St0) ->
+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{es=Es},Mes,St1};
+ {#k_map{op=exact,es=Es},Mes,St1};
get_match(M, St) ->
{M,[],St}.
@@ -1519,7 +1533,7 @@ arg_val(Arg, C) ->
end || Pair <- Es],
%% multiple keys may have the same name
%% do not use ordsets
- lists:sort(Keys)
+ lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Keys)
end.
%% ubody_used_vars(Expr, State) -> [UsedVar]
diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl
index 639c6737e2..b4e486f97c 100644
--- a/lib/compiler/src/v3_kernel_pp.erl
+++ b/lib/compiler/src/v3_kernel_pp.erl
@@ -115,7 +115,7 @@ format_1(#k_map{op=assoc,es=Es}, Ctxt) ->
format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
"}~"
];
-format_1(#k_map{op=exact,es=Es}, Ctxt) ->
+format_1(#k_map{es=Es}, Ctxt) ->
["::{",
format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
"}::"
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-03 12:02:37 +0000