From: simonpj Date: Mon, 29 Jan 2001 08:40:18 +0000 (+0000) Subject: [project @ 2001-01-29 08:40:18 by simonpj] X-Git-Tag: Approximately_9120_patches~2790 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=472845ba925da4553909a8b4f0edda1fe93de0e3;p=ghc-hetmet.git [project @ 2001-01-29 08:40:18 by simonpj] BinderInfo --> OccInfo (a long-awaited tidy-up) --- diff --git a/ghc/compiler/simplCore/BinderInfo.lhs b/ghc/compiler/simplCore/BinderInfo.lhs deleted file mode 100644 index d98ea9e..0000000 --- a/ghc/compiler/simplCore/BinderInfo.lhs +++ /dev/null @@ -1,164 +0,0 @@ -% -% (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} diff --git a/ghc/compiler/simplCore/OccurAnal.lhs b/ghc/compiler/simplCore/OccurAnal.lhs index 3dff2de..7fa1553 100644 --- a/ghc/compiler/simplCore/OccurAnal.lhs +++ b/ghc/compiler/simplCore/OccurAnal.lhs @@ -17,7 +17,6 @@ module OccurAnal ( #include "HsVersions.h" -import BinderInfo import CoreSyn import CoreFVs ( idRuleVars ) import CoreUtils ( exprIsTrivial ) @@ -33,7 +32,7 @@ import VarSet 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 ) @@ -55,7 +54,7 @@ Here's the externally-callable interface: \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 @@ -527,7 +526,7 @@ occAnalRhs env id rhs -- 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} @@ -545,7 +544,7 @@ occAnal env (Type t) = (emptyDetails, Type t) 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, @@ -686,7 +685,7 @@ occAnalApp env (Var fun, args) 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 @@ -811,20 +810,20 @@ oneShotGroup (OccEnv ifun cands ctxt) bndrs 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) @@ -856,23 +855,56 @@ tagBinder usage binder 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}