Commit c44e1c41 authored by simonpj's avatar 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
first iteration.  Lots of comments about this in Note [CPR-AND-STRICTNESS].

I don't know how much all this buys us, but it is simple and elegant.
parent ec7a80bf
......@@ -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
......
......@@ -204,7 +204,7 @@ tryWW is_rec fn_id rhs
-- inside its __inline wrapper. Death! Disaster!
= returnUs [ (fn_id', rhs) ]
| is_thunk && worthSplittingThunk fn_dmd res_info
| is_thunk && worthSplittingThunk maybe_fn_dmd res_info
= ASSERT( isNonRec is_rec ) -- The thunk must be non-recursive
splitThunk fn_id' rhs
......@@ -215,11 +215,11 @@ tryWW is_rec fn_id rhs
= returnUs [ (fn_id', rhs) ]
where
fn_info = idInfo fn_id
fn_dmd = newDemandInfo fn_info
unfolding = unfoldingInfo fn_info
inline_prag = inlinePragInfo fn_info
maybe_sig = newStrictnessInfo fn_info
fn_info = idInfo fn_id
maybe_fn_dmd = newDemandInfo fn_info
unfolding = unfoldingInfo fn_info
inline_prag = inlinePragInfo fn_info
maybe_sig = newStrictnessInfo fn_info
-- In practice it always will have a strictness
-- signature, even if it's a uninformative one
......@@ -360,15 +360,15 @@ worthSplittingFun ds res
worth_it (Eval (Prod ds)) = True -- Product arg to evaluate
worth_it other = False
worthSplittingThunk :: Demand -- Demand on the thunk
worthSplittingThunk :: Maybe Demand -- Demand on the thunk
-> DmdResult -- CPR info for the thunk
-> Bool
worthSplittingThunk dmd res
= worth_it dmd || returnsCPR res
worthSplittingThunk maybe_dmd res
= worth_it maybe_dmd || returnsCPR res
where
-- Split if the thing is unpacked
worth_it (Eval (Prod ds)) = not (all isAbsent ds)
worth_it other = False
worth_it (Just (Eval (Prod ds))) = not (all isAbsent ds)
worth_it other = False
\end{code}
......
Markdown is supported
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