[commit: ghc] wip/nested-cpr: In deferType, return convRes = Converges NoCPR (19eece6)
git at git.haskell.org
git at git.haskell.org
Fri Dec 6 17:01:27 UTC 2013
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nested-cpr
Link : http://ghc.haskell.org/trac/ghc/changeset/19eece6d7d76f281b0b1686ad56136bb86d59a3f/ghc
>---------------------------------------------------------------
commit 19eece6d7d76f281b0b1686ad56136bb86d59a3f
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Wed Dec 4 16:55:18 2013 +0000
In deferType, return convRes = Converges NoCPR
because this is the right-identity to `bothDmdResult`, and this is the
right thing to do in a lazy context.
>---------------------------------------------------------------
19eece6d7d76f281b0b1686ad56136bb86d59a3f
compiler/basicTypes/Demand.lhs | 9 ++++++---
1 file changed, 6 insertions(+), 3 deletions(-)
diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index 5f140df..092a950 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -793,8 +793,9 @@ seqCPRResult (RetCon n rs) = n `seq` seqListWith seqDmdResult rs
-- [cprRes] lets us switch off CPR analysis
-- by making sure that everything uses TopRes
-topRes, botRes :: DmdResult
+topRes, convRes, botRes :: DmdResult
topRes = Dunno NoCPR
+convRes = Converges NoCPR
botRes = Diverges
maxCPRDepth :: Int
@@ -1173,10 +1174,12 @@ postProcessDmdType (False, Many) ty = useType ty
postProcessDmdType (True, One) ty = deferType ty
postProcessDmdType (False, One) ty = ty
+-- If we use something lazily, we want to ignore any possible divergence
+-- (Otherwise we'd lose the termination information of constructors in in dmdAnalVarApp
deferType, useType, deferAndUse :: DmdType -> DmdType
-deferType (DmdType fv ds _) = DmdType (deferEnv fv) (map deferDmd ds) topRes
+deferType (DmdType fv ds _) = DmdType (deferEnv fv) (map deferDmd ds) convRes
useType (DmdType fv ds res_ty) = DmdType (useEnv fv) (map useDmd ds) res_ty
-deferAndUse (DmdType fv ds _) = DmdType (deferUseEnv fv) (map deferUseDmd ds) topRes
+deferAndUse (DmdType fv ds _) = DmdType (deferUseEnv fv) (map deferUseDmd ds) convRes
deferEnv, useEnv, deferUseEnv :: DmdEnv -> DmdEnv
deferEnv fv = mapVarEnv deferDmd fv
More information about the ghc-commits
mailing list