[commit: ghc] wip/rwbarton-float-unboxed: WIP: Less floating out of unboxed strings (04ffaf5)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/rwbarton-float-unboxed
Link       : http://ghc.haskell.org/trac/ghc/changeset/04ffaf5efc08fbbd73fb3c957e11522a0d3c1eec/ghc

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

commit 04ffaf5efc08fbbd73fb3c957e11522a0d3c1eec
Author: Reid Barton <rwbarton at gmail.com>
Date:   Mon Feb 27 13:25:19 2017 -0500

    WIP: Less floating out of unboxed strings


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

04ffaf5efc08fbbd73fb3c957e11522a0d3c1eec
 compiler/simplCore/SetLevels.hs | 3 +--
 compiler/simplCore/Simplify.hs  | 4 ++--
 2 files changed, 3 insertions(+), 4 deletions(-)

diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs
index 94d5bcd..2ab0cdc 100644
--- a/compiler/simplCore/SetLevels.hs
+++ b/compiler/simplCore/SetLevels.hs
@@ -66,7 +66,6 @@ import CoreSyn
 import CoreMonad        ( FloatOutSwitches(..) )
 import CoreUtils        ( exprType, exprIsHNF
                         , exprOkForSpeculation
-                        , exprIsTopLevelBindable
                         , isExprLevPoly
                         , collectMakeStaticArgs
                         )
@@ -561,7 +560,7 @@ lvlMFE env strict_ctxt ann_expr
   =     -- Don't float it out
     lvlExpr env ann_expr
 
-  |  float_is_new_lam || need_join || exprIsTopLevelBindable expr expr_ty
+  |  float_is_new_lam || need_join || not (isUnliftedType expr_ty)
   || expr_ok_for_spec && not (isTopLvl dest_lvl)
          -- No wrapping needed if the type is lifted, or is a literal string
          -- or if we are wrapping it in one or more value lambdas
diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs
index 4ef2994..0bdfb85 100644
--- a/compiler/simplCore/Simplify.hs
+++ b/compiler/simplCore/Simplify.hs
@@ -681,8 +681,8 @@ makeTrivialWithInfo top_lvl env context info expr
 bindingOk :: TopLevelFlag -> CoreExpr -> Type -> Bool
 -- True iff we can have a binding of this expression at this level
 -- Precondition: the type is the type of the expression
-bindingOk top_lvl expr expr_ty
-  | isTopLevel top_lvl = exprIsTopLevelBindable expr expr_ty
+bindingOk top_lvl _expr expr_ty
+  | isTopLevel top_lvl = not (isUnliftedType expr_ty)
   | otherwise          = True
 
 {-