+++ /dev/null
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-%************************************************************************
-%* *
-\section[BinderInfo]{Information attached to binders by SubstAnal}
-%* *
-%************************************************************************
-
-\begin{code}
-module BinderInfo (
- BinderInfo,
-
- addBinderInfo, orBinderInfo,
-
- deadOccurrence, funOccurrence, noBinderInfo,
-
- markMany, markInsideLam, markInsideSCC,
- getBinderInfoArity,
- setBinderInfoArityToZero,
-
- binderInfoToOccInfo
- ) where
-
-#include "HsVersions.h"
-
-import IdInfo ( OccInfo(..), InsideLam, insideLam, notInsideLam )
-import Outputable
-\end{code}
-
-The @BinderInfo@ describes how a variable is used in a given scope.
-
-NOTE: With SCCs we have to be careful what we unfold! We don't want to
-change the attribution of execution costs. If we decide to unfold
-within an SCC we can tag the definition as @DontKeepBinder@.
-Definitions tagged as @KeepBinder@ are discarded when we enter the
-scope of an SCC.
-
-\begin{code}
-data BinderInfo
- = DeadCode -- Dead code; discard the binding.
-
- | ManyOcc -- Everything else besides DeadCode and OneOccs
-
- !Int -- number of arguments on stack when called; this is a minimum guarantee
-
-
- | SingleOcc -- Just one occurrence (or one each in
- -- mutually-exclusive case alts).
-
- !InsideLam
-
- !InsideSCC
-
- !Int -- Number of mutually-exclusive case alternatives
- -- in which it occurs
-
- -- Note that we only worry about the case-alt counts
- -- if the SingleOcc is substitutable -- that's the only
- -- time we *use* the info; we could be more clever for
- -- other cases if we really had to. (WDP/PS)
-
- !Int -- number of arguments on stack when called; minimum guarantee
-
--- In general, we are feel free to substitute unless
--- (a) is in an argument position (ArgOcc)
--- (b) is inside a lambda [or type lambda?] (DupDanger)
--- (c) is inside an SCC expression (InsideSCC)
--- (d) is in the RHS of a binding for a variable with an INLINE pragma
--- (because the RHS will be inlined regardless of its size)
--- [again, DupDanger]
-
-data InsideSCC
- = InsideSCC -- Inside an SCC; so be careful when substituting.
- | NotInsideSCC -- It's ok.
-
-noBinderInfo = ManyOcc 0 -- A non-committal value
-\end{code}
-
-\begin{code}
-binderInfoToOccInfo :: BinderInfo -> OccInfo
-binderInfoToOccInfo DeadCode = IAmDead
-binderInfoToOccInfo (SingleOcc in_lam NotInsideSCC n_alts _) = OneOcc in_lam (n_alts==1)
-binderInfoToOccInfo other = NoOccInfo
-\end{code}
-
-
-
-Construction
-~~~~~~~~~~~~~
-\begin{code}
-deadOccurrence :: BinderInfo
-deadOccurrence = DeadCode
-
-funOccurrence :: Int -> BinderInfo
-funOccurrence = SingleOcc notInsideLam NotInsideSCC 1
-
-markMany, markInsideLam, markInsideSCC :: BinderInfo -> BinderInfo
-
-markMany (SingleOcc _ _ _ ar) = ManyOcc ar
-markMany (ManyOcc ar) = ManyOcc ar
-markMany DeadCode = panic "markMany"
-
-markInsideLam (SingleOcc _ in_scc n_alts ar) = SingleOcc insideLam in_scc n_alts ar
-markInsideLam other = other
-
-markInsideSCC (SingleOcc dup_danger _ n_alts ar) = SingleOcc dup_danger InsideSCC n_alts ar
-markInsideSCC other = other
-
-addBinderInfo, orBinderInfo :: BinderInfo -> BinderInfo -> BinderInfo
-
-addBinderInfo DeadCode info2 = info2
-addBinderInfo info1 DeadCode = info1
-addBinderInfo info1 info2
- = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
-
--- (orBinderInfo orig new) is used
--- when combining occurrence info from branches of a case
-
-orBinderInfo DeadCode info2 = info2
-orBinderInfo info1 DeadCode = info1
-orBinderInfo (SingleOcc dup1 scc1 n_alts1 ar_1)
- (SingleOcc dup2 scc2 n_alts2 ar_2)
- = let
- scc = or_sccs scc1 scc2
- dup = or_dups dup1 dup2
- alts = n_alts1 + n_alts2
- ar = min ar_1 ar_2
- in
- SingleOcc dup scc alts ar
-
-orBinderInfo info1 info2
- = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
-
-or_dups in_lam1 in_lam2 = in_lam1 || in_lam2
-
-or_sccs InsideSCC _ = InsideSCC
-or_sccs _ InsideSCC = InsideSCC
-or_sccs _ _ = NotInsideSCC
-
-setBinderInfoArityToZero :: BinderInfo -> BinderInfo
-setBinderInfoArityToZero DeadCode = DeadCode
-setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
-setBinderInfoArityToZero (SingleOcc dd sc i _) = SingleOcc dd sc i 0
-\end{code}
-
-\begin{code}
-getBinderInfoArity (DeadCode) = 0
-getBinderInfoArity (ManyOcc i) = i
-getBinderInfoArity (SingleOcc _ _ _ i) = i
-\end{code}
-
-\begin{code}
-instance Outputable BinderInfo where
- ppr DeadCode = ptext SLIT("Dead")
- ppr (ManyOcc ar) = hcat [ ptext SLIT("Many-"), int ar ]
- ppr (SingleOcc dup_danger in_scc n_alts ar)
- = hcat [ ptext SLIT("One-"), ppr dup_danger,
- char '-', pp_scc in_scc, char '-', int n_alts,
- char '-', int ar ]
- where
- pp_scc InsideSCC = ptext SLIT("*SCC*")
- pp_scc NotInsideSCC = ptext SLIT("noscc")
-\end{code}
#include "HsVersions.h"
-import BinderInfo
import CoreSyn
import CoreFVs ( idRuleVars )
import CoreUtils ( exprIsTrivial )
import VarEnv
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
-- 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) (one_branch1 && one_branch2)
-funOccZero = funOccurrence 0
+orOccInfo info1 info2 = NoOccInfo
\end{code}
projects / ghc-hetmet.git / commitdiff