vacuum-1.0.0.2: Extract graph representations of ghc heap values.

GHC.Vacuum

Description

 ghci> toAdjList $ vacuum (fix (0:))
 [(0,[1,0]),(1,[])]

 ghci> ppHs $ vacuum (fix (0:))
 fromList
   [(0,
     HNode{nodePtrs = [1, 0], nodeLits = [40425920],
           nodeInfo =
             ConInfo{itabPkg = "ghc-prim", itabMod = "GHC.Types", itabCon = ":",
                     itabPtrs = 2, itabLits = 0, itabType = CONSTR_2_0, itabSrtLen = 1,
                     itabCode =
                       [72, 131, 195, 2, 255, 101, 0, 144, 224, 30, 0, 0, 0, 0, 0, 0]}}),
    (1,
     HNode{nodePtrs = [], nodeLits = [0, 40425920],
           nodeInfo =
             ConInfo{itabPkg = "integer", itabMod = "GHC.Integer.Internals",
                     itabCon = "S#", itabPtrs = 0, itabLits = 1, itabType = CONSTR_0_1,
                     itabSrtLen = 0,
                     itabCode =
                       [72, 255, 195, 255, 101, 0, 102, 144, 152, 0, 0, 0, 0, 0, 0, 0]}})]

 ghci> ppDot . nameGraph $ vacuum (fix (0:))
 digraph g {
   graph [rankdir=LR, splines=true];
   node [label="\N", shape=none, fontcolor=blue, fontname=courier];
   edge [color=black, style=dotted, fontname=courier, arrowname=onormal];
       ":|0" -> {"S#|1";":|0"}
       "S#|1" -> {}
 }

 ghci> let a = [0..]
 ghci> toAdjList $ vacuumLazy a
 [(0,[])]
 ghci> take 2 a
 [0,1]
 ghci> toAdjList $ vacuumLazy a
 [(0,[1,2]),(1,[]),(2,[3,4]),(3,[]),(4,[])]
 ghci> take 3 a
 [0,1,2]
 ghci> toAdjList $ vacuumLazy a
 [(0,[1,2]),(1,[]),(2,[3,4]),(3,[]),(4,[5,6]),(5,[]),(6,[])]

Synopsis

Documentation

data HNode Source

Constructors

HNode 

Fields

nodePtrs :: [HNodeId]
 
nodeLits :: [Word]
 
nodeInfo :: InfoTab
 

vacuum :: a -> IntMap HNodeSource

Vacuums the entire reachable heap subgraph rooted at the a.

vacuumTo :: Int -> a -> IntMap HNodeSource

Stop after a given depth.

vacuumLazy :: a -> IntMap HNodeSource

Doesn't force anything.

vacuumStream :: a -> [(HNodeId, HNode)]Source

Returns nodes as it encounters them.

data ShowHNode Source

Constructors

ShowHNode 

Fields

showHNode :: Int -> HNode -> String
 
externHNode :: Int -> String
 

data Draw e v m a Source

To assist in "rendering" the graph to some source.

Constructors

Draw 

Fields

mkV :: Int -> a -> m v
 
mkE :: v -> v -> m e
 
succs :: a -> [Int]
 

newtype G e v Source

Constructors

G 

Fields

unG :: IntMap (v, IntMap e)
 

Instances

(Eq e, Eq v) => Eq (G e v) 
(Ord e, Ord v) => Ord (G e v) 
(Read e, Read v) => Read (G e v) 
(Show e, Show v) => Show (G e v) 

draw :: Monad m => Draw e v m a -> IntMap a -> m (G e v)Source

printDraw :: Draw (Int, Int) Int IO HNodeSource

An example Draw

split :: (a -> [Int]) -> IntMap a -> IntMap ([Int], [Int])Source

Build a map to (preds,succs)

data Closure Source

Constructors

Closure 

Fields

closPtrs :: [HValue]
 
closLits :: [Word]
 
closITab :: InfoTab
 

Instances

getClosure :: a -> IO ClosureSource

This is in part borrowed from RtClosureInspect.getClosureData.