BCOClosure {..} -> app
["_bco"]
ArrWordsClosure {..} -> app
- ["toArray", intercalate "," (map show arrWords) ]
- MutArrClosure {..} -> app
- ["toMutArray", intercalate "," (map (showBox 10) mccPayload)]
+ ["toArray", intercalate "," (shorten (map show arrWords)) ]
+ MutArrClosure {..} -> app
+ ["toMutArray", intercalate "," (shorten (map (showBox 10) mccPayload))]
MutVarClosure {..} -> app $
["_mutVar", (showBox 10) var]
MVarClosure {..} -> app $
where
app [a] = a ++ "()"
app xs = addBraces (10 <= prec) (intercalate " " xs)
+
+ shorten xs = if length xs > 20 then take 20 xs ++ ["(and more)"] else xs
{- $heapmap
--- /dev/null
+-- | Utilities to debug "GHC.HeapView".
+module GHC.HeapView.Debug where
+
+import GHC.HeapView
+import Text.Printf
+import System.IO
+import Control.Monad
+import System.Mem
+import Data.Maybe
+import Data.Functor
+import Data.Char
+import Data.IORef
+
+-- | This functions walks the heap referenced by the argument, printing the
+-- \"path\", i.e. the pointer indices from the initial to the current closure
+-- and the closure itself. When the runtime crashes, the problem is likely
+-- related to one of the earlier steps.
+walkHeap
+ :: Bool -- ^ Whether to check for cycles
+ -> Bool -- ^ Whethter to GC in every step
+ -> Box -- ^ The closure to investigate
+ -> IO ()
+walkHeap slow check x = do
+ seenRef <- newIORef []
+ go seenRef [] x
+ where
+ go seenRef prefix b = do
+ _ <- printf "At %s:\n" (show prefix)
+ seen <- readIORef seenRef
+ previous <- if check then findM (areBoxesEqual b . fst) seen else return Nothing
+ case previous of
+ Just (_,p') -> printf "Seen at %s.\n" (show p')
+ Nothing -> do
+ hFlush stdout
+ c <- getBoxedClosureData b
+ putStrLn (ppClosure (\_ box -> show box) 0 c)
+ when slow performGC
+ isCC <- isCharCons c
+ unless isCC $ do
+ modifyIORef seenRef ((b,prefix):)
+ forM_ (zip [(0::Int)..] (allPtrs c)) $ \(n,box) ->
+ go seenRef (prefix ++ [n]) box
+
+walkPrefix :: [Int] -> a -> IO Box
+walkPrefix is v = go is (asBox v)
+ where
+ go [] a = return a
+ go (x:xs) a = do
+ c <- getBoxedClosureData a
+ walkPrefix xs (allPtrs c !! x)
+
+
+findM :: (a -> IO Bool) -> [a] -> IO (Maybe a)
+findM _p [] = return Nothing
+findM p (x:xs) = do
+ b <- p x
+ if b then return (Just x) else findM p xs
+
+isCharCons :: GenClosure Box -> IO Bool
+isCharCons c | Just (h,_) <- isCons c = (isJust . isChar) <$> getBoxedClosureData h
+isCharCons _ = return False
+
+isCons :: GenClosure b -> Maybe (b, b)
+isCons (ConsClosure { name = ":", dataArgs = [], ptrArgs = [h,t]}) = Just (h,t)
+isCons _ = Nothing
+
+isChar :: GenClosure b -> Maybe Char
+isChar (ConsClosure { name = "C#", dataArgs = [ch], ptrArgs = []}) = Just (chr (fromIntegral ch))
+isChar _ = Nothing