{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}

module GHC.Exts.Heap.Closures (
    -- * Closures
      Closure
    , GenClosure(..)
    , PrimType(..)
    , WhatNext(..)
    , WhyBlocked(..)
    , TsoFlags(..)
    , allClosures
    , closureSize

    -- * Boxes
    , Box(..)
    , areBoxesEqual
    , asBox
    ) where

import Prelude -- See note [Why do we import Prelude here?]
import GHC.Exts.Heap.Constants
#if defined(PROFILING)
import GHC.Exts.Heap.InfoTableProf
#else
import GHC.Exts.Heap.InfoTable

-- `ghc -M` currently doesn't properly account for ways when generating
-- dependencies (#15197). This import ensures correct build-ordering between
-- this module and GHC.Exts.Heap.InfoTableProf. It should be removed when #15197
-- is fixed.
import GHC.Exts.Heap.InfoTableProf ()
#endif

import GHC.Exts.Heap.ProfInfo.Types

import Data.Bits
import Data.Foldable (toList)
import Data.Int
import Data.Word
import GHC.Exts
import GHC.Generics
import Numeric

------------------------------------------------------------------------
-- Boxes

foreign import prim "aToWordzh" aToWord# :: Any -> Word#

foreign import prim "reallyUnsafePtrEqualityUpToTag"
    reallyUnsafePtrEqualityUpToTag# :: Any -> Any -> Int#

-- | An arbitrary Haskell value in a safe Box. The point is that even
-- unevaluated thunks can safely be moved around inside the Box, and when
-- required, e.g. in 'getBoxedClosureData', the function knows how far it has
-- to evaluate the argument.
data Box = Box Any

instance Show Box where
-- From libraries/base/GHC/Ptr.lhs
   showsPrec :: Int -> Box -> ShowS
showsPrec Int
_ (Box Any
a) String
rs =
    -- unsafePerformIO (print "↓" >> pClosure a) `seq`
    ShowS
pad_out (Word -> ShowS
forall a. Integral a => a -> ShowS
showHex Word
addr String
"") String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Word
tagWord -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>Word
0 then String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
tag else String
"") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rs
     where
       ptr :: Word
ptr  = Word# -> Word
W# (Any -> Word#
aToWord# Any
a)
       tag :: Word
tag  = Word
ptr Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tAG_MASK -- ((1 `shiftL` TAG_BITS) -1)
       addr :: Word
addr = Word
ptr Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
tag
       pad_out :: ShowS
pad_out String
ls = Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'x'Char -> ShowS
forall a. a -> [a] -> [a]
:String
ls

-- |This takes an arbitrary value and puts it into a box.
-- Note that calls like
--
-- > asBox (head list)
--
-- will put the thunk \"head list\" into the box, /not/ the element at the head
-- of the list. For that, use careful case expressions:
--
-- > case list of x:_ -> asBox x
asBox :: a -> Box
asBox :: forall a. a -> Box
asBox a
x = Any -> Box
Box (a -> Any
forall a b. a -> b
unsafeCoerce# a
x)

-- | Boxes can be compared, but this is not pure, as different heap objects can,
-- after garbage collection, become the same object.
areBoxesEqual :: Box -> Box -> IO Bool
areBoxesEqual :: Box -> Box -> IO Bool
areBoxesEqual (Box Any
a) (Box Any
b) = case Any -> Any -> Int#
reallyUnsafePtrEqualityUpToTag# Any
a Any
b of
    Int#
0# -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    Int#
_  -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True


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

type Closure = GenClosure Box

-- | This is the representation of a Haskell value on the heap. It reflects
-- <https://gitlab.haskell.org/ghc/ghc/blob/master/rts/include/rts/storage/Closures.h>
--
-- The data type is parametrized by `b`: the type to store references in.
-- Usually this is a 'Box' with the type synonym 'Closure'.
--
-- 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 GenClosure b
  = -- | A data constructor
    ConstrClosure
        { forall b. GenClosure b -> StgInfoTable
info       :: !StgInfoTable
        , forall b. GenClosure b -> [b]
ptrArgs    :: ![b]            -- ^ Pointer arguments
        , forall b. GenClosure b -> [Word]
dataArgs   :: ![Word]         -- ^ Non-pointer arguments
        , forall b. GenClosure b -> String
pkg        :: !String         -- ^ Package name
        , forall b. GenClosure b -> String
modl       :: !String         -- ^ Module name
        , forall b. GenClosure b -> String
name       :: !String         -- ^ Constructor name
        }

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

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

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

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

    -- | A suspended thunk evaluation
  | APStackClosure
        { info       :: !StgInfoTable
        , fun        :: !b              -- ^ Function closure
        , payload    :: ![b]            -- ^ Stack right before suspension
        }

    -- | A pointer to another closure, introduced when a thunk is updated
    -- to point at its value
  | IndClosure
        { info       :: !StgInfoTable
        , forall b. GenClosure 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       :: !StgInfoTable
        , forall b. GenClosure b -> b
instrs     :: !b              -- ^ A pointer to an ArrWords
                                        --   of instructions
        , forall b. GenClosure b -> b
literals   :: !b              -- ^ A pointer to an ArrWords
                                        --   of literals
        , forall b. GenClosure b -> b
bcoptrs    :: !b              -- ^ A pointer to an ArrWords
                                        --   of byte code objects
        , arity      :: !HalfWord       -- ^ The arity of this BCO
        , forall b. GenClosure b -> HalfWord
size       :: !HalfWord       -- ^ The size of this BCO in words
        , forall b. GenClosure b -> [Word]
bitmap     :: ![Word]         -- ^ An StgLargeBitmap describing the
                                        --   pointerhood of its args/free vars
        }

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

    -- | A @ByteArray#@
  | ArrWordsClosure
        { info       :: !StgInfoTable
        , forall b. GenClosure b -> Word
bytes      :: !Word           -- ^ Size of array in bytes
        , forall b. GenClosure b -> [Word]
arrWords   :: ![Word]         -- ^ Array payload
        }

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

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

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

    -- | An @IOPort#@, with a queue of thread state objects blocking on them
  | IOPortClosure
        { info       :: !StgInfoTable
        , queueHead  :: !b              -- ^ Pointer to head of queue
        , queueTail  :: !b              -- ^ Pointer to tail of queue
        , value      :: !b              -- ^ Pointer to closure
        }

    -- | A @MutVar#@
  | MutVarClosure
        { info       :: !StgInfoTable
        , forall b. GenClosure b -> b
var        :: !b              -- ^ Pointer to contents
        }

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

  | WeakClosure
        { info        :: !StgInfoTable
        , forall b. GenClosure b -> b
cfinalizers :: !b
        , forall b. GenClosure b -> b
key         :: !b
        , value       :: !b
        , forall b. GenClosure b -> b
finalizer   :: !b
        , forall b. GenClosure b -> Maybe b
weakLink    :: !(Maybe b) -- ^ next weak pointer for the capability
        }

  -- | Representation of StgTSO: A Thread State Object. The values for
  -- 'what_next', 'why_blocked' and 'flags' are defined in @Constants.h@.
  | TSOClosure
      { info                :: !StgInfoTable
      -- pointers
      , link                :: !b
      , forall b. GenClosure b -> b
global_link         :: !b
      , forall b. GenClosure b -> b
tsoStack            :: !b -- ^ stackobj from StgTSO
      , forall b. GenClosure b -> b
trec                :: !b
      , forall b. GenClosure b -> b
blocked_exceptions  :: !b
      , forall b. GenClosure b -> b
bq                  :: !b
      , forall b. GenClosure b -> Maybe b
thread_label        :: !(Maybe b)
      -- values
      , forall b. GenClosure b -> WhatNext
what_next           :: !WhatNext
      , forall b. GenClosure b -> WhyBlocked
why_blocked         :: !WhyBlocked
      , forall b. GenClosure b -> [TsoFlags]
flags               :: ![TsoFlags]
      , forall b. GenClosure b -> Word64
threadId            :: !Word64
      , forall b. GenClosure b -> HalfWord
saved_errno         :: !Word32
      , forall b. GenClosure b -> HalfWord
tso_dirty           :: !Word32 -- ^ non-zero => dirty
      , forall b. GenClosure b -> Int64
alloc_limit         :: !Int64
      , forall b. GenClosure b -> HalfWord
tot_stack_size      :: !Word32
      , forall b. GenClosure b -> Maybe StgTSOProfInfo
prof                :: !(Maybe StgTSOProfInfo)
      }

  -- | Representation of StgStack: The 'tsoStack ' of a 'TSOClosure'.
  | StackClosure
      { info            :: !StgInfoTable
      , forall b. GenClosure b -> HalfWord
stack_size      :: !Word32 -- ^ stack size in *words*
      , forall b. GenClosure b -> Word8
stack_dirty     :: !Word8 -- ^ non-zero => dirty
#if __GLASGOW_HASKELL__ >= 811
      , forall b. GenClosure b -> Word8
stack_marking   :: !Word8
#endif
      }

    ------------------------------------------------------------
    -- Unboxed unlifted closures

    -- | Primitive Int
  | IntClosure
        { forall b. GenClosure b -> PrimType
ptipe      :: PrimType
        , forall b. GenClosure b -> Int
intVal     :: !Int }

    -- | Primitive Word
  | WordClosure
        { ptipe      :: PrimType
        , forall b. GenClosure b -> Word
wordVal    :: !Word }

    -- | Primitive Int64
  | Int64Closure
        { ptipe      :: PrimType
        , forall b. GenClosure b -> Int64
int64Val   :: !Int64 }

    -- | Primitive Word64
  | Word64Closure
        { ptipe      :: PrimType
        , forall b. GenClosure b -> Word64
word64Val  :: !Word64 }

    -- | Primitive Addr
  | AddrClosure
        { ptipe      :: PrimType
        , forall b. GenClosure b -> Int
addrVal    :: !Int }

    -- | Primitive Float
  | FloatClosure
        { ptipe      :: PrimType
        , forall b. GenClosure b -> Float
floatVal   :: !Float }

    -- | Primitive Double
  | DoubleClosure
        { ptipe      :: PrimType
        , forall b. GenClosure b -> Double
doubleVal  :: !Double }

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

    -- | Another kind of closure
  | OtherClosure
        { info       :: !StgInfoTable
        , forall b. GenClosure b -> [b]
hvalues    :: ![b]
        , forall b. GenClosure b -> [Word]
rawWords   :: ![Word]
        }

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


data PrimType
  = PInt
  | PWord
  | PInt64
  | PWord64
  | PAddr
  | PFloat
  | PDouble
  deriving (PrimType -> PrimType -> Bool
(PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool) -> Eq PrimType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrimType -> PrimType -> Bool
== :: PrimType -> PrimType -> Bool
$c/= :: PrimType -> PrimType -> Bool
/= :: PrimType -> PrimType -> Bool
Eq, Int -> PrimType -> ShowS
[PrimType] -> ShowS
PrimType -> String
(Int -> PrimType -> ShowS)
-> (PrimType -> String) -> ([PrimType] -> ShowS) -> Show PrimType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrimType -> ShowS
showsPrec :: Int -> PrimType -> ShowS
$cshow :: PrimType -> String
show :: PrimType -> String
$cshowList :: [PrimType] -> ShowS
showList :: [PrimType] -> ShowS
Show, (forall x. PrimType -> Rep PrimType x)
-> (forall x. Rep PrimType x -> PrimType) -> Generic PrimType
forall x. Rep PrimType x -> PrimType
forall x. PrimType -> Rep PrimType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PrimType -> Rep PrimType x
from :: forall x. PrimType -> Rep PrimType x
$cto :: forall x. Rep PrimType x -> PrimType
to :: forall x. Rep PrimType x -> PrimType
Generic, Eq PrimType
Eq PrimType =>
(PrimType -> PrimType -> Ordering)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> PrimType)
-> (PrimType -> PrimType -> PrimType)
-> Ord PrimType
PrimType -> PrimType -> Bool
PrimType -> PrimType -> Ordering
PrimType -> PrimType -> PrimType
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 :: PrimType -> PrimType -> Ordering
compare :: PrimType -> PrimType -> Ordering
$c< :: PrimType -> PrimType -> Bool
< :: PrimType -> PrimType -> Bool
$c<= :: PrimType -> PrimType -> Bool
<= :: PrimType -> PrimType -> Bool
$c> :: PrimType -> PrimType -> Bool
> :: PrimType -> PrimType -> Bool
$c>= :: PrimType -> PrimType -> Bool
>= :: PrimType -> PrimType -> Bool
$cmax :: PrimType -> PrimType -> PrimType
max :: PrimType -> PrimType -> PrimType
$cmin :: PrimType -> PrimType -> PrimType
min :: PrimType -> PrimType -> PrimType
Ord)

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

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

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

-- | For generic code, this function returns all referenced closures.
allClosures :: GenClosure b -> [b]
allClosures :: forall b. GenClosure b -> [b]
allClosures (ConstrClosure {[b]
String
[Word]
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
ptrArgs :: forall b. GenClosure b -> [b]
dataArgs :: forall b. GenClosure b -> [Word]
pkg :: forall b. GenClosure b -> String
modl :: forall b. GenClosure b -> String
name :: forall b. GenClosure b -> String
info :: StgInfoTable
ptrArgs :: [b]
dataArgs :: [Word]
pkg :: String
modl :: String
name :: String
..}) = [b]
ptrArgs
allClosures (ThunkClosure {[b]
[Word]
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
ptrArgs :: forall b. GenClosure b -> [b]
dataArgs :: forall b. GenClosure b -> [Word]
info :: StgInfoTable
ptrArgs :: [b]
dataArgs :: [Word]
..}) = [b]
ptrArgs
allClosures (SelectorClosure {b
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
selectee :: forall b. GenClosure b -> b
info :: StgInfoTable
selectee :: b
..}) = [b
selectee]
allClosures (IndClosure {b
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
indirectee :: forall b. GenClosure b -> b
info :: StgInfoTable
indirectee :: b
..}) = [b
indirectee]
allClosures (BlackholeClosure {b
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
indirectee :: forall b. GenClosure b -> b
info :: StgInfoTable
indirectee :: b
..}) = [b
indirectee]
allClosures (APClosure {b
[b]
HalfWord
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
arity :: forall b. GenClosure b -> HalfWord
n_args :: forall b. GenClosure b -> HalfWord
fun :: forall b. GenClosure b -> b
payload :: forall b. GenClosure b -> [b]
info :: StgInfoTable
arity :: HalfWord
n_args :: HalfWord
fun :: b
payload :: [b]
..}) = b
funb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
payload
allClosures (PAPClosure {b
[b]
HalfWord
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
arity :: forall b. GenClosure b -> HalfWord
n_args :: forall b. GenClosure b -> HalfWord
fun :: forall b. GenClosure b -> b
payload :: forall b. GenClosure b -> [b]
info :: StgInfoTable
arity :: HalfWord
n_args :: HalfWord
fun :: b
payload :: [b]
..}) = b
funb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
payload
allClosures (APStackClosure {b
[b]
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
fun :: forall b. GenClosure b -> b
payload :: forall b. GenClosure b -> [b]
info :: StgInfoTable
fun :: b
payload :: [b]
..}) = b
funb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
payload
allClosures (BCOClosure {b
[Word]
HalfWord
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
arity :: forall b. GenClosure b -> HalfWord
instrs :: forall b. GenClosure b -> b
literals :: forall b. GenClosure b -> b
bcoptrs :: forall b. GenClosure b -> b
size :: forall b. GenClosure b -> HalfWord
bitmap :: forall b. GenClosure b -> [Word]
info :: StgInfoTable
instrs :: b
literals :: b
bcoptrs :: b
arity :: HalfWord
size :: HalfWord
bitmap :: [Word]
..}) = [b
instrs,b
literals,b
bcoptrs]
allClosures (ArrWordsClosure {}) = []
allClosures (MutArrClosure {[b]
Word
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
mccPtrs :: forall b. GenClosure b -> Word
mccSize :: forall b. GenClosure b -> Word
mccPayload :: forall b. GenClosure b -> [b]
info :: StgInfoTable
mccPtrs :: Word
mccSize :: Word
mccPayload :: [b]
..}) = [b]
mccPayload
allClosures (SmallMutArrClosure {[b]
Word
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
mccPtrs :: forall b. GenClosure b -> Word
mccPayload :: forall b. GenClosure b -> [b]
info :: StgInfoTable
mccPtrs :: Word
mccPayload :: [b]
..}) = [b]
mccPayload
allClosures (MutVarClosure {b
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
var :: forall b. GenClosure b -> b
info :: StgInfoTable
var :: b
..}) = [b
var]
allClosures (MVarClosure {b
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
queueHead :: forall b. GenClosure b -> b
queueTail :: forall b. GenClosure b -> b
value :: forall b. GenClosure b -> b
info :: StgInfoTable
queueHead :: b
queueTail :: b
value :: b
..}) = [b
queueHead,b
queueTail,b
value]
allClosures (IOPortClosure {b
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
queueHead :: forall b. GenClosure b -> b
queueTail :: forall b. GenClosure b -> b
value :: forall b. GenClosure b -> b
info :: StgInfoTable
queueHead :: b
queueTail :: b
value :: b
..}) = [b
queueHead,b
queueTail,b
value]
allClosures (FunClosure {[b]
[Word]
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
ptrArgs :: forall b. GenClosure b -> [b]
dataArgs :: forall b. GenClosure b -> [Word]
info :: StgInfoTable
ptrArgs :: [b]
dataArgs :: [Word]
..}) = [b]
ptrArgs
allClosures (BlockingQueueClosure {b
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
link :: forall b. GenClosure b -> b
blackHole :: forall b. GenClosure b -> b
owner :: forall b. GenClosure b -> b
queue :: forall b. GenClosure b -> b
info :: StgInfoTable
link :: b
blackHole :: b
owner :: b
queue :: b
..}) = [b
link, b
blackHole, b
owner, b
queue]
allClosures (WeakClosure {b
Maybe b
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
value :: forall b. GenClosure b -> b
cfinalizers :: forall b. GenClosure b -> b
key :: forall b. GenClosure b -> b
finalizer :: forall b. GenClosure b -> b
weakLink :: forall b. GenClosure b -> Maybe b
info :: StgInfoTable
cfinalizers :: b
key :: b
value :: b
finalizer :: b
weakLink :: Maybe b
..}) = [b
cfinalizers, b
key, b
value, b
finalizer] [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ Maybe b -> [b]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Maybe b
weakLink
allClosures (OtherClosure {[b]
[Word]
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
hvalues :: forall b. GenClosure b -> [b]
rawWords :: forall b. GenClosure b -> [Word]
info :: StgInfoTable
hvalues :: [b]
rawWords :: [Word]
..}) = [b]
hvalues
allClosures GenClosure b
_ = []

-- | Get the size of the top-level closure in words.
-- Includes header and payload. Does not follow pointers.
--
-- @since 8.10.1
closureSize :: Box -> Int
closureSize :: Box -> Int
closureSize (Box Any
x) = Int# -> Int
I# (Any -> Int#
forall a. a -> Int#
closureSize# Any
x)