ghc-heap-view 0.3.0.4 → 0.4.0.0

raw patch · 4 files changed

+417/−60 lines, 4 filesdep +containersdep +transformerssetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, transformers

API changes (from Hackage documentation)

Files

• Setup.hs +14/−2
• ghc-heap-view.cabal +32/−1
• ghci +5/−0
• src/GHC/HeapView.hs +366/−57

@@ -3,8 +3,20 @@ import Distribution.Simple.LocalBuildInfo import Distribution.PackageDescription (PackageDescription) -main = defaultMainWithHooks $-       simpleUserHooks { postConf = postConfHook (postConf simpleUserHooks) }+import System.FilePath++main = defaultMainWithHooks $ simpleUserHooks+      { postInst = postInstHook (postInst simpleUserHooks)+      , postConf = postConfHook (postConf simpleUserHooks)+      }++postInstHook oldHook args iflags pDesc lbi = do+  let instDataDir = datadir $ absoluteInstallDirs pDesc lbi (fromFlag $ copyDest defaultCopyFlags)+  putStrLn "To enable the GHCi integration, you have to load a ghci file in GHCi. To do this automatically when GHCi is started run:"+  putStrLn $ "echo \":script " ++ (instDataDir </> "ghci") ++ "\" >> ~/.ghci"++  oldHook args iflags pDesc lbi+  postConfHook oldHook args flags descr buildInfo = case profFlag of   Flag True -> error "This library cannot be built using profiling. Try invoking cabal with the --disable-library-profiling flag."

@@ -1,5 +1,5 @@ Name:                ghc-heap-view-Version:             0.3.0.4+Version:             0.4.0.0 Synopsis:            Extract the heap representation of Haskell values and thunks Description:   This library provides functions to introspect the Haskell heap, for example@@ -8,6 +8,34 @@   It has been inspired by (and taken code from) the vacuum package and the GHCi   debugger, but also allows to investiage thunks and other closures.    .+  This package also provides a new GHCi-command, @:printHeap@, which allows you+  to inspect the current heap representation of a value, including sharing and+  cyclic references. To enable the command, you need to load the included ghci+  script or add it to @~/.ghci@, as explained by @cabal install@. Once it is+  set up, you can do this:+  .+  >> let value = "A Value"+  >> let x = (value, if head value == 'A' then value else "", cycle [True, False])+  >> :printHeap x+  >let x1 = _bco+  >    x21 = []+  >in (x1,_bco,_bco)+  >> length (take 100 (show x)) `seq` return () -- evaluate everything+  >> :printHeap x+  >let x1 = "A Value"+  >    x16 = True : False : x16+  >in (x1,x1,x16)+  .+  You can change the maximum recursion depth using @:setPrintHeapDepth@:+  .+  >> :setPrintHeapDepth 3+  >> :printHeap x+  >let x1 = C# 'A' : ... : ...+  >in (x1,x1,True : ... : ...)+  .+  If the view is impaired by blackholes (written @_bh@), running+  @System.Mem.performGC@ usually helps.+  .   The work on this package has been supported by the Deutsche Telekom Stiftung   (<http://telekom-stiftung.de>). License:             BSD3@@ -19,6 +47,7 @@ Build-type:          Custom Cabal-version:       >=1.14 Extra-source-files:  Demo.hs+data-files:          ghci  Flag prim-supports-any     Description: The used GHC supports Any as an argument to foreign prim functions (GHC ticket #5931)@@ -29,6 +58,8 @@   Default-Language:    Haskell2010   Build-depends:     base >= 4.5 && < 4.7,+    containers,+    transformers,     ghc   C-Sources: cbits/HeapView.c cbits/HeapViewPrim.cmm   Hs-source-dirs: src/

@@ -0,0 +1,5 @@+let _ghcHeapViewDepth = 1000 :: Int++:def setPrintHeapDepth \x -> return $ "let _ghcHeapViewDepth = " ++ x ++ ":: Int"++:def printHeap \x -> return $ "GHC.HeapView.buildHeapGraph _ghcHeapViewDepth (GHC.HeapView.asBox (" ++ x ++ ")) >>= putStrLn . GHC.HeapView.ppHeapGraph"

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash, UnboxedTuples, CPP, ForeignFunctionInterface, GHCForeignImportPrim, UnliftedFFITypes, BangPatterns, RecordWildCards, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} {-| Module      :  GHC.HeapView Copyright   :  (c) 2012 Joachim Breitner@@ -9,11 +9,11 @@ values, i.e. to investigate sharing and lazy evaluation. -} -{-# LANGUAGE MagicHash, UnboxedTuples, CPP, ForeignFunctionInterface, GHCForeignImportPrim, UnliftedFFITypes, BangPatterns, RecordWildCards #-}  module GHC.HeapView (     -- * Heap data types-    Closure(..),+    GenClosure(..),+    Closure,     allPtrs,     ClosureType(..),     StgInfoTable(..),@@ -22,21 +22,61 @@     getClosureData,     getBoxedClosureData,     getClosureRaw,+    -- * Pretty printing+    ppPrintClosure,+    -- * Heap maps+    -- $heapmap+    HeapTree(..),+    buildHeapTree,+    ppHeapTree,+    HeapGraphEntry(..),+    HeapGraphIndex,+    HeapGraph(..),+    lookupHeapGraph,+    heapGraphRoot,+    buildHeapGraph,+    ppHeapGraph,     -- * Boxes     Box(..),     asBox,+    -- * Weak boxes+    WeakBox,+    weakBox,+    isAlive,+    derefWeakBox,+    WeakClosure,+    weakenClosure,     )     where -import GHC.Exts-import GHC.Arr (Array(..))+import GHC.Exts         ( Any,+                          Ptr(..), Addr#, Int(..), Word(..), Word#, Int#,+                          ByteArray#, Array#, sizeofByteArray#, sizeofArray#, indexArray#, indexWordArray#,+                          unsafeCoerce# ) -import GHC.Constants ( wORD_SIZE, tAG_MASK, wORD_SIZE_IN_BITS )+import GHC.Arr          (Array(..)) -import Foreign+import GHC.Constants    ( wORD_SIZE, tAG_MASK, wORD_SIZE_IN_BITS )++import System.IO.Unsafe ( unsafePerformIO )++import Foreign          hiding ( unsafePerformIO ) import Numeric          ( showHex ) import Data.Char-import Data.List        ( intersperse )+import Data.List+import Data.Maybe       ( isJust, fromJust, catMaybes )+import System.Mem.Weak+import Data.Functor+import Data.Foldable    ( Foldable )+import Data.Traversable ( Traversable )+import qualified Data.Traversable as T+import qualified Data.IntMap as M+import Control.Monad+import Control.Monad.Trans.State+import Control.Monad.Trans.Class+import Control.Monad.IO.Class+import Control.Monad.Trans.Writer.Strict+import Control.Arrow    ( first, second )  #include "ghcautoconf.h" @@ -121,7 +161,7 @@       = error "Storable StgInfoTable is read-only"     peek a0-      = runState (castPtr a0)+      = flip (evalStateT) (castPtr a0)       $ do            ptrs'   <- load            nptrs'  <- load@@ -142,35 +182,18 @@ load = do addr <- advance           lift (peek addr) -type PtrIO = State (Ptr Word8) IO+type PtrIO = StateT (Ptr Word8) IO  advance :: Storable a => PtrIO (Ptr a)-advance = State adv where+advance = StateT adv where     adv addr = case castPtr addr of { addrCast -> return-        (addr `plusPtr` sizeOfPointee addrCast, addrCast) }+        (addrCast, addr `plusPtr` sizeOfPointee addrCast) }  sizeOfPointee :: (Storable a) => Ptr a -> Int sizeOfPointee addr = sizeOf (typeHack addr)     where typeHack = undefined :: Ptr a -> a  {--   Embedded StateT, also from ByteCodeItbls- -}--newtype State s m a = State (s -> m (s, a))--instance Monad m => Monad (State s m) where-  return a      = State (\s -> return (s, a))-  State m >>= k = State (\s -> m s >>= \(s', a) -> case k a of State n -> n s')-  fail str      = State (\_ -> fail str)--lift :: Monad m => m a -> State s m a-lift m = State (\s -> m >>= \a -> return (s, a))--runState :: (Monad m) => s -> State s m a -> m a-runState s (State m) = m s >>= return . snd--{-    Data Type representing Closures  -} @@ -246,11 +269,15 @@ {-| This is the main data type of this module, representing a Haskell value on   the heap. This reflects   <http://hackage.haskell.org/trac/ghc/browser/includes/rts/storage/Closures.h>++  The data type is parametrized by the type to store references in, which+  should be either 'Box' or 'WeakBox', with appropriate type synonyms 'Closure'+  and 'WeakClosure'.  -}-data Closure =+data GenClosure b =     ConsClosure {         info         :: StgInfoTable -        , ptrArgs    :: [Box]+        , ptrArgs    :: [b]         , dataArgs   :: [Word]         , pkg        :: String         , modl       :: String@@ -258,45 +285,45 @@     } |     ThunkClosure {         info         :: StgInfoTable -        , ptrArgs    :: [Box]+        , ptrArgs    :: [b]         , dataArgs   :: [Word]     } |     SelectorClosure {         info         :: StgInfoTable -        , selectee   :: Box+        , selectee   :: b     } |     IndClosure {         info         :: StgInfoTable -        , indirectee   :: Box+        , indirectee   :: b     } |     BlackholeClosure {         info         :: StgInfoTable -        , indirectee   :: Box+        , indirectee   :: b     } |     APClosure {         info         :: StgInfoTable          , arity      :: HalfWord         , n_args     :: HalfWord-        , fun        :: Box-        , payload    :: [Box]+        , fun        :: b+        , payload    :: [b]     } |     PAPClosure {         info         :: StgInfoTable          , arity      :: HalfWord         , n_args     :: HalfWord-        , fun        :: Box-        , payload    :: [Box]+        , fun        :: b+        , payload    :: [b]     } |     APStackClosure {         info         :: StgInfoTable -        , fun        :: Box-        , payload    :: [Box]+        , fun        :: b+        , payload    :: [b]     } |     BCOClosure {         info         :: StgInfoTable -        , instrs     :: Box-        , literals   :: Box-        , bcoptrs    :: Box+        , instrs     :: b+        , literals   :: b+        , bcoptrs    :: b         , arity      :: HalfWord         , size       :: HalfWord         , bitmap     :: Word@@ -310,43 +337,46 @@         info         :: StgInfoTable          , mccPtrs    :: Word         , mccSize    :: Word-        , mccPayload :: [Box]+        , mccPayload :: [b]         -- Card table ignored     } |     MutVarClosure {         info         :: StgInfoTable -        , var        :: Box+        , var        :: b     } |     MVarClosure {         info         :: StgInfoTable -        , queueHead  :: Box-        , queueTail  :: Box-        , value      :: Box+        , queueHead  :: b+        , queueTail  :: b+        , value      :: b     } |     FunClosure {         info         :: StgInfoTable -        , ptrArgs    :: [Box]+        , ptrArgs    :: [b]         , dataArgs   :: [Word]     } |     BlockingQueueClosure {         info         :: StgInfoTable -        , link       :: Box-        , blackHole  :: Box-        , owner      :: Box-        , queue      :: Box+        , link       :: b+        , blackHole  :: b+        , owner      :: b+        , queue      :: b     } |     OtherClosure {         info         :: StgInfoTable -        , hvalues    :: [Box]+        , hvalues    :: [b]         , rawWords   :: [Word]     } |     UnsupportedClosure {         info         :: StgInfoTable      }- deriving (Show)+ deriving (Show, Functor, Foldable, Traversable) ++type Closure = GenClosure Box+ -- | For generic code, this function returns all referenced closures. -allPtrs :: Closure -> [Box]+allPtrs :: GenClosure b -> [b] allPtrs (ConsClosure {..}) = ptrArgs allPtrs (ThunkClosure {..}) = ptrArgs allPtrs (SelectorClosure {..}) = [selectee]@@ -565,3 +595,282 @@ getBoxedClosureData :: Box -> IO Closure getBoxedClosureData (Box a) = getClosureData a ++isChar :: GenClosure b -> Maybe Char+isChar (ConsClosure { name = "C#", dataArgs = [ch], ptrArgs = []}) = Just (chr (fromIntegral ch))+isChar _ = Nothing++isCons :: GenClosure b -> Maybe (b, b)+isCons (ConsClosure { name = ":", dataArgs = [], ptrArgs = [h,t]}) = Just (h,t)+isCons _ = Nothing++isTup :: GenClosure b -> Maybe [b]+isTup (ConsClosure { dataArgs = [], ..}) =+    if length name >= 3 &&+       head name == '(' && last name == ')' &&+       all (==',') (tail (init name))+    then Just ptrArgs else Nothing+isTup _ = Nothing+++isNil :: GenClosure b -> Bool+isNil (ConsClosure { name = "[]", dataArgs = [], ptrArgs = []}) = True+isNil _ = False++-- | A pretty-printer that tries to generate valid Haskell for evalutated data.+-- It assumes that for the included boxes, you already replaced them by Strings+-- using 'Data.Foldable.map' or, if you need to do IO, 'Data.Foldable.mapM'.+--+-- The parameter gives the precedendence, to avoid avoidable parenthesises.+ppPrintClosure :: (Int -> b -> String) -> Int -> GenClosure b -> String+ppPrintClosure showBox prec c = case c of+    _ | Just ch <- isChar c -> app $+        ["C#", show ch]+    _ | Just (h,t) <- isCons c -> addBraces (5 <= prec) $+        showBox 5 h ++ " : " ++ showBox 4 t+    _ | Just vs <- isTup c ->+        "(" ++ intercalate "," (map (showBox 0) vs) ++ ")"+    ConsClosure {..} -> app $+        name : map (showBox 10) ptrArgs ++ map show dataArgs+    ThunkClosure {..} -> app $+        "_thunk" : map (showBox 10) ptrArgs ++ map show dataArgs+    SelectorClosure {..} -> app+        ["_sel", showBox 10 selectee]+    IndClosure {..} -> app+        ["_ind", showBox 10 indirectee]+    BlackholeClosure {..} -> app+        ["_bh",  showBox 10 indirectee]+    APClosure {..} -> app $ map (showBox 10) $+        fun : payload+    PAPClosure {..} -> app $ map (showBox 10) $+        fun : payload+    APStackClosure {..} -> app $ map (showBox 10) $+        fun : payload+    BCOClosure {..} -> app+        ["_bco"]+    ArrWordsClosure {..} -> app+        ["toArray", intercalate "," (map show arrWords) ]+    MutArrClosure {..} -> app+        ["toMutArray", intercalate "," (map (showBox 10) mccPayload)]+    MutVarClosure {..} -> app $+        ["_mutVar", (showBox 10) var]+    MVarClosure {..} -> app $+        ["MVar", (showBox 10) value]+    FunClosure {..} -> +        "_fun" ++ braceize (map (showBox 0) ptrArgs ++ map show dataArgs)+    BlockingQueueClosure {..} -> +        "_blockingQueue"+    OtherClosure {..} ->+        "_other"+    UnsupportedClosure {..} ->+        "_unsupported"+  where+    addBraces True t = "(" ++ t ++ ")"+    addBraces False t = t+    app [] = "()"+    app [a] = a +    app xs = addBraces (10 <= prec) (intercalate " " xs)+    braceize [] = ""+    braceize xs = "{" ++ intercalate "," xs ++ "}"+    +-- $heapmap+-- For more global views of the heap, you can use heap maps. These come in+-- variations, either a trees or as graphs, depending on+-- whether you want to detect cycles and sharing or not.++-- | Heap maps as tree, i.e. no sharing, no cycles.+data HeapTree = HeapTree WeakBox (GenClosure HeapTree) | EndOfHeapTree++heapTreeClosure :: HeapTree -> Maybe (GenClosure HeapTree)+heapTreeClosure (HeapTree _ c) = Just c+heapTreeClosure EndOfHeapTree = Nothing++-- | Constructing an 'HeapTree' from a boxed value. It takes a depth parameter+-- that prevents it from running ad infinitum for cyclic or infinite+-- structures.+buildHeapTree :: Int -> Box -> IO HeapTree+buildHeapTree 0 _ = do+    return $ EndOfHeapTree+buildHeapTree n b = do+    w <- weakBox b+    c <- getBoxedClosureData b+    c' <- T.mapM (buildHeapTree (n-1)) c+    return $ HeapTree w c'++-- | Pretty-Printing a heap Tree+-- +-- Example output for @[Just 4, Nothing, *something*]@, where *something* is an+-- unevaluated expression depending on the command line argument.+--+-- >[Just (I# 4),Nothing,Just (_thunk ["arg1","arg2"])]+ppHeapTree :: HeapTree -> String+ppHeapTree = go 0+  where+    go _ EndOfHeapTree = "..."+    go prec t@(HeapTree _ c')+        | Just s <- isHeapTreeString t = show s+        | Just l <- isHeapTreeList t   = "[" ++ intercalate "," (map ppHeapTree l) ++ "]"+        | otherwise                    =  ppPrintClosure go prec c'++isHeapTreeList :: HeapTree -> Maybe ([HeapTree])+isHeapTreeList tree = do+    c <- heapTreeClosure tree+    if isNil c+      then return []+      else do+        (h,t) <- isCons c+        t' <- isHeapTreeList t+        return $ (:) h t'++isHeapTreeString :: HeapTree -> Maybe String+isHeapTreeString t = do+    list <- isHeapTreeList t+    -- We do not want to print empty lists as "" as we do not know that they+    -- are really strings.+    if (null list)+        then Nothing+        else mapM (isChar <=< heapTreeClosure) list++-- | For heap graphs, i.e. data structures that also represent sharing and+-- cyclic structures, these are the entries. If the referenced value is+-- @Nothing@, then we do not have that value in the map, most likely due to+-- exceeding the recursion bound passed to 'buildHeapGraph'.+data HeapGraphEntry = HeapGraphEntry WeakBox (GenClosure (Maybe HeapGraphIndex))+    deriving (Show)+type HeapGraphIndex = Int++-- | The whole graph. The suggested interface is to only use 'lookupHeapGraph',+-- as the internal representation may change. Nevertheless, we export it here:+-- Sometimes the user knows better what he needs than we do.+newtype HeapGraph = HeapGraph (M.IntMap HeapGraphEntry)+    deriving (Show)++lookupHeapGraph :: HeapGraphIndex -> HeapGraph -> Maybe HeapGraphEntry+lookupHeapGraph i (HeapGraph m) = M.lookup i m++heapGraphRoot :: HeapGraphIndex+heapGraphRoot = 0++-- | Creates a 'HeapGraph' for the value in the box, but not recursing further+-- than the given limit. The initial value has index 'heapGraphRoot'.+buildHeapGraph :: Int -> Box -> IO HeapGraph+buildHeapGraph limit initialBox = do+    let initialState = ([], [0..])+    HeapGraph <$> execWriterT (runStateT (add limit initialBox) initialState)+  where+    add 0 _ = return Nothing+    add n b = do+        -- If the box is in the map, return the index+        (existing,_) <- get+        case lookup b existing of+            Just i -> return $ Just i+            Nothing -> do+                -- Otherwise, allocate a new index+                i <- nextI+                -- And register it+                modify (first ((b,i):))+                c <- liftIO $ getBoxedClosureData b+                -- Find indicies for all boxes contained in the map+                c' <- T.mapM (add (n-1)) c+                w <- liftIO $ weakBox b+                -- Add add the resulting closure to the map+                lift $ tell (M.singleton i (HeapGraphEntry w c'))+                return $ Just i+    nextI = do+        i <- gets (head . snd)+        modify (second tail)+        return i++-- | Pretty-prints a HeapGraph. The resulting string contains newlines. Example+-- for @let s = "Ki" in (s, s, cycle "Ho")@:+--+-- >let x1 = "Ki"+-- >    x6 = C# 'H' : C# 'o' : x6+-- >in (x1,x1,x6)+ppHeapGraph :: HeapGraph -> String+ppHeapGraph (HeapGraph m) = letWrapper ++ ppRef 0 (Just heapGraphRoot)+  where+    -- All variables occuring more than once+    bindings = boundMultipleTimes (HeapGraph m) [heapGraphRoot] ++    letWrapper =+        if null bindings+        then ""+        else "let " ++ intercalate "\n    " (map ppBinding bindings) ++ "\nin "++    ppBinding i = "x" ++ show i ++ " = " ++ ppEntry 0 (iToE i)++    ppEntry prec e@(HeapGraphEntry _ c)+        | Just s <- isString e = show s+        | Just l <- isList e = "[" ++ intercalate "," (map (ppRef 0) l) ++ "]"+        | otherwise = ppPrintClosure ppRef prec c++    ppRef _ Nothing = "..."+    ppRef prec (Just i) | i `elem` bindings = "x" ++ show i+                        | otherwise = ppEntry prec (iToE i) +    iToE i = fromJust (M.lookup i m)++    iToUnboundE i = if i `elem` bindings then Nothing else M.lookup i m++    isList :: HeapGraphEntry -> Maybe ([Maybe HeapGraphIndex])+    isList (HeapGraphEntry _ c) = +        if isNil c+          then return []+          else do+            (h,t) <- isCons c+            ti <- t+            e <- iToUnboundE ti+            t' <- isList e+            return $ (:) h t'++    isString :: HeapGraphEntry -> Maybe String+    isString e = do+        list <- isList e+        -- We do not want to print empty lists as "" as we do not know that they+        -- are really strings.+        if (null list)+            then Nothing+            else mapM (isChar . (\(HeapGraphEntry _ c) -> c) <=< iToUnboundE <=< id) list+++-- | In the given HeapMap, list all indices that are used more than once. The+-- second parameter adds external references, commonly @[heapGraphRoot]@.+boundMultipleTimes :: HeapGraph -> [HeapGraphIndex] -> [HeapGraphIndex]+boundMultipleTimes (HeapGraph m) roots = map head $ filter (not.null) $ map tail $ group $ sort $+     roots ++ concatMap (\(HeapGraphEntry _ c) -> catMaybes (allPtrs c)) (M.elems m)++-- | An a variant of 'Box' that does not keep the value alive.+-- +-- Like 'Box', its 'Show' instance is highly unsafe.+newtype WeakBox = WeakBox (Weak Box)+++type WeakClosure = GenClosure WeakBox++instance Show WeakBox where+    showsPrec p (WeakBox w) rs = case unsafePerformIO (deRefWeak w) of+        Nothing -> let txt = "(freed)" in+                   replicate (2*wORD_SIZE - length txt) ' ' ++ txt ++ rs+        Just b -> showsPrec p b rs++{-|+  Turns a 'Box' into a 'WeakBox', allowing the referenced value to be garbage+  collected.+-}+weakBox :: Box -> IO WeakBox+weakBox b@(Box a) = WeakBox `fmap` mkWeak a b Nothing++{-|+  Checks whether the value referenced by a weak box is still alive+-}+isAlive :: WeakBox -> IO Bool+isAlive (WeakBox w) = isJust `fmap` deRefWeak w++{-|+  Dereferences the weak box+-}+derefWeakBox :: WeakBox -> IO (Maybe Box)+derefWeakBox (WeakBox w) = deRefWeak w++weakenClosure :: Closure -> IO WeakClosure+weakenClosure = T.mapM weakBox