[commit: ghc] wip/nested-cpr: In deferType, return convRes = Converges NoCPR (6bd9939)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nested-cpr
Link       : http://ghc.haskell.org/trac/ghc/changeset/6bd9939ba8e7d0efe0aba410e97496afd89d58dc/ghc

>---------------------------------------------------------------

commit 6bd9939ba8e7d0efe0aba410e97496afd89d58dc
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.


>---------------------------------------------------------------

6bd9939ba8e7d0efe0aba410e97496afd89d58dc
 compiler/basicTypes/Demand.lhs |   12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index 27ed312..bb2e215 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -786,8 +786,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
@@ -1206,20 +1207,17 @@ 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
 deferType, useType, deferAndUse :: DmdType -> DmdType
-deferType   (DmdType fv ds res_ty) = DmdType (deferEnv fv)    (map deferDmd ds)    (deferRes res_ty)
+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 res_ty) = DmdType (deferUseEnv fv) (map deferUseDmd ds) (deferRes res_ty)
+deferAndUse (DmdType fv ds _)      = DmdType (deferUseEnv fv) (map deferUseDmd ds) convRes
 
 deferEnv, useEnv, deferUseEnv :: DmdEnv -> DmdEnv
 deferEnv    fv = mapVarEnv deferDmd fv
 useEnv      fv = mapVarEnv useDmd fv
 deferUseEnv fv = mapVarEnv deferUseDmd fv
 
-deferRes :: DmdResult -> DmdResult
-deferRes Diverges = topRes  -- Kill outer divergence
-deferRes r        = r       -- Preserve CPR info
-
 deferDmd, useDmd, deferUseDmd :: JointDmd -> JointDmd
 deferDmd    (JD {strd=_, absd=a}) = mkJointDmd Lazy a
 useDmd      (JD {strd=d, absd=a}) = mkJointDmd d    (markAsUsedDmd a)