{-# LANGUAGE MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-}
module ByteCodeTypes
( CompiledByteCode(..), seqCompiledByteCode, FFIInfo(..)
, UnlinkedBCO(..), BCOPtr(..), BCONPtr(..)
, ItblEnv, ItblPtr(..)
, CgBreakInfo(..)
, ModBreaks (..), BreakIndex, emptyModBreaks
, CCostCentre
) where
import GhcPrelude
import FastString
import Id
import Name
import NameEnv
import Outputable
import PrimOp
import SizedSeq
import Type
import SrcLoc
import GHCi.BreakArray
import GHCi.RemoteTypes
import GHCi.FFI
import Control.DeepSeq
import Foreign
import Data.Array
import Data.Array.Base ( UArray(..) )
import Data.ByteString (ByteString)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Maybe (catMaybes)
import GHC.Exts.Heap
import GHC.Stack.CCS
data CompiledByteCode = CompiledByteCode
{ CompiledByteCode -> [UnlinkedBCO]
bc_bcos :: [UnlinkedBCO]
, CompiledByteCode -> ItblEnv
bc_itbls :: ItblEnv
, CompiledByteCode -> [FFIInfo]
bc_ffis :: [FFIInfo]
, CompiledByteCode -> [RemotePtr ()]
bc_strs :: [RemotePtr ()]
, CompiledByteCode -> Maybe ModBreaks
bc_breaks :: Maybe ModBreaks
}
newtype FFIInfo = FFIInfo (RemotePtr C_ffi_cif)
deriving (Int -> FFIInfo -> ShowS
[FFIInfo] -> ShowS
FFIInfo -> String
(Int -> FFIInfo -> ShowS)
-> (FFIInfo -> String) -> ([FFIInfo] -> ShowS) -> Show FFIInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FFIInfo] -> ShowS
$cshowList :: [FFIInfo] -> ShowS
show :: FFIInfo -> String
$cshow :: FFIInfo -> String
showsPrec :: Int -> FFIInfo -> ShowS
$cshowsPrec :: Int -> FFIInfo -> ShowS
Show, FFIInfo -> ()
(FFIInfo -> ()) -> NFData FFIInfo
forall a. (a -> ()) -> NFData a
rnf :: FFIInfo -> ()
$crnf :: FFIInfo -> ()
NFData)
instance Outputable CompiledByteCode where
ppr :: CompiledByteCode -> SDoc
ppr CompiledByteCode{[RemotePtr ()]
[UnlinkedBCO]
[FFIInfo]
Maybe ModBreaks
ItblEnv
bc_breaks :: Maybe ModBreaks
bc_strs :: [RemotePtr ()]
bc_ffis :: [FFIInfo]
bc_itbls :: ItblEnv
bc_bcos :: [UnlinkedBCO]
bc_breaks :: CompiledByteCode -> Maybe ModBreaks
bc_strs :: CompiledByteCode -> [RemotePtr ()]
bc_ffis :: CompiledByteCode -> [FFIInfo]
bc_itbls :: CompiledByteCode -> ItblEnv
bc_bcos :: CompiledByteCode -> [UnlinkedBCO]
..} = [UnlinkedBCO] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [UnlinkedBCO]
bc_bcos
seqCompiledByteCode :: CompiledByteCode -> ()
seqCompiledByteCode :: CompiledByteCode -> ()
seqCompiledByteCode CompiledByteCode{[RemotePtr ()]
[UnlinkedBCO]
[FFIInfo]
Maybe ModBreaks
ItblEnv
bc_breaks :: Maybe ModBreaks
bc_strs :: [RemotePtr ()]
bc_ffis :: [FFIInfo]
bc_itbls :: ItblEnv
bc_bcos :: [UnlinkedBCO]
bc_breaks :: CompiledByteCode -> Maybe ModBreaks
bc_strs :: CompiledByteCode -> [RemotePtr ()]
bc_ffis :: CompiledByteCode -> [FFIInfo]
bc_itbls :: CompiledByteCode -> ItblEnv
bc_bcos :: CompiledByteCode -> [UnlinkedBCO]
..} =
[UnlinkedBCO] -> ()
forall a. NFData a => a -> ()
rnf [UnlinkedBCO]
bc_bcos () -> () -> ()
`seq`
[(Name, ItblPtr)] -> ()
forall a. NFData a => a -> ()
rnf (ItblEnv -> [(Name, ItblPtr)]
forall a. NameEnv a -> [a]
nameEnvElts ItblEnv
bc_itbls) () -> () -> ()
`seq`
[FFIInfo] -> ()
forall a. NFData a => a -> ()
rnf [FFIInfo]
bc_ffis () -> () -> ()
`seq`
[RemotePtr ()] -> ()
forall a. NFData a => a -> ()
rnf [RemotePtr ()]
bc_strs () -> () -> ()
`seq`
Maybe () -> ()
forall a. NFData a => a -> ()
rnf ((ModBreaks -> ()) -> Maybe ModBreaks -> Maybe ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModBreaks -> ()
seqModBreaks Maybe ModBreaks
bc_breaks)
type ItblEnv = NameEnv (Name, ItblPtr)
newtype ItblPtr = ItblPtr (RemotePtr StgInfoTable)
deriving (Int -> ItblPtr -> ShowS
[ItblPtr] -> ShowS
ItblPtr -> String
(Int -> ItblPtr -> ShowS)
-> (ItblPtr -> String) -> ([ItblPtr] -> ShowS) -> Show ItblPtr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItblPtr] -> ShowS
$cshowList :: [ItblPtr] -> ShowS
show :: ItblPtr -> String
$cshow :: ItblPtr -> String
showsPrec :: Int -> ItblPtr -> ShowS
$cshowsPrec :: Int -> ItblPtr -> ShowS
Show, ItblPtr -> ()
(ItblPtr -> ()) -> NFData ItblPtr
forall a. (a -> ()) -> NFData a
rnf :: ItblPtr -> ()
$crnf :: ItblPtr -> ()
NFData)
data UnlinkedBCO
= UnlinkedBCO {
UnlinkedBCO -> Name
unlinkedBCOName :: !Name,
UnlinkedBCO -> Int
unlinkedBCOArity :: {-# UNPACK #-} !Int,
UnlinkedBCO -> UArray Int Word16
unlinkedBCOInstrs :: !(UArray Int Word16),
UnlinkedBCO -> UArray Int Word64
unlinkedBCOBitmap :: !(UArray Int Word64),
UnlinkedBCO -> SizedSeq BCONPtr
unlinkedBCOLits :: !(SizedSeq BCONPtr),
UnlinkedBCO -> SizedSeq BCOPtr
unlinkedBCOPtrs :: !(SizedSeq BCOPtr)
}
instance NFData UnlinkedBCO where
rnf :: UnlinkedBCO -> ()
rnf UnlinkedBCO{Int
UArray Int Word16
UArray Int Word64
SizedSeq BCONPtr
SizedSeq BCOPtr
Name
unlinkedBCOPtrs :: SizedSeq BCOPtr
unlinkedBCOLits :: SizedSeq BCONPtr
unlinkedBCOBitmap :: UArray Int Word64
unlinkedBCOInstrs :: UArray Int Word16
unlinkedBCOArity :: Int
unlinkedBCOName :: Name
unlinkedBCOPtrs :: UnlinkedBCO -> SizedSeq BCOPtr
unlinkedBCOLits :: UnlinkedBCO -> SizedSeq BCONPtr
unlinkedBCOBitmap :: UnlinkedBCO -> UArray Int Word64
unlinkedBCOInstrs :: UnlinkedBCO -> UArray Int Word16
unlinkedBCOArity :: UnlinkedBCO -> Int
unlinkedBCOName :: UnlinkedBCO -> Name
..} =
SizedSeq BCONPtr -> ()
forall a. NFData a => a -> ()
rnf SizedSeq BCONPtr
unlinkedBCOLits () -> () -> ()
`seq`
SizedSeq BCOPtr -> ()
forall a. NFData a => a -> ()
rnf SizedSeq BCOPtr
unlinkedBCOPtrs
data BCOPtr
= BCOPtrName !Name
| BCOPtrPrimOp !PrimOp
| BCOPtrBCO !UnlinkedBCO
| BCOPtrBreakArray
instance NFData BCOPtr where
rnf :: BCOPtr -> ()
rnf (BCOPtrBCO UnlinkedBCO
bco) = UnlinkedBCO -> ()
forall a. NFData a => a -> ()
rnf UnlinkedBCO
bco
rnf BCOPtr
x = BCOPtr
x BCOPtr -> () -> ()
`seq` ()
data BCONPtr
= BCONPtrWord {-# UNPACK #-} !Word
| BCONPtrLbl !FastString
| BCONPtrItbl !Name
| BCONPtrStr !ByteString
instance NFData BCONPtr where
rnf :: BCONPtr -> ()
rnf BCONPtr
x = BCONPtr
x BCONPtr -> () -> ()
`seq` ()
data CgBreakInfo
= CgBreakInfo
{ CgBreakInfo -> [Maybe (Id, Word16)]
cgb_vars :: [Maybe (Id,Word16)]
, CgBreakInfo -> Type
cgb_resty :: Type
}
seqCgBreakInfo :: CgBreakInfo -> ()
seqCgBreakInfo :: CgBreakInfo -> ()
seqCgBreakInfo CgBreakInfo{[Maybe (Id, Word16)]
Type
cgb_resty :: Type
cgb_vars :: [Maybe (Id, Word16)]
cgb_resty :: CgBreakInfo -> Type
cgb_vars :: CgBreakInfo -> [Maybe (Id, Word16)]
..} =
[Word16] -> ()
forall a. NFData a => a -> ()
rnf (((Id, Word16) -> Word16) -> [(Id, Word16)] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map (Id, Word16) -> Word16
forall a b. (a, b) -> b
snd ([Maybe (Id, Word16)] -> [(Id, Word16)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Id, Word16)]
cgb_vars))) () -> () -> ()
`seq`
Type -> ()
seqType Type
cgb_resty
instance Outputable UnlinkedBCO where
ppr :: UnlinkedBCO -> SDoc
ppr (UnlinkedBCO Name
nm Int
_arity UArray Int Word16
_insns UArray Int Word64
_bitmap SizedSeq BCONPtr
lits SizedSeq BCOPtr
ptrs)
= [SDoc] -> SDoc
sep [String -> SDoc
text String
"BCO", Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm, String -> SDoc
text String
"with",
Word -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SizedSeq BCONPtr -> Word
forall a. SizedSeq a -> Word
sizeSS SizedSeq BCONPtr
lits), String -> SDoc
text String
"lits",
Word -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SizedSeq BCOPtr -> Word
forall a. SizedSeq a -> Word
sizeSS SizedSeq BCOPtr
ptrs), String -> SDoc
text String
"ptrs" ]
instance Outputable CgBreakInfo where
ppr :: CgBreakInfo -> SDoc
ppr CgBreakInfo
info = String -> SDoc
text String
"CgBreakInfo" SDoc -> SDoc -> SDoc
<+>
SDoc -> SDoc
parens ([Maybe (Id, Word16)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CgBreakInfo -> [Maybe (Id, Word16)]
cgb_vars CgBreakInfo
info) SDoc -> SDoc -> SDoc
<+>
Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CgBreakInfo -> Type
cgb_resty CgBreakInfo
info))
type BreakIndex = Int
data CCostCentre
data ModBreaks
= ModBreaks
{ ModBreaks -> ForeignRef BreakArray
modBreaks_flags :: ForeignRef BreakArray
, ModBreaks -> Array Int SrcSpan
modBreaks_locs :: !(Array BreakIndex SrcSpan)
, ModBreaks -> Array Int [OccName]
modBreaks_vars :: !(Array BreakIndex [OccName])
, ModBreaks -> Array Int [String]
modBreaks_decls :: !(Array BreakIndex [String])
, ModBreaks -> Array Int (RemotePtr CostCentre)
modBreaks_ccs :: !(Array BreakIndex (RemotePtr CostCentre))
, ModBreaks -> IntMap CgBreakInfo
modBreaks_breakInfo :: IntMap CgBreakInfo
}
seqModBreaks :: ModBreaks -> ()
seqModBreaks :: ModBreaks -> ()
seqModBreaks ModBreaks{Array Int [String]
Array Int [OccName]
Array Int (RemotePtr CostCentre)
Array Int SrcSpan
IntMap CgBreakInfo
ForeignRef BreakArray
modBreaks_breakInfo :: IntMap CgBreakInfo
modBreaks_ccs :: Array Int (RemotePtr CostCentre)
modBreaks_decls :: Array Int [String]
modBreaks_vars :: Array Int [OccName]
modBreaks_locs :: Array Int SrcSpan
modBreaks_flags :: ForeignRef BreakArray
modBreaks_breakInfo :: ModBreaks -> IntMap CgBreakInfo
modBreaks_ccs :: ModBreaks -> Array Int (RemotePtr CostCentre)
modBreaks_decls :: ModBreaks -> Array Int [String]
modBreaks_vars :: ModBreaks -> Array Int [OccName]
modBreaks_locs :: ModBreaks -> Array Int SrcSpan
modBreaks_flags :: ModBreaks -> ForeignRef BreakArray
..} =
ForeignRef BreakArray -> ()
forall a. NFData a => a -> ()
rnf ForeignRef BreakArray
modBreaks_flags () -> () -> ()
`seq`
Array Int SrcSpan -> ()
forall a. NFData a => a -> ()
rnf Array Int SrcSpan
modBreaks_locs () -> () -> ()
`seq`
Array Int [OccName] -> ()
forall a. NFData a => a -> ()
rnf Array Int [OccName]
modBreaks_vars () -> () -> ()
`seq`
Array Int [String] -> ()
forall a. NFData a => a -> ()
rnf Array Int [String]
modBreaks_decls () -> () -> ()
`seq`
Array Int (RemotePtr CostCentre) -> ()
forall a. NFData a => a -> ()
rnf Array Int (RemotePtr CostCentre)
modBreaks_ccs () -> () -> ()
`seq`
IntMap () -> ()
forall a. NFData a => a -> ()
rnf ((CgBreakInfo -> ()) -> IntMap CgBreakInfo -> IntMap ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CgBreakInfo -> ()
seqCgBreakInfo IntMap CgBreakInfo
modBreaks_breakInfo)
emptyModBreaks :: ModBreaks
emptyModBreaks :: ModBreaks
emptyModBreaks = ModBreaks :: ForeignRef BreakArray
-> Array Int SrcSpan
-> Array Int [OccName]
-> Array Int [String]
-> Array Int (RemotePtr CostCentre)
-> IntMap CgBreakInfo
-> ModBreaks
ModBreaks
{ modBreaks_flags :: ForeignRef BreakArray
modBreaks_flags = String -> ForeignRef BreakArray
forall a. HasCallStack => String -> a
error String
"ModBreaks.modBreaks_array not initialised"
, modBreaks_locs :: Array Int SrcSpan
modBreaks_locs = (Int, Int) -> [(Int, SrcSpan)] -> Array Int SrcSpan
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
0,-Int
1) []
, modBreaks_vars :: Array Int [OccName]
modBreaks_vars = (Int, Int) -> [(Int, [OccName])] -> Array Int [OccName]
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
0,-Int
1) []
, modBreaks_decls :: Array Int [String]
modBreaks_decls = (Int, Int) -> [(Int, [String])] -> Array Int [String]
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
0,-Int
1) []
, modBreaks_ccs :: Array Int (RemotePtr CostCentre)
modBreaks_ccs = (Int, Int)
-> [(Int, RemotePtr CostCentre)]
-> Array Int (RemotePtr CostCentre)
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
0,-Int
1) []
, modBreaks_breakInfo :: IntMap CgBreakInfo
modBreaks_breakInfo = IntMap CgBreakInfo
forall a. IntMap a
IntMap.empty
}