Merge branch 'bg/compiler' into dev

* bg/compiler:
  beam_peep: Remove optimization already done by beam_dead
  beam_dead: Combine is_eq_exact instructions into select_val instructions
  Evaluate is_record/3 at compile-time using type information
  Evaluate element/2 at compile-time using type information
  erl_expand_records: Replace is_record() with matching

OTP-8668 bg/compiler

The compiler optimizes record operations better.

5 files changed, 220 insertions, 77 deletions

diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index 7b4cd814a2..bb93110176 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -1,19 +1,19 @@
 %%
 %% %CopyrightBegin%
-%% 
-%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
-%% 
+%%
+%% Copyright Ericsson AB 2002-2010. 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%
 %%
 
@@ -281,12 +281,12 @@ forward([{test,is_eq_exact,_,[Dst,Src]}=I,{move,Src,Dst}|Is], D, Lc, Acc) ->
     forward([I|Is], D, Lc, Acc);
 forward([{test,is_nil,_,[Dst]}=I,{move,nil,Dst}|Is], D, Lc, Acc) ->
     forward([I|Is], D, Lc, Acc);
-forward([{test,is_eq_exact,_,[_,{atom,_}]}=I|Is], D, Lc, [{label,_}|_]=Acc) ->
+forward([{test,is_eq_exact,_,_}=I|Is], D, Lc, Acc) ->
     case Is of
 	[{label,_}|_] -> forward(Is, D, Lc, [I|Acc]);
 	_ -> forward(Is, D, Lc+1, [{label,Lc},I|Acc])
     end;
-forward([{test,is_ne_exact,_,[_,{atom,_}]}=I|Is], D, Lc, [{label,_}|_]=Acc) ->
+forward([{test,is_ne_exact,_,_}=I|Is], D, Lc, Acc) ->
     case Is of
 	[{label,_}|_] -> forward(Is, D, Lc, [I|Acc]);
 	_ -> forward(Is, D, Lc+1, [{label,Lc},I|Acc])
@@ -371,10 +371,10 @@ backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) ->
     To = shortcut_bs_start_match(To0, Src, D),
     I = {test,bs_start_match2,{f,To},Live,Info,Dst},
     backward(Is, D, [I|Acc]);
-backward([{test,is_eq_exact=Op,{f,To0},[Reg,{atom,Val}]=Ops}|Is], D, Acc) ->
+backward([{test,is_eq_exact,{f,To0},[Reg,{atom,Val}]=Ops}|Is], D, Acc) ->
     To1 = shortcut_bs_test(To0, Is, D),
     To = shortcut_fail_label(To1, Reg, Val, D),
-    I = {test,Op,{f,To},Ops},
+    I = combine_eqs(To, Ops, D, Acc),
     backward(Is, D, [I|Acc]);
 backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) ->
     To1 = shortcut_bs_test(To0, Is, D),
@@ -394,7 +394,10 @@ backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) ->
 	     _Code ->
 		 To2
 	 end,
-    I = {test,Op,{f,To},Ops0},
+    I = case Op of
+	    is_eq_exact -> combine_eqs(To, Ops0, D, Acc);
+	    _ -> {test,Op,{f,To},Ops0}
+	end,
     backward(Is, D, [I|Acc]);
 backward([{test,Op,{f,To0},Live,Ops0,Dst}|Is], D, Acc) ->
     To1 = shortcut_bs_test(To0, Is, D),
@@ -519,6 +522,41 @@ bif_to_test(Name, Args, Fail) ->
 
 not_possible() -> throw(not_possible).
 
+%% combine_eqs(To, Operands, Acc) -> Instruction.
+%%  Combine two is_eq_exact instructions or (an is_eq_exact
+%%  instruction and a select_val instruction) to a select_val
+%%  instruction if possible.
+%%
+%%  Example:
+%%
+%%      is_eq_exact F1 Reg Lit1		    select_val Reg F2 [ Lit1 L1
+%%   L1:                .                                       Lit2 L2 ]
+%%              	.
+%%                	.	     ==>
+%%                	.
+%%   F1:  is_eq_exact F2 Reg Lit2          F1: is_eq_exact F2 Reg Lit2
+%%   L2:  ....				   L2:
+%%
+combine_eqs(To, [Reg,{Type,_}=Lit1]=Ops, D, [{label,L1}|_])
+  when Type =:= atom; Type =:= integer ->
+    case beam_utils:code_at(To, D) of
+	[{test,is_eq_exact,{f,F2},[Reg,{Type,_}=Lit2]},
+	 {label,L2}|_] when Lit1 =/= Lit2 ->
+	    {select_val,Reg,{f,F2},{list,[Lit1,{f,L1},Lit2,{f,L2}]}};
+	[{select_val,Reg,{f,F2},{list,[{Type,_}|_]=List0}}|_] ->
+	    List = remove_from_list(Lit1, List0),
+	    {select_val,Reg,{f,F2},{list,[Lit1,{f,L1}|List]}};
+	_Is ->
+	    {test,is_eq_exact,{f,To},Ops}
+	end;
+combine_eqs(To, Ops, _D, _Acc) ->
+    {test,is_eq_exact,{f,To},Ops}.
+
+remove_from_list(Lit, [Lit,{f,_}|T]) ->
+    T;
+remove_from_list(Lit, [Val,{f,_}=Fail|T]) ->
+    [Val,Fail|remove_from_list(Lit, T)];
+remove_from_list(_, []) -> [].
 
 %% shortcut_bs_test(TargetLabel, [Instruction], D) -> TargetLabel'
 %%  Try to shortcut the failure label for a bit syntax matching.
diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl
index d03ac4b1f4..f39fc50b95 100644
--- a/lib/compiler/src/beam_peep.erl
+++ b/lib/compiler/src/beam_peep.erl
@@ -1,19 +1,19 @@
 %%
 %% %CopyrightBegin%
-%% 
-%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
-%% 
+%%
+%% Copyright Ericsson AB 2008-2010. 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%
 %%
 
@@ -64,22 +64,7 @@ function({function,Name,Arity,CLabel,Is0}) ->
 %%      InEncoding =:= latin1, OutEncoding =:= unicode; 
 %%      InEncoding =:= latin1, OutEncoding =:= utf8 ->
 %%
-%% (2) Code like
-%%
-%%        is_ne_exact Fail Reg Literal1
-%%        is_ne_exact Fail Reg Literal2
-%%        is_ne_exact Fail Reg Literal3
-%%        is_eq_exact UltimateFail Reg Literal4
-%%      Fail: ....
-%%
-%%     can be rewritten to
-%% 
-%%        select_val Reg UltimateFail   [ Literal1 Fail
-%%                                        Literal2 Fail
-%%                                        Literal3 Fail
-%%                                        Literal4 Fail ]
-%%
-%% (3) A select_val/4 instruction that only verifies that
+%% (2) A select_val/4 instruction that only verifies that
 %%     its argument is either 'true' or 'false' can be
 %%     be replaced with an is_boolean/2 instruction. That is:
 %%
@@ -132,7 +117,7 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) ->
 		false ->
 		    %% Remember that we have seen this test.
 		    SeenTests = gb_sets:insert(Test, SeenTests0),
-		    make_select_val(I, Is, SeenTests, Acc)
+		    peep(Is, SeenTests, [I|Acc])
 	    end
     end;
 peep([{select_val,Src,Fail,
@@ -151,33 +136,6 @@ peep([I|Is], _, Acc) ->
     peep(Is, gb_sets:empty(), [I|Acc]);
 peep([], _, Acc) -> reverse(Acc).
 
-make_select_val({test,is_ne_exact,{f,Fail},[Val,Lit]}=I0,
-		Is0, SeenTests, Acc) ->
-    try
-	Type = case Lit of
-		   {atom,_} -> atom;
-		   {integer,_} -> integer;
-		   _ -> throw(impossible)
-	       end,
-	{I,Is} = make_select_val_1(Is0, Fail, Val, Type, [Lit,{f,Fail}]),
-	peep([I|Is], SeenTests, Acc)
-    catch
-	impossible ->
-	    peep(Is0, SeenTests, [I0|Acc])
-    end;
-make_select_val(I, Is, SeenTests, Acc) ->
-    peep(Is, SeenTests, [I|Acc]).
-
-make_select_val_1([{test,is_ne_exact,{f,Fail},[Val,{Type,_}=Lit]}|Is],
-		  Fail, Val, Type, Acc) ->
-      make_select_val_1(Is, Fail, Val, Type, [Lit,{f,Fail}|Acc]);
-make_select_val_1([{test,is_eq_exact,{f,UltimateFail},[Val,{Type,_}=Lit]} |
-		   [{label,Fail}|_]=Is], Fail, Val, Type, Acc) ->
-    Choices = [Lit,{f,Fail}|Acc],
-    I = {select_val,Val,{f,UltimateFail},{list,Choices}},
-    {I,Is};
-make_select_val_1(_Is, _Fail, _Val, _Type, _Acc) -> throw(impossible).
-    
 kill_seen(Dst, Seen0) ->
     gb_sets:from_ordset(kill_seen_1(gb_sets:to_list(Seen0), Dst)).
 
@@ -187,5 +145,3 @@ kill_seen_1([{_,Ops}=Test|T], Dst) ->
 	false -> [Test|kill_seen_1(T, Dst)]
     end;
 kill_seen_1([], _) -> [].
-
-	    
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 6202f07479..96015fbe58 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -1038,6 +1038,8 @@ 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
@@ -1194,19 +1196,22 @@ eval_element(Call, #c_literal{val=Pos}, #c_tuple{es=Es}, _Types) when is_integer
 	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) ->
-%% 		    lists:nth(Pos, Elements);
-%% 		true ->
-%% 		    eval_failure(Call, badarg)
-%% 	    end;
-%% 	error ->
-%% 	    Call
-%%     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;
+	error ->
+	    Call
+    end;
 eval_element(Call, Pos, Tuple, _Types) ->
     case is_not_integer(Pos) orelse is_not_tuple(Tuple) of
 	true ->
@@ -1215,6 +1220,20 @@ eval_element(Call, Pos, Tuple, _Types) ->
 	    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.
 
diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl
index a38b7639d8..18c467db81 100644
--- a/lib/stdlib/src/erl_expand_records.erl
+++ b/lib/stdlib/src/erl_expand_records.erl
@@ -95,8 +95,9 @@ forms([F | Fs0], St0) ->
 forms([], St) -> {[],St}.
 
 clauses([{clause,Line,H0,G0,B0} | Cs0], St0) ->
-    {H,St1} = head(H0, St0),
-    {G,St2} = guard(G0, St1),
+    {H1,St1} = head(H0, St0),
+    {G1,St2} = guard(G0, St1),
+    {H,G} = optimize_is_record(H1, G1),
     {B,St3} = exprs(B0, St2),
     {Cs,St4} = clauses(Cs0, St3),
     {[{clause,Line,H,G,B} | Cs],St4};
@@ -800,5 +801,132 @@ imported(F, A, St) ->
         error -> no
     end.
 
+%%%
+%%% Replace is_record/3 in guards with matching if possible.
+%%%
+
+optimize_is_record(H0, G0) ->
+    case opt_rec_vars(G0) of
+	[] ->
+	    {H0,G0};
+	Rs0 ->
+	    {H,Rs} = opt_pattern_list(H0, Rs0),
+	    G = opt_remove(G0, Rs),
+	    {H,G}
+    end.
+
+
+%% opt_rec_vars(Guards) -> Vars.
+%%  Search through the guard expression, looking for
+%%  variables referenced in those is_record/3 calls that
+%%  will fail the entire guard if they evaluate to 'false'
+%%
+%%  In the following code
+%%
+%%      f(X, Y, Z) when is_record(X, r1) andalso
+%%                           (is_record(Y, r2) orelse is_record(Z, r3))
+%%
+%%  the entire guard will be false if the record test for
+%%  X fails, and the clause can be rewritten to:
+%%
+%%      f({r1,...}=X, Y, Z) when true andalso
+%%                              (is_record(Y, r2) or is_record(Z, r3))
+%%
+opt_rec_vars([G|Gs]) ->
+    Rs = opt_rec_vars_1(G, orddict:new()),
+    opt_rec_vars(Gs, Rs);
+opt_rec_vars([]) -> orddict:new().
+
+opt_rec_vars([G|Gs], Rs0) ->
+    Rs1 = opt_rec_vars_1(G, orddict:new()),
+    Rs = ordsets:intersection(Rs0, Rs1),
+    opt_rec_vars(Gs, Rs);
+opt_rec_vars([], Rs) -> Rs.
+
+opt_rec_vars_1([T|Ts], Rs0) ->
+    Rs = opt_rec_vars_2(T, Rs0),
+    opt_rec_vars_1(Ts, Rs);
+opt_rec_vars_1([], Rs) -> Rs.
+
+opt_rec_vars_2({op,_,'and',A1,A2}, Rs) ->
+    opt_rec_vars_1([A1,A2], Rs);
+opt_rec_vars_2({op,_,'andalso',A1,A2}, Rs) ->
+    opt_rec_vars_1([A1,A2], Rs);
+opt_rec_vars_2({op,_,'orelse',Arg,{atom,_,fail}}, Rs) ->
+    %% Since the second argument guarantees failure,
+    %% it is safe to inspect the first argument.
+    opt_rec_vars_2(Arg, Rs);
+opt_rec_vars_2({call,_,{remote,_,{atom,_,erlang},{atom,_,is_record}},
+		[{var,_,V},{atom,_,Tag},{integer,_,Sz}]}, Rs) ->
+    orddict:store(V, {Tag,Sz}, Rs);
+opt_rec_vars_2({call,_,{atom,_,is_record},
+		[{var,_,V},{atom,_,Tag},{integer,_,Sz}]}, Rs) ->
+    orddict:store(V, {Tag,Sz}, Rs);
+opt_rec_vars_2(_, Rs) -> Rs.
+
+opt_pattern_list(Ps, Rs) ->
+    opt_pattern_list(Ps, Rs, []).
+
+opt_pattern_list([P0|Ps], Rs0, Acc) ->
+    {P,Rs} = opt_pattern(P0, Rs0),
+    opt_pattern_list(Ps, Rs, [P|Acc]);
+opt_pattern_list([], Rs, Acc) ->
+    {reverse(Acc),Rs}.
+
+opt_pattern({var,_,V}=Var, Rs0) ->
+    case orddict:find(V, Rs0) of
+	{ok,{Tag,Sz}} ->
+	    Rs = orddict:store(V, {remove,Tag,Sz}, Rs0),
+	    {opt_var(Var, Tag, Sz),Rs};
+	_ ->
+	    {Var,Rs0}
+    end;
+opt_pattern({cons,Line,H0,T0}, Rs0) ->
+    {H,Rs1} = opt_pattern(H0, Rs0),
+    {T,Rs} = opt_pattern(T0, Rs1),
+    {{cons,Line,H,T},Rs};
+opt_pattern({tuple,Line,Es0}, Rs0) ->
+    {Es,Rs} = opt_pattern_list(Es0, Rs0),
+    {{tuple,Line,Es},Rs};
+opt_pattern({match,Line,Pa0,Pb0}, Rs0) ->
+    {Pa,Rs1} = opt_pattern(Pa0, Rs0),
+    {Pb,Rs} = opt_pattern(Pb0, Rs1),
+    {{match,Line,Pa,Pb},Rs};
+opt_pattern(P, Rs) -> {P,Rs}.
+
+opt_var({var,Line,_}=Var, Tag, Sz) ->
+    Rp = record_pattern(2, -1, ignore, Sz, Line, [{atom,Line,Tag}]),
+    {match,Line,{tuple,Line,Rp},Var}.
+
+opt_remove(Gs, Rs) ->
+    [opt_remove_1(G, Rs) || G <- Gs].
+
+opt_remove_1(Ts, Rs) ->
+    [opt_remove_2(T, Rs) || T <- Ts].
+
+opt_remove_2({op,L,'and'=Op,A1,A2}, Rs) ->
+    {op,L,Op,opt_remove_2(A1, Rs),opt_remove_2(A2, Rs)};
+opt_remove_2({op,L,'andalso'=Op,A1,A2}, Rs) ->
+    {op,L,Op,opt_remove_2(A1, Rs),opt_remove_2(A2, Rs)};
+opt_remove_2({op,L,'orelse',A1,A2}, Rs) ->
+    {op,L,'orelse',opt_remove_2(A1, Rs),A2};
+opt_remove_2({call,Line,{remote,_,{atom,_,erlang},{atom,_,is_record}},
+	      [{var,_,V},{atom,_,Tag},{integer,_,Sz}]}=A, Rs) ->
+    case orddict:find(V, Rs) of
+	{ok,{remove,Tag,Sz}} ->
+	    {atom,Line,true};
+	_ ->
+	    A
+    end;
+opt_remove_2({call,Line,{atom,_,is_record},
+	      [{var,_,V},{atom,_,Tag},{integer,_,Sz}]}=A, Rs) ->
+    case orddict:find(V, Rs) of
+	{ok,{remove,Tag,Sz}} ->
+	    {atom,Line,true};
+	_ ->
+	    A
+    end;
+opt_remove_2(A, _) -> A.
+
 neg_line(L) ->
     erl_parse:set_line(L, fun(Line) -> -abs(Line) end).
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index aa12ed57da..e21de8770a 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -3184,7 +3184,9 @@ lookup2(Config) when is_list(Config) ->
                  [] = qlc:e(Q),
                  false = lookup_keys(Q)
          end, [{1,b},{2,3}])">>,
-        {warnings,[{{3,48},qlc,nomatch_filter}]}},
+        {warnings,[{2,sys_core_fold,nomatch_guard},
+		   {3,qlc,nomatch_filter},
+		   {3,sys_core_fold,{eval_failure,badarg}}]}},
 
        <<"etsc(fun(E) ->
                 Q = qlc:q([X || {X} <- ets:table(E), element(1,{X}) =:= 1]),