summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSebastian Graf <sebastian.graf@kit.edu>2022-06-07 10:10:14 +0200
committerSebastian Graf <sebastian.graf@kit.edu>2022-06-20 09:40:58 +0200
commit94f2e92a2510a3338c5201a4dcc69666fa9575f8 (patch)
treeefe0ce5ab8180041f906d11e682cd319e8e774fe
parent26745006bdecc2d269fd8252b189650d6bd7ac10 (diff)
downloadhaskell-94f2e92a2510a3338c5201a4dcc69666fa9575f8.tar.gz
CprAnal: Set signatures of DFuns to top
The recursive DFun in the reproducer for #20836 also triggered a bug in CprAnal that is observable in a debug build. The CPR signature of a recursive DFunId was never updated and hence the optimistic arity 0 bottom signature triggered a mismatch with the arity 1 of the binding in WorkWrap. We never miscompiled any code because WW doesn't exploit bottom CPR signatures.
-rw-r--r--compiler/GHC/Core/Opt/CprAnal.hs13
1 files changed, 7 insertions, 6 deletions
diff --git a/compiler/GHC/Core/Opt/CprAnal.hs b/compiler/GHC/Core/Opt/CprAnal.hs
index f6120d64b8..fc5b2abda3 100644
--- a/compiler/GHC/Core/Opt/CprAnal.hs
+++ b/compiler/GHC/Core/Opt/CprAnal.hs
@@ -398,8 +398,10 @@ cprFix orig_env orig_pairs
where
init_sig id
-- See Note [CPR for data structures]
- | isDataStructure id = topCprSig
- | otherwise = mkCprSig 0 botCpr
+ -- Don't set the sig to bottom in this case, because cprAnalBind won't
+ -- update it to something reasonable. Result: Assertion error in WW
+ | isDataStructure id || isDFunId id = topCprSig
+ | otherwise = mkCprSig 0 botCpr
-- See Note [Initialising strictness] in GHC.Core.Opt.DmdAnal
orig_virgin = ae_virgin orig_env
init_pairs | orig_virgin = [(setIdCprSig id (init_sig id), rhs) | (id, rhs) <- orig_pairs ]
@@ -464,10 +466,10 @@ cprAnalBind env id rhs
| isDFunId id -- Never give DFuns the CPR property; we'll never save allocs.
= (id, rhs, extendSigEnv env id topCprSig)
-- See Note [CPR for data structures]
- | isDataStructure id
- = (id, rhs, env) -- Data structure => no code => no need to analyse rhs
+ | isDataStructure id -- Data structure => no code => no need to analyse rhs
+ = (id, rhs, env)
| otherwise
- = (id', rhs', env')
+ = (id `setIdCprSig` sig', rhs', env')
where
(rhs_ty, rhs') = cprAnal env rhs
-- possibly trim thunk CPR info
@@ -481,7 +483,6 @@ cprAnalBind env id rhs
-- See Note [The OPAQUE pragma and avoiding the reboxing of results]
sig' | isOpaquePragma (idInlinePragma id) = topCprSig
| otherwise = sig
- id' = setIdCprSig id sig'
env' = extendSigEnv env id sig'
-- See Note [CPR for thunks]