[commit: ghc] new-demand: small tweaks (afb4e97)

[Ilya Sergey]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : new-demand

http://hackage.haskell.org/trac/ghc/changeset/afb4e97d845d138aeb5bc1faafadbb8600721907

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

commit afb4e97d845d138aeb5bc1faafadbb8600721907
Author: Ilya Sergey <Ilya.Sergey at cs.kuleuven.be>
Date:   Wed Jul 18 22:40:39 2012 +0100

    small tweaks

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

 compiler/basicTypes/NewDemand.lhs |    8 ++++----
 compiler/stranal/NewDmdAnal.lhs   |    1 +
 2 files changed, 5 insertions(+), 4 deletions(-)

diff --git a/compiler/basicTypes/NewDemand.lhs b/compiler/basicTypes/NewDemand.lhs
index ee54902..baa0a9a 100644
--- a/compiler/basicTypes/NewDemand.lhs
+++ b/compiler/basicTypes/NewDemand.lhs
@@ -106,8 +106,8 @@ strCall s  = case s of
 
 strProd :: [StrDmd] -> StrDmd
 strProd sx
+  | any (== HyperStr) sx    = strBot
   | all (== Lazy) sx        = strStr
-  | any (== HyperStr) sx    = strTop
   | otherwise               = SProd sx
 
 -- Pretty-printing
@@ -443,9 +443,9 @@ replicateDmd n (JD x y) = zipWith JD (replicateStrDmd n x)
 
 -- Check whether is a product demand
 isProdDmd :: Demand -> Bool
-isProdDmd (JD Str _)       = True
-isProdDmd (JD (SProd _) _) = True
-isProdDmd _                = False
+--isProdDmd (JD Str a) | isUsed a  = True
+isProdDmd (JD (SProd _) _)       = True
+isProdDmd _                      = False
 
 isPolyDmd :: Demand -> Bool
 isPolyDmd (JD a b) = isPolyStrDmd a && isPolyAbsDmd b
diff --git a/compiler/stranal/NewDmdAnal.lhs b/compiler/stranal/NewDmdAnal.lhs
index 5b2d69a..d5fbbdd 100644
--- a/compiler/stranal/NewDmdAnal.lhs
+++ b/compiler/stranal/NewDmdAnal.lhs
@@ -884,6 +884,7 @@ extendSigsWithLam :: AnalEnv -> Id -> AnalEnv
 
 -- See Note [Optimistic CPR in the "virgin" case]
 extendSigsWithLam env id
+    -- is it too conservative?
   = if (ae_virgin env) || (isProdDmd $ nd_idDemandInfo id)
     then extendAnalEnv NotTopLevel env id cprSig
     else env