diff options
author | Simon PJ <simonpj@microsoft.com> | 2010-05-03 15:16:30 +0000 |
---|---|---|
committer | Simon PJ <simonpj@microsoft.com> | 2010-05-03 15:16:30 +0000 |
commit | 71c7067b7cc2b06265c97190e6a09c272ad7a175 (patch) | |
tree | 58afe6b53c94c17581e358b5ddd7aaf18521512b | |
parent | 979c11345ee532a4fc56aab54f51d2924c0ea841 (diff) | |
download | haskell-71c7067b7cc2b06265c97190e6a09c272ad7a175.tar.gz |
Make the demand analyser take account of lambda-bound unfoldings
This is a long-standing lurking bug. See Note [Lamba-bound unfoldings]
in DmdAnal.
I'm still not really happy with this lambda-bound-unfolding stuff.
-rw-r--r-- | compiler/simplCore/Simplify.lhs | 12 | ||||
-rw-r--r-- | compiler/stranal/DmdAnal.lhs | 32 |
2 files changed, 37 insertions, 7 deletions
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index eec4521040..d2f3d965f8 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -2082,12 +2082,22 @@ An alternative plan is this: but that is bad if 'c' is *not* later scrutinised. So instead we do both: we pass 'c' and 'c#' , and record in c's inlining -that it's really I# c#, thus +(an InlineRule) that it's really I# c#, thus $j = \c# -> \c[=I# c#] -> ...c.... Absence analysis may later discard 'c'. +NB: take great care when doing strictness analysis; + see Note [Lamba-bound unfoldings] in DmdAnal. + +Also note that we can still end up passing stuff that isn't used. Before +strictness analysis we have + let $j x y c{=(x,y)} = (h c, ...) + in ... +After strictness analysis we see that h is strict, we end up with + let $j x y c{=(x,y)} = ($wh x y, ...) +and c is unused. Note [Duplicated env] ~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 4660aad56a..e8aa22c326 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -32,7 +32,7 @@ import TyCon ( isProductTyCon, isRecursiveTyCon ) import Id ( Id, idType, idInlineActivation, isDataConWorkId, isGlobalId, idArity, idStrictness, idStrictness_maybe, - setIdStrictness, idDemandInfo, + setIdStrictness, idDemandInfo, idUnfolding, idDemandInfo_maybe, setIdDemandInfo ) @@ -205,14 +205,14 @@ dmdAnal sigs dmd (Lam var body) = let sigs' = extendSigsWithLam sigs var (body_ty, body') = dmdAnal sigs' body_dmd body - (lam_ty, var') = annotateLamIdBndr body_ty var + (lam_ty, var') = annotateLamIdBndr sigs body_ty var in (lam_ty, Lam var' body') | otherwise -- Not enough demand on the lambda; but do the body = let -- anyway to annotate it and gather free var info (body_ty, body') = dmdAnal sigs evalDmd body - (lam_ty, var') = annotateLamIdBndr body_ty var + (lam_ty, var') = annotateLamIdBndr sigs body_ty var in (deferType lam_ty, Lam var' body') @@ -728,17 +728,27 @@ annotateBndr dmd_ty@(DmdType fv ds res) var annotateBndrs = mapAccumR annotateBndr -annotateLamIdBndr :: DmdType -- Demand type of body +annotateLamIdBndr :: SigEnv + -> DmdType -- Demand type of body -> Id -- Lambda binder -> (DmdType, -- Demand type of lambda Id) -- and binder annotated with demand -annotateLamIdBndr dmd_ty@(DmdType fv ds res) id +annotateLamIdBndr sigs dmd_ty@(DmdType fv ds res) id -- For lambdas we add the demand to the argument demands -- Only called for Ids = ASSERT( isId id ) - (DmdType fv' (hacked_dmd:ds) res, setIdDemandInfo id hacked_dmd) + (final_ty, setIdDemandInfo id hacked_dmd) where + -- Watch out! See note [Lambda-bound unfoldings] + final_ty = case maybeUnfoldingTemplate (idUnfolding id) of + Nothing -> main_ty + Just unf -> main_ty `bothType` unf_ty + where + (unf_ty, _) = dmdAnal sigs dmd unf + + main_ty = DmdType fv' (hacked_dmd:ds) res + (fv', dmd) = removeFV fv id res hacked_dmd = argDemand dmd -- This call to argDemand is vital, because otherwise we label @@ -764,6 +774,16 @@ zapUnlifted id dmd | isUnLiftedType (idType id) = lazyDmd | otherwise = dmd \end{code} +Note [Lamba-bound unfoldings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We allow a lambda-bound variable to carry an unfolding, a facility that is used +exclusively for join points; see Note [Case binders and join points]. If so, +we must be careful to demand-analyse the RHS of the unfolding! Example + \x. \y{=Just x}. <body> +Then if <body> uses 'y', then transitively it uses 'x', and we must not +forget that fact, otherwise we might make 'x' absent when it isn't. + + %************************************************************************ %* * \subsection{Strictness signatures} |