1 files changed, 472 insertions, 2 deletions

diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index f8e99905b5..2bfa610628 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -82,7 +82,7 @@
 -export([module/2,format_error/1]).
 
 -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,
-		keymember/3,keyfind/3,partition/2,droplast/1,last/1]).
+		keymember/3,keyfind/3,partition/2,droplast/1,last/1,sort/1]).
 -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]).
 -import(cerl, [c_tuple/1]).
 
@@ -190,9 +190,479 @@ body(Ce, Sub, St0) ->
 guard(G0, Sub, St0) ->
     {G1,St1} = wrap_guard(G0, St0),
     {Ge0,Pre,St2} = expr(G1, Sub, St1),
-    {Ge,St} = gexpr_test(Ge0, St2),
+    {Ge1,St3} = gexpr_test(Ge0, St2),
+    {Ge,St} = guard_opt(Ge1, St3),
     {pre_seq(Pre, Ge),St}.
 
+%% guard_opt(Kexpr, State) -> {Kexpr,State}.
+%%  Optimize the Kexpr for the guard.  Instead of evaluating a boolean
+%%  expression comparing it to 'true' in a final #k_test{},
+%%  replace BIF calls with #k_test{} in the expression.
+%%
+%%  As an example, take the guard:
+%%
+%%     when is_integer(V0), is_atom(V1) ->
+%%
+%%  The unoptimized Kexpr translated to pseudo BEAM assembly
+%%  code would look like:
+%%
+%%     bif is_integer V0 => Bool0
+%%     bif is_atom V1    => Bool1
+%%     bif and Bool0 Bool1 => Bool
+%%     test Bool =:= true else goto Fail
+%%     ...
+%%   Fail:
+%%     ...
+%%
+%%  The optimized code would look like:
+%%
+%%     test is_integer V0 else goto Fail
+%%     test is_atom V1    else goto Fail
+%%     ...
+%%   Fail:
+%%     ...
+%%
+%%  An 'or' operation is only slightly more complicated:
+%%
+%%     test is_integer V0 else goto NotFailedYet
+%%     goto Success
+%%
+%%   NotFailedYet:
+%%     test is_atom V1 else goto Fail
+%%
+%%   Success:
+%%     ...
+%%   Fail:
+%%     ...
+
+guard_opt(G, St0) ->
+    {Root,Forest0,St1} = make_forest(G, St0),
+    {Exprs,Forest,St} = rewrite_bool(Root, Forest0, false, St1),
+    E = forest_pre_seq(Exprs, Forest),
+    {G#k_try{arg=E},St}.
+
+%% rewrite_bool(Kexpr, Forest, Inv, St) -> {[Kexpr],Forest,St}.
+%%  Rewrite Kexpr to use #k_test{} operations instead of comparison
+%%  and type test BIFs.
+%%
+%%  If Kexpr is a #k_test{} operation, the call will always
+%%  succeed. Otherwise, a 'not_possible' exception will be
+%%  thrown if Kexpr cannot be rewritten.
+
+rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}},
+		args=[#k_var{}=V,#k_atom{val=true}]}=Test, Forest0, Inv, St0) ->
+    try rewrite_bool_var(V, Forest0, Inv, St0) of
+	{_,_,_}=Res ->
+	    Res
+    catch
+	throw:not_possible ->
+	    {[Test],Forest0,St0}
+    end;
+rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}},
+		args=[#k_var{}=V,#k_atom{val=false}]}=Test, Forest0, Inv, St0) ->
+    try rewrite_bool_var(V, Forest0, not Inv, St0) of
+	{_,_,_}=Res ->
+	    Res
+    catch
+	throw:not_possible ->
+	    {[Test],Forest0,St0}
+    end;
+rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}},
+		args=[#k_atom{val=V1},#k_atom{val=V2}]}, Forest0, false, St0) ->
+    case V1 =:= V2 of
+	true ->
+	    {[make_test(is_boolean, [#k_atom{val=true}])],Forest0,St0};
+	false ->
+	    {[make_failing_test()],Forest0,St0}
+    end;
+rewrite_bool(#k_test{}=Test, Forest, false, St) ->
+    {[Test],Forest,St};
+rewrite_bool(#k_try{vars=[#k_var{name=X}],body=#k_var{name=X},
+			    handler=#k_atom{val=false},ret=[]}=Prot,
+		     Forest0, Inv, St0) ->
+    {Root,Forest1,St1} = make_forest(Prot, Forest0, St0),
+    {Exprs,Forest2,St} = rewrite_bool(Root, Forest1, Inv, St1),
+    InnerForest = maps:without(maps:keys(Forest0), Forest2),
+    Forest = maps:without(maps:keys(InnerForest), Forest2),
+    E = forest_pre_seq(Exprs, InnerForest),
+    {[Prot#k_try{arg=E}],Forest,St};
+rewrite_bool(#k_match{body=Body,ret=[]}, Forest, Inv, St) ->
+    rewrite_match(Body, Forest, Inv, St);
+rewrite_bool(Other, Forest, Inv, St) ->
+    case extract_bif(Other) of
+	{Name,Args} ->
+	    rewrite_bif(Name, Args, Forest, Inv, St);
+	error ->
+	    throw(not_possible)
+    end.
+
+%% rewrite_bool_var(Var, Forest, Inv, St) -> {[Kexpr],Forest,St}.
+%%  Rewrite the boolean expression whose key in Forest is
+%%  given by Var. Throw a 'not_possible' expression if something
+%%  prevents the rewriting.
+
+rewrite_bool_var(Arg, Forest0, Inv, St) ->
+    {Expr,Forest} = forest_take_expr(Arg, Forest0),
+    rewrite_bool(Expr, Forest, Inv, St).
+
+%% rewrite_bool_args([Kexpr], Forest, Inv, St) -> {[[Kexpr]],Forest,St}.
+%%  Rewrite each Kexpr in the list. The input Kexpr should be variables
+%%  or boolean values. Throw a 'not_possible' expression if something
+%%  prevents the rewriting.
+%%
+%%  This function is suitable for handling the arguments for both
+%%  'and' and 'or'.
+
+rewrite_bool_args([#k_atom{val=B}=A|Vs], Forest0, false=Inv, St0) when is_boolean(B) ->
+    {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0),
+    Bif = make_bif('=:=', [A,#k_atom{val=true}]),
+    {Exprs,Forest,St} = rewrite_bool(Bif, Forest1, Inv, St1),
+    {[Exprs|Tail],Forest,St};
+rewrite_bool_args([#k_var{}=Var|Vs], Forest0, false=Inv, St0) ->
+    {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0),
+    {Exprs,Forest,St} =
+	case is_bool_expr(Var, Forest0) of
+	    true ->
+		rewrite_bool_var(Var, Forest1, Inv, St1);
+	    false ->
+		Bif = make_bif('=:=', [Var,#k_atom{val=true}]),
+		rewrite_bool(Bif, Forest1, Inv, St1)
+	end,
+    {[Exprs|Tail],Forest,St};
+rewrite_bool_args([_|_], _Forest, _Inv, _St) ->
+    throw(not_possible);
+rewrite_bool_args([], Forest, _Inv, St) ->
+    {[],Forest,St}.
+
+%% rewrite_bif(Name, [Kexpr], Forest, Inv, St) -> {[Kexpr],Forest,St}.
+%%  Rewrite a BIF. Throw a 'not_possible' expression if something
+%%  prevents the rewriting.
+
+rewrite_bif('or', Args, Forest, true, St) ->
+    rewrite_not_args('and', Args, Forest, St);
+rewrite_bif('and', Args, Forest, true, St) ->
+    rewrite_not_args('or', Args, Forest, St);
+rewrite_bif('and', [#k_atom{val=Val},Arg], Forest0, Inv, St0) ->
+    false = Inv,				%Assertion.
+    case Val of
+	true ->
+	    %% The result only depends on Arg.
+	    rewrite_bool_var(Arg, Forest0, Inv, St0);
+	_ ->
+	    %% Will fail. There is no need to evalute the expression
+	    %% represented by Arg. Take it out from the forest and
+	    %% discard the expression.
+	    Failing = make_failing_test(),
+	    try rewrite_bool_var(Arg, Forest0, Inv, St0) of
+		{_,Forest,St} ->
+		    {[Failing],Forest,St}
+	    catch
+		throw:not_possible ->
+		    try forest_take_expr(Arg, Forest0) of
+			{_,Forest} ->
+			    {[Failing],Forest,St0}
+		    catch
+			throw:not_possible ->
+			    %% Arg is probably a variable bound in an
+			    %% outer scope.
+			    {[Failing],Forest0,St0}
+		    end
+	    end
+    end;
+rewrite_bif('and', [Arg,#k_atom{}=Atom], Forest, Inv, St) ->
+    false = Inv,				%Assertion.
+    rewrite_bif('and', [Atom,Arg], Forest, Inv, St);
+rewrite_bif('and', Args, Forest0, Inv, St0) ->
+    false = Inv,				%Assertion.
+    {[Es1,Es2],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0),
+    {Es1 ++ Es2,Forest,St};
+rewrite_bif('or', Args, Forest0, Inv, St0) ->
+    false = Inv,				%Assertion.
+    {[First,Then],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0),
+    Alt = make_alt(First, Then),
+    {[Alt],Forest,St};
+rewrite_bif('xor', [_,_], _Forest, _Inv, _St) ->
+    %% Rewriting 'xor' is not practical. Fortunately, 'xor' is
+    %% almost never used in practice.
+    throw(not_possible);
+rewrite_bif('not', [Arg], Forest0, Inv, St) ->
+    {Expr,Forest} = forest_take_expr(Arg, Forest0),
+    rewrite_bool(Expr, Forest, not Inv, St);
+rewrite_bif(Op, Args, Forest, Inv, St) ->
+    case is_test(Op, Args) of
+	true ->
+	    rewrite_bool(make_test(Op, Args, Inv), Forest, false, St);
+	false ->
+	    throw(not_possible)
+    end.
+
+rewrite_not_args(Op, [A0,B0], Forest0, St0) ->
+    {A,Forest1,St1} = rewrite_not_args_1(A0, Forest0, St0),
+    {B,Forest2,St2} = rewrite_not_args_1(B0, Forest1, St1),
+    rewrite_bif(Op, [A,B], Forest2, false, St2).
+
+rewrite_not_args_1(Arg, Forest, St) ->
+    Not = make_bif('not', [Arg]),
+    forest_add_expr(Not, Forest, St).
+
+%% rewrite_match(Kvar, TypeClause, Forest, Inv, St) ->
+%%       {[Kexpr],Forest,St}.
+%%  Try to rewrite a #k_match{} originating from an 'andalso' or an 'orelse'.
+
+rewrite_match(#k_alt{first=First,then=Then}, Forest, Inv, St) ->
+    case {First,Then} of
+	{#k_select{var=#k_var{name=V}=Var,types=[TypeClause]},#k_var{name=V}} ->
+	    rewrite_match_1(Var, TypeClause, Forest, Inv, St);
+	{_,_} ->
+	    throw(not_possible)
+    end.
+
+rewrite_match_1(Var, #k_type_clause{values=Cs0}, Forest0, Inv, St0) ->
+    Cs = sort([{Val,B} || #k_val_clause{val=#k_atom{val=Val},body=B} <- Cs0]),
+    case Cs of
+	[{false,False},{true,True}] ->
+	    rewrite_match_2(Var, False, True, Forest0, Inv, St0);
+	_ ->
+	    throw(not_possible)
+    end.
+
+rewrite_match_2(Var, False, #k_atom{val=true}, Forest0, Inv, St0) ->
+    %% Originates from an 'orelse'.
+    case False of
+	#k_atom{val=NotBool} when not is_boolean(NotBool) ->
+	    rewrite_bool(Var, Forest0, Inv, St0);
+	_ ->
+	    {CodeVar,Forest1,St1} = add_protected_expr(False, Forest0, St0),
+	    rewrite_bif('or', [Var,CodeVar], Forest1, Inv, St1)
+    end;
+rewrite_match_2(Var, #k_atom{val=false}, True, Forest0, Inv, St0) ->
+    %% Originates from an 'andalso'.
+    {CodeVar,Forest1,St1} = add_protected_expr(True, Forest0, St0),
+    rewrite_bif('and', [Var,CodeVar], Forest1, Inv, St1);
+rewrite_match_2(_V, _, _, _Forest, _Inv, _St) ->
+    throw(not_possible).
+
+%% is_bool_expr(#k_var{}, Forest) -> true|false.
+%%  Return true if the variable refers to a boolean expression
+%%  that does not need an explicit '=:= true' test.
+
+is_bool_expr(V, Forest) ->
+    case forest_peek_expr(V, Forest) of
+	error ->
+	    %% Defined outside of the guard. We can't know.
+	    false;
+	Expr ->
+	    case extract_bif(Expr) of
+		{Name,Args} ->
+		    is_test(Name, Args) orelse
+			erl_internal:bool_op(Name, length(Args));
+		error ->
+		    %% Not a BIF. Should be possible to rewrite
+		    %% to a boolean. Definitely does not need
+		    %% a '=:= true' test.
+		    true
+	    end
+    end.
+
+make_bif(Op, Args) ->
+    #k_bif{op=#k_remote{mod=#k_atom{val=erlang},
+			name=#k_atom{val=Op},
+			arity=length(Args)},
+	   args=Args}.
+
+extract_bif(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},
+				 name=#k_atom{val=Name}},
+		    args=Args}) ->
+    {Name,Args};
+extract_bif(_) ->
+    error.
+
+%% make_alt(First, Then) -> KMatch.
+%%  Make a #k_alt{} within a #k_match{} to implement
+%%  'or' or 'orelse'.
+
+make_alt(First0, Then0) ->
+    First1 = pre_seq(droplast(First0), last(First0)),
+    Then1 = pre_seq(droplast(Then0), last(Then0)),
+    First2 = make_protected(First1),
+    Then2 = make_protected(Then1),
+    Body = #k_atom{val=ignored},
+    First3 = #k_guard_clause{guard=First2,body=Body},
+    Then3 = #k_guard_clause{guard=Then2,body=Body},
+    First = #k_guard{clauses=[First3]},
+    Then = #k_guard{clauses=[Then3]},
+    Alt = #k_alt{first=First,then=Then},
+    #k_match{vars=[],body=Alt}.
+
+add_protected_expr(#k_atom{}=Atom, Forest, St) ->
+    {Atom,Forest,St};
+add_protected_expr(#k_var{}=Var, Forest, St) ->
+    {Var,Forest,St};
+add_protected_expr(E0, Forest, St) ->
+    E = make_protected(E0),
+    forest_add_expr(E, Forest, St).
+
+make_protected(#k_try{}=Try) ->
+    Try;
+make_protected(B) ->
+    #k_try{arg=B,vars=[#k_var{name=''}],body=#k_var{name=''},
+	   handler=#k_atom{val=false}}.
+
+make_failing_test() ->
+    make_test(is_boolean, [#k_atom{val=fail}]).
+
+make_test(Op, Args) ->
+    make_test(Op, Args, false).
+
+make_test(Op, Args, Inv) ->
+    Remote = #k_remote{mod=#k_atom{val=erlang},
+		       name=#k_atom{val=Op},
+		       arity=length(Args)},
+    #k_test{op=Remote,args=Args,inverted=Inv}.
+
+is_test(Op, Args) ->
+    A = length(Args),
+    erl_internal:new_type_test(Op, A) orelse erl_internal:comp_op(Op, A).
+
+%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}.
+%%  Build a forest out of Kexpr. RootKexpr is the final expression
+%%  nested inside Kexpr.
+
+make_forest(G, St) ->
+    make_forest_1(G, #{}, 0, St).
+
+%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}.
+%%  Add to Forest from Kexpr. RootKexpr is the final expression
+%%  nested inside Kexpr.
+
+make_forest(G, Forest0, St) ->
+    N = forest_next_index(Forest0),
+    make_forest_1(G, Forest0, N, St).
+
+make_forest_1(#k_try{arg=B}, Forest, I, St) ->
+    make_forest_1(B, Forest, I, St);
+make_forest_1(#iset{vars=[]}=Iset0, Forest, I, St0) ->
+    {UnrefVar,St} = new_var(St0),
+    Iset = Iset0#iset{vars=[UnrefVar]},
+    make_forest_1(Iset, Forest, I, St);
+make_forest_1(#iset{vars=[#k_var{name=V}],arg=Arg,body=B}, Forest0, I, St) ->
+    Forest = Forest0#{V => {I,Arg}, {untaken,V} => true},
+    make_forest_1(B, Forest, I+1, St);
+make_forest_1(Innermost, Forest, _I, St) ->
+    {Innermost,Forest,St}.
+
+%% forest_take_expr(Kexpr, Forest) -> {Expr,Forest}.
+%%  If Kexpr is a variable, take out the expression corresponding
+%%  to variable in Forest. Expressions that have been taken out
+%%  of the forest will not be included the Kexpr returned
+%%  by forest_pre_seq/2.
+%%
+%%  Throw a 'not_possible' exception if Kexpr is not a variable or
+%%  if the name of the variable is not a key in Forest.
+
+forest_take_expr(#k_var{name=V}, Forest0) ->
+    %% v3_core currently always generates guard expressions that can
+    %% be represented as a tree.  Other code generators (such as LFE)
+    %% could generate guard expressions that can only be represented
+    %% as a DAG (i.e. some nodes are referenced more than once). To
+    %% handle DAGs, we must never remove a node from the forest, but
+    %% just remove the {untaken,V} marker. That will effectively convert
+    %% the DAG to a tree by duplicating the shared nodes and their
+    %% descendants.
+
+    case maps:find(V, Forest0) of
+	{ok,{_,Expr}} ->
+	    Forest = maps:remove({untaken,V}, Forest0),
+	    {Expr,Forest};
+	error ->
+	    throw(not_possible)
+    end;
+forest_take_expr(_, _) ->
+    throw(not_possible).
+
+%% forest_peek_expr(Kvar, Forest) -> Kexpr | error.
+%%  Return the expression corresponding to Kvar in Forest or
+%%  return 'error' if there is a corresponding expression.
+
+forest_peek_expr(#k_var{name=V}, Forest0) ->
+    case maps:find(V, Forest0) of
+	{ok,{_,Expr}} -> Expr;
+	error -> error
+    end.
+
+%% forest_add_expr(Kexpr, Forest, St) -> {Kvar,Forest,St}.
+%%  Add a new expression to Forest.
+
+forest_add_expr(Expr, Forest0, St0) ->
+    {#k_var{name=V}=Var,St} = new_var(St0),
+    N = forest_next_index(Forest0),
+    Forest = Forest0#{V => {N,Expr}},
+    {Var,Forest,St}.
+
+forest_next_index(Forest) ->
+    1 + lists:max([N || {N,_} <- maps:values(Forest),
+			is_integer(N)] ++ [0]).
+
+%% forest_pre_seq([Kexpr], Forest) -> Kexpr.
+%%  Package the list of Kexprs into a nested Kexpr, prepending all
+%%  expressions in Forest that have not been taken out using
+%%  forest_take_expr/2.
+
+forest_pre_seq(Exprs, Forest) ->
+    Es0 = [#k_var{name=V} || {untaken,V} <- maps:keys(Forest)],
+    Es = Es0 ++ Exprs,
+    Vs = extract_all_vars(Es, Forest, []),
+    Pre0 = sort([{maps:get(V, Forest),V} || V <- Vs]),
+    Pre = [#iset{vars=[#k_var{name=V}],arg=A} ||
+	      {{_,A},V} <- Pre0],
+    pre_seq(Pre++droplast(Exprs), last(Exprs)).
+
+extract_all_vars(Es, Forest, Acc0) ->
+    case extract_var_list(Es) of
+	[] ->
+	    Acc0;
+	[_|_]=Vs0 ->
+	    Vs = [V || V <- Vs0, maps:is_key(V, Forest)],
+	    NewVs = ordsets:subtract(Vs, Acc0),
+	    NewEs = [begin
+		      {_,E} = maps:get(V, Forest),
+		      E
+		  end || V <- NewVs],
+	    Acc = union(NewVs, Acc0),
+	    extract_all_vars(NewEs, Forest, Acc)
+    end.
+
+extract_vars(#iset{arg=A,body=B}) ->
+    union(extract_vars(A), extract_vars(B));
+extract_vars(#k_bif{args=Args}) ->
+    ordsets:from_list(lit_list_vars(Args));
+extract_vars(#k_call{}) ->
+    [];
+extract_vars(#k_test{args=Args}) ->
+    ordsets:from_list(lit_list_vars(Args));
+extract_vars(#k_match{body=Body}) ->
+    extract_vars(Body);
+extract_vars(#k_alt{first=First,then=Then}) ->
+    union(extract_vars(First), extract_vars(Then));
+extract_vars(#k_guard{clauses=Cs}) ->
+    extract_var_list(Cs);
+extract_vars(#k_guard_clause{guard=G}) ->
+    extract_vars(G);
+extract_vars(#k_select{var=Var,types=Types}) ->
+    union(ordsets:from_list(lit_vars(Var)),
+	  extract_var_list(Types));
+extract_vars(#k_type_clause{values=Values}) ->
+    extract_var_list(Values);
+extract_vars(#k_val_clause{body=Body}) ->
+    extract_vars(Body);
+extract_vars(#k_try{arg=Arg}) ->
+    extract_vars(Arg);
+extract_vars(Lit) ->
+    ordsets:from_list(lit_vars(Lit)).
+
+extract_var_list(L) ->
+    union([extract_vars(E) || E <- L]).
+
 %% Wrap the entire guard in a try/catch if needed.
 
 wrap_guard(#c_try{}=Try, St) -> {Try,St};