- data Graph m l = Graph {}
- data LGraph m l = LGraph {}
- data FGraph m l = FGraph {}
- data Block m l = Block {}
- data ZBlock m l = ZBlock (ZHead m) (ZTail m l)
- data ZHead m
- data ZTail m l
- data ZLast l
- insertBlock :: Block m l -> BlockEnv (Block m l) -> BlockEnv (Block m l)
- class HavingSuccessors b where
- succs :: b -> [BlockId]
- fold_succs :: (BlockId -> a -> a) -> b -> a -> a
- class HavingSuccessors l => LastNode l where
- mkBranchNode :: BlockId -> l
- isBranchNode :: l -> Bool
- branchNodeTarget :: l -> BlockId
- blockId :: Block m l -> BlockId
- zip :: ZBlock m l -> Block m l
- unzip :: Block m l -> ZBlock m l
- last :: ZBlock m l -> ZLast l
- goto_end :: ZBlock m l -> (ZHead m, ZLast l)
- zipht :: ZHead m -> ZTail m l -> Block m l
- tailOfLast :: l -> ZTail m l
- splice_tail :: Graph m l -> ZTail m l -> Graph m l
- splice_head :: ZHead m -> LGraph m l -> (LGraph m l, ZHead m)
- splice_head_only' :: ZHead m -> Graph m l -> LGraph m l
- splice_head' :: ZHead m -> Graph m l -> (BlockEnv (Block m l), ZHead m)
- of_block_list :: BlockId -> [Block m l] -> LGraph m l
- to_block_list :: LGraph m l -> [Block m l]
- graphOfLGraph :: LastNode l => LGraph m l -> Graph m l
- map_blocks :: (Block m l -> Block m' l') -> LGraph m l -> LGraph m' l'
- map_one_block :: (BlockId -> BlockId) -> (m -> m') -> (l -> l') -> Block m l -> Block m' l'
- map_nodes :: (BlockId -> BlockId) -> (m -> m') -> (l -> l') -> LGraph m l -> LGraph m' l'
- mapM_blocks :: Monad mm => (Block m l -> mm (Block m' l')) -> LGraph m l -> mm (LGraph m' l')
- postorder_dfs :: LastNode l => LGraph m l -> [Block m l]
- postorder_dfs_from :: (HavingSuccessors b, LastNode l) => BlockEnv (Block m l) -> b -> [Block m l]
- postorder_dfs_from_except :: forall m b l. (HavingSuccessors b, LastNode l) => BlockEnv (Block m l) -> b -> BlockSet -> [Block m l]
- fold_layout :: LastNode l => (Block m l -> Maybe BlockId -> a -> a) -> a -> LGraph m l -> a
- fold_blocks :: (Block m l -> a -> a) -> a -> LGraph m l -> a
- fold_fwd_block :: (BlockId -> a -> a) -> (m -> a -> a) -> (ZLast l -> a -> a) -> Block m l -> a -> a
- translate :: Monad tm => (m -> tm (LGraph m' l')) -> (l -> tm (LGraph m' l')) -> LGraph m l -> tm (LGraph m' l')
- pprLgraph :: (Outputable m, Outputable l, LastNode l) => LGraph m l -> SDoc
- pprGraph :: (Outputable m, Outputable l, LastNode l) => Graph m l -> SDoc
- entry :: LGraph m l -> FGraph m l
Documentation
(Outputable m, Outputable l, LastNode l) => Outputable (Graph m l) |
(Outputable m, Outputable l, LastNode l) => Outputable (LGraph m l) |
Blocks and flow graphs; see Note [Kinds of graphs]
(Outputable m, Outputable l, LastNode l) => Outputable (Block m l) | |
LastNode l => HavingSuccessors (Block m l) |
And now the zipper. The focus is between the head and tail. We cannot ever focus on an inter-block edge.
LastNode l => HavingSuccessors (ZBlock m l) |
(Outputable m, Outputable l) => Outputable (ZTail m l) | |
LastNode l => HavingSuccessors (ZTail m l) |
A basic block is a first
node, followed by zero or more middle
nodes, followed by a last
node.
Outputable l => Outputable (ZLast l) | |
DefinerOfSlots l => DefinerOfSlots (ZLast l) | |
UserOfSlots l => UserOfSlots (ZLast l) | |
UserOfLocalRegs a => UserOfLocalRegs (ZLast a) | |
LastNode l => LastNode (ZLast l) | |
HavingSuccessors l => HavingSuccessors (ZLast l) |
insertBlock :: Block m l -> BlockEnv (Block m l) -> BlockEnv (Block m l)Source
insertBlock
should not be used to replace an existing block
but only to insert a new one
class HavingSuccessors b whereSource
We can't make a graph out of just any old 'last node' type. A last node
has to be able to find its successors, and we need to be able to create and
identify unconditional branches. We put these capabilities in a type class.
Moreover, the property of having successors is also shared by Block
s and
ZTails
, so it is useful to have that property in a type class of its own.
HavingSuccessors Last | |
HavingSuccessors l => HavingSuccessors (ZLast l) | |
LastNode l => HavingSuccessors (ZBlock m l) | |
LastNode l => HavingSuccessors (Block m l) | |
LastNode l => HavingSuccessors (ZTail m l) |
class HavingSuccessors l => LastNode l whereSource
mkBranchNode :: BlockId -> lSource
isBranchNode :: l -> BoolSource
:: l | |
-> BlockId | N.B. This interface seems to make for more congenial clients than a single function of type 'l -> Maybe BlockId' |
zipht :: ZHead m -> ZTail m l -> Block m lSource
Take a head and tail and go to beginning or end. The asymmetry in the types and names is a bit unfortunate, but 'Block m l' is effectively '(BlockId, ZTail m l)' and is accepted in many more places.
tailOfLast :: l -> ZTail m lSource
splice_tail :: Graph m l -> ZTail m l -> Graph m lSource
splice_head :: ZHead m -> LGraph m l -> (LGraph m l, ZHead m)Source
We can splice a single-entry, single-exit LGraph onto a head or a tail.
For a head, we have a head h
followed by a LGraph g
.
The entry node of g
gets joined to h
, forming the entry into
the new LGraph. The exit of g
becomes the new head.
For both arguments and results, the order of values is the order of
control flow: before splicing, the head flows into the LGraph; after
splicing, the LGraph flows into the head.
Splicing a tail is the dual operation.
(In order to maintain the order-means-control-flow convention, the
orders are reversed.)
For example, assume head = [L: x:=0] grph = (M, [M: stuff, blocks, N: y:=x; LastExit]) tail = [return (y,x)]
Then splice_head head grph = ((L, [L: x:=0; goto M, M: stuff, blocks]) , N: y:=x)
Then splice_tail grph tail = ( stuff , (???, [blocks, N: y:=x; return (y,x)])
splice_head_only' :: ZHead m -> Graph m l -> LGraph m lSource
of_block_list :: BlockId -> [Block m l] -> LGraph m lSource
A safe operation
Conversion to and from the environment form is convenient. For
layout or dataflow, however, one will want to use postorder_dfs
in order to get the blocks in an order that relates to the control
flow in the procedure.
to_block_list :: LGraph m l -> [Block m l]Source
graphOfLGraph :: LastNode l => LGraph m l -> Graph m lSource
Conversion from LGraph to Graph
postorder_dfs :: LastNode l => LGraph m l -> [Block m l]Source
Traversal: postorder_dfs
returns a list of blocks reachable
from the entry node. This list has the following property:
Say a back reference exists if one of a block's control-flow successors precedes it in the output list
Then there are as few back references as possible
The output is suitable for use in
a forward dataflow problem. For a backward problem, simply reverse
the list. (postorder_dfs
is sufficiently tricky to implement that
one doesn't want to try and maintain both forward and backward
versions.)
postorder_dfs_from :: (HavingSuccessors b, LastNode l) => BlockEnv (Block m l) -> b -> [Block m l]Source
postorder_dfs_from_except :: forall m b l. (HavingSuccessors b, LastNode l) => BlockEnv (Block m l) -> b -> BlockSet -> [Block m l]Source
This is the most important traversal over this data structure. It drops unreachable code and puts blocks in an order that is good for solving forward dataflow problems quickly. The reverse order is good for solving backward dataflow problems quickly. The forward order is also reasonably good for emitting instructions, except that it will not usually exploit Forrest Baskett's trick of eliminating the unconditional branch from a loop. For that you would need a more serious analysis, probably based on dominators, to identify loop headers.
The ubiquity of postorder_dfs
is one reason for the ubiquity of the LGraph
representation, when for most purposes the plain Graph
representation is
more mathematically elegant (but results in more complicated code).
Here's an easy way to go wrong! Consider
A -> [B,C]
B -> D
C -> D
Then ordinary dfs would give [A,B,D,C] which has a back ref from C to D.
Better to get [A,B,C,D]
fold_layout :: LastNode l => (Block m l -> Maybe BlockId -> a -> a) -> a -> LGraph m l -> aSource
For layout, we fold over pairs of 'Block m l' and 'Maybe BlockId'
in layout order. The 'Maybe BlockId', if present, identifies the
block that will be the layout successor of the current block. This
may be useful to help an emitter omit the final goto
of a block
that flows directly to its layout successor.
For example: fold_layout f z [ L1:B1, L2:B2, L3:B3 ] = z $ f (L1:B1) (Just L2) $ f (L2:B2) (Just L3) $ f (L3:B3) Nothing where a $ f = f a
fold_blocks :: (Block m l -> a -> a) -> a -> LGraph m l -> aSource
We can also fold over blocks in an unspecified order. The
ZipCfgExtras
module provides a monadic version, which we
haven't needed (else it would be here).
fold_fwd_block :: (BlockId -> a -> a) -> (m -> a -> a) -> (ZLast l -> a -> a) -> Block m l -> a -> aSource
Fold from first to last
translate :: Monad tm => (m -> tm (LGraph m' l')) -> (l -> tm (LGraph m' l')) -> LGraph m l -> tm (LGraph m' l')Source
These translation functions are speculative. I hope eventually they will be used in the native-code back ends ---NR
pprLgraph :: (Outputable m, Outputable l, LastNode l) => LGraph m l -> SDocSource
pprGraph :: (Outputable m, Outputable l, LastNode l) => Graph m l -> SDocSource