ghc-debug-client
Safe HaskellNone
LanguageHaskell2010

GHC.Debug.Client

Description

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

Running/Connecting to a debuggee

debuggeeRun Source #

Arguments

:: FilePath

path to executable to run as the debuggee

-> FilePath

filename of socket (e.g. "/tmp/ghc-debug")

-> 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.

withDebuggeeRun Source #

Arguments

:: FilePath

path to executable to run as the debuggee

-> FilePath

filename of socket (e.g. "/tmp/ghc-debug")

-> (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.

withDebuggeeConnect Source #

Arguments

:: FilePath

filename of socket (e.g. "/tmp/ghc-debug")

-> (Debuggee -> IO a) 
-> IO a 

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

run :: Debuggee -> DebugM a -> IO a Source #

Run a DebugM a in the given environment.

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

pause :: Debuggee -> IO () Source #

Pause the debuggee

resume :: Debuggee -> IO () Source #

Resume the debuggee

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????

withPause :: Debuggee -> IO a -> IO a Source #

Bracketed version of pause/resume.

Basic Requests

version :: DebugM Version Source #

Query the debuggee for the protocol version

gcRoots :: DebugM [ClosurePtr] Source #

Query the debuggee for the list of GC Roots

allBlocks :: DebugM [RawBlock] Source #

Query the debuggee for all the blocks it knows about

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

dereferenceStack :: StackCont -> DebugM StackFrames Source #

Deference some StackFrames from a given StackCont

dereferencePapPayload :: PayloadCont -> DebugM PapPayload Source #

Derference the PapPayload from the PayloadCont

class Hextraversable (m :: Type -> Type -> Type -> Type -> Type -> Type -> Type) where #

Methods

hextraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> (j -> f k) -> (l -> f n) -> m a c e h j l -> f (m b d g i k n) #

Instances

Instances details
Hextraversable DebugClosure # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

hextraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> (j -> f k) -> (l -> f n) -> DebugClosure a c e h j l -> f (DebugClosure b d g i k n) #

Hextraversable (DebugClosureWithExtra x) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

hextraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> (j -> f k) -> (l -> f n) -> DebugClosureWithExtra x a c e h j l -> f (DebugClosureWithExtra x b d g i k n) #

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.

data HeapGraph a #

Constructors

HeapGraph 

Instances

Instances details
Functor HeapGraph # 
Instance details

Defined in GHC.Debug.Types.Graph

Methods

fmap :: (a -> b) -> HeapGraph a -> HeapGraph b #

(<$) :: a -> HeapGraph b -> HeapGraph a #

Foldable HeapGraph # 
Instance details

Defined in GHC.Debug.Types.Graph

Methods

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] #

null :: HeapGraph a -> Bool #

length :: HeapGraph a -> Int #

elem :: Eq a => a -> HeapGraph a -> Bool #

maximum :: Ord a => HeapGraph a -> a #

minimum :: Ord a => HeapGraph a -> a #

sum :: Num a => HeapGraph a -> a #

product :: Num a => HeapGraph a -> a #

Traversable HeapGraph # 
Instance details

Defined in GHC.Debug.Types.Graph

Methods

traverse :: Applicative f => (a -> f b) -> HeapGraph a -> f (HeapGraph b) #

sequenceA :: Applicative f => HeapGraph (f a) -> f (HeapGraph a) #

mapM :: Monad m => (a -> m b) -> HeapGraph a -> m (HeapGraph b) #

sequence :: Monad m => HeapGraph (m a) -> m (HeapGraph a) #

Show a => Show (HeapGraph a) # 
Instance details

Defined in GHC.Debug.Types.Graph

data HeapGraphEntry a #

Instances

Instances details
Functor HeapGraphEntry # 
Instance details

Defined in GHC.Debug.Types.Graph

Methods

fmap :: (a -> b) -> HeapGraphEntry a -> HeapGraphEntry b #

(<$) :: a -> HeapGraphEntry b -> HeapGraphEntry a #

Foldable HeapGraphEntry # 
Instance details

Defined in GHC.Debug.Types.Graph

Methods

fold :: Monoid m => HeapGraphEntry m -> m #

foldMap :: Monoid m => (a -> m) -> HeapGraphEntry a -> m #

foldMap' :: Monoid m => (a -> m) -> HeapGraphEntry a -> m #

foldr :: (a -> b -> b) -> b -> HeapGraphEntry a -> b #

foldr' :: (a -> b -> b) -> b -> HeapGraphEntry a -> b #

foldl :: (b -> a -> b) -> b -> HeapGraphEntry a -> b #

foldl' :: (b -> a -> b) -> b -> HeapGraphEntry a -> b #

foldr1 :: (a -> a -> a) -> HeapGraphEntry a -> a #

foldl1 :: (a -> a -> a) -> HeapGraphEntry a -> a #

toList :: HeapGraphEntry a -> [a] #

null :: HeapGraphEntry a -> Bool #

length :: HeapGraphEntry a -> Int #

elem :: Eq a => a -> HeapGraphEntry a -> Bool #

maximum :: Ord a => HeapGraphEntry a -> a #

minimum :: Ord a => HeapGraphEntry a -> a #

sum :: Num a => HeapGraphEntry a -> a #

product :: Num a => HeapGraphEntry a -> a #

Traversable HeapGraphEntry # 
Instance details

Defined in GHC.Debug.Types.Graph

Methods

traverse :: Applicative f => (a -> f b) -> HeapGraphEntry a -> f (HeapGraphEntry b) #

sequenceA :: Applicative f => HeapGraphEntry (f a) -> f (HeapGraphEntry a) #

mapM :: Monad m => (a -> m b) -> HeapGraphEntry a -> m (HeapGraphEntry b) #

sequence :: Monad m => HeapGraphEntry (m a) -> m (HeapGraphEntry a) #

Show a => Show (HeapGraphEntry a) # 
Instance details

Defined in GHC.Debug.Types.Graph

Printing a heap graph

ppHeapGraph :: (a -> String) -> HeapGraph a -> String #

Tracing

traceWrite :: (DebugMonad m, Show a) => a -> m () Source #

Caching

Types

dcSize :: DebugClosureWithSize ccs srt pap string s b -> Size #

hexmap :: forall a b c d e f g h i j k l t. Hextraversable t => (a -> b) -> (c -> d) -> (e -> f) -> (g -> h) -> (i -> j) -> (k -> l) -> t a c e g i k -> t b d f h j l #

noSize :: DebugClosureWithSize ccs srt pap string s b -> DebugClosure ccs srt pap string s b #

data CCPayload #

Instances

Instances details
Show CCPayload # 
Instance details

Defined in GHC.Debug.Types.Closures

Eq CCPayload # 
Instance details

Defined in GHC.Debug.Types.Closures

Ord CCPayload # 
Instance details

Defined in GHC.Debug.Types.Closures

data ClosureType #

Instances

Instances details
Enum ClosureType # 
Instance details

Defined in GHC.Debug.Types.Closures

Generic ClosureType # 
Instance details

Defined in GHC.Debug.Types.Closures

Associated Types

type Rep ClosureType 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep ClosureType = D1 ('MetaData "ClosureType" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'False) ((((((C1 ('MetaCons "INVALID_OBJECT" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CONSTR" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "CONSTR_1_0" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CONSTR_0_1" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "CONSTR_2_0" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CONSTR_1_1" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "CONSTR_0_2" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CONSTR_NOCAF" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "FUN" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "FUN_1_0" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "FUN_0_1" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "FUN_2_0" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "FUN_1_1" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "FUN_0_2" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "FUN_STATIC" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "THUNK" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: ((((C1 ('MetaCons "THUNK_1_0" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "THUNK_0_1" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "THUNK_2_0" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "THUNK_1_1" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "THUNK_0_2" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "THUNK_STATIC" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "THUNK_SELECTOR" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BCO" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "AP" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PAP" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "AP_STACK" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "IND" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "IND_STATIC" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "RET_BCO" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "RET_SMALL" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "RET_BIG" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "RET_FUN" 'PrefixI 'False) (U1 :: Type -> Type))))))) :+: (((((C1 ('MetaCons "UPDATE_FRAME" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CATCH_FRAME" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "UNDERFLOW_FRAME" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "STOP_FRAME" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "BLOCKING_QUEUE" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BLACKHOLE" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "MVAR_CLEAN" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MVAR_DIRTY" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "TVAR" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ARR_WORDS" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "MUT_ARR_PTRS_CLEAN" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MUT_ARR_PTRS_DIRTY" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "MUT_ARR_PTRS_FROZEN_DIRTY" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MUT_ARR_PTRS_FROZEN_CLEAN" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "MUT_VAR_CLEAN" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MUT_VAR_DIRTY" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: ((((C1 ('MetaCons "WEAK" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PRIM" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "MUT_PRIM" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TSO" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "STACK" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TREC_CHUNK" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "ATOMICALLY_FRAME" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CATCH_RETRY_FRAME" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "CATCH_STM_FRAME" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "WHITEHOLE" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "SMALL_MUT_ARR_PTRS_CLEAN" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "SMALL_MUT_ARR_PTRS_DIRTY" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "SMALL_MUT_ARR_PTRS_FROZEN_DIRTY" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "SMALL_MUT_ARR_PTRS_FROZEN_CLEAN" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "COMPACT_NFDATA" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "CONTINUATION" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "N_CLOSURE_TYPES" 'PrefixI 'False) (U1 :: Type -> Type))))))))
Read ClosureType # 
Instance details

Defined in GHC.Debug.Types.Closures

Show ClosureType # 
Instance details

Defined in GHC.Debug.Types.Closures

Eq ClosureType # 
Instance details

Defined in GHC.Debug.Types.Closures

Ord ClosureType # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep ClosureType # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep ClosureType = D1 ('MetaData "ClosureType" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'False) ((((((C1 ('MetaCons "INVALID_OBJECT" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CONSTR" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "CONSTR_1_0" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CONSTR_0_1" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "CONSTR_2_0" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CONSTR_1_1" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "CONSTR_0_2" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CONSTR_NOCAF" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "FUN" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "FUN_1_0" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "FUN_0_1" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "FUN_2_0" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "FUN_1_1" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "FUN_0_2" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "FUN_STATIC" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "THUNK" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: ((((C1 ('MetaCons "THUNK_1_0" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "THUNK_0_1" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "THUNK_2_0" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "THUNK_1_1" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "THUNK_0_2" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "THUNK_STATIC" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "THUNK_SELECTOR" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BCO" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "AP" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PAP" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "AP_STACK" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "IND" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "IND_STATIC" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "RET_BCO" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "RET_SMALL" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "RET_BIG" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "RET_FUN" 'PrefixI 'False) (U1 :: Type -> Type))))))) :+: (((((C1 ('MetaCons "UPDATE_FRAME" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CATCH_FRAME" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "UNDERFLOW_FRAME" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "STOP_FRAME" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "BLOCKING_QUEUE" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BLACKHOLE" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "MVAR_CLEAN" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MVAR_DIRTY" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "TVAR" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ARR_WORDS" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "MUT_ARR_PTRS_CLEAN" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MUT_ARR_PTRS_DIRTY" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "MUT_ARR_PTRS_FROZEN_DIRTY" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MUT_ARR_PTRS_FROZEN_CLEAN" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "MUT_VAR_CLEAN" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MUT_VAR_DIRTY" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: ((((C1 ('MetaCons "WEAK" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PRIM" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "MUT_PRIM" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TSO" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "STACK" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TREC_CHUNK" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "ATOMICALLY_FRAME" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CATCH_RETRY_FRAME" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "CATCH_STM_FRAME" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "WHITEHOLE" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "SMALL_MUT_ARR_PTRS_CLEAN" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "SMALL_MUT_ARR_PTRS_DIRTY" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "SMALL_MUT_ARR_PTRS_FROZEN_DIRTY" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "SMALL_MUT_ARR_PTRS_FROZEN_CLEAN" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "COMPACT_NFDATA" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "CONTINUATION" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "N_CLOSURE_TYPES" 'PrefixI 'False) (U1 :: Type -> Type))))))))

data ConstrDesc #

Constructors

ConstrDesc 

Fields

data DebugClosure ccs srt pap string s b #

Constructors

ConstrClosure 

Fields

FunClosure 

Fields

ThunkClosure 

Fields

SelectorClosure 
PAPClosure 

Fields

APClosure 

Fields

APStackClosure 

Fields

IndClosure 
BCOClosure 

Fields

BlackholeClosure 
ArrWordsClosure 
MutArrClosure 
SmallMutArrClosure 
MVarClosure 

Fields

MutVarClosure 

Fields

BlockingQueueClosure 

Fields

TSOClosure 
StackClosure 
WeakClosure 

Fields

TVarClosure 
TRecChunkClosure 
MutPrimClosure 

Fields

PrimClosure 

Fields

OtherClosure 

Fields

UnsupportedClosure 

Instances

Instances details
Hextraversable DebugClosure # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

hextraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> (j -> f k) -> (l -> f n) -> DebugClosure a c e h j l -> f (DebugClosure b d g i k n) #

Functor (DebugClosure ccs srt pap string s) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fmap :: (a -> b) -> DebugClosure ccs srt pap string s a -> DebugClosure ccs srt pap string s b #

(<$) :: a -> DebugClosure ccs srt pap string s b -> DebugClosure ccs srt pap string s a #

Foldable (DebugClosure ccs srt pap string s) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fold :: Monoid m => DebugClosure ccs srt pap string s m -> m #

foldMap :: Monoid m => (a -> m) -> DebugClosure ccs srt pap string s a -> m #

foldMap' :: Monoid m => (a -> m) -> DebugClosure ccs srt pap string s a -> m #

foldr :: (a -> b -> b) -> b -> DebugClosure ccs srt pap string s a -> b #

foldr' :: (a -> b -> b) -> b -> DebugClosure ccs srt pap string s a -> b #

foldl :: (b -> a -> b) -> b -> DebugClosure ccs srt pap string s a -> b #

foldl' :: (b -> a -> b) -> b -> DebugClosure ccs srt pap string s a -> b #

foldr1 :: (a -> a -> a) -> DebugClosure ccs srt pap string s a -> a #

foldl1 :: (a -> a -> a) -> DebugClosure ccs srt pap string s a -> a #

toList :: DebugClosure ccs srt pap string s a -> [a] #

null :: DebugClosure ccs srt pap string s a -> Bool #

length :: DebugClosure ccs srt pap string s a -> Int #

elem :: Eq a => a -> DebugClosure ccs srt pap string s a -> Bool #

maximum :: Ord a => DebugClosure ccs srt pap string s a -> a #

minimum :: Ord a => DebugClosure ccs srt pap string s a -> a #

sum :: Num a => DebugClosure ccs srt pap string s a -> a #

product :: Num a => DebugClosure ccs srt pap string s a -> a #

Traversable (DebugClosure ccs srt pap string s) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

traverse :: Applicative f => (a -> f b) -> DebugClosure ccs srt pap string s a -> f (DebugClosure ccs srt pap string s b) #

sequenceA :: Applicative f => DebugClosure ccs srt pap string s (f a) -> f (DebugClosure ccs srt pap string s a) #

mapM :: Monad m => (a -> m b) -> DebugClosure ccs srt pap string s a -> m (DebugClosure ccs srt pap string s b) #

sequence :: Monad m => DebugClosure ccs srt pap string s (m a) -> m (DebugClosure ccs srt pap string s a) #

Generic (DebugClosure ccs srt pap string s b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Associated Types

type Rep (DebugClosure ccs srt pap string s b) 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep (DebugClosure ccs srt pap string s b) = D1 ('MetaData "DebugClosure" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'False) ((((C1 ('MetaCons "ConstrClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "ptrArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b]) :*: (S1 ('MetaSel ('Just "dataArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Word]) :*: S1 ('MetaSel ('Just "constrDesc") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 string)))) :+: (C1 ('MetaCons "FunClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "srt") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 srt) :*: (S1 ('MetaSel ('Just "ptrArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b]) :*: S1 ('MetaSel ('Just "dataArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Word])))) :+: C1 ('MetaCons "ThunkClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "srt") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 srt) :*: (S1 ('MetaSel ('Just "ptrArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b]) :*: S1 ('MetaSel ('Just "dataArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Word])))))) :+: (C1 ('MetaCons "SelectorClosure" 'PrefixI 'True) (S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "selectee") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))) :+: (C1 ('MetaCons "PAPClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "arity") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 HalfWord))) :*: (S1 ('MetaSel ('Just "n_args") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 HalfWord) :*: (S1 ('MetaSel ('Just "fun") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "pap_payload") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 pap)))) :+: C1 ('MetaCons "APClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "arity") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 HalfWord))) :*: (S1 ('MetaSel ('Just "n_args") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 HalfWord) :*: (S1 ('MetaSel ('Just "fun") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "ap_payload") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 pap))))))) :+: ((C1 ('MetaCons "APStackClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "ap_st_size") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word) :*: (S1 ('MetaSel ('Just "fun") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "payload") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 s)))) :+: (C1 ('MetaCons "IndClosure" 'PrefixI 'True) (S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "indirectee") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))) :+: C1 ('MetaCons "BCOClosure" 'PrefixI 'True) (((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "instrs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "literals") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))) :*: ((S1 ('MetaSel ('Just "bcoptrs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "arity") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 HalfWord)) :*: (S1 ('MetaSel ('Just "size") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 HalfWord) :*: S1 ('MetaSel ('Just "bitmap") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 PtrBitmap)))))) :+: (C1 ('MetaCons "BlackholeClosure" 'PrefixI 'True) (S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "indirectee") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))) :+: (C1 ('MetaCons "ArrWordsClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "bytes") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word) :*: S1 ('MetaSel ('Just "arrWords") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Word]))) :+: C1 ('MetaCons "MutArrClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "mccPtrs") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word) :*: (S1 ('MetaSel ('Just "mccSize") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word) :*: S1 ('MetaSel ('Just "mccPayload") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b])))))))) :+: (((C1 ('MetaCons "SmallMutArrClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "mccPtrs") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word) :*: S1 ('MetaSel ('Just "mccPayload") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b]))) :+: (C1 ('MetaCons "MVarClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "queueHead") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: (S1 ('MetaSel ('Just "queueTail") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "value") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b)))) :+: C1 ('MetaCons "MutVarClosure" 'PrefixI 'True) (S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "var") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))))) :+: (C1 ('MetaCons "BlockingQueueClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "link") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))) :*: (S1 ('MetaSel ('Just "blackHole") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: (S1 ('MetaSel ('Just "owner") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "queue") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b)))) :+: (C1 ('MetaCons "TSOClosure" 'PrefixI 'True) ((((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "_link") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "global_link") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))) :*: ((S1 ('MetaSel ('Just "tsoStack") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "trec") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b)) :*: (S1 ('MetaSel ('Just "blocked_exceptions") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: (S1 ('MetaSel ('Just "bq") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "threadLabel") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe b)))))) :*: (((S1 ('MetaSel ('Just "what_next") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 WhatNext) :*: S1 ('MetaSel ('Just "why_blocked") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 WhyBlocked)) :*: (S1 ('MetaSel ('Just "flags") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [TsoFlags]) :*: S1 ('MetaSel ('Just "threadId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word64))) :*: ((S1 ('MetaSel ('Just "saved_errno") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word32) :*: S1 ('MetaSel ('Just "dirty") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word32)) :*: (S1 ('MetaSel ('Just "alloc_limit") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int64) :*: (S1 ('MetaSel ('Just "tot_stack_size") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word32) :*: S1 ('MetaSel ('Just "prof") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe StgTSOProfInfo))))))) :+: C1 ('MetaCons "StackClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "stack_size") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word32))) :*: (S1 ('MetaSel ('Just "stack_dirty") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word8) :*: (S1 ('MetaSel ('Just "stack_marking") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word8) :*: S1 ('MetaSel ('Just "frames") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 s))))))) :+: ((C1 ('MetaCons "WeakClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "cfinalizers") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))) :*: ((S1 ('MetaSel ('Just "key") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "value") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b)) :*: (S1 ('MetaSel ('Just "finalizer") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "mlink") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe b))))) :+: (C1 ('MetaCons "TVarClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "current_value") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: (S1 ('MetaSel ('Just "tvar_watch_queue") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "num_updates") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Int)))) :+: C1 ('MetaCons "TRecChunkClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "prev_chunk") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: (S1 ('MetaSel ('Just "next_idx") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word) :*: S1 ('MetaSel ('Just "entries") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [TRecEntry b])))))) :+: ((C1 ('MetaCons "MutPrimClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "ptrArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b]) :*: S1 ('MetaSel ('Just "dataArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Word]))) :+: C1 ('MetaCons "PrimClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "ptrArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b]) :*: S1 ('MetaSel ('Just "dataArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Word])))) :+: (C1 ('MetaCons "OtherClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "hvalues") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b]) :*: S1 ('MetaSel ('Just "rawWords") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Word]))) :+: C1 ('MetaCons "UnsupportedClosure" 'PrefixI 'True) (S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))))))))

Methods

from :: DebugClosure ccs srt pap string s b -> Rep (DebugClosure ccs srt pap string s b) x #

to :: Rep (DebugClosure ccs srt pap string s b) x -> DebugClosure ccs srt pap string s b #

(Show ccs, Show string, Show srt, Show pap, Show s, Show b) => Show (DebugClosure ccs srt pap string s b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

showsPrec :: Int -> DebugClosure ccs srt pap string s b -> ShowS #

show :: DebugClosure ccs srt pap string s b -> String #

showList :: [DebugClosure ccs srt pap string s b] -> ShowS #

(Eq ccs, Eq string, Eq srt, Eq pap, Eq s, Eq b) => Eq (DebugClosure ccs srt pap string s b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

(==) :: DebugClosure ccs srt pap string s b -> DebugClosure ccs srt pap string s b -> Bool #

(/=) :: DebugClosure ccs srt pap string s b -> DebugClosure ccs srt pap string s b -> Bool #

(Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) => Ord (DebugClosure ccs srt pap string s b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

compare :: DebugClosure ccs srt pap string s b -> DebugClosure ccs srt pap string s b -> Ordering #

(<) :: DebugClosure ccs srt pap string s b -> DebugClosure ccs srt pap string s b -> Bool #

(<=) :: DebugClosure ccs srt pap string s b -> DebugClosure ccs srt pap string s b -> Bool #

(>) :: DebugClosure ccs srt pap string s b -> DebugClosure ccs srt pap string s b -> Bool #

(>=) :: DebugClosure ccs srt pap string s b -> DebugClosure ccs srt pap string s b -> Bool #

max :: DebugClosure ccs srt pap string s b -> DebugClosure ccs srt pap string s b -> DebugClosure ccs srt pap string s b #

min :: DebugClosure ccs srt pap string s b -> DebugClosure ccs srt pap string s b -> DebugClosure ccs srt pap string s b #

type Rep (DebugClosure ccs srt pap string s b) # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep (DebugClosure ccs srt pap string s b) = D1 ('MetaData "DebugClosure" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'False) ((((C1 ('MetaCons "ConstrClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "ptrArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b]) :*: (S1 ('MetaSel ('Just "dataArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Word]) :*: S1 ('MetaSel ('Just "constrDesc") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 string)))) :+: (C1 ('MetaCons "FunClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "srt") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 srt) :*: (S1 ('MetaSel ('Just "ptrArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b]) :*: S1 ('MetaSel ('Just "dataArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Word])))) :+: C1 ('MetaCons "ThunkClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "srt") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 srt) :*: (S1 ('MetaSel ('Just "ptrArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b]) :*: S1 ('MetaSel ('Just "dataArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Word])))))) :+: (C1 ('MetaCons "SelectorClosure" 'PrefixI 'True) (S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "selectee") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))) :+: (C1 ('MetaCons "PAPClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "arity") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 HalfWord))) :*: (S1 ('MetaSel ('Just "n_args") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 HalfWord) :*: (S1 ('MetaSel ('Just "fun") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "pap_payload") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 pap)))) :+: C1 ('MetaCons "APClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "arity") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 HalfWord))) :*: (S1 ('MetaSel ('Just "n_args") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 HalfWord) :*: (S1 ('MetaSel ('Just "fun") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "ap_payload") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 pap))))))) :+: ((C1 ('MetaCons "APStackClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "ap_st_size") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word) :*: (S1 ('MetaSel ('Just "fun") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "payload") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 s)))) :+: (C1 ('MetaCons "IndClosure" 'PrefixI 'True) (S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "indirectee") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))) :+: C1 ('MetaCons "BCOClosure" 'PrefixI 'True) (((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "instrs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "literals") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))) :*: ((S1 ('MetaSel ('Just "bcoptrs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "arity") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 HalfWord)) :*: (S1 ('MetaSel ('Just "size") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 HalfWord) :*: S1 ('MetaSel ('Just "bitmap") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 PtrBitmap)))))) :+: (C1 ('MetaCons "BlackholeClosure" 'PrefixI 'True) (S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "indirectee") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))) :+: (C1 ('MetaCons "ArrWordsClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "bytes") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word) :*: S1 ('MetaSel ('Just "arrWords") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Word]))) :+: C1 ('MetaCons "MutArrClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "mccPtrs") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word) :*: (S1 ('MetaSel ('Just "mccSize") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word) :*: S1 ('MetaSel ('Just "mccPayload") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b])))))))) :+: (((C1 ('MetaCons "SmallMutArrClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "mccPtrs") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word) :*: S1 ('MetaSel ('Just "mccPayload") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b]))) :+: (C1 ('MetaCons "MVarClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "queueHead") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: (S1 ('MetaSel ('Just "queueTail") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "value") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b)))) :+: C1 ('MetaCons "MutVarClosure" 'PrefixI 'True) (S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "var") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))))) :+: (C1 ('MetaCons "BlockingQueueClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "link") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))) :*: (S1 ('MetaSel ('Just "blackHole") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: (S1 ('MetaSel ('Just "owner") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "queue") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b)))) :+: (C1 ('MetaCons "TSOClosure" 'PrefixI 'True) ((((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "_link") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "global_link") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))) :*: ((S1 ('MetaSel ('Just "tsoStack") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "trec") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b)) :*: (S1 ('MetaSel ('Just "blocked_exceptions") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: (S1 ('MetaSel ('Just "bq") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "threadLabel") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe b)))))) :*: (((S1 ('MetaSel ('Just "what_next") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 WhatNext) :*: S1 ('MetaSel ('Just "why_blocked") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 WhyBlocked)) :*: (S1 ('MetaSel ('Just "flags") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [TsoFlags]) :*: S1 ('MetaSel ('Just "threadId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word64))) :*: ((S1 ('MetaSel ('Just "saved_errno") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word32) :*: S1 ('MetaSel ('Just "dirty") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word32)) :*: (S1 ('MetaSel ('Just "alloc_limit") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int64) :*: (S1 ('MetaSel ('Just "tot_stack_size") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word32) :*: S1 ('MetaSel ('Just "prof") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe StgTSOProfInfo))))))) :+: C1 ('MetaCons "StackClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "stack_size") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word32))) :*: (S1 ('MetaSel ('Just "stack_dirty") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word8) :*: (S1 ('MetaSel ('Just "stack_marking") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word8) :*: S1 ('MetaSel ('Just "frames") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 s))))))) :+: ((C1 ('MetaCons "WeakClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: (S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs))) :*: S1 ('MetaSel ('Just "cfinalizers") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b))) :*: ((S1 ('MetaSel ('Just "key") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "value") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b)) :*: (S1 ('MetaSel ('Just "finalizer") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "mlink") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe b))))) :+: (C1 ('MetaCons "TVarClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "current_value") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: (S1 ('MetaSel ('Just "tvar_watch_queue") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "num_updates") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Int)))) :+: C1 ('MetaCons "TRecChunkClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "prev_chunk") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: (S1 ('MetaSel ('Just "next_idx") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word) :*: S1 ('MetaSel ('Just "entries") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [TRecEntry b])))))) :+: ((C1 ('MetaCons "MutPrimClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "ptrArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b]) :*: S1 ('MetaSel ('Just "dataArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Word]))) :+: C1 ('MetaCons "PrimClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "ptrArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b]) :*: S1 ('MetaSel ('Just "dataArgs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Word])))) :+: (C1 ('MetaCons "OtherClosure" 'PrefixI 'True) ((S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))) :*: (S1 ('MetaSel ('Just "hvalues") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [b]) :*: S1 ('MetaSel ('Just "rawWords") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Word]))) :+: C1 ('MetaCons "UnsupportedClosure" 'PrefixI 'True) (S1 ('MetaSel ('Just "info") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StgInfoTableWithPtr) :*: S1 ('MetaSel ('Just "profHeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ProfHeader ccs)))))))))

data DebugClosureWithExtra x ccs srt pap string s b #

Constructors

DCS 

Fields

Instances

Instances details
Hextraversable (DebugClosureWithExtra x) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

hextraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> (j -> f k) -> (l -> f n) -> DebugClosureWithExtra x a c e h j l -> f (DebugClosureWithExtra x b d g i k n) #

(Show x, Show ccs, Show string, Show srt, Show pap, Show s, Show b) => Show (DebugClosureWithExtra x ccs srt pap string s b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

showsPrec :: Int -> DebugClosureWithExtra x ccs srt pap string s b -> ShowS #

show :: DebugClosureWithExtra x ccs srt pap string s b -> String #

showList :: [DebugClosureWithExtra x ccs srt pap string s b] -> ShowS #

(Eq x, Eq ccs, Eq string, Eq srt, Eq pap, Eq s, Eq b) => Eq (DebugClosureWithExtra x ccs srt pap string s b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

(==) :: DebugClosureWithExtra x ccs srt pap string s b -> DebugClosureWithExtra x ccs srt pap string s b -> Bool #

(/=) :: DebugClosureWithExtra x ccs srt pap string s b -> DebugClosureWithExtra x ccs srt pap string s b -> Bool #

(Ord x, Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) => Ord (DebugClosureWithExtra x ccs srt pap string s b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

compare :: DebugClosureWithExtra x ccs srt pap string s b -> DebugClosureWithExtra x ccs srt pap string s b -> Ordering #

(<) :: DebugClosureWithExtra x ccs srt pap string s b -> DebugClosureWithExtra x ccs srt pap string s b -> Bool #

(<=) :: DebugClosureWithExtra x ccs srt pap string s b -> DebugClosureWithExtra x ccs srt pap string s b -> Bool #

(>) :: DebugClosureWithExtra x ccs srt pap string s b -> DebugClosureWithExtra x ccs srt pap string s b -> Bool #

(>=) :: DebugClosureWithExtra x ccs srt pap string s b -> DebugClosureWithExtra x ccs srt pap string s b -> Bool #

max :: DebugClosureWithExtra x ccs srt pap string s b -> DebugClosureWithExtra x ccs srt pap string s b -> DebugClosureWithExtra x ccs srt pap string s b #

min :: DebugClosureWithExtra x ccs srt pap string s b -> DebugClosureWithExtra x ccs srt pap string s b -> DebugClosureWithExtra x ccs srt pap string s b #

data DebugStackFrame srt b #

Constructors

DebugStackFrame 

Instances

Instances details
Bifoldable DebugStackFrame # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

bifold :: Monoid m => DebugStackFrame m m -> m #

bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> DebugStackFrame a b -> m #

bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> DebugStackFrame a b -> c #

bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> DebugStackFrame a b -> c #

Bifunctor DebugStackFrame # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

bimap :: (a -> b) -> (c -> d) -> DebugStackFrame a c -> DebugStackFrame b d #

first :: (a -> b) -> DebugStackFrame a c -> DebugStackFrame b c #

second :: (b -> c) -> DebugStackFrame a b -> DebugStackFrame a c #

Bitraversable DebugStackFrame # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> DebugStackFrame a b -> f (DebugStackFrame c d) #

Functor (DebugStackFrame srt) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fmap :: (a -> b) -> DebugStackFrame srt a -> DebugStackFrame srt b #

(<$) :: a -> DebugStackFrame srt b -> DebugStackFrame srt a #

Foldable (DebugStackFrame srt) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fold :: Monoid m => DebugStackFrame srt m -> m #

foldMap :: Monoid m => (a -> m) -> DebugStackFrame srt a -> m #

foldMap' :: Monoid m => (a -> m) -> DebugStackFrame srt a -> m #

foldr :: (a -> b -> b) -> b -> DebugStackFrame srt a -> b #

foldr' :: (a -> b -> b) -> b -> DebugStackFrame srt a -> b #

foldl :: (b -> a -> b) -> b -> DebugStackFrame srt a -> b #

foldl' :: (b -> a -> b) -> b -> DebugStackFrame srt a -> b #

foldr1 :: (a -> a -> a) -> DebugStackFrame srt a -> a #

foldl1 :: (a -> a -> a) -> DebugStackFrame srt a -> a #

toList :: DebugStackFrame srt a -> [a] #

null :: DebugStackFrame srt a -> Bool #

length :: DebugStackFrame srt a -> Int #

elem :: Eq a => a -> DebugStackFrame srt a -> Bool #

maximum :: Ord a => DebugStackFrame srt a -> a #

minimum :: Ord a => DebugStackFrame srt a -> a #

sum :: Num a => DebugStackFrame srt a -> a #

product :: Num a => DebugStackFrame srt a -> a #

Traversable (DebugStackFrame srt) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

traverse :: Applicative f => (a -> f b) -> DebugStackFrame srt a -> f (DebugStackFrame srt b) #

sequenceA :: Applicative f => DebugStackFrame srt (f a) -> f (DebugStackFrame srt a) #

mapM :: Monad m => (a -> m b) -> DebugStackFrame srt a -> m (DebugStackFrame srt b) #

sequence :: Monad m => DebugStackFrame srt (m a) -> m (DebugStackFrame srt a) #

(Show srt, Show b) => Show (DebugStackFrame srt b) # 
Instance details

Defined in GHC.Debug.Types.Closures

(Eq srt, Eq b) => Eq (DebugStackFrame srt b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

(==) :: DebugStackFrame srt b -> DebugStackFrame srt b -> Bool #

(/=) :: DebugStackFrame srt b -> DebugStackFrame srt b -> Bool #

(Ord srt, Ord b) => Ord (DebugStackFrame srt b) # 
Instance details

Defined in GHC.Debug.Types.Closures

data FieldValue b #

Constructors

SPtr b 
SNonPtr !Word64 

Instances

Instances details
Functor FieldValue # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fmap :: (a -> b) -> FieldValue a -> FieldValue b #

(<$) :: a -> FieldValue b -> FieldValue a #

Foldable FieldValue # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fold :: Monoid m => FieldValue m -> m #

foldMap :: Monoid m => (a -> m) -> FieldValue a -> m #

foldMap' :: Monoid m => (a -> m) -> FieldValue a -> m #

foldr :: (a -> b -> b) -> b -> FieldValue a -> b #

foldr' :: (a -> b -> b) -> b -> FieldValue a -> b #

foldl :: (b -> a -> b) -> b -> FieldValue a -> b #

foldl' :: (b -> a -> b) -> b -> FieldValue a -> b #

foldr1 :: (a -> a -> a) -> FieldValue a -> a #

foldl1 :: (a -> a -> a) -> FieldValue a -> a #

toList :: FieldValue a -> [a] #

null :: FieldValue a -> Bool #

length :: FieldValue a -> Int #

elem :: Eq a => a -> FieldValue a -> Bool #

maximum :: Ord a => FieldValue a -> a #

minimum :: Ord a => FieldValue a -> a #

sum :: Num a => FieldValue a -> a #

product :: Num a => FieldValue a -> a #

Traversable FieldValue # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

traverse :: Applicative f => (a -> f b) -> FieldValue a -> f (FieldValue b) #

sequenceA :: Applicative f => FieldValue (f a) -> f (FieldValue a) #

mapM :: Monad m => (a -> m b) -> FieldValue a -> m (FieldValue b) #

sequence :: Monad m => FieldValue (m a) -> m (FieldValue a) #

Show b => Show (FieldValue b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Eq b => Eq (FieldValue b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

(==) :: FieldValue b -> FieldValue b -> Bool #

(/=) :: FieldValue b -> FieldValue b -> Bool #

Ord b => Ord (FieldValue b) # 
Instance details

Defined in GHC.Debug.Types.Closures

data GenCCSPayload ccsPtr ccPtr #

Instances

Instances details
Bifoldable GenCCSPayload # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

bifold :: Monoid m => GenCCSPayload m m -> m #

bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> GenCCSPayload a b -> m #

bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> GenCCSPayload a b -> c #

bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> GenCCSPayload a b -> c #

Bifunctor GenCCSPayload # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

bimap :: (a -> b) -> (c -> d) -> GenCCSPayload a c -> GenCCSPayload b d #

first :: (a -> b) -> GenCCSPayload a c -> GenCCSPayload b c #

second :: (b -> c) -> GenCCSPayload a b -> GenCCSPayload a c #

Bitraversable GenCCSPayload # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> GenCCSPayload a b -> f (GenCCSPayload c d) #

Functor (GenCCSPayload ccsPtr) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fmap :: (a -> b) -> GenCCSPayload ccsPtr a -> GenCCSPayload ccsPtr b #

(<$) :: a -> GenCCSPayload ccsPtr b -> GenCCSPayload ccsPtr a #

(Show ccPtr, Show ccsPtr) => Show (GenCCSPayload ccsPtr ccPtr) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

showsPrec :: Int -> GenCCSPayload ccsPtr ccPtr -> ShowS #

show :: GenCCSPayload ccsPtr ccPtr -> String #

showList :: [GenCCSPayload ccsPtr ccPtr] -> ShowS #

(Eq ccPtr, Eq ccsPtr) => Eq (GenCCSPayload ccsPtr ccPtr) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

(==) :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool #

(/=) :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool #

(Ord ccPtr, Ord ccsPtr) => Ord (GenCCSPayload ccsPtr ccPtr) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

compare :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Ordering #

(<) :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool #

(<=) :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool #

(>) :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool #

(>=) :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool #

max :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr #

min :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr #

newtype GenPapPayload b #

Constructors

GenPapPayload 

Fields

Instances

Instances details
Functor GenPapPayload # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fmap :: (a -> b) -> GenPapPayload a -> GenPapPayload b #

(<$) :: a -> GenPapPayload b -> GenPapPayload a #

Foldable GenPapPayload # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fold :: Monoid m => GenPapPayload m -> m #

foldMap :: Monoid m => (a -> m) -> GenPapPayload a -> m #

foldMap' :: Monoid m => (a -> m) -> GenPapPayload a -> m #

foldr :: (a -> b -> b) -> b -> GenPapPayload a -> b #

foldr' :: (a -> b -> b) -> b -> GenPapPayload a -> b #

foldl :: (b -> a -> b) -> b -> GenPapPayload a -> b #

foldl' :: (b -> a -> b) -> b -> GenPapPayload a -> b #

foldr1 :: (a -> a -> a) -> GenPapPayload a -> a #

foldl1 :: (a -> a -> a) -> GenPapPayload a -> a #

toList :: GenPapPayload a -> [a] #

null :: GenPapPayload a -> Bool #

length :: GenPapPayload a -> Int #

elem :: Eq a => a -> GenPapPayload a -> Bool #

maximum :: Ord a => GenPapPayload a -> a #

minimum :: Ord a => GenPapPayload a -> a #

sum :: Num a => GenPapPayload a -> a #

product :: Num a => GenPapPayload a -> a #

Traversable GenPapPayload # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

traverse :: Applicative f => (a -> f b) -> GenPapPayload a -> f (GenPapPayload b) #

sequenceA :: Applicative f => GenPapPayload (f a) -> f (GenPapPayload a) #

mapM :: Monad m => (a -> m b) -> GenPapPayload a -> m (GenPapPayload b) #

sequence :: Monad m => GenPapPayload (m a) -> m (GenPapPayload a) #

Show b => Show (GenPapPayload b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Eq b => Eq (GenPapPayload b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Ord b => Ord (GenPapPayload b) # 
Instance details

Defined in GHC.Debug.Types.Closures

newtype GenSrtPayload b #

Constructors

GenSrtPayload 

Fields

Instances

Instances details
Functor GenSrtPayload # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fmap :: (a -> b) -> GenSrtPayload a -> GenSrtPayload b #

(<$) :: a -> GenSrtPayload b -> GenSrtPayload a #

Foldable GenSrtPayload # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fold :: Monoid m => GenSrtPayload m -> m #

foldMap :: Monoid m => (a -> m) -> GenSrtPayload a -> m #

foldMap' :: Monoid m => (a -> m) -> GenSrtPayload a -> m #

foldr :: (a -> b -> b) -> b -> GenSrtPayload a -> b #

foldr' :: (a -> b -> b) -> b -> GenSrtPayload a -> b #

foldl :: (b -> a -> b) -> b -> GenSrtPayload a -> b #

foldl' :: (b -> a -> b) -> b -> GenSrtPayload a -> b #

foldr1 :: (a -> a -> a) -> GenSrtPayload a -> a #

foldl1 :: (a -> a -> a) -> GenSrtPayload a -> a #

toList :: GenSrtPayload a -> [a] #

null :: GenSrtPayload a -> Bool #

length :: GenSrtPayload a -> Int #

elem :: Eq a => a -> GenSrtPayload a -> Bool #

maximum :: Ord a => GenSrtPayload a -> a #

minimum :: Ord a => GenSrtPayload a -> a #

sum :: Num a => GenSrtPayload a -> a #

product :: Num a => GenSrtPayload a -> a #

Traversable GenSrtPayload # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

traverse :: Applicative f => (a -> f b) -> GenSrtPayload a -> f (GenSrtPayload b) #

sequenceA :: Applicative f => GenSrtPayload (f a) -> f (GenSrtPayload a) #

mapM :: Monad m => (a -> m b) -> GenSrtPayload a -> m (GenSrtPayload b) #

sequence :: Monad m => GenSrtPayload (m a) -> m (GenSrtPayload a) #

Show b => Show (GenSrtPayload b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Eq b => Eq (GenSrtPayload b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Ord b => Ord (GenSrtPayload b) # 
Instance details

Defined in GHC.Debug.Types.Closures

newtype GenStackFrames srt b #

Constructors

GenStackFrames 

Fields

Instances

Instances details
Bifoldable GenStackFrames # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

bifold :: Monoid m => GenStackFrames m m -> m #

bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> GenStackFrames a b -> m #

bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> GenStackFrames a b -> c #

bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> GenStackFrames a b -> c #

Bifunctor GenStackFrames # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

bimap :: (a -> b) -> (c -> d) -> GenStackFrames a c -> GenStackFrames b d #

first :: (a -> b) -> GenStackFrames a c -> GenStackFrames b c #

second :: (b -> c) -> GenStackFrames a b -> GenStackFrames a c #

Bitraversable GenStackFrames # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> GenStackFrames a b -> f (GenStackFrames c d) #

Functor (GenStackFrames srt) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fmap :: (a -> b) -> GenStackFrames srt a -> GenStackFrames srt b #

(<$) :: a -> GenStackFrames srt b -> GenStackFrames srt a #

Foldable (GenStackFrames srt) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fold :: Monoid m => GenStackFrames srt m -> m #

foldMap :: Monoid m => (a -> m) -> GenStackFrames srt a -> m #

foldMap' :: Monoid m => (a -> m) -> GenStackFrames srt a -> m #

foldr :: (a -> b -> b) -> b -> GenStackFrames srt a -> b #

foldr' :: (a -> b -> b) -> b -> GenStackFrames srt a -> b #

foldl :: (b -> a -> b) -> b -> GenStackFrames srt a -> b #

foldl' :: (b -> a -> b) -> b -> GenStackFrames srt a -> b #

foldr1 :: (a -> a -> a) -> GenStackFrames srt a -> a #

foldl1 :: (a -> a -> a) -> GenStackFrames srt a -> a #

toList :: GenStackFrames srt a -> [a] #

null :: GenStackFrames srt a -> Bool #

length :: GenStackFrames srt a -> Int #

elem :: Eq a => a -> GenStackFrames srt a -> Bool #

maximum :: Ord a => GenStackFrames srt a -> a #

minimum :: Ord a => GenStackFrames srt a -> a #

sum :: Num a => GenStackFrames srt a -> a #

product :: Num a => GenStackFrames srt a -> a #

Traversable (GenStackFrames srt) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

traverse :: Applicative f => (a -> f b) -> GenStackFrames srt a -> f (GenStackFrames srt b) #

sequenceA :: Applicative f => GenStackFrames srt (f a) -> f (GenStackFrames srt a) #

mapM :: Monad m => (a -> m b) -> GenStackFrames srt a -> m (GenStackFrames srt b) #

sequence :: Monad m => GenStackFrames srt (m a) -> m (GenStackFrames srt a) #

(Show srt, Show b) => Show (GenStackFrames srt b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

showsPrec :: Int -> GenStackFrames srt b -> ShowS #

show :: GenStackFrames srt b -> String #

showList :: [GenStackFrames srt b] -> ShowS #

(Eq srt, Eq b) => Eq (GenStackFrames srt b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

(==) :: GenStackFrames srt b -> GenStackFrames srt b -> Bool #

(/=) :: GenStackFrames srt b -> GenStackFrames srt b -> Bool #

(Ord srt, Ord b) => Ord (GenStackFrames srt b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

compare :: GenStackFrames srt b -> GenStackFrames srt b -> Ordering #

(<) :: GenStackFrames srt b -> GenStackFrames srt b -> Bool #

(<=) :: GenStackFrames srt b -> GenStackFrames srt b -> Bool #

(>) :: GenStackFrames srt b -> GenStackFrames srt b -> Bool #

(>=) :: GenStackFrames srt b -> GenStackFrames srt b -> Bool #

max :: GenStackFrames srt b -> GenStackFrames srt b -> GenStackFrames srt b #

min :: GenStackFrames srt b -> GenStackFrames srt b -> GenStackFrames srt b #

class Hextraversable (m :: Type -> Type -> Type -> Type -> Type -> Type -> Type) where #

Methods

hextraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> (j -> f k) -> (l -> f n) -> m a c e h j l -> f (m b d g i k n) #

Instances

Instances details
Hextraversable DebugClosure # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

hextraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> (j -> f k) -> (l -> f n) -> DebugClosure a c e h j l -> f (DebugClosure b d g i k n) #

Hextraversable (DebugClosureWithExtra x) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

hextraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> (j -> f k) -> (l -> f n) -> DebugClosureWithExtra x a c e h j l -> f (DebugClosureWithExtra x b d g i k n) #

newtype InclusiveSize #

Constructors

InclusiveSize 

Instances

Instances details
Monoid InclusiveSize # 
Instance details

Defined in GHC.Debug.Types.Closures

Semigroup InclusiveSize # 
Instance details

Defined in GHC.Debug.Types.Closures

Generic InclusiveSize # 
Instance details

Defined in GHC.Debug.Types.Closures

Associated Types

type Rep InclusiveSize 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep InclusiveSize = D1 ('MetaData "InclusiveSize" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'True) (C1 ('MetaCons "InclusiveSize" 'PrefixI 'True) (S1 ('MetaSel ('Just "getInclusiveSize") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)))
Show InclusiveSize # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep InclusiveSize # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep InclusiveSize = D1 ('MetaData "InclusiveSize" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'True) (C1 ('MetaCons "InclusiveSize" 'PrefixI 'True) (S1 ('MetaSel ('Just "getInclusiveSize") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)))

data PayloadCont #

Constructors

PayloadCont ClosurePtr [Word64] 

Instances

Instances details
Show PayloadCont # 
Instance details

Defined in GHC.Debug.Types.Closures

Eq PayloadCont # 
Instance details

Defined in GHC.Debug.Types.Closures

data ProfHeader a #

Constructors

ProfHeader 

Fields

Instances

Instances details
Functor ProfHeader # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fmap :: (a -> b) -> ProfHeader a -> ProfHeader b #

(<$) :: a -> ProfHeader b -> ProfHeader a #

Foldable ProfHeader # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fold :: Monoid m => ProfHeader m -> m #

foldMap :: Monoid m => (a -> m) -> ProfHeader a -> m #

foldMap' :: Monoid m => (a -> m) -> ProfHeader a -> m #

foldr :: (a -> b -> b) -> b -> ProfHeader a -> b #

foldr' :: (a -> b -> b) -> b -> ProfHeader a -> b #

foldl :: (b -> a -> b) -> b -> ProfHeader a -> b #

foldl' :: (b -> a -> b) -> b -> ProfHeader a -> b #

foldr1 :: (a -> a -> a) -> ProfHeader a -> a #

foldl1 :: (a -> a -> a) -> ProfHeader a -> a #

toList :: ProfHeader a -> [a] #

null :: ProfHeader a -> Bool #

length :: ProfHeader a -> Int #

elem :: Eq a => a -> ProfHeader a -> Bool #

maximum :: Ord a => ProfHeader a -> a #

minimum :: Ord a => ProfHeader a -> a #

sum :: Num a => ProfHeader a -> a #

product :: Num a => ProfHeader a -> a #

Traversable ProfHeader # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

traverse :: Applicative f => (a -> f b) -> ProfHeader a -> f (ProfHeader b) #

sequenceA :: Applicative f => ProfHeader (f a) -> f (ProfHeader a) #

mapM :: Monad m => (a -> m b) -> ProfHeader a -> m (ProfHeader b) #

sequence :: Monad m => ProfHeader (m a) -> m (ProfHeader a) #

Show a => Show (ProfHeader a) # 
Instance details

Defined in GHC.Debug.Types.Closures

Eq a => Eq (ProfHeader a) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

(==) :: ProfHeader a -> ProfHeader a -> Bool #

(/=) :: ProfHeader a -> ProfHeader a -> Bool #

Ord a => Ord (ProfHeader a) # 
Instance details

Defined in GHC.Debug.Types.Closures

newtype RetainerSize #

Constructors

RetainerSize 

Fields

Instances

Instances details
Monoid RetainerSize # 
Instance details

Defined in GHC.Debug.Types.Closures

Semigroup RetainerSize # 
Instance details

Defined in GHC.Debug.Types.Closures

Generic RetainerSize # 
Instance details

Defined in GHC.Debug.Types.Closures

Associated Types

type Rep RetainerSize 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep RetainerSize = D1 ('MetaData "RetainerSize" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'True) (C1 ('MetaCons "RetainerSize" 'PrefixI 'True) (S1 ('MetaSel ('Just "getRetainerSize") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)))
Show RetainerSize # 
Instance details

Defined in GHC.Debug.Types.Closures

Eq RetainerSize # 
Instance details

Defined in GHC.Debug.Types.Closures

Ord RetainerSize # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep RetainerSize # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep RetainerSize = D1 ('MetaData "RetainerSize" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'True) (C1 ('MetaCons "RetainerSize" 'PrefixI 'True) (S1 ('MetaSel ('Just "getRetainerSize") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)))

newtype Size #

Constructors

Size 

Fields

Instances

Instances details
Monoid Size # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

mempty :: Size #

mappend :: Size -> Size -> Size #

mconcat :: [Size] -> Size #

Semigroup Size # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

(<>) :: Size -> Size -> Size #

sconcat :: NonEmpty Size -> Size #

stimes :: Integral b => b -> Size -> Size #

Generic Size # 
Instance details

Defined in GHC.Debug.Types.Closures

Associated Types

type Rep Size 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep Size = D1 ('MetaData "Size" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'True) (C1 ('MetaCons "Size" 'PrefixI 'True) (S1 ('MetaSel ('Just "getSize") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)))

Methods

from :: Size -> Rep Size x #

to :: Rep Size x -> Size #

Num Size # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

(+) :: Size -> Size -> Size #

(-) :: Size -> Size -> Size #

(*) :: Size -> Size -> Size #

negate :: Size -> Size #

abs :: Size -> Size #

signum :: Size -> Size #

fromInteger :: Integer -> Size #

Read Size # 
Instance details

Defined in GHC.Debug.Types.Closures

Show Size # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

showsPrec :: Int -> Size -> ShowS #

show :: Size -> String #

showList :: [Size] -> ShowS #

Eq Size # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

(==) :: Size -> Size -> Bool #

(/=) :: Size -> Size -> Bool #

Ord Size # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

compare :: Size -> Size -> Ordering #

(<) :: Size -> Size -> Bool #

(<=) :: Size -> Size -> Bool #

(>) :: Size -> Size -> Bool #

(>=) :: Size -> Size -> Bool #

max :: Size -> Size -> Size #

min :: Size -> Size -> Size #

type Rep Size # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep Size = D1 ('MetaData "Size" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'True) (C1 ('MetaCons "Size" 'PrefixI 'True) (S1 ('MetaSel ('Just "getSize") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)))

data StackCont #

Constructors

StackCont StackPtr RawStack 

Instances

Instances details
Show StackCont # 
Instance details

Defined in GHC.Debug.Types.Closures

Eq StackCont # 
Instance details

Defined in GHC.Debug.Types.Closures

Ord StackCont # 
Instance details

Defined in GHC.Debug.Types.Closures

data StgInfoTable #

Constructors

StgInfoTable 

Fields

Instances

Instances details
Generic StgInfoTable # 
Instance details

Defined in GHC.Debug.Types.Closures

Associated Types

type Rep StgInfoTable 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep StgInfoTable = D1 ('MetaData "StgInfoTable" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'False) (C1 ('MetaCons "StgInfoTable" 'PrefixI 'True) ((S1 ('MetaSel ('Just "ptrs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HalfWord) :*: S1 ('MetaSel ('Just "nptrs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HalfWord)) :*: (S1 ('MetaSel ('Just "tipe") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ClosureType) :*: S1 ('MetaSel ('Just "srtlen") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HalfWord))))
Show StgInfoTable # 
Instance details

Defined in GHC.Debug.Types.Closures

Eq StgInfoTable # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep StgInfoTable # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep StgInfoTable = D1 ('MetaData "StgInfoTable" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'False) (C1 ('MetaCons "StgInfoTable" 'PrefixI 'True) ((S1 ('MetaSel ('Just "ptrs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HalfWord) :*: S1 ('MetaSel ('Just "nptrs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HalfWord)) :*: (S1 ('MetaSel ('Just "tipe") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ClosureType) :*: S1 ('MetaSel ('Just "srtlen") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HalfWord))))

data TRecEntry b #

Constructors

TRecEntry 

Fields

Instances

Instances details
Functor TRecEntry # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fmap :: (a -> b) -> TRecEntry a -> TRecEntry b #

(<$) :: a -> TRecEntry b -> TRecEntry a #

Foldable TRecEntry # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

fold :: Monoid m => TRecEntry m -> m #

foldMap :: Monoid m => (a -> m) -> TRecEntry a -> m #

foldMap' :: Monoid m => (a -> m) -> TRecEntry a -> m #

foldr :: (a -> b -> b) -> b -> TRecEntry a -> b #

foldr' :: (a -> b -> b) -> b -> TRecEntry a -> b #

foldl :: (b -> a -> b) -> b -> TRecEntry a -> b #

foldl' :: (b -> a -> b) -> b -> TRecEntry a -> b #

foldr1 :: (a -> a -> a) -> TRecEntry a -> a #

foldl1 :: (a -> a -> a) -> TRecEntry a -> a #

toList :: TRecEntry a -> [a] #

null :: TRecEntry a -> Bool #

length :: TRecEntry a -> Int #

elem :: Eq a => a -> TRecEntry a -> Bool #

maximum :: Ord a => TRecEntry a -> a #

minimum :: Ord a => TRecEntry a -> a #

sum :: Num a => TRecEntry a -> a #

product :: Num a => TRecEntry a -> a #

Traversable TRecEntry # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

traverse :: Applicative f => (a -> f b) -> TRecEntry a -> f (TRecEntry b) #

sequenceA :: Applicative f => TRecEntry (f a) -> f (TRecEntry a) #

mapM :: Monad m => (a -> m b) -> TRecEntry a -> m (TRecEntry b) #

sequence :: Monad m => TRecEntry (m a) -> m (TRecEntry a) #

Generic (TRecEntry b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Associated Types

type Rep (TRecEntry b) 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep (TRecEntry b) = D1 ('MetaData "TRecEntry" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'False) (C1 ('MetaCons "TRecEntry" 'PrefixI 'True) ((S1 ('MetaSel ('Just "tvar") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "expected_value") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b)) :*: (S1 ('MetaSel ('Just "new_value") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "trec_num_updates") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int))))

Methods

from :: TRecEntry b -> Rep (TRecEntry b) x #

to :: Rep (TRecEntry b) x -> TRecEntry b #

Show b => Show (TRecEntry b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Eq b => Eq (TRecEntry b) # 
Instance details

Defined in GHC.Debug.Types.Closures

Methods

(==) :: TRecEntry b -> TRecEntry b -> Bool #

(/=) :: TRecEntry b -> TRecEntry b -> Bool #

Ord b => Ord (TRecEntry b) # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep (TRecEntry b) # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep (TRecEntry b) = D1 ('MetaData "TRecEntry" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'False) (C1 ('MetaCons "TRecEntry" 'PrefixI 'True) ((S1 ('MetaSel ('Just "tvar") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "expected_value") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b)) :*: (S1 ('MetaSel ('Just "new_value") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "trec_num_updates") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int))))

data TsoFlags #

Instances

Instances details
Generic TsoFlags # 
Instance details

Defined in GHC.Debug.Types.Closures

Associated Types

type Rep TsoFlags 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep TsoFlags = D1 ('MetaData "TsoFlags" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'False) (((C1 ('MetaCons "TsoLocked" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TsoBlockx" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "TsoInterruptible" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TsoStoppedOnBreakpoint" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "TsoMarked" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TsoSqueezed" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "TsoAllocLimit" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TsoFlagsUnknownValue" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word32)))))

Methods

from :: TsoFlags -> Rep TsoFlags x #

to :: Rep TsoFlags x -> TsoFlags #

Show TsoFlags # 
Instance details

Defined in GHC.Debug.Types.Closures

Eq TsoFlags # 
Instance details

Defined in GHC.Debug.Types.Closures

Ord TsoFlags # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep TsoFlags # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep TsoFlags = D1 ('MetaData "TsoFlags" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'False) (((C1 ('MetaCons "TsoLocked" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TsoBlockx" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "TsoInterruptible" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TsoStoppedOnBreakpoint" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "TsoMarked" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TsoSqueezed" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "TsoAllocLimit" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TsoFlagsUnknownValue" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word32)))))

data WhatNext #

Instances

Instances details
Generic WhatNext # 
Instance details

Defined in GHC.Debug.Types.Closures

Associated Types

type Rep WhatNext 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep WhatNext = D1 ('MetaData "WhatNext" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'False) ((C1 ('MetaCons "ThreadRunGHC" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ThreadInterpret" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "ThreadKilled" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "ThreadComplete" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "WhatNextUnknownValue" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word16)))))

Methods

from :: WhatNext -> Rep WhatNext x #

to :: Rep WhatNext x -> WhatNext #

Show WhatNext # 
Instance details

Defined in GHC.Debug.Types.Closures

Eq WhatNext # 
Instance details

Defined in GHC.Debug.Types.Closures

Ord WhatNext # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep WhatNext # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep WhatNext = D1 ('MetaData "WhatNext" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'False) ((C1 ('MetaCons "ThreadRunGHC" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ThreadInterpret" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "ThreadKilled" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "ThreadComplete" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "WhatNextUnknownValue" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word16)))))

data WhyBlocked #

Instances

Instances details
Generic WhyBlocked # 
Instance details

Defined in GHC.Debug.Types.Closures

Associated Types

type Rep WhyBlocked 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep WhyBlocked = D1 ('MetaData "WhyBlocked" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'False) (((C1 ('MetaCons "NotBlocked" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "BlockedOnMVar" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BlockedOnMVarRead" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "BlockedOnBlackHole" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BlockedOnRead" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "BlockedOnWrite" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BlockedOnDelay" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "BlockedOnSTM" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "BlockedOnDoProc" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BlockedOnCCall" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "BlockedOnCCall_Interruptible" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BlockedOnMsgThrowTo" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "ThreadMigrating" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "WhyBlockedUnknownValue" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word32))))))
Show WhyBlocked # 
Instance details

Defined in GHC.Debug.Types.Closures

Eq WhyBlocked # 
Instance details

Defined in GHC.Debug.Types.Closures

Ord WhyBlocked # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep WhyBlocked # 
Instance details

Defined in GHC.Debug.Types.Closures

type Rep WhyBlocked = D1 ('MetaData "WhyBlocked" "GHC.Debug.Types.Closures" "ghc-debug-common-0.7.0.0-inplace" 'False) (((C1 ('MetaCons "NotBlocked" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "BlockedOnMVar" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BlockedOnMVarRead" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "BlockedOnBlackHole" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BlockedOnRead" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "BlockedOnWrite" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BlockedOnDelay" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "BlockedOnSTM" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "BlockedOnDoProc" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BlockedOnCCall" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "BlockedOnCCall_Interruptible" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BlockedOnMsgThrowTo" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "ThreadMigrating" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "WhyBlockedUnknownValue" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word32))))))

data RawBlock #

Instances

Instances details
Binary RawBlock # 
Instance details

Defined in GHC.Debug.Types.Ptr

Methods

put :: RawBlock -> Put #

get :: Get RawBlock #

putList :: [RawBlock] -> Put #

Show RawBlock # 
Instance details

Defined in GHC.Debug.Types.Ptr

data BlockPtr #

Instances

Instances details
Binary BlockPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Methods

put :: BlockPtr -> Put #

get :: Get BlockPtr #

putList :: [BlockPtr] -> Put #

Show BlockPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Eq BlockPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Ord BlockPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Hashable BlockPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Methods

hashWithSalt :: Int -> BlockPtr -> Int #

hash :: BlockPtr -> Int #

data StackPtr #

Instances

Instances details
Binary StackPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Methods

put :: StackPtr -> Put #

get :: Get StackPtr #

putList :: [StackPtr] -> Put #

Show StackPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Eq StackPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Ord StackPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Hashable StackPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Methods

hashWithSalt :: Int -> StackPtr -> Int #

hash :: StackPtr -> Int #

data ClosurePtr #

Instances

Instances details
Binary ClosurePtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Show ClosurePtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Eq ClosurePtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Ord ClosurePtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Hashable ClosurePtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

data CCPtr #

Instances

Instances details
Binary CCPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Methods

put :: CCPtr -> Put #

get :: Get CCPtr #

putList :: [CCPtr] -> Put #

Show CCPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Methods

showsPrec :: Int -> CCPtr -> ShowS #

show :: CCPtr -> String #

showList :: [CCPtr] -> ShowS #

Eq CCPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Methods

(==) :: CCPtr -> CCPtr -> Bool #

(/=) :: CCPtr -> CCPtr -> Bool #

Ord CCPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Methods

compare :: CCPtr -> CCPtr -> Ordering #

(<) :: CCPtr -> CCPtr -> Bool #

(<=) :: CCPtr -> CCPtr -> Bool #

(>) :: CCPtr -> CCPtr -> Bool #

(>=) :: CCPtr -> CCPtr -> Bool #

max :: CCPtr -> CCPtr -> CCPtr #

min :: CCPtr -> CCPtr -> CCPtr #

Hashable CCPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Methods

hashWithSalt :: Int -> CCPtr -> Int #

hash :: CCPtr -> Int #

data CCSPtr #

Instances

Instances details
Binary CCSPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Methods

put :: CCSPtr -> Put #

get :: Get CCSPtr #

putList :: [CCSPtr] -> Put #

Show CCSPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Eq CCSPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Methods

(==) :: CCSPtr -> CCSPtr -> Bool #

(/=) :: CCSPtr -> CCSPtr -> Bool #

Ord CCSPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Hashable CCSPtr # 
Instance details

Defined in GHC.Debug.Types.Ptr

Methods

hashWithSalt :: Int -> CCSPtr -> Int #

hash :: CCSPtr -> Int #