summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSebastian Graf <sebastian.graf@kit.edu>2022-06-07 10:10:14 +0200
committerBen Gamari <ben@smart-cactus.org>2022-10-12 19:20:16 -0400
commit26af15a009610daa32d550f3769ba1b33ca009c5 (patch)
tree221b84dec6cce147c448972d7540b081d0a7ae95
parent15c496c516aa4e52457b069f67d6b2ed27a0320c (diff)
downloadhaskell-26af15a009610daa32d550f3769ba1b33ca009c5.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. (cherry picked from commit 94f2e92a2510a3338c5201a4dcc69666fa9575f8)
-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 3f6455c9cf..5d5ea632bf 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]