path: root/lib/compiler/src/sys_core_fold.erl

%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1999-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% %CopyrightEnd%
%%
%% Purpose : Constant folding optimisation for Core

%% Propagate atomic values and fold in values of safe calls to
%% constant arguments.  Also detect and remove literals which are
%% ignored in a 'seq'.  Could handle lets better by chasing down
%% complex 'arg' expressions and finding values.
%%
%% Try to optimise case expressions by removing unmatchable or
%% unreachable clauses.  Also change explicit tuple arg into multiple
%% values and extend clause patterns.  We must be careful here not to
%% generate cases which we know to be safe but later stages will not
%% recognise as such, e.g. the following is NOT acceptable:
%%
%%    case 'b' of
%%        <'b'> -> ...
%%    end
%%
%% Variable folding is complicated by variable shadowing, for example
%% in:
%%    'foo'/1 =
%%        fun (X) ->
%%            let <A> = X
%%            in  let <X> = Y
%%                in ... <use A>
%% If we were to simply substitute X for A then we would be using the
%% wrong X.  Our solution is to rename variables that are the values
%% of substitutions.  We could rename all shadowing variables but do
%% the minimum.  We would then get:
%%    'foo'/1 =
%%        fun (X) ->
%%            let <A> = X
%%            in  let <X1> = Y
%%                in ... <use A>
%% which is optimised to:
%%    'foo'/1 =
%%        fun (X) ->
%%            let <X1> = Y
%%            in ... <use X>
%%
%% This is done by carefully shadowing variables and substituting
%% values.  See details when defining functions.
%%
%% It would be possible to extend to replace repeated evaluation of
%% "simple" expressions by the value (variable) of the first call.
%% For example, after a "let Z = X+1" then X+1 would be replaced by Z
%% where X is valid.  The Sub uses the full Core expression as key.
%% It would complicate handling of patterns as we would have to remove
%% all values where the key contains pattern variables.

-module(sys_core_fold).

-export([module/2,format_error/1]).

-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2,
		reverse/1,reverse/2,member/2,nth/2,flatten/1,unzip/1]).

-import(cerl, [ann_c_cons/3,ann_c_tuple/2]).

-include("core_parse.hrl").

%%-define(DEBUG, 1).

-ifdef(DEBUG).
-define(ASSERT(E),
	case E of
	    true -> ok;
	    false ->
		io:format("~p, line ~p: assertion failed\n", [?MODULE,?LINE]),
		exit(assertion_failed)
	end).
-else.
-define(ASSERT(E), ignore).
-endif.

%% Variable value info.
-record(sub, {v=[],				%Variable substitutions
	      s=[],				%Variables in scope
	      t=[],				%Types
	      in_guard=false}).			%In guard or not.

-spec module(cerl:c_module(), [compile:option()]) ->
	{'ok', cerl:c_module(), [_]}.

module(#c_module{defs=Ds0}=Mod, Opts) ->
    put(bin_opt_info, member(bin_opt_info, Opts)),
    put(no_inline_list_funcs, not member(inline_list_funcs, Opts)),
    case get(new_var_num) of
	undefined -> put(new_var_num, 0);
	_ -> ok
    end,
    init_warnings(),
    Ds1 = [function_1(D) || D <- Ds0],
    erase(no_inline_list_funcs),
    erase(bin_opt_info),
    {ok,Mod#c_module{defs=Ds1},get_warnings()}.

function_1({#c_var{name={F,Arity}}=Name,B0}) ->
    try
	B = expr(B0, value, sub_new()),			%This must be a fun!
	{Name,B}
    catch
	Class:Error ->
	    Stack = erlang:get_stacktrace(),
	    io:fwrite("Function: ~w/~w\n", [F,Arity]),
	    erlang:raise(Class, Error, Stack)
    end.

%% body(Expr, Sub) -> Expr.
%% body(Expr, Context, Sub) -> Expr.
%%  No special handling of anything except values.

body(Body, Sub) ->
    body(Body, value, Sub).

body(#c_values{anno=A,es=Es0}, Ctxt, Sub) ->
    Es1 = expr_list(Es0, Ctxt, Sub),
    case Ctxt of
	value ->
	    #c_values{anno=A,es=Es1};
	effect ->
	    make_effect_seq(Es1, Sub)
    end;
body(E, Ctxt, Sub) ->
    ?ASSERT(verify_scope(E, Sub)),
    expr(E, Ctxt, Sub).

%% guard(Expr, Sub) -> Expr.
%%  Do guard expression.  We optimize it in the same way as
%%  expressions in function bodies.

guard(Expr, Sub) ->
    ?ASSERT(verify_scope(Expr, Sub)),
    expr(Expr, value, Sub#sub{in_guard=true}).

%% opt_guard_try(Expr) -> Expr.
%%
opt_guard_try(#c_seq{arg=Arg,body=Body0}=Seq) ->
    Body = opt_guard_try(Body0),
    case {Arg,Body} of
	{#c_call{module=#c_literal{val=Mod},
		 name=#c_literal{val=Name},
		 args=Args},#c_literal{val=false}} ->
	    %% We have sequence consisting of a call (evaluated
	    %% for a possible exception and/or side effect only),
	    %% followed by 'false'.
	    %%   Since the sequence is inside a try block that will
	    %% default to 'false' if any exception occurs, not
	    %% evalutating the call will not change the behaviour
	    %% provided that the call has no side effects.
	    case erl_bifs:is_pure(Mod, Name, length(Args)) of
		false ->
		    %% Not a pure BIF (meaning that this is not
		    %% a guard and that we must keep the call).
		    Seq#c_seq{body=Body};
		true ->
		    %% The BIF has no side effects, so it can
		    %% be safely removed.
		    Body
	    end;
	{_,_} ->
	    Seq#c_seq{body=Body}
    end;
opt_guard_try(#c_case{clauses=Cs}=Term) ->
    Term#c_case{clauses=opt_guard_try_list(Cs)};
opt_guard_try(#c_clause{body=B0}=Term) ->
    Term#c_clause{body=opt_guard_try(B0)};
opt_guard_try(#c_let{arg=Arg,body=B0}=Term) ->
    case opt_guard_try(B0) of
	#c_literal{}=B ->
	    opt_guard_try(#c_seq{arg=Arg,body=B});
	B ->
	    Term#c_let{body=B}
    end;
opt_guard_try(Term) -> Term.

opt_guard_try_list([C|Cs]) ->
    [opt_guard_try(C)|opt_guard_try_list(Cs)];
opt_guard_try_list([]) -> [].

%% expr(Expr, Sub) -> Expr.
%% expr(Expr, Context, Sub) -> Expr.

expr(Expr, Sub) ->
    expr(Expr, value, Sub).

expr(#c_var{}=V, Ctxt, Sub) ->
    %% Return void() in effect context to potentially shorten the life time
    %% of the variable and potentially generate better code
    %% (for instance, if the variable no longer needs to survive a function
    %% call, there will be no need to save it in the stack frame).
    case Ctxt of
	effect -> void();
	value -> sub_get_var(V, Sub)
    end;
expr(#c_literal{val=Val}=L, Ctxt, _Sub) ->
    case Ctxt of
	effect ->
	    case Val of
		[] ->
		    %% Keep as [] - might give slightly better code.
		    L;
		_ when is_atom(Val) ->
		    %% For cleanliness replace with void().
		    void();
		_ ->
		    %% Warn and replace with void().
		    add_warning(L, useless_building),
		    void()
	    end;
	value -> L
    end;
expr(#c_cons{anno=Anno,hd=H0,tl=T0}=Cons, Ctxt, Sub) ->
    H1 = expr(H0, Ctxt, Sub),
    T1 = expr(T0, Ctxt, Sub),
    case Ctxt of
	effect ->
	    add_warning(Cons, useless_building),
	    expr(make_effect_seq([H1,T1], Sub), Ctxt, Sub);
	value ->
	    ann_c_cons(Anno, H1, T1)
    end;
expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) ->
    Es = expr_list(Es0, Ctxt, Sub),
    case Ctxt of
	effect ->
	    add_warning(Tuple, useless_building),
	    expr(make_effect_seq(Es, Sub), Ctxt, Sub);
	value ->
	    ann_c_tuple(Anno, Es)
    end;
expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) ->
    Es = pair_list(Es0, Ctxt, Sub),
    case Ctxt of
	effect ->
	    add_warning(Map, useless_building),
	    expr(make_effect_seq(Es, Sub), Ctxt, Sub);
	value ->
	    V = expr(V0, Ctxt, Sub),
	    Map#c_map{var=V,es=Es}
    end;
expr(#c_binary{segments=Ss}=Bin0, Ctxt, Sub) ->
    %% Warn for useless building, but always build the binary
    %% anyway to preserve a possible exception.
    case Ctxt of
	effect -> add_warning(Bin0, useless_building);
	value -> ok
    end,
    Bin1 = Bin0#c_binary{segments=bitstr_list(Ss, Sub)},
    Bin = bin_un_utf(Bin1),
    eval_binary(Bin);
expr(#c_fun{}=Fun, effect, _) ->
    %% A fun is created, but not used. Warn, and replace with the void value.
    add_warning(Fun, useless_building),
    void();
expr(#c_fun{vars=Vs0,body=B0}=Fun, Ctxt0, Sub0) ->
    {Vs1,Sub1} = pattern_list(Vs0, Sub0),
    Ctxt = case Ctxt0 of
	       {letrec,Ctxt1} -> Ctxt1;
	       value -> value
	   end,
    B1 = body(B0, Ctxt, Sub1),
    Fun#c_fun{vars=Vs1,body=B1};
expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) ->
    %% Optimise away pure literal arg as its value is ignored.
    B1 = body(B0, Ctxt, Sub),
    Arg = body(Arg0, effect, Sub),
    case will_fail(Arg) of
	true ->
	    Arg;
	false ->
	    %% Arg cannot be "values" here - only a single value
	    %% make sense here.
	    case is_safe_simple(Arg, Sub) of
		true -> B1;
		false -> Seq0#c_seq{arg=Arg,body=B1}
	    end
    end;
expr(#c_let{}=Let, Ctxt, Sub) ->
    case simplify_let(Let, Sub) of
	impossible ->
	    %% The argument for the let is "simple", i.e. has no
	    %% complex structures such as let or seq that can be entered.
	    ?ASSERT(verify_scope(Let, Sub)),
	    opt_simple_let(Let, Ctxt, Sub);
	Expr ->
	    %% The let body was successfully moved into the let argument.
	    %% Now recursively re-process the new expression.
	    expr(Expr, Ctxt, sub_new_preserve_types(Sub))
    end;
expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) ->
    %% This is named fun in an 'effect' context. Warn and ignore.
    add_warning(Letrec, useless_building),
    void();
expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) ->
    Fs1 = map(fun ({Name,Fb}) ->
		      {Name,expr(Fb, {letrec,Ctxt}, Sub)}
	      end, Fs0),
    B1 = body(B0, value, Sub),
    Letrec#c_letrec{defs=Fs1,body=B1};
expr(#c_case{}=Case0, Ctxt, Sub) ->
    %% Ideally, the compiler should only emit warnings when there is
    %% a real mistake in the code being compiled. We use the follow
    %% heuristics in an attempt to approach that ideal:
    %%
    %% * If the guard for a clause always fails, we will emit a
    %%   warning.
    %%
    %% * If a case expression is a literal, we will emit no warnings
    %%   for clauses that will not match or for clauses that are
    %%   shadowed after a clause that will always match. That means
    %%   that code such as:
    %%
    %%      case ?DEBUG of
    %%         false -> ok;
    %%         true -> ...
    %%      end
    %%
    %%   (where ?DEBUG expands to either 'true' or 'false') will not
    %%   produce any warnings.
    %%
    %% * If the case expression is not literal, warnings will be
    %%   emitted for every clause that don't match and for all
    %%   clauses following a clause that will always match.
    %%
    %% * If no clause will ever match, there will be a warning
    %%   (in addition to any warnings that may have been emitted
    %%   according to the rules above).
    %%
    case opt_bool_case(Case0) of
	#c_case{arg=Arg0,clauses=Cs0}=Case1 ->
	    Arg1 = body(Arg0, value, Sub),
	    LitExpr = cerl:is_literal(Arg1),
	    {Arg2,Cs1} = case_opt(Arg1, Cs0, Sub),
	    Cs2 = clauses(Arg2, Cs1, Ctxt, Sub, LitExpr),
	    Case = Case1#c_case{arg=Arg2,clauses=Cs2},
	    warn_no_clause_match(Case1, Case),
	    Expr = eval_case(Case, Sub),
	    bsm_an(Expr);
	Other ->
	    expr(Other, Ctxt, Sub)
    end;
expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) ->
    Cs1 = clauses(#c_var{name='_'}, Cs0, Ctxt, Sub, false),
    T1 = expr(T0, value, Sub),
    A1 = body(A0, Ctxt, Sub),
    Recv#c_receive{clauses=Cs1,timeout=T1,action=A1};
expr(#c_apply{op=Op0,args=As0}=App, _, Sub) ->
    Op1 = expr(Op0, value, Sub),
    As1 = expr_list(As0, value, Sub),
    App#c_apply{op=Op1,args=As1};
expr(#c_call{module=M0,name=N0}=Call0, Ctxt, Sub) ->
    M1 = expr(M0, value, Sub),
    N1 = expr(N0, value, Sub),
    Call = Call0#c_call{module=M1,name=N1},
    case useless_call(Ctxt, Call) of
	no -> call(Call, M1, N1, Sub);
	{yes,Seq} -> expr(Seq, Ctxt, Sub)
    end;
expr(#c_primop{args=As0}=Prim, _, Sub) ->
    As1 = expr_list(As0, value, Sub),
    Prim#c_primop{args=As1};
expr(#c_catch{body=B0}=Catch, _, Sub) ->
    %% We can remove catch if the value is simple
    B1 = body(B0, value, Sub),
    case is_safe_simple(B1, Sub) of
	true -> B1;
	false -> Catch#c_catch{body=B1}
    end;
expr(#c_try{arg=E0,vars=[#c_var{name=X}],body=#c_var{name=X},
	    handler=#c_literal{val=false}=False}=Try, _, Sub) ->
    %% Since guard may call expr/2, we must do some optimization of
    %% the kind of try's that occur in guards.
    E1 = body(E0, value, Sub),
    case will_fail(E1) of
	false ->
	    %% Remove any calls that are evaluated for effect only.
	    E2 = opt_guard_try(E1),

	    %% We can remove try/catch if the expression is an
	    %% expression that cannot fail.
	    case is_safe_bool_expr(E2, Sub) orelse is_safe_simple(E2, Sub) of
		true -> E2;
		false -> Try#c_try{arg=E2}
	    end;
	true ->
	    %% Expression will always fail.
	    False
    end;
expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0) ->
    %% Here is the general try/catch construct outside of guards.
    %% We can remove try if the value is simple and replace it with a let.
    E1 = body(E0, value, Sub0),
    {Vs1,Sub1} = pattern_list(Vs0, Sub0),
    B1 = body(B0, value, Sub1),
    case is_safe_simple(E1, Sub0) of
	true ->
	    expr(#c_let{anno=A,vars=Vs1,arg=E1,body=B1}, value, Sub0);
	false ->
	    {Evs1,Sub2} = pattern_list(Evs0, Sub0),
	    H1 = body(H0, value, Sub2),
	    Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H1}
    end.

expr_list(Es, Ctxt, Sub) ->
    [expr(E, Ctxt, Sub) || E <- Es].

pair_list(Es, Ctxt, Sub) ->
    [pair(E, Ctxt, Sub) || E <- Es].

pair(#c_map_pair{key=K,val=V}, effect, Sub) ->
    make_effect_seq([K,V], Sub);
pair(#c_map_pair{key=K0,val=V0}=Pair, value=Ctxt, Sub) ->
    K = expr(K0, Ctxt, Sub),
    V = expr(V0, Ctxt, Sub),
    Pair#c_map_pair{key=K,val=V}.

bitstr_list(Es, Sub) ->
    [bitstr(E, Sub) || E <- Es].

bitstr(#c_bitstr{val=Val,size=Size}=BinSeg, Sub) ->
    BinSeg#c_bitstr{val=expr(Val, Sub),size=expr(Size, value, Sub)}.

%% is_safe_simple(Expr, Sub) -> true | false.
%%  A safe simple cannot fail with badarg and is safe to use
%%  in a guard.
%%
%%  Currently, we don't attempt to check binaries because they
%%  are difficult to check.

is_safe_simple(#c_var{}, _) -> true;
is_safe_simple(#c_cons{hd=H,tl=T}, Sub) ->
    is_safe_simple(H, Sub) andalso is_safe_simple(T, Sub);
is_safe_simple(#c_tuple{es=Es}, Sub) -> is_safe_simple_list(Es, Sub);
is_safe_simple(#c_literal{}, _) -> true;
is_safe_simple(#c_call{module=#c_literal{val=erlang},
		       name=#c_literal{val=Name},
		       args=Args}, Sub) when is_atom(Name) ->
    NumArgs = length(Args),
    case erl_internal:bool_op(Name, NumArgs) of
	true ->
	    %% Boolean operators are safe if the arguments are boolean.
	    all(fun(#c_var{name=V}) -> is_boolean_type(V, Sub);
		   (#c_literal{val=Lit}) -> is_boolean(Lit);
		   (_) -> false
		end, Args);
	false ->
	    %% We need a rather complicated test to ensure that
	    %% we only allow safe calls that are allowed in a guard.
	    %% (Note that is_function/2 is a type test, but is not safe.)
	    erl_bifs:is_safe(erlang, Name, NumArgs) andalso
		      (erl_internal:comp_op(Name, NumArgs) orelse
		       erl_internal:new_type_test(Name, NumArgs))
    end;
is_safe_simple(_, _) -> false.

is_safe_simple_list(Es, Sub) -> all(fun(E) -> is_safe_simple(E, Sub) end, Es).

%% will_fail(Expr) -> true|false.
%%  Determine whether the expression will fail with an exception.
%%  Return true if the expression always will fail with an exception,
%%  i.e. never return normally.

will_fail(#c_let{arg=A,body=B}) ->
    will_fail(A) orelse will_fail(B);
will_fail(#c_call{module=#c_literal{val=Mod},name=#c_literal{val=Name},args=Args}) ->
    erl_bifs:is_exit_bif(Mod, Name, length(Args));
will_fail(#c_primop{name=#c_literal{val=match_fail},args=[_]}) -> true;
will_fail(_) -> false.

%% bin_un_utf(#c_binary{}) -> #c_binary{}
%%  Convert any literal UTF-8/16/32 literals to byte-sized
%%  integer fields.

bin_un_utf(#c_binary{anno=Anno,segments=Ss}=Bin) ->
    Bin#c_binary{segments=bin_un_utf_1(Ss, Anno)}.

bin_un_utf_1([#c_bitstr{val=#c_literal{},type=#c_literal{val=utf8}}=H|T],
	     Anno) ->
    bin_un_utf_eval(H, Anno) ++ bin_un_utf_1(T, Anno);
bin_un_utf_1([#c_bitstr{val=#c_literal{},type=#c_literal{val=utf16}}=H|T],
	     Anno) ->
    bin_un_utf_eval(H, Anno) ++ bin_un_utf_1(T, Anno);
bin_un_utf_1([#c_bitstr{val=#c_literal{},type=#c_literal{val=utf32}}=H|T],
	     Anno) ->
    bin_un_utf_eval(H, Anno) ++ bin_un_utf_1(T, Anno);
bin_un_utf_1([H|T], Anno) ->
    [H|bin_un_utf_1(T, Anno)];
bin_un_utf_1([], _) -> [].

bin_un_utf_eval(Bitstr, Anno) ->
    Segments = [Bitstr],
    case eval_binary(#c_binary{anno=Anno,segments=Segments}) of
	#c_literal{anno=Anno,val=Bytes} when is_binary(Bytes) ->
	    [#c_bitstr{anno=Anno,
		       val=#c_literal{anno=Anno,val=B},
		       size=#c_literal{anno=Anno,val=8},
		       unit=#c_literal{anno=Anno,val=1},
		       type=#c_literal{anno=Anno,val=integer},
		       flags=#c_literal{anno=Anno,val=[unsigned,big]}} ||
		B <- binary_to_list(Bytes)];
	_ ->
	    Segments
    end.

%% eval_binary(#c_binary{}) -> #c_binary{} | #c_literal{}
%%  Evaluate a binary at compile time if possible to create
%%  a binary literal.

eval_binary(#c_binary{anno=Anno,segments=Ss}=Bin) ->
    try
	#c_literal{anno=Anno,val=eval_binary_1(Ss, <<>>)}
    catch
	throw:impossible ->
	    Bin;
	  throw:{badarg,Warning} ->
	    add_warning(Bin, Warning),
	    #c_call{anno=Anno,
		    module=#c_literal{val=erlang},
		    name=#c_literal{val=error},
		    args=[#c_literal{val=badarg}]}
    end.

eval_binary_1([#c_bitstr{val=#c_literal{val=Val},size=#c_literal{val=Sz},
			 unit=#c_literal{val=Unit},type=#c_literal{val=Type},
			 flags=#c_literal{val=Flags}}|Ss], Acc0) ->
    Endian = case member(big, Flags) of
		 true ->
		     big;
		 false ->
		     case member(little, Flags) of
			 true -> little;
			 false -> throw(impossible) %Native endian.
		     end
	     end,

    %% Make sure that the size is reasonable.
    case Type of
	binary when is_bitstring(Val) ->
	    if
		Sz =:= all ->
		    ok;
		Sz*Unit =< bit_size(Val) ->
		    ok;
		true ->
		    %% Field size is greater than the actual binary - will fail.
		    throw({badarg,embedded_binary_size})
	    end;
	integer when is_integer(Val) ->
	    %% Estimate the number of bits needed to to hold the integer
	    %% literal. Check whether the field size is reasonable in
	    %% proportion to the number of bits needed.
	    if
		Sz*Unit =< 256 ->
		    %% Don't be cheap - always accept fields up to this size.
		    ok;
		true ->
		    case count_bits(Val) of
			BitsNeeded when 2*BitsNeeded >= Sz*Unit ->
			    ok;
			_ ->
			    %% More than about half of the field size will be
			    %% filled out with zeroes - not acceptable.
			    throw(impossible)
		    end
	    end;
	float when is_float(Val) ->
	    %% Bad float size.
	    case Sz*Unit of
		32 -> ok;
		64 -> ok;
		_ -> throw(impossible)
	    end;
	utf8 -> ok;
	utf16 -> ok;
	utf32 -> ok;
	_ ->
	    throw(impossible)
    end,

    %% Evaluate the field.
    try eval_binary_2(Acc0, Val, Sz, Unit, Type, Endian) of
	Acc -> eval_binary_1(Ss, Acc)
    catch
	error:_ ->
	    throw(impossible)
    end;
eval_binary_1([#c_bitstr{val=#c_literal{},size=#c_literal{},
			 unit=#c_literal{},type=#c_literal{},
			 flags=#c_cons{}=Flags}=Bitstr|Ss], Acc0) ->
    case cerl:fold_literal(Flags) of
	#c_literal{} = Flags1 ->
	    eval_binary_1([Bitstr#c_bitstr{flags=Flags1}|Ss], Acc0);
	_ -> throw(impossible)
    end;
eval_binary_1([], Acc) -> Acc;
eval_binary_1(_, _) -> throw(impossible).

eval_binary_2(Acc, Val, Size, Unit, integer, little) ->
    <<Acc/bitstring,Val:(Size*Unit)/little>>;
eval_binary_2(Acc, Val, Size, Unit, integer, big) ->
    <<Acc/bitstring,Val:(Size*Unit)/big>>;
eval_binary_2(Acc, Val, _Size, _Unit, utf8, _) ->
    try
	<<Acc/bitstring,Val/utf8>>
    catch
	error:_ ->
	    throw({badarg,bad_unicode})
    end;
eval_binary_2(Acc, Val, _Size, _Unit, utf16, big) ->
    try
	<<Acc/bitstring,Val/big-utf16>>
    catch
	error:_ ->
	    throw({badarg,bad_unicode})
    end;
eval_binary_2(Acc, Val, _Size, _Unit, utf16, little) ->
    try
	<<Acc/bitstring,Val/little-utf16>>
    catch
	error:_ ->
	    throw({badarg,bad_unicode})
    end;
eval_binary_2(Acc, Val, _Size, _Unit, utf32, big) ->
    try
	<<Acc/bitstring,Val/big-utf32>>
    catch
	error:_ ->
	    throw({badarg,bad_unicode})
    end;
eval_binary_2(Acc, Val, _Size, _Unit, utf32, little) ->
    try
	<<Acc/bitstring,Val/little-utf32>>
    catch
	error:_ ->
	    throw({badarg,bad_unicode})
    end;
eval_binary_2(Acc, Val, Size, Unit, float, little) ->
    <<Acc/bitstring,Val:(Size*Unit)/little-float>>;
eval_binary_2(Acc, Val, Size, Unit, float, big) ->
    <<Acc/bitstring,Val:(Size*Unit)/big-float>>;
eval_binary_2(Acc, Val, all, Unit, binary, _) ->
    case bit_size(Val) of
	Size when Size rem Unit =:= 0 ->
	    <<Acc/bitstring,Val:Size/bitstring>>;
	Size ->
	    throw({badarg,{embedded_unit,Unit,Size}})
    end;
eval_binary_2(Acc, Val, Size, Unit, binary, _) ->
    <<Acc/bitstring,Val:(Size*Unit)/bitstring>>.

%% Count the number of bits approximately needed to store Int.
%% (We don't need an exact result for this purpose.)

count_bits(Int) ->
    count_bits_1(abs(Int), 64).

count_bits_1(0, Bits) -> Bits;
count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64).

%% useless_call(Context, #c_call{}) -> no | {yes,Expr}
%%  Check whether the function is called only for effect,
%%  and if the function either has no effect whatsoever or
%%  the only effect is an exception. Generate appropriate
%%  warnings. If the call is "useless" (has no effect),
%%  a rewritten expression consisting of a sequence of
%%  the arguments only is returned.

useless_call(effect, #c_call{anno=Anno,
			     module=#c_literal{val=Mod},
			     name=#c_literal{val=Name},
			     args=Args}=Call) ->
    A = length(Args),
    case erl_bifs:is_safe(Mod, Name, A) of
	false ->
	    case erl_bifs:is_pure(Mod, Name, A) of
		true ->
		    case member(result_not_wanted, Anno) of
			false ->
			    add_warning(Call, result_ignored);
			true ->
			    ok
		    end;
		false ->
		    ok
	    end,
	    no;
	true ->
	    add_warning(Call, {no_effect,{Mod,Name,A}}),
	    {yes,make_effect_seq(Args, sub_new())}
    end;
useless_call(_, _) -> no.

%% make_effect_seq([Expr], Sub) -> #c_seq{}|void()
%%  Convert a list of expressions evaluated in effect context to a chain of
%%  #c_seq{}. The body in the innermost #c_seq{} will be void().
%%  Anything that will not have any effect will be thrown away.

make_effect_seq([H|T], Sub) ->
    case is_safe_simple(H, Sub) of
	true -> make_effect_seq(T, Sub);
	false -> #c_seq{arg=H,body=make_effect_seq(T, Sub)}
    end;
make_effect_seq([], _) -> void().

%% Handling remote calls. The module/name fields have been processed.

call(#c_call{args=As}=Call, #c_literal{val=M}=M0, #c_literal{val=N}=N0, Sub) ->
    case get(no_inline_list_funcs) of
  	true ->
 	    call_0(Call, M0, N0, As, Sub);
  	false ->
  	    call_1(Call, M, N, As, Sub)
      end;
call(#c_call{args=As}=Call, M, N, Sub) ->
    call_0(Call, M, N, As, Sub).

call_0(Call, M, N, As0, Sub) ->
    As1 = expr_list(As0, value, Sub),
    fold_call(Call#c_call{args=As1}, M, N, As1, Sub).

%% We inline some very common higher order list operations.
%% We use the same evaluation order as the library function.

call_1(#c_call{anno=Anno}, lists, all, [Arg1,Arg2], Sub) ->
    Loop = #c_var{name={'lists^all',1}},
    F = #c_var{name='F'},
    Xs = #c_var{name='Xs'},
    X = #c_var{name='X'},
    Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]},
    CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true},
		    body=#c_apply{anno=Anno, op=Loop, args=[Xs]}},
    CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
		    body=#c_literal{val=false}},
    CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
		    body=match_fail(Anno, Err1)},
    C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
		   body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]},
				clauses = [CC1, CC2, CC3]}},
    C2 = #c_clause{pats=[#c_literal{val=[]}],
		   guard=#c_call{module=#c_literal{val=erlang},
				 name=#c_literal{val=is_function},
				 args=[F, #c_literal{val=1}]},
		   body=#c_literal{val=true}},
    Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
    C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
		   body=match_fail([{function_name,{'lists^all',1}}|Anno], Err2)},
    Fun = #c_fun{vars=[Xs],
		 body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
    L = #c_var{name='L'},
    expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
		body=#c_letrec{defs=[{Loop,Fun}],
			       body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
	 Sub);
call_1(#c_call{anno=Anno}, lists, any, [Arg1,Arg2], Sub) ->
    Loop = #c_var{name={'lists^any',1}},
    F = #c_var{name='F'},
    Xs = #c_var{name='Xs'},
    X = #c_var{name='X'},
    Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]},
    CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true},
		    body=#c_literal{val=true}},
    CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
		    body=#c_apply{anno=Anno, op=Loop, args=[Xs]}},
    CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
		    body=match_fail(Anno, Err1)},
    C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
		   body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]},
				clauses = [CC1, CC2, CC3]}},
    C2 = #c_clause{pats=[#c_literal{val=[]}],
		   guard=#c_call{module=#c_literal{val=erlang},
				 name=#c_literal{val=is_function},
				 args=[F, #c_literal{val=1}]},
		   body=#c_literal{val=false}},
    Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
    C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
		   body=match_fail([{function_name,{'lists^any',1}}|Anno], Err2)},
    Fun = #c_fun{vars=[Xs],
		 body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
    L = #c_var{name='L'},
    expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
		body=#c_letrec{defs=[{Loop,Fun}],
			       body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
	 Sub);
call_1(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2], Sub) ->
    Loop = #c_var{name={'lists^foreach',1}},
    F = #c_var{name='F'},
    Xs = #c_var{name='Xs'},
    X = #c_var{name='X'},
    C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
		   body=#c_seq{arg=#c_apply{anno=Anno, op=F, args=[X]},
			       body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}},
    C2 = #c_clause{pats=[#c_literal{val=[]}],
		   guard=#c_call{module=#c_literal{val=erlang},
				 name=#c_literal{val=is_function},
				 args=[F, #c_literal{val=1}]},
		   body=#c_literal{val=ok}},
    Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
    C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
		   body=match_fail([{function_name,{'lists^foreach',1}}|Anno], Err)},
    Fun = #c_fun{vars=[Xs],
		 body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
    L = #c_var{name='L'},
    expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
		body=#c_letrec{defs=[{Loop,Fun}],
			       body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
	 Sub);
call_1(#c_call{anno=Anno}, lists, map, [Arg1,Arg2], Sub) ->
    Loop = #c_var{name={'lists^map',1}},
    F = #c_var{name='F'},
    Xs = #c_var{name='Xs'},
    X = #c_var{name='X'},
    H = #c_var{name='H'},
    C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
		   body=#c_let{vars=[H], arg=#c_apply{anno=Anno,
						      op=F,
						      args=[X]},
			       body=#c_cons{hd=H,
					    anno=[compiler_generated],
					    tl=#c_apply{anno=Anno,
							op=Loop,
							args=[Xs]}}}},
    C2 = #c_clause{pats=[#c_literal{val=[]}],
		   guard=#c_call{module=#c_literal{val=erlang},
				 name=#c_literal{val=is_function},
				 args=[F, #c_literal{val=1}]},
		   body=#c_literal{val=[]}},
    Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
    C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
		   body=match_fail([{function_name,{'lists^map',1}}|Anno], Err)},
    Fun = #c_fun{vars=[Xs],
		 body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
    L = #c_var{name='L'},
    expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
		body=#c_letrec{defs=[{Loop,Fun}],
			       body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
	 Sub);
call_1(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2], Sub) ->
    Loop = #c_var{name={'lists^flatmap',1}},
    F = #c_var{name='F'},
    Xs = #c_var{name='Xs'},
    X = #c_var{name='X'},
    H = #c_var{name='H'},
    C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
		   body=#c_let{vars=[H],
			       arg=#c_apply{anno=Anno, op=F, args=[X]},
			       body=#c_call{anno=[compiler_generated|Anno],
					    module=#c_literal{val=erlang},
					    name=#c_literal{val='++'},
					    args=[H,
						  #c_apply{anno=Anno,
							   op=Loop,
							   args=[Xs]}]}}},
    C2 = #c_clause{pats=[#c_literal{val=[]}],
		   guard=#c_call{module=#c_literal{val=erlang},
				 name=#c_literal{val=is_function},
				 args=[F, #c_literal{val=1}]},
		   body=#c_literal{val=[]}},
    Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
    C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
		   body=match_fail([{function_name,{'lists^flatmap',1}}|Anno], Err)},
    Fun = #c_fun{vars=[Xs],
		 body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
    L = #c_var{name='L'},
    expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
		body=#c_letrec{defs=[{Loop,Fun}],
			       body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
	 Sub);
call_1(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2], Sub) ->
    Loop = #c_var{name={'lists^filter',1}},
    F = #c_var{name='F'},
    Xs = #c_var{name='Xs'},
    X = #c_var{name='X'},
    B = #c_var{name='B'},
    Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]},
    CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true},
		    body=#c_cons{anno=[compiler_generated], hd=X, tl=Xs}},
    CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
		    body=Xs},
    CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
		    body=match_fail(Anno, Err1)},
    Case = #c_case{arg=B, clauses = [CC1, CC2, CC3]},
    C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
		   body=#c_let{vars=[B],
			       arg=#c_apply{anno=Anno, op=F, args=[X]},
			       body=#c_let{vars=[Xs],
					   arg=#c_apply{anno=Anno,
							op=Loop,
							args=[Xs]},
					   body=Case}}},
    C2 = #c_clause{pats=[#c_literal{val=[]}],
		   guard=#c_call{module=#c_literal{val=erlang},
				 name=#c_literal{val=is_function},
				 args=[F, #c_literal{val=1}]},
		   body=#c_literal{val=[]}},
    Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
    C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
		   body=match_fail([{function_name,{'lists^filter',1}}|Anno], Err2)},
    Fun = #c_fun{vars=[Xs],
		 body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
    L = #c_var{name='L'},
    expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
		body=#c_letrec{defs=[{Loop,Fun}],
			       body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
    Sub);
call_1(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3], Sub) ->
    Loop = #c_var{name={'lists^foldl',2}},
    F = #c_var{name='F'},
    Xs = #c_var{name='Xs'},
    X = #c_var{name='X'},
    A = #c_var{name='A'},
    C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
		   body=#c_apply{anno=Anno,
				 op=Loop,
				 args=[Xs, #c_apply{anno=Anno,
						    op=F,
						    args=[X, A]}]}},
    C2 = #c_clause{pats=[#c_literal{val=[]}],
		   guard=#c_call{module=#c_literal{val=erlang},
				 name=#c_literal{val=is_function},
				 args=[F, #c_literal{val=2}]},
		   body=A},
    Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]},
    C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
		   body=match_fail([{function_name,{'lists^foldl',2}}|Anno], Err)},
    Fun = #c_fun{vars=[Xs, A],
		 body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
    L = #c_var{name='L'},
    expr(#c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
		body=#c_letrec{defs=[{Loop,Fun}],
			       body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}},
	 Sub);
call_1(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3], Sub) ->
    Loop = #c_var{name={'lists^foldr',2}},
    F = #c_var{name='F'},
    Xs = #c_var{name='Xs'},
    X = #c_var{name='X'},
    A = #c_var{name='A'},
    C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
		   body=#c_apply{anno=Anno,
				 op=F,
				 args=[X, #c_apply{anno=Anno,
						   op=Loop,
						   args=[Xs, A]}]}},
    C2 = #c_clause{pats=[#c_literal{val=[]}],
		   guard=#c_call{module=#c_literal{val=erlang},
				 name=#c_literal{val=is_function},
				 args=[F, #c_literal{val=2}]},
		   body=A},
    Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]},
    C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
		   body=match_fail([{function_name,{'lists^foldr',2}}|Anno], Err)},
    Fun = #c_fun{vars=[Xs, A],
		 body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
    L = #c_var{name='L'},
    expr(#c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
		body=#c_letrec{defs=[{Loop,Fun}],
			       body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}},
	 Sub);
call_1(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3], Sub) ->
    Loop = #c_var{name={'lists^mapfoldl',2}},
    F = #c_var{name='F'},
    Xs = #c_var{name='Xs'},
    X = #c_var{name='X'},
    Avar = #c_var{name='A'},
    Match =
	fun (A, P, E) ->
		C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E},
		Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]},
		C2 = #c_clause{pats=[X], guard=#c_literal{val=true},
			       body=match_fail(Anno, Err)},
		#c_case{arg=A, clauses=[C1, C2]}
	end,
    C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
		   body=Match(#c_apply{anno=Anno, op=F, args=[X, Avar]},
			      #c_tuple{es=[X, Avar]},
%%% Tuple passing version
			      Match(#c_apply{anno=Anno,
					     op=Loop,
					     args=[Xs, Avar]},
				    #c_tuple{es=[Xs, Avar]},
				    #c_tuple{anno=[compiler_generated],
					     es=[#c_cons{anno=[compiler_generated],
							 hd=X, tl=Xs},
						 Avar]})
%%% Multiple-value version
%%% 			      #c_let{vars=[Xs,A],
%%% 				     %% The tuple here will be optimised
%%% 				     %% away later; no worries.
%%% 				     arg=#c_apply{op=Loop, args=[Xs, A]},
%%% 				     body=#c_values{es=[#c_cons{hd=X, tl=Xs},
%%% 							A]}}
			     )},
    C2 = #c_clause{pats=[#c_literal{val=[]}],
		   guard=#c_call{module=#c_literal{val=erlang},
				 name=#c_literal{val=is_function},
				 args=[F, #c_literal{val=2}]},
%%% Tuple passing version
		   body=#c_tuple{anno=[compiler_generated],
				 es=[#c_literal{val=[]}, Avar]}},
%%% Multiple-value version
%%% 		   body=#c_values{es=[#c_literal{val=[]}, A]}},
    Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]},
    C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
		   body=match_fail([{function_name,{'lists^mapfoldl',2}}|Anno], Err)},
    Fun = #c_fun{vars=[Xs, Avar],
		 body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
    L = #c_var{name='L'},
    expr(#c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
		body=#c_letrec{defs=[{Loop,Fun}],
%%% Tuple passing version
			       body=#c_apply{anno=Anno,
					     op=Loop,
					     args=[L, Avar]}}},
%%% Multiple-value version
%%% 			       body=#c_let{vars=[Xs, A],
%%% 					   arg=#c_apply{op=Loop,
%%% 							args=[L, A]},
%%% 					   body=#c_tuple{es=[Xs, A]}}}},
	 Sub);
call_1(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) ->
    Loop = #c_var{name={'lists^mapfoldr',2}},
    F = #c_var{name='F'},
    Xs = #c_var{name='Xs'},
    X = #c_var{name='X'},
    Avar = #c_var{name='A'},
    Match =
	fun (A, P, E) ->
		C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E},
		Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]},
		C2 = #c_clause{pats=[X], guard=#c_literal{val=true},
			       body=match_fail(Anno, Err)},
		#c_case{arg=A, clauses=[C1, C2]}
	end,
    C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
%%% Tuple passing version
		   body=Match(#c_apply{anno=Anno,
				       op=Loop,
				       args=[Xs, Avar]},
			      #c_tuple{es=[Xs, Avar]},
			      Match(#c_apply{anno=Anno, op=F, args=[X, Avar]},
				    #c_tuple{es=[X, Avar]},
				    #c_tuple{anno=[compiler_generated],
					     es=[#c_cons{anno=[compiler_generated],
							 hd=X, tl=Xs}, Avar]}))
%%% Multiple-value version
%%% 		   body=#c_let{vars=[Xs,A],
%%% 			       %% The tuple will be optimised away
%%% 			       arg=#c_apply{op=Loop, args=[Xs, A]},
%%% 			       body=Match(#c_apply{op=F, args=[X, A]},
%%% 					  #c_tuple{es=[X, A]},
%%% 					  #c_values{es=[#c_cons{hd=X, tl=Xs},
%%% 						        A]})}
		  },
    C2 = #c_clause{pats=[#c_literal{val=[]}],
		   guard=#c_call{module=#c_literal{val=erlang},
				 name=#c_literal{val=is_function},
				 args=[F, #c_literal{val=2}]},
%%% Tuple passing version
		   body=#c_tuple{anno=[compiler_generated],
				 es=[#c_literal{val=[]}, Avar]}},
%%% Multiple-value version
%%% 		   body=#c_values{es=[#c_literal{val=[]}, A]}},
    Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]},
    C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
		   body=match_fail([{function_name,{'lists^mapfoldr',2}}|Anno], Err)},
    Fun = #c_fun{vars=[Xs, Avar],
		 body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
    L = #c_var{name='L'},
    expr(#c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
		body=#c_letrec{defs=[{Loop,Fun}],
%%% Tuple passing version
			       body=#c_apply{anno=Anno,
					     op=Loop,
					     args=[L, Avar]}}},
%%% Multiple-value version
%%% 			       body=#c_let{vars=[Xs, A],
%%% 					   arg=#c_apply{op=Loop,
%%% 							args=[L, A]},
%%% 					   body=#c_tuple{es=[Xs, A]}}}},
	 Sub);
call_1(#c_call{module=M, name=N}=Call, _, _, As, Sub) ->
    call_0(Call, M, N, As, Sub).

match_fail(Anno, Arg) ->
    #c_primop{anno=Anno,
	      name=#c_literal{val='match_fail'},
	      args=[Arg]}.

%% fold_call(Call, Mod, Name, Args, Sub) -> Expr.
%%  Try to safely evaluate the call.  Just try to evaluate arguments,
%%  do the call and convert return values to literals.  If this
%%  succeeds then use the new value, otherwise just fail and use
%%  original call.  Do this at every level.
%%
%%  We attempt to evaluate calls to certain BIFs even if the
%%  arguments are not literals. For instance, we evaluate length/1
%%  if the shape of the list is known, and element/2 and setelement/3
%%  if the position is constant and the shape of the tuple is known.
%%
fold_call(Call, #c_literal{val=M}, #c_literal{val=F}, Args, Sub) ->
    fold_call_1(Call, M, F, Args, Sub);
fold_call(Call, _M, _N, _Args, _Sub) -> Call.

fold_call_1(Call, erlang, apply, [Mod,Func,Args], _) ->
    simplify_apply(Call, Mod, Func, Args);
fold_call_1(Call, Mod, Name, Args, Sub) ->
    NumArgs = length(Args),
    case erl_bifs:is_pure(Mod, Name, NumArgs) of
	false -> Call;				%Not pure - keep call.
	true -> fold_call_2(Call, Mod, Name, Args, Sub)
    end.

fold_call_2(Call, Module, Name, Args0, Sub) ->
    try
	Args = [core_lib:literal_value(A) || A <- Args0],
	try apply(Module, Name, Args) of
	    Val ->
		case cerl:is_literal_term(Val) of
		    true ->
			#c_literal{val=Val};
		    false ->
			%% Successful evaluation, but it was not
			%% possible to express the computed value as a literal.
			Call
		end
	catch
	    error:Reason ->
		%% Evaluation of the function failed. Warn and replace
		%% the call with a call to erlang:error/1.
		eval_failure(Call, Reason)
	end
    catch
	error:_ ->
	    %% There was at least one non-literal argument.
	    fold_non_lit_args(Call, Module, Name, Args0, Sub)
    end.

%% fold_non_lit_args(Call, Module, Name, Args, Sub) -> Expr.
%%  Attempt to evaluate some pure BIF calls with one or more
%%  non-literals arguments.
%%
fold_non_lit_args(Call, erlang, is_boolean, [Arg], Sub) ->
    eval_is_boolean(Call, Arg, Sub);
fold_non_lit_args(Call, erlang, element, [Arg1,Arg2], Sub) ->
    eval_element(Call, Arg1, Arg2, Sub);
fold_non_lit_args(Call, erlang, length, [Arg], _) ->
    eval_length(Call, Arg);
fold_non_lit_args(Call, erlang, '++', [Arg1,Arg2], _) ->
    eval_append(Call, Arg1, Arg2);
fold_non_lit_args(Call, lists, append, [Arg1,Arg2], _) ->
    eval_append(Call, Arg1, Arg2);
fold_non_lit_args(Call, erlang, setelement, [Arg1,Arg2,Arg3], _) ->
    eval_setelement(Call, Arg1, Arg2, Arg3);
fold_non_lit_args(Call, erlang, is_record, [Arg1,Arg2,Arg3], Sub) ->
    eval_is_record(Call, Arg1, Arg2, Arg3, Sub);
fold_non_lit_args(Call, erlang, N, Args, Sub) ->
    NumArgs = length(Args),
    case erl_internal:comp_op(N, NumArgs) of
	true ->
	    eval_rel_op(Call, N, Args, Sub);
	false ->
	    case erl_internal:bool_op(N, NumArgs) of
		true ->
		    eval_bool_op(Call, N, Args, Sub);
		false ->
		    Call
	    end
    end;
fold_non_lit_args(Call, _, _, _, _) -> Call.

%% Evaluate a relational operation using type information.
eval_rel_op(Call, Op, [#c_var{name=V},#c_var{name=V}], _) ->
    Bool = erlang:Op(same, same),
    #c_literal{anno=core_lib:get_anno(Call),val=Bool};
eval_rel_op(Call, '=:=', [#c_var{name=V}=Var,#c_literal{val=true}], Sub) ->
    %% BoolVar =:= true  ==>  BoolVar
    case is_boolean_type(V, Sub) of
	true -> Var;
	false -> Call
    end;
eval_rel_op(Call, '==', Ops, _Sub) ->
    case is_exact_eq_ok(Ops) of
	true ->
	    Name = #c_literal{anno=core_lib:get_anno(Call),val='=:='},
	    Call#c_call{name=Name};
	false ->
	    Call
    end;
eval_rel_op(Call, '/=', Ops, _Sub) ->
    case is_exact_eq_ok(Ops) of
	true ->
	    Name = #c_literal{anno=core_lib:get_anno(Call),val='=/='},
	    Call#c_call{name=Name};
	false ->
	    Call
    end;
eval_rel_op(Call, _, _, _) -> Call.

is_exact_eq_ok([#c_literal{val=Lit}|_]) ->
    is_non_numeric(Lit);
is_exact_eq_ok([_|T]) ->
    is_exact_eq_ok(T);
is_exact_eq_ok([]) -> false.

is_non_numeric([H|T]) ->
    is_non_numeric(H) andalso is_non_numeric(T);
is_non_numeric(Tuple) when is_tuple(Tuple) ->
    is_non_numeric_tuple(Tuple, tuple_size(Tuple));
is_non_numeric(Num) when is_number(Num) ->
    false;
is_non_numeric(_) -> true.

is_non_numeric_tuple(Tuple, El) when El >= 1 ->
    is_non_numeric(element(El, Tuple)) andalso
	is_non_numeric_tuple(Tuple, El-1);
is_non_numeric_tuple(_Tuple, 0) -> true.

%% Evaluate a bool op using type information. We KNOW that
%% there must be at least one non-literal argument (i.e.
%% there is no need to handle the case that all argments
%% are literal).
eval_bool_op(Call, 'and', [#c_literal{val=true},#c_var{name=V}=Res], Sub) ->
    case is_boolean_type(V, Sub) of
	true -> Res;
	false-> Call
    end;
eval_bool_op(Call, 'and', [#c_var{name=V}=Res,#c_literal{val=true}], Sub) ->
    case is_boolean_type(V, Sub) of
	true -> Res;
	false-> Call
    end;
eval_bool_op(Call, 'and', [#c_literal{val=false}=Res,#c_var{name=V}], Sub) ->
    case is_boolean_type(V, Sub) of
	true -> Res;
	false-> Call
    end;
eval_bool_op(Call, 'and', [#c_var{name=V},#c_literal{val=false}=Res], Sub) ->
    case is_boolean_type(V, Sub) of
	true -> Res;
	false-> Call
    end;
eval_bool_op(Call, _, _, _) -> Call.

%% Evaluate is_boolean/1 using type information.
eval_is_boolean(Call, #c_var{name=V}, Sub) ->
    case is_boolean_type(V, Sub) of
	true -> #c_literal{val=true};
	false -> Call
    end;
eval_is_boolean(_, #c_cons{}, _) ->
    #c_literal{val=false};
eval_is_boolean(_, #c_tuple{}, _) ->
    #c_literal{val=false};
eval_is_boolean(Call, _, _) ->
    Call.

%% eval_length(Call, List) -> Val.
%%  Evaluates the length for the prefix of List which has a known
%%  shape.
%%
eval_length(Call, Core) -> eval_length(Call, Core, 0).

eval_length(Call, #c_literal{val=Val}, Len0) ->
    try
	Len = Len0 + length(Val),
	#c_literal{anno=Call#c_call.anno,val=Len}
    catch
	_:_ ->
	    eval_failure(Call, badarg)
    end;
eval_length(Call, #c_cons{tl=T}, Len) ->
    eval_length(Call, T, Len+1);
eval_length(Call, _List, 0) ->
    Call;		%Could do nothing
eval_length(Call, List, Len) ->
    A = Call#c_call.anno,
    #c_call{anno=A,
	    module=#c_literal{anno=A,val=erlang},
	    name=#c_literal{anno=A,val='+'},
	    args=[#c_literal{anno=A,val=Len},Call#c_call{args=[List]}]}.

%% eval_append(Call, FirstList, SecondList) -> Val.
%%  Evaluates the constant part of '++' expression.
%%
eval_append(Call, #c_literal{val=Cs1}=S1, #c_literal{val=Cs2}) ->
    try
	S1#c_literal{val=Cs1 ++ Cs2}
    catch error:badarg ->
	    eval_failure(Call, badarg)
    end;
eval_append(Call, #c_literal{val=Cs}, List) when length(Cs) =< 4 ->
    Anno = Call#c_call.anno,
    foldr(fun (C, L) ->
		  ann_c_cons(Anno, #c_literal{val=C}, L)
	  end, List, Cs);
eval_append(Call, #c_cons{anno=Anno,hd=H,tl=T}, List) ->
    ann_c_cons(Anno, H, eval_append(Call, T, List));
eval_append(Call, X, Y) ->
    Call#c_call{args=[X,Y]}.			%Rebuild call arguments.

%% eval_element(Call, Pos, Tuple, Types) -> Val.
%%  Evaluates element/2 if the position Pos is a literal and
%%  the shape of the tuple Tuple is known.
%%
eval_element(Call, #c_literal{val=Pos}, #c_tuple{es=Es}, _Types) when is_integer(Pos) ->
    if
	1 =< Pos, Pos =< length(Es) ->
	    lists:nth(Pos, Es);
	true ->
	    eval_failure(Call, badarg)
    end;
eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types)
  when is_integer(Pos) ->
    case orddict:find(V, Types#sub.t) of
	{ok,#c_tuple{es=Elements}} ->
	    if
		1 =< Pos, Pos =< length(Elements) ->
		    case lists:nth(Pos, Elements) of
			#c_alias{var=Alias} -> Alias;
			Res -> Res
		    end;
		true ->
		    eval_failure(Call, badarg)
	    end;
	{ok,_} ->
	    eval_failure(Call, badarg);
	error ->
	    Call
    end;
eval_element(Call, Pos, Tuple, _Types) ->
    case is_not_integer(Pos) orelse is_not_tuple(Tuple) of
	true ->
	    eval_failure(Call, badarg);
	false ->
	    Call
    end.

%% eval_is_record(Call, Var, Tag, Size, Types) -> Val.
%%  Evaluates is_record/3 using type information.
%%
eval_is_record(Call, #c_var{name=V}, #c_literal{val=NeededTag}=Lit,
	       #c_literal{val=Size}, Types) ->
    case orddict:find(V, Types#sub.t) of
	{ok,#c_tuple{es=[#c_literal{val=Tag}|_]=Es}} ->
	    Lit#c_literal{val=Tag =:= NeededTag andalso
			  length(Es) =:= Size};
	_ ->
	    Call
    end;
eval_is_record(Call, _, _, _, _) -> Call.

%% is_not_integer(Core) -> true | false.
%%  Returns true if Core is definitely not an integer.

is_not_integer(#c_literal{val=Val}) when not is_integer(Val) -> true;
is_not_integer(#c_tuple{}) -> true;
is_not_integer(#c_cons{}) -> true;
is_not_integer(_) -> false.

%% is_not_tuple(Core) -> true | false.
%%  Returns true if Core is definitely not a tuple.

is_not_tuple(#c_literal{val=Val}) when not is_tuple(Val) -> true;
is_not_tuple(#c_cons{}) -> true;
is_not_tuple(_) -> false.

%% eval_setelement(Call, Pos, Tuple, NewVal) -> Core.
%%  Evaluates setelement/3 if position Pos is an integer
%%  the shape of the tuple Tuple is known.
%%
eval_setelement(Call, Pos, Tuple, NewVal) ->
    try
	eval_setelement_1(Pos, Tuple, NewVal)
    catch
	error:_ ->
	    Call
    end.

eval_setelement_1(#c_literal{val=Pos}, #c_tuple{anno=A,es=Es}, NewVal)
  when is_integer(Pos) ->
    ann_c_tuple(A, eval_setelement_2(Pos, Es, NewVal));
eval_setelement_1(#c_literal{val=Pos}, #c_literal{anno=A,val=Es0}, NewVal)
  when is_integer(Pos) ->
    Es = [#c_literal{anno=A,val=E} || E <- tuple_to_list(Es0)],
    ann_c_tuple(A, eval_setelement_2(Pos, Es, NewVal)).

eval_setelement_2(1, [_|T], NewVal) ->
    [NewVal|T];
eval_setelement_2(Pos, [H|T], NewVal) when Pos > 1 ->
    [H|eval_setelement_2(Pos-1, T, NewVal)].

%% eval_failure(Call, Reason) -> Core.
%%  Warn for a call that will fail and replace the call with
%%  a call to erlang:error(Reason).
%%
eval_failure(Call, Reason) ->
    add_warning(Call, {eval_failure,Reason}),
    Call#c_call{module=#c_literal{val=erlang},
		name=#c_literal{val=error},
		args=[#c_literal{val=Reason}]}.

%% simplify_apply(Call0, Mod, Func, Args) -> Call
%%  Simplify an apply/3 to a call if the number of arguments
%%  are known at compile time.

simplify_apply(Call, Mod, Func, Args) ->
    case is_atom_or_var(Mod) andalso is_atom_or_var(Func) of
	true -> simplify_apply_1(Args, Call, Mod, Func, []);
	false -> Call
    end.

simplify_apply_1(#c_literal{val=MoreArgs0}, Call, Mod, Func, Args)
  when length(MoreArgs0) >= 0 ->
    MoreArgs = [#c_literal{val=Arg} || Arg <- MoreArgs0],
    Call#c_call{module=Mod,name=Func,args=reverse(Args, MoreArgs)};
simplify_apply_1(#c_cons{hd=Arg,tl=T}, Call, Mod, Func, Args) ->
    simplify_apply_1(T, Call, Mod, Func, [Arg|Args]);
simplify_apply_1(_, Call, _, _, _) -> Call.

is_atom_or_var(#c_literal{val=Atom}) when is_atom(Atom) -> true;
is_atom_or_var(#c_var{}) -> true;
is_atom_or_var(_) -> false.

%% clause(Clause, Cepxr, Context, Sub) -> Clause.

clause(#c_clause{pats=Ps0,guard=G0,body=B0}=Cl, Cexpr, Ctxt, Sub0) ->
    {Ps1,Sub1} = pattern_list(Ps0, Sub0),
    Sub2 = update_types(Cexpr, Ps1, Sub1),
    GSub = case {Cexpr,Ps1} of
	       {#c_var{name='_'},_} ->
		   %% In a 'receive', Cexpr is the variable '_', which represents the
		   %% message being matched. We must NOT do any extra substiutions.
		   Sub2;
	       {#c_var{},[#c_var{}=Var]} ->
		   %% The idea here is to optimize expressions such as
		   %%
		   %%   case A of A -> ...
		   %%
		   %% to get rid of the extra guard test that the compiler
		   %% added when converting to the Core Erlang representation:
		   %%
		   %%   case A of NewVar when A =:= NewVar -> ...
		   %%
		   %% By replacing NewVar with A everywhere in the guard
		   %% expression, we get
		   %%
		   %%   case A of NewVar when A =:= A -> ...
		   %%
		   %% which by constant-expression evaluation is reduced to
		   %%
		   %%   case A of NewVar when true -> ...
		   %%
		   sub_set_var(Var, Cexpr, Sub2);
	       _ ->
		   Sub2
	   end,
    G1 = guard(G0, GSub),
    B1 = body(B0, Ctxt, Sub2),
    Cl#c_clause{pats=Ps1,guard=G1,body=B1}.

%% let_substs(LetVars, LetArg, Sub) -> {[Var],[Val],Sub}.
%%  Add suitable substitutions to Sub of variables in LetVars.  First
%%  remove variables in LetVars from Sub, then fix subs.  N.B. must
%%  work out new subs in parallel and then apply them to subs.  Return
%%  the unsubstituted variables and values.

let_substs(Vs0, As0, Sub0) ->
    {Vs1,Sub1} = pattern_list(Vs0, Sub0),
    {Vs2,As1,Ss} = let_substs_1(Vs1, As0, Sub1),
    Sub2 = scope_add([V || #c_var{name=V} <- Vs2], Sub1),
    {Vs2,As1,
     foldl(fun ({V,S}, Sub) -> sub_set_name(V, S, Sub) end, Sub2, Ss)}.

let_substs_1(Vs, #c_values{es=As}, Sub) ->
    let_subst_list(Vs, As, Sub);
let_substs_1([V], A, Sub) -> let_subst_list([V], [A], Sub);
let_substs_1(Vs, A, _) -> {Vs,A,[]}.

let_subst_list([V|Vs0], [A|As0], Sub) ->
    {Vs1,As1,Ss} = let_subst_list(Vs0, As0, Sub),
    case is_subst(A) of
	true -> {Vs1,As1,sub_subst_var(V, A, Sub) ++ Ss};
	false -> {[V|Vs1],[A|As1],Ss}
    end;
let_subst_list([], [], _) -> {[],[],[]}.

%% pattern(Pattern, InSub) -> {Pattern,OutSub}.
%% pattern(Pattern, InSub, OutSub) -> {Pattern,OutSub}.
%%  Variables occurring in Pattern will shadow so they must be removed
%%  from Sub.  If they occur as a value in Sub then we create a new
%%  variable and then add a substitution for that.
%%
%%  Patterns are complicated by sizes in binaries.  These are pure
%%  input variables which create no bindings.  We, therefore, need to
%%  carry around the original substitutions to get the correct
%%  handling.

%%pattern(Pat, Sub) -> pattern(Pat, Sub, Sub).

pattern(#c_var{}=Pat, Isub, Osub) ->
    case sub_is_val(Pat, Isub) of
	true ->
	    V1 = make_var_name(),
	    Pat1 = #c_var{name=V1},
	    {Pat1,sub_set_var(Pat, Pat1, scope_add([V1], Osub))};
	false ->
	    {Pat,sub_del_var(Pat, Osub)}
    end;
pattern(#c_literal{}=Pat, _, Osub) -> {Pat,Osub};
pattern(#c_cons{anno=Anno,hd=H0,tl=T0}, Isub, Osub0) ->
    {H1,Osub1} = pattern(H0, Isub, Osub0),
    {T1,Osub2} = pattern(T0, Isub, Osub1),
    {ann_c_cons(Anno, H1, T1),Osub2};
pattern(#c_tuple{anno=Anno,es=Es0}, Isub, Osub0) ->
    {Es1,Osub1} = pattern_list(Es0, Isub, Osub0),
    {ann_c_tuple(Anno, Es1),Osub1};
pattern(#c_map{anno=Anno,es=Es0}=Map, Isub, Osub0) ->
    {Es1,Osub1} = map_pair_pattern_list(Es0, Isub, Osub0),
    {Map#c_map{anno=Anno,es=Es1},Osub1};
pattern(#c_binary{segments=V0}=Pat, Isub, Osub0) ->
    {V1,Osub1} = bin_pattern_list(V0, Isub, Osub0),
    {Pat#c_binary{segments=V1},Osub1};
pattern(#c_alias{var=V0,pat=P0}=Pat, Isub, Osub0) ->
    {V1,Osub1} = pattern(V0, Isub, Osub0),
    {P1,Osub2} = pattern(P0, Isub, Osub1),
    Osub = update_types(V1, [P1], Osub2),
    {Pat#c_alias{var=V1,pat=P1},Osub}.

map_pair_pattern_list(Ps0, Isub, Osub0) ->
    {Ps,{_,Osub}} = mapfoldl(fun map_pair_pattern/2, {Isub,Osub0}, Ps0),
    {Ps,Osub}.

map_pair_pattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,{Isub,Osub0}) ->
    {K,Osub1} = case cerl:type(K0) of
	binary ->
	    K1 = eval_binary(K0),
	    case cerl:type(K1) of
		literal -> {K1,Osub0};
		_ -> pattern(K0,Isub,Osub0)
	    end;
	_ -> pattern(K0,Isub,Osub0)
    end,
    {V,Osub} = pattern(V0,Isub,Osub1),
    {Pair#c_map_pair{key=K,val=V},{Isub,Osub}}.

bin_pattern_list(Ps0, Isub, Osub0) ->
    {Ps,{_,Osub}} = mapfoldl(fun bin_pattern/2, {Isub,Osub0}, Ps0),
    {Ps,Osub}.

bin_pattern(#c_bitstr{val=E0,size=Size0}=Pat, {Isub0,Osub0}) ->
    Size1 = expr(Size0, Isub0),
    {E1,Osub} = pattern(E0, Isub0, Osub0),
    Isub = case E0 of
	       #c_var{} -> sub_set_var(E0, E1, Isub0);
	       _ -> Isub0
	   end,
    {Pat#c_bitstr{val=E1,size=Size1},{Isub,Osub}}.

pattern_list(Ps, Sub) -> pattern_list(Ps, Sub, Sub).

pattern_list(Ps0, Isub, Osub0) ->
    mapfoldl(fun (P, Osub) -> pattern(P, Isub, Osub) end, Osub0, Ps0).

%% is_subst(Expr) -> true | false.
%%  Test whether an expression is a suitable substitution.

is_subst(#c_var{name={_,_}}) ->
    %% Funs must not be duplicated (which will happen if the variable
    %% is used more than once), because the funs will not be equal
    %% (their "index" fields will be different).
    false;
is_subst(#c_var{}) -> true;
is_subst(#c_literal{}) -> true;
is_subst(_) -> false.

%% sub_new() -> #sub{}.
%% sub_get_var(Var, #sub{}) -> Value.
%% sub_set_var(Var, Value, #sub{}) -> #sub{}.
%% sub_set_name(Name, Value, #sub{}) -> #sub{}.
%% sub_del_var(Var, #sub{}) -> #sub{}.
%% sub_subst_var(Var, Value, #sub{}) -> [{Name,Value}].
%% sub_is_val(Var, #sub{}) -> boolean().
%% sub_subst_scope(#sub{}) -> #sub{}
%%
%%  We use the variable name as key so as not have problems with
%%  annotations.  When adding a new substitute we fold substitute
%%  chains so we never have to search more than once.  Use orddict so
%%  we know the format.
%%
%%  In addition to the list of substitutions, we also keep track of
%%  all variable currently live (the scope).
%%
%%  sub_subst_scope/1 adds dummy substitutions for all variables
%%  in the scope in order to force renaming if variables in the
%%  scope occurs as pattern variables.

sub_new() -> #sub{v=orddict:new(),s=gb_trees:empty(),t=[]}.

sub_new(#sub{}=Sub) ->
    Sub#sub{v=orddict:new(),t=[]}.

sub_new_preserve_types(#sub{}=Sub) ->
    Sub#sub{v=orddict:new()}.

sub_get_var(#c_var{name=V}=Var, #sub{v=S}) ->
    case orddict:find(V, S) of
	{ok,Val} -> Val;
	error -> Var
    end.

sub_set_var(#c_var{name=V}, Val, Sub) ->
    sub_set_name(V, Val, Sub).

sub_set_name(V, Val, #sub{v=S,s=Scope,t=Tdb0}=Sub) ->
    Tdb1 = kill_types(V, Tdb0),
    Tdb = copy_type(V, Val, Tdb1),
    Sub#sub{v=orddict:store(V, Val, S),s=gb_sets:add(V, Scope),t=Tdb}.

sub_del_var(#c_var{name=V}, #sub{v=S,s=Scope,t=Tdb}=Sub) ->
    %% Profiling shows that for programs with many record operations,
    %% sub_del_var/2 is a bottleneck. Since the scope contains all
    %% variables that are live, we know that V cannot be present in S
    %% if it is not in the scope.
    case gb_sets:is_member(V, Scope) of
	false ->
	    Sub#sub{s=gb_sets:insert(V, Scope)};
	true ->
	    Sub#sub{v=orddict:erase(V, S),t=kill_types(V, Tdb)}
    end.

sub_subst_var(#c_var{name=V}, Val, #sub{v=S0}) ->
    %% Fold chained substitutions.
    [{V,Val}] ++ [ {K,Val} || {K,#c_var{name=V1}} <- S0, V1 =:= V].

sub_subst_scope(#sub{v=S0,s=Scope}=Sub) ->
    S = [{-1,#c_var{name=Sv}} || Sv <- gb_sets:to_list(Scope)]++S0,
    Sub#sub{v=S}.

sub_is_val(#c_var{name=V}, #sub{v=S,s=Scope}) ->
    %% When the bottleneck in sub_del_var/2 was eliminated, this
    %% became the new bottleneck. Since the scope contains all
    %% live variables, a variable V can only be the target for
    %% a substitution if it is in the scope.
    gb_sets:is_member(V, Scope) andalso v_is_value(V, S).

v_is_value(Var, [{_,#c_var{name=Var}}|_]) -> true;
v_is_value(Var, [_|T]) -> v_is_value(Var, T);
v_is_value(_, []) -> false.

%% warn_no_clause_match(CaseOrig, CaseOpt) -> ok
%%  Generate a warning if none of the user-specified clauses
%%  will match.

warn_no_clause_match(CaseOrig, CaseOpt) ->
    OrigCs = cerl:case_clauses(CaseOrig),
    OptCs = cerl:case_clauses(CaseOpt),
    case any(fun(C) -> not is_compiler_generated(C) end, OrigCs) andalso
	all(fun is_compiler_generated/1, OptCs) of
	true ->
	    %% The original list of clauses did contain at least one
	    %% user-specified clause, but none of them will match.
	    %% That is probably a mistake.
	    add_warning(CaseOrig, no_clause_match);
	false ->
	    %% Either there were user-specified clauses left in
	    %% the transformed clauses, or else none of the original
	    %% clauses were user-specified to begin with (as in 'andalso').
	    ok
    end.

%% clauses(E, [Clause], TopLevel, Context, Sub) -> [Clause].
%%  Trim the clauses by removing all clauses AFTER the first one which
%%  is guaranteed to match.  Also remove all trivially false clauses.

clauses(E, [C0|Cs], Ctxt, Sub, LitExpr) ->
    #c_clause{pats=Ps,guard=G} = C1 = clause(C0, E, Ctxt, Sub),
    %%ok = io:fwrite("~w: ~p~n", [?LINE,{E,Ps}]),
    case {will_match(E, Ps),will_succeed(G)} of
	{yes,yes} ->
	    case LitExpr of
		false ->
		    Line = get_line(core_lib:get_anno(C1)),
		    shadow_warning(Cs, Line);
		true ->
		    %% If the case expression is a literal,
		    %% it is probably OK that some clauses don't match.
		    %% It is a probably some sort of debug macro.
		    ok
	    end,
	    [C1];				%Skip the rest
	{_Mat,no} ->				%Guard fails.
	    add_warning(C1, nomatch_guard),
	    clauses(E, Cs, Ctxt, Sub, LitExpr);	%Skip this clause
	{_Mat,_Suc} ->
	    [C1|clauses(E, Cs, Ctxt, Sub, LitExpr)]
    end;
clauses(_, [], _, _, _) -> [].

shadow_warning([C|Cs], none) ->
    add_warning(C, nomatch_shadow),
    shadow_warning(Cs, none);
shadow_warning([C|Cs], Line) ->
    add_warning(C, {nomatch_shadow, Line}),
    shadow_warning(Cs, Line);
shadow_warning([], _) -> ok.

%% will_succeed(Guard) -> yes | maybe | no.
%%  Test if we know whether a guard will succeed/fail or just don't
%%  know.  Be VERY conservative!

will_succeed(#c_literal{val=true}) -> yes;
will_succeed(#c_literal{val=false}) -> no;
will_succeed(_Guard) -> maybe.

%% will_match(Expr, [Pattern]) -> yes | maybe.
%%  We KNOW that this function is only used after optimizations
%%  in case_opt/4. Therefore clauses that can definitely not match
%%  have already been pruned.

will_match(#c_values{es=Es}, Ps) ->
    will_match_1(cerl_clauses:match_list(Ps, Es));
will_match(E, [P]) ->
    will_match_1(cerl_clauses:match(P, E)).

will_match_1({false,_}) -> maybe;
will_match_1({true,_}) -> yes.

%% opt_bool_case(CoreExpr) - CoreExpr'.
%%  Do various optimizations to case statement that has a
%%  boolean case expression.
%%
%%  We start with some simple optimizations and normalization
%%  to facilitate later optimizations.
%%
%%  If the case expression can only return a boolean
%%  (or fail), we can remove any clause that cannot
%%  possibly match 'true' or 'false'. Also, any clause
%%  following both 'true' and 'false' clause can
%%  be removed. If successful, we will end up this:
%%
%%  case BoolExpr of           	    case BoolExpr of
%%     true ->			       false ->
%%       ...; 			    	  ...;
%%     false ->            OR          true ->
%%       ...				  ...
%%     end.			    end.
%%
%%  We give up if there are clauses with guards, or if there
%%  is a variable clause that matches anything.
%%
opt_bool_case(#c_case{arg=Arg}=Case0) ->
    case is_bool_expr(Arg) of
	false ->
	    Case0;
	true ->
	    try opt_bool_clauses(Case0) of
		Case ->
		    opt_bool_not(Case)
	    catch
		impossible ->
		    Case0
	    end
    end;
opt_bool_case(Core) -> Core.

opt_bool_clauses(#c_case{clauses=Cs}=Case) ->
    Case#c_case{clauses=opt_bool_clauses(Cs, false, false)}.

opt_bool_clauses(Cs, true, true) ->
    %% We have now seen clauses that match both true and false.
    %% Any remaining clauses cannot possibly match.
    case Cs of
	[_|_] ->
	    shadow_warning(Cs, none),
	    [];
	[] ->
	    []
    end;
opt_bool_clauses([#c_clause{pats=[#c_literal{val=Lit}],
			    guard=#c_literal{val=true},
			    body=B}=C0|Cs], SeenT, SeenF) ->
    case is_boolean(Lit) of
	false ->
	    %% Not a boolean - this clause can't match.
	    add_warning(C0, nomatch_clause_type),
	    opt_bool_clauses(Cs, SeenT, SeenF);
	true ->
	    %% This clause will match.
	    C = C0#c_clause{body=opt_bool_case(B)},
	    case Lit of
		false -> [C|opt_bool_clauses(Cs, SeenT, true)];
		true -> [C|opt_bool_clauses(Cs, true, SeenF)]
	    end
    end;
opt_bool_clauses([#c_clause{pats=Ps,guard=#c_literal{val=true}}=C|Cs], SeenT, SeenF) ->
    case Ps of
	[#c_var{}] ->
	    %% Will match a boolean.
	    throw(impossible);
	[#c_alias{}] ->
	    %% Might match a boolean.
	    throw(impossible);
	_ ->
	    %% The clause cannot possible match a boolean.
	    %% We can remove it.
	    add_warning(C, nomatch_clause_type),
	    opt_bool_clauses(Cs, SeenT, SeenF)
    end;
opt_bool_clauses([_|_], _, _) ->
    %% A clause with a guard. Give up.
    throw(impossible).
%% We intentionally do not have a clause that match an empty
%% list. An empty list would indicate that the clauses do not
%% match all possible values for the case expression, which
%% means that the Core Erlang program is illegal. We prefer to
%% crash on such illegal input, rather than producing code that will
%% fail mysteriously at run time.


%% opt_bool_not(Case) -> CoreExpr.
%%  Try to eliminate one or more calls to 'not' at the top level
%%  of the case expression.
%%
%%  We KNOW that the case expression is guaranteed to return
%%  a boolean and that there are exactly two clauses: one that
%%  matches 'true' and one that matches 'false'.
%%
%%  case not Expr of       	    case Expr of
%%     true ->			       false ->
%%       ...; 			    	  ...;
%%     false ->           ==>          true ->
%%       ...				  ...;
%%     end.			       NewVar ->
%%                                        erlang:error(badarg)
%%                                  end.

opt_bool_not(#c_case{arg=Arg,clauses=Cs0}=Case0) ->
    case Arg of
	#c_call{anno=Anno,module=#c_literal{val=erlang},
 		name=#c_literal{val='not'},
 		args=[Expr]} ->
	    Cs = [opt_bool_not_invert(C) || C <- Cs0] ++
		 [#c_clause{anno=[compiler_generated],
			    pats=[#c_var{name=cor_variable}],
			    guard=#c_literal{val=true},
			    body=#c_call{anno=Anno,
					 module=#c_literal{val=erlang},
					 name=#c_literal{val=error},
					 args=[#c_literal{val=badarg}]}}],
	    Case = Case0#c_case{arg=Expr,clauses=Cs},
	    opt_bool_not(Case);
	_ ->
	    opt_bool_case_redundant(Case0)
    end.

opt_bool_not_invert(#c_clause{pats=[#c_literal{val=Bool}]}=C) ->
    C#c_clause{pats=[#c_literal{val=not Bool}]}.

%% opt_bool_case_redundant(Core) -> Core'.
%%  If the sole purpose of the case is to verify that the case
%%  expression is indeed boolean, we do not need the case
%%  (since we have already verified that the case expression is
%%  boolean).
%%
%%    case BoolExpr of
%%      true -> true   	       	       ==>      BoolExpr
%%      false -> false
%%    end.
%%
opt_bool_case_redundant(#c_case{arg=Arg,clauses=Cs}=Case) ->
    case all(fun opt_bool_case_redundant_1/1, Cs) of
	true -> Arg;
	false -> opt_bool_case_guard(Case)
    end.

opt_bool_case_redundant_1(#c_clause{pats=[#c_literal{val=B}],
				    body=#c_literal{val=B}}) ->
    true;
opt_bool_case_redundant_1(_) -> false.

%% opt_bool_case_guard(Case) -> Case'.
%%  Move a boolean case expression into the guard if we are sure that
%%  it cannot fail.
%%
%%    case SafeBoolExpr of	 	case <> of
%%      true -> TrueClause;    	   ==>    <> when SafeBoolExpr -> TrueClause;
%%      false -> FalseClause		  <> when true -> FalseClause
%%    end.		 		end.
%%
%%  Generally, evaluting a boolean expression in a guard should
%%  be faster than evaulating it in the body.
%%
opt_bool_case_guard(#c_case{arg=#c_literal{}}=Case) ->
    %% It is not necessary to move a literal case expression into the
    %% guard, because it will be handled quite well in other
    %% optimizations, and moving the literal into the guard will
    %% cause some extra warnings, for instance for this code
    %%
    %%    case true of
    %%       true -> ...;
    %%       false -> ...
    %%    end.
    %%
    Case;
opt_bool_case_guard(#c_case{arg=Arg,clauses=Cs0}=Case) ->
    case is_safe_bool_expr(Arg, sub_new()) of
	false ->
	    Case;
	true ->
	    Cs = opt_bool_case_guard(Arg, Cs0),
	    Case#c_case{arg=#c_values{anno=core_lib:get_anno(Arg),es=[]},
			clauses=Cs}
    end.

opt_bool_case_guard(Arg, [#c_clause{pats=[#c_literal{val=true}]}=Tc,Fc]) ->
    [Tc#c_clause{pats=[],guard=Arg},Fc#c_clause{pats=[]}];
opt_bool_case_guard(Arg, [#c_clause{pats=[#c_literal{val=false}]}=Fc,Tc]) ->
    [Tc#c_clause{pats=[],guard=Arg},Fc#c_clause{pats=[]}].

%% eval_case(Case) -> #c_case{} | #c_let{}.
%%  If possible, evaluate a case at compile time.  We know that the
%%  last clause is guaranteed to match so if there is only one clause
%%  with a pattern containing only variables then rewrite to a let.

eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,body=B}]}, Sub) ->
    Es = case cerl:is_c_values(E) of
	     true -> cerl:values_es(E);
	     false -> [E]
	 end,
    %% Consider:
    %%
    %%   case SomeSideEffect() of
    %%      X=Y -> ...
    %%   end
    %%
    %% We must not rewrite it to:
    %%
    %%   let <X,Y> = <SomeSideEffect(),SomeSideEffect()> in ...
    %%
    %% because SomeSideEffect() would be called evaluated twice.
    %%
    %% Instead we must evaluate the case expression in an outer let
    %% like this:
    %%
    %%   let NewVar = SomeSideEffect() in
    %%       let <X,Y> = <NewVar,NewVar> in ...
    %%
    Vs = make_vars([], length(Es)),
    {true,Bs} = cerl_clauses:match_list(Ps0, Vs),
    {Ps,As} = unzip(Bs),
    InnerLet = cerl:c_let(Ps, core_lib:make_values(As), B),
    Let = cerl:c_let(Vs, E, InnerLet),
    expr(Let, sub_new(Sub));
eval_case(Case, _) -> Case.

%% case_opt(CaseArg, [Clause]) -> {CaseArg,[Clause]}.
%%  Try and optimise a case by avoid building tuples or lists
%%  in the case expression. Instead combine the variable parts
%%  of the case expression to multiple "values". If a clause
%%  refers to the constructed term in the case expression (which
%%  was not built), introduce a let into the guard and/or body to
%%  build the term.
%%
%%     case {ok,[Expr1,Expr2]} of	case <Expr1,Expr2> of
%%         {ok,[P1,P2]} -> ...		    <P1,P2> -> ...
%%          .  	       	       	  ==>        .
%%          .				     .
%%          .				     .
%%         Var ->                           <Var1,Var2> ->
%%             ... Var ...                     let <Var> = {ok,[Var1,Var2]}
%%                                                 in ... Var ...
%%          .                                 .
%%          .                                 .
%%          .				      .
%%     end.				end.
%%
case_opt(Arg, Cs0, Sub) ->
    Cs1 = [{cerl:clause_pats(C),C,[],[]} || C <- Cs0],
    Args0 = case cerl:is_c_values(Arg) of
		false -> [Arg];
		true -> cerl:values_es(Arg)
	    end,
    LitExpr = cerl:is_literal(Arg),
    {Args,Cs2} = case_opt_args(Args0, Cs1, Sub, LitExpr, []),
    Cs = [cerl:update_c_clause(C,
			       reverse(Ps),
			       letify(Bs, cerl:clause_guard(C)),
			       letify(Bs, cerl:clause_body(C))) ||
	     {[],C,Ps,Bs} <- Cs2],
    {core_lib:make_values(Args),Cs}.

case_opt_args([A0|As0], Cs0, Sub, LitExpr, Acc) ->
    case case_opt_arg(A0, Sub, Cs0, LitExpr) of
	error ->
	    %% Nothing to be done. Move on to the next argument.
	    Cs = [{Ps,C,[P|PsAcc],Bs} || {[P|Ps],C,PsAcc,Bs} <- Cs0],
	    case_opt_args(As0, Cs, Sub, LitExpr, [A0|Acc]);
	{ok,As1,Cs} ->
	    %% The argument was either expanded (from tuple/list) or
	    %% removed (literal).
	    case_opt_args(As1++As0, Cs, Sub, LitExpr, Acc)
    end;
case_opt_args([], Cs, _Sub, _LitExpr, Acc) ->
    {reverse(Acc),Cs}.

%% case_opt_arg(Expr, Sub, Clauses0, LitExpr) ->
%%         {ok,Args,Clauses} | error
%%  Try to expand one argument to several arguments (if tuple/list)
%%  or to remove a literal argument.
%%
case_opt_arg(E0, Sub, Cs, LitExpr) ->
    E = maybe_replace_var(E0, Sub),
    case cerl:is_data(E) of
	false ->
	    error;
	true ->
	    case cerl:data_type(E) of
		{atomic,_} ->
		    case_opt_lit(E, Cs, LitExpr);
		_ ->
		    case_opt_data(E, Cs, LitExpr)
	    end
    end.

%% maybe_replace_var(Expr0, Sub) -> Expr
%%  If Expr0 is a variable that has been previously matched and
%%  is known to be a tuple, return the tuple instead. Otherwise
%%  return Expr0 unchanged.
%%
maybe_replace_var(E, Sub) ->
    case cerl:is_c_var(E) of
	false -> E;
	true -> maybe_replace_var_1(E, Sub)
    end.

maybe_replace_var_1(E, #sub{t=Tdb}) ->
    case orddict:find(cerl:var_name(E), Tdb) of
	{ok,T0} ->
	    case cerl:is_c_tuple(T0) of
		false ->
		    E;
		true ->
		    cerl_trees:map(fun(C) ->
					   case cerl:is_c_alias(C) of
					       false -> C;
					       true -> cerl:alias_pat(C)
					   end
				   end, T0)
	    end;
	error ->
	    E
    end.

%% case_opt_lit(Literal, Clauses0, LitExpr) ->
%%           {ok,[],Clauses} | error
%%  The current part of the case expression is a literal. That
%%  means that we will know at compile-time whether a clause
%%  will match, and we can remove the corresponding pattern from
%%  each clause.
%%
%%  The only complication is if the literal is a binary. Binary
%%  pattern matching is tricky, so we will give up in that case.

case_opt_lit(Lit, Cs0, LitExpr) ->
    try case_opt_lit_1(Cs0, Lit, LitExpr) of
	Cs ->
	    {ok,[],Cs}
    catch
	throw:impossible ->
	    error
    end.

case_opt_lit_1([{[P|Ps],C,PsAcc,Bs0}|Cs], E, LitExpr) ->
    case cerl_clauses:match(P, E) of
	none ->
	    %% The pattern will not match the literal. Remove the clause.
	    %% Unless the entire case expression is a literal, also
	    %% emit a warning.
	    case LitExpr of
		false -> add_warning(C, nomatch_clause_type);
		true -> ok
	    end,
	    case_opt_lit_1(Cs, E, LitExpr);
	{true,Bs} ->
	    %% The pattern matches the literal. Remove the pattern
	    %% and update the bindings.
	    [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_1(Cs, E, LitExpr)];
	{false,_} ->
	    %% Binary literal and pattern. We are not sure whether
	    %% the pattern will match.
	    throw(impossible)
    end;
case_opt_lit_1([], _, _) -> [].

%% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses}

case_opt_data(E, Cs0, LitExpr) ->
    Es = cerl:data_es(E),
    Cs = case_opt_data_1(Cs0, Es,
			 {cerl:data_type(E),cerl:data_arity(E)},
			 LitExpr),
    {ok,Es,Cs}.

case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig, LitExpr) ->
    case case_data_pat(P, TypeSig) of
	{ok,Ps1,Bs1} ->
	    [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|
	     case_opt_data_1(Cs, Es, TypeSig,LitExpr)];
	error ->
	    case LitExpr of
		false -> add_warning(C, nomatch_clause_type);
		true -> ok
	    end,
	    case_opt_data_1(Cs, Es, TypeSig, LitExpr)
    end;
case_opt_data_1([], _, _, _) -> [].

%% case_data_pat(Pattern, Type, Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error.

case_data_pat(P, TypeSig) ->
    case cerl:is_data(P) of
	false ->
	    case_data_pat_var(P, TypeSig);
	true ->
	    case {cerl:data_type(P),cerl:data_arity(P)} of
		TypeSig ->
		    {ok,cerl:data_es(P),[]};
		{_,_} ->
		    error
	    end
    end.

%% case_data_pat_var(Pattern, {DataType,ArityType}) ->
%%          {ok,[Pattern],[{AliasVar,Pat}]}

case_data_pat_var(P, {Type,Arity}=TypeSig) ->
    %% If the entire case statement is evaluated in an effect
    %% context (e.g. "case {A,B} of ... end, ok"), there will
    %% be a warning that a term is constructed but never used.
    %% To avoid that warning, we must annotate the data
    %% constructor as compiler generated.
    Ann = [compiler_generated|cerl:get_ann(P)],
    case cerl:type(P) of
	var ->
	    Vars = make_vars(cerl:get_ann(P), Arity),
	    {ok,Vars,[{P,cerl:ann_make_data(Ann, Type, Vars)}]};
	alias ->
	    V = cerl:alias_var(P),
	    Apat = cerl:alias_pat(P),
	    case case_data_pat(Apat, TypeSig) of
		{ok,Ps,Bs} ->
		    {ok,Ps,[{V,cerl:ann_make_data(Ann, Type, unalias_pat_list(Ps))}|Bs]};
		error ->
		    error
	    end;
	_ ->
	    error
    end.

%% unalias_pat(Pattern) -> Pattern.
%%  Remove all the aliases in a pattern but using the alias variables
%%  instead of the values.  We KNOW they will be bound.

unalias_pat(P) ->
    case cerl:is_c_alias(P) of
	true ->
	    cerl:alias_var(P);
	false ->
	    case cerl:is_data(P) of
		false ->
		    P;
		true ->
		    Es = unalias_pat_list(cerl:data_es(P)),
		    cerl:update_data(P, cerl:data_type(P), Es)
	    end
    end.

unalias_pat_list(Ps) -> [unalias_pat(P) || P <- Ps].

make_vars(A, Max) ->
    make_vars(A, 1, Max).

make_vars(A, I, Max) when I =< Max ->
    [make_var(A)|make_vars(A, I+1, Max)];
make_vars(_, _, _) -> [].

make_var(A) ->
    #c_var{anno=A,name=make_var_name()}.

make_var_name() ->
    N = get(new_var_num),
    put(new_var_num, N+1),
    list_to_atom("fol"++integer_to_list(N)).

letify(Bs, Body) ->
    foldr(fun({V,Val}, B) ->
		  letify(V, Val, B)
	  end, Body, Bs).

letify(#c_var{name=Vname}=Var, Val, Body) ->
    case core_lib:is_var_used(Vname, Body) of
	true ->
	    A = element(2, Body),
	    #c_let{anno=A,vars=[Var],arg=Val,body=Body};
	false -> Body
    end.

%% opt_case_in_let(LetExpr) -> LetExpr'

opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let) ->
    opt_case_in_let_0(Vs, Arg, B, Let).

opt_case_in_let_0([#c_var{name=V}], Arg,
		  #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let) ->
    case opt_case_in_let_1(V, Arg, Cs) of
	impossible ->
	    case is_simple_case_arg(Arg) andalso
		not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of
		true ->
		    expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new());
		false ->
		    Let
	    end;
	Expr -> Expr
    end;
opt_case_in_let_0(_, _, _, Let) -> Let.

opt_case_in_let_1(V, Arg, Cs) ->
    try
	opt_case_in_let_2(V, Arg, Cs)
    catch
	_:_ -> impossible
    end.

opt_case_in_let_2(V, Arg0,
		  [#c_clause{pats=[#c_tuple{es=Es}],
			     guard=#c_literal{val=true},body=B}|_]) ->

    %%  In {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end.
    %%  avoid building tuples, by converting tuples to multiple values.
    %%  (The optimisation is not done if the built tuple is used or returned.)

    true = all(fun (#c_var{}) -> true;
		   (_) -> false end, Es),	%Only variables in tuple
    false = core_lib:is_var_used(V, B),		%Built tuple must not be used.
    Arg1 = tuple_to_values(Arg0, length(Es)),	%Might fail.
    #c_let{vars=Es,arg=Arg1,body=B}.

%% is_simple_case_arg(Expr) -> true|false
%%  Determine whether the Expr is simple enough to be worth
%%  substituting into a case argument. (Common substitutions
%%  of variables and literals are assumed to have been already
%%  handled by the caller.)

is_simple_case_arg(#c_cons{}) -> true;
is_simple_case_arg(#c_tuple{}) -> true;
is_simple_case_arg(#c_call{}) -> true;
is_simple_case_arg(#c_apply{}) -> true;
is_simple_case_arg(_) -> false.

%% is_bool_expr(Core) -> true|false
%%  Check whether the Core expression is guaranteed to return
%%  a boolean IF IT RETURNS AT ALL.
%%
is_bool_expr(Core) ->
    is_bool_expr(Core, sub_new()).

%% is_bool_expr(Core, Sub) -> true|false
%%  Check whether the Core expression is guaranteed to return
%%  a boolean IF IT RETURNS AT ALL. Uses type information
%%  to be able to identify more expressions as booleans.
%%
is_bool_expr(#c_call{module=#c_literal{val=erlang},
		     name=#c_literal{val=Name},args=Args}=Call, _) ->
    NumArgs = length(Args),
    erl_internal:comp_op(Name, NumArgs) orelse
	erl_internal:new_type_test(Name, NumArgs) orelse
        erl_internal:bool_op(Name, NumArgs) orelse
	will_fail(Call);
is_bool_expr(#c_try{arg=E,vars=[#c_var{name=X}],body=#c_var{name=X},
		   handler=#c_literal{val=false}}, Sub) ->
    is_bool_expr(E, Sub);
is_bool_expr(#c_case{clauses=Cs}, Sub) ->
    is_bool_expr_list(Cs, Sub);
is_bool_expr(#c_clause{body=B}, Sub) ->
    is_bool_expr(B, Sub);
is_bool_expr(#c_let{vars=[V],arg=Arg,body=B}, Sub0) ->
    Sub = case is_bool_expr(Arg, Sub0) of
	      true -> update_types(V, [#c_literal{val=true}], Sub0);
	      false -> Sub0
	  end,
    is_bool_expr(B, Sub);
is_bool_expr(#c_let{body=B}, Sub) ->
    %% Binding of multiple variables.
    is_bool_expr(B, Sub);
is_bool_expr(#c_literal{val=Bool}, _) when is_boolean(Bool) ->
    true;
is_bool_expr(#c_var{name=V}, Sub) ->
    is_boolean_type(V, Sub);
is_bool_expr(_, _) -> false.

is_bool_expr_list([C|Cs], Sub) ->
    is_bool_expr(C, Sub) andalso is_bool_expr_list(Cs, Sub);
is_bool_expr_list([], _) -> true.

%% is_safe_bool_expr(Core) -> true|false
%%  Check whether the Core expression ALWAYS returns a boolean
%%  (i.e. it cannot fail). Also make sure that the expression
%%  is suitable for a guard (no calls to non-guard BIFs, local
%%  functions, or is_record/2).
%%
is_safe_bool_expr(Core, Sub) ->
    is_safe_bool_expr_1(Core, Sub, gb_sets:empty()).

is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
			    name=#c_literal{val=is_record},
			    args=[_,_]},
		    _Sub, _BoolVars) ->
    %% The is_record/2 BIF is NOT allowed in guards.
    %%
    %% NOTE: Calls like is_record(Expr, LiteralTag), where LiteralTag
    %% is a literal atom referring to a defined record, have already
    %% been rewritten to is_record(Expr, LiteralTag, TupleSize).
    false;
is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
			    name=#c_literal{val=Name},args=Args},
		    Sub, BoolVars) ->
    NumArgs = length(Args),
    case (erl_internal:comp_op(Name, NumArgs) orelse
	  erl_internal:new_type_test(Name, NumArgs)) andalso
	is_safe_simple_list(Args, Sub) of
	true ->
	    true;
	false ->
	    %% Boolean operators are safe if all arguments are boolean.
	    erl_internal:bool_op(Name, NumArgs) andalso
		is_safe_bool_expr_list(Args, Sub, BoolVars)
    end;
is_safe_bool_expr_1(#c_let{vars=Vars,arg=Arg,body=B}, Sub, BoolVars) ->
    case is_safe_simple(Arg, Sub) of
	true ->
	    case {is_safe_bool_expr_1(Arg, Sub, BoolVars),Vars} of
		{true,[#c_var{name=V}]} ->
		    is_safe_bool_expr_1(B, Sub, gb_sets:add(V, BoolVars));
		{false,_} ->
		    is_safe_bool_expr_1(B, Sub, BoolVars)
	    end;
	false -> false
    end;
is_safe_bool_expr_1(#c_literal{val=Val}, _Sub, _) ->
    is_boolean(Val);
is_safe_bool_expr_1(#c_var{name=V}, _Sub, BoolVars) ->
    gb_sets:is_element(V, BoolVars);
is_safe_bool_expr_1(_, _, _) -> false.

is_safe_bool_expr_list([C|Cs], Sub, BoolVars) ->
    case is_safe_bool_expr_1(C, Sub, BoolVars) of
	true -> is_safe_bool_expr_list(Cs, Sub, BoolVars);
	false -> false
    end;
is_safe_bool_expr_list([], _, _) -> true.

%% tuple_to_values(Expr, TupleArity) -> Expr'
%%  Convert tuples in return position of arity TupleArity to values.
%%  Throws an exception for constructs that are not handled.

tuple_to_values(#c_tuple{es=Es}, Arity) when length(Es) =:= Arity ->
    core_lib:make_values(Es);
tuple_to_values(#c_literal{val=Tuple}=Lit, Arity) when tuple_size(Tuple) =:= Arity ->
    Es = [Lit#c_literal{val=E} || E <- tuple_to_list(Tuple)],
    core_lib:make_values(Es);
tuple_to_values(#c_case{clauses=Cs0}=Case, Arity) ->
    Cs1 = [tuple_to_values(E, Arity) || E <- Cs0],
    Case#c_case{clauses=Cs1};
tuple_to_values(#c_seq{body=B0}=Seq, Arity) ->
    Seq#c_seq{body=tuple_to_values(B0, Arity)};
tuple_to_values(#c_let{body=B0}=Let, Arity) ->
    Let#c_let{body=tuple_to_values(B0, Arity)};
tuple_to_values(#c_receive{clauses=Cs0,timeout=Timeout,action=A0}=Rec, Arity) ->
    Cs = [tuple_to_values(E, Arity) || E <- Cs0],
    A = case Timeout of
	    #c_literal{val=infinity} -> A0;
	    _ -> tuple_to_values(A0, Arity)
	end,
    Rec#c_receive{clauses=Cs,action=A};
tuple_to_values(#c_clause{body=B0}=Clause, Arity) ->
    B = tuple_to_values(B0, Arity),
    Clause#c_clause{body=B};
tuple_to_values(Expr, _) ->
    case will_fail(Expr) of
	true -> Expr;
	false -> erlang:error({not_handled,Expr})
    end.

%% simplify_let(Let, Sub) -> Expr | impossible
%%  If the argument part of an let contains a complex expression, such
%%  as a let or a sequence, move the original let body into the complex
%%  expression.

simplify_let(#c_let{arg=Arg0}=Let0, Sub) ->
    Arg = opt_bool_case(Arg0),
    Let = Let0#c_let{arg=Arg},
    move_let_into_expr(Let, Arg, Sub).

move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner,
		   #c_let{vars=OuterVs0,arg=Arg0,body=OuterBody0}=Outer, Sub0) ->
    %%
    %% let <InnerVars> = let <OuterVars> = <Arg>
    %%                   in <OuterBody>
    %% in <InnerBody>
    %%
    %%       ==>
    %%
    %% let <OuterVars> = <Arg>
    %% in let <InnerVars> = <OuterBody>
    %%    in <InnerBody>
    %%
    Arg = body(Arg0, Sub0),
    ScopeSub0 = sub_subst_scope(Sub0#sub{t=[]}),
    {OuterVs,ScopeSub} = pattern_list(OuterVs0, ScopeSub0),
    
    OuterBody = body(OuterBody0, ScopeSub),

    {InnerVs,Sub} = pattern_list(InnerVs0, Sub0),
    InnerBody = body(InnerBody0, Sub),
    Outer#c_let{vars=OuterVs,arg=Arg,
		body=Inner#c_let{vars=InnerVs,arg=OuterBody,body=InnerBody}};
move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
		   #c_case{arg=Cexpr0,clauses=[Ca0,Cb0|Cs]}=Case, Sub0) ->
    %% Test if there are no more clauses than Ca0 and Cb0, or if
    %% Cb0 is guaranteed to match.
    TwoClauses = Cs =:= [] orelse
	case Cb0 of
	    #c_clause{pats=[#c_var{}],guard=#c_literal{val=true}} -> true;
	    _ -> false
	end,
    case {TwoClauses,is_failing_clause(Ca0),is_failing_clause(Cb0)} of
	{true,false,true} ->
	    %% let <Lvars> = case <Case-expr> of
	    %%                  <Cvars> -> <Clause-body>;
	    %%                  <OtherCvars> -> erlang:error(...)
	    %%               end
	    %% in <Let-body>
	    %%
	    %%     ==>
	    %%
	    %% case <Case-expr> of
	    %%   <Cvars> ->
	    %%       let <Lvars> = <Clause-body>
	    %%       in <Let-body>;
	    %%   <OtherCvars> -> erlang:error(...)
	    %% end

	    Cexpr = body(Cexpr0, Sub0),
	    CaVars0 = Ca0#c_clause.pats,
	    G0 = Ca0#c_clause.guard,
	    B0 = Ca0#c_clause.body,
	    ScopeSub0 = sub_subst_scope(Sub0#sub{t=[]}),
	    {CaVars,ScopeSub} = pattern_list(CaVars0, ScopeSub0),
	    G = guard(G0, ScopeSub),

	    B1 = body(B0, ScopeSub),

	    {Lvs,B2,Sub1} = let_substs(Lvs0, B1, Sub0),
	    Sub2 = Sub1#sub{s=gb_sets:union(ScopeSub#sub.s,
					    Sub1#sub.s)},
	    Lbody = body(Lbody0, Sub2),
	    B = Let#c_let{vars=Lvs,arg=core_lib:make_values(B2),body=Lbody},

	    Ca = Ca0#c_clause{pats=CaVars,guard=G,body=B},
	    Cb = clause(Cb0, Cexpr, value, Sub0),
	    Case#c_case{arg=Cexpr,clauses=[Ca,Cb]};
	{_,_,_} -> impossible
    end;
move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
		   #c_seq{arg=Sarg0,body=Sbody0}=Seq, Sub0) ->
    %%
    %% let <Lvars> = do <Seq-arg>
    %%                  <Seq-body>
    %% in <Let-body>
    %%
    %%       ==>
    %%
    %% do <Seq-arg>
    %%    let <Lvars> = <Seq-body>
    %%    in <Let-body>
    %%
    Sarg = body(Sarg0, Sub0),
    Sbody1 = body(Sbody0, Sub0),
    {Lvs,Sbody,Sub} = let_substs(Lvs0, Sbody1, Sub0),
    Lbody = body(Lbody0, Sub),
    Seq#c_seq{arg=Sarg,body=Let#c_let{vars=Lvs,arg=core_lib:make_values(Sbody),
				      body=Lbody}};
move_let_into_expr(_Let, _Expr, _Sub) -> impossible.

is_failing_clause(#c_clause{body=B}) ->
    will_fail(B).

scope_add(Vs, #sub{s=Scope0}=Sub) ->
    Scope = foldl(fun(V, S) when is_integer(V); is_atom(V) ->
			  gb_sets:add(V, S)
		  end, Scope0, Vs),
    Sub#sub{s=Scope}.

%% opt_simple_let(#c_let{}, Context, Sub) -> CoreTerm
%%  Optimize a let construct that does not contain any lets in
%%  in its argument.

opt_simple_let(#c_let{arg=Arg0}=Let, Ctxt, Sub0) ->
    Arg = body(Arg0, value, Sub0),		%This is a body
    case will_fail(Arg) of
	true -> Arg;
	false -> opt_simple_let_1(Let, Arg, Ctxt, Sub0)
    end.

opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) ->
    %% Optimise let and add new substitutions.
    {Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0),
    BodySub = case {Vs,Args} of
		  {[V],[A]} ->
		      case is_bool_expr(A, Sub0) of
			  true ->
			      update_types(V, [#c_literal{val=true}], Sub1);
			  false ->
			      Sub1
		      end;
		  {_,_} -> Sub1
	      end,
    B = body(B0, Ctxt, BodySub),
    Arg = core_lib:make_values(Args),
    opt_simple_let_2(Let, Vs, Arg, B, Ctxt, Sub1).

opt_simple_let_2(Let0, Vs0, Arg0, Body0, effect, Sub) ->
    case {Vs0,Arg0,Body0} of
	{[],#c_values{es=[]},Body} ->
	    %% No variables left (because of substitutions).
	    Body;
	{[_|_],Arg,#c_literal{}} ->
	    %% The body is a literal. That means that we can ignore
	    %% it and that the return value is Arg revisited in
	    %% effect context.
	    body(Arg, effect, sub_new_preserve_types(Sub));
	{Vs,Arg,Body} ->
	    %% Since we are in effect context, there is a chance
	    %% that the body no longer references the variables.
	    %% In that case we can construct a sequence and visit
	    %% that in effect context:
	    %%   let <Var> = Arg in BodyWithoutVar  ==> seq Arg BodyWithoutVar
	    case is_any_var_used(Vs, Body) of
		false ->
		    expr(#c_seq{arg=Arg,body=Body}, effect, sub_new_preserve_types(Sub));
		true ->
		    Let = Let0#c_let{vars=Vs,arg=Arg,body=Body},
		    opt_case_in_let_arg(opt_case_in_let(Let), effect, Sub)
	    end
    end;
opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) ->
    case {Vs0,Arg0,Body} of
	{[#c_var{name=N1}],Arg,#c_var{name=N2}} ->
	    case N1 =:= N2 of
		true ->
		    %% let <Var> = Arg in <Var>  ==>  Arg
		    Arg;
		false ->
		    %% let <Var> = Arg in <OtherVar>  ==>  seq Arg OtherVar
		    expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub))
	    end;
	{[],#c_values{es=[]},_} ->
	    %% No variables left.
	    Body;
	{_,Arg,#c_literal{}} ->
	    %% The variable is not used in the body. The argument
	    %% can be evaluated in effect context to simplify it.
	    expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub));
	{Vs,Arg,Body} ->
	    opt_case_in_let_arg(
	      opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}),
	      value, Sub)
    end.

%% In guards only, rewrite a case in a let argument like
%%
%%    let <Var> = case <> of
%%                    <> when AnyGuard -> Literal1;
%%                    <> when AnyGuard -> Literal2
%%                end
%%    in LetBody
%%
%% to
%%
%%    case <> of
%%         <> when AnyGuard ->
%%              let <Var> = Literal1 in LetBody
%%         <> when 'true' ->
%%              let <Var> = Literal2 in LetBody
%%    end
%%    
%% In the worst case, the size of the code could increase.
%% In practice, though, substituting the literals into
%% LetBody and doing constant folding will decrease the code
%% size. (Doing this transformation outside of guards could
%% lead to a substantational increase in code size.)
%%
opt_case_in_let_arg(#c_let{arg=#c_case{}=Case}=Let, Ctxt,
		    #sub{in_guard=true}=Sub) ->
    opt_case_in_let_arg_1(Let, Case, Ctxt, Sub);
opt_case_in_let_arg(Let, _, _) -> Let.

opt_case_in_let_arg_1(Let0, #c_case{arg=#c_values{es=[]},
				   clauses=Cs}=Case0, Ctxt, Sub) ->
    Let = mark_compiler_generated(Let0),
    case Cs of
	[#c_clause{body=#c_literal{}=BodyA}=Ca0,
	 #c_clause{body=#c_literal{}=BodyB}=Cb0] ->
	    Ca = Ca0#c_clause{body=Let#c_let{arg=BodyA}},
	    Cb = Cb0#c_clause{body=Let#c_let{arg=BodyB}},
	    Case = Case0#c_case{clauses=[Ca,Cb]},
	    expr(Case, Ctxt, sub_new_preserve_types(Sub));
	_ -> Let
    end;
opt_case_in_let_arg_1(Let, _, _, _) -> Let.

is_any_var_used([#c_var{name=V}|Vs], Expr) ->
    case core_lib:is_var_used(V, Expr) of
	false -> is_any_var_used(Vs, Expr);
	true -> true
    end;
is_any_var_used([], _) -> false.

is_boolean_type(V, #sub{t=Tdb}) ->
    case orddict:find(V, Tdb) of
	{ok,bool} -> true;
	_ -> false
    end.

%% update_types(Expr, Pattern, Sub) -> Sub'
%%  Update the type database.
update_types(Expr, Pat, #sub{t=Tdb0}=Sub) ->
    Tdb = update_types_1(Expr, Pat, Tdb0),
    Sub#sub{t=Tdb}.

update_types_1(#c_var{name=V,anno=Anno}, Pat, Types) ->
    case member(reuse_for_context, Anno) of
	true ->
	    %% If a variable has been marked for reuse of binary context,
	    %% optimizations based on type information are unsafe.
	    kill_types(V, Types);
	false ->
	    update_types_2(V, Pat, Types)
    end;
update_types_1(_, _, Types) -> Types.

update_types_2(V, [#c_tuple{}=P], Types) ->
    orddict:store(V, P, Types);
update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) ->
    orddict:store(V, bool, Types);
update_types_2(_, _, Types) -> Types.

%% kill_types(V, Tdb) -> Tdb'
%%  Kill any entries that references the variable,
%%  either in the key or in the value.

kill_types(V, [{V,_}|Tdb]) ->
    kill_types(V, Tdb);
kill_types(V, [{_,#c_tuple{}=Tuple}=Entry|Tdb]) ->
    case core_lib:is_var_used(V, Tuple) of
	false -> [Entry|kill_types(V, Tdb)];
	true -> kill_types(V, Tdb)
    end;
kill_types(V, [{_,Atom}=Entry|Tdb]) when is_atom(Atom) ->
    [Entry|kill_types(V, Tdb)];
kill_types(_, []) -> [].

%% copy_type(DestVar, SrcVar, Tdb) -> Tdb'
%%  If the SrcVar has a type, assign it to DestVar.
%%
copy_type(V, #c_var{name=Src}, Tdb) ->
    case orddict:find(Src, Tdb) of
	{ok,Type} -> orddict:store(V, Type, Tdb);
	error -> Tdb
    end;
copy_type(_, _, Tdb) -> Tdb.

%% The atom `ok', is widely used in Erlang for "void" values.

void() -> #c_literal{val=ok}.

%%%
%%% Annotate bit syntax matching to faciliate optimization in further passes.
%%%

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) -> Other.

bsm_an_1(Vs, #c_case{clauses=Cs}=Case) ->
    case bsm_leftmost(Cs) of
	none -> Case;
	Pos -> bsm_an_2(Vs, Cs, Case, Pos)
    end.

bsm_an_2(Vs, Cs, Case, Pos) ->
    case bsm_nonempty(Cs, Pos) of
	true -> bsm_an_3(Vs, Cs, Case, Pos);
	false -> Case
    end.

bsm_an_3(Vs, Cs, Case, Pos) ->
    try
	bsm_ensure_no_partition(Cs, Pos),
	bsm_do_an(Vs, Pos, Cs, Case)
    catch
	throw:{problem,Where,What} ->
	    add_bin_opt_info(Where, What),
	    Case
    end.

bsm_do_an(Vs0, Pos, Cs0, Case) ->
    case nth(Pos, Vs0) of
	#c_var{name=Vname}=V0 ->
	    Cs = bsm_do_an_var(Vname, Pos, Cs0, []),
	    V = bsm_annotate_for_reuse(V0),
	    Bef = lists:sublist(Vs0, Pos-1),
	    Aft = lists:nthtail(Pos, Vs0),
	    case Bef ++ [V|Aft] of
		[_] ->
		    Case#c_case{arg=V,clauses=Cs};
		Vs ->
		    Case#c_case{arg=#c_values{es=Vs},clauses=Cs}
	    end;
	_ ->
	    Case
    end.

bsm_do_an_var(V, S, [#c_clause{pats=Ps,guard=G,body=B0}=C0|Cs], Acc) ->
    case nth(S, Ps) 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},
	    bsm_do_an_var(V, S, Cs, [C|Acc]);
	#c_alias{}=P ->
	    case bsm_could_match_binary(P) of
		false ->
		    bsm_do_an_var(V, S, Cs, [C0|Acc]);
		true ->
		    bsm_problem(C0, bin_opt_alias)
	    end;
	P ->
	    case bsm_could_match_binary(P) andalso bsm_is_var_used(V, G, B0) of
		false ->
		    bsm_do_an_var(V, S, Cs, [C0|Acc]);
		true ->
		    bsm_problem(C0, bin_var_used)
	    end
    end;
bsm_do_an_var(_, _, [], Acc) -> reverse(Acc).

bsm_annotate_for_reuse(#c_var{anno=Anno}=Var) ->
    case member(reuse_for_context, Anno) of
	false -> Var#c_var{anno=[reuse_for_context|Anno]};
	true -> Var
    end.

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 does binary matching. Return
%%  the number of the argument (1-N).

bsm_leftmost(Cs) ->
    bsm_leftmost_1(Cs, none).

bsm_leftmost_1([#c_clause{pats=Ps}|Cs], Pos) ->
    bsm_leftmost_2(Ps, Cs, 1, Pos);
bsm_leftmost_1([], Pos) -> Pos.

bsm_leftmost_2(_, Cs, Pos, Pos) ->
    bsm_leftmost_1(Cs, Pos);
bsm_leftmost_2([#c_binary{}|_], Cs, N, _) ->
    bsm_leftmost_1(Cs, N);
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_nonempty(Cs, Pos) -> true|false
%%  Check if at least one of the clauses matches a non-empty
%%  binary in the given argument position.
%%
bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) ->
    case nth(Pos, Ps) of
	#c_binary{segments=[_|_]} ->
	    true;
	_ ->
	    bsm_nonempty(Cs, Pos)
    end;
bsm_nonempty([], _ ) -> false.

%% bsm_ensure_no_partition(Cs, Pos) -> ok     (exception if problem)
%%  We must make sure that matching is not partitioned between
%%  variables like this:
%%             foo(<<...>>) -> ...
%%             foo(<Variable>) when ... -> ...
%%             foo(<Any non-variable pattern>) ->
%%  If there is such partition, we are not allowed to reuse the binary variable
%%  for the match context.
%%
%%  Also, arguments to the left of the argument that is matched
%%  against a binary, are only allowed to be simple variables, not
%%  used in guards. The reason is that we must know that the binary is
%%  only matched in one place (i.e. there must be only one bs_start_match2
%%  instruction emitted).

bsm_ensure_no_partition(Cs, Pos) ->
    bsm_ensure_no_partition_1(Cs, Pos, before).

%% Loop through each clause.
bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], Pos, State0) ->
    State = bsm_ensure_no_partition_2(Ps, Pos, G, simple_vars, State0),
    case State of
	'after' ->
	    bsm_ensure_no_partition_after(Cs, Pos);
	_ ->
	    ok
    end,
    bsm_ensure_no_partition_1(Cs, Pos, State);
bsm_ensure_no_partition_1([], _, _) -> ok.

%% Loop through each pattern for this clause.
bsm_ensure_no_partition_2([#c_binary{}=Where|_], 1, _, Vstate, State) ->
    case State of
	before when Vstate =:= simple_vars -> within;
	before -> bsm_problem(Where, Vstate);
	within when Vstate =:= simple_vars -> within;
	within -> bsm_problem(Where, Vstate)
    end;
bsm_ensure_no_partition_2([#c_alias{}=Alias|_], 1, N, Vstate, State) ->
    %% Retrieve the real pattern that the alias refers to and check that.
    P = bsm_real_pattern(Alias),
    bsm_ensure_no_partition_2([P], 1, N, Vstate, State);
bsm_ensure_no_partition_2([_|_], 1, _, _Vstate, before=State) ->
    %% No binary matching yet - therefore no partition.
    State;
bsm_ensure_no_partition_2([P|_], 1, _, Vstate, State) ->
    case bsm_could_match_binary(P) of
	false ->
	    %% If clauses can be freely arranged (Vstate =:= simple_vars),
	    %% a clause that cannot match a binary will not partition the clause.
	    %% Example:
	    %%
	    %% a(Var, <<>>) -> ...
	    %% a(Var, []) -> ...
	    %% a(Var, <<B>>) -> ...
	    %%
	    %% But if the clauses can't be freely rearranged, as in
	    %%
	    %% b(Var, <<X>>) -> ...
	    %% b(1, 2) -> ...
	    %%
	    %% we do have a problem.
	    %%
	    case Vstate of
		simple_vars -> State;
		_ -> bsm_problem(P, Vstate)
	    end;
	true ->
	    %% The pattern P *may* match a binary, so we must update the state.
	    %% (P must be a variable.)
	    case State of
		within -> 'after';
		'after' -> 'after'
	    end
    end;
bsm_ensure_no_partition_2([#c_var{name=V}|Ps], N, G, Vstate, S) ->
    case core_lib:is_var_used(V, G) of
	false ->
	    bsm_ensure_no_partition_2(Ps, N-1, G, Vstate, S);
	true ->
	    bsm_ensure_no_partition_2(Ps, N-1, G, bin_left_var_used_in_guard, S)
    end;
bsm_ensure_no_partition_2([_|Ps], N, G, _, S) ->
    bsm_ensure_no_partition_2(Ps, N-1, G, bin_argument_order, S).

bsm_ensure_no_partition_after([#c_clause{pats=Ps}|Cs], Pos) ->
    case nth(Pos, Ps) of
	#c_var{} ->
	    bsm_ensure_no_partition_after(Cs, Pos);
	P ->
	    bsm_problem(P, 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}).

%%%
%%% Handling of warnings.
%%%

mark_compiler_generated(Term) ->
    cerl_trees:map(fun mark_compiler_generated_1/1, Term).

mark_compiler_generated_1(#c_call{anno=Anno}=Term) ->
    Term#c_call{anno=[compiler_generated|Anno--[compiler_generated]]};
mark_compiler_generated_1(Term) -> Term.

init_warnings() ->
    put({?MODULE,warnings}, []).

add_bin_opt_info(Core, Term) ->
    case get(bin_opt_info) of
	true -> add_warning(Core, Term);
	false -> ok
    end.

add_warning(Core, Term) ->
    case is_compiler_generated(Core) of
	true ->
	    ok;
	false ->
	    Anno = core_lib:get_anno(Core),
	    Line = get_line(Anno),
	    File = get_file(Anno),
	    Key = {?MODULE,warnings},
	    case get(Key) of
		[{File,[{Line,?MODULE,Term}]}|_] ->
		    ok;				%We already have
						%an identical warning.
		Ws ->
		    put(Key, [{File,[{Line,?MODULE,Term}]}|Ws])
	    end
    end.

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

is_compiler_generated(Core) ->
    Anno = core_lib:get_anno(Core),
    member(compiler_generated, Anno).

get_warnings() ->
    ordsets:from_list((erase({?MODULE,warnings}))).

-type error() :: 'bad_unicode' | 'bin_argument_order'
	       | 'bin_left_var_used_in_guard' | 'bin_opt_alias'
	       | 'bin_partition' | 'bin_var_used' | 'bin_var_used_in_guard'
	       | 'embedded_binary_size' | 'nomatch_clause_type'
	       | 'nomatch_guard' | 'nomatch_shadow' | 'no_clause_match'
	       | 'orig_bin_var_used_in_guard' | 'result_ignored'
	       | 'useless_building'
	       | {'eval_failure', term()}
	       | {'no_effect', {'erlang',atom(),arity()}}
	       | {'nomatch_shadow', integer()}
	       | {'embedded_unit', _, _}.

-spec format_error(error()) -> nonempty_string().

format_error({eval_failure,Reason}) ->
    flatten(io_lib:format("this expression will fail with a '~p' exception", [Reason]));
format_error(embedded_binary_size) ->
    "binary construction will fail with a 'badarg' exception "
	"(field size for binary/bitstring greater than actual size)";
format_error({embedded_unit,Unit,Size}) ->
    M = io_lib:format("binary construction will fail with a 'badarg' exception "
		      "(size ~p cannot be evenly divided by unit ~p)", [Size,Unit]),
    flatten(M);
format_error(bad_unicode) ->
    "binary construction will fail with a 'badarg' exception "
	"(invalid Unicode code point in a utf8/utf16/utf32 segment)";
format_error({nomatch_shadow,Line}) ->
    M = io_lib:format("this clause cannot match because a previous clause at line ~p "
		      "always matches", [Line]),
    flatten(M);
format_error(nomatch_shadow) ->
    "this clause cannot match because a previous clause always matches";
format_error(nomatch_guard) ->
    "the guard for this clause evaluates to 'false'";
format_error(no_clause_match) ->
    "no clause will ever match";
format_error(nomatch_clause_type) ->
    "this clause cannot match because of different types/sizes";
format_error({no_effect,{erlang,F,A}}) ->
    {Fmt,Args} = case erl_internal:comp_op(F, A) of
		     true ->
			 {"use of operator ~p has no effect",[F]};
		     false ->
			 case erl_internal:bif(F, A) of
			     false ->
				 {"the call to erlang:~p/~p has no effect",[F,A]};
			     true ->
				 {"the call to ~p/~p has no effect",[F,A]}
			 end
		 end,
    flatten(io_lib:format(Fmt, Args));
format_error(result_ignored) ->
    "the result of the expression is 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) ->
    "INFO: matching non-variables after a previous clause matching a variable "
	"will prevent delayed sub binary optimization";
format_error(bin_left_var_used_in_guard) ->
    "INFO: a variable to the left of the binary pattern is used in a guard; "
	"will prevent delayed sub binary optimization";
format_error(bin_argument_order) ->
    "INFO: matching anything else but a plain variable to the left of "
	"binary pattern will prevent delayed sub binary optimization; "
	"SUGGEST changing argument order";
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".

-ifdef(DEBUG).
%% In order for simplify_let/2 to work correctly, the list of
%% in-scope variables must always be a superset of the free variables
%% in the current expression (otherwise we might fail to rename a variable
%% when needed and get a name capture bug).

verify_scope(E, #sub{s=Scope}) ->
    Free0 = cerl_trees:free_variables(E),
    Free = [V || V <- Free0, not is_tuple(V)],	%Ignore function names.
    case ordsets:is_subset(Free, gb_sets:to_list(Scope)) of
	true -> true;
	false ->
	    io:format("~p\n", [E]),
	    io:format("~p\n", [Free]),
	    io:format("~p\n", [gb_sets:to_list(Scope)]),
	    false
    end.
-endif.