X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=f899847e18c7e2e7e421a6b80790e1a633059ddd;hb=c2b053f3228a8e32cf4d4909c2e97b338e3ac3c1;hp=92092956e7ac24dd76386043562a441e3cf246e3;hpb=9d787ef5a8072b6c1f576f2de1b66edfa59813ed;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index 9209295..f899847 100644 --- a/ghc/compiler/basicTypes/IdInfo.lhs +++ b/ghc/compiler/basicTypes/IdInfo.lhs @@ -12,9 +12,12 @@ module IdInfo ( vanillaIdInfo, mkIdInfo, seqIdInfo, megaSeqIdInfo, + -- Zapping + zapFragileInfo, zapLamInfo, zapSpecPragInfo, copyIdInfo, + -- Flavour IdFlavour(..), flavourInfo, - setNoDiscardInfo, zapSpecPragInfo, copyIdInfo, + setNoDiscardInfo, ppFlavourInfo, -- Arity @@ -40,8 +43,12 @@ module IdInfo ( demandInfo, setDemandInfo, -- Inline prags - InlinePragInfo(..), OccInfo(..), - inlinePragInfo, setInlinePragInfo, notInsideLambda, + InlinePragInfo(..), + inlinePragInfo, setInlinePragInfo, pprInlinePragInfo, + + -- Occurrence info + OccInfo(..), InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch, + occInfo, setOccInfo, isFragileOccInfo, -- Specialisation specInfo, setSpecInfo, @@ -56,9 +63,6 @@ module IdInfo ( -- Constructed Product Result Info CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, - -- Zapping - zapLamIdInfo, zapFragileIdInfo, zapIdInfoForStg, - -- Lambda-bound variable info LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo ) where @@ -71,9 +75,9 @@ import {-# SOURCE #-} CoreSyn ( CoreExpr, CoreRules, emptyCoreRules, isEmptyCor import {-# SOURCE #-} Const ( Con ) import Var ( Id ) +import VarSet ( IdOrTyVarSet ) import FieldLabel ( FieldLabel ) import Demand ( Demand, isStrict, isLazy, wwLazy, pprDemands, seqDemand, seqDemands ) -import Type ( UsageAnn ) import Outputable import Maybe ( isJust ) @@ -86,7 +90,8 @@ infixl 1 `setUpdateInfo`, `setUnfoldingInfo`, `setCprInfo`, `setWorkerInfo`, - `setCafInfo` + `setCafInfo`, + `setOccInfo` -- infixl so you can say (id `set` a `set` b) \end{code} @@ -121,7 +126,8 @@ data IdInfo cafInfo :: CafInfo, cprInfo :: CprInfo, -- Function always constructs a product result lbvarInfo :: LBVarInfo, -- Info about a lambda-bound variable - inlinePragInfo :: InlinePragInfo -- Inline pragmas + inlinePragInfo :: InlinePragInfo, -- Inline pragma + occInfo :: OccInfo -- How it occurs } seqIdInfo :: IdInfo -> () @@ -143,15 +149,16 @@ megaSeqIdInfo info seqCaf (cafInfo info) `seq` seqCpr (cprInfo info) `seq` seqLBVar (lbvarInfo info) `seq` - seqInlinePrag (inlinePragInfo info) + seqOccInfo (occInfo info) \end{code} Setters \begin{code} setWorkerInfo info wk = wk `seq` info { workerInfo = wk } -setSpecInfo info sp = sp `seq` info { specInfo = sp } +setSpecInfo info sp = PSEQ sp (info { specInfo = sp }) setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } +setOccInfo info oc = oc `seq` info { occInfo = oc } setStrictnessInfo info st = st `seq` info { strictnessInfo = st } -- Try to avoid spack leaks by seq'ing @@ -173,43 +180,6 @@ zapSpecPragInfo info = case flavourInfo info of SpecPragmaId -> info { flavourInfo = VanillaId } other -> info -copyIdInfo :: IdInfo -- From - -> IdInfo -- To - -> IdInfo -- To updated with stuff from From; except flavour unchanged --- copyIdInfo is used when shorting out a top-level binding --- f_local = BIG --- f = f_local --- where f is exported. We are going to swizzle it around to --- f = BIG --- f_local = f --- but we must be careful to combine their IdInfos right. --- The fact that things can go wrong here is a bad sign, but I can't see --- how to make it 'patently right', so copyIdInfo is derived (pretty much) by trial and error --- --- Here 'from' is f_local, 'to' is f. - -copyIdInfo from to = from { flavourInfo = flavourInfo to, - specInfo = specInfo to - } - -- It's important to propagate the inline pragmas from bndr - -- to exportd_id. Ditto strictness etc. This "bites" when we use an INLNE pragma: - -- {-# INLINE f #-} - -- f x = (x,x) - -- - -- This becomes (where the "*" means INLINE prag) - -- - -- M.f = /\a -> let mf* = \x -> (x,x) in mf - -- - -- Now the mf floats out and we end up with the trivial binding - -- - -- mf* = /\a -> \x -> (x,x) - -- M.f = mf - -- - -- Now, when we short out the M.f = mf binding we must preserve the inline - -- pragma on the mf binding. - -- - -- On the other hand, transformation rules may be attached to the - -- 'to' Id, and we want to preserve them. \end{code} @@ -230,7 +200,8 @@ mkIdInfo flv = IdInfo { cafInfo = MayHaveCafRefs, cprInfo = NoCPRInfo, lbvarInfo = NoLBVarInfo, - inlinePragInfo = NoInlinePragInfo + inlinePragInfo = NoInlinePragInfo, + occInfo = NoOccInfo } \end{code} @@ -284,8 +255,15 @@ besides the code-generator need arity info!) \begin{code} data ArityInfo = UnknownArity -- No idea - | ArityExactly Int -- Arity is exactly this - | ArityAtLeast Int -- Arity is this or greater + + | ArityExactly Int -- Arity is exactly this. We use this when importing a + -- function; it's already been compiled and we know its + -- arity for sure. + + | ArityAtLeast Int -- Arity is this or greater. We attach this arity to + -- functions in the module being compiled. Their arity + -- might increase later in the compilation process, if + -- an extra lambda floats up to the binding site. seqArity :: ArityInfo -> () seqArity a = arityLowerBound a `seq` () @@ -317,65 +295,78 @@ ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("__AL"), int arity] \begin{code} data InlinePragInfo = NoInlinePragInfo + | IMustNotBeINLINEd Bool -- True <=> came from an INLINE prag, False <=> came from a NOINLINE prag + (Maybe Int) -- Phase number from pragma, if any + -- The True, Nothing case doesn't need to be recorded - | IMustNotBeINLINEd -- User NOINLINE pragma - - | IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers - -- in a group of recursive definitions +instance Outputable InlinePragInfo where + -- This is now parsed in interface files + ppr NoInlinePragInfo = empty + ppr other_prag = ptext SLIT("__U") <> pprInlinePragInfo other_prag + +pprInlinePragInfo NoInlinePragInfo = empty +pprInlinePragInfo (IMustNotBeINLINEd True Nothing) = empty +pprInlinePragInfo (IMustNotBeINLINEd True (Just n)) = brackets (int n) +pprInlinePragInfo (IMustNotBeINLINEd False Nothing) = brackets (char '!') +pprInlinePragInfo (IMustNotBeINLINEd False (Just n)) = brackets (char '!' <> int n) + +instance Show InlinePragInfo where + showsPrec p prag = showsPrecSDoc p (ppr prag) +\end{code} - | ICanSafelyBeINLINEd -- Used by the occurrence analyser to mark things - -- that manifesly occur once, not inside SCCs, - -- not in constructor arguments - OccInfo -- Says whether the occurrence is inside a lambda - -- If so, must only substitute WHNFs +%************************************************************************ +%* * +\subsection{Occurrence information} +%* * +%************************************************************************ - Bool -- False <=> occurs in more than one case branch - -- If so, there's a code-duplication issue +\begin{code} +data OccInfo + = NoOccInfo | IAmDead -- Marks unused variables. Sometimes useful for -- lambda and case-bound variables. - | IMustBeINLINEd -- Absolutely must inline; used for PrimOps and - -- constructors only. + | OneOcc InsideLam -seqInlinePrag :: InlinePragInfo -> () -seqInlinePrag (ICanSafelyBeINLINEd occ alts) - = occ `seq` alts `seq` () -seqInlinePrag other - = () + OneBranch -instance Outputable InlinePragInfo where - -- only used for debugging; never parsed. KSW 1999-07 - ppr NoInlinePragInfo = empty - ppr IMustBeINLINEd = ptext SLIT("__UU") - ppr IMustNotBeINLINEd = ptext SLIT("__Unot") - ppr IAmALoopBreaker = ptext SLIT("__Ux") - ppr IAmDead = ptext SLIT("__Ud") - ppr (ICanSafelyBeINLINEd InsideLam _) = ptext SLIT("__Ul") - ppr (ICanSafelyBeINLINEd _ _) = ptext SLIT("__Us") - -instance Show InlinePragInfo where - showsPrec p prag = showsPrecSDoc p (ppr prag) -\end{code} + | IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers + -- in a group of recursive definitions -\begin{code} -data OccInfo - = NotInsideLam +seqOccInfo :: OccInfo -> () +seqOccInfo (OneOcc in_lam once) = in_lam `seq` once `seq` () +seqOccInfo occ = () - | InsideLam -- Inside a non-linear lambda (that is, a lambda which - -- is sure to be instantiated only once). +type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda -- Substituting a redex for this occurrence is -- dangerous because it might duplicate work. +insideLam = True +notInsideLam = False -instance Outputable OccInfo where - ppr NotInsideLam = empty - ppr InsideLam = text "l" +type OneBranch = Bool -- True <=> Occurs in only one case branch + -- so no code-duplication issue to worry about +oneBranch = True +notOneBranch = False +isFragileOccInfo :: OccInfo -> Bool +isFragileOccInfo (OneOcc _ _) = True +isFragileOccInfo other = False +\end{code} -notInsideLambda :: OccInfo -> Bool -notInsideLambda NotInsideLam = True -notInsideLambda InsideLam = False +\begin{code} +instance Outputable OccInfo where + -- only used for debugging; never parsed. KSW 1999-07 + ppr NoOccInfo = empty + ppr IAmALoopBreaker = ptext SLIT("_Kx") + ppr IAmDead = ptext SLIT("_Kd") + ppr (OneOcc inside_lam one_branch) | inside_lam = ptext SLIT("_Kl") + | one_branch = ptext SLIT("_Ks") + | otherwise = ptext SLIT("_Ks*") + +instance Show OccInfo where + showsPrec p occ = showsPrecSDoc p (ppr occ) \end{code} %************************************************************************ @@ -466,7 +457,7 @@ ppWorkerInfo (Just wk_id) = ptext SLIT("__P") <+> ppr wk_id noWorkerInfo = Nothing -workerExists :: Maybe Id -> Bool +workerExists :: WorkerInfo -> Bool workerExists = isJust \end{code} @@ -537,98 +528,6 @@ ppCafInfo MayHaveCafRefs = empty %************************************************************************ %* * -\subsection[CAF-IdInfo]{CAF-related information} -%* * -%************************************************************************ - -zapFragileIdInfo is used when cloning binders, mainly in the -simplifier. We must forget about used-once information because that -isn't necessarily correct in the transformed program. -Also forget specialisations and unfoldings because they would need -substitution to be correct. (They get pinned back on separately.) - -\begin{code} -zapFragileIdInfo :: IdInfo -> Maybe IdInfo -zapFragileIdInfo info@(IdInfo {inlinePragInfo = inline_prag, - workerInfo = wrkr, - specInfo = rules, - unfoldingInfo = unfolding}) - | not is_fragile_inline_prag - -- We must forget about whether it was marked safe-to-inline, - -- because that isn't necessarily true in the simplified expression. - -- This is important because expressions may be re-simplified - - && isEmptyCoreRules rules - -- Specialisations would need substituting. They get pinned - -- back on separately. - - && not (workerExists wrkr) - - && not (hasUnfolding unfolding) - -- This is very important; occasionally a let-bound binder is used - -- as a binder in some lambda, in which case its unfolding is utterly - -- bogus. Also the unfolding uses old binders so if we left it we'd - -- have to substitute it. Much better simply to give the Id a new - -- unfolding each time, which is what the simplifier does. - = Nothing - - | otherwise - = Just (info {inlinePragInfo = safe_inline_prag, - workerInfo = noWorkerInfo, - specInfo = emptyCoreRules, - unfoldingInfo = noUnfolding}) - - where - is_fragile_inline_prag = case inline_prag of - ICanSafelyBeINLINEd _ _ -> True - --- We used to say the dead-ness was fragile, but I don't --- see why it is. Furthermore, deadness is a pain to lose; --- see Simplify.mkDupableCont (Select ...) --- IAmDead -> True - - other -> False - - -- Be careful not to destroy real 'pragma' info - safe_inline_prag | is_fragile_inline_prag = NoInlinePragInfo - | otherwise = inline_prag -\end{code} - - -@zapLamIdInfo@ is used for lambda binders that turn out to to be -part of an unsaturated lambda - -\begin{code} -zapLamIdInfo :: IdInfo -> Maybe IdInfo -zapLamIdInfo info@(IdInfo {inlinePragInfo = inline_prag, demandInfo = demand}) - | is_safe_inline_prag && not (isStrict demand) - = Nothing - | otherwise - = Just (info {inlinePragInfo = safe_inline_prag, - demandInfo = wwLazy}) - where - -- The "unsafe" prags are the ones that say I'm not in a lambda - -- because that might not be true for an unsaturated lambda - is_safe_inline_prag = case inline_prag of - ICanSafelyBeINLINEd NotInsideLam nalts -> False - other -> True - - safe_inline_prag = case inline_prag of - ICanSafelyBeINLINEd _ nalts - -> ICanSafelyBeINLINEd InsideLam nalts - other -> inline_prag -\end{code} - -\begin{code} -zapIdInfoForStg :: IdInfo -> IdInfo - -- Return only the info needed for STG stuff - -- Namely, nothing, I think -zapIdInfoForStg info = vanillaIdInfo -\end{code} - - -%************************************************************************ -%* * \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@} %* * %************************************************************************ @@ -742,3 +641,112 @@ instance Outputable LBVarInfo where instance Show LBVarInfo where showsPrec p c = showsPrecSDoc p (ppr c) \end{code} + + +%************************************************************************ +%* * +\subsection{Bulk operations on IdInfo} +%* * +%************************************************************************ + +zapFragileInfo is used when cloning binders, mainly in the +simplifier. We must forget about used-once information because that +isn't necessarily correct in the transformed program. +Also forget specialisations and unfoldings because they would need +substitution to be correct. (They get pinned back on separately.) + +\begin{code} +zapFragileInfo :: IdInfo -> Maybe IdInfo +zapFragileInfo info@(IdInfo {occInfo = occ, + workerInfo = wrkr, + specInfo = rules, + unfoldingInfo = unfolding}) + | not (isFragileOccInfo occ) + -- We must forget about whether it was marked safe-to-inline, + -- because that isn't necessarily true in the simplified expression. + -- This is important because expressions may be re-simplified + -- We don't zap deadness or loop-breaker-ness. + -- The latter is important because it tells MkIface not to + -- spit out an inlining for the thing. The former doesn't + -- seem so important, but there's no harm. + + && isEmptyCoreRules rules + -- Specialisations would need substituting. They get pinned + -- back on separately. + + && not (workerExists wrkr) + + && not (hasUnfolding unfolding) + -- This is very important; occasionally a let-bound binder is used + -- as a binder in some lambda, in which case its unfolding is utterly + -- bogus. Also the unfolding uses old binders so if we left it we'd + -- have to substitute it. Much better simply to give the Id a new + -- unfolding each time, which is what the simplifier does. + = Nothing + + | otherwise + = Just (info {occInfo = robust_occ_info, + workerInfo = noWorkerInfo, + specInfo = emptyCoreRules, + unfoldingInfo = noUnfolding}) + where + -- It's important to keep the loop-breaker info, + -- because the substitution doesn't remember it. + robust_occ_info = case occ of + OneOcc _ _ -> NoOccInfo + other -> occ +\end{code} + +@zapLamInfo@ is used for lambda binders that turn out to to be +part of an unsaturated lambda + +\begin{code} +zapLamInfo :: IdInfo -> Maybe IdInfo +zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand}) + | is_safe_occ && not (isStrict demand) + = Nothing + | otherwise + = Just (info {occInfo = safe_occ, + demandInfo = wwLazy}) + where + -- The "unsafe" occ info is the ones that say I'm not in a lambda + -- because that might not be true for an unsaturated lambda + is_safe_occ = case occ of + OneOcc in_lam once -> in_lam + other -> True + + safe_occ = case occ of + OneOcc _ once -> OneOcc insideLam once + other -> occ +\end{code} + + +copyIdInfo is used when shorting out a top-level binding + f_local = BIG + f = f_local +where f is exported. We are going to swizzle it around to + f = BIG + f_local = f +but we must be careful to combine their IdInfos right. +The fact that things can go wrong here is a bad sign, but I can't see +how to make it 'patently right', so copyIdInfo is derived (pretty much) by trial and error + +Here 'from' is f_local, 'to' is f, and the result is attached to f + +\begin{code} +copyIdInfo :: IdInfo -- From + -> IdInfo -- To + -> IdInfo -- To, updated with stuff from From; except flavour unchanged +copyIdInfo from to = from { flavourInfo = flavourInfo to, + specInfo = specInfo to, + inlinePragInfo = inlinePragInfo to + } + -- It's important to preserve the inline pragma on 'f'; e.g. consider + -- {-# NOINLINE f #-} + -- f = local + -- + -- similarly, transformation rules may be attached to f + -- and we want to preserve them. + -- + -- On the other hand, we want the strictness info from f_local. +\end{code}