Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
The Haskell representation of a heap closure, the DebugClosure
type
- is quite similar to the one found in the ghc-heap
package but with some
- more type parameters and other changes..
Synopsis
- type Closure = DebugClosure PayloadCont ConstrDescCont StackCont ClosurePtr
- type SizedClosure = DebugClosureWithSize PayloadCont ConstrDescCont StackCont ClosurePtr
- type SizedClosureC = DebugClosureWithSize PayloadCont ConstrDesc StackCont ClosurePtr
- data DebugClosure pap string s b
- = ConstrClosure {
- info :: !StgInfoTableWithPtr
- ptrArgs :: ![b]
- dataArgs :: ![Word]
- constrDesc :: !string
- | FunClosure {
- info :: !StgInfoTableWithPtr
- ptrArgs :: ![b]
- dataArgs :: ![Word]
- | ThunkClosure {
- info :: !StgInfoTableWithPtr
- ptrArgs :: ![b]
- dataArgs :: ![Word]
- | SelectorClosure {
- info :: !StgInfoTableWithPtr
- selectee :: !b
- | PAPClosure {
- info :: !StgInfoTableWithPtr
- arity :: !HalfWord
- n_args :: !HalfWord
- fun :: !b
- pap_payload :: !pap
- | APClosure {
- info :: !StgInfoTableWithPtr
- arity :: !HalfWord
- n_args :: !HalfWord
- fun :: !b
- ap_payload :: !pap
- | APStackClosure {
- info :: !StgInfoTableWithPtr
- ap_st_size :: !Word
- fun :: !b
- payload :: !s
- | IndClosure {
- info :: !StgInfoTableWithPtr
- indirectee :: !b
- | BCOClosure { }
- | BlackholeClosure {
- info :: !StgInfoTableWithPtr
- indirectee :: !b
- | ArrWordsClosure { }
- | MutArrClosure {
- info :: !StgInfoTableWithPtr
- mccPtrs :: !Word
- mccSize :: !Word
- mccPayload :: ![b]
- | SmallMutArrClosure {
- info :: !StgInfoTableWithPtr
- mccPtrs :: !Word
- mccPayload :: ![b]
- | MVarClosure {
- info :: !StgInfoTableWithPtr
- queueHead :: !b
- queueTail :: !b
- value :: !b
- | MutVarClosure {
- info :: !StgInfoTableWithPtr
- var :: !b
- | BlockingQueueClosure { }
- | TSOClosure {
- info :: !StgInfoTableWithPtr
- _link :: !b
- global_link :: !b
- tsoStack :: !b
- trec :: !b
- blocked_exceptions :: !b
- bq :: !b
- what_next :: WhatNext
- why_blocked :: WhyBlocked
- flags :: [TsoFlags]
- threadId :: Word64
- saved_errno :: Word32
- dirty :: Word32
- alloc_limit :: Int64
- tot_stack_size :: Word32
- prof :: Maybe StgTSOProfInfo
- | StackClosure {
- info :: !StgInfoTableWithPtr
- stack_size :: !Word32
- stack_dirty :: !Word8
- stack_marking :: !Word8
- frames :: s
- | WeakClosure {
- info :: !StgInfoTableWithPtr
- cfinalizers :: !b
- key :: !b
- value :: !b
- finalizer :: !b
- mlink :: !(Maybe b)
- | TVarClosure {
- info :: !StgInfoTableWithPtr
- current_value :: !b
- tvar_watch_queue :: !b
- num_updates :: !Int
- | TRecChunkClosure {
- info :: !StgInfoTableWithPtr
- prev_chunk :: !b
- next_idx :: !Word
- entries :: ![TRecEntry b]
- | MutPrimClosure {
- info :: !StgInfoTableWithPtr
- ptrArgs :: ![b]
- dataArgs :: ![Word]
- | OtherClosure {
- info :: !StgInfoTableWithPtr
- hvalues :: ![b]
- rawWords :: ![Word]
- | UnsupportedClosure { }
- = ConstrClosure {
- data TRecEntry b = TRecEntry {
- tvar :: !b
- expected_value :: !b
- new_value :: !b
- trec_num_updates :: Int
- type DebugClosureWithSize = DebugClosureWithExtra Size
- data DebugClosureWithExtra x pap string s b = DCS {
- extraDCS :: x
- unDCS :: DebugClosure pap string s b
- newtype Size = Size {}
- newtype InclusiveSize = InclusiveSize {}
- newtype RetainerSize = RetainerSize {}
- noSize :: DebugClosureWithSize pap string s b -> DebugClosure pap string s b
- dcSize :: DebugClosureWithSize pap string s b -> Size
- allClosures :: DebugClosure (GenPapPayload c) a (GenStackFrames c) c -> [c]
- data StgInfoTable = StgInfoTable {}
- data ClosureType
- = INVALID_OBJECT
- | CONSTR
- | CONSTR_1_0
- | CONSTR_0_1
- | CONSTR_2_0
- | CONSTR_1_1
- | CONSTR_0_2
- | CONSTR_NOCAF
- | FUN
- | FUN_1_0
- | FUN_0_1
- | FUN_2_0
- | FUN_1_1
- | FUN_0_2
- | FUN_STATIC
- | THUNK
- | THUNK_1_0
- | THUNK_0_1
- | THUNK_2_0
- | THUNK_1_1
- | THUNK_0_2
- | THUNK_STATIC
- | THUNK_SELECTOR
- | BCO
- | AP
- | PAP
- | AP_STACK
- | IND
- | IND_STATIC
- | RET_BCO
- | RET_SMALL
- | RET_BIG
- | RET_FUN
- | UPDATE_FRAME
- | CATCH_FRAME
- | UNDERFLOW_FRAME
- | STOP_FRAME
- | BLOCKING_QUEUE
- | BLACKHOLE
- | MVAR_CLEAN
- | MVAR_DIRTY
- | TVAR
- | ARR_WORDS
- | MUT_ARR_PTRS_CLEAN
- | MUT_ARR_PTRS_DIRTY
- | MUT_ARR_PTRS_FROZEN_DIRTY
- | MUT_ARR_PTRS_FROZEN_CLEAN
- | MUT_VAR_CLEAN
- | MUT_VAR_DIRTY
- | WEAK
- | PRIM
- | MUT_PRIM
- | TSO
- | STACK
- | TREC_CHUNK
- | ATOMICALLY_FRAME
- | CATCH_RETRY_FRAME
- | CATCH_STM_FRAME
- | WHITEHOLE
- | SMALL_MUT_ARR_PTRS_CLEAN
- | SMALL_MUT_ARR_PTRS_DIRTY
- | SMALL_MUT_ARR_PTRS_FROZEN_DIRTY
- | SMALL_MUT_ARR_PTRS_FROZEN_CLEAN
- | COMPACT_NFDATA
- | N_CLOSURE_TYPES
- data StgInfoTableWithPtr = StgInfoTableWithPtr {}
- data DebugStackFrame b = DebugStackFrame {
- frame_info :: !StgInfoTableWithPtr
- values :: [FieldValue b]
- data FieldValue b
- newtype GenStackFrames b = GenStackFrames {
- getFrames :: [DebugStackFrame b]
- type StackFrames = GenStackFrames ClosurePtr
- data StackCont = StackCont StackPtr RawStack
- newtype GenPapPayload b = GenPapPayload {
- getValues :: [FieldValue b]
- type PapPayload = GenPapPayload ClosurePtr
- data PayloadCont = PayloadCont ClosurePtr [Word64]
- data ConstrDesc = ConstrDesc {}
- type ConstrDescCont = InfoTablePtr
- parseConstrDesc :: String -> ConstrDesc
- class Quadtraversable m where
- quadtraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> m a c e h -> f (m b d g i)
- quadmap :: forall a b c d e f g h t. Quadtraversable t => (a -> b) -> (c -> d) -> (e -> f) -> (g -> h) -> t a c e g -> t b d f h
Closure Representation
data DebugClosure pap string s b Source #
This is the representation of a Haskell value on the heap. It reflects https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/storage/Closures.h
The data type is parametrized by 4 type parameters which correspond to different pointer types.
All Heap objects have the same basic layout. A header containing a pointer
to the info table and a payload with various fields. The info
field below
always refers to the info table pointed to by the header. The remaining
fields are the payload.
See https://gitlab.haskell.org/ghc/ghc/wikis/commentary/rts/storage/heap-objects for more information.
ConstrClosure | A data constructor |
| |
FunClosure | A function |
| |
ThunkClosure | A thunk, an expression not obviously in head normal form |
| |
SelectorClosure | A thunk which performs a simple selection operation |
| |
PAPClosure | An unsaturated function application |
| |
APClosure | A function application |
| |
APStackClosure | A suspended thunk evaluation |
| |
IndClosure | A pointer to another closure, introduced when a thunk is updated to point at its value |
| |
BCOClosure | A byte-code object (BCO) which can be interpreted by GHC's byte-code interpreter (e.g. as used by GHCi) |
| |
BlackholeClosure | A thunk under evaluation by another thread |
| |
ArrWordsClosure | A |
MutArrClosure | A |
| |
SmallMutArrClosure | A Since: 8.10.1 |
| |
MVarClosure | An |
| |
MutVarClosure | A |
| |
BlockingQueueClosure | An STM blocking queue. |
TSOClosure | |
| |
StackClosure | |
| |
WeakClosure | |
| |
TVarClosure | |
| |
TRecChunkClosure | |
| |
MutPrimClosure | |
| |
OtherClosure | Another kind of closure |
| |
UnsupportedClosure | |
Instances
TRecEntry | |
|
Instances
Wrappers
data DebugClosureWithExtra x pap string s b Source #
DCS | |
|
Instances
Exclusive size
newtype InclusiveSize Source #
Instances
newtype RetainerSize Source #
Instances
noSize :: DebugClosureWithSize pap string s b -> DebugClosure pap string s b Source #
dcSize :: DebugClosureWithSize pap string s b -> Size Source #
allClosures :: DebugClosure (GenPapPayload c) a (GenStackFrames c) c -> [c] Source #
Info Table Representation
data StgInfoTable #
This is a somewhat faithful representation of an info table. See https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/storage/InfoTables.h for more details on this data structure.
Instances
data ClosureType #
Instances
data StgInfoTableWithPtr Source #
Instances
Show StgInfoTableWithPtr Source # | |
Defined in GHC.Debug.Types.Closures showsPrec :: Int -> StgInfoTableWithPtr -> ShowS # show :: StgInfoTableWithPtr -> String # showList :: [StgInfoTableWithPtr] -> ShowS # | |
Eq StgInfoTableWithPtr Source # | |
Defined in GHC.Debug.Types.Closures (==) :: StgInfoTableWithPtr -> StgInfoTableWithPtr -> Bool # (/=) :: StgInfoTableWithPtr -> StgInfoTableWithPtr -> Bool # | |
Ord StgInfoTableWithPtr Source # | |
Defined in GHC.Debug.Types.Closures compare :: StgInfoTableWithPtr -> StgInfoTableWithPtr -> Ordering # (<) :: StgInfoTableWithPtr -> StgInfoTableWithPtr -> Bool # (<=) :: StgInfoTableWithPtr -> StgInfoTableWithPtr -> Bool # (>) :: StgInfoTableWithPtr -> StgInfoTableWithPtr -> Bool # (>=) :: StgInfoTableWithPtr -> StgInfoTableWithPtr -> Bool # max :: StgInfoTableWithPtr -> StgInfoTableWithPtr -> StgInfoTableWithPtr # min :: StgInfoTableWithPtr -> StgInfoTableWithPtr -> StgInfoTableWithPtr # |
Stack Frame Representation
data DebugStackFrame b Source #
DebugStackFrame | |
|
Instances
data FieldValue b Source #
Instances
newtype GenStackFrames b Source #
Instances
type StackFrames = GenStackFrames ClosurePtr Source #
Information needed to decode a set of stack frames
PAP payload representation
newtype GenPapPayload b Source #
GenPapPayload | |
|
Instances
type PapPayload = GenPapPayload ClosurePtr Source #
data PayloadCont Source #
Information needed to decode a PAP payload
Instances
Show PayloadCont Source # | |
Defined in GHC.Debug.Types.Closures showsPrec :: Int -> PayloadCont -> ShowS # show :: PayloadCont -> String # showList :: [PayloadCont] -> ShowS # |
Constructor Description Representation
data ConstrDesc Source #
Instances
Show ConstrDesc Source # | |
Defined in GHC.Debug.Types.Closures showsPrec :: Int -> ConstrDesc -> ShowS # show :: ConstrDesc -> String # showList :: [ConstrDesc] -> ShowS # | |
Eq ConstrDesc Source # | |
Defined in GHC.Debug.Types.Closures (==) :: ConstrDesc -> ConstrDesc -> Bool # (/=) :: ConstrDesc -> ConstrDesc -> Bool # | |
Ord ConstrDesc Source # | |
Defined in GHC.Debug.Types.Closures compare :: ConstrDesc -> ConstrDesc -> Ordering # (<) :: ConstrDesc -> ConstrDesc -> Bool # (<=) :: ConstrDesc -> ConstrDesc -> Bool # (>) :: ConstrDesc -> ConstrDesc -> Bool # (>=) :: ConstrDesc -> ConstrDesc -> Bool # max :: ConstrDesc -> ConstrDesc -> ConstrDesc # min :: ConstrDesc -> ConstrDesc -> ConstrDesc # |
type ConstrDescCont = InfoTablePtr Source #
Information needed to decode a ConstrDesc
parseConstrDesc :: String -> ConstrDesc Source #
Traversing functions
class Quadtraversable m where Source #
quadtraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> m a c e h -> f (m b d g i) Source #
Instances
Quadtraversable DebugClosure Source # | |
Defined in GHC.Debug.Types.Closures quadtraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> DebugClosure a c e h -> f (DebugClosure b d g i) Source # | |
Quadtraversable (DebugClosureWithExtra x) Source # | |
Defined in GHC.Debug.Types.Closures quadtraverse :: Applicative f => (a -> f b) -> (c -> f d) -> (e -> f g) -> (h -> f i) -> DebugClosureWithExtra x a c e h -> f (DebugClosureWithExtra x b d g i) Source # |
quadmap :: forall a b c d e f g h t. Quadtraversable t => (a -> b) -> (c -> d) -> (e -> f) -> (g -> h) -> t a c e g -> t b d f h Source #