From: simonpj <unknown>
Date: Fri, 5 Apr 2002 08:12:22 +0000 (+0000)
Subject: [project @ 2002-04-05 08:12:21 by simonpj]
X-Git-Tag: Approx_11550_changesets_converted~2177
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=ef1d3a95a6d3cf315a1208743f1265d22e87b878;p=ghc-hetmet.git

[project @ 2002-04-05 08:12:21 by simonpj]
Heal the head
---

diff --git a/ghc/compiler/basicTypes/NewDemand.lhs b/ghc/compiler/basicTypes/NewDemand.lhs
index ea314d5..cafd67c 100644
--- a/ghc/compiler/basicTypes/NewDemand.lhs
+++ b/ghc/compiler/basicTypes/NewDemand.lhs
@@ -211,9 +211,12 @@ resTypeArgDmd :: DmdResult -> Demand
 --	BotRes = Bot -> BotRes
 --	TopRes = Top -> TopRes
 -- This function makes that concrete
+-- We can get a RetCPR, because of the way in which we are (now)
+-- giving CPR info to strict arguments.  On the first pass, when
+-- nothing has demand info, we optimistically give CPR info or RetCPR to all args
 resTypeArgDmd TopRes = Top
+resTypeArgDmd RetCPR = Top
 resTypeArgDmd BotRes = Bot
-resTypeArgDmd RetCPR = panic "resTypeArgDmd: RetCPR"
 
 returnsCPR :: DmdResult -> Bool
 returnsCPR RetCPR = True
diff --git a/ghc/compiler/stranal/DmdAnal.lhs b/ghc/compiler/stranal/DmdAnal.lhs
index a55be50..e90e413 100644
--- a/ghc/compiler/stranal/DmdAnal.lhs
+++ b/ghc/compiler/stranal/DmdAnal.lhs
@@ -713,17 +713,22 @@ extendSigEnvList = extendVarEnvList
 
 extendSigsWithLam :: SigEnv -> Id -> SigEnv
 -- Extend the SigEnv when we meet a lambda binder
--- If the binder is marked demanded with a product demand, 
--- then give it a CPR signature, because in the likely event
--- that this is a lambda on a fn defn [we only use this when
--- the lambda is being consumed with a call demand],
--- it'll be w/w'd and so it will be CPR-ish
--- NOTE: see notes [CPR-AND-STRICTNESS]
+--  If the binder is marked demanded with a product demand, then give it a CPR 
+-- signature, because in the likely event that this is a lambda on a fn defn 
+-- [we only use this when the lambda is being consumed with a call demand],
+-- it'll be w/w'd and so it will be CPR-ish.
+--
+-- 	NOTE: see notes [CPR-AND-STRICTNESS]
+--
+-- Also note that we only want to do this for something that
+-- definitely has product type, else we may get over-optimistic 
+-- CPR results (e.g. from \x -> x!).
+
 extendSigsWithLam sigs id
   = case idNewDemandInfo_maybe id of
-	Nothing	       -> pprTrace "Yes (bot)" (ppr id) $ extendVarEnv sigs id (cprSig, NotTopLevel)
-	Just (Eval ds) -> pprTrace "Yes" (ppr id) $ extendVarEnv sigs id (cprSig, NotTopLevel)
-	other          -> pprTrace "No" (ppr id $$ ppr (idNewDemandInfo id)) $ sigs
+	Nothing	              -> extendVarEnv sigs id (cprSig, NotTopLevel)
+	Just (Eval (Prod ds)) -> extendVarEnv sigs id (cprSig, NotTopLevel)
+	other                 -> sigs
 
 cprSig :: StrictSig
 cprSig = StrictSig (mkDmdType emptyVarEnv [] RetCPR)