From 95c13506a9988cfe613618ef5c76fe95f4048d22 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Tue, 31 Jan 2006 15:32:47 +0000 Subject: [PATCH] Fix long-standing bug in CPR analysis MERGE TO STABLE For a long time (2002!) the CPR analysis done by dmdAnalTopRhs has been bogus. In particular, it's possible for a newtype constructor to look CPR-ish when it simply isn't. This fixes it. Test is stranal/newtype --- ghc/compiler/stranal/DmdAnal.lhs | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/ghc/compiler/stranal/DmdAnal.lhs b/ghc/compiler/stranal/DmdAnal.lhs index f0dcc00..c5cfb7b 100644 --- a/ghc/compiler/stranal/DmdAnal.lhs +++ b/ghc/compiler/stranal/DmdAnal.lhs @@ -112,11 +112,18 @@ dmdAnalTopRhs :: CoreExpr -> (StrictSig, CoreExpr) -- a) appropriate strictness info -- b) the unfolding (decorated with stricntess info) dmdAnalTopRhs rhs - = (sig, rhs') + = (sig, rhs2) where - arity = exprArity rhs - (rhs_ty, rhs') = dmdAnal emptySigEnv (vanillaCall arity) rhs + call_dmd = vanillaCall (exprArity rhs) + (_, rhs1) = dmdAnal emptySigEnv call_dmd rhs + (rhs_ty, rhs2) = dmdAnal emptySigEnv call_dmd rhs1 sig = mkTopSigTy rhs rhs_ty + -- Do two passes; see notes with extendSigsWithLam + -- Otherwise we get bogus CPR info for constructors like + -- newtype T a = MkT a + -- The constructor looks like (\x::T a -> x), modulo the coerce + -- extendSigsWithLam will optimistically give x a CPR tag the + -- first time, which is wrong in the end. \end{code} %************************************************************************ @@ -761,8 +768,6 @@ extendSigsWithLam :: SigEnv -> Id -> SigEnv -- (a,b) -- We want f to have the CPR property because x does, by the time f has been w/w'd -- --- 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!). @@ -770,6 +775,8 @@ extendSigsWithLam :: SigEnv -> Id -> SigEnv extendSigsWithLam sigs id = case idNewDemandInfo_maybe id of Nothing -> extendVarEnv sigs id (cprSig, NotTopLevel) + -- Optimistic in the Nothing case; + -- See notes [CPR-AND-STRICTNESS] Just (Eval (Prod ds)) -> extendVarEnv sigs id (cprSig, NotTopLevel) other -> sigs -- 1.7.10.4