{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{- | The Haskell representation of a heap closure, the 'DebugClosure' type
- is quite similar to the one found in the @ghc-heap@ package but with some
- more type parameters and other changes..
-}
module GHC.Debug.Types.Closures (
    -- * Closure Representation
      Closure
    , SizedClosure
    , SizedClosureC
    , SizedClosureP
    , DebugClosure(..)
    , TRecEntry(..)
    -- * Wrappers
    , DebugClosureWithSize
    , DebugClosureWithExtra(..)
    , Size(..)
    , InclusiveSize(..)
    , RetainerSize(..)
    , noSize
    , dcSize
    , allClosures
    -- * Info Table Representation
    , StgInfoTable(..)
    , GHC.ClosureType(..)
    , StgInfoTableWithPtr(..)
    -- * Stack Frame Representation
    , DebugStackFrame(..)
    , FieldValue(..)
    , GenStackFrames(..)
    , StackFrames
    , StackCont(..)
    -- * PAP payload representation
    , GenPapPayload(..)
    , PapPayload
    , PayloadCont(..)
    -- * Constructor Description Representation
    , ConstrDesc(..)
    , ConstrDescCont
    , parseConstrDesc
    -- * SRT field representation
    , GenSrtPayload(..)
    , SrtPayload
    , SrtCont

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

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


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

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


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


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

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

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

type DebugClosureWithSize = DebugClosureWithExtra Size

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

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

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

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


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

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

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

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

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

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


-- | This is the representation of a Haskell value on the heap. It reflects
-- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/storage/Closures.h>
--
-- The data type is parametrized by 4 type parameters which correspond to
-- different pointer types.
--
-- All Heap objects have the same basic layout. A header containing a pointer
-- to the info table and a payload with various fields. The @info@ field below
-- always refers to the info table pointed to by the header. The remaining
-- fields are the payload.
--
-- See
-- <https://gitlab.haskell.org/ghc/ghc/wikis/commentary/rts/storage/heap-objects>
-- for more information.
data DebugClosure srt pap string s b
  = -- | A data constructor
    ConstrClosure
        { forall srt pap string s b.
DebugClosure srt pap string s b -> StgInfoTableWithPtr
info       :: !StgInfoTableWithPtr
        , forall srt pap string s b. DebugClosure srt pap string s b -> [b]
ptrArgs    :: ![b]            -- ^ Pointer arguments
        , forall srt pap string s b.
DebugClosure srt pap string s b -> [Word]
dataArgs   :: ![Word]         -- ^ Non-pointer arguments
        , forall srt pap string s b.
DebugClosure srt pap string s b -> string
constrDesc :: !string
        }

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

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

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

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

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

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

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

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

    -- | A thunk under evaluation by another thread
  | BlackholeClosure
        { info       :: !StgInfoTableWithPtr
        , indirectee :: !b              -- ^ The target closure
        }

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

type PapPayload = GenPapPayload ClosurePtr

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

type SrtPayload = GenSrtPayload ClosurePtr

type SrtCont = InfoTablePtr

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

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

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

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

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



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


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

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

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



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


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

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

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

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

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


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