vacuum 0.0.6 → 0.0.7

raw patch · 3 files changed

+57/−4 lines, 3 filesdep ~ghc

Dependency ranges changed: ghc

Files

• src/GHC/Vacuum.hs +54/−0
• src/GHC/Vacuum/GHC/Internal.hs +1/−2
• vacuum.cabal +2/−2

@@ -43,11 +43,14 @@   ,ShowHNode(..)   ,showHNodes   ,ppHs,ppDot+  ,Draw(..),G(..)+  ,draw,printDraw,split   ,Closure(..)   ,InfoTab(..)   ,getClosure   ,nodePkg,nodeMod   ,nodeName,itabName+  ,getInfoPtr ) where import GHC.Vacuum.Dot as Dot import GHC.Vacuum.ClosureType@@ -86,6 +89,10 @@ dumpTo :: Int -> a -> IO (IntMap HNode) dumpTo n a = execH (dumpToH n a) ++++ -----------------------------------------------------------------------------  toAdjList :: IntMap HNode -> [(Int, [Int])]@@ -153,6 +160,45 @@  ------------------------------------------------ +-- | To assist in \"rendering\"+--  the graph to some source.+data Draw e v m a = Draw+  {mkV   :: Int -> a -> m v+  ,mkE   :: v -> v -> m e+  ,succs :: a -> [Int]}++newtype G e v = G {unG :: IntMap (v, IntMap e)}+  deriving(Eq,Ord,Read,Show)++draw :: (Monad m) => Draw e v m a -> IntMap a -> m (G e v)+draw (Draw mkV mkE succs) g = do+  vs <- IM.fromList `liftM` forM (IM.toList g)+          (\(i,a) -> do v <- mkV i a+                        return (i,(v,succs a)))+  (G . IM.fromList) `liftM` forM (IM.toList vs)+    (\(i,(v,ps)) -> do let us = fmap (vs IM.!) ps+                       es <- IM.fromList `liftM` forM ps+                               (\p -> do e <- mkE v (fst (vs IM.! p))+                                         return (p,e))+                       return (i,(v,es)))++-- | An example @Draw@+printDraw :: Draw (Int,Int) Int IO HNode+printDraw = Draw+  {mkV   = \i _ -> print i >> return i+  ,mkE   = \u v -> print (u,v) >> return (u,v)+  ,succs = nodePtrs}++-- | Build a map to @(preds,succs)@+split :: (a -> [Int]) -> IntMap a -> IntMap ([Int],[Int])+split f = flip IM.foldWithKey mempty (\i a m ->+            let ps = f a+            in foldl' (\m p -> IM.insertWith mappend p ([i],[]) m)+                      (IM.insertWith mappend i ([],ps) m)+                      ps)++------------------------------------------------+ emptyHNode :: ClosureType -> HNode emptyHNode ct = HNode   {nodePtrs   = []@@ -177,6 +223,14 @@ itabName  _            = ([], [], [])  ------------------------------------------------++getInfoPtr :: a -> Ptr StgInfoTable+getInfoPtr a = let b = a `seq` Box a+                in b `seq` case unpackClosure# a of+                            (# iptr,_,_ #)+                              | ghciTablesNextToCode -> Ptr iptr+                              | otherwise -> Ptr iptr `plusPtr`+                                              negate wORD_SIZE  -- | This is in part borrowed from @RtClosureInspect.getClosureData@. getClosure :: a -> IO Closure

@@ -73,7 +73,7 @@         ,Opt_RankNTypes         ,Opt_KindSignatures         ,Opt_UnicodeSyntax-          -- um, i assume this turn it _off_ (?)+          -- um, i assume this turns it _off_ (?)         ,Opt_MonomorphismRestriction         ,Opt_PatternGuards         ,Opt_ParallelListComp@@ -137,7 +137,6 @@               return env')           (maybe defaultDynFlags id dflagsM) --- | Escape this hideous Ghc monad :-) myRunGhc :: HscEnv -> Ghc a -> IO a myRunGhc hsc_env ghc = do   wref <- newIORef emptyBag

@@ -1,5 +1,5 @@ name:               vacuum-version:            0.0.6+version:            0.0.7 cabal-version:      >= 1.6 build-type:         Simple license:            LGPL@@ -18,7 +18,7 @@   ghc-options:      -O2 -fglasgow-exts   extensions:   build-depends:    base==4.*,-                    ghc==6.10.1, ghc-prim,+                    ghc >= 6.10.1 && <= 6.10.2, ghc-prim,                     array, containers, array,                     pretty, haskell-src-meta,                     Cabal >= 1.6 && < 1.7, ghc-paths