X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FOccurAnal.lhs;h=eaa3383b56f535075b126648803e7dfa18f92a70;hb=ebf2c80221ccf11aeb7a0a2be27bfc72529855a5;hp=2aefb2b0e755f73f51df6793536fead917d983be;hpb=a127213c1890584702075d732d7bb9887113e4ff;p=ghc-hetmet.git diff --git a/ghc/compiler/simplCore/OccurAnal.lhs b/ghc/compiler/simplCore/OccurAnal.lhs index 2aefb2b..eaa3383 100644 --- a/ghc/compiler/simplCore/OccurAnal.lhs +++ b/ghc/compiler/simplCore/OccurAnal.lhs @@ -12,37 +12,33 @@ core expression with (hopefully) improved usage information. \begin{code} module OccurAnal ( - occurAnalyseBinds, occurAnalyseExpr, occurAnalyseGlobalExpr, - markBinderInsideLambda, tagBinders, - UsageDetails + occurAnalyseBinds, occurAnalyseGlobalExpr, occurAnalyseRule ) where #include "HsVersions.h" -import BinderInfo -import CmdLineOpts ( SimplifierSwitch(..) ) import CoreSyn import CoreFVs ( idRuleVars ) import CoreUtils ( exprIsTrivial ) -import Literal ( Literal(..) ) -import Id ( isSpecPragmaId, isDataConId, isOneShotLambda, setOneShotLambda, +import Id ( isDataConId, isOneShotLambda, setOneShotLambda, idOccInfo, setIdOccInfo, isExportedId, modifyIdInfo, idInfo, - idSpecialisation, + idSpecialisation, isLocalId, idType, idUnique, Id ) -import IdInfo ( OccInfo(..), insideLam, copyIdInfo ) +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 Unique ( u2i, buildIdKey, foldrIdKey, runSTRepIdKey, augmentIdKey ) +import PrelNames ( buildIdKey, foldrIdKey, runSTRepIdKey, augmentIdKey ) +import Unique ( u2i ) import UniqFM ( keysUFM ) -import Util ( zipWithEqual, mapAndUnzip, count ) +import Util ( zipWithEqual, mapAndUnzip ) +import FastTypes import Outputable \end{code} @@ -58,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 @@ -71,6 +67,15 @@ occurAnalyseGlobalExpr expr = -- Top level expr, so no interesting free vars, and -- discard occurence info returned snd (occurAnalyseExpr (\_ -> False) expr) + +occurAnalyseRule :: CoreRule -> CoreRule +occurAnalyseRule rule@(BuiltinRule _) = rule +occurAnalyseRule (Rule str tpl_vars tpl_args rhs) + -- Add occ info to tpl_vars, rhs + = Rule str tpl_vars' tpl_args rhs' + where + (rhs_uds, rhs') = occurAnalyseExpr isLocalId rhs + (_, tpl_vars') = tagBinders rhs_uds tpl_vars \end{code} @@ -82,22 +87,20 @@ occurAnalyseGlobalExpr expr In @occAnalTop@ we do indirection-shorting. That is, if we have this: - loc = + x_local = ... - exp = loc + x_exported = loc where exp is exported, and loc is not, then we replace it with this: - loc = exp - exp = + x_local = x_exported + x_exported = ... -Without this we never get rid of the exp = loc thing. -This save a gratuitous jump -(from \tr{x_exported} to \tr{x_local}), and makes strictness -information propagate better. -This used to happen in the final phase, but it's tidier to do it here. - +Without this we never get rid of the x_exported = x_local thing. This +save a gratuitous jump (from \tr{x_exported} to \tr{x_local}), and +makes strictness information propagate better. This used to happen in +the final phase, but it's tidier to do it here. If more than one exported thing is equal to a local thing (i.e., the local thing really is shared), then we do one only: @@ -139,7 +142,10 @@ occurAnalyseBinds binds go :: OccEnv -> [CoreBind] -> (UsageDetails, -- Occurrence info IdEnv Id, -- Indirection elimination info - [CoreBind]) + -- Maps local-id -> exported-id, but it embodies + -- bindings of the form exported-id = local-id in + -- the argument to go + [CoreBind]) -- Occ-analysed bindings, less the exported-id=local-id ones go env [] = (emptyDetails, emptyVarEnv, []) @@ -165,9 +171,9 @@ occurAnalyseBinds binds ind_env' = extendVarEnv ind_env local_id exported_id other -> -- Ho ho! The normal case - (final_usage, ind_env, new_binds ++ binds') + (final_usage, ind_env, new_binds ++ binds') -initialTopEnv = OccEnv isLocallyDefined -- Anything local is interesting +initialTopEnv = OccEnv isLocalId -- Anything local is interesting emptyVarSet [] @@ -181,27 +187,34 @@ zapBind ind_env (Rec pairs) zapBind ind_env bind = bind -zap ind_env pair@(bndr,rhs) - = case lookupVarEnv ind_env bndr of +zap ind_env pair@(local_id,rhs) + = case lookupVarEnv ind_env local_id of Nothing -> [pair] - Just exported_id -> [(bndr, Var exported_id), - (exported_id_w_info, rhs)] - where - exported_id_w_info = modifyIdInfo (copyIdInfo (idInfo bndr)) exported_id - -- See notes with copyIdInfo about propagating IdInfo from - -- one to t'other + Just exported_id -> [(local_id, Var exported_id), + (exported_id', rhs)] + where + exported_id' = modifyIdInfo (copyIdInfo (idInfo local_id)) exported_id shortMeOut ind_env exported_id local_id - = isExportedId exported_id && -- Only if this is exported - - isLocallyDefined local_id && -- Only if this one is defined in this - -- module, so that we *can* change its - -- binding to be the exported thing! - - not (isExportedId local_id) && -- Only if this one is not itself exported, - -- since the transformation will nuke it - - not (local_id `elemVarEnv` ind_env) -- Only if not already substituted for +-- The if-then-else stuff is just so I can get a pprTrace to see +-- how often I don't get shorting out becuase of IdInfo stuff + = if isExportedId exported_id && -- Only if this is exported + + isLocalId local_id && -- Only if this one is defined in this + -- module, so that we *can* change its + -- binding to be the exported thing! + + not (isExportedId local_id) && -- Only if this one is not itself exported, + -- since the transformation will nuke it + + not (local_id `elemVarEnv` ind_env) -- Only if not already substituted for + then + if shortableIdInfo (idInfo exported_id) -- Only if its IdInfo is 'shortable' + -- (see the defn of IdInfo.shortableIdInfo + then True + else pprTrace "shortMeOut:" (ppr exported_id) False + else + False \end{code} @@ -281,8 +294,6 @@ It isn't easy to do a perfect job in one blow. Consider occAnalBind env (Rec pairs) body_usage = foldr (_scc_ "occAnalBind.dofinal" do_final_bind) (body_usage, []) sccs where - pp_item (_, bndr, _) = ppr bndr - binders = map fst pairs rhs_env = env `addNewCands` binders @@ -299,7 +310,7 @@ occAnalBind env (Rec pairs) body_usage ---- stuff for dependency analysis of binds ------------------------------- edges :: [Node Details1] edges = _scc_ "occAnalBind.assoc" - [ (details, IBOX(u2i (idUnique id)), edges_from rhs_usage) + [ (details, iBox (u2i (idUnique id)), edges_from rhs_usage) | details@(id, rhs_usage, rhs) <- analysed_pairs ] @@ -446,13 +457,24 @@ reOrderRec env (CyclicSCC (bind : binds)) score :: Node Details2 -> Int -- Higher score => less likely to be picked as loop breaker score ((bndr, rhs), _, _) - | exprIsTrivial rhs && - not (isExportedId bndr) = 3 -- Practically certain to be inlined - | inlineCandidate bndr rhs = 3 -- Likely to be inlined - | not_fun_ty (idType bndr) = 2 -- Data types help with cases + | exprIsTrivial rhs = 4 -- Practically certain to be inlined + -- Used to have also: && not (isExportedId bndr) + -- But I found this sometimes cost an extra iteration when we have + -- rec { d = (a,b); a = ...df...; b = ...df...; df = d } + -- where df is the exported dictionary. Then df makes a really + -- bad choice for loop breaker + + | not_fun_ty (idType bndr) = 3 -- Data types help with cases + -- This used to have a lower score than inlineCandidate, but + -- it's *really* helpful if dictionaries get inlined fast, + -- so I'm experimenting with giving higher priority to data-typed things + + | inlineCandidate bndr rhs = 2 -- Likely to be inlined + | not (isEmptyCoreRules (idSpecialisation bndr)) = 1 -- Avoid things with specialisations; we'd like -- to take advantage of them in the subsequent bindings + | otherwise = 0 inlineCandidate :: Id -> CoreExpr -> Bool @@ -504,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} @@ -522,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, @@ -608,8 +630,8 @@ occAnal env expr@(Lam _ _) (really_final_usage, mkLams tagged_binders body') } where - (binders, body) = collectBinders expr - (linear, env_body, binders') = oneShotGroup env binders + (binders, body) = collectBinders expr + (linear, env_body, _) = oneShotGroup env binders occAnal env (Case scrut bndr alts) = case mapAndUnzip (occAnalAlt alt_env) alts of { (alts_usage_s, alts') -> @@ -663,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 @@ -788,26 +810,24 @@ 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) -unitDetails id info = (unitVarEnv id info :: UsageDetails) - usedIn :: Id -> UsageDetails -> Bool v `usedIn` details = isExportedId v || v `elemVarEnv` details @@ -835,33 +855,57 @@ 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 -markBinderInsideLambda :: CoreBndr -> CoreBndr -markBinderInsideLambda bndr - | isTyVar bndr - = bndr +-- (orOccInfo orig new) is used +-- when combining occurrence info from branches of a case - | otherwise - = case idOccInfo bndr of - OneOcc _ once -> bndr `setIdOccInfo` OneOcc insideLam once - other -> bndr +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}