{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{- | 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..
-}
module GHC.Debug.Types.Closures (
    -- * Closure Representation
      Closure
    , SizedClosure
    , SizedClosureC
    , SizedClosureP
    , DebugClosure(..)
    , TRecEntry(..)
    -- * Wrappers
    , DebugClosureWithSize
    , DebugClosureWithExtra(..)
    , Size(..)
    , InclusiveSize(..)
    , RetainerSize(..)
    , noSize
    , dcSize
    , allClosures
    -- * Info Table Representation
    , StgInfoTable(..)
    , ClosureType(..)
    , WhatNext(..)
    , WhyBlocked(..)
    , TsoFlags(..)
    , StgInfoTableWithPtr(..)
    -- * Stack Frame Representation
    , DebugStackFrame(..)
    , FieldValue(..)
    , GenStackFrames(..)
    , StackFrames
    , StackCont(..)
    -- * PAP payload representation
    , GenPapPayload(..)
    , PapPayload
    , PayloadCont(..)
    -- * Constructor Description Representation
    , ConstrDesc(..)
    , ConstrDescCont
    , parseConstrDesc
    -- * SRT field representation
    , GenSrtPayload(..)
    , SrtPayload
    , SrtCont
    , ProfHeader(..)
    , ProfHeaderWord(..)
    , ProfHeaderWithPtr
    , CCSPayload
    , GenCCSPayload(..)
    , CCPayload(..)
    , IndexTable(..)

    -- * Traversing functions
    , Hextraversable(..)
    , hexmap
    ) where

import Prelude -- See note [Why do we import Prelude here?]

import Data.Functor.Identity
import Data.Int
import Data.Word
import GHC.Exts
import GHC.Generics
import GHC.Debug.Types.Ptr
import Data.List (intercalate)
import Data.Char

import Control.Applicative
import Data.Monoid
import Data.Bitraversable
import Data.Bifunctor
import Data.Bifoldable

------------------------------------------------------------------------
-- GHC Heap


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
    | CONTINUATION
    | N_CLOSURE_TYPES
 deriving (Int -> ClosureType
ClosureType -> Int
ClosureType -> [ClosureType]
ClosureType -> ClosureType
ClosureType -> ClosureType -> [ClosureType]
ClosureType -> ClosureType -> ClosureType -> [ClosureType]
(ClosureType -> ClosureType)
-> (ClosureType -> ClosureType)
-> (Int -> ClosureType)
-> (ClosureType -> Int)
-> (ClosureType -> [ClosureType])
-> (ClosureType -> ClosureType -> [ClosureType])
-> (ClosureType -> ClosureType -> [ClosureType])
-> (ClosureType -> ClosureType -> ClosureType -> [ClosureType])
-> Enum ClosureType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ClosureType -> ClosureType
succ :: ClosureType -> ClosureType
$cpred :: ClosureType -> ClosureType
pred :: ClosureType -> ClosureType
$ctoEnum :: Int -> ClosureType
toEnum :: Int -> ClosureType
$cfromEnum :: ClosureType -> Int
fromEnum :: ClosureType -> Int
$cenumFrom :: ClosureType -> [ClosureType]
enumFrom :: ClosureType -> [ClosureType]
$cenumFromThen :: ClosureType -> ClosureType -> [ClosureType]
enumFromThen :: ClosureType -> ClosureType -> [ClosureType]
$cenumFromTo :: ClosureType -> ClosureType -> [ClosureType]
enumFromTo :: ClosureType -> ClosureType -> [ClosureType]
$cenumFromThenTo :: ClosureType -> ClosureType -> ClosureType -> [ClosureType]
enumFromThenTo :: ClosureType -> ClosureType -> ClosureType -> [ClosureType]
Enum, ClosureType -> ClosureType -> Bool
(ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> Bool) -> Eq ClosureType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClosureType -> ClosureType -> Bool
== :: ClosureType -> ClosureType -> Bool
$c/= :: ClosureType -> ClosureType -> Bool
/= :: ClosureType -> ClosureType -> Bool
Eq, Eq ClosureType
Eq ClosureType
-> (ClosureType -> ClosureType -> Ordering)
-> (ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> ClosureType)
-> (ClosureType -> ClosureType -> ClosureType)
-> Ord ClosureType
ClosureType -> ClosureType -> Bool
ClosureType -> ClosureType -> Ordering
ClosureType -> ClosureType -> ClosureType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ClosureType -> ClosureType -> Ordering
compare :: ClosureType -> ClosureType -> Ordering
$c< :: ClosureType -> ClosureType -> Bool
< :: ClosureType -> ClosureType -> Bool
$c<= :: ClosureType -> ClosureType -> Bool
<= :: ClosureType -> ClosureType -> Bool
$c> :: ClosureType -> ClosureType -> Bool
> :: ClosureType -> ClosureType -> Bool
$c>= :: ClosureType -> ClosureType -> Bool
>= :: ClosureType -> ClosureType -> Bool
$cmax :: ClosureType -> ClosureType -> ClosureType
max :: ClosureType -> ClosureType -> ClosureType
$cmin :: ClosureType -> ClosureType -> ClosureType
min :: ClosureType -> ClosureType -> ClosureType
Ord, Int -> ClosureType -> ShowS
[ClosureType] -> ShowS
ClosureType -> String
(Int -> ClosureType -> ShowS)
-> (ClosureType -> String)
-> ([ClosureType] -> ShowS)
-> Show ClosureType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClosureType -> ShowS
showsPrec :: Int -> ClosureType -> ShowS
$cshow :: ClosureType -> String
show :: ClosureType -> String
$cshowList :: [ClosureType] -> ShowS
showList :: [ClosureType] -> ShowS
Show, (forall x. ClosureType -> Rep ClosureType x)
-> (forall x. Rep ClosureType x -> ClosureType)
-> Generic ClosureType
forall x. Rep ClosureType x -> ClosureType
forall x. ClosureType -> Rep ClosureType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClosureType -> Rep ClosureType x
from :: forall x. ClosureType -> Rep ClosureType x
$cto :: forall x. Rep ClosureType x -> ClosureType
to :: forall x. Rep ClosureType x -> ClosureType
Generic, ReadPrec [ClosureType]
ReadPrec ClosureType
Int -> ReadS ClosureType
ReadS [ClosureType]
(Int -> ReadS ClosureType)
-> ReadS [ClosureType]
-> ReadPrec ClosureType
-> ReadPrec [ClosureType]
-> Read ClosureType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ClosureType
readsPrec :: Int -> ReadS ClosureType
$creadList :: ReadS [ClosureType]
readList :: ReadS [ClosureType]
$creadPrec :: ReadPrec ClosureType
readPrec :: ReadPrec ClosureType
$creadListPrec :: ReadPrec [ClosureType]
readListPrec :: ReadPrec [ClosureType]
Read)

type HalfWord = Word32 -- TODO support 32 bit

data StgInfoTable = StgInfoTable {
   StgInfoTable -> HalfWord
ptrs   :: HalfWord,
   StgInfoTable -> HalfWord
nptrs  :: HalfWord,
   StgInfoTable -> ClosureType
tipe   :: ClosureType,
   StgInfoTable -> HalfWord
srtlen :: HalfWord
  } deriving (StgInfoTable -> StgInfoTable -> Bool
(StgInfoTable -> StgInfoTable -> Bool)
-> (StgInfoTable -> StgInfoTable -> Bool) -> Eq StgInfoTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StgInfoTable -> StgInfoTable -> Bool
== :: StgInfoTable -> StgInfoTable -> Bool
$c/= :: StgInfoTable -> StgInfoTable -> Bool
/= :: StgInfoTable -> StgInfoTable -> Bool
Eq, Int -> StgInfoTable -> ShowS
[StgInfoTable] -> ShowS
StgInfoTable -> String
(Int -> StgInfoTable -> ShowS)
-> (StgInfoTable -> String)
-> ([StgInfoTable] -> ShowS)
-> Show StgInfoTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StgInfoTable -> ShowS
showsPrec :: Int -> StgInfoTable -> ShowS
$cshow :: StgInfoTable -> String
show :: StgInfoTable -> String
$cshowList :: [StgInfoTable] -> ShowS
showList :: [StgInfoTable] -> ShowS
Show, (forall x. StgInfoTable -> Rep StgInfoTable x)
-> (forall x. Rep StgInfoTable x -> StgInfoTable)
-> Generic StgInfoTable
forall x. Rep StgInfoTable x -> StgInfoTable
forall x. StgInfoTable -> Rep StgInfoTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StgInfoTable -> Rep StgInfoTable x
from :: forall x. StgInfoTable -> Rep StgInfoTable x
$cto :: forall x. Rep StgInfoTable x -> StgInfoTable
to :: forall x. Rep StgInfoTable x -> StgInfoTable
Generic)

data WhatNext
  = ThreadRunGHC
  | ThreadInterpret
  | ThreadKilled
  | ThreadComplete
  | WhatNextUnknownValue Word16 -- ^ Please report this as a bug
  deriving (WhatNext -> WhatNext -> Bool
(WhatNext -> WhatNext -> Bool)
-> (WhatNext -> WhatNext -> Bool) -> Eq WhatNext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WhatNext -> WhatNext -> Bool
== :: WhatNext -> WhatNext -> Bool
$c/= :: WhatNext -> WhatNext -> Bool
/= :: WhatNext -> WhatNext -> Bool
Eq, Int -> WhatNext -> ShowS
[WhatNext] -> ShowS
WhatNext -> String
(Int -> WhatNext -> ShowS)
-> (WhatNext -> String) -> ([WhatNext] -> ShowS) -> Show WhatNext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WhatNext -> ShowS
showsPrec :: Int -> WhatNext -> ShowS
$cshow :: WhatNext -> String
show :: WhatNext -> String
$cshowList :: [WhatNext] -> ShowS
showList :: [WhatNext] -> ShowS
Show, (forall x. WhatNext -> Rep WhatNext x)
-> (forall x. Rep WhatNext x -> WhatNext) -> Generic WhatNext
forall x. Rep WhatNext x -> WhatNext
forall x. WhatNext -> Rep WhatNext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WhatNext -> Rep WhatNext x
from :: forall x. WhatNext -> Rep WhatNext x
$cto :: forall x. Rep WhatNext x -> WhatNext
to :: forall x. Rep WhatNext x -> WhatNext
Generic, Eq WhatNext
Eq WhatNext
-> (WhatNext -> WhatNext -> Ordering)
-> (WhatNext -> WhatNext -> Bool)
-> (WhatNext -> WhatNext -> Bool)
-> (WhatNext -> WhatNext -> Bool)
-> (WhatNext -> WhatNext -> Bool)
-> (WhatNext -> WhatNext -> WhatNext)
-> (WhatNext -> WhatNext -> WhatNext)
-> Ord WhatNext
WhatNext -> WhatNext -> Bool
WhatNext -> WhatNext -> Ordering
WhatNext -> WhatNext -> WhatNext
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WhatNext -> WhatNext -> Ordering
compare :: WhatNext -> WhatNext -> Ordering
$c< :: WhatNext -> WhatNext -> Bool
< :: WhatNext -> WhatNext -> Bool
$c<= :: WhatNext -> WhatNext -> Bool
<= :: WhatNext -> WhatNext -> Bool
$c> :: WhatNext -> WhatNext -> Bool
> :: WhatNext -> WhatNext -> Bool
$c>= :: WhatNext -> WhatNext -> Bool
>= :: WhatNext -> WhatNext -> Bool
$cmax :: WhatNext -> WhatNext -> WhatNext
max :: WhatNext -> WhatNext -> WhatNext
$cmin :: WhatNext -> WhatNext -> WhatNext
min :: WhatNext -> WhatNext -> WhatNext
Ord)

data WhyBlocked
  = NotBlocked
  | BlockedOnMVar
  | BlockedOnMVarRead
  | BlockedOnBlackHole
  | BlockedOnRead
  | BlockedOnWrite
  | BlockedOnDelay
  | BlockedOnSTM
  | BlockedOnDoProc
  | BlockedOnCCall
  | BlockedOnCCall_Interruptible
  | BlockedOnMsgThrowTo
  | ThreadMigrating
  | WhyBlockedUnknownValue Word32 -- ^ Please report this as a bug
  deriving (WhyBlocked -> WhyBlocked -> Bool
(WhyBlocked -> WhyBlocked -> Bool)
-> (WhyBlocked -> WhyBlocked -> Bool) -> Eq WhyBlocked
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WhyBlocked -> WhyBlocked -> Bool
== :: WhyBlocked -> WhyBlocked -> Bool
$c/= :: WhyBlocked -> WhyBlocked -> Bool
/= :: WhyBlocked -> WhyBlocked -> Bool
Eq, Int -> WhyBlocked -> ShowS
[WhyBlocked] -> ShowS
WhyBlocked -> String
(Int -> WhyBlocked -> ShowS)
-> (WhyBlocked -> String)
-> ([WhyBlocked] -> ShowS)
-> Show WhyBlocked
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WhyBlocked -> ShowS
showsPrec :: Int -> WhyBlocked -> ShowS
$cshow :: WhyBlocked -> String
show :: WhyBlocked -> String
$cshowList :: [WhyBlocked] -> ShowS
showList :: [WhyBlocked] -> ShowS
Show, (forall x. WhyBlocked -> Rep WhyBlocked x)
-> (forall x. Rep WhyBlocked x -> WhyBlocked) -> Generic WhyBlocked
forall x. Rep WhyBlocked x -> WhyBlocked
forall x. WhyBlocked -> Rep WhyBlocked x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WhyBlocked -> Rep WhyBlocked x
from :: forall x. WhyBlocked -> Rep WhyBlocked x
$cto :: forall x. Rep WhyBlocked x -> WhyBlocked
to :: forall x. Rep WhyBlocked x -> WhyBlocked
Generic, Eq WhyBlocked
Eq WhyBlocked
-> (WhyBlocked -> WhyBlocked -> Ordering)
-> (WhyBlocked -> WhyBlocked -> Bool)
-> (WhyBlocked -> WhyBlocked -> Bool)
-> (WhyBlocked -> WhyBlocked -> Bool)
-> (WhyBlocked -> WhyBlocked -> Bool)
-> (WhyBlocked -> WhyBlocked -> WhyBlocked)
-> (WhyBlocked -> WhyBlocked -> WhyBlocked)
-> Ord WhyBlocked
WhyBlocked -> WhyBlocked -> Bool
WhyBlocked -> WhyBlocked -> Ordering
WhyBlocked -> WhyBlocked -> WhyBlocked
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WhyBlocked -> WhyBlocked -> Ordering
compare :: WhyBlocked -> WhyBlocked -> Ordering
$c< :: WhyBlocked -> WhyBlocked -> Bool
< :: WhyBlocked -> WhyBlocked -> Bool
$c<= :: WhyBlocked -> WhyBlocked -> Bool
<= :: WhyBlocked -> WhyBlocked -> Bool
$c> :: WhyBlocked -> WhyBlocked -> Bool
> :: WhyBlocked -> WhyBlocked -> Bool
$c>= :: WhyBlocked -> WhyBlocked -> Bool
>= :: WhyBlocked -> WhyBlocked -> Bool
$cmax :: WhyBlocked -> WhyBlocked -> WhyBlocked
max :: WhyBlocked -> WhyBlocked -> WhyBlocked
$cmin :: WhyBlocked -> WhyBlocked -> WhyBlocked
min :: WhyBlocked -> WhyBlocked -> WhyBlocked
Ord)

data TsoFlags
  = TsoLocked
  | TsoBlockx
  | TsoInterruptible
  | TsoStoppedOnBreakpoint
  | TsoMarked
  | TsoSqueezed
  | TsoAllocLimit
  | TsoFlagsUnknownValue Word32 -- ^ Please report this as a bug
  deriving (TsoFlags -> TsoFlags -> Bool
(TsoFlags -> TsoFlags -> Bool)
-> (TsoFlags -> TsoFlags -> Bool) -> Eq TsoFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TsoFlags -> TsoFlags -> Bool
== :: TsoFlags -> TsoFlags -> Bool
$c/= :: TsoFlags -> TsoFlags -> Bool
/= :: TsoFlags -> TsoFlags -> Bool
Eq, Int -> TsoFlags -> ShowS
[TsoFlags] -> ShowS
TsoFlags -> String
(Int -> TsoFlags -> ShowS)
-> (TsoFlags -> String) -> ([TsoFlags] -> ShowS) -> Show TsoFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TsoFlags -> ShowS
showsPrec :: Int -> TsoFlags -> ShowS
$cshow :: TsoFlags -> String
show :: TsoFlags -> String
$cshowList :: [TsoFlags] -> ShowS
showList :: [TsoFlags] -> ShowS
Show, (forall x. TsoFlags -> Rep TsoFlags x)
-> (forall x. Rep TsoFlags x -> TsoFlags) -> Generic TsoFlags
forall x. Rep TsoFlags x -> TsoFlags
forall x. TsoFlags -> Rep TsoFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TsoFlags -> Rep TsoFlags x
from :: forall x. TsoFlags -> Rep TsoFlags x
$cto :: forall x. Rep TsoFlags x -> TsoFlags
to :: forall x. Rep TsoFlags x -> TsoFlags
Generic, Eq TsoFlags
Eq TsoFlags
-> (TsoFlags -> TsoFlags -> Ordering)
-> (TsoFlags -> TsoFlags -> Bool)
-> (TsoFlags -> TsoFlags -> Bool)
-> (TsoFlags -> TsoFlags -> Bool)
-> (TsoFlags -> TsoFlags -> Bool)
-> (TsoFlags -> TsoFlags -> TsoFlags)
-> (TsoFlags -> TsoFlags -> TsoFlags)
-> Ord TsoFlags
TsoFlags -> TsoFlags -> Bool
TsoFlags -> TsoFlags -> Ordering
TsoFlags -> TsoFlags -> TsoFlags
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TsoFlags -> TsoFlags -> Ordering
compare :: TsoFlags -> TsoFlags -> Ordering
$c< :: TsoFlags -> TsoFlags -> Bool
< :: TsoFlags -> TsoFlags -> Bool
$c<= :: TsoFlags -> TsoFlags -> Bool
<= :: TsoFlags -> TsoFlags -> Bool
$c> :: TsoFlags -> TsoFlags -> Bool
> :: TsoFlags -> TsoFlags -> Bool
$c>= :: TsoFlags -> TsoFlags -> Bool
>= :: TsoFlags -> TsoFlags -> Bool
$cmax :: TsoFlags -> TsoFlags -> TsoFlags
max :: TsoFlags -> TsoFlags -> TsoFlags
$cmin :: TsoFlags -> TsoFlags -> TsoFlags
min :: TsoFlags -> TsoFlags -> TsoFlags
Ord)

newtype StgTSOProfInfo = StgTSOProfInfo {
    StgTSOProfInfo -> Maybe CCSPtr
cccs :: Maybe CCSPtr
} deriving (Int -> StgTSOProfInfo -> ShowS
[StgTSOProfInfo] -> ShowS
StgTSOProfInfo -> String
(Int -> StgTSOProfInfo -> ShowS)
-> (StgTSOProfInfo -> String)
-> ([StgTSOProfInfo] -> ShowS)
-> Show StgTSOProfInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StgTSOProfInfo -> ShowS
showsPrec :: Int -> StgTSOProfInfo -> ShowS
$cshow :: StgTSOProfInfo -> String
show :: StgTSOProfInfo -> String
$cshowList :: [StgTSOProfInfo] -> ShowS
showList :: [StgTSOProfInfo] -> ShowS
Show, (forall x. StgTSOProfInfo -> Rep StgTSOProfInfo x)
-> (forall x. Rep StgTSOProfInfo x -> StgTSOProfInfo)
-> Generic StgTSOProfInfo
forall x. Rep StgTSOProfInfo x -> StgTSOProfInfo
forall x. StgTSOProfInfo -> Rep StgTSOProfInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StgTSOProfInfo -> Rep StgTSOProfInfo x
from :: forall x. StgTSOProfInfo -> Rep StgTSOProfInfo x
$cto :: forall x. Rep StgTSOProfInfo x -> StgTSOProfInfo
to :: forall x. Rep StgTSOProfInfo x -> StgTSOProfInfo
Generic, StgTSOProfInfo -> StgTSOProfInfo -> Bool
(StgTSOProfInfo -> StgTSOProfInfo -> Bool)
-> (StgTSOProfInfo -> StgTSOProfInfo -> Bool) -> Eq StgTSOProfInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
== :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
$c/= :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
/= :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
Eq, Eq StgTSOProfInfo
Eq StgTSOProfInfo
-> (StgTSOProfInfo -> StgTSOProfInfo -> Ordering)
-> (StgTSOProfInfo -> StgTSOProfInfo -> Bool)
-> (StgTSOProfInfo -> StgTSOProfInfo -> Bool)
-> (StgTSOProfInfo -> StgTSOProfInfo -> Bool)
-> (StgTSOProfInfo -> StgTSOProfInfo -> Bool)
-> (StgTSOProfInfo -> StgTSOProfInfo -> StgTSOProfInfo)
-> (StgTSOProfInfo -> StgTSOProfInfo -> StgTSOProfInfo)
-> Ord StgTSOProfInfo
StgTSOProfInfo -> StgTSOProfInfo -> Bool
StgTSOProfInfo -> StgTSOProfInfo -> Ordering
StgTSOProfInfo -> StgTSOProfInfo -> StgTSOProfInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StgTSOProfInfo -> StgTSOProfInfo -> Ordering
compare :: StgTSOProfInfo -> StgTSOProfInfo -> Ordering
$c< :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
< :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
$c<= :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
<= :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
$c> :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
> :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
$c>= :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
>= :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
$cmax :: StgTSOProfInfo -> StgTSOProfInfo -> StgTSOProfInfo
max :: StgTSOProfInfo -> StgTSOProfInfo -> StgTSOProfInfo
$cmin :: StgTSOProfInfo -> StgTSOProfInfo -> StgTSOProfInfo
min :: StgTSOProfInfo -> StgTSOProfInfo -> StgTSOProfInfo
Ord)

------------------------------------------------------------------------
-- Closures


type Closure = DebugClosure CCSPtr SrtCont PayloadCont ConstrDescCont StackCont ClosurePtr
type SizedClosure = DebugClosureWithSize CCSPtr SrtCont PayloadCont ConstrDescCont StackCont ClosurePtr
type SizedClosureC = DebugClosureWithSize CCSPtr SrtCont PayloadCont ConstrDesc StackCont ClosurePtr
type SizedClosureP = DebugClosureWithSize CCSPtr SrtPayload PapPayload ConstrDesc StackCont ClosurePtr

-- | Information needed to decode a 'ConstrDesc'
type ConstrDescCont = InfoTablePtr

-- | Information needed to decode a PAP payload
data PayloadCont = PayloadCont ClosurePtr [Word64] deriving (Int -> PayloadCont -> ShowS
[PayloadCont] -> ShowS
PayloadCont -> String
(Int -> PayloadCont -> ShowS)
-> (PayloadCont -> String)
-> ([PayloadCont] -> ShowS)
-> Show PayloadCont
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PayloadCont -> ShowS
showsPrec :: Int -> PayloadCont -> ShowS
$cshow :: PayloadCont -> String
show :: PayloadCont -> String
$cshowList :: [PayloadCont] -> ShowS
showList :: [PayloadCont] -> ShowS
Show, PayloadCont -> PayloadCont -> Bool
(PayloadCont -> PayloadCont -> Bool)
-> (PayloadCont -> PayloadCont -> Bool) -> Eq PayloadCont
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PayloadCont -> PayloadCont -> Bool
== :: PayloadCont -> PayloadCont -> Bool
$c/= :: PayloadCont -> PayloadCont -> Bool
/= :: PayloadCont -> PayloadCont -> Bool
Eq)

type DebugClosureWithSize = DebugClosureWithExtra Size

data DebugClosureWithExtra x ccs srt pap string s b
  = DCS { forall x ccs srt pap string s b.
DebugClosureWithExtra x ccs srt pap string s b -> x
extraDCS :: x
        , forall x ccs srt pap string s b.
DebugClosureWithExtra x ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
unDCS :: DebugClosure ccs srt pap string s b }
    deriving (Int -> DebugClosureWithExtra x ccs srt pap string s b -> ShowS
[DebugClosureWithExtra x ccs srt pap string s b] -> ShowS
DebugClosureWithExtra x ccs srt pap string s b -> String
(Int -> DebugClosureWithExtra x ccs srt pap string s b -> ShowS)
-> (DebugClosureWithExtra x ccs srt pap string s b -> String)
-> ([DebugClosureWithExtra x ccs srt pap string s b] -> ShowS)
-> Show (DebugClosureWithExtra x ccs srt pap string s b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x ccs srt pap string s b.
(Show x, Show ccs, Show string, Show srt, Show pap, Show s,
 Show b) =>
Int -> DebugClosureWithExtra x ccs srt pap string s b -> ShowS
forall x ccs srt pap string s b.
(Show x, Show ccs, Show string, Show srt, Show pap, Show s,
 Show b) =>
[DebugClosureWithExtra x ccs srt pap string s b] -> ShowS
forall x ccs srt pap string s b.
(Show x, Show ccs, Show string, Show srt, Show pap, Show s,
 Show b) =>
DebugClosureWithExtra x ccs srt pap string s b -> String
$cshowsPrec :: forall x ccs srt pap string s b.
(Show x, Show ccs, Show string, Show srt, Show pap, Show s,
 Show b) =>
Int -> DebugClosureWithExtra x ccs srt pap string s b -> ShowS
showsPrec :: Int -> DebugClosureWithExtra x ccs srt pap string s b -> ShowS
$cshow :: forall x ccs srt pap string s b.
(Show x, Show ccs, Show string, Show srt, Show pap, Show s,
 Show b) =>
DebugClosureWithExtra x ccs srt pap string s b -> String
show :: DebugClosureWithExtra x ccs srt pap string s b -> String
$cshowList :: forall x ccs srt pap string s b.
(Show x, Show ccs, Show string, Show srt, Show pap, Show s,
 Show b) =>
[DebugClosureWithExtra x ccs srt pap string s b] -> ShowS
showList :: [DebugClosureWithExtra x ccs srt pap string s b] -> ShowS
Show, Eq (DebugClosureWithExtra x ccs srt pap string s b)
Eq (DebugClosureWithExtra x ccs srt pap string s b)
-> (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)
-> (DebugClosureWithExtra x ccs srt pap string s b
    -> DebugClosureWithExtra x ccs srt pap string s b
    -> DebugClosureWithExtra x ccs srt pap string s b)
-> (DebugClosureWithExtra x ccs srt pap string s b
    -> DebugClosureWithExtra x ccs srt pap string s b
    -> DebugClosureWithExtra x ccs srt pap string s b)
-> Ord (DebugClosureWithExtra x ccs srt pap string s b)
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 -> Ordering
DebugClosureWithExtra x ccs srt pap string s b
-> DebugClosureWithExtra x ccs srt pap string s b
-> DebugClosureWithExtra x ccs srt pap string s b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {x} {ccs} {srt} {pap} {string} {s} {b}.
(Ord x, Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
Eq (DebugClosureWithExtra x ccs srt pap string s b)
forall x ccs srt pap string s b.
(Ord x, Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
DebugClosureWithExtra x ccs srt pap string s b
-> DebugClosureWithExtra x ccs srt pap string s b -> Bool
forall x ccs srt pap string s b.
(Ord x, Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
DebugClosureWithExtra x ccs srt pap string s b
-> DebugClosureWithExtra x ccs srt pap string s b -> Ordering
forall x ccs srt pap string s b.
(Ord x, Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
DebugClosureWithExtra x ccs srt pap string s b
-> DebugClosureWithExtra x ccs srt pap string s b
-> DebugClosureWithExtra x ccs srt pap string s b
$ccompare :: forall x ccs srt pap string s b.
(Ord x, Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
DebugClosureWithExtra x ccs srt pap string s b
-> DebugClosureWithExtra x ccs srt pap string s b -> Ordering
compare :: DebugClosureWithExtra x ccs srt pap string s b
-> DebugClosureWithExtra x ccs srt pap string s b -> Ordering
$c< :: forall x ccs srt pap string s b.
(Ord x, Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
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
$c<= :: forall x ccs srt pap string s b.
(Ord x, Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
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
$c> :: forall x ccs srt pap string s b.
(Ord x, Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
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
$c>= :: forall x ccs srt pap string s b.
(Ord x, Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
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
$cmax :: forall x ccs srt pap string s b.
(Ord x, Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
DebugClosureWithExtra x ccs srt pap string s b
-> DebugClosureWithExtra x ccs srt pap string s b
-> DebugClosureWithExtra x ccs srt pap string s b
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
$cmin :: forall x ccs srt pap string s b.
(Ord x, Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
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
Ord, 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)
-> Eq (DebugClosureWithExtra x ccs srt pap string s b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x ccs srt pap string s b.
(Eq x, Eq ccs, Eq string, Eq srt, Eq pap, Eq s, Eq b) =>
DebugClosureWithExtra x ccs srt pap string s b
-> DebugClosureWithExtra x ccs srt pap string s b -> Bool
$c== :: forall x ccs srt pap string s b.
(Eq x, Eq ccs, Eq string, Eq srt, Eq pap, Eq s, Eq b) =>
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
$c/= :: forall x ccs srt pap string s b.
(Eq x, Eq ccs, Eq string, Eq srt, Eq pap, Eq s, Eq b) =>
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
Eq)

-- | Exclusive size
newtype Size = Size { Size -> Int
getSize :: Int }
  deriving stock (Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
(Int -> Size -> ShowS)
-> (Size -> String) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Size -> ShowS
showsPrec :: Int -> Size -> ShowS
$cshow :: Size -> String
show :: Size -> String
$cshowList :: [Size] -> ShowS
showList :: [Size] -> ShowS
Show, (forall x. Size -> Rep Size x)
-> (forall x. Rep Size x -> Size) -> Generic Size
forall x. Rep Size x -> Size
forall x. Size -> Rep Size x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Size -> Rep Size x
from :: forall x. Size -> Rep Size x
$cto :: forall x. Rep Size x -> Size
to :: forall x. Rep Size x -> Size
Generic)
  deriving (NonEmpty Size -> Size
Size -> Size -> Size
(Size -> Size -> Size)
-> (NonEmpty Size -> Size)
-> (forall b. Integral b => b -> Size -> Size)
-> Semigroup Size
forall b. Integral b => b -> Size -> Size
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Size -> Size -> Size
<> :: Size -> Size -> Size
$csconcat :: NonEmpty Size -> Size
sconcat :: NonEmpty Size -> Size
$cstimes :: forall b. Integral b => b -> Size -> Size
stimes :: forall b. Integral b => b -> Size -> Size
Semigroup, Semigroup Size
Size
Semigroup Size
-> Size
-> (Size -> Size -> Size)
-> ([Size] -> Size)
-> Monoid Size
[Size] -> Size
Size -> Size -> Size
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Size
mempty :: Size
$cmappend :: Size -> Size -> Size
mappend :: Size -> Size -> Size
$cmconcat :: [Size] -> Size
mconcat :: [Size] -> Size
Monoid) via (Sum Int)
  deriving newtype (Integer -> Size
Size -> Size
Size -> Size -> Size
(Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size)
-> (Size -> Size)
-> (Size -> Size)
-> (Integer -> Size)
-> Num Size
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Size -> Size -> Size
+ :: Size -> Size -> Size
$c- :: Size -> Size -> Size
- :: Size -> Size -> Size
$c* :: Size -> Size -> Size
* :: Size -> Size -> Size
$cnegate :: Size -> Size
negate :: Size -> Size
$cabs :: Size -> Size
abs :: Size -> Size
$csignum :: Size -> Size
signum :: Size -> Size
$cfromInteger :: Integer -> Size
fromInteger :: Integer -> Size
Num, Eq Size
Eq Size
-> (Size -> Size -> Ordering)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> Ord Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Size -> Size -> Ordering
compare :: Size -> Size -> Ordering
$c< :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
>= :: Size -> Size -> Bool
$cmax :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
min :: Size -> Size -> Size
Ord, Size -> Size -> Bool
(Size -> Size -> Bool) -> (Size -> Size -> Bool) -> Eq Size
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
/= :: Size -> Size -> Bool
Eq, ReadPrec [Size]
ReadPrec Size
Int -> ReadS Size
ReadS [Size]
(Int -> ReadS Size)
-> ReadS [Size] -> ReadPrec Size -> ReadPrec [Size] -> Read Size
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Size
readsPrec :: Int -> ReadS Size
$creadList :: ReadS [Size]
readList :: ReadS [Size]
$creadPrec :: ReadPrec Size
readPrec :: ReadPrec Size
$creadListPrec :: ReadPrec [Size]
readListPrec :: ReadPrec [Size]
Read)

newtype InclusiveSize = InclusiveSize { InclusiveSize -> Int
getInclusiveSize :: Int }
  deriving stock (Int -> InclusiveSize -> ShowS
[InclusiveSize] -> ShowS
InclusiveSize -> String
(Int -> InclusiveSize -> ShowS)
-> (InclusiveSize -> String)
-> ([InclusiveSize] -> ShowS)
-> Show InclusiveSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InclusiveSize -> ShowS
showsPrec :: Int -> InclusiveSize -> ShowS
$cshow :: InclusiveSize -> String
show :: InclusiveSize -> String
$cshowList :: [InclusiveSize] -> ShowS
showList :: [InclusiveSize] -> ShowS
Show, (forall x. InclusiveSize -> Rep InclusiveSize x)
-> (forall x. Rep InclusiveSize x -> InclusiveSize)
-> Generic InclusiveSize
forall x. Rep InclusiveSize x -> InclusiveSize
forall x. InclusiveSize -> Rep InclusiveSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InclusiveSize -> Rep InclusiveSize x
from :: forall x. InclusiveSize -> Rep InclusiveSize x
$cto :: forall x. Rep InclusiveSize x -> InclusiveSize
to :: forall x. Rep InclusiveSize x -> InclusiveSize
Generic)
  deriving (NonEmpty InclusiveSize -> InclusiveSize
InclusiveSize -> InclusiveSize -> InclusiveSize
(InclusiveSize -> InclusiveSize -> InclusiveSize)
-> (NonEmpty InclusiveSize -> InclusiveSize)
-> (forall b. Integral b => b -> InclusiveSize -> InclusiveSize)
-> Semigroup InclusiveSize
forall b. Integral b => b -> InclusiveSize -> InclusiveSize
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: InclusiveSize -> InclusiveSize -> InclusiveSize
<> :: InclusiveSize -> InclusiveSize -> InclusiveSize
$csconcat :: NonEmpty InclusiveSize -> InclusiveSize
sconcat :: NonEmpty InclusiveSize -> InclusiveSize
$cstimes :: forall b. Integral b => b -> InclusiveSize -> InclusiveSize
stimes :: forall b. Integral b => b -> InclusiveSize -> InclusiveSize
Semigroup, Semigroup InclusiveSize
InclusiveSize
Semigroup InclusiveSize
-> InclusiveSize
-> (InclusiveSize -> InclusiveSize -> InclusiveSize)
-> ([InclusiveSize] -> InclusiveSize)
-> Monoid InclusiveSize
[InclusiveSize] -> InclusiveSize
InclusiveSize -> InclusiveSize -> InclusiveSize
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: InclusiveSize
mempty :: InclusiveSize
$cmappend :: InclusiveSize -> InclusiveSize -> InclusiveSize
mappend :: InclusiveSize -> InclusiveSize -> InclusiveSize
$cmconcat :: [InclusiveSize] -> InclusiveSize
mconcat :: [InclusiveSize] -> InclusiveSize
Monoid) via (Sum Int)

newtype RetainerSize = RetainerSize { RetainerSize -> Int
getRetainerSize :: Int }
  deriving stock (Int -> RetainerSize -> ShowS
[RetainerSize] -> ShowS
RetainerSize -> String
(Int -> RetainerSize -> ShowS)
-> (RetainerSize -> String)
-> ([RetainerSize] -> ShowS)
-> Show RetainerSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RetainerSize -> ShowS
showsPrec :: Int -> RetainerSize -> ShowS
$cshow :: RetainerSize -> String
show :: RetainerSize -> String
$cshowList :: [RetainerSize] -> ShowS
showList :: [RetainerSize] -> ShowS
Show, (forall x. RetainerSize -> Rep RetainerSize x)
-> (forall x. Rep RetainerSize x -> RetainerSize)
-> Generic RetainerSize
forall x. Rep RetainerSize x -> RetainerSize
forall x. RetainerSize -> Rep RetainerSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RetainerSize -> Rep RetainerSize x
from :: forall x. RetainerSize -> Rep RetainerSize x
$cto :: forall x. Rep RetainerSize x -> RetainerSize
to :: forall x. Rep RetainerSize x -> RetainerSize
Generic, Eq RetainerSize
Eq RetainerSize
-> (RetainerSize -> RetainerSize -> Ordering)
-> (RetainerSize -> RetainerSize -> Bool)
-> (RetainerSize -> RetainerSize -> Bool)
-> (RetainerSize -> RetainerSize -> Bool)
-> (RetainerSize -> RetainerSize -> Bool)
-> (RetainerSize -> RetainerSize -> RetainerSize)
-> (RetainerSize -> RetainerSize -> RetainerSize)
-> Ord RetainerSize
RetainerSize -> RetainerSize -> Bool
RetainerSize -> RetainerSize -> Ordering
RetainerSize -> RetainerSize -> RetainerSize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RetainerSize -> RetainerSize -> Ordering
compare :: RetainerSize -> RetainerSize -> Ordering
$c< :: RetainerSize -> RetainerSize -> Bool
< :: RetainerSize -> RetainerSize -> Bool
$c<= :: RetainerSize -> RetainerSize -> Bool
<= :: RetainerSize -> RetainerSize -> Bool
$c> :: RetainerSize -> RetainerSize -> Bool
> :: RetainerSize -> RetainerSize -> Bool
$c>= :: RetainerSize -> RetainerSize -> Bool
>= :: RetainerSize -> RetainerSize -> Bool
$cmax :: RetainerSize -> RetainerSize -> RetainerSize
max :: RetainerSize -> RetainerSize -> RetainerSize
$cmin :: RetainerSize -> RetainerSize -> RetainerSize
min :: RetainerSize -> RetainerSize -> RetainerSize
Ord, RetainerSize -> RetainerSize -> Bool
(RetainerSize -> RetainerSize -> Bool)
-> (RetainerSize -> RetainerSize -> Bool) -> Eq RetainerSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RetainerSize -> RetainerSize -> Bool
== :: RetainerSize -> RetainerSize -> Bool
$c/= :: RetainerSize -> RetainerSize -> Bool
/= :: RetainerSize -> RetainerSize -> Bool
Eq)
  deriving (NonEmpty RetainerSize -> RetainerSize
RetainerSize -> RetainerSize -> RetainerSize
(RetainerSize -> RetainerSize -> RetainerSize)
-> (NonEmpty RetainerSize -> RetainerSize)
-> (forall b. Integral b => b -> RetainerSize -> RetainerSize)
-> Semigroup RetainerSize
forall b. Integral b => b -> RetainerSize -> RetainerSize
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: RetainerSize -> RetainerSize -> RetainerSize
<> :: RetainerSize -> RetainerSize -> RetainerSize
$csconcat :: NonEmpty RetainerSize -> RetainerSize
sconcat :: NonEmpty RetainerSize -> RetainerSize
$cstimes :: forall b. Integral b => b -> RetainerSize -> RetainerSize
stimes :: forall b. Integral b => b -> RetainerSize -> RetainerSize
Semigroup, Semigroup RetainerSize
RetainerSize
Semigroup RetainerSize
-> RetainerSize
-> (RetainerSize -> RetainerSize -> RetainerSize)
-> ([RetainerSize] -> RetainerSize)
-> Monoid RetainerSize
[RetainerSize] -> RetainerSize
RetainerSize -> RetainerSize -> RetainerSize
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: RetainerSize
mempty :: RetainerSize
$cmappend :: RetainerSize -> RetainerSize -> RetainerSize
mappend :: RetainerSize -> RetainerSize -> RetainerSize
$cmconcat :: [RetainerSize] -> RetainerSize
mconcat :: [RetainerSize] -> RetainerSize
Monoid) via (Sum Int)


noSize :: DebugClosureWithSize ccs srt pap string s b -> DebugClosure ccs srt pap string s b
noSize :: forall ccs srt pap string s b.
DebugClosureWithSize ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
noSize = DebugClosureWithExtra Size ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
forall x ccs srt pap string s b.
DebugClosureWithExtra x ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
unDCS

dcSize :: DebugClosureWithSize ccs srt pap string s b -> Size
dcSize :: forall ccs srt pap string s b.
DebugClosureWithSize ccs srt pap string s b -> Size
dcSize = DebugClosureWithExtra Size ccs srt pap string s b -> Size
forall x ccs srt pap string s b.
DebugClosureWithExtra x ccs srt pap string s b -> x
extraDCS

instance Hextraversable (DebugClosureWithExtra x) where
  hextraverse :: forall (f :: * -> *) a b c d e g h i j k l n.
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)
hextraverse a -> f b
f c -> f d
g e -> f g
h h -> f i
i j -> f k
j l -> f n
k (DCS x
x DebugClosure a c e h j l
v) = x
-> DebugClosure b d g i k n -> DebugClosureWithExtra x b d g i k n
forall x ccs srt pap string s b.
x
-> DebugClosure ccs srt pap string s b
-> DebugClosureWithExtra x ccs srt pap string s b
DCS x
x (DebugClosure b d g i k n -> DebugClosureWithExtra x b d g i k n)
-> f (DebugClosure b d g i k n)
-> f (DebugClosureWithExtra x b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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)
forall (f :: * -> *) a b c d e g h i j k l n.
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)
forall (m :: * -> * -> * -> * -> * -> * -> *) (f :: * -> *) a b c d
       e g h i j k l n.
(Hextraversable m, 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)
hextraverse a -> f b
f c -> f d
g e -> f g
h h -> f i
i j -> f k
j l -> f n
k DebugClosure a c e h j l
v



data StgInfoTableWithPtr = StgInfoTableWithPtr {
                              StgInfoTableWithPtr -> InfoTablePtr
tableId :: InfoTablePtr
                            , StgInfoTableWithPtr -> StgInfoTable
decodedTable :: StgInfoTable
                            } deriving (Int -> StgInfoTableWithPtr -> ShowS
[StgInfoTableWithPtr] -> ShowS
StgInfoTableWithPtr -> String
(Int -> StgInfoTableWithPtr -> ShowS)
-> (StgInfoTableWithPtr -> String)
-> ([StgInfoTableWithPtr] -> ShowS)
-> Show StgInfoTableWithPtr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StgInfoTableWithPtr -> ShowS
showsPrec :: Int -> StgInfoTableWithPtr -> ShowS
$cshow :: StgInfoTableWithPtr -> String
show :: StgInfoTableWithPtr -> String
$cshowList :: [StgInfoTableWithPtr] -> ShowS
showList :: [StgInfoTableWithPtr] -> ShowS
Show)

instance Ord StgInfoTableWithPtr where
  compare :: StgInfoTableWithPtr -> StgInfoTableWithPtr -> Ordering
compare StgInfoTableWithPtr
t1 StgInfoTableWithPtr
t2 = InfoTablePtr -> InfoTablePtr -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (StgInfoTableWithPtr -> InfoTablePtr
tableId StgInfoTableWithPtr
t1) (StgInfoTableWithPtr -> InfoTablePtr
tableId StgInfoTableWithPtr
t2)

instance Eq StgInfoTableWithPtr where
  StgInfoTableWithPtr
t1 == :: StgInfoTableWithPtr -> StgInfoTableWithPtr -> Bool
== StgInfoTableWithPtr
t2 = StgInfoTableWithPtr -> InfoTablePtr
tableId StgInfoTableWithPtr
t1 InfoTablePtr -> InfoTablePtr -> Bool
forall a. Eq a => a -> a -> Bool
== StgInfoTableWithPtr -> InfoTablePtr
tableId StgInfoTableWithPtr
t2

data ProfHeader a = ProfHeader { forall a. ProfHeader a -> a
ccs :: a, forall a. ProfHeader a -> ProfHeaderWord
hp :: ProfHeaderWord }
  deriving (ProfHeader a -> ProfHeader a -> Bool
(ProfHeader a -> ProfHeader a -> Bool)
-> (ProfHeader a -> ProfHeader a -> Bool) -> Eq (ProfHeader a)
forall a. Eq a => ProfHeader a -> ProfHeader a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ProfHeader a -> ProfHeader a -> Bool
== :: ProfHeader a -> ProfHeader a -> Bool
$c/= :: forall a. Eq a => ProfHeader a -> ProfHeader a -> Bool
/= :: ProfHeader a -> ProfHeader a -> Bool
Eq, Eq (ProfHeader a)
Eq (ProfHeader a)
-> (ProfHeader a -> ProfHeader a -> Ordering)
-> (ProfHeader a -> ProfHeader a -> Bool)
-> (ProfHeader a -> ProfHeader a -> Bool)
-> (ProfHeader a -> ProfHeader a -> Bool)
-> (ProfHeader a -> ProfHeader a -> Bool)
-> (ProfHeader a -> ProfHeader a -> ProfHeader a)
-> (ProfHeader a -> ProfHeader a -> ProfHeader a)
-> Ord (ProfHeader a)
ProfHeader a -> ProfHeader a -> Bool
ProfHeader a -> ProfHeader a -> Ordering
ProfHeader a -> ProfHeader a -> ProfHeader a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (ProfHeader a)
forall a. Ord a => ProfHeader a -> ProfHeader a -> Bool
forall a. Ord a => ProfHeader a -> ProfHeader a -> Ordering
forall a. Ord a => ProfHeader a -> ProfHeader a -> ProfHeader a
$ccompare :: forall a. Ord a => ProfHeader a -> ProfHeader a -> Ordering
compare :: ProfHeader a -> ProfHeader a -> Ordering
$c< :: forall a. Ord a => ProfHeader a -> ProfHeader a -> Bool
< :: ProfHeader a -> ProfHeader a -> Bool
$c<= :: forall a. Ord a => ProfHeader a -> ProfHeader a -> Bool
<= :: ProfHeader a -> ProfHeader a -> Bool
$c> :: forall a. Ord a => ProfHeader a -> ProfHeader a -> Bool
> :: ProfHeader a -> ProfHeader a -> Bool
$c>= :: forall a. Ord a => ProfHeader a -> ProfHeader a -> Bool
>= :: ProfHeader a -> ProfHeader a -> Bool
$cmax :: forall a. Ord a => ProfHeader a -> ProfHeader a -> ProfHeader a
max :: ProfHeader a -> ProfHeader a -> ProfHeader a
$cmin :: forall a. Ord a => ProfHeader a -> ProfHeader a -> ProfHeader a
min :: ProfHeader a -> ProfHeader a -> ProfHeader a
Ord, Int -> ProfHeader a -> ShowS
[ProfHeader a] -> ShowS
ProfHeader a -> String
(Int -> ProfHeader a -> ShowS)
-> (ProfHeader a -> String)
-> ([ProfHeader a] -> ShowS)
-> Show (ProfHeader a)
forall a. Show a => Int -> ProfHeader a -> ShowS
forall a. Show a => [ProfHeader a] -> ShowS
forall a. Show a => ProfHeader a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ProfHeader a -> ShowS
showsPrec :: Int -> ProfHeader a -> ShowS
$cshow :: forall a. Show a => ProfHeader a -> String
show :: ProfHeader a -> String
$cshowList :: forall a. Show a => [ProfHeader a] -> ShowS
showList :: [ProfHeader a] -> ShowS
Show, (forall a b. (a -> b) -> ProfHeader a -> ProfHeader b)
-> (forall a b. a -> ProfHeader b -> ProfHeader a)
-> Functor ProfHeader
forall a b. a -> ProfHeader b -> ProfHeader a
forall a b. (a -> b) -> ProfHeader a -> ProfHeader b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ProfHeader a -> ProfHeader b
fmap :: forall a b. (a -> b) -> ProfHeader a -> ProfHeader b
$c<$ :: forall a b. a -> ProfHeader b -> ProfHeader a
<$ :: forall a b. a -> ProfHeader b -> ProfHeader a
Functor, (forall m. Monoid m => ProfHeader m -> m)
-> (forall m a. Monoid m => (a -> m) -> ProfHeader a -> m)
-> (forall m a. Monoid m => (a -> m) -> ProfHeader a -> m)
-> (forall a b. (a -> b -> b) -> b -> ProfHeader a -> b)
-> (forall a b. (a -> b -> b) -> b -> ProfHeader a -> b)
-> (forall b a. (b -> a -> b) -> b -> ProfHeader a -> b)
-> (forall b a. (b -> a -> b) -> b -> ProfHeader a -> b)
-> (forall a. (a -> a -> a) -> ProfHeader a -> a)
-> (forall a. (a -> a -> a) -> ProfHeader a -> a)
-> (forall a. ProfHeader a -> [a])
-> (forall a. ProfHeader a -> Bool)
-> (forall a. ProfHeader a -> Int)
-> (forall a. Eq a => a -> ProfHeader a -> Bool)
-> (forall a. Ord a => ProfHeader a -> a)
-> (forall a. Ord a => ProfHeader a -> a)
-> (forall a. Num a => ProfHeader a -> a)
-> (forall a. Num a => ProfHeader a -> a)
-> Foldable ProfHeader
forall a. Eq a => a -> ProfHeader a -> Bool
forall a. Num a => ProfHeader a -> a
forall a. Ord a => ProfHeader a -> a
forall m. Monoid m => ProfHeader m -> m
forall a. ProfHeader a -> Bool
forall a. ProfHeader a -> Int
forall a. ProfHeader a -> [a]
forall a. (a -> a -> a) -> ProfHeader a -> a
forall m a. Monoid m => (a -> m) -> ProfHeader a -> m
forall b a. (b -> a -> b) -> b -> ProfHeader a -> b
forall a b. (a -> b -> b) -> b -> ProfHeader a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ProfHeader m -> m
fold :: forall m. Monoid m => ProfHeader m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ProfHeader a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ProfHeader a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ProfHeader a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ProfHeader a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ProfHeader a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ProfHeader a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ProfHeader a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ProfHeader a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ProfHeader a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ProfHeader a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ProfHeader a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ProfHeader a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ProfHeader a -> a
foldr1 :: forall a. (a -> a -> a) -> ProfHeader a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ProfHeader a -> a
foldl1 :: forall a. (a -> a -> a) -> ProfHeader a -> a
$ctoList :: forall a. ProfHeader a -> [a]
toList :: forall a. ProfHeader a -> [a]
$cnull :: forall a. ProfHeader a -> Bool
null :: forall a. ProfHeader a -> Bool
$clength :: forall a. ProfHeader a -> Int
length :: forall a. ProfHeader a -> Int
$celem :: forall a. Eq a => a -> ProfHeader a -> Bool
elem :: forall a. Eq a => a -> ProfHeader a -> Bool
$cmaximum :: forall a. Ord a => ProfHeader a -> a
maximum :: forall a. Ord a => ProfHeader a -> a
$cminimum :: forall a. Ord a => ProfHeader a -> a
minimum :: forall a. Ord a => ProfHeader a -> a
$csum :: forall a. Num a => ProfHeader a -> a
sum :: forall a. Num a => ProfHeader a -> a
$cproduct :: forall a. Num a => ProfHeader a -> a
product :: forall a. Num a => ProfHeader a -> a
Foldable, Functor ProfHeader
Foldable ProfHeader
Functor ProfHeader
-> Foldable ProfHeader
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ProfHeader (f a) -> f (ProfHeader a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ProfHeader a -> m (ProfHeader b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ProfHeader (m a) -> m (ProfHeader a))
-> Traversable ProfHeader
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ProfHeader (m a) -> m (ProfHeader a)
forall (f :: * -> *) a.
Applicative f =>
ProfHeader (f a) -> f (ProfHeader a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ProfHeader a -> m (ProfHeader b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ProfHeader (f a) -> f (ProfHeader a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ProfHeader (f a) -> f (ProfHeader a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ProfHeader a -> m (ProfHeader b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ProfHeader a -> m (ProfHeader b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ProfHeader (m a) -> m (ProfHeader a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ProfHeader (m a) -> m (ProfHeader a)
Traversable)

data ProfHeaderWord
  = RetainerHeader { ProfHeaderWord -> Bool
trav :: !Bool, ProfHeaderWord -> RetainerSetPtr
retainerSet :: !RetainerSetPtr }
  | LDVWord { ProfHeaderWord -> Bool
state :: !Bool, ProfHeaderWord -> HalfWord
creationTime :: !Word32, ProfHeaderWord -> HalfWord
lastUseTime :: !Word32 }
  | EraWord Word64
  | OtherHeader Word64
  deriving (ProfHeaderWord -> ProfHeaderWord -> Bool
(ProfHeaderWord -> ProfHeaderWord -> Bool)
-> (ProfHeaderWord -> ProfHeaderWord -> Bool) -> Eq ProfHeaderWord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProfHeaderWord -> ProfHeaderWord -> Bool
== :: ProfHeaderWord -> ProfHeaderWord -> Bool
$c/= :: ProfHeaderWord -> ProfHeaderWord -> Bool
/= :: ProfHeaderWord -> ProfHeaderWord -> Bool
Eq, Eq ProfHeaderWord
Eq ProfHeaderWord
-> (ProfHeaderWord -> ProfHeaderWord -> Ordering)
-> (ProfHeaderWord -> ProfHeaderWord -> Bool)
-> (ProfHeaderWord -> ProfHeaderWord -> Bool)
-> (ProfHeaderWord -> ProfHeaderWord -> Bool)
-> (ProfHeaderWord -> ProfHeaderWord -> Bool)
-> (ProfHeaderWord -> ProfHeaderWord -> ProfHeaderWord)
-> (ProfHeaderWord -> ProfHeaderWord -> ProfHeaderWord)
-> Ord ProfHeaderWord
ProfHeaderWord -> ProfHeaderWord -> Bool
ProfHeaderWord -> ProfHeaderWord -> Ordering
ProfHeaderWord -> ProfHeaderWord -> ProfHeaderWord
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ProfHeaderWord -> ProfHeaderWord -> Ordering
compare :: ProfHeaderWord -> ProfHeaderWord -> Ordering
$c< :: ProfHeaderWord -> ProfHeaderWord -> Bool
< :: ProfHeaderWord -> ProfHeaderWord -> Bool
$c<= :: ProfHeaderWord -> ProfHeaderWord -> Bool
<= :: ProfHeaderWord -> ProfHeaderWord -> Bool
$c> :: ProfHeaderWord -> ProfHeaderWord -> Bool
> :: ProfHeaderWord -> ProfHeaderWord -> Bool
$c>= :: ProfHeaderWord -> ProfHeaderWord -> Bool
>= :: ProfHeaderWord -> ProfHeaderWord -> Bool
$cmax :: ProfHeaderWord -> ProfHeaderWord -> ProfHeaderWord
max :: ProfHeaderWord -> ProfHeaderWord -> ProfHeaderWord
$cmin :: ProfHeaderWord -> ProfHeaderWord -> ProfHeaderWord
min :: ProfHeaderWord -> ProfHeaderWord -> ProfHeaderWord
Ord, Int -> ProfHeaderWord -> ShowS
[ProfHeaderWord] -> ShowS
ProfHeaderWord -> String
(Int -> ProfHeaderWord -> ShowS)
-> (ProfHeaderWord -> String)
-> ([ProfHeaderWord] -> ShowS)
-> Show ProfHeaderWord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProfHeaderWord -> ShowS
showsPrec :: Int -> ProfHeaderWord -> ShowS
$cshow :: ProfHeaderWord -> String
show :: ProfHeaderWord -> String
$cshowList :: [ProfHeaderWord] -> ShowS
showList :: [ProfHeaderWord] -> ShowS
Show)

type ProfHeaderWithPtr = ProfHeader CCSPtr

-- | 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.
data DebugClosure ccs srt pap string s b
  = -- | A data constructor
    ConstrClosure
        { forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> StgInfoTableWithPtr
info       :: !StgInfoTableWithPtr
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Maybe (ProfHeader ccs)
profHeader :: Maybe (ProfHeader ccs)
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> [b]
ptrArgs    :: ![b]            -- ^ Pointer arguments
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> [Word]
dataArgs   :: ![Word]         -- ^ Non-pointer arguments
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> string
constrDesc :: !string
        }

    -- | A function
  | FunClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> srt
srt        :: !(srt)
        , ptrArgs    :: ![b]            -- ^ Pointer arguments
        , dataArgs   :: ![Word]         -- ^ Non-pointer arguments
        }

    -- | A thunk, an expression not obviously in head normal form
  | ThunkClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , srt        :: !(srt)
        , ptrArgs    :: ![b]            -- ^ Pointer arguments
        , dataArgs   :: ![Word]         -- ^ Non-pointer arguments
        }

    -- | A thunk which performs a simple selection operation
  | SelectorClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
selectee   :: !b              -- ^ Pointer to the object being
                                        --   selected from
        }

    -- | An unsaturated function application
  | PAPClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> HalfWord
arity      :: !HalfWord       -- ^ Arity of the partial application
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> HalfWord
n_args     :: !HalfWord       -- ^ Size of the payload in words
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
fun        :: !b              -- ^ Pointer to a 'FunClosure'
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> pap
pap_payload    :: !pap            -- ^ Sequence of already applied
                                        --   arguments
        }

    -- In GHCi, if Linker.h would allow a reverse lookup, we could for exported
    -- functions fun actually find the name here.
    -- At least the other direction works via "lookupSymbol
    -- base_GHCziBase_zpzp_closure" and yields the same address (up to tags)
    -- | A function application
  | APClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , arity      :: !HalfWord       -- ^ Always 0
        , n_args     :: !HalfWord       -- ^ Size of payload in words
        , fun        :: !b              -- ^ Pointer to a 'FunClosure'
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> pap
ap_payload    :: !pap            -- ^ Sequence of already applied
                                        --   arguments
        }

    -- | A suspended thunk evaluation
  | APStackClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Word
ap_st_size :: !Word
        , fun        :: !b              -- ^ Function closure
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> s
payload    :: !s            -- ^ Stack right before suspension
        }

    -- | A pointer to another closure, introduced when a thunk is updated
    -- to point at its value
  | IndClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
indirectee :: !b              -- ^ Target closure
        }

   -- | A byte-code object (BCO) which can be interpreted by GHC's byte-code
   -- interpreter (e.g. as used by GHCi)
  | BCOClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
instrs     :: !b              -- ^ A pointer to an ArrWords
                                        --   of instructions
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
literals   :: !b              -- ^ A pointer to an ArrWords
                                        --   of literals
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
bcoptrs    :: !b              -- ^ A pointer to an ArrWords
                                        --   of byte code objects
        , arity      :: !HalfWord       -- ^ The arity of this BCO
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> HalfWord
size       :: !HalfWord       -- ^ The size of this BCO in words
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> [Word]
bitmap     :: ![Word]         -- ^ An StgLargeBitmap describing the
                                        --   pointerhood of its args/free vars
        }

    -- | A thunk under evaluation by another thread
  | BlackholeClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , indirectee :: !b              -- ^ The target closure
        }

    -- | A @ByteArray#@
  | ArrWordsClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Word
bytes      :: !Word           -- ^ Size of array in bytes
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> [Word]
arrWords   :: ![Word]         -- ^ Array payload
        }

    -- | A @MutableByteArray#@
  | MutArrClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Word
mccPtrs    :: !Word           -- ^ Number of pointers
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Word
mccSize    :: !Word           -- ^ ?? Closures.h vs ClosureMacros.h
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> [b]
mccPayload :: ![b]            -- ^ Array payload
        -- Card table ignored
        }

    -- | A @SmallMutableArray#@
    --
    -- @since 8.10.1
  | SmallMutArrClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , mccPtrs    :: !Word           -- ^ Number of pointers
        , mccPayload :: ![b]            -- ^ Array payload
        }

    -- | An @MVar#@, with a queue of thread state objects blocking on them
  | MVarClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
queueHead  :: !b              -- ^ Pointer to head of queue
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
queueTail  :: !b              -- ^ Pointer to tail of queue
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
value      :: !b              -- ^ Pointer to closure
        }

    -- | A @MutVar#@
  | MutVarClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
var        :: !b              -- ^ Pointer to contents
        }

    -- | An STM blocking queue.
  | BlockingQueueClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
link       :: !b              -- ^ ?? Here so it looks like an IND
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
blackHole  :: !b              -- ^ The blackhole closure
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
owner      :: !b              -- ^ The owning thread state object
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
queue      :: !b              -- ^ ??
        }

  | TSOClosure
      { info :: !StgInfoTableWithPtr
      , profHeader :: Maybe (ProfHeader ccs)
      -- pointers
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
_link :: !b
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
global_link :: !b
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
tsoStack :: !b -- ^ stackobj from StgTSO
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
trec :: !b
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
blocked_exceptions :: !b
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
bq :: !b
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Maybe b
threadLabel :: !(Maybe b)
      -- values
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> WhatNext
what_next :: WhatNext
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> WhyBlocked
why_blocked :: WhyBlocked
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> [TsoFlags]
flags :: [TsoFlags]
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Word64
threadId :: Word64
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> HalfWord
saved_errno :: Word32
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> HalfWord
dirty :: Word32
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Int64
alloc_limit :: Int64
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> HalfWord
tot_stack_size :: Word32
      , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Maybe StgTSOProfInfo
prof :: Maybe StgTSOProfInfo
      }

 | StackClosure
     { info :: !StgInfoTableWithPtr
     , profHeader :: Maybe (ProfHeader ccs)
     , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> HalfWord
stack_size :: !Word32 -- ^ stack size in *words*
     , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Word8
stack_dirty :: !Word8 -- ^ non-zero => dirty
     , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Word8
stack_marking :: !Word8
     , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> s
frames :: s
     }


  | WeakClosure
     { info        :: !StgInfoTableWithPtr
     , profHeader :: Maybe (ProfHeader ccs)
     , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
cfinalizers :: !b
     , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
key         :: !b
     , value       :: !b
     , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
finalizer   :: !b
     , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Maybe b
mlink       :: !(Maybe b) -- ^ next weak pointer for the capability, can be NULL.
     }

  | TVarClosure
    { info :: !StgInfoTableWithPtr
    , profHeader :: Maybe (ProfHeader ccs)
    , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
current_value :: !b
    , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
tvar_watch_queue :: !b
    , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Int
num_updates :: !Int }

  | TRecChunkClosure
    { info :: !StgInfoTableWithPtr
    , profHeader :: Maybe (ProfHeader ccs)
    , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> b
prev_chunk  :: !b
    , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Word
next_idx :: !Word
    , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> [TRecEntry b]
entries :: ![TRecEntry b]
    }

  | MutPrimClosure
    { info :: !StgInfoTableWithPtr
    , profHeader :: Maybe (ProfHeader ccs)
    , ptrArgs :: ![b]
    , dataArgs :: ![Word]
    }

  | PrimClosure
    { info :: !StgInfoTableWithPtr
    , profHeader :: Maybe (ProfHeader ccs)
    , ptrArgs :: ![b]
    , dataArgs :: ![Word]
    }

    -----------------------------------------------------------
    -- Anything else

    -- | Another kind of closure
  | OtherClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> [b]
hvalues    :: ![b]
        , forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> [Word]
rawWords   :: ![Word]
        }

  | UnsupportedClosure
        { info       :: !StgInfoTableWithPtr
        , profHeader :: Maybe (ProfHeader ccs)
        }
  deriving (Int -> DebugClosure ccs srt pap string s b -> ShowS
[DebugClosure ccs srt pap string s b] -> ShowS
DebugClosure ccs srt pap string s b -> String
(Int -> DebugClosure ccs srt pap string s b -> ShowS)
-> (DebugClosure ccs srt pap string s b -> String)
-> ([DebugClosure ccs srt pap string s b] -> ShowS)
-> Show (DebugClosure ccs srt pap string s b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ccs srt pap string s b.
(Show ccs, Show string, Show srt, Show pap, Show s, Show b) =>
Int -> DebugClosure ccs srt pap string s b -> ShowS
forall ccs srt pap string s b.
(Show ccs, Show string, Show srt, Show pap, Show s, Show b) =>
[DebugClosure ccs srt pap string s b] -> ShowS
forall ccs srt pap string s b.
(Show ccs, Show string, Show srt, Show pap, Show s, Show b) =>
DebugClosure ccs srt pap string s b -> String
$cshowsPrec :: forall ccs srt pap string s b.
(Show ccs, Show string, Show srt, Show pap, Show s, Show b) =>
Int -> DebugClosure ccs srt pap string s b -> ShowS
showsPrec :: Int -> DebugClosure ccs srt pap string s b -> ShowS
$cshow :: forall ccs srt pap string s b.
(Show ccs, Show string, Show srt, Show pap, Show s, Show b) =>
DebugClosure ccs srt pap string s b -> String
show :: DebugClosure ccs srt pap string s b -> String
$cshowList :: forall ccs srt pap string s b.
(Show ccs, Show string, Show srt, Show pap, Show s, Show b) =>
[DebugClosure ccs srt pap string s b] -> ShowS
showList :: [DebugClosure ccs srt pap string s b] -> ShowS
Show, (forall x.
 DebugClosure ccs srt pap string s b
 -> Rep (DebugClosure ccs srt pap string s b) x)
-> (forall x.
    Rep (DebugClosure ccs srt pap string s b) x
    -> DebugClosure ccs srt pap string s b)
-> Generic (DebugClosure ccs srt pap string s b)
forall x.
Rep (DebugClosure ccs srt pap string s b) x
-> DebugClosure ccs srt pap string s b
forall x.
DebugClosure ccs srt pap string s b
-> Rep (DebugClosure ccs srt pap string s b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ccs srt pap string s b x.
Rep (DebugClosure ccs srt pap string s b) x
-> DebugClosure ccs srt pap string s b
forall ccs srt pap string s b x.
DebugClosure ccs srt pap string s b
-> Rep (DebugClosure ccs srt pap string s b) x
$cfrom :: forall ccs srt pap string s b x.
DebugClosure ccs srt pap string s b
-> Rep (DebugClosure ccs srt pap string s b) x
from :: forall x.
DebugClosure ccs srt pap string s b
-> Rep (DebugClosure ccs srt pap string s b) x
$cto :: forall ccs srt pap string s b x.
Rep (DebugClosure ccs srt pap string s b) x
-> DebugClosure ccs srt pap string s b
to :: forall x.
Rep (DebugClosure ccs srt pap string s b) x
-> DebugClosure ccs srt pap string s b
Generic, (forall a b.
 (a -> b)
 -> DebugClosure ccs srt pap string s a
 -> DebugClosure ccs srt pap string s b)
-> (forall a b.
    a
    -> DebugClosure ccs srt pap string s b
    -> DebugClosure ccs srt pap string s a)
-> Functor (DebugClosure ccs srt pap string s)
forall a b.
a
-> DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s a
forall a b.
(a -> b)
-> DebugClosure ccs srt pap string s a
-> DebugClosure ccs srt pap string s b
forall ccs srt pap string s a b.
a
-> DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s a
forall ccs srt pap string s a b.
(a -> b)
-> DebugClosure ccs srt pap string s a
-> DebugClosure ccs srt pap string s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall ccs srt pap string s a b.
(a -> b)
-> DebugClosure ccs srt pap string s a
-> DebugClosure ccs srt pap string s b
fmap :: forall a b.
(a -> b)
-> DebugClosure ccs srt pap string s a
-> DebugClosure ccs srt pap string s b
$c<$ :: forall ccs srt pap string s a b.
a
-> DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s a
<$ :: forall a b.
a
-> DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s a
Functor, (forall m. Monoid m => DebugClosure ccs srt pap string s m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> DebugClosure ccs srt pap string s a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> DebugClosure ccs srt pap string s a -> m)
-> (forall a b.
    (a -> b -> b) -> b -> DebugClosure ccs srt pap string s a -> b)
-> (forall a b.
    (a -> b -> b) -> b -> DebugClosure ccs srt pap string s a -> b)
-> (forall b a.
    (b -> a -> b) -> b -> DebugClosure ccs srt pap string s a -> b)
-> (forall b a.
    (b -> a -> b) -> b -> DebugClosure ccs srt pap string s a -> b)
-> (forall a.
    (a -> a -> a) -> DebugClosure ccs srt pap string s a -> a)
-> (forall a.
    (a -> a -> a) -> DebugClosure ccs srt pap string s a -> a)
-> (forall a. DebugClosure ccs srt pap string s a -> [a])
-> (forall a. DebugClosure ccs srt pap string s a -> Bool)
-> (forall a. DebugClosure ccs srt pap string s a -> Int)
-> (forall a.
    Eq a =>
    a -> DebugClosure ccs srt pap string s a -> Bool)
-> (forall a. Ord a => DebugClosure ccs srt pap string s a -> a)
-> (forall a. Ord a => DebugClosure ccs srt pap string s a -> a)
-> (forall a. Num a => DebugClosure ccs srt pap string s a -> a)
-> (forall a. Num a => DebugClosure ccs srt pap string s a -> a)
-> Foldable (DebugClosure ccs srt pap string s)
forall a. Eq a => a -> DebugClosure ccs srt pap string s a -> Bool
forall a. Num a => DebugClosure ccs srt pap string s a -> a
forall a. Ord a => DebugClosure ccs srt pap string s a -> a
forall m. Monoid m => DebugClosure ccs srt pap string s m -> m
forall a. DebugClosure ccs srt pap string s a -> Bool
forall a. DebugClosure ccs srt pap string s a -> Int
forall a. DebugClosure ccs srt pap string s a -> [a]
forall a. (a -> a -> a) -> DebugClosure ccs srt pap string s a -> a
forall m a.
Monoid m =>
(a -> m) -> DebugClosure ccs srt pap string s a -> m
forall b a.
(b -> a -> b) -> b -> DebugClosure ccs srt pap string s a -> b
forall a b.
(a -> b -> b) -> b -> DebugClosure ccs srt pap string s a -> b
forall ccs srt pap string s a.
Eq a =>
a -> DebugClosure ccs srt pap string s a -> Bool
forall ccs srt pap string s a.
Num a =>
DebugClosure ccs srt pap string s a -> a
forall ccs srt pap string s a.
Ord a =>
DebugClosure ccs srt pap string s a -> a
forall ccs srt pap string s m.
Monoid m =>
DebugClosure ccs srt pap string s m -> m
forall ccs srt pap string s a.
DebugClosure ccs srt pap string s a -> Bool
forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Int
forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> [b]
forall ccs srt pap string s a.
(a -> a -> a) -> DebugClosure ccs srt pap string s a -> a
forall ccs srt pap string s m a.
Monoid m =>
(a -> m) -> DebugClosure ccs srt pap string s a -> m
forall ccs srt pap string s b a.
(b -> a -> b) -> b -> DebugClosure ccs srt pap string s a -> b
forall ccs srt pap string s a b.
(a -> b -> b) -> b -> DebugClosure ccs srt pap string s a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall ccs srt pap string s m.
Monoid m =>
DebugClosure ccs srt pap string s m -> m
fold :: forall m. Monoid m => DebugClosure ccs srt pap string s m -> m
$cfoldMap :: forall ccs srt pap string s m a.
Monoid m =>
(a -> m) -> DebugClosure ccs srt pap string s a -> m
foldMap :: forall m a.
Monoid m =>
(a -> m) -> DebugClosure ccs srt pap string s a -> m
$cfoldMap' :: forall ccs srt pap string s m a.
Monoid m =>
(a -> m) -> DebugClosure ccs srt pap string s a -> m
foldMap' :: forall m a.
Monoid m =>
(a -> m) -> DebugClosure ccs srt pap string s a -> m
$cfoldr :: forall ccs srt pap string s a b.
(a -> b -> b) -> b -> DebugClosure ccs srt pap string s a -> b
foldr :: forall a b.
(a -> b -> b) -> b -> DebugClosure ccs srt pap string s a -> b
$cfoldr' :: forall ccs srt pap string s a b.
(a -> b -> b) -> b -> DebugClosure ccs srt pap string s a -> b
foldr' :: forall a b.
(a -> b -> b) -> b -> DebugClosure ccs srt pap string s a -> b
$cfoldl :: forall ccs srt pap string s b a.
(b -> a -> b) -> b -> DebugClosure ccs srt pap string s a -> b
foldl :: forall b a.
(b -> a -> b) -> b -> DebugClosure ccs srt pap string s a -> b
$cfoldl' :: forall ccs srt pap string s b a.
(b -> a -> b) -> b -> DebugClosure ccs srt pap string s a -> b
foldl' :: forall b a.
(b -> a -> b) -> b -> DebugClosure ccs srt pap string s a -> b
$cfoldr1 :: forall ccs srt pap string s a.
(a -> a -> a) -> DebugClosure ccs srt pap string s a -> a
foldr1 :: forall a. (a -> a -> a) -> DebugClosure ccs srt pap string s a -> a
$cfoldl1 :: forall ccs srt pap string s a.
(a -> a -> a) -> DebugClosure ccs srt pap string s a -> a
foldl1 :: forall a. (a -> a -> a) -> DebugClosure ccs srt pap string s a -> a
$ctoList :: forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> [b]
toList :: forall a. DebugClosure ccs srt pap string s a -> [a]
$cnull :: forall ccs srt pap string s a.
DebugClosure ccs srt pap string s a -> Bool
null :: forall a. DebugClosure ccs srt pap string s a -> Bool
$clength :: forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> Int
length :: forall a. DebugClosure ccs srt pap string s a -> Int
$celem :: forall ccs srt pap string s a.
Eq a =>
a -> DebugClosure ccs srt pap string s a -> Bool
elem :: forall a. Eq a => a -> DebugClosure ccs srt pap string s a -> Bool
$cmaximum :: forall ccs srt pap string s a.
Ord a =>
DebugClosure ccs srt pap string s a -> a
maximum :: forall a. Ord a => DebugClosure ccs srt pap string s a -> a
$cminimum :: forall ccs srt pap string s a.
Ord a =>
DebugClosure ccs srt pap string s a -> a
minimum :: forall a. Ord a => DebugClosure ccs srt pap string s a -> a
$csum :: forall ccs srt pap string s a.
Num a =>
DebugClosure ccs srt pap string s a -> a
sum :: forall a. Num a => DebugClosure ccs srt pap string s a -> a
$cproduct :: forall ccs srt pap string s a.
Num a =>
DebugClosure ccs srt pap string s a -> a
product :: forall a. Num a => DebugClosure ccs srt pap string s a -> a
Foldable, Functor (DebugClosure ccs srt pap string s)
Foldable (DebugClosure ccs srt pap string s)
Functor (DebugClosure ccs srt pap string s)
-> Foldable (DebugClosure ccs srt pap string s)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b)
    -> DebugClosure ccs srt pap string s a
    -> f (DebugClosure ccs srt pap string s b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    DebugClosure ccs srt pap string s (f a)
    -> f (DebugClosure ccs srt pap string s a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b)
    -> DebugClosure ccs srt pap string s a
    -> m (DebugClosure ccs srt pap string s b))
-> (forall (m :: * -> *) a.
    Monad m =>
    DebugClosure ccs srt pap string s (m a)
    -> m (DebugClosure ccs srt pap string s a))
-> Traversable (DebugClosure ccs srt pap string s)
forall ccs srt pap string s.
Functor (DebugClosure ccs srt pap string s)
forall ccs srt pap string s.
Foldable (DebugClosure ccs srt pap string s)
forall ccs srt pap string s (m :: * -> *) a.
Monad m =>
DebugClosure ccs srt pap string s (m a)
-> m (DebugClosure ccs srt pap string s a)
forall ccs srt pap string s (f :: * -> *) a.
Applicative f =>
DebugClosure ccs srt pap string s (f a)
-> f (DebugClosure ccs srt pap string s a)
forall ccs srt pap string s (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> DebugClosure ccs srt pap string s a
-> m (DebugClosure ccs srt pap string s b)
forall ccs srt pap string s (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> DebugClosure ccs srt pap string s a
-> f (DebugClosure ccs srt pap string s b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
DebugClosure ccs srt pap string s (m a)
-> m (DebugClosure ccs srt pap string s a)
forall (f :: * -> *) a.
Applicative f =>
DebugClosure ccs srt pap string s (f a)
-> f (DebugClosure ccs srt pap string s a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> DebugClosure ccs srt pap string s a
-> m (DebugClosure ccs srt pap string s b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> DebugClosure ccs srt pap string s a
-> f (DebugClosure ccs srt pap string s b)
$ctraverse :: forall ccs srt pap string s (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> DebugClosure ccs srt pap string s a
-> f (DebugClosure ccs srt pap string s b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> DebugClosure ccs srt pap string s a
-> f (DebugClosure ccs srt pap string s b)
$csequenceA :: forall ccs srt pap string s (f :: * -> *) a.
Applicative f =>
DebugClosure ccs srt pap string s (f a)
-> f (DebugClosure ccs srt pap string s a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
DebugClosure ccs srt pap string s (f a)
-> f (DebugClosure ccs srt pap string s a)
$cmapM :: forall ccs srt pap string s (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> DebugClosure ccs srt pap string s a
-> m (DebugClosure ccs srt pap string s b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> DebugClosure ccs srt pap string s a
-> m (DebugClosure ccs srt pap string s b)
$csequence :: forall ccs srt pap string s (m :: * -> *) a.
Monad m =>
DebugClosure ccs srt pap string s (m a)
-> m (DebugClosure ccs srt pap string s a)
sequence :: forall (m :: * -> *) a.
Monad m =>
DebugClosure ccs srt pap string s (m a)
-> m (DebugClosure ccs srt pap string s a)
Traversable, Eq (DebugClosure ccs srt pap string s b)
Eq (DebugClosure ccs srt pap string s b)
-> (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)
-> (DebugClosure ccs srt pap string s b
    -> DebugClosure ccs srt pap string s b
    -> DebugClosure ccs srt pap string s b)
-> (DebugClosure ccs srt pap string s b
    -> DebugClosure ccs srt pap string s b
    -> DebugClosure ccs srt pap string s b)
-> Ord (DebugClosure ccs srt pap string s b)
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 -> Ordering
DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {ccs} {srt} {pap} {string} {s} {b}.
(Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
Eq (DebugClosure ccs srt pap string s b)
forall ccs srt pap string s b.
(Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s b -> Bool
forall ccs srt pap string s b.
(Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s b -> Ordering
forall ccs srt pap string s b.
(Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
$ccompare :: forall ccs srt pap string s b.
(Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s b -> Ordering
compare :: DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s b -> Ordering
$c< :: forall ccs srt pap string s b.
(Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
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
$c<= :: forall ccs srt pap string s b.
(Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
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
$c> :: forall ccs srt pap string s b.
(Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
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
$c>= :: forall ccs srt pap string s b.
(Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
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
$cmax :: forall ccs srt pap string s b.
(Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
max :: DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
$cmin :: forall ccs srt pap string s b.
(Ord ccs, Ord string, Ord srt, Ord pap, Ord s, Ord b) =>
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
Ord, 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)
-> Eq (DebugClosure ccs srt pap string s b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ccs srt pap string s b.
(Eq ccs, Eq string, Eq srt, Eq pap, Eq s, Eq b) =>
DebugClosure ccs srt pap string s b
-> DebugClosure ccs srt pap string s b -> Bool
$c== :: forall ccs srt pap string s b.
(Eq ccs, Eq string, Eq srt, Eq pap, Eq s, Eq b) =>
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
$c/= :: forall ccs srt pap string s b.
(Eq ccs, Eq string, Eq srt, Eq pap, Eq s, Eq b) =>
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
Eq)

data TRecEntry b = TRecEntry { forall b. TRecEntry b -> b
tvar :: !b
                             , forall b. TRecEntry b -> b
expected_value :: !b
                             , forall b. TRecEntry b -> b
new_value :: !b
                             , forall b. TRecEntry b -> Int
trec_num_updates :: Int -- Only in THREADED, TODO: This is not an Int,
                                                       -- is it a pointer
                                                       -- to a haskell int
                             } deriving (Int -> TRecEntry b -> ShowS
[TRecEntry b] -> ShowS
TRecEntry b -> String
(Int -> TRecEntry b -> ShowS)
-> (TRecEntry b -> String)
-> ([TRecEntry b] -> ShowS)
-> Show (TRecEntry b)
forall b. Show b => Int -> TRecEntry b -> ShowS
forall b. Show b => [TRecEntry b] -> ShowS
forall b. Show b => TRecEntry b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall b. Show b => Int -> TRecEntry b -> ShowS
showsPrec :: Int -> TRecEntry b -> ShowS
$cshow :: forall b. Show b => TRecEntry b -> String
show :: TRecEntry b -> String
$cshowList :: forall b. Show b => [TRecEntry b] -> ShowS
showList :: [TRecEntry b] -> ShowS
Show, (forall x. TRecEntry b -> Rep (TRecEntry b) x)
-> (forall x. Rep (TRecEntry b) x -> TRecEntry b)
-> Generic (TRecEntry b)
forall x. Rep (TRecEntry b) x -> TRecEntry b
forall x. TRecEntry b -> Rep (TRecEntry b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall b x. Rep (TRecEntry b) x -> TRecEntry b
forall b x. TRecEntry b -> Rep (TRecEntry b) x
$cfrom :: forall b x. TRecEntry b -> Rep (TRecEntry b) x
from :: forall x. TRecEntry b -> Rep (TRecEntry b) x
$cto :: forall b x. Rep (TRecEntry b) x -> TRecEntry b
to :: forall x. Rep (TRecEntry b) x -> TRecEntry b
Generic, (forall a b. (a -> b) -> TRecEntry a -> TRecEntry b)
-> (forall a b. a -> TRecEntry b -> TRecEntry a)
-> Functor TRecEntry
forall a b. a -> TRecEntry b -> TRecEntry a
forall a b. (a -> b) -> TRecEntry a -> TRecEntry b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> TRecEntry a -> TRecEntry b
fmap :: forall a b. (a -> b) -> TRecEntry a -> TRecEntry b
$c<$ :: forall a b. a -> TRecEntry b -> TRecEntry a
<$ :: forall a b. a -> TRecEntry b -> TRecEntry a
Functor, (forall m. Monoid m => TRecEntry m -> m)
-> (forall m a. Monoid m => (a -> m) -> TRecEntry a -> m)
-> (forall m a. Monoid m => (a -> m) -> TRecEntry a -> m)
-> (forall a b. (a -> b -> b) -> b -> TRecEntry a -> b)
-> (forall a b. (a -> b -> b) -> b -> TRecEntry a -> b)
-> (forall b a. (b -> a -> b) -> b -> TRecEntry a -> b)
-> (forall b a. (b -> a -> b) -> b -> TRecEntry a -> b)
-> (forall a. (a -> a -> a) -> TRecEntry a -> a)
-> (forall a. (a -> a -> a) -> TRecEntry a -> a)
-> (forall a. TRecEntry a -> [a])
-> (forall a. TRecEntry a -> Bool)
-> (forall b. TRecEntry b -> Int)
-> (forall a. Eq a => a -> TRecEntry a -> Bool)
-> (forall a. Ord a => TRecEntry a -> a)
-> (forall a. Ord a => TRecEntry a -> a)
-> (forall a. Num a => TRecEntry a -> a)
-> (forall a. Num a => TRecEntry a -> a)
-> Foldable TRecEntry
forall a. Eq a => a -> TRecEntry a -> Bool
forall a. Num a => TRecEntry a -> a
forall a. Ord a => TRecEntry a -> a
forall m. Monoid m => TRecEntry m -> m
forall a. TRecEntry a -> Bool
forall b. TRecEntry b -> Int
forall a. TRecEntry a -> [a]
forall a. (a -> a -> a) -> TRecEntry a -> a
forall m a. Monoid m => (a -> m) -> TRecEntry a -> m
forall b a. (b -> a -> b) -> b -> TRecEntry a -> b
forall a b. (a -> b -> b) -> b -> TRecEntry a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => TRecEntry m -> m
fold :: forall m. Monoid m => TRecEntry m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> TRecEntry a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> TRecEntry a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> TRecEntry a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> TRecEntry a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> TRecEntry a -> b
foldr :: forall a b. (a -> b -> b) -> b -> TRecEntry a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> TRecEntry a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> TRecEntry a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> TRecEntry a -> b
foldl :: forall b a. (b -> a -> b) -> b -> TRecEntry a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> TRecEntry a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> TRecEntry a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> TRecEntry a -> a
foldr1 :: forall a. (a -> a -> a) -> TRecEntry a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> TRecEntry a -> a
foldl1 :: forall a. (a -> a -> a) -> TRecEntry a -> a
$ctoList :: forall a. TRecEntry a -> [a]
toList :: forall a. TRecEntry a -> [a]
$cnull :: forall a. TRecEntry a -> Bool
null :: forall a. TRecEntry a -> Bool
$clength :: forall b. TRecEntry b -> Int
length :: forall b. TRecEntry b -> Int
$celem :: forall a. Eq a => a -> TRecEntry a -> Bool
elem :: forall a. Eq a => a -> TRecEntry a -> Bool
$cmaximum :: forall a. Ord a => TRecEntry a -> a
maximum :: forall a. Ord a => TRecEntry a -> a
$cminimum :: forall a. Ord a => TRecEntry a -> a
minimum :: forall a. Ord a => TRecEntry a -> a
$csum :: forall a. Num a => TRecEntry a -> a
sum :: forall a. Num a => TRecEntry a -> a
$cproduct :: forall a. Num a => TRecEntry a -> a
product :: forall a. Num a => TRecEntry a -> a
Foldable, Functor TRecEntry
Foldable TRecEntry
Functor TRecEntry
-> Foldable TRecEntry
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> TRecEntry a -> f (TRecEntry b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    TRecEntry (f a) -> f (TRecEntry a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> TRecEntry a -> m (TRecEntry b))
-> (forall (m :: * -> *) a.
    Monad m =>
    TRecEntry (m a) -> m (TRecEntry a))
-> Traversable TRecEntry
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
TRecEntry (m a) -> m (TRecEntry a)
forall (f :: * -> *) a.
Applicative f =>
TRecEntry (f a) -> f (TRecEntry a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TRecEntry a -> m (TRecEntry b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TRecEntry a -> f (TRecEntry b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TRecEntry a -> f (TRecEntry b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TRecEntry a -> f (TRecEntry b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
TRecEntry (f a) -> f (TRecEntry a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
TRecEntry (f a) -> f (TRecEntry a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TRecEntry a -> m (TRecEntry b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TRecEntry a -> m (TRecEntry b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
TRecEntry (m a) -> m (TRecEntry a)
sequence :: forall (m :: * -> *) a.
Monad m =>
TRecEntry (m a) -> m (TRecEntry a)
Traversable, Eq (TRecEntry b)
Eq (TRecEntry b)
-> (TRecEntry b -> TRecEntry b -> Ordering)
-> (TRecEntry b -> TRecEntry b -> Bool)
-> (TRecEntry b -> TRecEntry b -> Bool)
-> (TRecEntry b -> TRecEntry b -> Bool)
-> (TRecEntry b -> TRecEntry b -> Bool)
-> (TRecEntry b -> TRecEntry b -> TRecEntry b)
-> (TRecEntry b -> TRecEntry b -> TRecEntry b)
-> Ord (TRecEntry b)
TRecEntry b -> TRecEntry b -> Bool
TRecEntry b -> TRecEntry b -> Ordering
TRecEntry b -> TRecEntry b -> TRecEntry b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {b}. Ord b => Eq (TRecEntry b)
forall b. Ord b => TRecEntry b -> TRecEntry b -> Bool
forall b. Ord b => TRecEntry b -> TRecEntry b -> Ordering
forall b. Ord b => TRecEntry b -> TRecEntry b -> TRecEntry b
$ccompare :: forall b. Ord b => TRecEntry b -> TRecEntry b -> Ordering
compare :: TRecEntry b -> TRecEntry b -> Ordering
$c< :: forall b. Ord b => TRecEntry b -> TRecEntry b -> Bool
< :: TRecEntry b -> TRecEntry b -> Bool
$c<= :: forall b. Ord b => TRecEntry b -> TRecEntry b -> Bool
<= :: TRecEntry b -> TRecEntry b -> Bool
$c> :: forall b. Ord b => TRecEntry b -> TRecEntry b -> Bool
> :: TRecEntry b -> TRecEntry b -> Bool
$c>= :: forall b. Ord b => TRecEntry b -> TRecEntry b -> Bool
>= :: TRecEntry b -> TRecEntry b -> Bool
$cmax :: forall b. Ord b => TRecEntry b -> TRecEntry b -> TRecEntry b
max :: TRecEntry b -> TRecEntry b -> TRecEntry b
$cmin :: forall b. Ord b => TRecEntry b -> TRecEntry b -> TRecEntry b
min :: TRecEntry b -> TRecEntry b -> TRecEntry b
Ord, TRecEntry b -> TRecEntry b -> Bool
(TRecEntry b -> TRecEntry b -> Bool)
-> (TRecEntry b -> TRecEntry b -> Bool) -> Eq (TRecEntry b)
forall b. Eq b => TRecEntry b -> TRecEntry b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall b. Eq b => TRecEntry b -> TRecEntry b -> Bool
== :: TRecEntry b -> TRecEntry b -> Bool
$c/= :: forall b. Eq b => TRecEntry b -> TRecEntry b -> Bool
/= :: TRecEntry b -> TRecEntry b -> Bool
Eq)

newtype GenPapPayload b = GenPapPayload { forall b. GenPapPayload b -> [FieldValue b]
getValues :: [FieldValue b] }
  deriving ((forall a b. (a -> b) -> GenPapPayload a -> GenPapPayload b)
-> (forall a b. a -> GenPapPayload b -> GenPapPayload a)
-> Functor GenPapPayload
forall a b. a -> GenPapPayload b -> GenPapPayload a
forall a b. (a -> b) -> GenPapPayload a -> GenPapPayload b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GenPapPayload a -> GenPapPayload b
fmap :: forall a b. (a -> b) -> GenPapPayload a -> GenPapPayload b
$c<$ :: forall a b. a -> GenPapPayload b -> GenPapPayload a
<$ :: forall a b. a -> GenPapPayload b -> GenPapPayload a
Functor, (forall m. Monoid m => GenPapPayload m -> m)
-> (forall m a. Monoid m => (a -> m) -> GenPapPayload a -> m)
-> (forall m a. Monoid m => (a -> m) -> GenPapPayload a -> m)
-> (forall a b. (a -> b -> b) -> b -> GenPapPayload a -> b)
-> (forall a b. (a -> b -> b) -> b -> GenPapPayload a -> b)
-> (forall b a. (b -> a -> b) -> b -> GenPapPayload a -> b)
-> (forall b a. (b -> a -> b) -> b -> GenPapPayload a -> b)
-> (forall a. (a -> a -> a) -> GenPapPayload a -> a)
-> (forall a. (a -> a -> a) -> GenPapPayload a -> a)
-> (forall a. GenPapPayload a -> [a])
-> (forall a. GenPapPayload a -> Bool)
-> (forall a. GenPapPayload a -> Int)
-> (forall a. Eq a => a -> GenPapPayload a -> Bool)
-> (forall a. Ord a => GenPapPayload a -> a)
-> (forall a. Ord a => GenPapPayload a -> a)
-> (forall a. Num a => GenPapPayload a -> a)
-> (forall a. Num a => GenPapPayload a -> a)
-> Foldable GenPapPayload
forall a. Eq a => a -> GenPapPayload a -> Bool
forall a. Num a => GenPapPayload a -> a
forall a. Ord a => GenPapPayload a -> a
forall m. Monoid m => GenPapPayload m -> m
forall a. GenPapPayload a -> Bool
forall a. GenPapPayload a -> Int
forall a. GenPapPayload a -> [a]
forall a. (a -> a -> a) -> GenPapPayload a -> a
forall m a. Monoid m => (a -> m) -> GenPapPayload a -> m
forall b a. (b -> a -> b) -> b -> GenPapPayload a -> b
forall a b. (a -> b -> b) -> b -> GenPapPayload a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => GenPapPayload m -> m
fold :: forall m. Monoid m => GenPapPayload m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GenPapPayload a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GenPapPayload a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GenPapPayload a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> GenPapPayload a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> GenPapPayload a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GenPapPayload a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GenPapPayload a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GenPapPayload a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GenPapPayload a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GenPapPayload a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GenPapPayload a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> GenPapPayload a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> GenPapPayload a -> a
foldr1 :: forall a. (a -> a -> a) -> GenPapPayload a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GenPapPayload a -> a
foldl1 :: forall a. (a -> a -> a) -> GenPapPayload a -> a
$ctoList :: forall a. GenPapPayload a -> [a]
toList :: forall a. GenPapPayload a -> [a]
$cnull :: forall a. GenPapPayload a -> Bool
null :: forall a. GenPapPayload a -> Bool
$clength :: forall a. GenPapPayload a -> Int
length :: forall a. GenPapPayload a -> Int
$celem :: forall a. Eq a => a -> GenPapPayload a -> Bool
elem :: forall a. Eq a => a -> GenPapPayload a -> Bool
$cmaximum :: forall a. Ord a => GenPapPayload a -> a
maximum :: forall a. Ord a => GenPapPayload a -> a
$cminimum :: forall a. Ord a => GenPapPayload a -> a
minimum :: forall a. Ord a => GenPapPayload a -> a
$csum :: forall a. Num a => GenPapPayload a -> a
sum :: forall a. Num a => GenPapPayload a -> a
$cproduct :: forall a. Num a => GenPapPayload a -> a
product :: forall a. Num a => GenPapPayload a -> a
Foldable, Functor GenPapPayload
Foldable GenPapPayload
Functor GenPapPayload
-> Foldable GenPapPayload
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> GenPapPayload a -> f (GenPapPayload b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GenPapPayload (f a) -> f (GenPapPayload a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GenPapPayload a -> m (GenPapPayload b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GenPapPayload (m a) -> m (GenPapPayload a))
-> Traversable GenPapPayload
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
GenPapPayload (m a) -> m (GenPapPayload a)
forall (f :: * -> *) a.
Applicative f =>
GenPapPayload (f a) -> f (GenPapPayload a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenPapPayload a -> m (GenPapPayload b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenPapPayload a -> f (GenPapPayload b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenPapPayload a -> f (GenPapPayload b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenPapPayload a -> f (GenPapPayload b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
GenPapPayload (f a) -> f (GenPapPayload a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
GenPapPayload (f a) -> f (GenPapPayload a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenPapPayload a -> m (GenPapPayload b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenPapPayload a -> m (GenPapPayload b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
GenPapPayload (m a) -> m (GenPapPayload a)
sequence :: forall (m :: * -> *) a.
Monad m =>
GenPapPayload (m a) -> m (GenPapPayload a)
Traversable, Int -> GenPapPayload b -> ShowS
[GenPapPayload b] -> ShowS
GenPapPayload b -> String
(Int -> GenPapPayload b -> ShowS)
-> (GenPapPayload b -> String)
-> ([GenPapPayload b] -> ShowS)
-> Show (GenPapPayload b)
forall b. Show b => Int -> GenPapPayload b -> ShowS
forall b. Show b => [GenPapPayload b] -> ShowS
forall b. Show b => GenPapPayload b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall b. Show b => Int -> GenPapPayload b -> ShowS
showsPrec :: Int -> GenPapPayload b -> ShowS
$cshow :: forall b. Show b => GenPapPayload b -> String
show :: GenPapPayload b -> String
$cshowList :: forall b. Show b => [GenPapPayload b] -> ShowS
showList :: [GenPapPayload b] -> ShowS
Show, Eq (GenPapPayload b)
Eq (GenPapPayload b)
-> (GenPapPayload b -> GenPapPayload b -> Ordering)
-> (GenPapPayload b -> GenPapPayload b -> Bool)
-> (GenPapPayload b -> GenPapPayload b -> Bool)
-> (GenPapPayload b -> GenPapPayload b -> Bool)
-> (GenPapPayload b -> GenPapPayload b -> Bool)
-> (GenPapPayload b -> GenPapPayload b -> GenPapPayload b)
-> (GenPapPayload b -> GenPapPayload b -> GenPapPayload b)
-> Ord (GenPapPayload b)
GenPapPayload b -> GenPapPayload b -> Bool
GenPapPayload b -> GenPapPayload b -> Ordering
GenPapPayload b -> GenPapPayload b -> GenPapPayload b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {b}. Ord b => Eq (GenPapPayload b)
forall b. Ord b => GenPapPayload b -> GenPapPayload b -> Bool
forall b. Ord b => GenPapPayload b -> GenPapPayload b -> Ordering
forall b.
Ord b =>
GenPapPayload b -> GenPapPayload b -> GenPapPayload b
$ccompare :: forall b. Ord b => GenPapPayload b -> GenPapPayload b -> Ordering
compare :: GenPapPayload b -> GenPapPayload b -> Ordering
$c< :: forall b. Ord b => GenPapPayload b -> GenPapPayload b -> Bool
< :: GenPapPayload b -> GenPapPayload b -> Bool
$c<= :: forall b. Ord b => GenPapPayload b -> GenPapPayload b -> Bool
<= :: GenPapPayload b -> GenPapPayload b -> Bool
$c> :: forall b. Ord b => GenPapPayload b -> GenPapPayload b -> Bool
> :: GenPapPayload b -> GenPapPayload b -> Bool
$c>= :: forall b. Ord b => GenPapPayload b -> GenPapPayload b -> Bool
>= :: GenPapPayload b -> GenPapPayload b -> Bool
$cmax :: forall b.
Ord b =>
GenPapPayload b -> GenPapPayload b -> GenPapPayload b
max :: GenPapPayload b -> GenPapPayload b -> GenPapPayload b
$cmin :: forall b.
Ord b =>
GenPapPayload b -> GenPapPayload b -> GenPapPayload b
min :: GenPapPayload b -> GenPapPayload b -> GenPapPayload b
Ord, GenPapPayload b -> GenPapPayload b -> Bool
(GenPapPayload b -> GenPapPayload b -> Bool)
-> (GenPapPayload b -> GenPapPayload b -> Bool)
-> Eq (GenPapPayload b)
forall b. Eq b => GenPapPayload b -> GenPapPayload b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall b. Eq b => GenPapPayload b -> GenPapPayload b -> Bool
== :: GenPapPayload b -> GenPapPayload b -> Bool
$c/= :: forall b. Eq b => GenPapPayload b -> GenPapPayload b -> Bool
/= :: GenPapPayload b -> GenPapPayload b -> Bool
Eq)

type PapPayload = GenPapPayload ClosurePtr

newtype GenSrtPayload b = GenSrtPayload { forall b. GenSrtPayload b -> Maybe b
getSrt :: Maybe b }
  deriving ((forall a b. (a -> b) -> GenSrtPayload a -> GenSrtPayload b)
-> (forall a b. a -> GenSrtPayload b -> GenSrtPayload a)
-> Functor GenSrtPayload
forall a b. a -> GenSrtPayload b -> GenSrtPayload a
forall a b. (a -> b) -> GenSrtPayload a -> GenSrtPayload b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GenSrtPayload a -> GenSrtPayload b
fmap :: forall a b. (a -> b) -> GenSrtPayload a -> GenSrtPayload b
$c<$ :: forall a b. a -> GenSrtPayload b -> GenSrtPayload a
<$ :: forall a b. a -> GenSrtPayload b -> GenSrtPayload a
Functor, (forall m. Monoid m => GenSrtPayload m -> m)
-> (forall m a. Monoid m => (a -> m) -> GenSrtPayload a -> m)
-> (forall m a. Monoid m => (a -> m) -> GenSrtPayload a -> m)
-> (forall a b. (a -> b -> b) -> b -> GenSrtPayload a -> b)
-> (forall a b. (a -> b -> b) -> b -> GenSrtPayload a -> b)
-> (forall b a. (b -> a -> b) -> b -> GenSrtPayload a -> b)
-> (forall b a. (b -> a -> b) -> b -> GenSrtPayload a -> b)
-> (forall a. (a -> a -> a) -> GenSrtPayload a -> a)
-> (forall a. (a -> a -> a) -> GenSrtPayload a -> a)
-> (forall a. GenSrtPayload a -> [a])
-> (forall a. GenSrtPayload a -> Bool)
-> (forall a. GenSrtPayload a -> Int)
-> (forall a. Eq a => a -> GenSrtPayload a -> Bool)
-> (forall a. Ord a => GenSrtPayload a -> a)
-> (forall a. Ord a => GenSrtPayload a -> a)
-> (forall a. Num a => GenSrtPayload a -> a)
-> (forall a. Num a => GenSrtPayload a -> a)
-> Foldable GenSrtPayload
forall a. Eq a => a -> GenSrtPayload a -> Bool
forall a. Num a => GenSrtPayload a -> a
forall a. Ord a => GenSrtPayload a -> a
forall m. Monoid m => GenSrtPayload m -> m
forall a. GenSrtPayload a -> Bool
forall a. GenSrtPayload a -> Int
forall a. GenSrtPayload a -> [a]
forall a. (a -> a -> a) -> GenSrtPayload a -> a
forall m a. Monoid m => (a -> m) -> GenSrtPayload a -> m
forall b a. (b -> a -> b) -> b -> GenSrtPayload a -> b
forall a b. (a -> b -> b) -> b -> GenSrtPayload a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => GenSrtPayload m -> m
fold :: forall m. Monoid m => GenSrtPayload m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GenSrtPayload a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GenSrtPayload a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GenSrtPayload a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> GenSrtPayload a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> GenSrtPayload a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GenSrtPayload a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GenSrtPayload a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GenSrtPayload a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GenSrtPayload a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GenSrtPayload a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GenSrtPayload a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> GenSrtPayload a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> GenSrtPayload a -> a
foldr1 :: forall a. (a -> a -> a) -> GenSrtPayload a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GenSrtPayload a -> a
foldl1 :: forall a. (a -> a -> a) -> GenSrtPayload a -> a
$ctoList :: forall a. GenSrtPayload a -> [a]
toList :: forall a. GenSrtPayload a -> [a]
$cnull :: forall a. GenSrtPayload a -> Bool
null :: forall a. GenSrtPayload a -> Bool
$clength :: forall a. GenSrtPayload a -> Int
length :: forall a. GenSrtPayload a -> Int
$celem :: forall a. Eq a => a -> GenSrtPayload a -> Bool
elem :: forall a. Eq a => a -> GenSrtPayload a -> Bool
$cmaximum :: forall a. Ord a => GenSrtPayload a -> a
maximum :: forall a. Ord a => GenSrtPayload a -> a
$cminimum :: forall a. Ord a => GenSrtPayload a -> a
minimum :: forall a. Ord a => GenSrtPayload a -> a
$csum :: forall a. Num a => GenSrtPayload a -> a
sum :: forall a. Num a => GenSrtPayload a -> a
$cproduct :: forall a. Num a => GenSrtPayload a -> a
product :: forall a. Num a => GenSrtPayload a -> a
Foldable, Functor GenSrtPayload
Foldable GenSrtPayload
Functor GenSrtPayload
-> Foldable GenSrtPayload
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> GenSrtPayload a -> f (GenSrtPayload b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GenSrtPayload (f a) -> f (GenSrtPayload a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GenSrtPayload a -> m (GenSrtPayload b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GenSrtPayload (m a) -> m (GenSrtPayload a))
-> Traversable GenSrtPayload
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
GenSrtPayload (m a) -> m (GenSrtPayload a)
forall (f :: * -> *) a.
Applicative f =>
GenSrtPayload (f a) -> f (GenSrtPayload a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenSrtPayload a -> m (GenSrtPayload b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenSrtPayload a -> f (GenSrtPayload b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenSrtPayload a -> f (GenSrtPayload b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenSrtPayload a -> f (GenSrtPayload b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
GenSrtPayload (f a) -> f (GenSrtPayload a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
GenSrtPayload (f a) -> f (GenSrtPayload a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenSrtPayload a -> m (GenSrtPayload b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenSrtPayload a -> m (GenSrtPayload b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
GenSrtPayload (m a) -> m (GenSrtPayload a)
sequence :: forall (m :: * -> *) a.
Monad m =>
GenSrtPayload (m a) -> m (GenSrtPayload a)
Traversable, Int -> GenSrtPayload b -> ShowS
[GenSrtPayload b] -> ShowS
GenSrtPayload b -> String
(Int -> GenSrtPayload b -> ShowS)
-> (GenSrtPayload b -> String)
-> ([GenSrtPayload b] -> ShowS)
-> Show (GenSrtPayload b)
forall b. Show b => Int -> GenSrtPayload b -> ShowS
forall b. Show b => [GenSrtPayload b] -> ShowS
forall b. Show b => GenSrtPayload b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall b. Show b => Int -> GenSrtPayload b -> ShowS
showsPrec :: Int -> GenSrtPayload b -> ShowS
$cshow :: forall b. Show b => GenSrtPayload b -> String
show :: GenSrtPayload b -> String
$cshowList :: forall b. Show b => [GenSrtPayload b] -> ShowS
showList :: [GenSrtPayload b] -> ShowS
Show, Eq (GenSrtPayload b)
Eq (GenSrtPayload b)
-> (GenSrtPayload b -> GenSrtPayload b -> Ordering)
-> (GenSrtPayload b -> GenSrtPayload b -> Bool)
-> (GenSrtPayload b -> GenSrtPayload b -> Bool)
-> (GenSrtPayload b -> GenSrtPayload b -> Bool)
-> (GenSrtPayload b -> GenSrtPayload b -> Bool)
-> (GenSrtPayload b -> GenSrtPayload b -> GenSrtPayload b)
-> (GenSrtPayload b -> GenSrtPayload b -> GenSrtPayload b)
-> Ord (GenSrtPayload b)
GenSrtPayload b -> GenSrtPayload b -> Bool
GenSrtPayload b -> GenSrtPayload b -> Ordering
GenSrtPayload b -> GenSrtPayload b -> GenSrtPayload b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {b}. Ord b => Eq (GenSrtPayload b)
forall b. Ord b => GenSrtPayload b -> GenSrtPayload b -> Bool
forall b. Ord b => GenSrtPayload b -> GenSrtPayload b -> Ordering
forall b.
Ord b =>
GenSrtPayload b -> GenSrtPayload b -> GenSrtPayload b
$ccompare :: forall b. Ord b => GenSrtPayload b -> GenSrtPayload b -> Ordering
compare :: GenSrtPayload b -> GenSrtPayload b -> Ordering
$c< :: forall b. Ord b => GenSrtPayload b -> GenSrtPayload b -> Bool
< :: GenSrtPayload b -> GenSrtPayload b -> Bool
$c<= :: forall b. Ord b => GenSrtPayload b -> GenSrtPayload b -> Bool
<= :: GenSrtPayload b -> GenSrtPayload b -> Bool
$c> :: forall b. Ord b => GenSrtPayload b -> GenSrtPayload b -> Bool
> :: GenSrtPayload b -> GenSrtPayload b -> Bool
$c>= :: forall b. Ord b => GenSrtPayload b -> GenSrtPayload b -> Bool
>= :: GenSrtPayload b -> GenSrtPayload b -> Bool
$cmax :: forall b.
Ord b =>
GenSrtPayload b -> GenSrtPayload b -> GenSrtPayload b
max :: GenSrtPayload b -> GenSrtPayload b -> GenSrtPayload b
$cmin :: forall b.
Ord b =>
GenSrtPayload b -> GenSrtPayload b -> GenSrtPayload b
min :: GenSrtPayload b -> GenSrtPayload b -> GenSrtPayload b
Ord, GenSrtPayload b -> GenSrtPayload b -> Bool
(GenSrtPayload b -> GenSrtPayload b -> Bool)
-> (GenSrtPayload b -> GenSrtPayload b -> Bool)
-> Eq (GenSrtPayload b)
forall b. Eq b => GenSrtPayload b -> GenSrtPayload b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall b. Eq b => GenSrtPayload b -> GenSrtPayload b -> Bool
== :: GenSrtPayload b -> GenSrtPayload b -> Bool
$c/= :: forall b. Eq b => GenSrtPayload b -> GenSrtPayload b -> Bool
/= :: GenSrtPayload b -> GenSrtPayload b -> Bool
Eq)

type SrtPayload = GenSrtPayload ClosurePtr

type SrtCont = InfoTablePtr

data GenCCSPayload ccsPtr ccPtr
  = CCSPayload
  { forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Int64
ccsID :: !Int64
  , forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> ccPtr
ccsCc :: ccPtr
  , forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Maybe ccsPtr
ccsPrevStack :: Maybe ccsPtr
  , forall ccsPtr ccPtr.
GenCCSPayload ccsPtr ccPtr -> Maybe IndexTablePtr
ccsIndexTable :: Maybe IndexTablePtr
  , forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Maybe CCSPtr
ccsRoot :: Maybe CCSPtr -- todo ccsPtr?
  , forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsDepth :: Word
  , forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsSccCount :: Word64
  , forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsSelected :: Word
  , forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsTimeTicks :: Word
  , forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsMemAlloc :: Word64
  , forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsInheritedAlloc :: Word64
  , forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsInheritedTicks :: Word
  } deriving (Int -> GenCCSPayload ccsPtr ccPtr -> ShowS
[GenCCSPayload ccsPtr ccPtr] -> ShowS
GenCCSPayload ccsPtr ccPtr -> String
(Int -> GenCCSPayload ccsPtr ccPtr -> ShowS)
-> (GenCCSPayload ccsPtr ccPtr -> String)
-> ([GenCCSPayload ccsPtr ccPtr] -> ShowS)
-> Show (GenCCSPayload ccsPtr ccPtr)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ccsPtr ccPtr.
(Show ccPtr, Show ccsPtr) =>
Int -> GenCCSPayload ccsPtr ccPtr -> ShowS
forall ccsPtr ccPtr.
(Show ccPtr, Show ccsPtr) =>
[GenCCSPayload ccsPtr ccPtr] -> ShowS
forall ccsPtr ccPtr.
(Show ccPtr, Show ccsPtr) =>
GenCCSPayload ccsPtr ccPtr -> String
$cshowsPrec :: forall ccsPtr ccPtr.
(Show ccPtr, Show ccsPtr) =>
Int -> GenCCSPayload ccsPtr ccPtr -> ShowS
showsPrec :: Int -> GenCCSPayload ccsPtr ccPtr -> ShowS
$cshow :: forall ccsPtr ccPtr.
(Show ccPtr, Show ccsPtr) =>
GenCCSPayload ccsPtr ccPtr -> String
show :: GenCCSPayload ccsPtr ccPtr -> String
$cshowList :: forall ccsPtr ccPtr.
(Show ccPtr, Show ccsPtr) =>
[GenCCSPayload ccsPtr ccPtr] -> ShowS
showList :: [GenCCSPayload ccsPtr ccPtr] -> ShowS
Show, Eq (GenCCSPayload ccsPtr ccPtr)
Eq (GenCCSPayload ccsPtr ccPtr)
-> (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)
-> (GenCCSPayload ccsPtr ccPtr
    -> GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr)
-> (GenCCSPayload ccsPtr ccPtr
    -> GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr)
-> Ord (GenCCSPayload ccsPtr ccPtr)
GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
GenCCSPayload ccsPtr ccPtr
-> GenCCSPayload ccsPtr ccPtr -> Ordering
GenCCSPayload ccsPtr ccPtr
-> GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {ccsPtr} {ccPtr}.
(Ord ccPtr, Ord ccsPtr) =>
Eq (GenCCSPayload ccsPtr ccPtr)
forall ccsPtr ccPtr.
(Ord ccPtr, Ord ccsPtr) =>
GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
forall ccsPtr ccPtr.
(Ord ccPtr, Ord ccsPtr) =>
GenCCSPayload ccsPtr ccPtr
-> GenCCSPayload ccsPtr ccPtr -> Ordering
forall ccsPtr ccPtr.
(Ord ccPtr, Ord ccsPtr) =>
GenCCSPayload ccsPtr ccPtr
-> GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr
$ccompare :: forall ccsPtr ccPtr.
(Ord ccPtr, Ord ccsPtr) =>
GenCCSPayload ccsPtr ccPtr
-> GenCCSPayload ccsPtr ccPtr -> Ordering
compare :: GenCCSPayload ccsPtr ccPtr
-> GenCCSPayload ccsPtr ccPtr -> Ordering
$c< :: forall ccsPtr ccPtr.
(Ord ccPtr, Ord ccsPtr) =>
GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
< :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
$c<= :: forall ccsPtr ccPtr.
(Ord ccPtr, Ord ccsPtr) =>
GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
<= :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
$c> :: forall ccsPtr ccPtr.
(Ord ccPtr, Ord ccsPtr) =>
GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
> :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
$c>= :: forall ccsPtr ccPtr.
(Ord ccPtr, Ord ccsPtr) =>
GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
>= :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
$cmax :: forall ccsPtr ccPtr.
(Ord ccPtr, Ord ccsPtr) =>
GenCCSPayload ccsPtr ccPtr
-> GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr
max :: GenCCSPayload ccsPtr ccPtr
-> GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr
$cmin :: forall ccsPtr ccPtr.
(Ord ccPtr, Ord ccsPtr) =>
GenCCSPayload ccsPtr ccPtr
-> GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr
min :: GenCCSPayload ccsPtr ccPtr
-> GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr
Ord, GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
(GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool)
-> (GenCCSPayload ccsPtr ccPtr
    -> GenCCSPayload ccsPtr ccPtr -> Bool)
-> Eq (GenCCSPayload ccsPtr ccPtr)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ccsPtr ccPtr.
(Eq ccPtr, Eq ccsPtr) =>
GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
$c== :: forall ccsPtr ccPtr.
(Eq ccPtr, Eq ccsPtr) =>
GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
== :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
$c/= :: forall ccsPtr ccPtr.
(Eq ccPtr, Eq ccsPtr) =>
GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
/= :: GenCCSPayload ccsPtr ccPtr -> GenCCSPayload ccsPtr ccPtr -> Bool
Eq, (forall a b.
 (a -> b) -> GenCCSPayload ccsPtr a -> GenCCSPayload ccsPtr b)
-> (forall a b.
    a -> GenCCSPayload ccsPtr b -> GenCCSPayload ccsPtr a)
-> Functor (GenCCSPayload ccsPtr)
forall a b. a -> GenCCSPayload ccsPtr b -> GenCCSPayload ccsPtr a
forall a b.
(a -> b) -> GenCCSPayload ccsPtr a -> GenCCSPayload ccsPtr b
forall ccsPtr a b.
a -> GenCCSPayload ccsPtr b -> GenCCSPayload ccsPtr a
forall ccsPtr a b.
(a -> b) -> GenCCSPayload ccsPtr a -> GenCCSPayload ccsPtr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall ccsPtr a b.
(a -> b) -> GenCCSPayload ccsPtr a -> GenCCSPayload ccsPtr b
fmap :: forall a b.
(a -> b) -> GenCCSPayload ccsPtr a -> GenCCSPayload ccsPtr b
$c<$ :: forall ccsPtr a b.
a -> GenCCSPayload ccsPtr b -> GenCCSPayload ccsPtr a
<$ :: forall a b. a -> GenCCSPayload ccsPtr b -> GenCCSPayload ccsPtr a
Functor)

instance Bifunctor GenCCSPayload where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> GenCCSPayload a c -> GenCCSPayload b d
bimap a -> b
f c -> d
g CCSPayload{c
Int64
Maybe a
Maybe IndexTablePtr
Maybe CCSPtr
Word
Word64
ccsID :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Int64
ccsCc :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> ccPtr
ccsPrevStack :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Maybe ccsPtr
ccsIndexTable :: forall ccsPtr ccPtr.
GenCCSPayload ccsPtr ccPtr -> Maybe IndexTablePtr
ccsRoot :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Maybe CCSPtr
ccsDepth :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsSccCount :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsSelected :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsTimeTicks :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsMemAlloc :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsInheritedAlloc :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsInheritedTicks :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsID :: Int64
ccsCc :: c
ccsPrevStack :: Maybe a
ccsIndexTable :: Maybe IndexTablePtr
ccsRoot :: Maybe CCSPtr
ccsDepth :: Word
ccsSccCount :: Word64
ccsSelected :: Word
ccsTimeTicks :: Word
ccsMemAlloc :: Word64
ccsInheritedAlloc :: Word64
ccsInheritedTicks :: Word
..} = (\Maybe b
a d
b -> CCSPayload{ccsPrevStack :: Maybe b
ccsPrevStack = Maybe b
a, ccsCc :: d
ccsCc = d
b, Int64
Maybe IndexTablePtr
Maybe CCSPtr
Word
Word64
ccsID :: Int64
ccsIndexTable :: Maybe IndexTablePtr
ccsRoot :: Maybe CCSPtr
ccsDepth :: Word
ccsSccCount :: Word64
ccsSelected :: Word
ccsTimeTicks :: Word
ccsMemAlloc :: Word64
ccsInheritedAlloc :: Word64
ccsInheritedTicks :: Word
ccsID :: Int64
ccsIndexTable :: Maybe IndexTablePtr
ccsRoot :: Maybe CCSPtr
ccsDepth :: Word
ccsSccCount :: Word64
ccsSelected :: Word
ccsTimeTicks :: Word
ccsMemAlloc :: Word64
ccsInheritedAlloc :: Word64
ccsInheritedTicks :: Word
..})
                              ((a -> b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
ccsPrevStack)
                              (c -> d
g c
ccsCc)

instance Bifoldable GenCCSPayload where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> GenCCSPayload a b -> m
bifoldMap a -> m
f b -> m
g CCSPayload{b
Int64
Maybe a
Maybe IndexTablePtr
Maybe CCSPtr
Word
Word64
ccsID :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Int64
ccsCc :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> ccPtr
ccsPrevStack :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Maybe ccsPtr
ccsIndexTable :: forall ccsPtr ccPtr.
GenCCSPayload ccsPtr ccPtr -> Maybe IndexTablePtr
ccsRoot :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Maybe CCSPtr
ccsDepth :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsSccCount :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsSelected :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsTimeTicks :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsMemAlloc :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsInheritedAlloc :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsInheritedTicks :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsID :: Int64
ccsCc :: b
ccsPrevStack :: Maybe a
ccsIndexTable :: Maybe IndexTablePtr
ccsRoot :: Maybe CCSPtr
ccsDepth :: Word
ccsSccCount :: Word64
ccsSelected :: Word
ccsTimeTicks :: Word
ccsMemAlloc :: Word64
ccsInheritedAlloc :: Word64
ccsInheritedTicks :: Word
..} = (a -> m) -> Maybe a -> m
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Maybe a
ccsPrevStack m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
ccsCc

instance Bitraversable GenCCSPayload where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> GenCCSPayload a b -> f (GenCCSPayload c d)
bitraverse a -> f c
f b -> f d
g CCSPayload{b
Int64
Maybe a
Maybe IndexTablePtr
Maybe CCSPtr
Word
Word64
ccsID :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Int64
ccsCc :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> ccPtr
ccsPrevStack :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Maybe ccsPtr
ccsIndexTable :: forall ccsPtr ccPtr.
GenCCSPayload ccsPtr ccPtr -> Maybe IndexTablePtr
ccsRoot :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Maybe CCSPtr
ccsDepth :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsSccCount :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsSelected :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsTimeTicks :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsMemAlloc :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsInheritedAlloc :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsInheritedTicks :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsID :: Int64
ccsCc :: b
ccsPrevStack :: Maybe a
ccsIndexTable :: Maybe IndexTablePtr
ccsRoot :: Maybe CCSPtr
ccsDepth :: Word
ccsSccCount :: Word64
ccsSelected :: Word
ccsTimeTicks :: Word
ccsMemAlloc :: Word64
ccsInheritedAlloc :: Word64
ccsInheritedTicks :: Word
..} = (\Maybe c
a d
b -> CCSPayload{ccsPrevStack :: Maybe c
ccsPrevStack = Maybe c
a, ccsCc :: d
ccsCc = d
b, Int64
Maybe IndexTablePtr
Maybe CCSPtr
Word
Word64
ccsID :: Int64
ccsIndexTable :: Maybe IndexTablePtr
ccsRoot :: Maybe CCSPtr
ccsDepth :: Word
ccsSccCount :: Word64
ccsSelected :: Word
ccsTimeTicks :: Word
ccsMemAlloc :: Word64
ccsInheritedAlloc :: Word64
ccsInheritedTicks :: Word
ccsID :: Int64
ccsIndexTable :: Maybe IndexTablePtr
ccsRoot :: Maybe CCSPtr
ccsDepth :: Word
ccsSccCount :: Word64
ccsSelected :: Word
ccsTimeTicks :: Word
ccsMemAlloc :: Word64
ccsInheritedAlloc :: Word64
ccsInheritedTicks :: Word
..})
                              (Maybe c -> d -> GenCCSPayload c d)
-> f (Maybe c) -> f (d -> GenCCSPayload c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c) -> Maybe a -> f (Maybe c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse a -> f c
f Maybe a
ccsPrevStack
                              f (d -> GenCCSPayload c d) -> f d -> f (GenCCSPayload c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g b
ccsCc

type CCSPayload = GenCCSPayload CCSPtr CCPtr

data CCPayload
  = CCPayload
  { CCPayload -> Int64
ccID :: !Int64
  , CCPayload -> String
ccLabel :: String
  , CCPayload -> String
ccMod :: String
  , CCPayload -> String
ccLoc :: String
  , CCPayload -> Word64
ccMemAlloc :: Word64
  , CCPayload -> Word
ccTimeTicks :: Word
  , CCPayload -> Bool
ccIsCaf :: Bool
  , CCPayload -> Maybe CCPtr
ccLink :: Maybe CCPtr -- todo ccPtr?
  } deriving (Int -> CCPayload -> ShowS
[CCPayload] -> ShowS
CCPayload -> String
(Int -> CCPayload -> ShowS)
-> (CCPayload -> String)
-> ([CCPayload] -> ShowS)
-> Show CCPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CCPayload -> ShowS
showsPrec :: Int -> CCPayload -> ShowS
$cshow :: CCPayload -> String
show :: CCPayload -> String
$cshowList :: [CCPayload] -> ShowS
showList :: [CCPayload] -> ShowS
Show, Eq CCPayload
Eq CCPayload
-> (CCPayload -> CCPayload -> Ordering)
-> (CCPayload -> CCPayload -> Bool)
-> (CCPayload -> CCPayload -> Bool)
-> (CCPayload -> CCPayload -> Bool)
-> (CCPayload -> CCPayload -> Bool)
-> (CCPayload -> CCPayload -> CCPayload)
-> (CCPayload -> CCPayload -> CCPayload)
-> Ord CCPayload
CCPayload -> CCPayload -> Bool
CCPayload -> CCPayload -> Ordering
CCPayload -> CCPayload -> CCPayload
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CCPayload -> CCPayload -> Ordering
compare :: CCPayload -> CCPayload -> Ordering
$c< :: CCPayload -> CCPayload -> Bool
< :: CCPayload -> CCPayload -> Bool
$c<= :: CCPayload -> CCPayload -> Bool
<= :: CCPayload -> CCPayload -> Bool
$c> :: CCPayload -> CCPayload -> Bool
> :: CCPayload -> CCPayload -> Bool
$c>= :: CCPayload -> CCPayload -> Bool
>= :: CCPayload -> CCPayload -> Bool
$cmax :: CCPayload -> CCPayload -> CCPayload
max :: CCPayload -> CCPayload -> CCPayload
$cmin :: CCPayload -> CCPayload -> CCPayload
min :: CCPayload -> CCPayload -> CCPayload
Ord, CCPayload -> CCPayload -> Bool
(CCPayload -> CCPayload -> Bool)
-> (CCPayload -> CCPayload -> Bool) -> Eq CCPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CCPayload -> CCPayload -> Bool
== :: CCPayload -> CCPayload -> Bool
$c/= :: CCPayload -> CCPayload -> Bool
/= :: CCPayload -> CCPayload -> Bool
Eq)

-- data IndexTable ccsPtr ccPtr = IndexTable
data IndexTable = IndexTable
  { IndexTable -> CCPtr
itCostCentre :: CCPtr
  , IndexTable -> CCSPtr
itCostCentreStack :: CCSPtr
  , IndexTable -> Maybe IndexTablePtr
itNext :: Maybe IndexTablePtr
  , IndexTable -> Bool
itBackEdge :: Bool
  } deriving (Int -> IndexTable -> ShowS
[IndexTable] -> ShowS
IndexTable -> String
(Int -> IndexTable -> ShowS)
-> (IndexTable -> String)
-> ([IndexTable] -> ShowS)
-> Show IndexTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexTable -> ShowS
showsPrec :: Int -> IndexTable -> ShowS
$cshow :: IndexTable -> String
show :: IndexTable -> String
$cshowList :: [IndexTable] -> ShowS
showList :: [IndexTable] -> ShowS
Show, Eq IndexTable
Eq IndexTable
-> (IndexTable -> IndexTable -> Ordering)
-> (IndexTable -> IndexTable -> Bool)
-> (IndexTable -> IndexTable -> Bool)
-> (IndexTable -> IndexTable -> Bool)
-> (IndexTable -> IndexTable -> Bool)
-> (IndexTable -> IndexTable -> IndexTable)
-> (IndexTable -> IndexTable -> IndexTable)
-> Ord IndexTable
IndexTable -> IndexTable -> Bool
IndexTable -> IndexTable -> Ordering
IndexTable -> IndexTable -> IndexTable
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IndexTable -> IndexTable -> Ordering
compare :: IndexTable -> IndexTable -> Ordering
$c< :: IndexTable -> IndexTable -> Bool
< :: IndexTable -> IndexTable -> Bool
$c<= :: IndexTable -> IndexTable -> Bool
<= :: IndexTable -> IndexTable -> Bool
$c> :: IndexTable -> IndexTable -> Bool
> :: IndexTable -> IndexTable -> Bool
$c>= :: IndexTable -> IndexTable -> Bool
>= :: IndexTable -> IndexTable -> Bool
$cmax :: IndexTable -> IndexTable -> IndexTable
max :: IndexTable -> IndexTable -> IndexTable
$cmin :: IndexTable -> IndexTable -> IndexTable
min :: IndexTable -> IndexTable -> IndexTable
Ord, IndexTable -> IndexTable -> Bool
(IndexTable -> IndexTable -> Bool)
-> (IndexTable -> IndexTable -> Bool) -> Eq IndexTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexTable -> IndexTable -> Bool
== :: IndexTable -> IndexTable -> Bool
$c/= :: IndexTable -> IndexTable -> Bool
/= :: IndexTable -> IndexTable -> Bool
Eq)

-- | Information needed to decode a set of stack frames
data StackCont = StackCont StackPtr -- Address of start of frames
                           RawStack -- The raw frames
                           deriving (Int -> StackCont -> ShowS
[StackCont] -> ShowS
StackCont -> String
(Int -> StackCont -> ShowS)
-> (StackCont -> String)
-> ([StackCont] -> ShowS)
-> Show StackCont
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StackCont -> ShowS
showsPrec :: Int -> StackCont -> ShowS
$cshow :: StackCont -> String
show :: StackCont -> String
$cshowList :: [StackCont] -> ShowS
showList :: [StackCont] -> ShowS
Show, StackCont -> StackCont -> Bool
(StackCont -> StackCont -> Bool)
-> (StackCont -> StackCont -> Bool) -> Eq StackCont
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StackCont -> StackCont -> Bool
== :: StackCont -> StackCont -> Bool
$c/= :: StackCont -> StackCont -> Bool
/= :: StackCont -> StackCont -> Bool
Eq, Eq StackCont
Eq StackCont
-> (StackCont -> StackCont -> Ordering)
-> (StackCont -> StackCont -> Bool)
-> (StackCont -> StackCont -> Bool)
-> (StackCont -> StackCont -> Bool)
-> (StackCont -> StackCont -> Bool)
-> (StackCont -> StackCont -> StackCont)
-> (StackCont -> StackCont -> StackCont)
-> Ord StackCont
StackCont -> StackCont -> Bool
StackCont -> StackCont -> Ordering
StackCont -> StackCont -> StackCont
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StackCont -> StackCont -> Ordering
compare :: StackCont -> StackCont -> Ordering
$c< :: StackCont -> StackCont -> Bool
< :: StackCont -> StackCont -> Bool
$c<= :: StackCont -> StackCont -> Bool
<= :: StackCont -> StackCont -> Bool
$c> :: StackCont -> StackCont -> Bool
> :: StackCont -> StackCont -> Bool
$c>= :: StackCont -> StackCont -> Bool
>= :: StackCont -> StackCont -> Bool
$cmax :: StackCont -> StackCont -> StackCont
max :: StackCont -> StackCont -> StackCont
$cmin :: StackCont -> StackCont -> StackCont
min :: StackCont -> StackCont -> StackCont
Ord)

type StackFrames = GenStackFrames SrtCont ClosurePtr
newtype GenStackFrames srt b = GenStackFrames { forall srt b. GenStackFrames srt b -> [DebugStackFrame srt b]
getFrames :: [DebugStackFrame srt b] }
  deriving ((forall a b.
 (a -> b) -> GenStackFrames srt a -> GenStackFrames srt b)
-> (forall a b. a -> GenStackFrames srt b -> GenStackFrames srt a)
-> Functor (GenStackFrames srt)
forall a b. a -> GenStackFrames srt b -> GenStackFrames srt a
forall a b.
(a -> b) -> GenStackFrames srt a -> GenStackFrames srt b
forall srt a b. a -> GenStackFrames srt b -> GenStackFrames srt a
forall srt a b.
(a -> b) -> GenStackFrames srt a -> GenStackFrames srt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall srt a b.
(a -> b) -> GenStackFrames srt a -> GenStackFrames srt b
fmap :: forall a b.
(a -> b) -> GenStackFrames srt a -> GenStackFrames srt b
$c<$ :: forall srt a b. a -> GenStackFrames srt b -> GenStackFrames srt a
<$ :: forall a b. a -> GenStackFrames srt b -> GenStackFrames srt a
Functor, (forall m. Monoid m => GenStackFrames srt m -> m)
-> (forall m a. Monoid m => (a -> m) -> GenStackFrames srt a -> m)
-> (forall m a. Monoid m => (a -> m) -> GenStackFrames srt a -> m)
-> (forall a b. (a -> b -> b) -> b -> GenStackFrames srt a -> b)
-> (forall a b. (a -> b -> b) -> b -> GenStackFrames srt a -> b)
-> (forall b a. (b -> a -> b) -> b -> GenStackFrames srt a -> b)
-> (forall b a. (b -> a -> b) -> b -> GenStackFrames srt a -> b)
-> (forall a. (a -> a -> a) -> GenStackFrames srt a -> a)
-> (forall a. (a -> a -> a) -> GenStackFrames srt a -> a)
-> (forall a. GenStackFrames srt a -> [a])
-> (forall a. GenStackFrames srt a -> Bool)
-> (forall a. GenStackFrames srt a -> Int)
-> (forall a. Eq a => a -> GenStackFrames srt a -> Bool)
-> (forall a. Ord a => GenStackFrames srt a -> a)
-> (forall a. Ord a => GenStackFrames srt a -> a)
-> (forall a. Num a => GenStackFrames srt a -> a)
-> (forall a. Num a => GenStackFrames srt a -> a)
-> Foldable (GenStackFrames srt)
forall a. Eq a => a -> GenStackFrames srt a -> Bool
forall a. Num a => GenStackFrames srt a -> a
forall a. Ord a => GenStackFrames srt a -> a
forall m. Monoid m => GenStackFrames srt m -> m
forall a. GenStackFrames srt a -> Bool
forall a. GenStackFrames srt a -> Int
forall a. GenStackFrames srt a -> [a]
forall a. (a -> a -> a) -> GenStackFrames srt a -> a
forall srt a. Eq a => a -> GenStackFrames srt a -> Bool
forall srt a. Num a => GenStackFrames srt a -> a
forall srt a. Ord a => GenStackFrames srt a -> a
forall m a. Monoid m => (a -> m) -> GenStackFrames srt a -> m
forall srt m. Monoid m => GenStackFrames srt m -> m
forall srt a. GenStackFrames srt a -> Bool
forall srt a. GenStackFrames srt a -> Int
forall srt a. GenStackFrames srt a -> [a]
forall b a. (b -> a -> b) -> b -> GenStackFrames srt a -> b
forall a b. (a -> b -> b) -> b -> GenStackFrames srt a -> b
forall srt a. (a -> a -> a) -> GenStackFrames srt a -> a
forall srt m a. Monoid m => (a -> m) -> GenStackFrames srt a -> m
forall srt b a. (b -> a -> b) -> b -> GenStackFrames srt a -> b
forall srt a b. (a -> b -> b) -> b -> GenStackFrames srt a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall srt m. Monoid m => GenStackFrames srt m -> m
fold :: forall m. Monoid m => GenStackFrames srt m -> m
$cfoldMap :: forall srt m a. Monoid m => (a -> m) -> GenStackFrames srt a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GenStackFrames srt a -> m
$cfoldMap' :: forall srt m a. Monoid m => (a -> m) -> GenStackFrames srt a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> GenStackFrames srt a -> m
$cfoldr :: forall srt a b. (a -> b -> b) -> b -> GenStackFrames srt a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GenStackFrames srt a -> b
$cfoldr' :: forall srt a b. (a -> b -> b) -> b -> GenStackFrames srt a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GenStackFrames srt a -> b
$cfoldl :: forall srt b a. (b -> a -> b) -> b -> GenStackFrames srt a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GenStackFrames srt a -> b
$cfoldl' :: forall srt b a. (b -> a -> b) -> b -> GenStackFrames srt a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> GenStackFrames srt a -> b
$cfoldr1 :: forall srt a. (a -> a -> a) -> GenStackFrames srt a -> a
foldr1 :: forall a. (a -> a -> a) -> GenStackFrames srt a -> a
$cfoldl1 :: forall srt a. (a -> a -> a) -> GenStackFrames srt a -> a
foldl1 :: forall a. (a -> a -> a) -> GenStackFrames srt a -> a
$ctoList :: forall srt a. GenStackFrames srt a -> [a]
toList :: forall a. GenStackFrames srt a -> [a]
$cnull :: forall srt a. GenStackFrames srt a -> Bool
null :: forall a. GenStackFrames srt a -> Bool
$clength :: forall srt a. GenStackFrames srt a -> Int
length :: forall a. GenStackFrames srt a -> Int
$celem :: forall srt a. Eq a => a -> GenStackFrames srt a -> Bool
elem :: forall a. Eq a => a -> GenStackFrames srt a -> Bool
$cmaximum :: forall srt a. Ord a => GenStackFrames srt a -> a
maximum :: forall a. Ord a => GenStackFrames srt a -> a
$cminimum :: forall srt a. Ord a => GenStackFrames srt a -> a
minimum :: forall a. Ord a => GenStackFrames srt a -> a
$csum :: forall srt a. Num a => GenStackFrames srt a -> a
sum :: forall a. Num a => GenStackFrames srt a -> a
$cproduct :: forall srt a. Num a => GenStackFrames srt a -> a
product :: forall a. Num a => GenStackFrames srt a -> a
Foldable, Functor (GenStackFrames srt)
Foldable (GenStackFrames srt)
Functor (GenStackFrames srt)
-> Foldable (GenStackFrames srt)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> GenStackFrames srt a -> f (GenStackFrames srt b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GenStackFrames srt (f a) -> f (GenStackFrames srt a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GenStackFrames srt a -> m (GenStackFrames srt b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GenStackFrames srt (m a) -> m (GenStackFrames srt a))
-> Traversable (GenStackFrames srt)
forall srt. Functor (GenStackFrames srt)
forall srt. Foldable (GenStackFrames srt)
forall srt (m :: * -> *) a.
Monad m =>
GenStackFrames srt (m a) -> m (GenStackFrames srt a)
forall srt (f :: * -> *) a.
Applicative f =>
GenStackFrames srt (f a) -> f (GenStackFrames srt a)
forall srt (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenStackFrames srt a -> m (GenStackFrames srt b)
forall srt (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenStackFrames srt a -> f (GenStackFrames srt b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
GenStackFrames srt (m a) -> m (GenStackFrames srt a)
forall (f :: * -> *) a.
Applicative f =>
GenStackFrames srt (f a) -> f (GenStackFrames srt a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenStackFrames srt a -> m (GenStackFrames srt b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenStackFrames srt a -> f (GenStackFrames srt b)
$ctraverse :: forall srt (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenStackFrames srt a -> f (GenStackFrames srt b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenStackFrames srt a -> f (GenStackFrames srt b)
$csequenceA :: forall srt (f :: * -> *) a.
Applicative f =>
GenStackFrames srt (f a) -> f (GenStackFrames srt a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
GenStackFrames srt (f a) -> f (GenStackFrames srt a)
$cmapM :: forall srt (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenStackFrames srt a -> m (GenStackFrames srt b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenStackFrames srt a -> m (GenStackFrames srt b)
$csequence :: forall srt (m :: * -> *) a.
Monad m =>
GenStackFrames srt (m a) -> m (GenStackFrames srt a)
sequence :: forall (m :: * -> *) a.
Monad m =>
GenStackFrames srt (m a) -> m (GenStackFrames srt a)
Traversable, Int -> GenStackFrames srt b -> ShowS
[GenStackFrames srt b] -> ShowS
GenStackFrames srt b -> String
(Int -> GenStackFrames srt b -> ShowS)
-> (GenStackFrames srt b -> String)
-> ([GenStackFrames srt b] -> ShowS)
-> Show (GenStackFrames srt b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall srt b.
(Show srt, Show b) =>
Int -> GenStackFrames srt b -> ShowS
forall srt b. (Show srt, Show b) => [GenStackFrames srt b] -> ShowS
forall srt b. (Show srt, Show b) => GenStackFrames srt b -> String
$cshowsPrec :: forall srt b.
(Show srt, Show b) =>
Int -> GenStackFrames srt b -> ShowS
showsPrec :: Int -> GenStackFrames srt b -> ShowS
$cshow :: forall srt b. (Show srt, Show b) => GenStackFrames srt b -> String
show :: GenStackFrames srt b -> String
$cshowList :: forall srt b. (Show srt, Show b) => [GenStackFrames srt b] -> ShowS
showList :: [GenStackFrames srt b] -> ShowS
Show, Eq (GenStackFrames srt b)
Eq (GenStackFrames srt b)
-> (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)
-> (GenStackFrames srt b
    -> GenStackFrames srt b -> GenStackFrames srt b)
-> (GenStackFrames srt b
    -> GenStackFrames srt b -> GenStackFrames srt b)
-> Ord (GenStackFrames srt b)
GenStackFrames srt b -> GenStackFrames srt b -> Bool
GenStackFrames srt b -> GenStackFrames srt b -> Ordering
GenStackFrames srt b
-> GenStackFrames srt b -> GenStackFrames srt b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {srt} {b}. (Ord srt, Ord b) => Eq (GenStackFrames srt b)
forall srt b.
(Ord srt, Ord b) =>
GenStackFrames srt b -> GenStackFrames srt b -> Bool
forall srt b.
(Ord srt, Ord b) =>
GenStackFrames srt b -> GenStackFrames srt b -> Ordering
forall srt b.
(Ord srt, Ord b) =>
GenStackFrames srt b
-> GenStackFrames srt b -> GenStackFrames srt b
$ccompare :: forall srt b.
(Ord srt, Ord b) =>
GenStackFrames srt b -> GenStackFrames srt b -> Ordering
compare :: GenStackFrames srt b -> GenStackFrames srt b -> Ordering
$c< :: forall srt b.
(Ord srt, Ord b) =>
GenStackFrames srt b -> GenStackFrames srt b -> Bool
< :: GenStackFrames srt b -> GenStackFrames srt b -> Bool
$c<= :: forall srt b.
(Ord srt, Ord b) =>
GenStackFrames srt b -> GenStackFrames srt b -> Bool
<= :: GenStackFrames srt b -> GenStackFrames srt b -> Bool
$c> :: forall srt b.
(Ord srt, Ord b) =>
GenStackFrames srt b -> GenStackFrames srt b -> Bool
> :: GenStackFrames srt b -> GenStackFrames srt b -> Bool
$c>= :: forall srt b.
(Ord srt, Ord b) =>
GenStackFrames srt b -> GenStackFrames srt b -> Bool
>= :: GenStackFrames srt b -> GenStackFrames srt b -> Bool
$cmax :: forall srt b.
(Ord srt, Ord b) =>
GenStackFrames srt b
-> GenStackFrames srt b -> GenStackFrames srt b
max :: GenStackFrames srt b
-> GenStackFrames srt b -> GenStackFrames srt b
$cmin :: forall srt b.
(Ord srt, Ord b) =>
GenStackFrames srt b
-> GenStackFrames srt b -> GenStackFrames srt b
min :: GenStackFrames srt b
-> GenStackFrames srt b -> GenStackFrames srt b
Ord, GenStackFrames srt b -> GenStackFrames srt b -> Bool
(GenStackFrames srt b -> GenStackFrames srt b -> Bool)
-> (GenStackFrames srt b -> GenStackFrames srt b -> Bool)
-> Eq (GenStackFrames srt b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall srt b.
(Eq srt, Eq b) =>
GenStackFrames srt b -> GenStackFrames srt b -> Bool
$c== :: forall srt b.
(Eq srt, Eq b) =>
GenStackFrames srt b -> GenStackFrames srt b -> Bool
== :: GenStackFrames srt b -> GenStackFrames srt b -> Bool
$c/= :: forall srt b.
(Eq srt, Eq b) =>
GenStackFrames srt b -> GenStackFrames srt b -> Bool
/= :: GenStackFrames srt b -> GenStackFrames srt b -> Bool
Eq)

instance Bifoldable GenStackFrames where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> GenStackFrames a b -> m
bifoldMap a -> m
f b -> m
g (GenStackFrames [DebugStackFrame a b]
frames) = (DebugStackFrame a b -> m) -> [DebugStackFrame a b] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (b -> m) -> DebugStackFrame a b -> m
forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> DebugStackFrame a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) [DebugStackFrame a b]
frames

instance Bitraversable GenStackFrames where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> GenStackFrames a b -> f (GenStackFrames c d)
bitraverse a -> f c
f b -> f d
g (GenStackFrames [DebugStackFrame a b]
frames) = [DebugStackFrame c d] -> GenStackFrames c d
forall srt b. [DebugStackFrame srt b] -> GenStackFrames srt b
GenStackFrames ([DebugStackFrame c d] -> GenStackFrames c d)
-> f [DebugStackFrame c d] -> f (GenStackFrames c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DebugStackFrame a b -> f (DebugStackFrame c d))
-> [DebugStackFrame a b] -> f [DebugStackFrame c d]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> f c)
-> (b -> f d) -> DebugStackFrame a b -> f (DebugStackFrame c d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> DebugStackFrame a b -> f (DebugStackFrame c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) [DebugStackFrame a b]
frames

instance Bifunctor GenStackFrames where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> GenStackFrames a c -> GenStackFrames b d
bimap a -> b
f c -> d
g (GenStackFrames [DebugStackFrame a c]
frames) = [DebugStackFrame b d] -> GenStackFrames b d
forall srt b. [DebugStackFrame srt b] -> GenStackFrames srt b
GenStackFrames ((DebugStackFrame a c -> DebugStackFrame b d)
-> [DebugStackFrame a c] -> [DebugStackFrame b d]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (c -> d) -> DebugStackFrame a c -> DebugStackFrame b d
forall a b c d.
(a -> b) -> (c -> d) -> DebugStackFrame a c -> DebugStackFrame b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g) [DebugStackFrame a c]
frames)



data DebugStackFrame srt b
  = DebugStackFrame
        { forall srt b. DebugStackFrame srt b -> StgInfoTableWithPtr
frame_info :: !StgInfoTableWithPtr
        , forall srt b. DebugStackFrame srt b -> srt
frame_srt        :: srt
        , forall srt b. DebugStackFrame srt b -> [FieldValue b]
values     :: [FieldValue b]
        } deriving (Functor (DebugStackFrame srt)
Foldable (DebugStackFrame srt)
Functor (DebugStackFrame srt)
-> Foldable (DebugStackFrame srt)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> DebugStackFrame srt a -> f (DebugStackFrame srt b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    DebugStackFrame srt (f a) -> f (DebugStackFrame srt a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> DebugStackFrame srt a -> m (DebugStackFrame srt b))
-> (forall (m :: * -> *) a.
    Monad m =>
    DebugStackFrame srt (m a) -> m (DebugStackFrame srt a))
-> Traversable (DebugStackFrame srt)
forall srt. Functor (DebugStackFrame srt)
forall srt. Foldable (DebugStackFrame srt)
forall srt (m :: * -> *) a.
Monad m =>
DebugStackFrame srt (m a) -> m (DebugStackFrame srt a)
forall srt (f :: * -> *) a.
Applicative f =>
DebugStackFrame srt (f a) -> f (DebugStackFrame srt a)
forall srt (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DebugStackFrame srt a -> m (DebugStackFrame srt b)
forall srt (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DebugStackFrame srt a -> f (DebugStackFrame srt b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
DebugStackFrame srt (m a) -> m (DebugStackFrame srt a)
forall (f :: * -> *) a.
Applicative f =>
DebugStackFrame srt (f a) -> f (DebugStackFrame srt a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DebugStackFrame srt a -> m (DebugStackFrame srt b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DebugStackFrame srt a -> f (DebugStackFrame srt b)
$ctraverse :: forall srt (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DebugStackFrame srt a -> f (DebugStackFrame srt b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DebugStackFrame srt a -> f (DebugStackFrame srt b)
$csequenceA :: forall srt (f :: * -> *) a.
Applicative f =>
DebugStackFrame srt (f a) -> f (DebugStackFrame srt a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
DebugStackFrame srt (f a) -> f (DebugStackFrame srt a)
$cmapM :: forall srt (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DebugStackFrame srt a -> m (DebugStackFrame srt b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DebugStackFrame srt a -> m (DebugStackFrame srt b)
$csequence :: forall srt (m :: * -> *) a.
Monad m =>
DebugStackFrame srt (m a) -> m (DebugStackFrame srt a)
sequence :: forall (m :: * -> *) a.
Monad m =>
DebugStackFrame srt (m a) -> m (DebugStackFrame srt a)
Traversable, (forall a b.
 (a -> b) -> DebugStackFrame srt a -> DebugStackFrame srt b)
-> (forall a b.
    a -> DebugStackFrame srt b -> DebugStackFrame srt a)
-> Functor (DebugStackFrame srt)
forall a b. a -> DebugStackFrame srt b -> DebugStackFrame srt a
forall a b.
(a -> b) -> DebugStackFrame srt a -> DebugStackFrame srt b
forall srt a b. a -> DebugStackFrame srt b -> DebugStackFrame srt a
forall srt a b.
(a -> b) -> DebugStackFrame srt a -> DebugStackFrame srt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall srt a b.
(a -> b) -> DebugStackFrame srt a -> DebugStackFrame srt b
fmap :: forall a b.
(a -> b) -> DebugStackFrame srt a -> DebugStackFrame srt b
$c<$ :: forall srt a b. a -> DebugStackFrame srt b -> DebugStackFrame srt a
<$ :: forall a b. a -> DebugStackFrame srt b -> DebugStackFrame srt a
Functor, (forall m. Monoid m => DebugStackFrame srt m -> m)
-> (forall m a. Monoid m => (a -> m) -> DebugStackFrame srt a -> m)
-> (forall m a. Monoid m => (a -> m) -> DebugStackFrame srt a -> m)
-> (forall a b. (a -> b -> b) -> b -> DebugStackFrame srt a -> b)
-> (forall a b. (a -> b -> b) -> b -> DebugStackFrame srt a -> b)
-> (forall b a. (b -> a -> b) -> b -> DebugStackFrame srt a -> b)
-> (forall b a. (b -> a -> b) -> b -> DebugStackFrame srt a -> b)
-> (forall a. (a -> a -> a) -> DebugStackFrame srt a -> a)
-> (forall a. (a -> a -> a) -> DebugStackFrame srt a -> a)
-> (forall a. DebugStackFrame srt a -> [a])
-> (forall a. DebugStackFrame srt a -> Bool)
-> (forall a. DebugStackFrame srt a -> Int)
-> (forall a. Eq a => a -> DebugStackFrame srt a -> Bool)
-> (forall a. Ord a => DebugStackFrame srt a -> a)
-> (forall a. Ord a => DebugStackFrame srt a -> a)
-> (forall a. Num a => DebugStackFrame srt a -> a)
-> (forall a. Num a => DebugStackFrame srt a -> a)
-> Foldable (DebugStackFrame srt)
forall a. Eq a => a -> DebugStackFrame srt a -> Bool
forall a. Num a => DebugStackFrame srt a -> a
forall a. Ord a => DebugStackFrame srt a -> a
forall m. Monoid m => DebugStackFrame srt m -> m
forall a. DebugStackFrame srt a -> Bool
forall a. DebugStackFrame srt a -> Int
forall a. DebugStackFrame srt a -> [a]
forall a. (a -> a -> a) -> DebugStackFrame srt a -> a
forall srt a. Eq a => a -> DebugStackFrame srt a -> Bool
forall srt a. Num a => DebugStackFrame srt a -> a
forall srt a. Ord a => DebugStackFrame srt a -> a
forall m a. Monoid m => (a -> m) -> DebugStackFrame srt a -> m
forall srt m. Monoid m => DebugStackFrame srt m -> m
forall srt a. DebugStackFrame srt a -> Bool
forall srt a. DebugStackFrame srt a -> Int
forall srt a. DebugStackFrame srt a -> [a]
forall b a. (b -> a -> b) -> b -> DebugStackFrame srt a -> b
forall a b. (a -> b -> b) -> b -> DebugStackFrame srt a -> b
forall srt a. (a -> a -> a) -> DebugStackFrame srt a -> a
forall srt m a. Monoid m => (a -> m) -> DebugStackFrame srt a -> m
forall srt b a. (b -> a -> b) -> b -> DebugStackFrame srt a -> b
forall srt a b. (a -> b -> b) -> b -> DebugStackFrame srt a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall srt m. Monoid m => DebugStackFrame srt m -> m
fold :: forall m. Monoid m => DebugStackFrame srt m -> m
$cfoldMap :: forall srt m a. Monoid m => (a -> m) -> DebugStackFrame srt a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> DebugStackFrame srt a -> m
$cfoldMap' :: forall srt m a. Monoid m => (a -> m) -> DebugStackFrame srt a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> DebugStackFrame srt a -> m
$cfoldr :: forall srt a b. (a -> b -> b) -> b -> DebugStackFrame srt a -> b
foldr :: forall a b. (a -> b -> b) -> b -> DebugStackFrame srt a -> b
$cfoldr' :: forall srt a b. (a -> b -> b) -> b -> DebugStackFrame srt a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> DebugStackFrame srt a -> b
$cfoldl :: forall srt b a. (b -> a -> b) -> b -> DebugStackFrame srt a -> b
foldl :: forall b a. (b -> a -> b) -> b -> DebugStackFrame srt a -> b
$cfoldl' :: forall srt b a. (b -> a -> b) -> b -> DebugStackFrame srt a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> DebugStackFrame srt a -> b
$cfoldr1 :: forall srt a. (a -> a -> a) -> DebugStackFrame srt a -> a
foldr1 :: forall a. (a -> a -> a) -> DebugStackFrame srt a -> a
$cfoldl1 :: forall srt a. (a -> a -> a) -> DebugStackFrame srt a -> a
foldl1 :: forall a. (a -> a -> a) -> DebugStackFrame srt a -> a
$ctoList :: forall srt a. DebugStackFrame srt a -> [a]
toList :: forall a. DebugStackFrame srt a -> [a]
$cnull :: forall srt a. DebugStackFrame srt a -> Bool
null :: forall a. DebugStackFrame srt a -> Bool
$clength :: forall srt a. DebugStackFrame srt a -> Int
length :: forall a. DebugStackFrame srt a -> Int
$celem :: forall srt a. Eq a => a -> DebugStackFrame srt a -> Bool
elem :: forall a. Eq a => a -> DebugStackFrame srt a -> Bool
$cmaximum :: forall srt a. Ord a => DebugStackFrame srt a -> a
maximum :: forall a. Ord a => DebugStackFrame srt a -> a
$cminimum :: forall srt a. Ord a => DebugStackFrame srt a -> a
minimum :: forall a. Ord a => DebugStackFrame srt a -> a
$csum :: forall srt a. Num a => DebugStackFrame srt a -> a
sum :: forall a. Num a => DebugStackFrame srt a -> a
$cproduct :: forall srt a. Num a => DebugStackFrame srt a -> a
product :: forall a. Num a => DebugStackFrame srt a -> a
Foldable, Int -> DebugStackFrame srt b -> ShowS
[DebugStackFrame srt b] -> ShowS
DebugStackFrame srt b -> String
(Int -> DebugStackFrame srt b -> ShowS)
-> (DebugStackFrame srt b -> String)
-> ([DebugStackFrame srt b] -> ShowS)
-> Show (DebugStackFrame srt b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall srt b.
(Show srt, Show b) =>
Int -> DebugStackFrame srt b -> ShowS
forall srt b.
(Show srt, Show b) =>
[DebugStackFrame srt b] -> ShowS
forall srt b. (Show srt, Show b) => DebugStackFrame srt b -> String
$cshowsPrec :: forall srt b.
(Show srt, Show b) =>
Int -> DebugStackFrame srt b -> ShowS
showsPrec :: Int -> DebugStackFrame srt b -> ShowS
$cshow :: forall srt b. (Show srt, Show b) => DebugStackFrame srt b -> String
show :: DebugStackFrame srt b -> String
$cshowList :: forall srt b.
(Show srt, Show b) =>
[DebugStackFrame srt b] -> ShowS
showList :: [DebugStackFrame srt b] -> ShowS
Show, Eq (DebugStackFrame srt b)
Eq (DebugStackFrame srt b)
-> (DebugStackFrame srt b -> DebugStackFrame srt b -> Ordering)
-> (DebugStackFrame srt b -> DebugStackFrame srt b -> Bool)
-> (DebugStackFrame srt b -> DebugStackFrame srt b -> Bool)
-> (DebugStackFrame srt b -> DebugStackFrame srt b -> Bool)
-> (DebugStackFrame srt b -> DebugStackFrame srt b -> Bool)
-> (DebugStackFrame srt b
    -> DebugStackFrame srt b -> DebugStackFrame srt b)
-> (DebugStackFrame srt b
    -> DebugStackFrame srt b -> DebugStackFrame srt b)
-> Ord (DebugStackFrame srt b)
DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
DebugStackFrame srt b -> DebugStackFrame srt b -> Ordering
DebugStackFrame srt b
-> DebugStackFrame srt b -> DebugStackFrame srt b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {srt} {b}. (Ord srt, Ord b) => Eq (DebugStackFrame srt b)
forall srt b.
(Ord srt, Ord b) =>
DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
forall srt b.
(Ord srt, Ord b) =>
DebugStackFrame srt b -> DebugStackFrame srt b -> Ordering
forall srt b.
(Ord srt, Ord b) =>
DebugStackFrame srt b
-> DebugStackFrame srt b -> DebugStackFrame srt b
$ccompare :: forall srt b.
(Ord srt, Ord b) =>
DebugStackFrame srt b -> DebugStackFrame srt b -> Ordering
compare :: DebugStackFrame srt b -> DebugStackFrame srt b -> Ordering
$c< :: forall srt b.
(Ord srt, Ord b) =>
DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
< :: DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
$c<= :: forall srt b.
(Ord srt, Ord b) =>
DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
<= :: DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
$c> :: forall srt b.
(Ord srt, Ord b) =>
DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
> :: DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
$c>= :: forall srt b.
(Ord srt, Ord b) =>
DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
>= :: DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
$cmax :: forall srt b.
(Ord srt, Ord b) =>
DebugStackFrame srt b
-> DebugStackFrame srt b -> DebugStackFrame srt b
max :: DebugStackFrame srt b
-> DebugStackFrame srt b -> DebugStackFrame srt b
$cmin :: forall srt b.
(Ord srt, Ord b) =>
DebugStackFrame srt b
-> DebugStackFrame srt b -> DebugStackFrame srt b
min :: DebugStackFrame srt b
-> DebugStackFrame srt b -> DebugStackFrame srt b
Ord, DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
(DebugStackFrame srt b -> DebugStackFrame srt b -> Bool)
-> (DebugStackFrame srt b -> DebugStackFrame srt b -> Bool)
-> Eq (DebugStackFrame srt b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall srt b.
(Eq srt, Eq b) =>
DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
$c== :: forall srt b.
(Eq srt, Eq b) =>
DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
== :: DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
$c/= :: forall srt b.
(Eq srt, Eq b) =>
DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
/= :: DebugStackFrame srt b -> DebugStackFrame srt b -> Bool
Eq)


instance Bifunctor DebugStackFrame where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> DebugStackFrame a c -> DebugStackFrame b d
bimap a -> b
f c -> d
g (DebugStackFrame StgInfoTableWithPtr
itbl a
srt [FieldValue c]
v) = StgInfoTableWithPtr -> b -> [FieldValue d] -> DebugStackFrame b d
forall srt b.
StgInfoTableWithPtr
-> srt -> [FieldValue b] -> DebugStackFrame srt b
DebugStackFrame StgInfoTableWithPtr
itbl (a -> b
f a
srt) ((FieldValue c -> FieldValue d) -> [FieldValue c] -> [FieldValue d]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c -> d) -> FieldValue c -> FieldValue d
forall a b. (a -> b) -> FieldValue a -> FieldValue b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g) [FieldValue c]
v)

instance Bifoldable DebugStackFrame where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> DebugStackFrame a b -> m
bifoldMap a -> m
f b -> m
g (DebugStackFrame StgInfoTableWithPtr
_ a
srt [FieldValue b]
v) = a -> m
f a
srt m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (FieldValue b -> m) -> [FieldValue b] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((b -> m) -> FieldValue b -> m
forall m a. Monoid m => (a -> m) -> FieldValue a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g) [FieldValue b]
v

instance Bitraversable DebugStackFrame where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> DebugStackFrame a b -> f (DebugStackFrame c d)
bitraverse a -> f c
f b -> f d
g (DebugStackFrame StgInfoTableWithPtr
itbl a
srt [FieldValue b]
v) = StgInfoTableWithPtr -> c -> [FieldValue d] -> DebugStackFrame c d
forall srt b.
StgInfoTableWithPtr
-> srt -> [FieldValue b] -> DebugStackFrame srt b
DebugStackFrame StgInfoTableWithPtr
itbl (c -> [FieldValue d] -> DebugStackFrame c d)
-> f c -> f ([FieldValue d] -> DebugStackFrame c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
srt f ([FieldValue d] -> DebugStackFrame c d)
-> f [FieldValue d] -> f (DebugStackFrame c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FieldValue b -> f (FieldValue d))
-> [FieldValue b] -> f [FieldValue d]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((b -> f d) -> FieldValue b -> f (FieldValue d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FieldValue a -> f (FieldValue b)
traverse b -> f d
g) [FieldValue b]
v



data ConstrDesc = ConstrDesc {
          ConstrDesc -> String
pkg        :: !String         -- ^ Package name
        , ConstrDesc -> String
modl       :: !String         -- ^ Module name
        , ConstrDesc -> String
name       :: !String         -- ^ Constructor name
        } deriving (Int -> ConstrDesc -> ShowS
[ConstrDesc] -> ShowS
ConstrDesc -> String
(Int -> ConstrDesc -> ShowS)
-> (ConstrDesc -> String)
-> ([ConstrDesc] -> ShowS)
-> Show ConstrDesc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConstrDesc -> ShowS
showsPrec :: Int -> ConstrDesc -> ShowS
$cshow :: ConstrDesc -> String
show :: ConstrDesc -> String
$cshowList :: [ConstrDesc] -> ShowS
showList :: [ConstrDesc] -> ShowS
Show, ConstrDesc -> ConstrDesc -> Bool
(ConstrDesc -> ConstrDesc -> Bool)
-> (ConstrDesc -> ConstrDesc -> Bool) -> Eq ConstrDesc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConstrDesc -> ConstrDesc -> Bool
== :: ConstrDesc -> ConstrDesc -> Bool
$c/= :: ConstrDesc -> ConstrDesc -> Bool
/= :: ConstrDesc -> ConstrDesc -> Bool
Eq, Eq ConstrDesc
Eq ConstrDesc
-> (ConstrDesc -> ConstrDesc -> Ordering)
-> (ConstrDesc -> ConstrDesc -> Bool)
-> (ConstrDesc -> ConstrDesc -> Bool)
-> (ConstrDesc -> ConstrDesc -> Bool)
-> (ConstrDesc -> ConstrDesc -> Bool)
-> (ConstrDesc -> ConstrDesc -> ConstrDesc)
-> (ConstrDesc -> ConstrDesc -> ConstrDesc)
-> Ord ConstrDesc
ConstrDesc -> ConstrDesc -> Bool
ConstrDesc -> ConstrDesc -> Ordering
ConstrDesc -> ConstrDesc -> ConstrDesc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConstrDesc -> ConstrDesc -> Ordering
compare :: ConstrDesc -> ConstrDesc -> Ordering
$c< :: ConstrDesc -> ConstrDesc -> Bool
< :: ConstrDesc -> ConstrDesc -> Bool
$c<= :: ConstrDesc -> ConstrDesc -> Bool
<= :: ConstrDesc -> ConstrDesc -> Bool
$c> :: ConstrDesc -> ConstrDesc -> Bool
> :: ConstrDesc -> ConstrDesc -> Bool
$c>= :: ConstrDesc -> ConstrDesc -> Bool
>= :: ConstrDesc -> ConstrDesc -> Bool
$cmax :: ConstrDesc -> ConstrDesc -> ConstrDesc
max :: ConstrDesc -> ConstrDesc -> ConstrDesc
$cmin :: ConstrDesc -> ConstrDesc -> ConstrDesc
min :: ConstrDesc -> ConstrDesc -> ConstrDesc
Ord)


-- Copied from ghc-heap
parseConstrDesc :: String -> ConstrDesc
parseConstrDesc :: String -> ConstrDesc
parseConstrDesc String
input =
    if Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) ([Int] -> Bool) -> ([String] -> [Int]) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ [String
p,String
m,String
occ]
                     then String -> String -> String -> ConstrDesc
ConstrDesc String
"" String
"" String
input
                     else String -> String -> String -> ConstrDesc
ConstrDesc String
p String
m String
occ
  where
    (String
p, String
rest1) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') String
input
    (String
m, String
occ)
        = (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse [String]
modWords, String
occWord)
        where
        ([String]
modWords, String
occWord) =
            if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest1 --  XXXXXXXXx YUKX
                --then error "getConDescAddress:parse:length rest1 < 1"
                then [String] -> String -> ([String], String)
parseModOcc [] []
                else [String] -> String -> ([String], String)
parseModOcc [] (ShowS
forall a. HasCallStack => [a] -> [a]
tail String
rest1)
    -- We only look for dots if str could start with a module name,
    -- i.e. if it starts with an upper case character.
    -- Otherwise we might think that "X.:->" is the module name in
    -- "X.:->.+", whereas actually "X" is the module name and
    -- ":->.+" is a constructor name.
    parseModOcc :: [String] -> String -> ([String], String)
    parseModOcc :: [String] -> String -> ([String], String)
parseModOcc [String]
acc str :: String
str@(Char
c : String
_)
        | Char -> Bool
isUpper Char
c =
            case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') String
str of
                (String
top, []) -> ([String]
acc, String
top)
                (String
top, Char
_:String
bot) -> [String] -> String -> ([String], String)
parseModOcc (String
top String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc) String
bot
    parseModOcc [String]
acc String
str = ([String]
acc, String
str)

class Hextraversable m where
  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)

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
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
hexmap = ((a -> Identity b)
 -> (c -> Identity d)
 -> (e -> Identity f)
 -> (g -> Identity h)
 -> (i -> Identity j)
 -> (k -> Identity l)
 -> t a c e g i k
 -> Identity (t b d f h j l))
-> (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
forall a b. Coercible a b => a -> b
coerce
  ((a -> Identity b)
-> (c -> Identity d)
-> (e -> Identity f)
-> (g -> Identity h)
-> (i -> Identity j)
-> (k -> Identity l)
-> t a c e g i k
-> Identity (t b d f h j l)
forall (f :: * -> *) a b c d e g h i j k l n.
Applicative f =>
(a -> f b)
-> (c -> f d)
-> (e -> f g)
-> (h -> f i)
-> (j -> f k)
-> (l -> f n)
-> t a c e h j l
-> f (t b d g i k n)
forall (m :: * -> * -> * -> * -> * -> * -> *) (f :: * -> *) a b c d
       e g h i j k l n.
(Hextraversable m, 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)
hextraverse :: (a -> Identity b)
              -> (c -> Identity d)
              -> (e -> Identity f)
              -> (g -> Identity h)
              -> (i -> Identity j)
              -> (k -> Identity l)
              -> t a c e g i k -> Identity (t b d f h j l))

allClosures :: DebugClosure ccs (GenSrtPayload c) (GenPapPayload c) a (GenStackFrames (GenSrtPayload c) c) c -> [c]
allClosures :: forall ccs c a.
DebugClosure
  ccs
  (GenSrtPayload c)
  (GenPapPayload c)
  a
  (GenStackFrames (GenSrtPayload c) c)
  c
-> [c]
allClosures DebugClosure
  ccs
  (GenSrtPayload c)
  (GenPapPayload c)
  a
  (GenStackFrames (GenSrtPayload c) c)
  c
c = Const
  [c]
  (DebugClosure
     Any
     (GenSrtPayload Any)
     (GenPapPayload Any)
     Any
     (GenStackFrames (GenSrtPayload c) Any)
     Any)
-> [c]
forall {k} a (b :: k). Const a b -> a
getConst (Const
   [c]
   (DebugClosure
      Any
      (GenSrtPayload Any)
      (GenPapPayload Any)
      Any
      (GenStackFrames (GenSrtPayload c) Any)
      Any)
 -> [c])
-> Const
     [c]
     (DebugClosure
        Any
        (GenSrtPayload Any)
        (GenPapPayload Any)
        Any
        (GenStackFrames (GenSrtPayload c) Any)
        Any)
-> [c]
forall a b. (a -> b) -> a -> b
$ (ccs -> Const [c] Any)
-> (GenSrtPayload c -> Const [c] (GenSrtPayload Any))
-> (GenPapPayload c -> Const [c] (GenPapPayload Any))
-> (a -> Const [c] Any)
-> (GenStackFrames (GenSrtPayload c) c
    -> Const [c] (GenStackFrames (GenSrtPayload c) Any))
-> (c -> Const [c] Any)
-> DebugClosure
     ccs
     (GenSrtPayload c)
     (GenPapPayload c)
     a
     (GenStackFrames (GenSrtPayload c) c)
     c
-> Const
     [c]
     (DebugClosure
        Any
        (GenSrtPayload Any)
        (GenPapPayload Any)
        Any
        (GenStackFrames (GenSrtPayload c) Any)
        Any)
forall (f :: * -> *) a b c d e g h i j k l n.
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)
forall (m :: * -> * -> * -> * -> * -> * -> *) (f :: * -> *) a b c d
       e g h i j k l n.
(Hextraversable m, 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)
hextraverse (Const [c] Any -> ccs -> Const [c] Any
forall a b. a -> b -> a
const ([c] -> Const [c] Any
forall {k} a (b :: k). a -> Const a b
Const [])) ((c -> Const [c] Any)
-> GenSrtPayload c -> Const [c] (GenSrtPayload Any)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenSrtPayload a -> f (GenSrtPayload b)
traverse ([c] -> Const [c] Any
forall {k} a (b :: k). a -> Const a b
Const ([c] -> Const [c] Any) -> (c -> [c]) -> c -> Const [c] Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> [c] -> [c]
forall a. a -> [a] -> [a]
:[]))) ((c -> Const [c] Any)
-> GenPapPayload c -> Const [c] (GenPapPayload Any)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenPapPayload a -> f (GenPapPayload b)
traverse ([c] -> Const [c] Any
forall {k} a (b :: k). a -> Const a b
Const ([c] -> Const [c] Any) -> (c -> [c]) -> c -> Const [c] Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> [c] -> [c]
forall a. a -> [a] -> [a]
:[]))) (Const [c] Any -> a -> Const [c] Any
forall a b. a -> b -> a
const ([c] -> Const [c] Any
forall {k} a (b :: k). a -> Const a b
Const [])) ((c -> Const [c] Any)
-> GenStackFrames (GenSrtPayload c) c
-> Const [c] (GenStackFrames (GenSrtPayload c) Any)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenStackFrames (GenSrtPayload c) a
-> f (GenStackFrames (GenSrtPayload c) b)
traverse ([c] -> Const [c] Any
forall {k} a (b :: k). a -> Const a b
Const ([c] -> Const [c] Any) -> (c -> [c]) -> c -> Const [c] Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> [c] -> [c]
forall a. a -> [a] -> [a]
:[]))) ([c] -> Const [c] Any
forall {k} a (b :: k). a -> Const a b
Const ([c] -> Const [c] Any) -> (c -> [c]) -> c -> Const [c] Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> [c] -> [c]
forall a. a -> [a] -> [a]
:[])) DebugClosure
  ccs
  (GenSrtPayload c)
  (GenPapPayload c)
  a
  (GenStackFrames (GenSrtPayload c) c)
  c
c

data FieldValue b = SPtr b
                  | SNonPtr !Word64 deriving (Int -> FieldValue b -> ShowS
[FieldValue b] -> ShowS
FieldValue b -> String
(Int -> FieldValue b -> ShowS)
-> (FieldValue b -> String)
-> ([FieldValue b] -> ShowS)
-> Show (FieldValue b)
forall b. Show b => Int -> FieldValue b -> ShowS
forall b. Show b => [FieldValue b] -> ShowS
forall b. Show b => FieldValue b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall b. Show b => Int -> FieldValue b -> ShowS
showsPrec :: Int -> FieldValue b -> ShowS
$cshow :: forall b. Show b => FieldValue b -> String
show :: FieldValue b -> String
$cshowList :: forall b. Show b => [FieldValue b] -> ShowS
showList :: [FieldValue b] -> ShowS
Show, Functor FieldValue
Foldable FieldValue
Functor FieldValue
-> Foldable FieldValue
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> FieldValue a -> f (FieldValue b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    FieldValue (f a) -> f (FieldValue a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> FieldValue a -> m (FieldValue b))
-> (forall (m :: * -> *) a.
    Monad m =>
    FieldValue (m a) -> m (FieldValue a))
-> Traversable FieldValue
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
FieldValue (m a) -> m (FieldValue a)
forall (f :: * -> *) a.
Applicative f =>
FieldValue (f a) -> f (FieldValue a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FieldValue a -> m (FieldValue b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FieldValue a -> f (FieldValue b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FieldValue a -> f (FieldValue b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FieldValue a -> f (FieldValue b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
FieldValue (f a) -> f (FieldValue a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
FieldValue (f a) -> f (FieldValue a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FieldValue a -> m (FieldValue b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FieldValue a -> m (FieldValue b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
FieldValue (m a) -> m (FieldValue a)
sequence :: forall (m :: * -> *) a.
Monad m =>
FieldValue (m a) -> m (FieldValue a)
Traversable, (forall a b. (a -> b) -> FieldValue a -> FieldValue b)
-> (forall a b. a -> FieldValue b -> FieldValue a)
-> Functor FieldValue
forall a b. a -> FieldValue b -> FieldValue a
forall a b. (a -> b) -> FieldValue a -> FieldValue b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> FieldValue a -> FieldValue b
fmap :: forall a b. (a -> b) -> FieldValue a -> FieldValue b
$c<$ :: forall a b. a -> FieldValue b -> FieldValue a
<$ :: forall a b. a -> FieldValue b -> FieldValue a
Functor, (forall m. Monoid m => FieldValue m -> m)
-> (forall m a. Monoid m => (a -> m) -> FieldValue a -> m)
-> (forall m a. Monoid m => (a -> m) -> FieldValue a -> m)
-> (forall a b. (a -> b -> b) -> b -> FieldValue a -> b)
-> (forall a b. (a -> b -> b) -> b -> FieldValue a -> b)
-> (forall b a. (b -> a -> b) -> b -> FieldValue a -> b)
-> (forall b a. (b -> a -> b) -> b -> FieldValue a -> b)
-> (forall a. (a -> a -> a) -> FieldValue a -> a)
-> (forall a. (a -> a -> a) -> FieldValue a -> a)
-> (forall a. FieldValue a -> [a])
-> (forall a. FieldValue a -> Bool)
-> (forall a. FieldValue a -> Int)
-> (forall a. Eq a => a -> FieldValue a -> Bool)
-> (forall a. Ord a => FieldValue a -> a)
-> (forall a. Ord a => FieldValue a -> a)
-> (forall a. Num a => FieldValue a -> a)
-> (forall a. Num a => FieldValue a -> a)
-> Foldable FieldValue
forall a. Eq a => a -> FieldValue a -> Bool
forall a. Num a => FieldValue a -> a
forall a. Ord a => FieldValue a -> a
forall m. Monoid m => FieldValue m -> m
forall a. FieldValue a -> Bool
forall a. FieldValue a -> Int
forall a. FieldValue a -> [a]
forall a. (a -> a -> a) -> FieldValue a -> a
forall m a. Monoid m => (a -> m) -> FieldValue a -> m
forall b a. (b -> a -> b) -> b -> FieldValue a -> b
forall a b. (a -> b -> b) -> b -> FieldValue a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => FieldValue m -> m
fold :: forall m. Monoid m => FieldValue m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> FieldValue a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> FieldValue a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> FieldValue a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> FieldValue a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> FieldValue a -> b
foldr :: forall a b. (a -> b -> b) -> b -> FieldValue a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> FieldValue a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> FieldValue a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> FieldValue a -> b
foldl :: forall b a. (b -> a -> b) -> b -> FieldValue a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> FieldValue a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> FieldValue a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> FieldValue a -> a
foldr1 :: forall a. (a -> a -> a) -> FieldValue a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> FieldValue a -> a
foldl1 :: forall a. (a -> a -> a) -> FieldValue a -> a
$ctoList :: forall a. FieldValue a -> [a]
toList :: forall a. FieldValue a -> [a]
$cnull :: forall a. FieldValue a -> Bool
null :: forall a. FieldValue a -> Bool
$clength :: forall a. FieldValue a -> Int
length :: forall a. FieldValue a -> Int
$celem :: forall a. Eq a => a -> FieldValue a -> Bool
elem :: forall a. Eq a => a -> FieldValue a -> Bool
$cmaximum :: forall a. Ord a => FieldValue a -> a
maximum :: forall a. Ord a => FieldValue a -> a
$cminimum :: forall a. Ord a => FieldValue a -> a
minimum :: forall a. Ord a => FieldValue a -> a
$csum :: forall a. Num a => FieldValue a -> a
sum :: forall a. Num a => FieldValue a -> a
$cproduct :: forall a. Num a => FieldValue a -> a
product :: forall a. Num a => FieldValue a -> a
Foldable, Eq (FieldValue b)
Eq (FieldValue b)
-> (FieldValue b -> FieldValue b -> Ordering)
-> (FieldValue b -> FieldValue b -> Bool)
-> (FieldValue b -> FieldValue b -> Bool)
-> (FieldValue b -> FieldValue b -> Bool)
-> (FieldValue b -> FieldValue b -> Bool)
-> (FieldValue b -> FieldValue b -> FieldValue b)
-> (FieldValue b -> FieldValue b -> FieldValue b)
-> Ord (FieldValue b)
FieldValue b -> FieldValue b -> Bool
FieldValue b -> FieldValue b -> Ordering
FieldValue b -> FieldValue b -> FieldValue b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {b}. Ord b => Eq (FieldValue b)
forall b. Ord b => FieldValue b -> FieldValue b -> Bool
forall b. Ord b => FieldValue b -> FieldValue b -> Ordering
forall b. Ord b => FieldValue b -> FieldValue b -> FieldValue b
$ccompare :: forall b. Ord b => FieldValue b -> FieldValue b -> Ordering
compare :: FieldValue b -> FieldValue b -> Ordering
$c< :: forall b. Ord b => FieldValue b -> FieldValue b -> Bool
< :: FieldValue b -> FieldValue b -> Bool
$c<= :: forall b. Ord b => FieldValue b -> FieldValue b -> Bool
<= :: FieldValue b -> FieldValue b -> Bool
$c> :: forall b. Ord b => FieldValue b -> FieldValue b -> Bool
> :: FieldValue b -> FieldValue b -> Bool
$c>= :: forall b. Ord b => FieldValue b -> FieldValue b -> Bool
>= :: FieldValue b -> FieldValue b -> Bool
$cmax :: forall b. Ord b => FieldValue b -> FieldValue b -> FieldValue b
max :: FieldValue b -> FieldValue b -> FieldValue b
$cmin :: forall b. Ord b => FieldValue b -> FieldValue b -> FieldValue b
min :: FieldValue b -> FieldValue b -> FieldValue b
Ord, FieldValue b -> FieldValue b -> Bool
(FieldValue b -> FieldValue b -> Bool)
-> (FieldValue b -> FieldValue b -> Bool) -> Eq (FieldValue b)
forall b. Eq b => FieldValue b -> FieldValue b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall b. Eq b => FieldValue b -> FieldValue b -> Bool
== :: FieldValue b -> FieldValue b -> Bool
$c/= :: forall b. Eq b => FieldValue b -> FieldValue b -> Bool
/= :: FieldValue b -> FieldValue b -> Bool
Eq)


instance Hextraversable DebugClosure where
  hextraverse :: forall (f :: * -> *) a b c d e g h i j k l n.
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)
hextraverse a -> f b
fccs c -> f d
srt e -> f g
p h -> f i
h j -> f k
f l -> f n
g DebugClosure a c e h j l
c =
    case DebugClosure a c e h j l
c of
      ConstrClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph [l]
bs [Word]
ds h
str ->
        (\Maybe (ProfHeader b)
ph1 [n]
cs i
cstr -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> [n]
-> [Word]
-> i
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> [b]
-> [Word]
-> string
-> DebugClosure ccs srt pap string s b
ConstrClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader b)
ph1 [n]
cs [Word]
ds i
cstr) (Maybe (ProfHeader b) -> [n] -> i -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f ([n] -> i -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f ([n] -> i -> DebugClosure b d g i k n)
-> f [n] -> f (i -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (l -> f n) -> [l] -> f [n]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse l -> f n
g [l]
bs f (i -> DebugClosure b d g i k n)
-> f i -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
h h
str
      FunClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph c
srt_p [l]
bs [Word]
ws -> (\Maybe (ProfHeader b)
ph1 d
srt' [n]
cs -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> d
-> [n]
-> [Word]
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> srt
-> [b]
-> [Word]
-> DebugClosure ccs srt pap string s b
FunClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader b)
ph1 d
srt' [n]
cs [Word]
ws) (Maybe (ProfHeader b) -> d -> [n] -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f (d -> [n] -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (d -> [n] -> DebugClosure b d g i k n)
-> f d -> f ([n] -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> f d
srt c
srt_p f ([n] -> DebugClosure b d g i k n)
-> f [n] -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (l -> f n) -> [l] -> f [n]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse l -> f n
g [l]
bs
      ThunkClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph c
srt_p [l]
bs [Word]
ws -> (\Maybe (ProfHeader b)
ph1 d
srt' [n]
cs -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> d
-> [n]
-> [Word]
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> srt
-> [b]
-> [Word]
-> DebugClosure ccs srt pap string s b
ThunkClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader b)
ph1 d
srt' [n]
cs [Word]
ws) (Maybe (ProfHeader b) -> d -> [n] -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f (d -> [n] -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (d -> [n] -> DebugClosure b d g i k n)
-> f d -> f ([n] -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> f d
srt c
srt_p f ([n] -> DebugClosure b d g i k n)
-> f [n] -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (l -> f n) -> [l] -> f [n]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse l -> f n
g [l]
bs
      SelectorClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph l
b  -> StgInfoTableWithPtr
-> Maybe (ProfHeader b) -> n -> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> DebugClosure ccs srt pap string s b
SelectorClosure StgInfoTableWithPtr
a1 (Maybe (ProfHeader b) -> n -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b)) -> f (n -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (n -> DebugClosure b d g i k n)
-> f n -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b
      PAPClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
a2 HalfWord
a3 HalfWord
a4 l
a5 e
a6 -> (\Maybe (ProfHeader b)
b2 -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> HalfWord
-> HalfWord
-> n
-> g
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> HalfWord
-> HalfWord
-> b
-> pap
-> DebugClosure ccs srt pap string s b
PAPClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader b)
b2 HalfWord
a3 HalfWord
a4) (Maybe (ProfHeader b) -> n -> g -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f (n -> g -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
a2 f (n -> g -> DebugClosure b d g i k n)
-> f n -> f (g -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
a5 f (g -> DebugClosure b d g i k n)
-> f g -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> f g
p e
a6
      APClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
a2 HalfWord
a3 HalfWord
a4 l
a5 e
a6 -> (\Maybe (ProfHeader b)
b2 -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> HalfWord
-> HalfWord
-> n
-> g
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> HalfWord
-> HalfWord
-> b
-> pap
-> DebugClosure ccs srt pap string s b
APClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader b)
b2 HalfWord
a3 HalfWord
a4) (Maybe (ProfHeader b) -> n -> g -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f (n -> g -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
a2 f (n -> g -> DebugClosure b d g i k n)
-> f n -> f (g -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
a5 f (g -> DebugClosure b d g i k n)
-> f g -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> f g
p e
a6
      APStackClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph Word
s l
b j
bs   -> (\Maybe (ProfHeader b)
ph2 -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> Word
-> n
-> k
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> Word
-> b
-> s
-> DebugClosure ccs srt pap string s b
APStackClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader b)
ph2 Word
s) (Maybe (ProfHeader b) -> n -> k -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f (n -> k -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (n -> k -> DebugClosure b d g i k n)
-> f n -> f (k -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b f (k -> DebugClosure b d g i k n)
-> f k -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> j -> f k
f j
bs
      IndClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph l
b -> StgInfoTableWithPtr
-> Maybe (ProfHeader b) -> n -> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> DebugClosure ccs srt pap string s b
IndClosure StgInfoTableWithPtr
a1 (Maybe (ProfHeader b) -> n -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b)) -> f (n -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (n -> DebugClosure b d g i k n)
-> f n -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b
      BCOClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph l
b1 l
b2 l
b3 HalfWord
a2 HalfWord
a3 [Word]
a4 ->
        (\Maybe (ProfHeader b)
ph2 n
c1 n
c2 n
c3 -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> n
-> n
-> n
-> HalfWord
-> HalfWord
-> [Word]
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> b
-> b
-> HalfWord
-> HalfWord
-> [Word]
-> DebugClosure ccs srt pap string s b
BCOClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader b)
ph2 n
c1 n
c2 n
c3 HalfWord
a2 HalfWord
a3 [Word]
a4) (Maybe (ProfHeader b) -> n -> n -> n -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f (n -> n -> n -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (n -> n -> n -> DebugClosure b d g i k n)
-> f n -> f (n -> n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b1 f (n -> n -> DebugClosure b d g i k n)
-> f n -> f (n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b2 f (n -> DebugClosure b d g i k n)
-> f n -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b3
      BlackholeClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph l
b -> StgInfoTableWithPtr
-> Maybe (ProfHeader b) -> n -> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> DebugClosure ccs srt pap string s b
BlackholeClosure StgInfoTableWithPtr
a1 (Maybe (ProfHeader b) -> n -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b)) -> f (n -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (n -> DebugClosure b d g i k n)
-> f n -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b
      ArrWordsClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph Word
a2 [Word]
a3 -> (\Maybe (ProfHeader b)
ph2 -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> Word
-> [Word]
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> Word
-> [Word]
-> DebugClosure ccs srt pap string s b
ArrWordsClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader b)
ph2 Word
a2 [Word]
a3) (Maybe (ProfHeader b) -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b)) -> f (DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph
      MutArrClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph Word
a2 Word
a3 [l]
bs -> (\Maybe (ProfHeader b)
ph2 -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> Word
-> Word
-> [n]
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> Word
-> Word
-> [b]
-> DebugClosure ccs srt pap string s b
MutArrClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader b)
ph2 Word
a2 Word
a3) (Maybe (ProfHeader b) -> [n] -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b)) -> f ([n] -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f ([n] -> DebugClosure b d g i k n)
-> f [n] -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (l -> f n) -> [l] -> f [n]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse l -> f n
g [l]
bs
      SmallMutArrClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph Word
a2 [l]
bs -> (\Maybe (ProfHeader b)
ph2 -> StgInfoTableWithPtr
-> Maybe (ProfHeader b) -> Word -> [n] -> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> Word
-> [b]
-> DebugClosure ccs srt pap string s b
SmallMutArrClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader b)
ph2 Word
a2) (Maybe (ProfHeader b) -> [n] -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b)) -> f ([n] -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f ([n] -> DebugClosure b d g i k n)
-> f [n] -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (l -> f n) -> [l] -> f [n]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse l -> f n
g [l]
bs
      MVarClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph l
b1 l
b2 l
b3     -> StgInfoTableWithPtr
-> Maybe (ProfHeader b) -> n -> n -> n -> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> b
-> b
-> DebugClosure ccs srt pap string s b
MVarClosure StgInfoTableWithPtr
a1 (Maybe (ProfHeader b) -> n -> n -> n -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f (n -> n -> n -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (n -> n -> n -> DebugClosure b d g i k n)
-> f n -> f (n -> n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b1 f (n -> n -> DebugClosure b d g i k n)
-> f n -> f (n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b2 f (n -> DebugClosure b d g i k n)
-> f n -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b3
      MutVarClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph l
b -> StgInfoTableWithPtr
-> Maybe (ProfHeader b) -> n -> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> DebugClosure ccs srt pap string s b
MutVarClosure StgInfoTableWithPtr
a1 (Maybe (ProfHeader b) -> n -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b)) -> f (n -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (n -> DebugClosure b d g i k n)
-> f n -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b
      BlockingQueueClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph l
b1 l
b2 l
b3 l
b4 ->
        StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> n
-> n
-> n
-> n
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> b
-> b
-> b
-> DebugClosure ccs srt pap string s b
BlockingQueueClosure StgInfoTableWithPtr
a1 (Maybe (ProfHeader b)
 -> n -> n -> n -> n -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f (n -> n -> n -> n -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (n -> n -> n -> n -> DebugClosure b d g i k n)
-> f n -> f (n -> n -> n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b1 f (n -> n -> n -> DebugClosure b d g i k n)
-> f n -> f (n -> n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b2 f (n -> n -> DebugClosure b d g i k n)
-> f n -> f (n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b3 f (n -> DebugClosure b d g i k n)
-> f n -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b4
      TSOClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph l
b1 l
b2 l
b3 l
b4 l
b5 l
b6 Maybe l
b7 WhatNext
a2 WhyBlocked
a3 [TsoFlags]
a4 Word64
a5 HalfWord
a6 HalfWord
a7 Int64
a8 HalfWord
a9 Maybe StgTSOProfInfo
a10 ->
        (\Maybe (ProfHeader b)
ph2 n
c1 n
c2 n
c3 n
c4 n
c5 n
c6 Maybe n
c7 -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> n
-> n
-> n
-> n
-> n
-> n
-> Maybe n
-> WhatNext
-> WhyBlocked
-> [TsoFlags]
-> Word64
-> HalfWord
-> HalfWord
-> Int64
-> HalfWord
-> Maybe StgTSOProfInfo
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> b
-> b
-> b
-> b
-> b
-> Maybe b
-> WhatNext
-> WhyBlocked
-> [TsoFlags]
-> Word64
-> HalfWord
-> HalfWord
-> Int64
-> HalfWord
-> Maybe StgTSOProfInfo
-> DebugClosure ccs srt pap string s b
TSOClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader b)
ph2 n
c1 n
c2 n
c3 n
c4 n
c5 n
c6 Maybe n
c7 WhatNext
a2 WhyBlocked
a3 [TsoFlags]
a4 Word64
a5 HalfWord
a6 HalfWord
a7 Int64
a8 HalfWord
a9 Maybe StgTSOProfInfo
a10) (Maybe (ProfHeader b)
 -> n
 -> n
 -> n
 -> n
 -> n
 -> n
 -> Maybe n
 -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f (n
      -> n -> n -> n -> n -> n -> Maybe n -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (n
   -> n -> n -> n -> n -> n -> Maybe n -> DebugClosure b d g i k n)
-> f n
-> f (n -> n -> n -> n -> n -> Maybe n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b1 f (n -> n -> n -> n -> n -> Maybe n -> DebugClosure b d g i k n)
-> f n
-> f (n -> n -> n -> n -> Maybe n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b2 f (n -> n -> n -> n -> Maybe n -> DebugClosure b d g i k n)
-> f n -> f (n -> n -> n -> Maybe n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b3 f (n -> n -> n -> Maybe n -> DebugClosure b d g i k n)
-> f n -> f (n -> n -> Maybe n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b4 f (n -> n -> Maybe n -> DebugClosure b d g i k n)
-> f n -> f (n -> Maybe n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b5 f (n -> Maybe n -> DebugClosure b d g i k n)
-> f n -> f (Maybe n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
b6 f (Maybe n -> DebugClosure b d g i k n)
-> f (Maybe n) -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (l -> f n) -> Maybe l -> f (Maybe n)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse l -> f n
g Maybe l
b7
      StackClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph HalfWord
a2 Word8
a3 Word8
a4 j
a5 -> (\Maybe (ProfHeader b)
ph2 -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> HalfWord
-> Word8
-> Word8
-> k
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> HalfWord
-> Word8
-> Word8
-> s
-> DebugClosure ccs srt pap string s b
StackClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader b)
ph2 HalfWord
a2 Word8
a3 Word8
a4) (Maybe (ProfHeader b) -> k -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b)) -> f (k -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (k -> DebugClosure b d g i k n)
-> f k -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> j -> f k
f j
a5
      WeakClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph l
a2 l
a3 l
a4 l
a5 Maybe l
a6 ->
        StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> n
-> n
-> n
-> n
-> Maybe n
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> b
-> b
-> b
-> Maybe b
-> DebugClosure ccs srt pap string s b
WeakClosure StgInfoTableWithPtr
a1 (Maybe (ProfHeader b)
 -> n -> n -> n -> n -> Maybe n -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f (n -> n -> n -> n -> Maybe n -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (n -> n -> n -> n -> Maybe n -> DebugClosure b d g i k n)
-> f n -> f (n -> n -> n -> Maybe n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
a2 f (n -> n -> n -> Maybe n -> DebugClosure b d g i k n)
-> f n -> f (n -> n -> Maybe n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
a3 f (n -> n -> Maybe n -> DebugClosure b d g i k n)
-> f n -> f (n -> Maybe n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
a4 f (n -> Maybe n -> DebugClosure b d g i k n)
-> f n -> f (Maybe n -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
a5 f (Maybe n -> DebugClosure b d g i k n)
-> f (Maybe n) -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (l -> f n) -> Maybe l -> f (Maybe n)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse l -> f n
g Maybe l
a6
      TVarClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph l
a2 l
a3 Int
a4 ->
        StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> n
-> n
-> Int
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> b
-> Int
-> DebugClosure ccs srt pap string s b
TVarClosure StgInfoTableWithPtr
a1 (Maybe (ProfHeader b) -> n -> n -> Int -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f (n -> n -> Int -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (n -> n -> Int -> DebugClosure b d g i k n)
-> f n -> f (n -> Int -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
a2 f (n -> Int -> DebugClosure b d g i k n)
-> f n -> f (Int -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
a3 f (Int -> DebugClosure b d g i k n)
-> f Int -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f Int
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
a4
      TRecChunkClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph l
a2 Word
a3 [TRecEntry l]
a4 -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> n
-> Word
-> [TRecEntry n]
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> Word
-> [TRecEntry b]
-> DebugClosure ccs srt pap string s b
TRecChunkClosure StgInfoTableWithPtr
a1 (Maybe (ProfHeader b)
 -> n -> Word -> [TRecEntry n] -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f (n -> Word -> [TRecEntry n] -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f (n -> Word -> [TRecEntry n] -> DebugClosure b d g i k n)
-> f n -> f (Word -> [TRecEntry n] -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> l -> f n
g l
a2 f (Word -> [TRecEntry n] -> DebugClosure b d g i k n)
-> f Word -> f ([TRecEntry n] -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Word -> f Word
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word
a3 f ([TRecEntry n] -> DebugClosure b d g i k n)
-> f [TRecEntry n] -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TRecEntry l -> f (TRecEntry n))
-> [TRecEntry l] -> f [TRecEntry n]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((l -> f n) -> TRecEntry l -> f (TRecEntry n)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TRecEntry a -> f (TRecEntry b)
traverse l -> f n
g) [TRecEntry l]
a4
      MutPrimClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph [l]
a2 [Word]
a3 -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> [n]
-> [Word]
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> [b]
-> [Word]
-> DebugClosure ccs srt pap string s b
MutPrimClosure StgInfoTableWithPtr
a1 (Maybe (ProfHeader b) -> [n] -> [Word] -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f ([n] -> [Word] -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f ([n] -> [Word] -> DebugClosure b d g i k n)
-> f [n] -> f ([Word] -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (l -> f n) -> [l] -> f [n]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse l -> f n
g [l]
a2 f ([Word] -> DebugClosure b d g i k n)
-> f [Word] -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Word] -> f [Word]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Word]
a3
      PrimClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph [l]
a2 [Word]
a3 -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> [n]
-> [Word]
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> [b]
-> [Word]
-> DebugClosure ccs srt pap string s b
PrimClosure StgInfoTableWithPtr
a1 (Maybe (ProfHeader b) -> [n] -> [Word] -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f ([n] -> [Word] -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f ([n] -> [Word] -> DebugClosure b d g i k n)
-> f [n] -> f ([Word] -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (l -> f n) -> [l] -> f [n]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse l -> f n
g [l]
a2 f ([Word] -> DebugClosure b d g i k n)
-> f [Word] -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Word] -> f [Word]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Word]
a3
      OtherClosure StgInfoTableWithPtr
a1 Maybe (ProfHeader a)
ph [l]
bs [Word]
ws -> StgInfoTableWithPtr
-> Maybe (ProfHeader b)
-> [n]
-> [Word]
-> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> [b]
-> [Word]
-> DebugClosure ccs srt pap string s b
OtherClosure StgInfoTableWithPtr
a1 (Maybe (ProfHeader b) -> [n] -> [Word] -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b))
-> f ([n] -> [Word] -> DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph f ([n] -> [Word] -> DebugClosure b d g i k n)
-> f [n] -> f ([Word] -> DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (l -> f n) -> [l] -> f [n]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse l -> f n
g [l]
bs f ([Word] -> DebugClosure b d g i k n)
-> f [Word] -> f (DebugClosure b d g i k n)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Word] -> f [Word]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Word]
ws
      UnsupportedClosure StgInfoTableWithPtr
i Maybe (ProfHeader a)
ph -> StgInfoTableWithPtr
-> Maybe (ProfHeader b) -> DebugClosure b d g i k n
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs) -> DebugClosure ccs srt pap string s b
UnsupportedClosure StgInfoTableWithPtr
i (Maybe (ProfHeader b) -> DebugClosure b d g i k n)
-> f (Maybe (ProfHeader b)) -> f (DebugClosure b d g i k n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ProfHeader a -> f (ProfHeader b))
-> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ProfHeader a -> f (ProfHeader b))
 -> Maybe (ProfHeader a) -> f (Maybe (ProfHeader b)))
-> ((a -> f b) -> ProfHeader a -> f (ProfHeader b))
-> (a -> f b)
-> Maybe (ProfHeader a)
-> f (Maybe (ProfHeader b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> ProfHeader a -> f (ProfHeader b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProfHeader a -> f (ProfHeader b)
traverse) a -> f b
fccs Maybe (ProfHeader a)
ph