[project @ 2001-07-24 16:42:11 by simonpj]

A major demand-analyser fix, which made it say something was
absent when it wasn't at all.  Here's the comment from the
Case equation of dmdAnal.

	-- Figure out whether the case binder is used, and use
	-- that to set the keepity of the demand.  This is utterly essential.
	-- Consider	f x = case x of y { (a,b) -> k y a }
	-- If we just take scrut_demand = U(L,A), then we won't pass x to the
	-- worker, so the worker will rebuild
	--	x = (a, absent-error)
	-- and that'll crash.

diff --git a/ghc/compiler/basicTypes/NewDemand.lhs b/ghc/compiler/basicTypes/NewDemand.lhs
index 0dcb69a..291cf07 100644 (file)
--- a/ghc/compiler/basicTypes/NewDemand.lhs
+++ b/ghc/compiler/basicTypes/NewDemand.lhs
@@ -6,7 +6,7 @@
 \begin{code}
 module NewDemand(
        Demand(..), Keepity(..), Deferredness(..), 
-       topDmd, lazyDmd, seqDmd, evalDmd, isStrictDmd,
+       topDmd, lazyDmd, seqDmd, evalDmd, isStrictDmd, isAbsentDmd,
 
        DmdType(..), topDmdType, mkDmdType, mkTopDmdType, 
                dmdTypeDepth, dmdTypeRes,
@@ -212,6 +212,12 @@ isStrictDmd Eval     = True
 isStrictDmd (Call _)     = True
 isStrictDmd other        = False
 
+isAbsentDmd :: Demand -> Bool
+isAbsentDmd Bot          = True
+isAbsentDmd Err          = True
+isAbsentDmd Abs          = True
+isAbsentDmd other = False
+
 instance Outputable Demand where
     ppr Lazy        = char 'L'
     ppr Abs         = char 'A'

diff --git a/ghc/compiler/stranal/DmdAnal.lhs b/ghc/compiler/stranal/DmdAnal.lhs
index 4d4861f..d6bdd0e 100644 (file)
--- a/ghc/compiler/stranal/DmdAnal.lhs
+++ b/ghc/compiler/stranal/DmdAnal.lhs
@@ -173,12 +173,24 @@ dmdAnal sigs dmd (Case scrut case_bndr [alt@(DataAlt dc,bndrs,rhs)])
     isProductTyCon tycon,
     not (isRecursiveTyCon tycon)
   = let
-       bndr_ids                = filter isId bndrs
-       (alt_ty, alt')          = dmdAnalAlt sigs dmd alt
-       (alt_ty1, case_bndr')   = annotateBndr alt_ty case_bndr
-       (_, bndrs', _)          = alt'
-        scrut_dmd              = Seq Drop Now [idNewDemandInfo b | b <- bndrs', isId b]
-       (scrut_ty, scrut')      = dmdAnal sigs scrut_dmd scrut
+       bndr_ids                 = filter isId bndrs
+       (alt_ty, alt')           = dmdAnalAlt sigs dmd alt
+       (alt_ty1, case_bndr')    = annotateBndr alt_ty case_bndr
+       (_, bndrs', _)           = alt'
+
+       -- Figure out whether the case binder is used, and use
+       -- that to set the keepity of the demand.  This is utterly essential.
+       -- Consider     f x = case x of y { (a,b) -> k y a }
+       -- If we just take scrut_demand = U(L,A), then we won't pass x to the
+       -- worker, so the worker will rebuild 
+       --      x = (a, absent-error)
+       -- and that'll crash.
+       dead_case_bndr           = isAbsentDmd (idNewDemandInfo case_bndr')
+       keepity | dead_case_bndr = Drop
+               | otherwise      = Keep         
+
+        scrut_dmd               = Seq keepity Now [idNewDemandInfo b | b <- bndrs', isId b]
+       (scrut_ty, scrut')       = dmdAnal sigs scrut_dmd scrut
     in
     (alt_ty1 `bothType` scrut_ty, Case scrut' case_bndr' [alt'])