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 /compiler/simplCore/SetLevels.hs | |
| parent | 28664d742eb0f790e5dbbcdd30d4dbc3bbec5412 (diff) | |
| download | haskell-wip/rwbarton-float-unboxed.tar.gz | |
WIP: Less floating out of unboxed stringswip/rwbarton-float-unboxed
Diffstat (limited to 'compiler/simplCore/SetLevels.hs')
| -rw-r--r-- | compiler/simplCore/SetLevels.hs | 3 |
1 files changed, 1 insertions, 2 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 |