[commit: ghc] master: Minor impovement to when we float a let out of (b4e86fa)

[Simon Peyton Jones]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/b4e86fa8b7a3c7527632aa8ba4b4a94a8719bfa5

>---------------------------------------------------------------

commit b4e86fa8b7a3c7527632aa8ba4b4a94a8719bfa5
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Oct 28 20:32:26 2011 +0100

    Minor impovement to when we float a let out of
    a right-hand side:
    
    Note [Float when cheap or expandable]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We want to float a let from a let if the residual RHS is
       a) cheap, such as (\x. blah)
       b) expandable, such as (f b) if f is CONLIKE
    But there are
      - cheap things that are not expandable (eg \x. expensive)
      - expandable things that are not cheap (eg (f b) where b is CONLIKE)
    so we must take the 'or' of the two.

>---------------------------------------------------------------

 compiler/simplCore/SimplEnv.lhs |   12 +++++++++++-
 1 files changed, 11 insertions(+), 1 deletions(-)

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index 85d2ef3..b5b91ea 100644
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -398,13 +398,23 @@ doFloatFromRhs :: TopLevelFlag -> RecFlag -> Bool -> OutExpr -> SimplEnv -> Bool
 doFloatFromRhs lvl rec str rhs (SimplEnv {seFloats = Floats fs ff})
   =  not (isNilOL fs) && want_to_float && can_float
   where
-     want_to_float = isTopLevel lvl || exprIsExpandable rhs
+     want_to_float = isTopLevel lvl || exprIsCheap rhs || exprIsExpandable rhs 
+     		     -- See Note [Float when cheap or expandable]
      can_float = case ff of
                    FltLifted  -> True
                    FltOkSpec  -> isNotTopLevel lvl && isNonRec rec
                    FltCareful -> isNotTopLevel lvl && isNonRec rec && str
 \end{code}
 
+Note [Float when cheap or expandable]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We want to float a let from a let if the residual RHS is
+   a) cheap, such as (\x. blah)
+   b) expandable, such as (f b) if f is CONLIKE
+But there are 
+  - cheap things that are not expandable (eg \x. expensive)
+  - expandable things that are not cheap (eg (f b) where b is CONLIKE)
+so we must take the 'or' of the two.
 
 \begin{code}
 emptyFloats :: Floats