From 210dbf68a62794b51b74337381cd87424a46b2a5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= <egil@erlang.org>
Date: Mon, 10 Feb 2014 18:55:17 +0100
Subject: compiler: Change map instructions for fetching values

* Combine multiple get values with one instruction
* Combine multiple check keys with one instruction
---
 lib/compiler/src/beam_a.erl         |  2 ++
 lib/compiler/src/beam_asm.erl       |  2 ++
 lib/compiler/src/beam_block.erl     | 12 ++++++++----
 lib/compiler/src/beam_clean.erl     |  4 ++--
 lib/compiler/src/beam_disasm.erl    | 10 +++++-----
 lib/compiler/src/beam_flatten.erl   |  4 ++--
 lib/compiler/src/beam_jump.erl      |  2 +-
 lib/compiler/src/beam_split.erl     |  4 ++--
 lib/compiler/src/beam_utils.erl     |  1 +
 lib/compiler/src/beam_validator.erl | 20 +++++++++++++++-----
 lib/compiler/src/beam_z.erl         |  2 ++
 lib/compiler/src/genop.tab          |  6 +++---
 lib/compiler/src/v3_codegen.erl     | 35 ++++++++++++++++++++++++++---------
 lib/compiler/src/v3_kernel.erl      | 32 +++++++++++++++++++++++---------
 lib/compiler/src/v3_kernel_pp.erl   |  2 +-
 15 files changed, 95 insertions(+), 43 deletions(-)

(limited to 'lib')

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_disasm.erl b/lib/compiler/src/beam_disasm.erl
index 57fdf95677..3f5e9df5fd 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -1151,12 +1151,12 @@ resolve_inst({is_map,Args0},_,_,_) ->
     {test, is_map, FLbl, Args};
 
 resolve_inst({has_map_field,Args0},_,_,_) ->
-    [FLbl|Args] = resolve_args(Args0),
-    {test,has_map_field,FLbl,Args};
+    [FLbl,Src,{u,_Len}|Args] = resolve_args(Args0),
+    {test,has_map_field,FLbl,Src,{list,Args}};
 
-resolve_inst({get_map_element,Args},_,_,_) ->
-    [FLbl,Src,Key,Dst] = resolve_args(Args),
-    {get_map_element,FLbl,Src,Key,Dst};
+resolve_inst({get_map_element,Args0},_,_,_) ->
+    [FLbl,Src,{u,_Len}|Args] = resolve_args(Args0),
+    {get_map_element,FLbl,Src,{list,Args}};
 
 %%
 %% 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..9f8f1cd3f5 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -770,6 +770,9 @@ 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,_Op,{f,Lbl},Src,{list,_}}, Vst) ->
+    validate_src([Src], Vst),
+    branch_state(Lbl, Vst);
 valfun_4({test,_Op,{f,Lbl},Src}, Vst) ->
     validate_src(Src, Vst),
     branch_state(Lbl, Vst);
@@ -871,14 +874,21 @@ 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),
+    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),
diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl
index 9953a48710..c204eac25d 100644
--- a/lib/compiler/src/beam_z.erl
+++ b/lib/compiler/src/beam_z.erl
@@ -78,6 +78,8 @@ 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,List}};
 undo_rename({select,I,Reg,Fail,List}) ->
     {I,Reg,Fail,{list,List}};
 undo_rename(I) -> I.
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/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_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),
      "}::"
-- 
cgit v1.2.3


From bf21750a8af22b1ad10eab41ea48a7ae6efec7f5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= <egil@erlang.org>
Date: Thu, 13 Feb 2014 15:47:40 +0100
Subject: compiler: Check literal order in beam_validator

---
 lib/compiler/src/beam_disasm.erl    | 41 +++++++++++++++++--------------
 lib/compiler/src/beam_validator.erl | 49 +++++++++++++++++++++++++++++++++++--
 2 files changed, 70 insertions(+), 20 deletions(-)

(limited to 'lib')

diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index 3f5e9df5fd..363989f4c9 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -366,9 +366,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 +403,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]}
@@ -1150,13 +1153,15 @@ resolve_inst({is_map,Args0},_,_,_) ->
     [FLbl|Args] = resolve_args(Args0),
     {test, is_map, FLbl, Args};
 
-resolve_inst({has_map_field,Args0},_,_,_) ->
-    [FLbl,Src,{u,_Len}|Args] = resolve_args(Args0),
-    {test,has_map_field,FLbl,Src,{list,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,Args0},_,_,_) ->
-    [FLbl,Src,{u,_Len}|Args] = resolve_args(Args0),
-    {get_map_element,FLbl,Src,{list,Args}};
+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_validator.erl b/lib/compiler/src/beam_validator.erl
index 9f8f1cd3f5..6feab29d33 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -770,8 +770,9 @@ 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,_Op,{f,Lbl},Src,{list,_}}, 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),
@@ -882,6 +883,8 @@ valfun_4(_, _) ->
 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;
@@ -1109,6 +1112,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.
 %%%
@@ -1344,6 +1380,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)).
 
@@ -1359,7 +1396,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
@@ -1440,6 +1476,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) ->
-- 
cgit v1.2.3


From bd1ced90995f6084f2ac7b2b0d5cc2cc92cfe5a9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= <egil@erlang.org>
Date: Thu, 13 Feb 2014 17:39:12 +0100
Subject: compiler: Use aliasing in map pair patterns

---
 lib/compiler/src/v3_core.erl | 55 ++++++++++++++++++++++++++++++++++++--------
 1 file changed, 46 insertions(+), 9 deletions(-)

(limited to 'lib')

diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 291443f824..0d87432298 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -1505,8 +1505,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
@@ -1523,13 +1565,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].
 
-- 
cgit v1.2.3


From fddad198019039ade815aedb38f44d54945e56a5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= <egil@erlang.org>
Date: Thu, 13 Feb 2014 17:39:52 +0100
Subject: compiler: Test Maps aliasing

---
 lib/compiler/test/map_SUITE.erl | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

(limited to 'lib')

diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl
index 86f65c3ed6..b76108005c 100644
--- a/lib/compiler/test/map_SUITE.erl
+++ b/lib/compiler/test/map_SUITE.erl
@@ -30,6 +30,7 @@
 	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,
@@ -54,6 +55,8 @@ all() -> [
 	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,
@@ -112,6 +115,20 @@ t_build_and_match_literals(Config) when is_list(Config) ->
     {'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(#{})),
-- 
cgit v1.2.3


From 70d3c4d51f58f0e95fd28f6735cd54cad9ca87ce Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= <egil@erlang.org>
Date: Wed, 19 Feb 2014 15:51:03 +0100
Subject: compiler: Transform list of Args to exact literal type

---
 lib/compiler/src/beam_z.erl | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

(limited to 'lib')

diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl
index c204eac25d..c2a6ef604e 100644
--- a/lib/compiler/src/beam_z.erl
+++ b/lib/compiler/src/beam_z.erl
@@ -79,7 +79,17 @@ undo_rename({put_map,Fail,assoc,S,D,R,L}) ->
 undo_rename({put_map,Fail,exact,S,D,R,L}) ->
     {put_map_exact,Fail,S,D,R,L};
 undo_rename({test,has_map_fields,Fail,[Src|List]}) ->
-    {test,has_map_fields,Fail,Src,{list,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.
-- 
cgit v1.2.3


From f31d54aeaad8bccb0b4e7291ed443e757e2edb5d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= <egil@erlang.org>
Date: Thu, 20 Feb 2014 13:21:48 +0100
Subject: compiler: Remove dead warning

---
 lib/compiler/src/sys_core_fold.erl | 3 ---
 1 file changed, 3 deletions(-)

(limited to 'lib')

diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index e302e2324d..ade28e5fc3 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -3060,9 +3060,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) ->
-- 
cgit v1.2.3


From 1c37990e06a4588b941f430f872ad45001b63844 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= <egil@erlang.org>
Date: Thu, 20 Feb 2014 14:21:23 +0100
Subject: compiler: Strengthen Maps compile tests

---
 lib/compiler/test/error_SUITE.erl | 19 +++++++++++++++++--
 lib/compiler/test/map_SUITE.erl   |  2 --
 2 files changed, 17 insertions(+), 4 deletions(-)

(limited to 'lib')

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/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl
index b76108005c..7d35ffc8d5 100644
--- a/lib/compiler/test/map_SUITE.erl
+++ b/lib/compiler/test/map_SUITE.erl
@@ -106,8 +106,6 @@ t_build_and_match_literals(Config) when is_list(Config) ->
 	 id(#{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}),
 
     %% error case
-    %V = 32,
-    %{'EXIT',{{badmatch,_},_}} = (catch (#{<<"hi all">> => 1} = id(#{<<"hi",V,"all">> => 1}))),
     {'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}))),
-- 
cgit v1.2.3