{-# LINE 1 "libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc" #-}
{-# LANGUAGE DeriveGeneric #-}
module GHC.Exts.Heap.InfoTable.Types
    ( StgInfoTable(..)
    , EntryFunPtr
    , HalfWord
    , ItblCodes
    ) where



import Prelude -- See note [Why do we import Prelude here?]
import GHC.Generics
import GHC.Exts.Heap.ClosureTypes
import Foreign

type ItblCodes = Either [Word8] [Word32]


-- Ultra-minimalist version specially for constructors

{-# LINE 21 "libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc" #-}
type HalfWord = Word32

{-# LINE 27 "libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc" #-}

type EntryFunPtr = FunPtr (Ptr () -> IO (Ptr ()))

-- | This is a somewhat faithful representation of an info table. See
-- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/storage/InfoTables.h>
-- for more details on this data structure.
data StgInfoTable = StgInfoTable {
   StgInfoTable -> Maybe EntryFunPtr
entry  :: Maybe EntryFunPtr, -- Just <=> not ghciTablesNextToCode
   StgInfoTable -> HalfWord
ptrs   :: HalfWord,
   StgInfoTable -> HalfWord
nptrs  :: HalfWord,
   StgInfoTable -> ClosureType
tipe   :: ClosureType,
   StgInfoTable -> HalfWord
srtlen :: HalfWord,
   StgInfoTable -> Maybe ItblCodes
code   :: Maybe ItblCodes -- Just <=> ghciTablesNextToCode
  } deriving (Int -> StgInfoTable -> ShowS
[StgInfoTable] -> ShowS
StgInfoTable -> String
(Int -> StgInfoTable -> ShowS)
-> (StgInfoTable -> String)
-> ([StgInfoTable] -> ShowS)
-> Show StgInfoTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StgInfoTable] -> ShowS
$cshowList :: [StgInfoTable] -> ShowS
show :: StgInfoTable -> String
$cshow :: StgInfoTable -> String
showsPrec :: Int -> StgInfoTable -> ShowS
$cshowsPrec :: Int -> StgInfoTable -> ShowS
Show, (forall x. StgInfoTable -> Rep StgInfoTable x)
-> (forall x. Rep StgInfoTable x -> StgInfoTable)
-> Generic StgInfoTable
forall x. Rep StgInfoTable x -> StgInfoTable
forall x. StgInfoTable -> Rep StgInfoTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StgInfoTable x -> StgInfoTable
$cfrom :: forall x. StgInfoTable -> Rep StgInfoTable x
Generic)