Improve code generation for a 'case' with exported variables

Consider a 'case' that exports variables and whose return
value is ignored:

foo(N) ->
    case N of
        1 ->
            Res = one;
        2 ->
            Res = two
    end,
    {ok,Res}.

That code will be translated to the following Core Erlang code:

'foo'/1 =
    fun (_@c0) ->
        let <_@c5,Res> =
           case _@c0 of
	      <1> when 'true' ->
                  <'one','one'>
	      <2> when 'true' ->
                  <'two','two'>
	      <_@c3> when 'true' ->
                  primop 'match_fail'({'case_clause',_@c3})
           end
	in
           {'ok',Res}

The exported variables has been rewritten to explicit return
values. Note that the original return value from the 'case' is bound to
the variable _@c5, which is unused.

The corresponding BEAM assembly code looks like this:

{function, foo, 1, 2}.
  {label,1}.
    {line,[...]}.
    {func_info,{atom,t},{atom,foo},1}.
  {label,2}.
    {test,is_integer,{f,6},[{x,0}]}.
    {select_val,{x,0},{f,6},{list,[{integer,2},{f,3},{integer,1},{f,4}]}}.
  {label,3}.
    {move,{atom,two},{x,1}}.
    {move,{atom,two},{x,0}}.
    {jump,{f,5}}.
  {label,4}.
    {move,{atom,one},{x,1}}.
    {move,{atom,one},{x,0}}.
  {label,5}.
    {test_heap,3,2}.
    {put_tuple,2,{x,0}}.
    {put,{atom,ok}}.
    {put,{x,1}}.
    return.
  {label,6}.
    {line,[...]}.
    {case_end,{x,0}}.

Because of the test_heap instruction following label 5, the assignment
to {x,0} cannot be optimized away by the passes that optimize BEAM assembly
code.

Refactor the optimizations of 'let' in sys_core_fold to eliminate the
unused variable. Thus:

'foo'/1 =
    fun (_@c0) ->
       let <Res> =
           case _@c0 of
              <1> when 'true' ->
                 'one'
              <2> when 'true' ->
                 'two'
              <_@c3> when 'true' ->
                  primop 'match_fail'({'case_clause',_@c3})
           end
       in
           {'ok',Res}

The resulting BEAM code will look like:

{function, foo, 1, 2}.
  {label,1}.
    {line,[...]}.
    {func_info,{atom,t},{atom,foo},1}.
  {label,2}.
    {test,is_integer,{f,6},[{x,0}]}.
    {select_val,{x,0},{f,6},{list,[{integer,2},{f,3},{integer,1},{f,4}]}}.
  {label,3}.
    {move,{atom,two},{x,0}}.
    {jump,{f,5}}.
  {label,4}.
    {move,{atom,one},{x,0}}.
  {label,5}.
    {test_heap,3,1}.
    {put_tuple,2,{x,1}}.
    {put,{atom,ok}}.
    {put,{x,0}}.
    {move,{x,1},{x,0}}.
    return.
  {label,6}.
    {line,[...]}.
    {case_end,{x,0}}.

2 files changed, 105 insertions, 32 deletions

diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 2dc2dd51ff..46816fe24a 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -145,14 +145,9 @@ find_fixpoint(OptFun, Core0, Max) ->
 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(#c_values{anno=A,es=Es0}, value, Sub) ->
+    Es1 = expr_list(Es0, value, Sub),
+    #c_values{anno=A,es=Es1};
 body(E, Ctxt, Sub) ->
     ?ASSERT(verify_scope(E, Sub)),
     expr(E, Ctxt, Sub).
@@ -2687,22 +2682,73 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) ->
 	{[],#c_values{es=[]},_} ->
 	    %% No variables left.
 	    Body;
-	{Vs,Arg1,Body} ->
-	    %% If none of the variables are used in the body, we can
-	    %% rewrite the let to a sequence:
-	    %%    let <Var> = Arg in BodyWithoutVar ==>
-	    %%        seq Arg BodyWithoutVar
-	    case is_any_var_used(Vs, Body) of
-		false ->
-		    Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody),
-		    #c_seq{arg=Arg,body=Body};
-		true ->
-		    Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body},
-		    opt_bool_case_in_let(Let1, Sub)
+	{[#c_var{name=V}=Var|Vars]=Vars0,Arg1,Body} ->
+            case core_lib:is_var_used(V, Body) of
+                false when Vars =:= [] ->
+                    %% If the variable is not used in the body, we can
+                    %% rewrite the let to a sequence:
+                    %%    let <Var> = Arg in BodyWithoutVar ==>
+                    %%        seq Arg BodyWithoutVar
+                    Arg = maybe_suppress_warnings(Arg1, Var, PrevBody),
+                    #c_seq{arg=Arg,body=Body};
+                false ->
+                    %% There are multiple values returned by the argument
+                    %% and the first value is not used (this is a 'case'
+                    %% with exported variables, but the return value is
+                    %% ignored). We can remove the first variable and the
+                    %% the first value returned from the 'let' argument.
+                    Arg2 = remove_first_value(Arg1, Sub),
+                    Let1 = Let0#c_let{vars=Vars,arg=Arg2,body=Body},
+                    post_opt_let(Let1, Sub);
+                true ->
+                    Let1 = Let0#c_let{vars=Vars0,arg=Arg1,body=Body},
+                    post_opt_let(Let1, Sub)
 	    end
     end.
 
-%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody) -> Arg'
+%% post_opt_let(Let, Sub)
+%%  Final optimizations of the let.
+%%
+%%  Note that the substitutions and scope in Sub have been cleared
+%%  and should not be used.
+
+post_opt_let(Let, Sub) ->
+    opt_bool_case_in_let(Let, Sub).
+
+
+%% remove_first_value(Core0, Sub) -> Core.
+%%  Core0 is an expression that returns at least two values.
+%%  Remove the first value returned from Core0.
+
+remove_first_value(#c_values{es=[V|Vs]}, Sub) ->
+    Values = core_lib:make_values(Vs),
+    case is_safe_simple(V, Sub) of
+        false ->
+            #c_seq{arg=V,body=Values};
+        true ->
+            Values
+    end;
+remove_first_value(#c_case{clauses=Cs0}=Core, Sub) ->
+    Cs = remove_first_value_cs(Cs0, Sub),
+    Core#c_case{clauses=Cs};
+remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core, Sub) ->
+    Cs = remove_first_value_cs(Cs0, Sub),
+    Act = remove_first_value(Act0, Sub),
+    Core#c_receive{clauses=Cs,action=Act};
+remove_first_value(#c_let{body=B}=Core, Sub) ->
+    Core#c_let{body=remove_first_value(B, Sub)};
+remove_first_value(#c_seq{body=B}=Core, Sub) ->
+    Core#c_seq{body=remove_first_value(B, Sub)};
+remove_first_value(#c_primop{}=Core, _Sub) ->
+    Core;
+remove_first_value(#c_call{}=Core, _Sub) ->
+    Core.
+
+remove_first_value_cs(Cs, Sub) ->
+    [C#c_clause{body=remove_first_value(B, Sub)} ||
+        #c_clause{body=B}=C <- Cs].
+
+%% maybe_suppress_warnings(Arg, #c_var{}, PreviousBody) -> Arg'
 %%  Try to suppress false warnings when a variable is not used.
 %%  For instance, we don't expect a warning for useless building in:
 %%
@@ -2713,12 +2759,12 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) ->
 %%  referenced in the original unoptimized code. If they were, we will
 %%  consider the warning false and suppress it.
 
-maybe_suppress_warnings(Arg, Vs, PrevBody) ->
+maybe_suppress_warnings(Arg, #c_var{name=V}, PrevBody) ->
     case should_suppress_warning(Arg) of
 	true ->
 	    Arg;				%Already suppressed.
 	false ->
-	    case is_any_var_used(Vs, PrevBody) of
+	    case core_lib:is_var_used(V, PrevBody) of
 		true ->
 		    suppress_warning([Arg]);
 		false ->
@@ -2826,13 +2872,6 @@ move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer,
 move_case_into_arg(Expr, _) ->
     Expr.
 
-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.
-
 %%%
 %%% Retrieving information about types.
 %%%
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index 262967d03d..4fd1f84569 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -27,7 +27,7 @@
 	 multiple_aliases/1,redundant_boolean_clauses/1,
 	 mixed_matching_clauses/1,unnecessary_building/1,
 	 no_no_file/1,configuration/1,supplies/1,
-         redundant_stack_frame/1]).
+         redundant_stack_frame/1,export_from_case/1]).
 
 -export([foo/0,foo/1,foo/2,foo/3]).
 
@@ -47,7 +47,7 @@ groups() ->
        multiple_aliases,redundant_boolean_clauses,
        mixed_matching_clauses,unnecessary_building,
        no_no_file,configuration,supplies,
-       redundant_stack_frame]}].
+       redundant_stack_frame,export_from_case]}].
 
 
 init_per_suite(Config) ->
@@ -551,4 +551,38 @@ do_redundant_stack_frame(Map) ->
         end,
     {X, Y}.
 
+%% Cover some clauses in sys_core_fold:remove_first_value/2.
+
+-record(export_from_case, {val}).
+
+export_from_case(_Config) ->
+    a = export_from_case_1(true),
+    b = export_from_case_1(false),
+
+    R = #export_from_case{val=0},
+    {ok,R} = export_from_case_2(false, R),
+    {ok,#export_from_case{val=42}} = export_from_case_2(true, R),
+
+    ok.
+
+export_from_case_1(Bool) ->
+    case Bool of
+        true ->
+            id(42),
+            Result = a;
+        false ->
+            Result = b
+    end,
+    id(Result).
+
+export_from_case_2(Bool, Rec) ->
+    case Bool of
+        false ->
+            Result = Rec;
+        true ->
+            Result = Rec#export_from_case{val=42}
+    end,
+    {ok,Result}.
+
+
 id(I) -> I.