Commit 95c13506 authored by's avatar
Browse files

Fix long-standing bug in CPR analysis


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

parent 8f0a33dd
......@@ -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)
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.
......@@ -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
-- 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;
Just (Eval (Prod ds)) -> extendVarEnv sigs id (cprSig, NotTopLevel)
other -> sigs
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment