[commit: ghc] wip/T8598: Do not forget CPR information after an IO action (a31cb5b)

[git at git.haskell.org]

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

On branch  : wip/T8598
Link       : http://ghc.haskell.org/trac/ghc/changeset/a31cb5b07726f5739f6eac35cbb348fcd2d6b598/ghc

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

commit a31cb5b07726f5739f6eac35cbb348fcd2d6b598
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Dec 6 17:58:29 2013 +0000

    Do not forget CPR information after an IO action
    
    but do forget about certain divergence, if required. Fixes one part of
    ticket #8598.
    
    The added function (deferAfterIO) can maybe be merged with existing
    code, but given the ongoing work in the nested-cpr branch, I defer that
    work.


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

a31cb5b07726f5739f6eac35cbb348fcd2d6b598
 compiler/basicTypes/Demand.lhs |   19 ++++++++++++++++++-
 compiler/stranal/DmdAnal.lhs   |    2 +-
 2 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index cd844a1..ff6c59f 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -35,7 +35,7 @@ module Demand (
 
         evalDmd, cleanEvalDmd, cleanEvalProdDmd, isStrictDmd, 
         splitDmdTy, splitFVs,
-        deferDmd, deferType, deferAndUse, deferEnv, modifyEnv,
+        deferDmd, deferType, deferAndUse, deferAfterIO, deferEnv, modifyEnv,
 
         splitProdDmd, splitProdDmd_maybe, peelCallDmd, mkCallDmd,
         dmdTransformSig, dmdTransformDataConSig, dmdTransformDictSelSig,
@@ -1086,6 +1086,23 @@ useType (DmdType fv ds res_ty) = DmdType (useEnv fv) ds res_ty
 useEnv :: DmdEnv -> DmdEnv
 useEnv fv = mapVarEnv useDmd fv
 
+-- When e is evaluated after executing an IO action, and d is e's demand, then
+-- what of this demand should we consider, given that the IO action can cleanly
+-- exit?
+-- * We have to kill all strictness demands (i.e. lub with a lazy demand)
+-- * We can keep demand information (i.e. lub with an absent deman)
+-- * We have to kill definite divergence
+-- * We can keep CPR information.
+-- See Note [IO hack in the demand analyser]
+deferAfterIO :: DmdType -> DmdType
+deferAfterIO d@(DmdType _ _ res) =
+    case d `lubDmdType` topDmdType of
+        DmdType fv ds _ -> DmdType fv ds (defer_res res)
+  where
+  defer_res BotCPR  = NoCPR
+  defer_res r       = r
+
+
 modifyEnv :: Bool                       -- No-op if False
           -> (Demand -> Demand)         -- The zapper
           -> DmdEnv -> DmdEnv           -- Env1 and Env2
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index 0ceb7c9..cadc04c 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -335,7 +335,7 @@ dmdAnalAlt env dmd (con,bndrs,rhs)
 	(rhs_ty, rhs')   = dmdAnal env dmd rhs
         rhs_ty'          = addDataConPatDmds con bndrs rhs_ty
 	(alt_ty, bndrs') = annotateBndrs env rhs_ty' bndrs
-	final_alt_ty | io_hack_reqd = alt_ty `lubDmdType` topDmdType
+	final_alt_ty | io_hack_reqd = deferAfterIO alt_ty
 		     | otherwise    = alt_ty
 
 	-- There's a hack here for I/O operations.  Consider