[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 (file)
--- 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 (file)
--- 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)