[commit: ghc] wip/nested-cpr: Kill divergence information in deferType (f9a7404)

git at git.haskell.org git at git.haskell.org
Wed Dec 4 09:19:41 UTC 2013


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

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

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

commit f9a7404bce0a3a57015cf7402280bf525fcf5e5d
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Wed Dec 4 09:16:55 2013 +0000

    Kill divergence information in deferType


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

f9a7404bce0a3a57015cf7402280bf525fcf5e5d
 compiler/basicTypes/Demand.lhs |    8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index e955195..368468a 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -1209,15 +1209,19 @@ postProcessDmdType (True,  One)  ty = deferType ty
 postProcessDmdType (False, One)  ty = ty
 
 deferType, useType, deferAndUse :: DmdType -> DmdType
-deferType   (DmdType fv ds _)      = DmdType (deferEnv fv)    (map deferDmd ds)    topRes
+deferType   (DmdType fv ds res_ty) = DmdType (deferEnv fv)    (map deferDmd ds)    (deferRes res_ty)
 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 res_ty) = DmdType (deferUseEnv fv) (map deferUseDmd ds) (deferRes res_ty)
 
 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)



More information about the ghc-commits mailing list