From 85cc321c5d3d1e78a895a549a856266228a75a02 Mon Sep 17 00:00:00 2001
From: Anthony Ramine <n.oxyde@gmail.com>
Date: Fri, 7 Feb 2014 02:07:04 +0100
Subject: Optimise case arguments in sys_core_fold

If the argument of a case expression is a let, a seq or a case with two clauses
where the second one is a failing clause; it can be moved outside the case and
further optimisations can be performed.

module 'foo' ['t'/4]
  attributes []
't'/4 =
  fun (_cor14,Sub0,_cor15,_cor16) ->
    let Ssa = call 'erlang':'get' ('foo') in
      case let Ssa = {'ssa',_cor14,Sub0,_cor15,_cor16} in
           let _rec11 = call 'erlang':'+' (_cor14, 1) in
           let _cor4 = call 'erlang':'setelement' (2, Ssa, _rec11) in
             {{'tmp',_cor14},_cor4} of
        {NewReg,Foo} when 'true' ->
          {NewReg,Foo,Ssa}
        _cor20 when 'true' ->
          primop 'match_failure' ({'case_clause',_cor20})
      end
end

  ==>

module 'foo' ['t'/4]
  attributes []
't'/4 =
  fun (_cor14,Sub0,_cor15,_cor16) ->
    let Ssa = call 'erlang':'get' ('foo') in
    let _fol0 = {'ssa',_cor14,Sub0,_cor15,_cor16} in
    let _rec11 = call 'erlang':'+' (_cor14, 1) in
    let _cor4 = call 'erlang':'setelement' (2, _fol0, _rec11) in
    let NewReg = {'tmp',_cor14} in
      {NewReg,_cor4,Ssa}
end
---
 lib/compiler/src/sys_core_fold.erl | 78 +++++++++++++++++++++++++++++++++++++-
 1 file changed, 77 insertions(+), 1 deletion(-)

(limited to 'lib/compiler/src/sys_core_fold.erl')

diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index d1eec9e347..c45c7aa1de 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -349,7 +349,12 @@ expr(#c_case{}=Case0, Ctxt, Sub) ->
 	    Case = Case1#c_case{arg=Arg2,clauses=Cs2},
 	    warn_no_clause_match(Case1, Case),
 	    Expr = eval_case(Case, Sub),
-	    bsm_an(Expr);
+            case move_case_into_arg(Case, Sub) of
+                impossible ->
+                    bsm_an(Expr);
+                Other ->
+                    expr(Other, Ctxt, sub_new_preserve_types(Sub))
+            end;
 	Other ->
 	    expr(Other, Ctxt, Sub)
     end;
@@ -2571,6 +2576,77 @@ opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) ->
 	      value, Sub)
     end.
 
+move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg,
+                                      body=InnerArg0}=Outer,
+                           clauses=InnerClauses}=Inner, Sub) ->
+    %%
+    %% case let <OuterVars> = <OuterArg> in <InnerArg> of
+    %%     <InnerClauses>
+    %% end
+    %%
+    %%       ==>
+    %%
+    %% let <OuterVars> = <OuterArg>
+    %% in case <InnerArg> of <InnerClauses> end
+    %%
+    ScopeSub0 = sub_subst_scope(Sub#sub{t=[]}),
+    {OuterVars,ScopeSub} = pattern_list(OuterVars0, ScopeSub0),
+    InnerArg = body(InnerArg0, ScopeSub),
+    Outer#c_let{vars=OuterVars,arg=OuterArg,
+                body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}};
+move_case_into_arg(#c_case{arg=#c_case{arg=OuterArg,
+                                       clauses=[OuterCa0,OuterCb]}=Outer,
+                           clauses=InnerClauses}=Inner0, Sub) ->
+    case is_failing_clause(OuterCb) of
+        true ->
+            #c_clause{pats=OuterPats0,guard=OuterGuard0,
+                      body=InnerArg0} = OuterCa0,
+            %%
+            %% case case <OuterArg> of
+            %%          <OuterPats> when <OuterGuard> -> <InnerArg>
+            %%          <OuterCb>
+            %%          ...
+            %%      end of
+            %%     <InnerClauses>
+            %% end
+            %%
+            %%       ==>
+            %%
+            %% case <OuterArg> of
+            %%     <OuterPats> when <OuterGuard> ->
+            %%         case <InnerArg> of <InnerClauses> end
+            %%     <OuterCb>
+            %% end
+            %%
+            ScopeSub0 = sub_subst_scope(Sub#sub{t=[]}),
+            {OuterPats,ScopeSub} = pattern_list(OuterPats0, ScopeSub0),
+            OuterGuard = guard(OuterGuard0, ScopeSub),
+            InnerArg = body(InnerArg0, ScopeSub),
+            Inner = Inner0#c_case{arg=InnerArg,clauses=InnerClauses},
+            OuterCa = OuterCa0#c_clause{pats=OuterPats,guard=OuterGuard,
+                                        body=Inner},
+            Outer#c_case{arg=OuterArg,
+                         clauses=[OuterCa,OuterCb]};
+        false ->
+            impossible
+    end;
+move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer,
+                           clauses=InnerClauses}=Inner, _Sub) ->
+    %%
+    %% case do <OuterArg> <InnerArg> of
+    %%     <InnerClauses>
+    %% end
+    %%
+    %%       ==>
+    %%
+    %% do <OuterArg>
+    %%    case <InnerArg> of <InerClauses> end
+    %%
+    Outer#c_seq{arg=OuterArg,
+                body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}};
+move_case_into_arg(_, _) ->
+    impossible.
+
 %% In guards only, rewrite a case in a let argument like
 %%
 %%    let <Var> = case <> of
-- 
cgit v1.2.3