{-# 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(..)
    , GHC.ClosureType(..)
    , 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

    -- * Traversing functions
    , Quintraversable(..)
    , quinmap
    ) where

import Prelude -- See note [Why do we import Prelude here?]
-- TODO: Support profiling
--import qualified GHC.Exts.Heap.InfoTableProf as ItblProf
import GHC.Exts.Heap.InfoTable
import qualified GHC.Exts.Heap as GHC
import GHC.Exts.Heap.ProfInfo.Types as ProfTypes


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


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


type Closure = DebugClosure SrtCont PayloadCont ConstrDescCont StackCont ClosurePtr
type SizedClosure = DebugClosureWithSize SrtCont PayloadCont ConstrDescCont StackCont ClosurePtr
type SizedClosureC = DebugClosureWithSize SrtCont PayloadCont ConstrDesc StackCont ClosurePtr
type SizedClosureP = DebugClosureWithSize 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PayloadCont] -> ShowS
$cshowList :: [PayloadCont] -> ShowS
show :: PayloadCont -> String
$cshow :: PayloadCont -> String
showsPrec :: Int -> PayloadCont -> ShowS
$cshowsPrec :: Int -> PayloadCont -> ShowS
Show, PayloadCont -> PayloadCont -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PayloadCont -> PayloadCont -> Bool
$c/= :: PayloadCont -> PayloadCont -> Bool
== :: PayloadCont -> PayloadCont -> Bool
$c== :: PayloadCont -> PayloadCont -> Bool
Eq)

type DebugClosureWithSize = DebugClosureWithExtra Size

data DebugClosureWithExtra x srt pap string s b = DCS { forall x srt pap string s b.
DebugClosureWithExtra x srt pap string s b -> x
extraDCS :: x
                                              , forall x srt pap string s b.
DebugClosureWithExtra x srt pap string s b
-> DebugClosure srt pap string s b
unDCS :: DebugClosure srt pap string s b }
    deriving (Int -> DebugClosureWithExtra x srt pap string s b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x srt pap string s b.
(Show x, Show b, Show string, Show srt, Show pap, Show s) =>
Int -> DebugClosureWithExtra x srt pap string s b -> ShowS
forall x srt pap string s b.
(Show x, Show b, Show string, Show srt, Show pap, Show s) =>
[DebugClosureWithExtra x srt pap string s b] -> ShowS
forall x srt pap string s b.
(Show x, Show b, Show string, Show srt, Show pap, Show s) =>
DebugClosureWithExtra x srt pap string s b -> String
showList :: [DebugClosureWithExtra x srt pap string s b] -> ShowS
$cshowList :: forall x srt pap string s b.
(Show x, Show b, Show string, Show srt, Show pap, Show s) =>
[DebugClosureWithExtra x srt pap string s b] -> ShowS
show :: DebugClosureWithExtra x srt pap string s b -> String
$cshow :: forall x srt pap string s b.
(Show x, Show b, Show string, Show srt, Show pap, Show s) =>
DebugClosureWithExtra x srt pap string s b -> String
showsPrec :: Int -> DebugClosureWithExtra x srt pap string s b -> ShowS
$cshowsPrec :: forall x srt pap string s b.
(Show x, Show b, Show string, Show srt, Show pap, Show s) =>
Int -> DebugClosureWithExtra x srt pap string s b -> ShowS
Show, DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Ordering
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} {srt} {pap} {string} {s} {b}.
(Ord x, Ord b, Ord string, Ord srt, Ord pap, Ord s) =>
Eq (DebugClosureWithExtra x srt pap string s b)
forall x srt pap string s b.
(Ord x, Ord b, Ord string, Ord srt, Ord pap, Ord s) =>
DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
forall x srt pap string s b.
(Ord x, Ord b, Ord string, Ord srt, Ord pap, Ord s) =>
DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Ordering
forall x srt pap string s b.
(Ord x, Ord b, Ord string, Ord srt, Ord pap, Ord s) =>
DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b
min :: DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b
$cmin :: forall x srt pap string s b.
(Ord x, Ord b, Ord string, Ord srt, Ord pap, Ord s) =>
DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b
max :: DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b
$cmax :: forall x srt pap string s b.
(Ord x, Ord b, Ord string, Ord srt, Ord pap, Ord s) =>
DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b
>= :: DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
$c>= :: forall x srt pap string s b.
(Ord x, Ord b, Ord string, Ord srt, Ord pap, Ord s) =>
DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
> :: DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
$c> :: forall x srt pap string s b.
(Ord x, Ord b, Ord string, Ord srt, Ord pap, Ord s) =>
DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
<= :: DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
$c<= :: forall x srt pap string s b.
(Ord x, Ord b, Ord string, Ord srt, Ord pap, Ord s) =>
DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
< :: DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
$c< :: forall x srt pap string s b.
(Ord x, Ord b, Ord string, Ord srt, Ord pap, Ord s) =>
DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
compare :: DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Ordering
$ccompare :: forall x srt pap string s b.
(Ord x, Ord b, Ord string, Ord srt, Ord pap, Ord s) =>
DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Ordering
Ord, DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x srt pap string s b.
(Eq x, Eq b, Eq string, Eq srt, Eq pap, Eq s) =>
DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
/= :: DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
$c/= :: forall x srt pap string s b.
(Eq x, Eq b, Eq string, Eq srt, Eq pap, Eq s) =>
DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
== :: DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x srt pap string s b -> Bool
$c== :: forall x srt pap string s b.
(Eq x, Eq b, Eq string, Eq srt, Eq pap, Eq s) =>
DebugClosureWithExtra x srt pap string s b
-> DebugClosureWithExtra x 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Size] -> ShowS
$cshowList :: [Size] -> ShowS
show :: Size -> String
$cshow :: Size -> String
showsPrec :: Int -> Size -> ShowS
$cshowsPrec :: Int -> Size -> ShowS
Show, 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
$cto :: forall x. Rep Size x -> Size
$cfrom :: forall x. Size -> Rep Size x
Generic)
  deriving (NonEmpty Size -> Size
Size -> Size -> 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
stimes :: forall b. Integral b => b -> Size -> Size
$cstimes :: forall b. Integral b => b -> Size -> Size
sconcat :: NonEmpty Size -> Size
$csconcat :: NonEmpty Size -> Size
<> :: Size -> Size -> Size
$c<> :: Size -> Size -> Size
Semigroup, Semigroup Size
Size
[Size] -> Size
Size -> Size -> Size
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Size] -> Size
$cmconcat :: [Size] -> Size
mappend :: Size -> Size -> Size
$cmappend :: Size -> Size -> Size
mempty :: Size
$cmempty :: Size
Monoid) via (Sum Int)
  deriving newtype (Integer -> Size
Size -> Size
Size -> Size -> Size
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Size
$cfromInteger :: Integer -> Size
signum :: Size -> Size
$csignum :: Size -> Size
abs :: Size -> Size
$cabs :: Size -> Size
negate :: Size -> Size
$cnegate :: Size -> Size
* :: Size -> Size -> Size
$c* :: Size -> Size -> Size
- :: Size -> Size -> Size
$c- :: Size -> Size -> Size
+ :: Size -> Size -> Size
$c+ :: Size -> Size -> Size
Num, Eq 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
min :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmax :: Size -> Size -> Size
>= :: Size -> Size -> Bool
$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
compare :: Size -> Size -> Ordering
$ccompare :: Size -> Size -> Ordering
Ord, Size -> Size -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c== :: Size -> Size -> Bool
Eq)

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

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


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

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

instance Quintraversable (DebugClosureWithExtra x) where
  quintraverse :: forall (f :: * -> *) a b c d e g h i j k.
Applicative f =>
(a -> f b)
-> (c -> f d)
-> (e -> f g)
-> (h -> f i)
-> (j -> f k)
-> DebugClosureWithExtra x a c e h j
-> f (DebugClosureWithExtra x b d g i k)
quintraverse a -> f b
f c -> f d
g e -> f g
h h -> f i
i j -> f k
j (DCS x
x DebugClosure a c e h j
v) = forall x srt pap string s b.
x
-> DebugClosure srt pap string s b
-> DebugClosureWithExtra x srt pap string s b
DCS x
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> * -> * -> * -> * -> *) (f :: * -> *) a b c d e g
       h i j k.
(Quintraversable m, Applicative f) =>
(a -> f b)
-> (c -> f d)
-> (e -> f g)
-> (h -> f i)
-> (j -> f k)
-> m a c e h j
-> f (m b d g i k)
quintraverse a -> f b
f c -> f d
g e -> f g
h h -> f i
i j -> f k
j DebugClosure a c e h j
v

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

instance Ord StgInfoTableWithPtr where
  compare :: StgInfoTableWithPtr -> StgInfoTableWithPtr -> Ordering
compare StgInfoTableWithPtr
t1 StgInfoTableWithPtr
t2 = 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 forall a. Eq a => a -> a -> Bool
== StgInfoTableWithPtr -> InfoTablePtr
tableId StgInfoTableWithPtr
t2


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

    -- | A function
  | FunClosure
        { info       :: !StgInfoTableWithPtr
        , forall srt pap string s b. DebugClosure 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
        , srt        :: !(srt)
        , ptrArgs    :: ![b]            -- ^ Pointer arguments
        , dataArgs   :: ![Word]         -- ^ Non-pointer arguments
        }

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

    -- | An unsaturated function application
  | PAPClosure
        { info       :: !StgInfoTableWithPtr
        , forall srt pap string s b.
DebugClosure srt pap string s b -> HalfWord
arity      :: !HalfWord       -- ^ Arity of the partial application
        , forall srt pap string s b.
DebugClosure srt pap string s b -> HalfWord
n_args     :: !HalfWord       -- ^ Size of the payload in words
        , forall srt pap string s b. DebugClosure srt pap string s b -> b
fun        :: !b              -- ^ Pointer to a 'FunClosure'
        , forall srt pap string s b. DebugClosure 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
        , arity      :: !HalfWord       -- ^ Always 0
        , n_args     :: !HalfWord       -- ^ Size of payload in words
        , fun        :: !b              -- ^ Pointer to a 'FunClosure'
        , forall srt pap string s b. DebugClosure srt pap string s b -> pap
ap_payload    :: !pap            -- ^ Sequence of already applied
                                        --   arguments
        }

    -- | A suspended thunk evaluation
  | APStackClosure
        { info       :: !StgInfoTableWithPtr
        , forall srt pap string s b. DebugClosure srt pap string s b -> Word
ap_st_size :: !Word
        , fun        :: !b              -- ^ Function closure
        , forall srt pap string s b. DebugClosure 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
        , forall srt pap string s b. DebugClosure 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
        , forall srt pap string s b. DebugClosure srt pap string s b -> b
instrs     :: !b              -- ^ A pointer to an ArrWords
                                        --   of instructions
        , forall srt pap string s b. DebugClosure srt pap string s b -> b
literals   :: !b              -- ^ A pointer to an ArrWords
                                        --   of literals
        , forall srt pap string s b. DebugClosure 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 srt pap string s b.
DebugClosure srt pap string s b -> HalfWord
size       :: !HalfWord       -- ^ The size of this BCO in words
        , forall srt pap string s b.
DebugClosure 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
        , indirectee :: !b              -- ^ The target closure
        }

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

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

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

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

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

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

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

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


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

  | TVarClosure
    { info :: !StgInfoTableWithPtr
    , forall srt pap string s b. DebugClosure srt pap string s b -> b
current_value :: !b
    , forall srt pap string s b. DebugClosure srt pap string s b -> b
tvar_watch_queue :: !b
    , forall srt pap string s b. DebugClosure srt pap string s b -> Int
num_updates :: !Int }

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

  | MutPrimClosure
    { info :: !StgInfoTableWithPtr
    , ptrArgs :: ![b]
    , dataArgs :: ![Word]
    }

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

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

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

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

type PapPayload = GenPapPayload ClosurePtr

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

type SrtPayload = GenSrtPayload ClosurePtr

type SrtCont = InfoTablePtr

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


-- Copied from ghc-heap
parseConstrDesc :: String -> ConstrDesc
parseConstrDesc :: String -> ConstrDesc
parseConstrDesc String
input =
    if Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Ord a => a -> a -> Bool
>Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t a -> Int
length 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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
':') String
input
    (String
m, String
occ)
        = (forall a. [a] -> [[a]] -> [a]
intercalate String
"." forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [String]
modWords, String
occWord)
        where
        ([String]
modWords, String
occWord) =
            if 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 [] (forall a. [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 forall a. (a -> Bool) -> [a] -> ([a], [a])
break (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 forall a. a -> [a] -> [a]
: [String]
acc) String
bot
    parseModOcc [String]
acc String
str = ([String]
acc, String
str)

class Quintraversable m where
  quintraverse ::
    Applicative f => (a -> f b)
                  -> (c -> f d)
                  -> (e -> f g)
                  -> (h -> f i)
                  -> (j -> f k)
                  -> m a c e h j
                  -> f (m b d g i k)

quinmap :: forall a b c d e f g h i j t . Quintraversable t => (a -> b) -> (c -> d) -> (e -> f) -> (g -> h) -> (i -> j) -> t a c e g i -> t b d f h j
quinmap :: forall a b c d e f g h i j (t :: * -> * -> * -> * -> * -> *).
Quintraversable t =>
(a -> b)
-> (c -> d)
-> (e -> f)
-> (g -> h)
-> (i -> j)
-> t a c e g i
-> t b d f h j
quinmap = coerce :: forall a b. Coercible a b => a -> b
coerce
  (forall (m :: * -> * -> * -> * -> * -> *) (f :: * -> *) a b c d e g
       h i j k.
(Quintraversable m, Applicative f) =>
(a -> f b)
-> (c -> f d)
-> (e -> f g)
-> (h -> f i)
-> (j -> f k)
-> m a c e h j
-> f (m b d g i k)
quintraverse :: (a -> Identity b)
              -> (c -> Identity d)
              -> (e -> Identity f)
              -> (g -> Identity h)
              -> (i -> Identity j)
              -> t a c e g i -> Identity (t b d f h j))

allClosures :: DebugClosure (GenSrtPayload c) (GenPapPayload c) a (GenStackFrames (GenSrtPayload c) c) c -> [c]
allClosures :: forall c a.
DebugClosure
  (GenSrtPayload c)
  (GenPapPayload c)
  a
  (GenStackFrames (GenSrtPayload c) c)
  c
-> [c]
allClosures DebugClosure
  (GenSrtPayload c)
  (GenPapPayload c)
  a
  (GenStackFrames (GenSrtPayload c) c)
  c
c = forall {k} a (b :: k). Const a b -> a
getConst forall a b. (a -> b) -> a -> b
$ forall (m :: * -> * -> * -> * -> * -> *) (f :: * -> *) a b c d e g
       h i j k.
(Quintraversable m, Applicative f) =>
(a -> f b)
-> (c -> f d)
-> (e -> f g)
-> (h -> f i)
-> (j -> f k)
-> m a c e h j
-> f (m b d g i k)
quintraverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]))) (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]))) (forall a b. a -> b -> a
const (forall {k} a (b :: k). a -> Const a b
Const [])) (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]))) (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])) DebugClosure
  (GenSrtPayload c)
  (GenPapPayload c)
  a
  (GenStackFrames (GenSrtPayload c) c)
  c
c

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


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