Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- type CAFSet = Set CAFfyLabel
- type CAFEnv = LabelMap CAFSet
- cafAnal :: Platform -> LabelSet -> CLabel -> CmmGraph -> CAFEnv
- cafAnalData :: Platform -> CmmStatics -> CAFSet
- doSRTs :: CmmConfig -> ModuleSRTInfo -> [(CAFEnv, [CmmDecl])] -> [(CAFSet, CmmDataDecl)] -> IO (ModuleSRTInfo, [CmmDeclSRTs])
- data ModuleSRTInfo = ModuleSRTInfo {
- thisModule :: Module
- dedupSRTs :: Map (Set SRTEntry) SRTEntry
- flatSRTs :: Map SRTEntry (Set SRTEntry)
- moduleSRTMap :: SRTMap
- emptySRT :: Module -> ModuleSRTInfo
- type SRTMap = Map CAFfyLabel (Maybe SRTEntry)
- srtMapNonCAFs :: SRTMap -> NonCaffySet
Documentation
:: Platform | |
-> LabelSet | The blocks representing continuations, ie. those that will get RET info tables. These labels will get their own SRTs, so we don't aggregate CAFs from references to these labels, we just use the label. |
-> CLabel | The top label of the proc |
-> CmmGraph | |
-> CAFEnv |
For each code block:
- collect the references reachable from this code block to FUN,
THUNK or RET labels for which hasCAF == True
This gives us a CAFEnv
: a mapping from code block to sets of labels
cafAnalData :: Platform -> CmmStatics -> CAFSet Source #
Collect possible CAFfy references from a CmmData
decl.
:: CmmConfig | |
-> ModuleSRTInfo | |
-> [(CAFEnv, [CmmDecl])] | |
-> [(CAFSet, CmmDataDecl)] | static data decls and their |
-> IO (ModuleSRTInfo, [CmmDeclSRTs]) |
Attach SRTs to all info tables in the CmmDecl
s, and add SRT
declarations to the ModuleSRTInfo
.
data ModuleSRTInfo Source #
ModuleSRTInfo | |
|
Instances
OutputableP env CLabel => OutputableP env ModuleSRTInfo Source # | |
Defined in GHC.Cmm.Info.Build pdoc :: env -> ModuleSRTInfo -> SDoc Source # |
emptySRT :: Module -> ModuleSRTInfo Source #
type SRTMap = Map CAFfyLabel (Maybe SRTEntry) Source #
Maps labels from cafAnal
to the final CLabel that will appear
in the SRT.
- closures with singleton SRTs resolve to their single entry
- closures with larger SRTs map to the label for that SRT
- CAFs must not map to anything!
- if a labels maps to Nothing, we found that this label's SRT
is empty, so we don't need to refer to it from other SRTs.
srtMapNonCAFs :: SRTMap -> NonCaffySet Source #
Given SRTMap
of a module, returns the set of non-CAFFY names in the
module. Any Name
s not in the set are CAFFY.