Fix binary matching in the debugger

'eval_bits' is a common utility module used for evaluting binary
construction and matching. The functions that do matching
(match_bits/{6,7} and bin_gen/6) are supposed to treat the bindings as
an abstract data type, but they assume that the bindings have the same
representation as in the erl_eval module.  That may cause binary
matching to fail in the debugger, because the debugger represents the
bindings as an unordered list of two-tuples, while the erl_eval
modules uses an ordered list of two-tuple (an ordset).

One way to fix the problem would be to let the debugger to use ordered
lists to represent the bindings. Unfortunately, that would also change
how the bindings are presented in the user interface. Currently, the
variable have most been recently assigned is shown first, which is
convenient.

Fix the matching problem by mending the leaky abstraction in
eval_bits.  The matching functions needs to be passed two additional
operations: one for looking up a variable in the bindings and one for
adding a binding. Those operations could be passed as two more funs
(in addition to the evaluation and match fun already passed), but the
functions already have too many arguments. Therefore, change the
meaning of the match fun, so that the first argument is the operation
to perform ('match', 'binding', or 'add_binding') and second argument
is a tuple with arguments for the operation.

6 files changed, 74 insertions, 37 deletions

diff --git a/erts/emulator/test/bs_match_misc_SUITE.erl b/erts/emulator/test/bs_match_misc_SUITE.erl
index b022f96740..15427661f3 100644
--- a/erts/emulator/test/bs_match_misc_SUITE.erl
+++ b/erts/emulator/test/bs_match_misc_SUITE.erl
@@ -23,7 +23,7 @@
 	 bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1,
 	 kenneth/1,encode_binary/1,native/1,happi/1,
 	 size_var/1,wiger/1,x0_context/1,huge_float_field/1,
-	 writable_binary_matched/1,otp_7198/1]).
+	 writable_binary_matched/1,otp_7198/1,unordered_bindings/1]).
 
 -include_lib("test_server/include/test_server.hrl").
 
@@ -33,7 +33,7 @@ all() ->
     [bound_var, bound_tail, t_float, little_float, sean,
      kenneth, encode_binary, native, happi, size_var, wiger,
      x0_context, huge_float_field, writable_binary_matched,
-     otp_7198].
+     otp_7198, unordered_bindings].
 
 groups() -> 
     [].
@@ -553,5 +553,15 @@ otp_7198_scan(<<C, Rest/binary>>, TokAcc) when
                         otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc])
         end.
 
+unordered_bindings(Config) when is_list(Config) ->
+    {<<1,2,3,4>>,<<42,42>>,<<3,3,3>>} =
+	unordered_bindings(4, 2, 3, <<1,2,3,4, 42,42, 3,3,3, 3>>),
+    ok.
+
+unordered_bindings(CompressedLength, HashSize, PadLength, T) ->
+    <<Content:CompressedLength/binary,Mac:HashSize/binary,
+     Padding:PadLength/binary,PadLength>> = T,
+    {Content,Mac,Padding}.
+
 
 id(I) -> I.
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 3b33a08cf7..0bbedf0207 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -1167,9 +1167,7 @@ select_bin_int_1(_, _, _, _) -> throw(not_possible).
 
 select_assert_match_possible(Sz, Val, Fs) ->
     EmptyBindings = erl_eval:new_bindings(),
-    MatchFun = fun({integer,_,_}, NewV, Bs) when NewV =:= Val ->
-		       {match,Bs}
-	       end,
+    MatchFun = match_fun(Val),
     EvalFun = fun({integer,_,S}, B) -> {value,S,B} end,
     Expr = [{bin_element,0,{integer,0,Val},{integer,0,Sz},[{unit,1}|Fs]}],
     {value,Bin,EmptyBindings} = eval_bits:expr_grp(Expr, EmptyBindings, EvalFun),
@@ -1184,6 +1182,11 @@ select_assert_match_possible(Sz, Val, Fs) ->
 	    throw(not_possible)
     end.
 
+match_fun(Val) ->
+    fun(match, {{integer,_,_},NewV,Bs}) when NewV =:= Val ->
+	    {match,Bs}
+    end.
+
 select_utf8(Val0) ->
     try
 	Bin = <<Val0/utf8>>,
diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl
index 9b6919074f..b0792b05f0 100644
--- a/lib/debugger/src/dbg_ieval.erl
+++ b/lib/debugger/src/dbg_ieval.erl
@@ -1023,7 +1023,7 @@ eval_generate(Term, _P, Bs, _CompFun, Ieval) ->
     exception(error, {bad_generator,Term}, Bs, Ieval).
 
 eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, CompFun, Ieval) ->
-    Mfun = fun(L, R, Bs) -> match1(L, R, Bs, Bs0) end,
+    Mfun = match_fun(Bs0),
     Efun = fun(Exp, Bs) -> expr(Exp, Bs, #ieval{}) end,
     case eval_bits:bin_gen(P, Bin, erl_eval:new_bindings(), Bs0, Mfun, Efun) of
 	{match,Rest,Bs1} ->
@@ -1392,11 +1392,9 @@ match1({cons,_,H,T}, [H1|T1], Bs0, BBs) ->
 match1({tuple,_,Elts}, Tuple, Bs, BBs) 
   when length(Elts) =:= tuple_size(Tuple) ->
     match_tuple(Elts, Tuple, 1, Bs, BBs);
-match1({bin,_,Fs}, B, Bs0, BBs0) when is_bitstring(B) ->
-    Bs1 = lists:sort(Bs0),  %Kludge.
-    BBs = lists:sort(BBs0),
-    try eval_bits:match_bits(Fs, B, Bs1, BBs,
-			     fun(L, R, Bs) -> match1(L, R, Bs, BBs) end,
+match1({bin,_,Fs}, B, Bs0, BBs) when is_bitstring(B) ->
+    try eval_bits:match_bits(Fs, B, Bs0, BBs,
+			     match_fun(BBs),
 			     fun(E, Bs) -> expr(E, Bs, #ieval{}) end,
 			     false)
     catch
@@ -1405,6 +1403,12 @@ match1({bin,_,Fs}, B, Bs0, BBs0) when is_bitstring(B) ->
 match1(_,_,_,_) ->
     throw(nomatch).
 
+match_fun(BBs) ->
+    fun(match, {L,R,Bs}) -> match1(L, R, Bs, BBs);
+       (binding, {Name,Bs}) -> binding(Name, Bs);
+       (add_binding, {Name,Val,Bs}) -> add_binding(Name, Val, Bs)
+    end.
+
 match_tuple([E|Es], Tuple, I, Bs0, BBs) ->
     {match,Bs} = match1(E, element(I, Tuple), Bs0, BBs),
     match_tuple(Es, Tuple, I+1, Bs, BBs);
diff --git a/lib/debugger/test/bs_match_misc_SUITE.erl b/lib/debugger/test/bs_match_misc_SUITE.erl
index 5244a358bd..89fce263f5 100644
--- a/lib/debugger/test/bs_match_misc_SUITE.erl
+++ b/lib/debugger/test/bs_match_misc_SUITE.erl
@@ -25,7 +25,8 @@
 	 bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1,
 	 kenneth/1,encode_binary/1,native/1,happi/1,
 	 size_var/1,wiger/1,x0_context/1,huge_float_field/1,
-	 writable_binary_matched/1,otp_7198/1]).
+	 writable_binary_matched/1,otp_7198/1,
+	 unordered_bindings/1]).
 
 -include_lib("test_server/include/test_server.hrl").
 
@@ -35,7 +36,7 @@ all() ->
     [bound_var, bound_tail, t_float, little_float, sean,
      kenneth, encode_binary, native, happi, size_var, wiger,
      x0_context, huge_float_field, writable_binary_matched,
-     otp_7198].
+     otp_7198, unordered_bindings].
 
 groups() -> 
     [].
@@ -566,5 +567,15 @@ otp_7198_scan(<<C, Rest/binary>>, TokAcc) when
                         otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc])
         end.
 
+unordered_bindings(Config) when is_list(Config) ->
+    {<<1,2,3,4>>,<<42,42>>,<<3,3,3>>} =
+	unordered_bindings(4, 2, 3, <<1,2,3,4, 42,42, 3,3,3, 3>>),
+    ok.
+
+unordered_bindings(CompressedLength, HashSize, PadLength, T) ->
+    <<Content:CompressedLength/binary,Mac:HashSize/binary,
+     Padding:PadLength/binary,PadLength>> = T,
+    {Content,Mac,Padding}.
+
 
 id(I) -> I.
diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index 515ea2ebb7..4f4fa16040 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -621,7 +621,7 @@ eval_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) ->
     erlang:raise(error, {bad_generator,Term}, stacktrace()).
 
 eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) ->
-    Mfun = fun(L, R, Bs) -> match1(L, R, Bs, Bs0) end,
+    Mfun = match_fun(Bs0),
     Efun = fun(Exp, Bs) -> expr(Exp, Bs, Lf, Ef, none) end,
     case eval_bits:bin_gen(P, Bin, new_bindings(), Bs0, Mfun, Efun) of
 	{match, Rest, Bs1} ->
@@ -1024,7 +1024,7 @@ match1({tuple,_,_}, _, _Bs, _BBs) ->
     throw(nomatch);
 match1({bin, _, Fs}, <<_/bitstring>>=B, Bs0, BBs) ->
     eval_bits:match_bits(Fs, B, Bs0, BBs,
-			 fun(L, R, Bs) -> match1(L, R, Bs, BBs) end,
+			 match_fun(BBs),
 			 fun(E, Bs) -> expr(E, Bs, none, none, none) end);
 match1({bin,_,_}, _, _Bs, _BBs) ->
     throw(nomatch);
@@ -1053,6 +1053,12 @@ match1({op,Line,Op,L,R}, Term, Bs, BBs) ->
 match1(_, _, _Bs, _BBs) ->
     throw(invalid).
 
+match_fun(BBs) ->
+    fun(match, {L,R,Bs}) -> match1(L, R, Bs, BBs);
+       (binding, {Name,Bs}) -> binding(Name, Bs);
+       (add_binding, {Name,Val,Bs}) -> add_binding(Name, Val, Bs)
+    end.
+
 match_tuple([E|Es], Tuple, I, Bs0, BBs) ->
     {match,Bs} = match1(E, element(I, Tuple), Bs0, BBs),
     match_tuple(Es, Tuple, I+1, Bs, BBs);
diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl
index 2cbd6cdae7..ddce4bd75a 100644
--- a/lib/stdlib/src/eval_bits.erl
+++ b/lib/stdlib/src/eval_bits.erl
@@ -31,8 +31,9 @@
 %% @type evalfun(). A closure which evaluates an expression given an
 %% environment
 %%
-%% @type matchfun(). A closure which performs a match given a value, a
-%% pattern and an environment
+%% @type matchfun(). A closure which depending on its first argument
+%% can perform a match (given a value, a pattern and an environment),
+%% lookup a variable in the bindings, or add a new binding
 %%
 %% @type field() represents a field in a "bin"
 
@@ -144,7 +145,8 @@ eval_exp_field(Val, Size, Unit, binary, _, _) ->
 bin_gen({bin,_,Fs}, Bin, Bs0, BBs0, Mfun, Efun) ->
     bin_gen(Fs, Bin, Bs0, BBs0, Mfun, Efun, true).
 
-bin_gen([F|Fs], Bin, Bs0, BBs0, Mfun, Efun, Flag) ->
+bin_gen([F|Fs], Bin, Bs0, BBs0, Mfun, Efun, Flag)
+  when is_function(Mfun, 2), is_function(Efun, 2) ->
     case bin_gen_field(F, Bin, Bs0, BBs0, Mfun, Efun) of
         {match,Bs,BBs,Rest} ->
             bin_gen(Fs, Rest, Bs, BBs, Mfun, Efun, Flag);
@@ -175,14 +177,14 @@ bin_gen_field({bin_element,Line,VE,Size0,Options0},
     {Size1, [Type,{unit,Unit},Sign,Endian]} = 
         make_bit_type(Line, Size0, Options0),
     V = erl_eval:partial_eval(VE),
-    match_check_size(Size1, BBs0),
+    match_check_size(Mfun, Size1, BBs0),
     {value, Size, _BBs} = Efun(Size1, BBs0),
     case catch get_value(Bin, Type, Size, Unit, Sign, Endian) of
         {Val,<<_/bitstring>>=Rest} ->
             NewV = coerce_to_float(V, Type),
-            case catch Mfun(NewV, Val, Bs0) of
+            case catch Mfun(match, {NewV,Val,Bs0}) of
                 {match,Bs} ->
-                    BBs = add_bin_binding(NewV, Bs, BBs0),
+                    BBs = add_bin_binding(Mfun, NewV, Bs, BBs0),
                     {match,Bs,BBs,Rest};
                 _ ->
                     {nomatch,Rest}
@@ -205,7 +207,8 @@ bin_gen_field({bin_element,Line,VE,Size0,Options0},
 match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun, _) ->
     match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun).
 
-match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun) ->
+match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun)
+  when is_function(Mfun, 2), is_function(Efun, 2) ->
     case catch match_bits_1(Fs, Bin, Bs0, BBs, Mfun, Efun) of
         {match,Bs} -> {match,Bs};
         invalid -> throw(invalid);
@@ -230,12 +233,12 @@ match_field_1({bin_element,Line,VE,Size0,Options0},
         make_bit_type(Line, Size0, Options0),
     V = erl_eval:partial_eval(VE),
     Size2 = erl_eval:partial_eval(Size1),
-    match_check_size(Size2, BBs0),
+    match_check_size(Mfun, Size2, BBs0),
     {value, Size, _BBs} = Efun(Size2, BBs0),
     {Val,Rest} = get_value(Bin, Type, Size, Unit, Sign, Endian),
     NewV = coerce_to_float(V, Type),
-    {match,Bs} = Mfun(NewV, Val, Bs0),
-    BBs = add_bin_binding(NewV, Bs, BBs0),
+    {match,Bs} = Mfun(match, {NewV,Val,Bs0}),
+    BBs = add_bin_binding(Mfun, NewV, Bs, BBs0),
     {Bs,BBs,Rest}.
 
 %% Almost identical to the one in sys_pre_expand.
@@ -249,12 +252,12 @@ coerce_to_float({integer,L,I}=E, float) ->
 coerce_to_float(E, _Type) -> 
     E.
 
-add_bin_binding({var,_,'_'}, _Bs, BBs) ->
+add_bin_binding(_, {var,_,'_'}, _Bs, BBs) ->
     BBs;
-add_bin_binding({var,_,Name}, Bs, BBs) ->
-    {value,Value} = erl_eval:binding(Name, Bs),
-    erl_eval:add_binding(Name, Value, BBs);
-add_bin_binding(_, _Bs, BBs) ->
+add_bin_binding(Mfun, {var,_,Name}, Bs, BBs) ->
+    {value,Value} = Mfun(binding, {Name,Bs}),
+    Mfun(add_binding, {Name,Value,BBs});
+add_bin_binding(_, _, _Bs, BBs) ->
     BBs.
 
 get_value(Bin, integer, Size, Unit, Sign, Endian) ->
@@ -327,20 +330,20 @@ make_bit_type(_Line, Size, Type0) -> %Size evaluates to an integer or 'all'
         {error,Reason} -> error(Reason)
     end.
 
-match_check_size({var,_,V}, Bs) -> 
-    case erl_eval:binding(V, Bs) of
+match_check_size(Mfun, {var,_,V}, Bs) ->
+    case Mfun(binding, {V,Bs}) of
         {value,_} -> ok;
 	unbound -> throw(invalid) % or, rather, error({unbound,V})
     end;
-match_check_size({atom,_,all}, _Bs) ->
+match_check_size(_, {atom,_,all}, _Bs) ->
     ok;
-match_check_size({atom,_,undefined}, _Bs) ->
+match_check_size(_, {atom,_,undefined}, _Bs) ->
     ok;
-match_check_size({integer,_,_}, _Bs) ->
+match_check_size(_, {integer,_,_}, _Bs) ->
     ok;
-match_check_size({value,_,_}, _Bs) ->
+match_check_size(_, {value,_,_}, _Bs) ->
     ok;	%From the debugger.
-match_check_size(_, _Bs) -> 
+match_check_size(_, _, _Bs) ->
     throw(invalid).
 
 %% error(Reason) -> exception thrown