summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2022-07-12 16:16:56 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2022-07-18 09:01:28 +0100
commitf6a14dcbf003a6669efe6481bd09e9109828fa92 (patch)
treecfbb21dec4d6a82f31ec0948b4d4d2d85708eb92
parentd49abf3d436aebb95487e6661ebb821fcbf807e4 (diff)
downloadhaskell-f6a14dcbf003a6669efe6481bd09e9109828fa92.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
----------------------------------------------------