1 files changed, 25 insertions, 287 deletions

diff --git a/lib/compiler/src/sys_core_bsm.erl b/lib/compiler/src/sys_core_bsm.erl
index 62657933ee..685e807e65 100644
--- a/lib/compiler/src/sys_core_bsm.erl
+++ b/lib/compiler/src/sys_core_bsm.erl
@@ -24,223 +24,52 @@
 -export([module/2,format_error/1]).
 
 -include("core_parse.hrl").
--import(lists, [member/2,reverse/1,usort/1]).
 
 -spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module()}.
 
-module(#c_module{defs=Ds0}=Mod, Opts) ->
-    {Ds,Ws0} = function(Ds0, [], []),
-    case member(bin_opt_info, Opts) of
-        false ->
-            {ok,Mod#c_module{defs=Ds}};
-        true ->
-            Ws1 = [make_warning(Where, What) || {Where,What} <- Ws0],
-            Ws = usort(Ws1),
-            {ok,Mod#c_module{defs=Ds},Ws}
-    end.
+module(#c_module{defs=Ds}=Mod, _Opts) ->
+    {ok,Mod#c_module{defs=function(Ds)}}.
 
-function([{#c_var{name={F,Arity}}=Name,B0}|Fs], FsAcc, Ws0) ->
-    try cerl_trees:mapfold(fun bsm_an/2, Ws0, B0) of
-        {B,Ws} ->
-            function(Fs, [{Name,B}|FsAcc], Ws)
+function([{#c_var{name={F,Arity}}=Name,B0}|Fs]) ->
+    try cerl_trees:map(fun bsm_reorder/1, B0) of
+        B -> [{Name,B} | function(Fs)]
     catch
-        throw:unsafe_bs_context_to_binary ->
-            %% Unsafe bs_context_to_binary (in the sense that the
-            %% contents of the binary will probably be wrong).
-            %% Disable binary optimizations for the entire function.
-            %% We don't generate an INFO message, because this happens
-            %% very infrequently and it would be hard to explain in
-            %% a comprehensible way in an INFO message.
-            function(Fs, [{Name,B0}|FsAcc], Ws0);
         Class:Error:Stack ->
-	    io:fwrite("Function: ~w/~w\n", [F,Arity]),
-	    erlang:raise(Class, Error, Stack)
+            io:fwrite("Function: ~w/~w\n", [F,Arity]),
+            erlang:raise(Class, Error, Stack)
     end;
-function([], Fs, Ws) ->
-    {reverse(Fs),Ws}.
+function([]) ->
+    [].
 
 -type error() :: atom().
 -spec format_error(error()) -> nonempty_string().
 
-format_error(bin_opt_alias) ->
-    "INFO: the '=' operator will prevent delayed sub binary optimization";
-format_error(bin_partition) ->
-    "INFO: matching non-variables after a previous clause matching a variable "
-	"will prevent delayed sub binary optimization";
-format_error(bin_var_used) ->
-    "INFO: using a matched out sub binary will prevent "
-	"delayed sub binary optimization";
-format_error(orig_bin_var_used_in_guard) ->
-    "INFO: using the original binary variable in a guard will prevent "
-	"delayed sub binary optimization";
-format_error(bin_var_used_in_guard) ->
-    "INFO: using a matched out sub binary in a guard will prevent "
-	"delayed sub binary optimization".
-
+format_error(_) -> error(badarg).
 
-%%%
-%%% Annotate bit syntax matching to faciliate optimization in further passes.
-%%%
+%%% Reorder bit syntax matching to faciliate optimization in further passes.
 
-bsm_an(Core0, Ws0) ->
-    case bsm_an(Core0) of
-        {ok,Core} ->
-            {Core,Ws0};
-        {ok,Core,W} ->
-            {Core,[W|Ws0]}
-    end.
+bsm_reorder(#c_case{arg=#c_var{}=V}=Case) ->
+    bsm_reorder_1([V], Case);
+bsm_reorder(#c_case{arg=#c_values{es=Es}}=Case) ->
+    bsm_reorder_1(Es, Case);
+bsm_reorder(Core) ->
+    Core.
 
-bsm_an(#c_case{arg=#c_var{}=V}=Case) ->
-    bsm_an_1([V], Case);
-bsm_an(#c_case{arg=#c_values{es=Es}}=Case) ->
-    bsm_an_1(Es, Case);
-bsm_an(Other) ->
-    {ok,Other}.
-
-bsm_an_1(Vs0, #c_case{clauses=Cs0}=Case) ->
+bsm_reorder_1(Vs0, #c_case{clauses=Cs0}=Case) ->
     case bsm_leftmost(Cs0) of
-	none ->
-            {ok,Case};
-        1 ->
-            bsm_an_2(Vs0, Cs0, Case);
-        Pos ->
-            Vs = move_from_col(Pos, Vs0),
-            Cs = [C#c_clause{pats=move_from_col(Pos, Ps)} ||
-                     #c_clause{pats=Ps}=C <- Cs0],
-            bsm_an_2(Vs, Cs, Case)
-    end.
-
-bsm_an_2(Vs, Cs, Case) ->
-    try
-        bsm_ensure_no_partition(Cs),
-        {ok,bsm_do_an(Vs, Cs, Case)}
-    catch
-        throw:{problem,Where,What} ->
-            {ok,Case,{Where,What}}
+        Pos when Pos > 0, Pos =/= none ->
+            Vs = core_lib:make_values(move_from_col(Pos, Vs0)),
+            Cs = [C#c_clause{pats=move_from_col(Pos, Ps)}
+                  || #c_clause{pats=Ps}=C <- Cs0],
+            Case#c_case{arg=Vs,clauses=Cs};
+        _ ->
+            Case
     end.
 
 move_from_col(Pos, L) ->
     {First,[Col|Rest]} = lists:split(Pos - 1, L),
     [Col|First] ++ Rest.
 
-bsm_do_an([#c_var{name=Vname}=V0|Vs0], Cs0, Case) ->
-    bsm_inner_context_to_binary(Cs0),
-    Cs = bsm_do_an_var(Vname, Cs0),
-    V = bsm_annotate_for_reuse(V0),
-    Vs = core_lib:make_values([V|Vs0]),
-    Case#c_case{arg=Vs,clauses=Cs};
-bsm_do_an(_Vs, _Cs, Case) -> Case.
-
-bsm_inner_context_to_binary([#c_clause{body=B}|Cs]) ->
-    %% Consider:
-    %%
-    %%   foo(<<Length, Data/binary>>) ->  %Line 1
-    %%      case {Data, Length} of        %Line 2
-    %%        {_, 0} -> Data;             %Line 3
-    %%        {<<...>>, 4} -> ...         %Line 4
-    %%      end.
-    %%
-    %% No sub binary will be created for Data in line 1. The match
-    %% context will be passed on to the `case` in line 2. In line 3,
-    %% this pass inserts a `bs_context_to_binary` instruction to
-    %% convert the match context representing Data to a binary before
-    %% returning it. The problem is that the binary created will be
-    %% the original binary (including the matched out Length field),
-    %% not the tail of the binary as it is supposed to be.
-    %%
-    %% Here follows a heuristic to disable the binary optimizations
-    %% for the entire function if this code kind of code is found.
-
-    case cerl_trees:free_variables(B) of
-        [] ->
-            %% Since there are no free variables in the body of
-            %% this clause, there can't be any troublesome
-            %% bs_context_to_binary instructions.
-            bsm_inner_context_to_binary(Cs);
-        [_|_]=Free ->
-            %% One of the free variables could refer to a match context
-            %% created by the outer binary match.
-            F = fun(#c_primop{name=#c_literal{val=bs_context_to_binary},
-                              args=[#c_var{name=V}]}, _) ->
-                        case member(V, Free) of
-                            true ->
-                                %% This bs_context_to_binary instruction will
-                                %% make a binary of the match context from an
-                                %% outer binary match. It is very likely that
-                                %% the contents of the binary will be wrong
-                                %% (the original binary as opposed to only
-                                %% the tail binary).
-                                throw(unsafe_bs_context_to_binary);
-                            false ->
-                                %% Safe. This bs_context_to_binary instruction
-                                %% will make a binary from a match context
-                                %% defined in the body of the clause.
-                                ok
-                        end;
-                   (_, _) ->
-                        ok
-                end,
-            cerl_trees:fold(F, ok, B)
-    end;
-bsm_inner_context_to_binary([]) -> ok.
-
-bsm_do_an_var(V, [#c_clause{pats=[P|_],guard=G,body=B0}=C0|Cs]) ->
-    case P of
-	#c_var{name=VarName} ->
-	    case core_lib:is_var_used(V, G) of
-		true -> bsm_problem(C0, orig_bin_var_used_in_guard);
-		false -> ok
-	    end,
-	    case core_lib:is_var_used(VarName, G) of
-		true -> bsm_problem(C0, bin_var_used_in_guard);
-		false -> ok
-	    end,
-	    B1 = bsm_maybe_ctx_to_binary(VarName, B0),
-	    B = bsm_maybe_ctx_to_binary(V, B1),
-	    C = C0#c_clause{body=B},
-            [C|bsm_do_an_var(V, Cs)];
-        #c_alias{} ->
-	    case bsm_could_match_binary(P) of
-		false ->
-		    [C0|bsm_do_an_var(V, Cs)];
-		true ->
-		    bsm_problem(C0, bin_opt_alias)
-	    end;
-        _ ->
-	    case bsm_could_match_binary(P) andalso bsm_is_var_used(V, G, B0) of
-		false ->
-		    [C0|bsm_do_an_var(V, Cs)];
-		true ->
-		    bsm_problem(C0, bin_var_used)
-	    end
-    end;
-bsm_do_an_var(_, []) -> [].
-
-bsm_annotate_for_reuse(#c_var{anno=Anno}=Var) ->
-    Var#c_var{anno=[reuse_for_context|Anno]}.
-
-bsm_is_var_used(V, G, B) ->
-    core_lib:is_var_used(V, G) orelse core_lib:is_var_used(V, B).
-
-bsm_maybe_ctx_to_binary(V, B) ->
-    case core_lib:is_var_used(V, B) andalso not previous_ctx_to_binary(V, B) of
-	false ->
-	    B;
-	true ->
-	    #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary},
-				 args=[#c_var{name=V}]},
-		   body=B}
-    end.
-
-previous_ctx_to_binary(V, Core) ->
-    case Core of
-	#c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary},
-			     args=[#c_var{name=V}]}} ->
-	    true;
-	_ ->
-	    false
-    end.
-
 %% bsm_leftmost(Cs) -> none | ArgumentNumber
 %%  Find the leftmost argument that matches a nonempty binary.
 %%  Return either 'none' or the argument number (1-N).
@@ -262,94 +91,3 @@ bsm_leftmost_2([_|Ps], Cs, N, Pos) ->
     bsm_leftmost_2(Ps, Cs, N+1, Pos);
 bsm_leftmost_2([], Cs, _, Pos) ->
     bsm_leftmost_1(Cs, Pos).
-
-%% bsm_ensure_no_partition(Cs) -> ok     (exception if problem)
-%%  There must only be a single bs_start_match2 instruction if we
-%%  are to reuse the binary variable for the match context.
-%%
-%%  To make sure that there is only a single bs_start_match2
-%%  instruction, we will check for partitions such as:
-%%
-%%             foo(<<...>>) -> ...
-%%             foo(<Variable>) when ... -> ...
-%%             foo(<Non-variable pattern>) ->
-%%
-%%  If there is such partition, we reject the optimization.
-
-bsm_ensure_no_partition(Cs) ->
-    bsm_ensure_no_partition_1(Cs, before).
-
-%% Loop through each clause.
-bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], State0) ->
-    State = bsm_ensure_no_partition_2(Ps, G, State0),
-    case State of
-	'after' ->
-	    bsm_ensure_no_partition_after(Cs);
-	_ ->
-	    ok
-    end,
-    bsm_ensure_no_partition_1(Cs, State);
-bsm_ensure_no_partition_1([], _) -> ok.
-
-bsm_ensure_no_partition_2([#c_binary{}|_], _, _State) ->
-    within;
-bsm_ensure_no_partition_2([#c_alias{}=Alias|_], N, State) ->
-    %% Retrieve the real pattern that the alias refers to and check that.
-    P = bsm_real_pattern(Alias),
-    bsm_ensure_no_partition_2([P], N, State);
-bsm_ensure_no_partition_2([_|_], _, before=State) ->
-    %% No binary matching yet - therefore no partition.
-    State;
-bsm_ensure_no_partition_2([P|_], _, State) ->
-    case bsm_could_match_binary(P) of
-	false ->
-            State;
-	true ->
-	    %% The pattern P *may* match a binary, so we must update the state.
-	    %% (P must be a variable.)
-            'after'
-    end.
-
-bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs]) ->
-    case Ps of
-        [#c_var{}|_] ->
-            bsm_ensure_no_partition_after(Cs);
-        _ ->
-            bsm_problem(C, bin_partition)
-    end;
-bsm_ensure_no_partition_after([]) -> ok.
-
-bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P);
-bsm_could_match_binary(#c_cons{}) -> false;
-bsm_could_match_binary(#c_tuple{}) -> false;
-bsm_could_match_binary(#c_literal{val=Lit}) -> is_bitstring(Lit);
-bsm_could_match_binary(_) -> true.
-
-bsm_real_pattern(#c_alias{pat=P}) -> bsm_real_pattern(P);
-bsm_real_pattern(P) -> P.
-
-bsm_problem(Where, What) ->
-    throw({problem,Where,What}).
-
-make_warning(Core, Term) ->
-    case should_suppress_warning(Core) of
-	true ->
-	    ok;
-	false ->
-            Anno = cerl:get_ann(Core),
-            Line = get_line(Anno),
-            File = get_file(Anno),
-            {File,[{Line,?MODULE,Term}]}
-    end.
-
-should_suppress_warning(Core) ->
-    Ann = cerl:get_ann(Core),
-    member(compiler_generated, Ann).
-
-get_line([Line|_]) when is_integer(Line) -> Line;
-get_line([_|T]) -> get_line(T);
-get_line([]) -> none.
-
-get_file([{file,File}|_]) -> File;
-get_file([_|T]) -> get_file(T);
-get_file([]) -> "no_file". % should not happen