Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
The main API for creating debuggers. For example, this API can be used to connect to an instrumented process, query the GC roots and then decode the first root up to depth 10 and displayed to the user.
main = withDebuggeeConnect "/tmp/ghc-debug" p1 p1 :: Debuggee -> IO () p1 e = do pause e g <- run e $ do precacheBlocks (r:_) <- gcRoots buildHeapGraph (Just 10) r putStrLn (ppHeapGraph (const "") g)
Synopsis
- data Debuggee
- type DebugM = DebugM
- debuggeeRun :: FilePath -> FilePath -> IO Debuggee
- debuggeeConnect :: FilePath -> IO Debuggee
- debuggeeClose :: Debuggee -> IO ()
- withDebuggeeRun :: FilePath -> FilePath -> (Debuggee -> IO a) -> IO a
- withDebuggeeConnect :: FilePath -> (Debuggee -> IO a) -> IO a
- socketDirectory :: IO FilePath
- snapshotRun :: FilePath -> (Debuggee -> IO a) -> IO a
- run :: Debuggee -> DebugM a -> IO a
- runTrace :: Debuggee -> DebugM a -> IO a
- runAnalysis :: DebugM a -> (a -> IO r) -> Debuggee -> IO r
- pause :: Debuggee -> IO ()
- fork :: Debuggee -> IO ()
- pauseThen :: Debuggee -> DebugM b -> IO b
- resume :: Debuggee -> IO ()
- pausePoll :: Debuggee -> IO ()
- withPause :: Debuggee -> IO a -> IO a
- version :: DebugM Version
- gcRoots :: DebugM [ClosurePtr]
- allBlocks :: DebugM [RawBlock]
- getSourceInfo :: InfoTablePtr -> DebugM (Maybe SourceInformation)
- savedObjects :: DebugM [ClosurePtr]
- precacheBlocks :: DebugM [RawBlock]
- dereferenceClosure :: ClosurePtr -> DebugM SizedClosure
- dereferenceToClosurePtr :: SizedClosure -> DebugM SizedClosureP
- addConstrDesc :: SizedClosure -> DebugM SizedClosureC
- dereferenceClosures :: [ClosurePtr] -> DebugM [SizedClosure]
- dereferenceStack :: StackCont -> DebugM StackFrames
- dereferencePapPayload :: PayloadCont -> DebugM PapPayload
- dereferenceConDesc :: ConstrDescCont -> DebugM ConstrDesc
- dereferenceInfoTable :: InfoTablePtr -> DebugM StgInfoTable
- dereferenceSRT :: InfoTablePtr -> DebugM SrtPayload
- class Quintraversable (m :: TYPE LiftedRep -> TYPE LiftedRep -> TYPE LiftedRep -> TYPE LiftedRep -> TYPE LiftedRep -> TYPE LiftedRep) where
- quintraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> (j -> f k) -> m a c e h j -> f (m b d g i k)
- buildHeapGraph :: Maybe Int -> ClosurePtr -> DebugM (HeapGraph Size)
- multiBuildHeapGraph :: Maybe Int -> NonEmpty ClosurePtr -> DebugM (HeapGraph Size)
- data HeapGraph a = HeapGraph {
- roots :: !(NonEmpty ClosurePtr)
- graph :: !(IntMap (HeapGraphEntry a))
- data HeapGraphEntry a = HeapGraphEntry {}
- ppHeapGraph :: (a -> String) -> HeapGraph a -> String
- traceWrite :: DebugMonad m => Show a => a -> m ()
- traceMsg :: DebugMonad m => String -> m ()
- saveCache :: DebugMonad m => FilePath -> m ()
- loadCache :: DebugMonad m => FilePath -> m ()
- module GHC.Debug.Types.Closures
- data SourceInformation = SourceInformation {
- infoName :: !String
- infoClosureType :: !ClosureType
- infoType :: !String
- infoLabel :: !String
- infoModule :: !String
- infoPosition :: !String
- data RawBlock = RawBlock BlockPtr Word16 ByteString
- data BlockPtr
- data StackPtr
- data ClosurePtr
- data InfoTablePtr
- type StackHI = GenStackFrames (GenSrtPayload (Maybe HeapGraphIndex)) (Maybe HeapGraphIndex)
- type PapHI = GenPapPayload (Maybe HeapGraphIndex)
- type HeapGraphIndex = ClosurePtr
Running/Connecting to a debuggee
:: FilePath | path to executable to run as the debuggee |
-> FilePath | filename of socket (e.g. |
-> IO Debuggee |
Run a debuggee and connect to it. Use debuggeeClose
when you're done.
debuggeeClose :: Debuggee -> IO () Source #
Close the connection to the debuggee.
:: FilePath | path to executable to run as the debuggee |
-> FilePath | filename of socket (e.g. |
-> (Debuggee -> IO a) | |
-> IO a |
Bracketed version of debuggeeRun
. Runs a debuggee, connects to it, runs
the action, kills the process, then closes the debuggee.
Bracketed version of debuggeeConnect
. Connects to a debuggee, runs the
action, then closes the debuggee.
snapshotRun :: FilePath -> (Debuggee -> IO a) -> IO a Source #
Start an analysis session using a snapshot. This will not connect to a
debuggee. The snapshot is created by snapshot
.
Running DebugM
runAnalysis :: DebugM a -> (a -> IO r) -> Debuggee -> IO r Source #
Perform the given analysis whilst the debuggee is paused, then resume and apply the continuation to the result.
Pause/Resume
pausePoll :: Debuggee -> IO () Source #
Like pause, but wait for the debuggee to pause itself. It currently impossible to resume after a pause caused by a poll.?????????? Is that true???? can we not just call resume????
Basic Requests
gcRoots :: DebugM [ClosurePtr] Source #
Query the debuggee for the list of GC Roots
getSourceInfo :: InfoTablePtr -> DebugM (Maybe SourceInformation) Source #
Query the debuggee for source information about a specific info table.
This requires your executable to be built with -finfo-table-map
.
savedObjects :: DebugM [ClosurePtr] Source #
Query the debuggee for the list of saved objects.
precacheBlocks :: DebugM [RawBlock] Source #
Fetch all the blocks from the debuggee and add them to the block cache
dereferenceClosure :: ClosurePtr -> DebugM SizedClosure Source #
Consult the BlockCache
for the block which contains a specific
closure, if it's not there then try to fetch the right block, if that
fails, call dereferenceClosureDirect
dereferenceClosures :: [ClosurePtr] -> DebugM [SizedClosure] Source #
dereferenceStack :: StackCont -> DebugM StackFrames Source #
Deference some StackFrames from a given StackCont
dereferencePapPayload :: PayloadCont -> DebugM PapPayload Source #
Derference the PapPayload from the PayloadCont
class Quintraversable (m :: TYPE LiftedRep -> TYPE LiftedRep -> TYPE LiftedRep -> TYPE LiftedRep -> TYPE LiftedRep -> TYPE LiftedRep) where #
quintraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> (j -> f k) -> m a c e h j -> f (m b d g i k) #
Instances
Quintraversable DebugClosure | |
Defined in GHC.Debug.Types.Closures quintraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> (j -> f k) -> DebugClosure a c e h j -> f (DebugClosure b d g i k) # | |
Quintraversable (DebugClosureWithExtra x) | |
Defined in GHC.Debug.Types.Closures quintraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> (j -> f k) -> DebugClosureWithExtra x a c e h j -> f (DebugClosureWithExtra x b d g i k) # |
Building a Heap Graph
buildHeapGraph :: Maybe Int -> ClosurePtr -> DebugM (HeapGraph Size) Source #
Build a heap graph starting from the given root. The first argument controls how many levels to recurse. You nearly always want to set this to a small number ~ 10, as otherwise you can easily run out of memory.
multiBuildHeapGraph :: Maybe Int -> NonEmpty ClosurePtr -> DebugM (HeapGraph Size) Source #
Build a heap graph starting from multiple roots. The first argument controls how many levels to recurse. You nearly always want to set this value to a small number ~ 10 as otherwise you can easily run out of memory.
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.
HeapGraph | |
|
Instances
Foldable HeapGraph | |
Defined in GHC.Debug.Types.Graph fold :: Monoid m => HeapGraph m -> m # foldMap :: Monoid m => (a -> m) -> HeapGraph a -> m # foldMap' :: Monoid m => (a -> m) -> HeapGraph a -> m # foldr :: (a -> b -> b) -> b -> HeapGraph a -> b # foldr' :: (a -> b -> b) -> b -> HeapGraph a -> b # foldl :: (b -> a -> b) -> b -> HeapGraph a -> b # foldl' :: (b -> a -> b) -> b -> HeapGraph a -> b # foldr1 :: (a -> a -> a) -> HeapGraph a -> a # foldl1 :: (a -> a -> a) -> HeapGraph a -> a # toList :: HeapGraph a -> [a] # length :: HeapGraph a -> Int # elem :: Eq a => a -> HeapGraph a -> Bool # maximum :: Ord a => HeapGraph a -> a # minimum :: Ord a => HeapGraph a -> a # | |
Traversable HeapGraph | |
Functor HeapGraph | |
Show a => Show (HeapGraph a) | |
data HeapGraphEntry a #
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
.
Besides a pointer to the stored value and the closure representation we have a slot for arbitrary data, for the user's convenience.
Instances
Printing a heap graph
ppHeapGraph :: (a -> String) -> HeapGraph a -> String #
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)
Tracing
traceWrite :: DebugMonad m => Show a => a -> m () Source #
traceMsg :: DebugMonad m => String -> m () Source #
Caching
saveCache :: DebugMonad m => FilePath -> m () Source #
loadCache :: DebugMonad m => FilePath -> m () Source #
Types
module GHC.Debug.Types.Closures
data SourceInformation #
SourceInformation | |
|
Instances
Show SourceInformation | |
Defined in GHC.Debug.Types showsPrec :: Int -> SourceInformation -> ShowS # show :: SourceInformation -> String # showList :: [SourceInformation] -> ShowS # | |
Eq SourceInformation | |
Defined in GHC.Debug.Types (==) :: SourceInformation -> SourceInformation -> Bool # (/=) :: SourceInformation -> SourceInformation -> Bool # | |
Ord SourceInformation | |
Defined in GHC.Debug.Types compare :: SourceInformation -> SourceInformation -> Ordering # (<) :: SourceInformation -> SourceInformation -> Bool # (<=) :: SourceInformation -> SourceInformation -> Bool # (>) :: SourceInformation -> SourceInformation -> Bool # (>=) :: SourceInformation -> SourceInformation -> Bool # max :: SourceInformation -> SourceInformation -> SourceInformation # min :: SourceInformation -> SourceInformation -> SourceInformation # |
data ClosurePtr #
Instances
Show ClosurePtr | |
Defined in GHC.Debug.Types.Ptr showsPrec :: Int -> ClosurePtr -> ShowS # show :: ClosurePtr -> String # showList :: [ClosurePtr] -> ShowS # | |
Binary ClosurePtr | |
Defined in GHC.Debug.Types.Ptr | |
Eq ClosurePtr | |
Defined in GHC.Debug.Types.Ptr (==) :: ClosurePtr -> ClosurePtr -> Bool # (/=) :: ClosurePtr -> ClosurePtr -> Bool # | |
Ord ClosurePtr | |
Defined in GHC.Debug.Types.Ptr compare :: ClosurePtr -> ClosurePtr -> Ordering # (<) :: ClosurePtr -> ClosurePtr -> Bool # (<=) :: ClosurePtr -> ClosurePtr -> Bool # (>) :: ClosurePtr -> ClosurePtr -> Bool # (>=) :: ClosurePtr -> ClosurePtr -> Bool # max :: ClosurePtr -> ClosurePtr -> ClosurePtr # min :: ClosurePtr -> ClosurePtr -> ClosurePtr # | |
Hashable ClosurePtr | |
Defined in GHC.Debug.Types.Ptr hashWithSalt :: Int -> ClosurePtr -> Int # hash :: ClosurePtr -> Int # |
data InfoTablePtr #
Instances
Show InfoTablePtr | |
Defined in GHC.Debug.Types.Ptr showsPrec :: Int -> InfoTablePtr -> ShowS # show :: InfoTablePtr -> String # showList :: [InfoTablePtr] -> ShowS # | |
Binary InfoTablePtr | |
Defined in GHC.Debug.Types.Ptr | |
Eq InfoTablePtr | |
Defined in GHC.Debug.Types.Ptr (==) :: InfoTablePtr -> InfoTablePtr -> Bool # (/=) :: InfoTablePtr -> InfoTablePtr -> Bool # | |
Ord InfoTablePtr | |
Defined in GHC.Debug.Types.Ptr compare :: InfoTablePtr -> InfoTablePtr -> Ordering # (<) :: InfoTablePtr -> InfoTablePtr -> Bool # (<=) :: InfoTablePtr -> InfoTablePtr -> Bool # (>) :: InfoTablePtr -> InfoTablePtr -> Bool # (>=) :: InfoTablePtr -> InfoTablePtr -> Bool # max :: InfoTablePtr -> InfoTablePtr -> InfoTablePtr # min :: InfoTablePtr -> InfoTablePtr -> InfoTablePtr # | |
Hashable InfoTablePtr | |
Defined in GHC.Debug.Types.Ptr hashWithSalt :: Int -> InfoTablePtr -> Int # hash :: InfoTablePtr -> Int # |
type StackHI = GenStackFrames (GenSrtPayload (Maybe HeapGraphIndex)) (Maybe HeapGraphIndex) #
type PapHI = GenPapPayload (Maybe HeapGraphIndex) #
type HeapGraphIndex = ClosurePtr #