{-# 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
    , 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

    -- * Traversing functions
    , Quadtraversable(..)
    , quadmap
    ) 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 (sortBy, intercalate)
import Data.Char
import Data.Kind

import Control.Applicative
import Data.Monoid


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


type Closure = DebugClosure PayloadCont ConstrDescCont StackCont ClosurePtr
type SizedClosure = DebugClosureWithSize PayloadCont ConstrDescCont StackCont ClosurePtr
type SizedClosureC = DebugClosureWithSize PayloadCont ConstrDesc StackCont ClosurePtr

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

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

type DebugClosureWithSize = DebugClosureWithExtra Size

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

-- | Exclusive size
newtype Size = Size { Size -> Int
getSize :: Int }
  deriving stock (Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
(Int -> Size -> ShowS)
-> (Size -> String) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Size] -> ShowS
$cshowList :: [Size] -> ShowS
show :: Size -> String
$cshow :: Size -> String
showsPrec :: Int -> Size -> ShowS
$cshowsPrec :: Int -> Size -> ShowS
Show, (forall x. Size -> Rep Size x)
-> (forall x. Rep Size x -> Size) -> Generic Size
forall x. Rep Size x -> Size
forall x. Size -> Rep Size x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Size x -> Size
$cfrom :: forall x. Size -> Rep Size x
Generic)
  deriving (NonEmpty Size -> Size
Size -> Size -> Size
(Size -> Size -> Size)
-> (NonEmpty Size -> Size)
-> (forall b. Integral b => b -> Size -> Size)
-> Semigroup Size
forall b. Integral b => b -> Size -> Size
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
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
Semigroup Size
-> Size
-> (Size -> Size -> Size)
-> ([Size] -> Size)
-> Monoid Size
[Size] -> Size
Size -> Size -> Size
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
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
(Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size)
-> (Size -> Size)
-> (Size -> Size)
-> (Integer -> Size)
-> Num Size
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
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
Eq Size
-> (Size -> Size -> Ordering)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> Ord Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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
(Size -> Size -> Bool) -> (Size -> Size -> Bool) -> Eq Size
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
(Int -> InclusiveSize -> ShowS)
-> (InclusiveSize -> String)
-> ([InclusiveSize] -> ShowS)
-> Show InclusiveSize
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. InclusiveSize -> Rep InclusiveSize x)
-> (forall x. Rep InclusiveSize x -> InclusiveSize)
-> Generic InclusiveSize
forall x. Rep InclusiveSize x -> InclusiveSize
forall x. InclusiveSize -> Rep InclusiveSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InclusiveSize x -> InclusiveSize
$cfrom :: forall x. InclusiveSize -> Rep InclusiveSize x
Generic)
  deriving (NonEmpty InclusiveSize -> InclusiveSize
InclusiveSize -> InclusiveSize -> InclusiveSize
(InclusiveSize -> InclusiveSize -> InclusiveSize)
-> (NonEmpty InclusiveSize -> InclusiveSize)
-> (forall b. Integral b => b -> InclusiveSize -> InclusiveSize)
-> Semigroup InclusiveSize
forall b. Integral b => b -> InclusiveSize -> InclusiveSize
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
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
Semigroup InclusiveSize
-> InclusiveSize
-> (InclusiveSize -> InclusiveSize -> InclusiveSize)
-> ([InclusiveSize] -> InclusiveSize)
-> Monoid InclusiveSize
[InclusiveSize] -> InclusiveSize
InclusiveSize -> InclusiveSize -> InclusiveSize
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
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
(Int -> RetainerSize -> ShowS)
-> (RetainerSize -> String)
-> ([RetainerSize] -> ShowS)
-> Show RetainerSize
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. RetainerSize -> Rep RetainerSize x)
-> (forall x. Rep RetainerSize x -> RetainerSize)
-> Generic RetainerSize
forall x. Rep RetainerSize x -> RetainerSize
forall x. RetainerSize -> Rep RetainerSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RetainerSize x -> RetainerSize
$cfrom :: forall x. RetainerSize -> Rep RetainerSize x
Generic, Eq RetainerSize
Eq RetainerSize
-> (RetainerSize -> RetainerSize -> Ordering)
-> (RetainerSize -> RetainerSize -> Bool)
-> (RetainerSize -> RetainerSize -> Bool)
-> (RetainerSize -> RetainerSize -> Bool)
-> (RetainerSize -> RetainerSize -> Bool)
-> (RetainerSize -> RetainerSize -> RetainerSize)
-> (RetainerSize -> RetainerSize -> RetainerSize)
-> Ord RetainerSize
RetainerSize -> RetainerSize -> Bool
RetainerSize -> RetainerSize -> Ordering
RetainerSize -> RetainerSize -> RetainerSize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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
(RetainerSize -> RetainerSize -> Bool)
-> (RetainerSize -> RetainerSize -> Bool) -> Eq RetainerSize
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
(RetainerSize -> RetainerSize -> RetainerSize)
-> (NonEmpty RetainerSize -> RetainerSize)
-> (forall b. Integral b => b -> RetainerSize -> RetainerSize)
-> Semigroup RetainerSize
forall b. Integral b => b -> RetainerSize -> RetainerSize
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
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
Semigroup RetainerSize
-> RetainerSize
-> (RetainerSize -> RetainerSize -> RetainerSize)
-> ([RetainerSize] -> RetainerSize)
-> Monoid RetainerSize
[RetainerSize] -> RetainerSize
RetainerSize -> RetainerSize -> RetainerSize
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [RetainerSize] -> RetainerSize
$cmconcat :: [RetainerSize] -> RetainerSize
mappend :: RetainerSize -> RetainerSize -> RetainerSize
$cmappend :: RetainerSize -> RetainerSize -> RetainerSize
mempty :: RetainerSize
$cmempty :: RetainerSize
Monoid) via (Sum Int)


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

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

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

data StgInfoTableWithPtr = StgInfoTableWithPtr {
                              StgInfoTableWithPtr -> InfoTablePtr
tableId :: InfoTablePtr
                            , StgInfoTableWithPtr -> StgInfoTable
decodedTable :: StgInfoTable
                            } deriving (Int -> StgInfoTableWithPtr -> ShowS
[StgInfoTableWithPtr] -> ShowS
StgInfoTableWithPtr -> String
(Int -> StgInfoTableWithPtr -> ShowS)
-> (StgInfoTableWithPtr -> String)
-> ([StgInfoTableWithPtr] -> ShowS)
-> Show StgInfoTableWithPtr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
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 = InfoTablePtr -> InfoTablePtr -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (StgInfoTableWithPtr -> InfoTablePtr
tableId StgInfoTableWithPtr
t1) (StgInfoTableWithPtr -> InfoTablePtr
tableId StgInfoTableWithPtr
t2)

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


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

    -- | A function
  | FunClosure
        { info       :: !StgInfoTableWithPtr
        , ptrArgs    :: ![b]            -- ^ Pointer arguments
        , dataArgs   :: ![Word]         -- ^ Non-pointer arguments
        }

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

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

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

    -- | A suspended thunk evaluation
  | APStackClosure
        { info       :: !StgInfoTableWithPtr
        , forall pap string s b. DebugClosure pap string s b -> Word
ap_st_size :: !Word
        , fun        :: !b              -- ^ Function closure
        , forall pap string s b. DebugClosure 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 pap string s b. DebugClosure 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 pap string s b. DebugClosure pap string s b -> b
instrs     :: !b              -- ^ A pointer to an ArrWords
                                        --   of instructions
        , forall pap string s b. DebugClosure pap string s b -> b
literals   :: !b              -- ^ A pointer to an ArrWords
                                        --   of literals
        , forall pap string s b. DebugClosure pap string s b -> b
bcoptrs    :: !b              -- ^ A pointer to an ArrWords
                                        --   of byte code objects
        , arity      :: !HalfWord       -- ^ The arity of this BCO
        , forall pap string s b. DebugClosure pap string s b -> HalfWord
size       :: !HalfWord       -- ^ The size of this BCO in words
        , forall pap string s b. DebugClosure 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 pap string s b. DebugClosure pap string s b -> Word
bytes      :: !Word           -- ^ Size of array in bytes
        , forall pap string s b. DebugClosure pap string s b -> [Word]
arrWords   :: ![Word]         -- ^ Array payload
        }

    -- | A @MutableByteArray#@
  | MutArrClosure
        { info       :: !StgInfoTableWithPtr
        , forall pap string s b. DebugClosure pap string s b -> Word
mccPtrs    :: !Word           -- ^ Number of pointers
        , forall pap string s b. DebugClosure pap string s b -> Word
mccSize    :: !Word           -- ^ ?? Closures.h vs ClosureMacros.h
        , forall pap string s b. DebugClosure 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 pap string s b. DebugClosure pap string s b -> b
queueHead  :: !b              -- ^ Pointer to head of queue
        , forall pap string s b. DebugClosure pap string s b -> b
queueTail  :: !b              -- ^ Pointer to tail of queue
        , forall pap string s b. DebugClosure pap string s b -> b
value      :: !b              -- ^ Pointer to closure
        }

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

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

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

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


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

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

  | TRecChunkClosure
    { info :: !StgInfoTableWithPtr
    , forall pap string s b. DebugClosure pap string s b -> b
prev_chunk  :: !b
    , forall pap string s b. DebugClosure pap string s b -> Word
next_idx :: !Word
    , forall pap string s b. DebugClosure 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 pap string s b. DebugClosure pap string s b -> [b]
hvalues    :: ![b]
        , forall pap string s b. DebugClosure pap string s b -> [Word]
rawWords   :: ![Word]
        }

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

data TRecEntry b = TRecEntry { forall b. TRecEntry b -> b
tvar :: !b
                             , forall b. TRecEntry b -> b
expected_value :: !b
                             , forall b. TRecEntry b -> b
new_value :: !b
                             , forall b. TRecEntry b -> Int
trec_num_updates :: Int -- Only in THREADED, TODO: This is not an Int,
                                                       -- is it a pointer
                                                       -- to a haskell int
                             } deriving (Int -> TRecEntry b -> ShowS
[TRecEntry b] -> ShowS
TRecEntry b -> String
(Int -> TRecEntry b -> ShowS)
-> (TRecEntry b -> String)
-> ([TRecEntry b] -> ShowS)
-> Show (TRecEntry b)
forall b. Show b => Int -> TRecEntry b -> ShowS
forall b. Show b => [TRecEntry b] -> ShowS
forall b. Show b => TRecEntry b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
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 x. TRecEntry b -> Rep (TRecEntry b) x)
-> (forall x. Rep (TRecEntry b) x -> TRecEntry b)
-> Generic (TRecEntry b)
forall x. Rep (TRecEntry b) x -> TRecEntry b
forall x. TRecEntry b -> Rep (TRecEntry b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall b x. Rep (TRecEntry b) x -> TRecEntry b
forall b x. TRecEntry b -> Rep (TRecEntry b) x
$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 -> b) -> TRecEntry a -> TRecEntry b)
-> (forall a b. a -> TRecEntry b -> TRecEntry a)
-> Functor TRecEntry
forall a b. a -> TRecEntry b -> TRecEntry a
forall a b. (a -> b) -> TRecEntry a -> TRecEntry b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: 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 m. Monoid m => TRecEntry m -> m)
-> (forall m a. Monoid m => (a -> m) -> TRecEntry a -> m)
-> (forall m a. Monoid m => (a -> m) -> TRecEntry a -> m)
-> (forall a b. (a -> b -> b) -> b -> TRecEntry a -> b)
-> (forall a b. (a -> b -> b) -> b -> TRecEntry a -> b)
-> (forall b a. (b -> a -> b) -> b -> TRecEntry a -> b)
-> (forall b a. (b -> a -> b) -> b -> TRecEntry a -> b)
-> (forall a. (a -> a -> a) -> TRecEntry a -> a)
-> (forall a. (a -> a -> a) -> TRecEntry a -> a)
-> (forall a. TRecEntry a -> [a])
-> (forall a. TRecEntry a -> Bool)
-> (forall b. TRecEntry b -> Int)
-> (forall a. Eq a => a -> TRecEntry a -> Bool)
-> (forall a. Ord a => TRecEntry a -> a)
-> (forall a. Ord a => TRecEntry a -> a)
-> (forall a. Num a => TRecEntry a -> a)
-> (forall a. Num a => TRecEntry a -> a)
-> Foldable TRecEntry
forall a. Eq a => a -> TRecEntry a -> Bool
forall a. Num a => TRecEntry a -> a
forall a. Ord a => TRecEntry a -> a
forall m. Monoid m => TRecEntry m -> m
forall a. TRecEntry a -> Bool
forall b. TRecEntry b -> Int
forall a. TRecEntry a -> [a]
forall a. (a -> a -> a) -> TRecEntry a -> a
forall m a. Monoid m => (a -> m) -> TRecEntry a -> m
forall b a. (b -> a -> b) -> b -> TRecEntry a -> b
forall a b. (a -> b -> b) -> b -> TRecEntry a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
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
Functor TRecEntry
-> Foldable TRecEntry
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> TRecEntry a -> f (TRecEntry b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    TRecEntry (f a) -> f (TRecEntry a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> TRecEntry a -> m (TRecEntry b))
-> (forall (m :: * -> *) a.
    Monad m =>
    TRecEntry (m a) -> m (TRecEntry a))
-> Traversable TRecEntry
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
TRecEntry (m a) -> m (TRecEntry a)
forall (f :: * -> *) a.
Applicative f =>
TRecEntry (f a) -> f (TRecEntry a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TRecEntry a -> m (TRecEntry b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TRecEntry a -> f (TRecEntry b)
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, Eq (TRecEntry b)
Eq (TRecEntry b)
-> (TRecEntry b -> TRecEntry b -> Ordering)
-> (TRecEntry b -> TRecEntry b -> Bool)
-> (TRecEntry b -> TRecEntry b -> Bool)
-> (TRecEntry b -> TRecEntry b -> Bool)
-> (TRecEntry b -> TRecEntry b -> Bool)
-> (TRecEntry b -> TRecEntry b -> TRecEntry b)
-> (TRecEntry b -> TRecEntry b -> TRecEntry b)
-> Ord (TRecEntry b)
TRecEntry b -> TRecEntry b -> Bool
TRecEntry b -> TRecEntry b -> Ordering
TRecEntry b -> TRecEntry b -> TRecEntry b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {b}. Ord b => Eq (TRecEntry b)
forall b. Ord b => TRecEntry b -> TRecEntry b -> Bool
forall b. Ord b => TRecEntry b -> TRecEntry b -> Ordering
forall b. Ord b => TRecEntry b -> TRecEntry b -> TRecEntry b
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
(TRecEntry b -> TRecEntry b -> Bool)
-> (TRecEntry b -> TRecEntry b -> Bool) -> Eq (TRecEntry b)
forall b. Eq b => TRecEntry b -> TRecEntry b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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 -> b) -> GenPapPayload a -> GenPapPayload b)
-> (forall a b. a -> GenPapPayload b -> GenPapPayload a)
-> Functor GenPapPayload
forall a b. a -> GenPapPayload b -> GenPapPayload a
forall a b. (a -> b) -> GenPapPayload a -> GenPapPayload b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: 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 m. Monoid m => GenPapPayload m -> m)
-> (forall m a. Monoid m => (a -> m) -> GenPapPayload a -> m)
-> (forall m a. Monoid m => (a -> m) -> GenPapPayload a -> m)
-> (forall a b. (a -> b -> b) -> b -> GenPapPayload a -> b)
-> (forall a b. (a -> b -> b) -> b -> GenPapPayload a -> b)
-> (forall b a. (b -> a -> b) -> b -> GenPapPayload a -> b)
-> (forall b a. (b -> a -> b) -> b -> GenPapPayload a -> b)
-> (forall a. (a -> a -> a) -> GenPapPayload a -> a)
-> (forall a. (a -> a -> a) -> GenPapPayload a -> a)
-> (forall a. GenPapPayload a -> [a])
-> (forall a. GenPapPayload a -> Bool)
-> (forall a. GenPapPayload a -> Int)
-> (forall a. Eq a => a -> GenPapPayload a -> Bool)
-> (forall a. Ord a => GenPapPayload a -> a)
-> (forall a. Ord a => GenPapPayload a -> a)
-> (forall a. Num a => GenPapPayload a -> a)
-> (forall a. Num a => GenPapPayload a -> a)
-> Foldable GenPapPayload
forall a. Eq a => a -> GenPapPayload a -> Bool
forall a. Num a => GenPapPayload a -> a
forall a. Ord a => GenPapPayload a -> a
forall m. Monoid m => GenPapPayload m -> m
forall a. GenPapPayload a -> Bool
forall a. GenPapPayload a -> Int
forall a. GenPapPayload a -> [a]
forall a. (a -> a -> a) -> GenPapPayload a -> a
forall m a. Monoid m => (a -> m) -> GenPapPayload a -> m
forall b a. (b -> a -> b) -> b -> GenPapPayload a -> b
forall a b. (a -> b -> b) -> b -> GenPapPayload a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
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
Functor GenPapPayload
-> Foldable GenPapPayload
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> GenPapPayload a -> f (GenPapPayload b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GenPapPayload (f a) -> f (GenPapPayload a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GenPapPayload a -> m (GenPapPayload b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GenPapPayload (m a) -> m (GenPapPayload a))
-> Traversable GenPapPayload
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
GenPapPayload (m a) -> m (GenPapPayload a)
forall (f :: * -> *) a.
Applicative f =>
GenPapPayload (f a) -> f (GenPapPayload a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenPapPayload a -> m (GenPapPayload b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenPapPayload a -> f (GenPapPayload b)
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
[GenPapPayload b] -> ShowS
GenPapPayload b -> String
(Int -> GenPapPayload b -> ShowS)
-> (GenPapPayload b -> String)
-> ([GenPapPayload b] -> ShowS)
-> Show (GenPapPayload b)
forall b. Show b => Int -> GenPapPayload b -> ShowS
forall b. Show b => [GenPapPayload b] -> ShowS
forall b. Show b => GenPapPayload b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
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, Eq (GenPapPayload b)
Eq (GenPapPayload b)
-> (GenPapPayload b -> GenPapPayload b -> Ordering)
-> (GenPapPayload b -> GenPapPayload b -> Bool)
-> (GenPapPayload b -> GenPapPayload b -> Bool)
-> (GenPapPayload b -> GenPapPayload b -> Bool)
-> (GenPapPayload b -> GenPapPayload b -> Bool)
-> (GenPapPayload b -> GenPapPayload b -> GenPapPayload b)
-> (GenPapPayload b -> GenPapPayload b -> GenPapPayload b)
-> Ord (GenPapPayload b)
GenPapPayload b -> GenPapPayload b -> Bool
GenPapPayload b -> GenPapPayload b -> Ordering
GenPapPayload b -> GenPapPayload b -> GenPapPayload b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {b}. Ord b => Eq (GenPapPayload b)
forall b. Ord b => GenPapPayload b -> GenPapPayload b -> Bool
forall b. Ord b => GenPapPayload b -> GenPapPayload b -> Ordering
forall b.
Ord b =>
GenPapPayload b -> GenPapPayload b -> GenPapPayload b
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
(GenPapPayload b -> GenPapPayload b -> Bool)
-> (GenPapPayload b -> GenPapPayload b -> Bool)
-> Eq (GenPapPayload b)
forall b. Eq b => GenPapPayload b -> GenPapPayload b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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

-- | Information needed to decode a set of stack frames
data StackCont = StackCont StackPtr -- Address of start of frames
                           RawStack -- The raw frames
                           deriving Int -> StackCont -> ShowS
[StackCont] -> ShowS
StackCont -> String
(Int -> StackCont -> ShowS)
-> (StackCont -> String)
-> ([StackCont] -> ShowS)
-> Show StackCont
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackCont] -> ShowS
$cshowList :: [StackCont] -> ShowS
show :: StackCont -> String
$cshow :: StackCont -> String
showsPrec :: Int -> StackCont -> ShowS
$cshowsPrec :: Int -> StackCont -> ShowS
Show

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

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



data ConstrDesc = ConstrDesc {
          ConstrDesc -> String
pkg        :: !String         -- ^ Package name
        , ConstrDesc -> String
modl       :: !String         -- ^ Module name
        , ConstrDesc -> String
name       :: !String         -- ^ Constructor name
        } deriving (Int -> ConstrDesc -> ShowS
[ConstrDesc] -> ShowS
ConstrDesc -> String
(Int -> ConstrDesc -> ShowS)
-> (ConstrDesc -> String)
-> ([ConstrDesc] -> ShowS)
-> Show ConstrDesc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstrDesc] -> ShowS
$cshowList :: [ConstrDesc] -> ShowS
show :: ConstrDesc -> String
$cshow :: ConstrDesc -> String
showsPrec :: Int -> ConstrDesc -> ShowS
$cshowsPrec :: Int -> ConstrDesc -> ShowS
Show, ConstrDesc -> ConstrDesc -> Bool
(ConstrDesc -> ConstrDesc -> Bool)
-> (ConstrDesc -> ConstrDesc -> Bool) -> Eq ConstrDesc
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
Eq ConstrDesc
-> (ConstrDesc -> ConstrDesc -> Ordering)
-> (ConstrDesc -> ConstrDesc -> Bool)
-> (ConstrDesc -> ConstrDesc -> Bool)
-> (ConstrDesc -> ConstrDesc -> Bool)
-> (ConstrDesc -> ConstrDesc -> Bool)
-> (ConstrDesc -> ConstrDesc -> ConstrDesc)
-> (ConstrDesc -> ConstrDesc -> ConstrDesc)
-> Ord ConstrDesc
ConstrDesc -> ConstrDesc -> Bool
ConstrDesc -> ConstrDesc -> Ordering
ConstrDesc -> ConstrDesc -> ConstrDesc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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 (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) ([Int] -> Bool) -> ([String] -> [Int]) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int) -> [String] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ [String
p,String
m,String
occ]
                     then String -> String -> String -> ConstrDesc
ConstrDesc String
"" String
"" String
input
                     else String -> String -> String -> ConstrDesc
ConstrDesc String
p String
m String
occ
  where
    (String
p, String
rest1) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') String
input
    (String
m, String
occ)
        = (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse [String]
modWords, String
occWord)
        where
        ([String]
modWords, String
occWord) =
            if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest1 --  XXXXXXXXx YUKX
                --then error "getConDescAddress:parse:length rest1 < 1"
                then [String] -> String -> ([String], String)
parseModOcc [] []
                else [String] -> String -> ([String], String)
parseModOcc [] (ShowS
forall a. [a] -> [a]
tail String
rest1)
    -- We only look for dots if str could start with a module name,
    -- i.e. if it starts with an upper case character.
    -- Otherwise we might think that "X.:->" is the module name in
    -- "X.:->.+", whereas actually "X" is the module name and
    -- ":->.+" is a constructor name.
    parseModOcc :: [String] -> String -> ([String], String)
    parseModOcc :: [String] -> String -> ([String], String)
parseModOcc [String]
acc str :: String
str@(Char
c : String
_)
        | Char -> Bool
isUpper Char
c =
            case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') String
str of
                (String
top, []) -> ([String]
acc, String
top)
                (String
top, Char
_:String
bot) -> [String] -> String -> ([String], String)
parseModOcc (String
top String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc) String
bot
    parseModOcc [String]
acc String
str = ([String]
acc, String
str)

class Quadtraversable m where
  quadtraverse ::
    Applicative f => (a -> f b)
                  -> (c -> f d)
                  -> (e -> f g)
                  -> (h -> f i)
                  -> m a c e h
                  -> f (m b d g i)

quadmap :: forall a b c d e f g h t . Quadtraversable t => (a -> b) -> (c -> d) -> (e -> f) -> (g -> h) -> t a c e g -> t b d f h
quadmap :: forall a b c d e f g h (t :: * -> * -> * -> * -> *).
Quadtraversable t =>
(a -> b)
-> (c -> d) -> (e -> f) -> (g -> h) -> t a c e g -> t b d f h
quadmap = ((a -> Identity b)
 -> (c -> Identity d)
 -> (e -> Identity f)
 -> (g -> Identity h)
 -> t a c e g
 -> Identity (t b d f h))
-> (a -> b)
-> (c -> d)
-> (e -> f)
-> (g -> h)
-> t a c e g
-> t b d f h
coerce
  ((a -> Identity b)
-> (c -> Identity d)
-> (e -> Identity f)
-> (g -> Identity h)
-> t a c e g
-> Identity (t b d f h)
forall (m :: * -> * -> * -> * -> *) (f :: * -> *) a b c d e g h i.
(Quadtraversable m, Applicative f) =>
(a -> f b)
-> (c -> f d)
-> (e -> f g)
-> (h -> f i)
-> m a c e h
-> f (m b d g i)
quadtraverse :: (a -> Identity b)
              -> (c -> Identity d)
              -> (e -> Identity f)
              -> (g -> Identity h)
              -> t a c e g -> Identity (t b d f h))

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

data FieldValue b = SPtr b
                  | SNonPtr !Word64 deriving (Int -> FieldValue b -> ShowS
[FieldValue b] -> ShowS
FieldValue b -> String
(Int -> FieldValue b -> ShowS)
-> (FieldValue b -> String)
-> ([FieldValue b] -> ShowS)
-> Show (FieldValue b)
forall b. Show b => Int -> FieldValue b -> ShowS
forall b. Show b => [FieldValue b] -> ShowS
forall b. Show b => FieldValue b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
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
Functor FieldValue
-> Foldable FieldValue
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> FieldValue a -> f (FieldValue b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    FieldValue (f a) -> f (FieldValue a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> FieldValue a -> m (FieldValue b))
-> (forall (m :: * -> *) a.
    Monad m =>
    FieldValue (m a) -> m (FieldValue a))
-> Traversable FieldValue
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
FieldValue (m a) -> m (FieldValue a)
forall (f :: * -> *) a.
Applicative f =>
FieldValue (f a) -> f (FieldValue a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FieldValue a -> m (FieldValue b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FieldValue a -> f (FieldValue b)
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 -> b) -> FieldValue a -> FieldValue b)
-> (forall a b. a -> FieldValue b -> FieldValue a)
-> Functor FieldValue
forall a b. a -> FieldValue b -> FieldValue a
forall a b. (a -> b) -> FieldValue a -> FieldValue b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: 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 m. Monoid m => FieldValue m -> m)
-> (forall m a. Monoid m => (a -> m) -> FieldValue a -> m)
-> (forall m a. Monoid m => (a -> m) -> FieldValue a -> m)
-> (forall a b. (a -> b -> b) -> b -> FieldValue a -> b)
-> (forall a b. (a -> b -> b) -> b -> FieldValue a -> b)
-> (forall b a. (b -> a -> b) -> b -> FieldValue a -> b)
-> (forall b a. (b -> a -> b) -> b -> FieldValue a -> b)
-> (forall a. (a -> a -> a) -> FieldValue a -> a)
-> (forall a. (a -> a -> a) -> FieldValue a -> a)
-> (forall a. FieldValue a -> [a])
-> (forall a. FieldValue a -> Bool)
-> (forall a. FieldValue a -> Int)
-> (forall a. Eq a => a -> FieldValue a -> Bool)
-> (forall a. Ord a => FieldValue a -> a)
-> (forall a. Ord a => FieldValue a -> a)
-> (forall a. Num a => FieldValue a -> a)
-> (forall a. Num a => FieldValue a -> a)
-> Foldable FieldValue
forall a. Eq a => a -> FieldValue a -> Bool
forall a. Num a => FieldValue a -> a
forall a. Ord a => FieldValue a -> a
forall m. Monoid m => FieldValue m -> m
forall a. FieldValue a -> Bool
forall a. FieldValue a -> Int
forall a. FieldValue a -> [a]
forall a. (a -> a -> a) -> FieldValue a -> a
forall m a. Monoid m => (a -> m) -> FieldValue a -> m
forall b a. (b -> a -> b) -> b -> FieldValue a -> b
forall a b. (a -> b -> b) -> b -> FieldValue a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
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, Eq (FieldValue b)
Eq (FieldValue b)
-> (FieldValue b -> FieldValue b -> Ordering)
-> (FieldValue b -> FieldValue b -> Bool)
-> (FieldValue b -> FieldValue b -> Bool)
-> (FieldValue b -> FieldValue b -> Bool)
-> (FieldValue b -> FieldValue b -> Bool)
-> (FieldValue b -> FieldValue b -> FieldValue b)
-> (FieldValue b -> FieldValue b -> FieldValue b)
-> Ord (FieldValue b)
FieldValue b -> FieldValue b -> Bool
FieldValue b -> FieldValue b -> Ordering
FieldValue b -> FieldValue b -> FieldValue b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {b}. Ord b => Eq (FieldValue b)
forall b. Ord b => FieldValue b -> FieldValue b -> Bool
forall b. Ord b => FieldValue b -> FieldValue b -> Ordering
forall b. Ord b => FieldValue b -> FieldValue b -> FieldValue b
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
(FieldValue b -> FieldValue b -> Bool)
-> (FieldValue b -> FieldValue b -> Bool) -> Eq (FieldValue b)
forall b. Eq b => FieldValue b -> FieldValue b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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 Quadtraversable DebugClosure where
  quadtraverse :: forall (f :: * -> *) a b c d e g h i.
Applicative f =>
(a -> f b)
-> (c -> f d)
-> (e -> f g)
-> (h -> f i)
-> DebugClosure a c e h
-> f (DebugClosure b d g i)
quadtraverse a -> f b
p c -> f d
h e -> f g
f h -> f i
g DebugClosure a c e h
c =
    case DebugClosure a c e h
c of
      ConstrClosure StgInfoTableWithPtr
a1 [h]
bs [Word]
ds c
str ->
        (\[i]
cs d
cstr -> StgInfoTableWithPtr -> [i] -> [Word] -> d -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr
-> [b] -> [Word] -> string -> DebugClosure pap string s b
ConstrClosure StgInfoTableWithPtr
a1 [i]
cs [Word]
ds d
cstr) ([i] -> d -> DebugClosure b d g i)
-> f [i] -> f (d -> DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (h -> f i) -> [h] -> f [i]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse h -> f i
g [h]
bs f (d -> DebugClosure b d g i) -> f d -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> f d
h c
str
      FunClosure StgInfoTableWithPtr
a1 [h]
bs [Word]
ws -> (\[i]
cs -> StgInfoTableWithPtr -> [i] -> [Word] -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr -> [b] -> [Word] -> DebugClosure pap string s b
FunClosure StgInfoTableWithPtr
a1 [i]
cs [Word]
ws) ([i] -> DebugClosure b d g i) -> f [i] -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (h -> f i) -> [h] -> f [i]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse h -> f i
g [h]
bs
      ThunkClosure StgInfoTableWithPtr
a1 [h]
bs [Word]
ws -> (\[i]
cs -> StgInfoTableWithPtr -> [i] -> [Word] -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr -> [b] -> [Word] -> DebugClosure pap string s b
ThunkClosure StgInfoTableWithPtr
a1 [i]
cs [Word]
ws) ([i] -> DebugClosure b d g i) -> f [i] -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (h -> f i) -> [h] -> f [i]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse h -> f i
g [h]
bs
      SelectorClosure StgInfoTableWithPtr
a1 h
b  -> StgInfoTableWithPtr -> i -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr -> b -> DebugClosure pap string s b
SelectorClosure StgInfoTableWithPtr
a1 (i -> DebugClosure b d g i) -> f i -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f i
g h
b
      PAPClosure StgInfoTableWithPtr
a1 HalfWord
a2 HalfWord
a3 h
a4 a
a5 -> StgInfoTableWithPtr
-> HalfWord -> HalfWord -> i -> b -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr
-> HalfWord -> HalfWord -> b -> pap -> DebugClosure pap string s b
PAPClosure StgInfoTableWithPtr
a1 HalfWord
a2 HalfWord
a3 (i -> b -> DebugClosure b d g i)
-> f i -> f (b -> DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f i
g h
a4 f (b -> DebugClosure b d g i) -> f b -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
p a
a5
      APClosure StgInfoTableWithPtr
a1 HalfWord
a2 HalfWord
a3 h
a4 a
a5 -> StgInfoTableWithPtr
-> HalfWord -> HalfWord -> i -> b -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr
-> HalfWord -> HalfWord -> b -> pap -> DebugClosure pap string s b
APClosure StgInfoTableWithPtr
a1 HalfWord
a2 HalfWord
a3 (i -> b -> DebugClosure b d g i)
-> f i -> f (b -> DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f i
g h
a4 f (b -> DebugClosure b d g i) -> f b -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
p a
a5
      APStackClosure StgInfoTableWithPtr
a1 Word
s h
b e
bs   -> StgInfoTableWithPtr -> Word -> i -> g -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr
-> Word -> b -> s -> DebugClosure pap string s b
APStackClosure StgInfoTableWithPtr
a1 Word
s (i -> g -> DebugClosure b d g i)
-> f i -> f (g -> DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f i
g h
b f (g -> DebugClosure b d g i) -> f g -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> f g
f e
bs
      IndClosure StgInfoTableWithPtr
a1 h
b -> StgInfoTableWithPtr -> i -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr -> b -> DebugClosure pap string s b
IndClosure StgInfoTableWithPtr
a1 (i -> DebugClosure b d g i) -> f i -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f i
g h
b
      BCOClosure StgInfoTableWithPtr
a1 h
b1 h
b2 h
b3 HalfWord
a2 HalfWord
a3 [Word]
a4 ->
        (\i
c1 i
c2 i
c3 -> StgInfoTableWithPtr
-> i
-> i
-> i
-> HalfWord
-> HalfWord
-> [Word]
-> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr
-> b
-> b
-> b
-> HalfWord
-> HalfWord
-> [Word]
-> DebugClosure pap string s b
BCOClosure StgInfoTableWithPtr
a1 i
c1 i
c2 i
c3 HalfWord
a2 HalfWord
a3 [Word]
a4) (i -> i -> i -> DebugClosure b d g i)
-> f i -> f (i -> i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f i
g h
b1 f (i -> i -> DebugClosure b d g i)
-> f i -> f (i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
b2 f (i -> DebugClosure b d g i) -> f i -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
b3
      BlackholeClosure StgInfoTableWithPtr
a1 h
b -> StgInfoTableWithPtr -> i -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr -> b -> DebugClosure pap string s b
BlackholeClosure StgInfoTableWithPtr
a1 (i -> DebugClosure b d g i) -> f i -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f i
g h
b
      ArrWordsClosure StgInfoTableWithPtr
a1 Word
a2 [Word]
a3 -> DebugClosure b d g i -> f (DebugClosure b d g i)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StgInfoTableWithPtr -> Word -> [Word] -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr
-> Word -> [Word] -> DebugClosure pap string s b
ArrWordsClosure StgInfoTableWithPtr
a1 Word
a2 [Word]
a3)
      MutArrClosure StgInfoTableWithPtr
a1 Word
a2 Word
a3 [h]
bs -> StgInfoTableWithPtr -> Word -> Word -> [i] -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr
-> Word -> Word -> [b] -> DebugClosure pap string s b
MutArrClosure StgInfoTableWithPtr
a1 Word
a2 Word
a3 ([i] -> DebugClosure b d g i) -> f [i] -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (h -> f i) -> [h] -> f [i]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse h -> f i
g [h]
bs
      SmallMutArrClosure StgInfoTableWithPtr
a1 Word
a2 [h]
bs -> StgInfoTableWithPtr -> Word -> [i] -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr -> Word -> [b] -> DebugClosure pap string s b
SmallMutArrClosure StgInfoTableWithPtr
a1 Word
a2 ([i] -> DebugClosure b d g i) -> f [i] -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (h -> f i) -> [h] -> f [i]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse h -> f i
g [h]
bs
      MVarClosure StgInfoTableWithPtr
a1 h
b1 h
b2 h
b3     -> StgInfoTableWithPtr -> i -> i -> i -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr -> b -> b -> b -> DebugClosure pap string s b
MVarClosure StgInfoTableWithPtr
a1 (i -> i -> i -> DebugClosure b d g i)
-> f i -> f (i -> i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f i
g h
b1 f (i -> i -> DebugClosure b d g i)
-> f i -> f (i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
b2 f (i -> DebugClosure b d g i) -> f i -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
b3
      MutVarClosure StgInfoTableWithPtr
a1 h
b -> StgInfoTableWithPtr -> i -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr -> b -> DebugClosure pap string s b
MutVarClosure StgInfoTableWithPtr
a1 (i -> DebugClosure b d g i) -> f i -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f i
g h
b
      BlockingQueueClosure StgInfoTableWithPtr
a1 h
b1 h
b2 h
b3 h
b4 ->
        StgInfoTableWithPtr -> i -> i -> i -> i -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr
-> b -> b -> b -> b -> DebugClosure pap string s b
BlockingQueueClosure StgInfoTableWithPtr
a1 (i -> i -> i -> i -> DebugClosure b d g i)
-> f i -> f (i -> i -> i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f i
g h
b1 f (i -> i -> i -> DebugClosure b d g i)
-> f i -> f (i -> i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
b2 f (i -> i -> DebugClosure b d g i)
-> f i -> f (i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
b3 f (i -> DebugClosure b d g i) -> f i -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
b4
      TSOClosure StgInfoTableWithPtr
a1 h
b1 h
b2 h
b3 h
b4 h
b5 h
b6 WhatNext
a2 WhyBlocked
a3 [TsoFlags]
a4 Word64
a5 HalfWord
a6 HalfWord
a7 Int64
a8 HalfWord
a9 Maybe StgTSOProfInfo
a10 ->
        (\i
c1 i
c2 i
c3 i
c4 i
c5 i
c6 -> StgInfoTableWithPtr
-> i
-> i
-> i
-> i
-> i
-> i
-> WhatNext
-> WhyBlocked
-> [TsoFlags]
-> Word64
-> HalfWord
-> HalfWord
-> Int64
-> HalfWord
-> Maybe StgTSOProfInfo
-> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr
-> b
-> b
-> b
-> b
-> b
-> b
-> WhatNext
-> WhyBlocked
-> [TsoFlags]
-> Word64
-> HalfWord
-> HalfWord
-> Int64
-> HalfWord
-> Maybe StgTSOProfInfo
-> DebugClosure pap string s b
TSOClosure StgInfoTableWithPtr
a1 i
c1 i
c2 i
c3 i
c4 i
c5 i
c6 WhatNext
a2 WhyBlocked
a3 [TsoFlags]
a4 Word64
a5 HalfWord
a6 HalfWord
a7 Int64
a8 HalfWord
a9 Maybe StgTSOProfInfo
a10) (i -> i -> i -> i -> i -> i -> DebugClosure b d g i)
-> f i -> f (i -> i -> i -> i -> i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f i
g h
b1 f (i -> i -> i -> i -> i -> DebugClosure b d g i)
-> f i -> f (i -> i -> i -> i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
b2 f (i -> i -> i -> i -> DebugClosure b d g i)
-> f i -> f (i -> i -> i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
b3 f (i -> i -> i -> DebugClosure b d g i)
-> f i -> f (i -> i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
b4 f (i -> i -> DebugClosure b d g i)
-> f i -> f (i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
b5 f (i -> DebugClosure b d g i) -> f i -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
b6
      StackClosure StgInfoTableWithPtr
a1 HalfWord
a2 Word8
a3 Word8
a4 e
a5 -> StgInfoTableWithPtr
-> HalfWord -> Word8 -> Word8 -> g -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr
-> HalfWord -> Word8 -> Word8 -> s -> DebugClosure pap string s b
StackClosure StgInfoTableWithPtr
a1 HalfWord
a2 Word8
a3 Word8
a4 (g -> DebugClosure b d g i) -> f g -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> f g
f e
a5
      WeakClosure StgInfoTableWithPtr
a1 h
a2 h
a3 h
a4 h
a5 Maybe h
a6 ->
        StgInfoTableWithPtr
-> i -> i -> i -> i -> Maybe i -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr
-> b -> b -> b -> b -> Maybe b -> DebugClosure pap string s b
WeakClosure StgInfoTableWithPtr
a1 (i -> i -> i -> i -> Maybe i -> DebugClosure b d g i)
-> f i -> f (i -> i -> i -> Maybe i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f i
g h
a2 f (i -> i -> i -> Maybe i -> DebugClosure b d g i)
-> f i -> f (i -> i -> Maybe i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
a3 f (i -> i -> Maybe i -> DebugClosure b d g i)
-> f i -> f (i -> Maybe i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
a4 f (i -> Maybe i -> DebugClosure b d g i)
-> f i -> f (Maybe i -> DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
a5 f (Maybe i -> DebugClosure b d g i)
-> f (Maybe i) -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (h -> f i) -> Maybe h -> f (Maybe i)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse h -> f i
g Maybe h
a6
      TVarClosure StgInfoTableWithPtr
a1 h
a2 h
a3 Int
a4 ->
        StgInfoTableWithPtr -> i -> i -> Int -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr -> b -> b -> Int -> DebugClosure pap string s b
TVarClosure StgInfoTableWithPtr
a1 (i -> i -> Int -> DebugClosure b d g i)
-> f i -> f (i -> Int -> DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f i
g h
a2 f (i -> Int -> DebugClosure b d g i)
-> f i -> f (Int -> DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h -> f i
g h
a3 f (Int -> DebugClosure b d g i)
-> f Int -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
a4
      TRecChunkClosure StgInfoTableWithPtr
a1 h
a2 Word
a3 [TRecEntry h]
a4 -> StgInfoTableWithPtr
-> i -> Word -> [TRecEntry i] -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr
-> b -> Word -> [TRecEntry b] -> DebugClosure pap string s b
TRecChunkClosure StgInfoTableWithPtr
a1 (i -> Word -> [TRecEntry i] -> DebugClosure b d g i)
-> f i -> f (Word -> [TRecEntry i] -> DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f i
g h
a2 f (Word -> [TRecEntry i] -> DebugClosure b d g i)
-> f Word -> f ([TRecEntry i] -> DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Word -> f Word
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word
a3 f ([TRecEntry i] -> DebugClosure b d g i)
-> f [TRecEntry i] -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TRecEntry h -> f (TRecEntry i))
-> [TRecEntry h] -> f [TRecEntry i]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((h -> f i) -> TRecEntry h -> f (TRecEntry i)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse h -> f i
g) [TRecEntry h]
a4
      MutPrimClosure StgInfoTableWithPtr
a1 [h]
a2 [Word]
a3 -> StgInfoTableWithPtr -> [i] -> [Word] -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr -> [b] -> [Word] -> DebugClosure pap string s b
MutPrimClosure StgInfoTableWithPtr
a1 ([i] -> [Word] -> DebugClosure b d g i)
-> f [i] -> f ([Word] -> DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (h -> f i) -> [h] -> f [i]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse h -> f i
g [h]
a2 f ([Word] -> DebugClosure b d g i)
-> f [Word] -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Word] -> f [Word]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Word]
a3
      OtherClosure StgInfoTableWithPtr
a1 [h]
bs [Word]
ws -> StgInfoTableWithPtr -> [i] -> [Word] -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr -> [b] -> [Word] -> DebugClosure pap string s b
OtherClosure StgInfoTableWithPtr
a1 ([i] -> [Word] -> DebugClosure b d g i)
-> f [i] -> f ([Word] -> DebugClosure b d g i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (h -> f i) -> [h] -> f [i]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse h -> f i
g [h]
bs f ([Word] -> DebugClosure b d g i)
-> f [Word] -> f (DebugClosure b d g i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Word] -> f [Word]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Word]
ws
      UnsupportedClosure StgInfoTableWithPtr
i  -> DebugClosure b d g i -> f (DebugClosure b d g i)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StgInfoTableWithPtr -> DebugClosure b d g i
forall pap string s b.
StgInfoTableWithPtr -> DebugClosure pap string s b
UnsupportedClosure StgInfoTableWithPtr
i)