Commit 2e6d322e authored by simonmar's avatar simonmar
Browse files

[project @ 2003-03-21 13:54:27 by simonmar]

Modifications to the way we calculate CafInfo during tidying (again).

The previous hack of setting the CafInfo on all non-top-level bindings
to NoCafRefs was a hack, and it came back to bite us: when CorePrep
floats out a let to the top level it doesn't create a new binding, and
the existing let binder happens to say NoCafRefs which is unsafe.  It
was caught by an ASSERT in the CoreToStg when compiling the libraries
without -O - compiling without -O tends to result in more
opportunities for CorePrep to float things to the top level.

Now, we calculate CafInfo on the pre-tidied expressions, using the
mapping from Ids to Ids that is being built up during tidying.  This
avoids one loop, but will be slightly slower due to the extra lookups.
However, it means we don't need to set the CafInfo on non-top-level
binders to NoCafRefs.
parent 63a5c646
......@@ -21,7 +21,7 @@ import CoreUtils ( exprArity )
import PprCore ( pprIdRules )
import Id ( Id, mkUserLocal, idInfo, setIdInfo, idUnique,
idType, idCoreRules )
import IdInfo ( setArityInfo, noCafIdInfo,
import IdInfo ( setArityInfo, vanillaIdInfo,
newStrictnessInfo, setAllStrictnessInfo,
newDemandInfo, setNewDemandInfo )
import Type ( tidyType, tidyTyVarBndr )
......@@ -149,11 +149,9 @@ tidyLetBndr env (id,rhs)
--
-- Similarly arity info for eta expansion in CorePrep
--
-- CafInfo is NoCafRefs, because this is not a top-level Id.
--
final_id = new_id `setIdInfo` new_info
idinfo = idInfo id
new_info = noCafIdInfo -- NB. no CAF refs!
new_info = vanillaIdInfo
`setArityInfo` exprArity rhs
`setAllStrictnessInfo` newStrictnessInfo idinfo
`setNewDemandInfo` newDemandInfo idinfo
......@@ -173,12 +171,12 @@ tidyIdBndr env@(tidy_env, var_env) id
-- The SrcLoc isn't important now,
-- though we could extract it from the Id
--
-- All nested Ids now have the same IdInfo, namely noCafIdInfo,
-- All nested Ids now have the same IdInfo, namely vanillaIdInfo,
-- which should save some space.
-- But note that tidyLetBndr puts some of it back.
ty' = tidyType env (idType id)
id' = mkUserLocal occ' (idUnique id) ty' noSrcLoc
`setIdInfo` noCafIdInfo
`setIdInfo` vanillaIdInfo
var_env' = extendVarEnv var_env id id'
in
((tidy_env', var_env'), id')
......
......@@ -18,8 +18,7 @@ module CoreUtils (
exprIsBottom, exprIsDupable, exprIsTrivial, exprIsCheap,
exprIsValue,exprOkForSpeculation, exprIsBig,
exprIsConApp_maybe, exprIsAtom,
idAppIsBottom, idAppIsCheap,
idAppIsBottom, idAppIsCheap, rhsIsNonUpd,
-- Arity and eta expansion
manifestArity, exprArity,
......@@ -34,9 +33,6 @@ module CoreUtils (
-- Equality
cheapEqExpr, eqExpr, applyTypeToArgs, applyTypeToArg,
-- CAF info
hasCafRefs, rhsIsNonUpd,
-- Cross-DLL references
isCrossDllConApp,
) where
......@@ -59,10 +55,9 @@ import PrimOp ( PrimOp(..), primOpOkForSpeculation, primOpIsCheap )
import Id ( Id, idType, globalIdDetails, idNewStrictness,
mkWildId, idArity, idName, idUnfolding, idInfo,
isOneShotLambda, isDataConWorkId_maybe, mkSysLocal,
isDataConWorkId, isBottomingId, idCafInfo
isDataConWorkId, isBottomingId
)
import IdInfo ( GlobalIdDetails(..), megaSeqIdInfo,
CafInfo(..), mayHaveCafRefs )
import IdInfo ( GlobalIdDetails(..), megaSeqIdInfo )
import NewDemand ( appIsBottom )
import Type ( Type, mkFunTy, mkForAllTy, splitFunTy_maybe,
splitFunTy,
......@@ -80,7 +75,6 @@ import Outputable
import TysPrim ( alphaTy ) -- Debugging only
import Util ( equalLength, lengthAtLeast )
import TysPrim ( statePrimTyCon )
import FastTypes hiding ( fastOr )
\end{code}
......@@ -1178,58 +1172,11 @@ isCrossDllArg (Lam v e) = isCrossDllArg e
%************************************************************************
%* *
\subsection{Figuring out CafInfo for an expression}
\subsection{Determining non-updatable right-hand-sides}
%* *
%************************************************************************
hasCafRefs decides whether a top-level closure can point into the dynamic heap.
We mark such things as `MayHaveCafRefs' because this information is
used to decide whether a particular closure needs to be referenced
in an SRT or not.
There are two reasons for setting MayHaveCafRefs:
a) The RHS is a CAF: a top-level updatable thunk.
b) The RHS refers to something that MayHaveCafRefs
Possible improvement: In an effort to keep the number of CAFs (and
hence the size of the SRTs) down, we could also look at the expression and
decide whether it requires a small bounded amount of heap, so we can ignore
it as a CAF. In these cases however, we would need to use an additional
CAF list to keep track of non-collectable CAFs.
\begin{code}
hasCafRefs :: (Var -> Bool) -> Arity -> CoreExpr -> CafInfo
hasCafRefs p arity expr
| is_caf || mentions_cafs = MayHaveCafRefs
| otherwise = NoCafRefs
where
mentions_cafs = isFastTrue (cafRefs p expr)
is_caf = not (arity > 0 || rhsIsNonUpd expr)
-- NB. we pass in the arity of the expression, which is expected
-- to be calculated by exprArity. This is because exprArity
-- knows how much eta expansion is going to be done by
-- CorePrep later on, and we don't want to duplicate that
-- knowledge in rhsIsNonUpd below.
cafRefs p (Var id)
| isId id && p id = fastBool (mayHaveCafRefs (idCafInfo id))
| otherwise = fastBool False
cafRefs p (Lit l) = fastBool False
cafRefs p (App f a) = fastOr (cafRefs p f) (cafRefs p) a
cafRefs p (Lam x e) = cafRefs p e
cafRefs p (Let b e) = fastOr (cafRefss p (rhssOfBind b)) (cafRefs p) e
cafRefs p (Case e bndr alts) = fastOr (cafRefs p e) (cafRefss p) (rhssOfAlts alts)
cafRefs p (Note n e) = cafRefs p e
cafRefs p (Type t) = fastBool False
cafRefss p [] = fastBool False
cafRefss p (e:es) = fastOr (cafRefs p e) (cafRefss p) es
-- hack for lazy-or over FastBool.
fastOr a f x = fastBool (isFastTrue a || isFastTrue (f x))
rhsIsNonUpd :: CoreExpr -> Bool
-- True => Value-lambda, saturated constructor
-- This is a bit like CoreUtils.exprIsValue, with the following differences:
......
......@@ -15,17 +15,17 @@ import CoreFVs ( ruleLhsFreeIds, ruleRhsFreeVars, exprSomeFreeVars )
import CoreTidy ( tidyExpr, tidyVarOcc, tidyIdRules )
import PprCore ( pprIdRules )
import CoreLint ( showPass, endPass )
import CoreUtils ( exprArity, hasCafRefs )
import CoreUtils ( exprArity, rhsIsNonUpd )
import VarEnv
import VarSet
import Var ( Id, Var )
import Id ( idType, idInfo, idName, idCoreRules,
isExportedId, mkVanillaGlobal, isLocalId,
isImplicitId, idArity, setIdInfo
isImplicitId, idArity, setIdInfo, idCafInfo
)
import IdInfo {- loads of stuff -}
import NewDemand ( isBottomingSig, topSig )
import BasicTypes ( isNeverActive )
import BasicTypes ( Arity, isNeverActive )
import Name ( getOccName, nameOccName, mkInternalName,
localiseName, isExternalName, nameSrcLoc
)
......@@ -47,6 +47,7 @@ import List ( partition )
import Util ( mapAccumL )
import Maybe ( isJust )
import Outputable
import FastTypes hiding ( fastOr )
\end{code}
......@@ -418,7 +419,7 @@ tidyTopBind :: Module
-> TopTidyEnv -> CoreBind
-> (TopTidyEnv, CoreBind)
tidyTopBind mod ext_ids top_tidy_env (NonRec bndr rhs)
tidyTopBind mod ext_ids top_tidy_env@(_,_,subst1) (NonRec bndr rhs)
= ((orig,occ,subst) , NonRec bndr' rhs')
where
((orig,occ,subst), bndr')
......@@ -426,9 +427,9 @@ tidyTopBind mod ext_ids top_tidy_env (NonRec bndr rhs)
rec_tidy_env rhs rhs' top_tidy_env bndr
rec_tidy_env = (occ,subst)
rhs' = tidyExpr rec_tidy_env rhs
caf_info = hasCafRefs (const True) (idArity bndr') rhs'
caf_info = hasCafRefs subst1 (idArity bndr') rhs'
tidyTopBind mod ext_ids top_tidy_env (Rec prs)
tidyTopBind mod ext_ids top_tidy_env@(_,_,subst1) (Rec prs)
= (final_env, Rec prs')
where
(final_env@(_,occ,subst), prs') = mapAccumL do_one top_tidy_env prs
......@@ -445,10 +446,9 @@ tidyTopBind mod ext_ids top_tidy_env (Rec prs)
-- the CafInfo for a recursive group says whether *any* rhs in
-- the group may refer indirectly to a CAF (because then, they all do).
pred v = v `notElem` map fst prs'
caf_info
| or [ mayHaveCafRefs (hasCafRefs pred (idArity bndr) rhs)
| (bndr,rhs) <- prs' ] = MayHaveCafRefs
| or [ mayHaveCafRefs (hasCafRefs subst1 (idArity bndr) rhs)
| (bndr,rhs) <- prs ] = MayHaveCafRefs
| otherwise = NoCafRefs
tidyTopBinder :: Module -> IdEnv Bool -> CafInfo
......@@ -588,3 +588,62 @@ tidyWorker tidy_env (HasWorker work_id wrap_arity)
tidyWorker tidy_env other
= NoWorker
\end{code}
%************************************************************************
%* *
\subsection{Figuring out CafInfo for an expression}
%* *
%************************************************************************
hasCafRefs decides whether a top-level closure can point into the dynamic heap.
We mark such things as `MayHaveCafRefs' because this information is
used to decide whether a particular closure needs to be referenced
in an SRT or not.
There are two reasons for setting MayHaveCafRefs:
a) The RHS is a CAF: a top-level updatable thunk.
b) The RHS refers to something that MayHaveCafRefs
Possible improvement: In an effort to keep the number of CAFs (and
hence the size of the SRTs) down, we could also look at the expression and
decide whether it requires a small bounded amount of heap, so we can ignore
it as a CAF. In these cases however, we would need to use an additional
CAF list to keep track of non-collectable CAFs.
\begin{code}
hasCafRefs :: VarEnv Var -> Arity -> CoreExpr -> CafInfo
hasCafRefs p arity expr
| is_caf || mentions_cafs = MayHaveCafRefs
| otherwise = NoCafRefs
where
mentions_cafs = isFastTrue (cafRefs p expr)
is_caf = not (arity > 0 || rhsIsNonUpd expr)
-- NB. we pass in the arity of the expression, which is expected
-- to be calculated by exprArity. This is because exprArity
-- knows how much eta expansion is going to be done by
-- CorePrep later on, and we don't want to duplicate that
-- knowledge in rhsIsNonUpd below.
cafRefs p (Var id)
-- imported Ids first:
| not (isLocalId id) = fastBool (mayHaveCafRefs (idCafInfo id))
-- now Ids local to this module:
| otherwise =
case lookupVarEnv p id of
Just id' -> fastBool (mayHaveCafRefs (idCafInfo id'))
Nothing -> fastBool False
cafRefs p (Lit l) = fastBool False
cafRefs p (App f a) = fastOr (cafRefs p f) (cafRefs p) a
cafRefs p (Lam x e) = cafRefs p e
cafRefs p (Let b e) = fastOr (cafRefss p (rhssOfBind b)) (cafRefs p) e
cafRefs p (Case e bndr alts) = fastOr (cafRefs p e) (cafRefss p) (rhssOfAlts alts)
cafRefs p (Note n e) = cafRefs p e
cafRefs p (Type t) = fastBool False
cafRefss p [] = fastBool False
cafRefss p (e:es) = fastOr (cafRefs p e) (cafRefss p) es
-- hack for lazy-or over FastBool.
fastOr a f x = fastBool (isFastTrue a || isFastTrue (f x))
\end{code}
......@@ -209,7 +209,6 @@ coreTopBindToStg env body_fvs (Rec pairs)
in
ASSERT2(and [manifestArity rhs == stgRhsArity stg_rhs | (rhs,stg_rhs) <- rhss `zip` stg_rhss], ppr binders)
ASSERT2(consistentCafInfo (head binders) bind, ppr binders)
-- WARN(not (consistent caf_info bind), ppr binders <+> ppr cafs <+> ppCafInfo caf_info)
(env', fvs' `unionFVInfo` body_fvs, bind)
#ifdef DEBUG
......@@ -219,10 +218,12 @@ coreTopBindToStg env body_fvs (Rec pairs)
-- floated out a binding, in which case it will be approximate.
consistentCafInfo id bind
| occNameFS (nameOccName (idName id)) == FSLIT("sat")
= id_marked_caffy || not binding_is_caffy
= safe
| otherwise
= id_marked_caffy == binding_is_caffy
= WARN (not exact, ppr id) safe
where
safe = id_marked_caffy || not binding_is_caffy
exact = id_marked_caffy == binding_is_caffy
id_marked_caffy = mayHaveCafRefs (idCafInfo id)
binding_is_caffy = stgBindHasCafRefs bind
#endif
......
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