X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=d53bf5627d99638a48f0f07e57eb846b4e0dc65a;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=54578ae2f4f8aa3d03e4ee291a5854e76a437a29;hpb=23f40f0e9be6d4aa5cf9ea31d73f4013f8e7b4bd;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index 54578ae..d53bf56 100644 --- a/ghc/compiler/basicTypes/IdInfo.lhs +++ b/ghc/compiler/basicTypes/IdInfo.lhs @@ -16,7 +16,6 @@ module IdInfo ( -- Zapping zapLamInfo, zapDemandInfo, - shortableIdInfo, copyIdInfo, -- Arity ArityInfo, @@ -64,7 +63,8 @@ module IdInfo ( occInfo, setOccInfo, -- Specialisation - specInfo, setSpecInfo, + SpecInfo(..), specInfo, setSpecInfo, isEmptySpecInfo, + specInfoFreeVars, specInfoRules, seqSpecInfo, -- CAF info CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs, @@ -80,6 +80,7 @@ import CoreSyn import Class ( Class ) import PrimOp ( PrimOp ) import Var ( Id ) +import VarSet ( VarSet, emptyVarSet, seqVarSet ) import BasicTypes ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker, InsideLam, insideLam, notInsideLam, OneBranch, oneBranch, notOneBranch, @@ -230,14 +231,19 @@ an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported data GlobalIdDetails = VanillaGlobal -- Imported from elsewhere, a default method Id. - | RecordSelId TyCon FieldLabel -- The Id for a record selector + | RecordSelId -- The Id for a record selector + { sel_tycon :: TyCon + , sel_label :: FieldLabel + , sel_naughty :: Bool -- True <=> naughty + } -- See Note [Naughty record selectors] + -- with MkId.mkRecordSelectorId | DataConWorkId DataCon -- The Id for a data constructor *worker* | DataConWrapId DataCon -- The Id for a data constructor *wrapper* -- [the only reasons we need to know is so that - -- a) we can suppress printing a definition in the interface file - -- b) when typechecking a pattern we can get from the - -- Id back to the data con] + -- a) to support isImplicitId + -- b) when desugaring a RecordCon we can get + -- from the Id back to the data con] | ClassOpId Class -- An operation of a class @@ -256,7 +262,7 @@ instance Outputable GlobalIdDetails where ppr (ClassOpId _) = ptext SLIT("[ClassOp]") ppr (PrimOpId _) = ptext SLIT("[PrimOp]") ppr (FCallId _) = ptext SLIT("[ForeignCall]") - ppr (RecordSelId _ _) = ptext SLIT("[RecSel]") + ppr (RecordSelId {}) = ptext SLIT("[RecSel]") \end{code} @@ -283,13 +289,20 @@ case. KSW 1999-04). data IdInfo = IdInfo { arityInfo :: !ArityInfo, -- Its arity - specInfo :: CoreRules, -- Specialisations of this function which exist + specInfo :: SpecInfo, -- Specialisations of this function which exist #ifdef OLD_STRICTNESS cprInfo :: CprInfo, -- Function always constructs a product result demandInfo :: Demand.Demand, -- Whether or not it is definitely demanded strictnessInfo :: StrictnessInfo, -- Strictness properties #endif workerInfo :: WorkerInfo, -- Pointer to Worker Function + -- Within one module this is irrelevant; the + -- inlining of a worker is handled via the Unfolding + -- WorkerInfo is used *only* to indicate the form of + -- the RHS, so that interface files don't actually + -- need to contain the RHS; it can be derived from + -- the strictness info + unfoldingInfo :: Unfolding, -- Its unfolding cafInfo :: CafInfo, -- CAF info lbvarInfo :: LBVarInfo, -- Info about a lambda-bound variable @@ -311,7 +324,7 @@ seqIdInfo (IdInfo {}) = () megaSeqIdInfo :: IdInfo -> () megaSeqIdInfo info - = seqRules (specInfo info) `seq` + = seqSpecInfo (specInfo info) `seq` seqWorker (workerInfo info) `seq` -- Omitting this improves runtimes a little, presumably because @@ -379,7 +392,7 @@ vanillaIdInfo demandInfo = wwLazy, strictnessInfo = NoStrictnessInfo, #endif - specInfo = emptyCoreRules, + specInfo = emptySpecInfo, workerInfo = NoWorker, unfoldingInfo = noUnfolding, lbvarInfo = NoLBVarInfo, @@ -434,6 +447,36 @@ type InlinePragInfo = Activation -- -- If there was an INLINE pragma, then as a separate matter, the -- RHS will have been made to look small with a CoreSyn Inline Note + + -- The default InlinePragInfo is AlwaysActive, so the info serves + -- entirely as a way to inhibit inlining until we want it +\end{code} + + +%************************************************************************ +%* * + SpecInfo +%* * +%************************************************************************ + +\begin{code} +-- CoreRules is used only in an idSpecialisation (move to IdInfo?) +data SpecInfo + = SpecInfo [CoreRule] VarSet -- Locally-defined free vars of RHSs + +emptySpecInfo :: SpecInfo +emptySpecInfo = SpecInfo [] emptyVarSet + +isEmptySpecInfo :: SpecInfo -> Bool +isEmptySpecInfo (SpecInfo rs _) = null rs + +specInfoFreeVars :: SpecInfo -> VarSet +specInfoFreeVars (SpecInfo _ fvs) = fvs + +specInfoRules :: SpecInfo -> [CoreRule] +specInfoRules (SpecInfo rules _) = rules + +seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs \end{code} @@ -481,7 +524,7 @@ seqWorker (HasWorker id a) = id `seq` a `seq` () seqWorker NoWorker = () ppWorkerInfo NoWorker = empty -ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id +ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("Worker") <+> ppr wk_id workerExists :: WorkerInfo -> Bool workerExists NoWorker = False @@ -636,12 +679,12 @@ zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand}) 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 (OneOcc in_lam once) = in_lam - is_safe_occ other = True + is_safe_occ (OneOcc in_lam _ _) = in_lam + is_safe_occ other = True safe_occ = case occ of - OneOcc _ once -> OneOcc insideLam once - other -> occ + OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt + other -> occ is_safe_dmd Nothing = True is_safe_dmd (Just dmd) = not (isStrictDmd dmd) @@ -654,70 +697,3 @@ zapDemandInfo info@(IdInfo {newDemandInfo = dmd}) | otherwise = Nothing \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 (a) we must be careful about messing up rules - (b) we must ensure f's IdInfo ends up right - -(a) Messing up the rules -~~~~~~~~~~~~~~~~~~~~ -The example that went bad on me was this one: - - iterate :: (a -> a) -> a -> [a] - iterate = iterateList - - iterateFB c f x = x `c` iterateFB c f (f x) - iterateList f x = x : iterateList f (f x) - - {-# RULES - "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x) - "iterateFB" iterateFB (:) = iterateList - #-} - -This got shorted out to: - - iterateList :: (a -> a) -> a -> [a] - iterateList = iterate - - iterateFB c f x = x `c` iterateFB c f (f x) - iterate f x = x : iterate f (f x) - - {-# RULES - "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x) - "iterateFB" iterateFB (:) = iterate - #-} - -And now we get an infinite loop in the rule system - iterate f x -> build (\cn -> iterateFB c f x) - -> iterateFB (:) f x - -> iterate f x - -Tiresome solution: don't do shorting out if f has rewrite rules. -Hence shortableIdInfo. - -(b) Keeping the IdInfo right -~~~~~~~~~~~~~~~~~~~~~~~~ -We want to move strictness/worker info from f_local to f, but keep the rest. -Hence copyIdInfo. - -\begin{code} -shortableIdInfo :: IdInfo -> Bool -shortableIdInfo info = isEmptyCoreRules (specInfo info) - -copyIdInfo :: IdInfo -- f_local - -> IdInfo -- f (the exported one) - -> IdInfo -- New info for f -copyIdInfo f_local f = f { newStrictnessInfo = newStrictnessInfo f_local, -#ifdef OLD_STRICTNESS - strictnessInfo = strictnessInfo f_local, - cprInfo = cprInfo f_local, -#endif - workerInfo = workerInfo f_local - } -\end{code}