diff options
| author | Reid Barton <rwbarton@gmail.com> | 2017-02-27 13:25:19 -0500 |
|---|---|---|
| committer | Reid Barton <rwbarton@gmail.com> | 2017-02-28 10:18:52 -0500 |
| commit | 04ffaf5efc08fbbd73fb3c957e11522a0d3c1eec (patch) | |
| tree | 082e3029f107be8adc5ce0a9b983a0bc6b607bbf | |
| parent | 28664d742eb0f790e5dbbcdd30d4dbc3bbec5412 (diff) | |
| download | haskell-wip/rwbarton-float-unboxed.tar.gz | |
WIP: Less floating out of unboxed stringswip/rwbarton-float-unboxed
| -rw-r--r-- | compiler/simplCore/SetLevels.hs | 3 | ||||
| -rw-r--r-- | 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 94d5bcd2c4..2ab0cdcc6e 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 4ef299440e..0bdfb8519b 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 {- |