module GHC.Linker.Types
( Loader (..)
, LoaderState (..)
, uninitializedLoader
, Linkable(..)
, Unlinked(..)
, SptEntry(..)
, isObjectLinkable
, linkableObjs
, isObject
, nameOfObject
, isInterpretable
, byteCodeOfObject
)
where
import GHC.Prelude
import GHC.Unit ( UnitId, Module )
import GHC.ByteCode.Types ( ItblEnv, CompiledByteCode )
import GHC.Fingerprint.Type ( Fingerprint )
import GHCi.RemoteTypes ( ForeignHValue )
import GHC.Types.Var ( Id )
import GHC.Types.Name.Env ( NameEnv )
import GHC.Types.Name ( Name )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import Control.Concurrent.MVar
import Data.Time ( UTCTime )
newtype Loader = Loader { Loader -> MVar (Maybe LoaderState)
loader_state :: MVar (Maybe LoaderState) }
data LoaderState = LoaderState
{ LoaderState -> ClosureEnv
closure_env :: ClosureEnv
, LoaderState -> ItblEnv
itbl_env :: !ItblEnv
, LoaderState -> [Linkable]
bcos_loaded :: ![Linkable]
, LoaderState -> [Linkable]
objs_loaded :: ![Linkable]
, LoaderState -> [UnitId]
pkgs_loaded :: ![UnitId]
, LoaderState -> [(FilePath, FilePath)]
temp_sos :: ![(FilePath, String)]
}
uninitializedLoader :: IO Loader
uninitializedLoader :: IO Loader
uninitializedLoader = MVar (Maybe LoaderState) -> Loader
Loader (MVar (Maybe LoaderState) -> Loader)
-> IO (MVar (Maybe LoaderState)) -> IO Loader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LoaderState -> IO (MVar (Maybe LoaderState))
forall a. a -> IO (MVar a)
newMVar Maybe LoaderState
forall a. Maybe a
Nothing
type ClosureEnv = NameEnv (Name, ForeignHValue)
data Linkable = LM {
Linkable -> UTCTime
linkableTime :: UTCTime,
Linkable -> Module
linkableModule :: Module,
Linkable -> [Unlinked]
linkableUnlinked :: [Unlinked]
}
instance Outputable Linkable where
ppr :: Linkable -> SDoc
ppr (LM UTCTime
when_made Module
mod [Unlinked]
unlinkeds)
= (FilePath -> SDoc
text FilePath
"LinkableM" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (FilePath -> SDoc
text (UTCTime -> FilePath
forall a. Show a => a -> FilePath
show UTCTime
when_made)) SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)
SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
3 ([Unlinked] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Unlinked]
unlinkeds)
data Unlinked
= DotO FilePath
| DotA FilePath
| DotDLL FilePath
| BCOs CompiledByteCode
[SptEntry]
instance Outputable Unlinked where
ppr :: Unlinked -> SDoc
ppr (DotO FilePath
path) = FilePath -> SDoc
text FilePath
"DotO" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
path
ppr (DotA FilePath
path) = FilePath -> SDoc
text FilePath
"DotA" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
path
ppr (DotDLL FilePath
path) = FilePath -> SDoc
text FilePath
"DotDLL" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
path
ppr (BCOs CompiledByteCode
bcos [SptEntry]
spt) = FilePath -> SDoc
text FilePath
"BCOs" SDoc -> SDoc -> SDoc
<+> CompiledByteCode -> SDoc
forall a. Outputable a => a -> SDoc
ppr CompiledByteCode
bcos SDoc -> SDoc -> SDoc
<+> [SptEntry] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [SptEntry]
spt
data SptEntry = SptEntry Id Fingerprint
instance Outputable SptEntry where
ppr :: SptEntry -> SDoc
ppr (SptEntry Id
id Fingerprint
fpr) = Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
fpr
isObjectLinkable :: Linkable -> Bool
isObjectLinkable :: Linkable -> Bool
isObjectLinkable Linkable
l = Bool -> Bool
not ([Unlinked] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Unlinked]
unlinked) Bool -> Bool -> Bool
&& (Unlinked -> Bool) -> [Unlinked] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Unlinked -> Bool
isObject [Unlinked]
unlinked
where unlinked :: [Unlinked]
unlinked = Linkable -> [Unlinked]
linkableUnlinked Linkable
l
linkableObjs :: Linkable -> [FilePath]
linkableObjs :: Linkable -> [FilePath]
linkableObjs Linkable
l = [ FilePath
f | DotO FilePath
f <- Linkable -> [Unlinked]
linkableUnlinked Linkable
l ]
isObject :: Unlinked -> Bool
isObject :: Unlinked -> Bool
isObject (DotO FilePath
_) = Bool
True
isObject (DotA FilePath
_) = Bool
True
isObject (DotDLL FilePath
_) = Bool
True
isObject Unlinked
_ = Bool
False
isInterpretable :: Unlinked -> Bool
isInterpretable :: Unlinked -> Bool
isInterpretable = Bool -> Bool
not (Bool -> Bool) -> (Unlinked -> Bool) -> Unlinked -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unlinked -> Bool
isObject
nameOfObject :: Unlinked -> FilePath
nameOfObject :: Unlinked -> FilePath
nameOfObject (DotO FilePath
fn) = FilePath
fn
nameOfObject (DotA FilePath
fn) = FilePath
fn
nameOfObject (DotDLL FilePath
fn) = FilePath
fn
nameOfObject Unlinked
other = FilePath -> SDoc -> FilePath
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"nameOfObject" (Unlinked -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unlinked
other)
byteCodeOfObject :: Unlinked -> CompiledByteCode
byteCodeOfObject :: Unlinked -> CompiledByteCode
byteCodeOfObject (BCOs CompiledByteCode
bc [SptEntry]
_) = CompiledByteCode
bc
byteCodeOfObject Unlinked
other = FilePath -> SDoc -> CompiledByteCode
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"byteCodeOfObject" (Unlinked -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unlinked
other)