#include "HsVersions.h"
-import BinderInfo
import CoreSyn
import CoreFVs ( idRuleVars )
import CoreUtils ( exprIsTrivial )
import Id ( isDataConId, isOneShotLambda, setOneShotLambda,
idOccInfo, setIdOccInfo,
isExportedId, modifyIdInfo, idInfo,
- idSpecialisation,
+ idSpecialisation, isLocalId,
idType, idUnique, Id
)
import IdInfo ( OccInfo(..), shortableIdInfo, copyIdInfo )
import VarSet
import VarEnv
-import Name ( isLocallyDefined )
import Type ( splitFunTy_maybe, splitForAllTys )
-import Maybes ( maybeToBool )
+import Maybes ( maybeToBool, orElse )
import Digraph ( stronglyConnCompR, SCC(..) )
import PrelNames ( buildIdKey, foldrIdKey, runSTRepIdKey, augmentIdKey )
import Unique ( u2i )
\begin{code}
occurAnalyseExpr :: (Id -> Bool) -- Tells if a variable is interesting
-> CoreExpr
- -> (IdEnv BinderInfo, -- Occ info for interesting free vars
+ -> (IdEnv OccInfo, -- Occ info for interesting free vars
CoreExpr)
occurAnalyseExpr interesting expr
-- Add occ info to tpl_vars, rhs
= Rule str tpl_vars' tpl_args rhs'
where
- (rhs_uds, rhs') = occurAnalyseExpr isLocallyDefined rhs
+ (rhs_uds, rhs') = occurAnalyseExpr isLocalId rhs
(_, tpl_vars') = tagBinders rhs_uds tpl_vars
\end{code}
other -> -- Ho ho! The normal case
(final_usage, ind_env, new_binds ++ binds')
-initialTopEnv = OccEnv isLocallyDefined -- Anything local is interesting
+initialTopEnv = OccEnv isLocalId -- Anything local is interesting
emptyVarSet
[]
-- how often I don't get shorting out becuase of IdInfo stuff
= if isExportedId exported_id && -- Only if this is exported
- isLocallyDefined local_id && -- Only if this one is defined in this
+ isLocalId local_id && -- Only if this one is defined in this
-- module, so that we *can* change its
-- binding to be the exported thing!
-- die too unless they are already referenced directly.
final_usage = foldVarSet add rhs_usage (idRuleVars id)
- add v u = addOneOcc u v noBinderInfo -- Give a non-committal binder info
+ add v u = addOneOcc u v NoOccInfo -- Give a non-committal binder info
-- (i.e manyOcc) because many copies
-- of the specialised thing can appear
\end{code}
occAnal env (Var v)
= (var_uds, Var v)
where
- var_uds | isCandidate env v = unitVarEnv v funOccZero
+ var_uds | isCandidate env v = unitVarEnv v oneOcc
| otherwise = emptyDetails
-- At one stage, I gathered the idRuleVars for v here too,
where
fun_uniq = idUnique fun
- fun_uds | isCandidate env fun = unitVarEnv fun funOccZero
+ fun_uds | isCandidate env fun = unitVarEnv fun oneOcc
| otherwise = emptyDetails
args_stuff | fun_uniq == buildIdKey = appSpecial env 2 [True,True] args
zapCtxt env@(OccEnv ifun cands []) = env
zapCtxt (OccEnv ifun cands _ ) = OccEnv ifun cands []
-type UsageDetails = IdEnv BinderInfo -- A finite map from ids to their usage
+type UsageDetails = IdEnv OccInfo -- A finite map from ids to their usage
combineUsageDetails, combineAltsUsageDetails
:: UsageDetails -> UsageDetails -> UsageDetails
combineUsageDetails usage1 usage2
- = plusVarEnv_C addBinderInfo usage1 usage2
+ = plusVarEnv_C addOccInfo usage1 usage2
combineAltsUsageDetails usage1 usage2
- = plusVarEnv_C orBinderInfo usage1 usage2
+ = plusVarEnv_C orOccInfo usage1 usage2
-addOneOcc :: UsageDetails -> Id -> BinderInfo -> UsageDetails
+addOneOcc :: UsageDetails -> Id -> OccInfo -> UsageDetails
addOneOcc usage id info
- = plusVarEnv_C addBinderInfo usage (unitVarEnv id info)
+ = plusVarEnv_C addOccInfo usage (unitVarEnv id info)
-- ToDo: make this more efficient
emptyDetails = (emptyVarEnv :: UsageDetails)
in
usage' `seq` (usage', binder')
-
setBinderOcc :: UsageDetails -> CoreBndr -> CoreBndr
setBinderOcc usage bndr
| isTyVar bndr = bndr
- | isExportedId bndr
- = -- Don't use local usage info for visible-elsewhere things
- -- BUT *do* erase any IAmALoopBreaker annotation, because we're
- -- about to re-generate it and it shouldn't be "sticky"
- case idOccInfo bndr of
- NoOccInfo -> bndr
- other -> setIdOccInfo bndr NoOccInfo
+ | isExportedId bndr = case idOccInfo bndr of
+ NoOccInfo -> bndr
+ other -> setIdOccInfo bndr NoOccInfo
+ -- Don't use local usage info for visible-elsewhere things
+ -- BUT *do* erase any IAmALoopBreaker annotation, because we're
+ -- about to re-generate it and it shouldn't be "sticky"
- | otherwise = setIdOccInfo bndr occ_info
+ | otherwise = setIdOccInfo bndr occ_info
where
- occ_info = case lookupVarEnv usage bndr of
- Nothing -> IAmDead
- Just info -> binderInfoToOccInfo info
+ occ_info = lookupVarEnv usage bndr `orElse` IAmDead
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Operations over OccInfo}
+%* *
+%************************************************************************
+
+\begin{code}
+oneOcc :: OccInfo
+oneOcc = OneOcc False True
+
+markMany, markInsideLam, markInsideSCC :: OccInfo -> OccInfo
+
+markMany IAmDead = IAmDead
+markMany other = NoOccInfo
+
+markInsideSCC occ = markMany occ
+
+markInsideLam (OneOcc _ one_br) = OneOcc True one_br
+markInsideLam occ = occ
+
+addOccInfo, orOccInfo :: OccInfo -> OccInfo -> OccInfo
+
+addOccInfo IAmDead info2 = info2
+addOccInfo info1 IAmDead = info1
+addOccInfo info1 info2 = NoOccInfo
+
+-- (orOccInfo orig new) is used
+-- when combining occurrence info from branches of a case
+
+orOccInfo IAmDead info2 = info2
+orOccInfo info1 IAmDead = info1
+orOccInfo (OneOcc in_lam1 one_branch1)
+ (OneOcc in_lam2 one_branch2)
+ = OneOcc (in_lam1 || in_lam2)
+ False -- False, because it occurs in both branches
-funOccZero = funOccurrence 0
+orOccInfo info1 info2 = NoOccInfo
\end{code}
projects / ghc-hetmet.git / blobdiff