c180a3ff745de693f7eddfb62afba26de977d4cd
[ghc-heap-view.git] / src / GHC / HeapView / Debug.hs
1 -- | Utilities to debug "GHC.HeapView".
2 module GHC.HeapView.Debug where
3
4 import GHC.HeapView
5 import Text.Printf
6 import System.IO
7 import Control.Monad
8 import System.Mem
9 import Data.Maybe
10 import Data.Functor
11 import Data.Char
12 import Data.IORef
13
14 -- | This functions walks the heap referenced by the argument, printing the
15 -- \"path\", i.e. the pointer indices from the initial to the current closure
16 -- and the closure itself. When the runtime crashes, the problem is likely
17 -- related to one of the earlier steps.
18 walkHeap
19     :: Bool -- ^ Whether to check for cycles 
20     -> Bool -- ^ Whethter to GC in every step
21     -> Box -- ^ The closure to investigate
22     -> IO ()
23 walkHeap slow check x = do
24     seenRef <- newIORef []
25     go seenRef [] x
26  where
27     go seenRef prefix b = do
28         _ <- printf "At %s:\n" (show prefix)
29         seen <- readIORef seenRef
30         previous <- if check then findM (areBoxesEqual b . fst) seen else return Nothing
31         case previous of
32             Just (_,p') -> printf "Seen at %s.\n" (show p')
33             Nothing -> do
34                 hFlush stdout
35                 c <- getBoxedClosureData b
36                 putStrLn (ppClosure (\_ box -> show box) 0 c)
37                 when slow performGC
38                 isCC <- isCharCons c
39                 unless isCC $ do
40                     modifyIORef seenRef ((b,prefix):)
41                     forM_ (zip [(0::Int)..] (allPtrs c)) $ \(n,box) ->
42                         go seenRef (prefix ++ [n]) box
43
44 walkPrefix :: [Int] -> a -> IO Box
45 walkPrefix is v = go is (asBox v)
46   where
47     go [] a = return a
48     go (x:xs) a = do
49         c <- getBoxedClosureData a
50         walkPrefix xs (allPtrs c !! x)
51
52
53 findM :: (a -> IO Bool) -> [a] -> IO (Maybe a)
54 findM _p [] = return Nothing
55 findM p (x:xs) = do
56     b <- p x
57     if b then return (Just x) else findM p xs
58
59 isCharCons :: GenClosure Box -> IO Bool
60 isCharCons c | Just (h,_) <- isCons c = (isJust . isChar) <$> getBoxedClosureData h
61 isCharCons _ = return False 
62
63 isCons :: GenClosure b -> Maybe (b, b)
64 isCons (ConsClosure { name = ":", dataArgs = [], ptrArgs = [h,t]}) = Just (h,t)
65 isCons _ = Nothing
66
67 isChar :: GenClosure b -> Maybe Char
68 isChar (ConsClosure { name = "C#", dataArgs = [ch], ptrArgs = []}) = Just (chr (fromIntegral ch))
69 isChar _ = Nothing