[commit: ghc] wip/nested-cpr: Revert "Apply IO stricness hack only to information about arguments" (02557dd)

[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/02557dd0457eebc23877d1816b04d7714d28c0e8/ghc

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

commit 02557dd0457eebc23877d1816b04d7714d28c0e8
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Dec 6 10:55:43 2013 +0000

    Revert "Apply IO stricness hack only to information about arguments"
    
    This reverts commit 4f055ee8d890e23c8ad02a5864d0b6069420bbec.
    We need a discussion about this in #8598 first, and I do not want this
    to influence my nested CPR nofib results.


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

02557dd0457eebc23877d1816b04d7714d28c0e8
 compiler/basicTypes/Demand.lhs |    9 +--------
 compiler/stranal/DmdAnal.lhs   |    4 +---
 compiler/stranal/WwLib.lhs     |    3 +--
 3 files changed, 3 insertions(+), 13 deletions(-)

diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index aee44ba..5f140df 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -20,7 +20,7 @@ module Demand (
 
         DmdType(..), dmdTypeDepth, lubDmdType, bothDmdType,
         topDmdType, botDmdType, mkDmdType, mkTopDmdType, 
-        addDemand, dmdTypeArgTop,
+        addDemand,
 
         DmdEnv, emptyDmdEnv,
         peelFV,
@@ -1132,13 +1132,6 @@ splitDmdTy :: DmdType -> (Demand, DmdType)
 splitDmdTy (DmdType fv (dmd:dmds) res_ty) = (dmd, DmdType fv dmds res_ty)
 splitDmdTy ty@(DmdType _ [] res_ty)       = (resTypeArgDmd res_ty, ty)
 
--- We want to forget what we know about the arguments, but keep the information
--- of the result, see Note [IO Strictness Hack]
-dmdTypeArgTop :: DmdType -> DmdType
-dmdTypeArgTop d@(DmdType _ _ res)
-  = let (DmdType env' ds' res') = d `lubDmdType` topDmdType
-    in   DmdType env' ds' (if opt_NestedCprOff then res' else res)
-
 strictenDmd :: JointDmd -> CleanDemand
 strictenDmd (JD {strd = s, absd = u})
   = CD { sd = poke_s s, ud = poke_u u }
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index 0d7c8fe..9863610 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -310,11 +310,9 @@ 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 = dmdTypeArgTop alt_ty
+	final_alt_ty | io_hack_reqd = alt_ty `lubDmdType` topDmdType
 		     | otherwise    = alt_ty
 
-        -- Note [IO Strictness Hack]
-        --
 	-- There's a hack here for I/O operations.  Consider
 	-- 	case foo x s of { (# s, r #) -> y }
 	-- Is this strict in 'y'.  Normally yes, but what if 'foo' is an I/O
diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs
index 7dfff78..4acf255 100644
--- a/compiler/stranal/WwLib.lhs
+++ b/compiler/stranal/WwLib.lhs
@@ -32,7 +32,6 @@ import Maybes
 import Util
 import Outputable
 import DynFlags
-import StaticFlags ( opt_NestedCprOff )
 import FastString
 \end{code}
 
@@ -504,7 +503,7 @@ deepSplitCprType_maybe :: ConTag -> Type -> Maybe (DataCon, [Type], [Type], Coer
 deepSplitCprType_maybe con_tag ty
   | let (co, ty1) = topNormaliseNewType_maybe ty `orElse` (mkReflCo Representational ty, ty)
   , Just (tc, tc_args) <- splitTyConApp_maybe ty1
-  , isDataTyCon tc || (not opt_NestedCprOff && isUnboxedTupleTyCon tc)
+  , isDataTyCon tc
   , let cons = tyConDataCons tc
         con = ASSERT( cons `lengthAtLeast` con_tag ) cons !! (con_tag - fIRST_TAG)
   = Just (con, tc_args, dataConInstArgTys con tc_args, co)