[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