Commit c44e1c41 by simonpj

### [project @ 2002-04-04 13:15:18 by simonpj]

---------------------------------------
A glorious improvement to CPR analysis
---------------------------------------

Working on the CPR paper, I finally figured out how to
do a decent job of taking account of strictness analyis when doing
CPR analysis.

There are two places we do that:

1.  Usually, on a letrec for a *thunk* we discard any CPR info from
the RHS.  We can't worker/wrapper a thunk.  BUT, if the let is
non-recursive
non-top-level
used strictly
we don't need to discard the CPR info, because the thunk-splitting
transform (WorkWrap.splitThunk) works.  This idea isn't new in this
commit.

2. Arguments to strict functions.  Consider

fac n m = if n==0 then m
else fac (n-1) (m*n)

Does it have the CPR property?  Apparently not, because it returns the
accumulating parameter, m.  But the strictness analyser will
discover that fac is strict in m, so it will be passed unboxed to
the worker for fac.  More concretely, here is the worker/wrapper
split that will result from strictness analysis alone:

fac n m = case n of MkInt n' ->
case m of MkInt m' ->
facw n' m'

facw n' m' = if n' ==# 0#
then I# m'
else facw (n' -# 1#) (m' *# n')

Now facw clearly does have the CPR property!  We can take advantage
of this by giving a demanded lambda the CPR property.

To make this work nicely, I've made NewDemandInfo into Maybe Demand
rather than simply Demand, so that we can tell when we are on the
I don't know how much all this buys us, but it is simple and elegant.
 ... ... @@ -62,7 +62,7 @@ module Id ( #endif idArity, idNewDemandInfo, idNewDemandInfo, idNewDemandInfo_maybe, idNewStrictness, idNewStrictness_maybe, idTyGenInfo, idWorkerInfo, ... ... @@ -99,12 +99,12 @@ import Type ( Type, typePrimRep, addFreeTyVars, import IdInfo import qualified Demand ( Demand ) import NewDemand ( Demand, StrictSig, topSig, isBottomingSig ) import NewDemand ( Demand, StrictSig, topDmd, topSig, isBottomingSig ) import Name ( Name, OccName, mkSystemName, mkInternalName, getOccName, getSrcLoc ) import OccName ( EncodedFS, UserFS, mkWorkerOcc ) import OccName ( EncodedFS, mkWorkerOcc ) import PrimRep ( PrimRep ) import TysPrim ( statePrimTyCon ) import FieldLabel ( FieldLabel ) ... ... @@ -383,11 +383,14 @@ setIdDemandInfo :: Id -> Demand.Demand -> Id setIdDemandInfo id demand_info = modifyIdInfo (setDemandInfo demand_info) id #endif idNewDemandInfo :: Id -> NewDemand.Demand idNewDemandInfo id = newDemandInfo (idInfo id) idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand idNewDemandInfo :: Id -> NewDemand.Demand idNewDemandInfo_maybe id = newDemandInfo (idInfo id) idNewDemandInfo id = newDemandInfo (idInfo id) orElse NewDemand.topDmd setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id setIdNewDemandInfo id dmd = modifyIdInfo (setNewDemandInfo dmd) id setIdNewDemandInfo id dmd = modifyIdInfo (setNewDemandInfo Just dmd) id --------------------------------- -- SPECIALISATION ... ...
 ... ... @@ -105,6 +105,7 @@ import qualified Demand import NewDemand import Outputable import Util ( seqList, listLengthCmp ) import Maybe ( isJust ) import List ( replicate ) -- infixl so you can say (id set a set b) ... ... @@ -215,6 +216,12 @@ oldDemand (Call _) = WwStrict \end{code} \begin{code} seqNewDemandInfo Nothing = () seqNewDemandInfo (Just dmd) = seqDemand dmd \end{code} %************************************************************************ %* * \subsection{GlobalIdDetails ... ... @@ -296,7 +303,10 @@ data IdInfo -- know whether whether this is the first visit, -- so it can assign botSig. Other customers want -- topSig. So Nothing is good. newDemandInfo :: Demand newDemandInfo :: Maybe Demand -- Similarly we want to know if there's no -- known demand yet, for when we are looking for -- CPR info } seqIdInfo :: IdInfo -> () ... ... @@ -312,7 +322,7 @@ megaSeqIdInfo info -- some unfoldings are not calculated at all -- seqUnfolding (unfoldingInfo info) seq seqDemand (newDemandInfo info) seq seqNewDemandInfo (newDemandInfo info) seq seqNewStrictnessInfo (newStrictnessInfo info) seq #ifdef OLD_STRICTNESS ... ... @@ -352,7 +362,7 @@ setUnfoldingInfo info uf -- let x = (a,b) in h a b x -- and now x is not demanded (I'm assuming h is lazy) -- This really happens. The solution here is a bit ad hoc... = info { unfoldingInfo = uf, newDemandInfo = Top } = info { unfoldingInfo = uf, newDemandInfo = Nothing } | otherwise -- We do *not* seq on the unfolding info, For some reason, doing so ... ... @@ -392,7 +402,7 @@ vanillaIdInfo lbvarInfo = NoLBVarInfo, inlinePragInfo = AlwaysActive, occInfo = NoOccInfo, newDemandInfo = topDmd, newDemandInfo = Nothing, newStrictnessInfo = Nothing } ... ... @@ -765,28 +775,29 @@ part of an unsaturated lambda \begin{code} zapLamInfo :: IdInfo -> Maybe IdInfo zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand}) | is_safe_occ && not (isStrictDmd demand) | is_safe_occ occ && is_safe_dmd demand = Nothing | otherwise = Just (info {occInfo = safe_occ, newDemandInfo = Top}) = Just (info {occInfo = safe_occ, newDemandInfo = Nothing}) where -- The "unsafe" occ info is the ones that say I'm not in a lambda -- because that might not be true for an unsaturated lambda is_safe_occ = case occ of OneOcc in_lam once -> in_lam other -> True is_safe_occ (OneOcc in_lam once) = in_lam is_safe_occ other = True safe_occ = case occ of OneOcc _ once -> OneOcc insideLam once other -> occ is_safe_dmd Nothing = True is_safe_dmd (Just dmd) = not (isStrictDmd dmd) \end{code} \begin{code} zapDemandInfo :: IdInfo -> Maybe IdInfo zapDemandInfo info@(IdInfo {newDemandInfo = demand}) | not (isStrictDmd demand) = Nothing | otherwise = Just (info {newDemandInfo = Top}) zapDemandInfo info@(IdInfo {newDemandInfo = dmd}) | isJust dmd = Just (info {newDemandInfo = Nothing}) | otherwise = Nothing \end{code} ... ...
 ... ... @@ -27,6 +27,7 @@ import Id ( Id, idType, idInlinePragma, #endif idNewStrictness, idNewStrictness_maybe, setIdNewStrictness, idNewDemandInfo, idNewDemandInfo_maybe, setIdNewDemandInfo, idName ) #ifdef OLD_STRICTNESS ... ... @@ -68,6 +69,7 @@ dmdAnalPgm dflags binds = do { showPass dflags "Demand analysis" ; let { binds_plus_dmds = do_prog binds } ; endPass dflags "Demand analysis" Opt_D_dump_stranal binds_plus_dmds ; #ifdef OLD_STRICTNESS ... ... @@ -90,7 +92,8 @@ dmdAnalTopBind sigs (NonRec id rhs) ( _, _, (_, rhs1)) = dmdAnalRhs TopLevel sigs (id, rhs) (sigs2, _, (id2, rhs2)) = dmdAnalRhs TopLevel sigs (id, rhs1) -- Do two passes to improve CPR information -- See the comments with mkSigTy.ignore_cpr_info below -- See comments with ignore_cpr_info in mk_sig_ty -- and with extendSigsWithLam in (sigs2, NonRec id2 rhs2) ... ... @@ -98,6 +101,7 @@ dmdAnalTopBind sigs (Rec pairs) = let (sigs', _, pairs') = dmdFix TopLevel sigs pairs -- We get two iterations automatically -- c.f. the NonRec case above in (sigs', Rec pairs') \end{code} ... ... @@ -188,7 +192,8 @@ dmdAnal sigs dmd (Lam var body) | Call body_dmd <- dmd -- A call demand: good! = let (body_ty, body') = dmdAnal sigs body_dmd body sigs' = extendSigsWithLam sigs var (body_ty, body') = dmdAnal sigs' body_dmd body (lam_ty, var') = annotateLamIdBndr body_ty var in (lam_ty, Lam var' body') ... ... @@ -209,7 +214,7 @@ dmdAnal sigs dmd (Case scrut case_bndr [alt@(DataAlt dc,bndrs,rhs)]) (alt_ty, alt') = dmdAnalAlt sigs_alt dmd alt (alt_ty1, case_bndr') = annotateBndr alt_ty case_bndr (_, bndrs', _) = alt' case_bndr_sig = StrictSig (mkDmdType emptyVarEnv [] RetCPR) case_bndr_sig = cprSig -- Inside the alternative, the case binder has the CPR property. -- Meaning that a case on it will successfully cancel. -- Example: ... ... @@ -321,7 +326,7 @@ dmdFix top_lvl sigs orig_pairs = loop 1 initial_sigs orig_pairs where bndrs = map fst orig_pairs initial_sigs = extendSigEnvList sigs [(id, (initial_sig id, top_lvl)) | id <- bndrs] initial_sigs = extendSigEnvList sigs [(id, (initialSig id, top_lvl)) | id <- bndrs] loop :: Int -> SigEnv -- Already contains the current sigs ... ... @@ -358,16 +363,16 @@ dmdFix top_lvl sigs orig_pairs -- old_sig = lookup sigs id -- new_sig = lookup sigs' id same_sig sigs sigs' var = lookup sigs var == lookup sigs' var lookup sigs var = case lookupVarEnv sigs var of Just (sig,_) -> sig -- Get an initial strictness signature from the Id -- itself. That way we make use of earlier iterations -- of the fixpoint algorithm. (Cunning plan.) -- Note that the cunning plan extends to the DmdEnv too, -- since it is part of the strictness signature initial_sig id = idNewStrictness_maybe id orElse botSig same_sig sigs sigs' var = lookup sigs var == lookup sigs' var lookup sigs var = case lookupVarEnv sigs var of Just (sig,_) -> sig initialSig id = idNewStrictness_maybe id orElse botSig dmdAnalRhs :: TopLevelFlag -> SigEnv -> (Id, CoreExpr) ... ... @@ -401,10 +406,85 @@ mkTopSigTy rhs dmd_ty = snd (mk_sig_ty False False rhs dmd_ty) mkSigTy :: Id -> CoreExpr -> DmdType -> (DmdEnv, StrictSig) mkSigTy id rhs dmd_ty = mk_sig_ty (isNeverActive (idInlinePragma id)) (isStrictDmd (idNewDemandInfo id)) ok_to_keep_cpr_info rhs dmd_ty where ok_to_keep_cpr_info = case idNewDemandInfo_maybe id of Nothing -> True -- Is the case the first time round Just dmd -> isStrictDmd dmd \end{code} The ok_to_keep_cpr_info stuff [CPR-AND-STRICTNESS] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If the rhs is a thunk, we usually forget the CPR info, because it is presumably shared (else it would have been inlined, and so we'd lose sharing if w/w'd it into a function. However, if the strictness analyser has figured out (in a previous iteration) that it's strict, then we DON'T need to forget the CPR info. Instead we can retain the CPR info and do the thunk-splitting transform (see WorkWrap.splitThunk). This made a big difference to PrelBase.modInt, which had something like modInt = \ x -> let r = ... -> I# v in ...body strict in r... r's RHS isn't a value yet; but modInt returns r in various branches, so if r doesn't have the CPR property then neither does modInt Another case I found in practice (in Complex.magnitude), looks like this: let k = if ... then I# a else I# b in ... body strict in k .... (For this example, it doesn't matter whether k is returned as part of the overall result; but it does matter that k's RHS has the CPR property.) Left to itself, the simplifier will make a join point thus: let $j k = ...body strict in k... if ... then$j (I# a) else $j (I# b) With thunk-splitting, we get instead let$j x = let k = I#x in ...body strict in k... in if ... then $j a else$j b This is much better; there's a good chance the I# won't get allocated. The difficulty with this is that we need the strictness type to look at the body... but we now need the body to calculate the demand on the variable, so we can decide whether its strictness type should have a CPR in it or not. Simple solution: a) use strictness info from the previous iteration b) make sure we do at least 2 iterations, by doing a second round for top-level non-recs. Top level recs will get at least 2 iterations except for totally-bottom functions which aren't very interesting anyway. NB: strictly_demanded is never true of a top-level Id, or of a recursive Id. The Nothing case in ok_to_keep_cpr_info [CPR-AND-STRICTNESS] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Demand info now has a 'Nothing' state, just like strictness info. The analysis works from 'dangerous' towards a 'safe' state; so we start with botSig for 'Nothing' strictness infos, and we start with "yes, it's demanded" for 'Nothing' in the demand info. The fixpoint iteration will sort it all out. We can't start with 'not-demanded' because then consider f x = let t = ... I# x in if ... then t else I# y else f x' In the first iteration we'd have no demand info for x, so assume not-demanded; then we'd get TopRes for f's CPR info. Next iteration we'd see that t was demanded, and so give it the CPR property, but by now f has TopRes, so it will stay TopRes. Instead, with the Nothing setting the first time round, we say 'yes t is demanded' the first time. However, this does mean that for non-recursive bindings we must iterate twice to be sure of not getting over-optimistic CPR info, in the case where t turns out to be not-demanded. This is handled by dmdAnalTopBind. mk_sig_ty never_inline strictly_demanded rhs (DmdType fv dmds res) \begin{code} mk_sig_ty never_inline ok_to_keep_cpr_info rhs (DmdType fv dmds res) | never_inline && not (isBotRes res) -- HACK ALERT -- Don't strictness-analyse NOINLINE things. Why not? Because ... ... @@ -475,41 +555,7 @@ mk_sig_ty never_inline strictly_demanded rhs (DmdType fv dmds res) res' = case res of RetCPR | ignore_cpr_info -> TopRes other -> res ignore_cpr_info = is_thunk && not strictly_demanded is_thunk = not (exprIsValue rhs) -- If the rhs is a thunk, we forget the CPR info, because -- it is presumably shared (else it would have been inlined, and -- so we'd lose sharing if w/w'd it into a function. -- -- Also, if the strictness analyser has figured out (in a previous iteration) -- that it's strict, the let-to-case transformation will happen, so again -- it's good. -- This made a big difference to PrelBase.modInt, which had something like -- modInt = \ x -> let r = ... -> I# v in -- ...body strict in r... -- r's RHS isn't a value yet; but modInt returns r in various branches, so -- if r doesn't have the CPR property then neither does modInt -- Another case I found in practice (in Complex.magnitude), looks like this: -- let k = if ... then I# a else I# b -- in ... body strict in k .... -- (For this example, it doesn't matter whether k is returned as part of -- the overall result.) Left to itself, the simplifier will make a join -- point thus: -- let $j k = ...body strict in k... -- if ... then$j (I# a) else $j (I# b) -- -- -- The difficulty with this is that we need the strictness type to -- look at the body... but we now need the body to calculate the demand -- on the variable, so we can decide whether its strictness type should -- have a CPR in it or not. Simple solution: -- a) use strictness info from the previous iteration -- b) make sure we do at least 2 iterations, by doing a second -- round for top-level non-recs. Top level recs will get at -- least 2 iterations except for totally-bottom functions -- which aren't very interesting anyway. -- -- NB: strictly_demanded is never true of a top-level Id, or of a recursive Id. ignore_cpr_info = not (exprIsValue rhs || ok_to_keep_cpr_info) \end{code} The unpack strategy determines whether we'll *really* unpack the argument, ... ... @@ -665,6 +711,24 @@ extendSigEnv top_lvl env var sig = extendVarEnv env var (sig, top_lvl) 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] 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 cprSig :: StrictSig cprSig = StrictSig (mkDmdType emptyVarEnv [] RetCPR) dmdTransform :: SigEnv -- The strictness environment -> Id -- The function -> Demand -- The demand on the function ... ...