StgOp(..),
-- SRTs
- SRT(..), noSRT,
+ SRT(..), noSRT, nonEmptySRT,
-- utils
- stgBindHasCafRefs, stgRhsArity, getArgPrimRep,
+ stgBindHasCafRefs, stgArgHasCafRefs, stgRhsArity, getArgPrimRep,
isLitLitArg, isDllConApp, isStgTypeArg,
stgArgType, stgBinders,
import CostCentre ( CostCentreStack, CostCentre )
import VarSet ( IdSet, isEmptyVarSet )
import Var ( isId )
-import Id ( Id, idName, idPrimRep, idType )
+import Id ( Id, idName, idPrimRep, idType, idCafInfo )
+import IdInfo ( mayHaveCafRefs )
import Name ( isDllName )
import Literal ( Literal, literalType, isLitLitLit, literalPrimRep )
import ForeignCall ( ForeignCall )
import TyCon ( TyCon )
import UniqSet ( isEmptyUniqSet, uniqSetToList, UniqSet )
import Unique ( Unique )
+import Bitmap
import CmdLineOpts ( opt_SccProfilingOn )
\end{code}
\begin{code}
data GenStgBinding bndr occ
- = StgNonRec SRT bndr (GenStgRhs bndr occ)
- | StgRec SRT [(bndr, GenStgRhs bndr occ)]
+ = StgNonRec bndr (GenStgRhs bndr occ)
+ | StgRec [(bndr, GenStgRhs bndr occ)]
stgBinders :: GenStgBinding bndr occ -> [bndr]
-stgBinders (StgNonRec _ b _) = [b]
-stgBinders (StgRec _ bs) = map fst bs
+stgBinders (StgNonRec b _) = [b]
+stgBinders (StgRec bs) = map fst bs
\end{code}
%************************************************************************
(GenStgExpr bndr occ)
-- the thing to examine
- (GenStgLiveVars occ) -- Live vars of whole case
- -- expression; i.e., those which mustn't be
- -- overwritten
+ (GenStgLiveVars occ) -- Live vars of whole case expression,
+ -- plus everything that happens after the case
+ -- i.e., those which mustn't be overwritten
- (GenStgLiveVars occ) -- Live vars of RHSs;
+ (GenStgLiveVars occ) -- Live vars of RHSs (plus what happens afterwards)
-- i.e., those which must be saved before eval.
--
-- note that an alt's constructor's
[occ] -- non-global free vars; a list, rather than
-- a set, because order is important
!UpdateFlag -- ReEntrant | Updatable | SingleEntry
+ SRT -- The SRT reference
[bndr] -- arguments; if empty, then not a function;
-- as above, order is important.
(GenStgExpr bndr occ) -- body
\begin{code}
stgRhsArity :: StgRhs -> Int
-stgRhsArity (StgRhsClosure _ _ _ _ bndrs _) = count isId bndrs
+stgRhsArity (StgRhsClosure _ _ _ _ _ bndrs _) = count isId bndrs
-- The arity never includes type parameters, so
-- when keeping type arguments and binders in the Stg syntax
-- (opt_RuntimeTypes) we have to fliter out the type binders.
\end{code}
\begin{code}
-stgBindHasCafRefs :: GenStgBinding bndr occ -> Bool
-stgBindHasCafRefs (StgNonRec srt _ rhs)
- = nonEmptySRT srt || rhsIsUpdatable rhs
-stgBindHasCafRefs (StgRec srt binds)
- = nonEmptySRT srt || any rhsIsUpdatable (map snd binds)
-
-rhsIsUpdatable (StgRhsClosure _ _ _ upd _ _) = isUpdatable upd
-rhsIsUpdatable _ = False
+stgBindHasCafRefs :: GenStgBinding bndr Id -> Bool
+stgBindHasCafRefs (StgNonRec _ rhs) = rhsHasCafRefs rhs
+stgBindHasCafRefs (StgRec binds) = any rhsHasCafRefs (map snd binds)
+
+rhsHasCafRefs (StgRhsClosure _ _ _ upd srt _ _)
+ = isUpdatable upd || nonEmptySRT srt
+rhsHasCafRefs (StgRhsCon _ _ args)
+ = any stgArgHasCafRefs args
+
+stgArgHasCafRefs (StgVarArg id) = mayHaveCafRefs (idCafInfo id)
+stgArgHasCafRefs _ = False
\end{code}
Here's the @StgBinderInfo@ type, and its combining op:
\begin{code}
data SRT = NoSRT
- | SRTEntries IdSet -- generated by CoreToStg
- | SRT !Int{-offset-} !Int{-length-} -- generated by computeSRTs
+ | SRTEntries IdSet
+ -- generated by CoreToStg
+ | SRT !Int{-offset-} !Int{-length-} !Bitmap{-bitmap-}
+ -- generated by computeSRTs
noSRT :: SRT
noSRT = NoSRT
pprSRT (NoSRT) = ptext SLIT("_no_srt_")
pprSRT (SRTEntries ids) = text "SRT:" <> ppr ids
-pprSRT (SRT off len) = parens (ppr off <> comma <> ppr len)
+pprSRT (SRT off length bitmap) = parens (ppr off <> comma <> text "*bitmap*")
\end{code}
%************************************************************************
pprGenStgBinding :: (Outputable bndr, Outputable bdee, Ord bdee)
=> GenStgBinding bndr bdee -> SDoc
-pprGenStgBinding (StgNonRec srt bndr rhs)
- = pprMaybeSRT srt $$ hang (hsep [ppr bndr, equals])
- 4 ((<>) (ppr rhs) semi)
+pprGenStgBinding (StgNonRec bndr rhs)
+ = hang (hsep [ppr bndr, equals])
+ 4 ((<>) (ppr rhs) semi)
-pprGenStgBinding (StgRec srt pairs)
+pprGenStgBinding (StgRec pairs)
= vcat ((ifPprDebug (ptext SLIT("{- StgRec (begin) -}"))) :
- pprMaybeSRT srt :
(map (ppr_bind) pairs) ++ [(ifPprDebug (ptext SLIT("{- StgRec (end) -}")))])
where
ppr_bind (bndr, expr)
pprGenStgBindingWithSRT
:: (Outputable bndr, Outputable bdee, Ord bdee)
- => (GenStgBinding bndr bdee,[Id]) -> SDoc
+ => (GenStgBinding bndr bdee,[(Id,[Id])]) -> SDoc
-pprGenStgBindingWithSRT (bind,srt)
- = vcat [ pprGenStgBinding bind,
- ptext SLIT("SRT: ") <> ppr srt ]
+pprGenStgBindingWithSRT (bind,srts)
+ = vcat (pprGenStgBinding bind : map pprSRT srts)
+ where pprSRT (id,srt) =
+ ptext SLIT("SRT") <> parens (ppr id) <> ptext SLIT(": ") <> ppr srt
-pprStgBindingsWithSRTs :: [(StgBinding,[Id])] -> SDoc
+pprStgBindingsWithSRTs :: [(StgBinding,[(Id,[Id])])] -> SDoc
pprStgBindingsWithSRTs binds = vcat (map pprGenStgBindingWithSRT binds)
\end{code}
=> GenStgRhs bndr bdee -> SDoc
-- special case
-pprStgRhs (StgRhsClosure cc bi [free_var] upd_flag [{-no args-}] (StgApp func []))
+pprStgRhs (StgRhsClosure cc bi [free_var] upd_flag srt [{-no args-}] (StgApp func []))
= hcat [ ppr cc,
pp_binder_info bi,
brackets (ifPprDebug (ppr free_var)),
- ptext SLIT(" \\"), ppr upd_flag, ptext SLIT(" [] "), ppr func ]
+ ptext SLIT(" \\"), ppr upd_flag, pprMaybeSRT srt, ptext SLIT(" [] "), ppr func ]
-- general case
-pprStgRhs (StgRhsClosure cc bi free_vars upd_flag args body)
+pprStgRhs (StgRhsClosure cc bi free_vars upd_flag srt args body)
= hang (hsep [if opt_SccProfilingOn then ppr cc else empty,
pp_binder_info bi,
ifPprDebug (brackets (interppSP free_vars)),
- char '\\' <> ppr upd_flag, brackets (interppSP args)])
+ char '\\' <> ppr upd_flag, pprMaybeSRT srt, brackets (interppSP args)])
4 (ppr body)
pprStgRhs (StgRhsCon cc con args)
space, ppr con, ptext SLIT("! "), brackets (interppSP args)]
pprMaybeSRT (NoSRT) = empty
-pprMaybeSRT srt = ptext SLIT("srt: ") <> pprSRT srt
+pprMaybeSRT srt = ptext SLIT("srt:") <> pprSRT srt
\end{code}
projects / ghc-hetmet.git / blobdiff