Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- class Semigroup node => PureSupernode node where
- superLabel :: node -> Label
- mapLabels :: (Label -> Label) -> node -> node
- class (MonadUnique m, PureSupernode node) => Supernode node m where
- freshen :: node -> m node
- collapseInductiveGraph :: (DynGraph gr, Supernode s m, VizCollapseMonad m gr s) => gr s () -> m (gr s ())
- class (MonadUniqSM m, Graph gr, Supernode s m) => VizCollapseMonad m gr s where
- consumeByInGraph :: Node -> Node -> gr s () -> m ()
- splitGraphAt :: gr s () -> LNode s -> m ()
- finalGraph :: gr s () -> m ()
- newtype NullCollapseViz a = NullCollapseViz {}
- runNullCollapse :: NullCollapseViz a -> UniqSM a
- class Monad m => MonadUniqSM m where
- liftUniqSM :: UniqSM a -> m a
Documentation
class Semigroup node => PureSupernode node where Source #
A "supernode" stands for a collection of one or more nodes (basic blocks) that have been coalesced by the Hecht-Ullman algorithm. A collection in a supernode constitutes a reducible subgraph of a control-flow graph. (When an entire control-flow graph is collapsed to a single supernode, the flow graph is reducible.)
The idea of node splitting is to collapse a control-flow graph down
to a single supernode, then materialize (`inflate'
) the reducible
equivalent graph from that supernode. The Supernode
class
defines only the methods needed to collapse; rematerialization is
the responsiblity of the client.
During the Hecht-Ullman algorithm, every supernode has a unique
entry point, which is given by superLabel
. But this invariant is
not guaranteed by the class methods and is not a law of the class.
The mapLabels
function rewrites all labels that appear in a
supernode (both definitions and uses). The freshen
function
replaces every appearance of a defined label with a fresh label.
(Appearances include both definitions and uses.)
Laws:
superLabel (n <> n') == superLabel n
blocks (n <> n') == blocks n
union
blocks n'
mapLabels f (n <> n') = mapLabels f n <> mapLabels f n'
mapLabels id == id
mapLabels (f . g) == mapLabels f . mapLabels g
(We expect freshen
to distribute over <>
, but because of
the fresh names involved, formulating a precise law is a bit
challenging.)
class (MonadUnique m, PureSupernode node) => Supernode node m where Source #
collapseInductiveGraph :: (DynGraph gr, Supernode s m, VizCollapseMonad m gr s) => gr s () -> m (gr s ()) Source #
Using the algorithm of Hecht and Ullman (1972), collapse a graph
into a single node, splitting nodes as needed. Record
visualization events in monad m
.
class (MonadUniqSM m, Graph gr, Supernode s m) => VizCollapseMonad m gr s where Source #
consumeByInGraph :: Node -> Node -> gr s () -> m () Source #
splitGraphAt :: gr s () -> LNode s -> m () Source #
finalGraph :: gr s () -> m () Source #
Instances
(Graph gr, Supernode s NullCollapseViz) => VizCollapseMonad NullCollapseViz gr s Source # | |
Defined in GHC.Data.Graph.Collapse consumeByInGraph :: Node -> Node -> gr s () -> NullCollapseViz () Source # splitGraphAt :: gr s () -> LNode s -> NullCollapseViz () Source # finalGraph :: gr s () -> NullCollapseViz () Source # |
newtype NullCollapseViz a Source #
The identity monad as a VizCollapseMonad
. Use this monad when
you want efficiency in graph collapse.
Instances
runNullCollapse :: NullCollapseViz a -> UniqSM a Source #
class Monad m => MonadUniqSM m where Source #
Module : GHC.Data.Graph.Collapse Description : Implement the "collapsing" algorithm Hecht and Ullman
A control-flow graph is reducible if and only if it is collapsible according to the definition of Hecht and Ullman (1972). This module implements the collapsing algorithm of Hecht and Ullman, and if it encounters a graph that is not collapsible, it splits nodes until the graph is fully collapsed. It then reports what nodes (if any) had to be split in order to collapse the graph. The information is used upstream to node-split Cmm graphs.
The module uses the inductive graph representation cloned from the
Functional Graph Library (Hackage package fgl
, modules
*
.)
If you want to visualize the graph-collapsing algorithm, create
an instance of monad VizCollapseMonad
. Each step in the
algorithm is announced to the monad as a side effect. If you don't
care about visualization, you would use the NullCollapseViz
monad, in which these operations are no-ops.
liftUniqSM :: UniqSM a -> m a Source #
Instances
MonadUniqSM NullCollapseViz Source # | |
Defined in GHC.Data.Graph.Collapse liftUniqSM :: UniqSM a -> NullCollapseViz a Source # |