summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2022-07-12 16:16:56 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-07-18 16:38:04 -0400
commitd0b806fff79ad80ae587f2e081a71b3d85ac7589 (patch)
tree1597b9b9dcba9436b7e0236a0523b9064becf778
parent9bdfdd98e9be4eb0ff687e638fe5c33c6284a31c (diff)
downloadhaskell-d0b806fff79ad80ae587f2e081a71b3d85ac7589.tar.gz
Make SetLevels honour floatConsts
This fix, in the definition of profitableFloat, is just for consistency. `floatConsts` should do what it says! I don't think it'll affect anything much, though.
-rw-r--r--compiler/GHC/Core/Opt/SetLevels.hs8
1 files changed, 4 insertions, 4 deletions
diff --git a/compiler/GHC/Core/Opt/SetLevels.hs b/compiler/GHC/Core/Opt/SetLevels.hs
index a8a99ba42f..8dea553ad5 100644
--- a/compiler/GHC/Core/Opt/SetLevels.hs
+++ b/compiler/GHC/Core/Opt/SetLevels.hs
@@ -1017,9 +1017,9 @@ annotateBotStr :: Id -> Arity -> Maybe (Arity, DmdSig) -> Id
annotateBotStr id n_extra mb_str
= case mb_str of
Nothing -> id
- Just (arity, sig) -> id `setIdArity` (arity + n_extra)
- `setIdDmdSig` (prependArgsDmdSig n_extra sig)
- `setIdCprSig` mkCprSig (arity + n_extra) botCpr
+ Just (arity, sig) -> id `setIdArity` (arity + n_extra)
+ `setIdDmdSig` prependArgsDmdSig n_extra sig
+ `setIdCprSig` mkCprSig (arity + n_extra) botCpr
notWorthFloating :: CoreExpr -> [Var] -> Bool
-- Returns True if the expression would be replaced by
@@ -1262,7 +1262,7 @@ lvlBind env (AnnRec pairs)
profitableFloat :: LevelEnv -> Level -> Bool
profitableFloat env dest_lvl
= (dest_lvl `ltMajLvl` le_ctxt_lvl env) -- Escapes a value lambda
- || isTopLvl dest_lvl -- Going all the way to top level
+ || (isTopLvl dest_lvl && floatConsts env) -- Going all the way to top level
----------------------------------------------------