Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- type CFG = EdgeInfoMap EdgeInfo
- data CfgEdge = CfgEdge {}
- data EdgeInfo = EdgeInfo {}
- newtype EdgeWeight = EdgeWeight Int
- data TransitionSource
- = CmmSource (CmmNode O C)
- | AsmCodeGen
- addWeightEdge :: BlockId -> BlockId -> EdgeWeight -> CFG -> CFG
- addEdge :: BlockId -> BlockId -> EdgeInfo -> CFG -> CFG
- delEdge :: BlockId -> BlockId -> CFG -> CFG
- addNodesBetween :: CFG -> [(BlockId, BlockId, BlockId)] -> CFG
- shortcutWeightMap :: LabelMap (Maybe BlockId) -> CFG -> CFG
- reverseEdges :: CFG -> CFG
- filterEdges :: (BlockId -> BlockId -> EdgeInfo -> Bool) -> CFG -> CFG
- addImmediateSuccessor :: HasDebugCallStack => BlockId -> BlockId -> CFG -> CFG
- mkWeightInfo :: Integral n => n -> EdgeInfo
- adjustEdgeWeight :: CFG -> (EdgeWeight -> EdgeWeight) -> BlockId -> BlockId -> CFG
- infoEdgeList :: CFG -> [CfgEdge]
- edgeList :: CFG -> [Edge]
- getSuccessorEdges :: HasDebugCallStack => CFG -> BlockId -> [(BlockId, EdgeInfo)]
- getSuccessors :: HasDebugCallStack => CFG -> BlockId -> [BlockId]
- getSuccEdgesSorted :: CFG -> BlockId -> [(BlockId, EdgeInfo)]
- weightedEdgeList :: CFG -> [(BlockId, BlockId, EdgeWeight)]
- getEdgeInfo :: BlockId -> BlockId -> CFG -> Maybe EdgeInfo
- getCfgNodes :: CFG -> LabelSet
- hasNode :: CFG -> BlockId -> Bool
- loopMembers :: HasDebugCallStack => CFG -> LabelMap Bool
- getCfg :: CfgWeights -> CmmGraph -> CFG
- getCfgProc :: CfgWeights -> RawCmmDecl -> CFG
- pprEdgeWeights :: CFG -> SDoc
- sanityCheckCfg :: CFG -> LabelSet -> SDoc -> Bool
- optimizeCFG :: HasDebugCallStack => CfgWeights -> RawCmmDecl -> CFG -> CFG
Documentation
type CFG = EdgeInfoMap EdgeInfo Source #
A control flow graph where edges have been annotated with a weight. Implemented as IntMap (IntMap edgeData) We must uphold the invariant that for each edge A -> B we must have: A entry B in the outer map. A entry B in the map we get when looking up A. Maintaining this invariant is useful as any failed lookup now indicates an actual error in code which might go unnoticed for a while otherwise.
Information about edges
newtype EdgeWeight Source #
Instances
data TransitionSource Source #
Can we trace back a edge to a specific Cmm Node or has it been introduced for codegen. We use this to maintain some information which would otherwise be lost during the Cmm - asm transition. See also Note [Inverting Conditional Branches]
Instances
Eq TransitionSource # | |
Defined in CFG (==) :: TransitionSource -> TransitionSource -> Bool # (/=) :: TransitionSource -> TransitionSource -> Bool # |
addWeightEdge :: BlockId -> BlockId -> EdgeWeight -> CFG -> CFG Source #
Adds a edge with the given weight to the cfg If there already existed an edge it is overwritten. `addWeightEdge from to weight cfg`
addEdge :: BlockId -> BlockId -> EdgeInfo -> CFG -> CFG Source #
Adds a new edge, overwrites existing edges if present
addNodesBetween :: CFG -> [(BlockId, BlockId, BlockId)] -> CFG Source #
Insert a block in the control flow between two other blocks. We pass a list of tuples (A,B,C) where * A -> C: Old edge * A -> B -> C : New Arc, where B is the new block. It's possible that a block has two jumps to the same block in the assembly code. However we still only store a single edge for these cases. We assign the old edge info to the edge A -> B and assign B -> C the weight of an unconditional jump.
reverseEdges :: CFG -> CFG Source #
filterEdges :: (BlockId -> BlockId -> EdgeInfo -> Bool) -> CFG -> CFG Source #
Filter the CFG with a custom function f. Paramaeters are `f from to edgeInfo`
addImmediateSuccessor :: HasDebugCallStack => BlockId -> BlockId -> CFG -> CFG Source #
Sometimes we insert a block which should unconditionally be executed after a given block. This function updates the CFG for these cases. So we get A -> B => A -> A' -> B -- -> C => -> C
mkWeightInfo :: Integral n => n -> EdgeInfo Source #
Convenience function, generate edge info based on weight not originating from cmm.
adjustEdgeWeight :: CFG -> (EdgeWeight -> EdgeWeight) -> BlockId -> BlockId -> CFG Source #
Adjust the weight between the blocks using the given function. If there is no such edge returns the original map.
infoEdgeList :: CFG -> [CfgEdge] Source #
Returns a unordered list of all edges with info
getSuccessorEdges :: HasDebugCallStack => CFG -> BlockId -> [(BlockId, EdgeInfo)] Source #
Get successors of a given node with edge weights.
getSuccessors :: HasDebugCallStack => CFG -> BlockId -> [BlockId] Source #
Get successors of a given node without edge weights.
getSuccEdgesSorted :: CFG -> BlockId -> [(BlockId, EdgeInfo)] Source #
Destinations from bid ordered by weight (descending)
weightedEdgeList :: CFG -> [(BlockId, BlockId, EdgeWeight)] Source #
Unordered list of edges with weight as Tuple (from,to,weight)
getCfgNodes :: CFG -> LabelSet Source #
loopMembers :: HasDebugCallStack => CFG -> LabelMap Bool Source #
Determine loop membership of blocks based on SCC analysis Ideally we would replace this with a variant giving us loop levels instead but the SCC code will do for now.
getCfgProc :: CfgWeights -> RawCmmDecl -> CFG Source #
Generate weights for a Cmm proc based on some simple heuristics.
pprEdgeWeights :: CFG -> SDoc Source #
sanityCheckCfg :: CFG -> LabelSet -> SDoc -> Bool Source #
Check if the nodes in the cfg and the set of blocks are the same. In a case of a missmatch we panic and show the difference.
optimizeCFG :: HasDebugCallStack => CfgWeights -> RawCmmDecl -> CFG -> CFG Source #