module GHC.Linker.Types
( Loader (..)
, LoaderState (..)
, uninitializedLoader
, Linkable(..)
, Unlinked(..)
, SptEntry(..)
, isObjectLinkable
, linkableObjs
, isObject
, nameOfObject
, nameOfObject_maybe
, isInterpretable
, byteCodeOfObject
, LibrarySpec(..)
)
where
import GHC.Prelude
import GHC.Unit ( UnitId, Module, ModuleNameWithIsBoot )
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 )
import Data.Maybe
import qualified Data.Map as M
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 -> [LibrarySpec]
hs_objs_loaded :: ![LibrarySpec]
, LoaderState -> [LibrarySpec]
non_hs_objs_loaded :: ![LibrarySpec]
, LoaderState -> Map ModuleNameWithIsBoot [Linkable]
module_deps :: M.Map ModuleNameWithIsBoot [Linkable]
, 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_maybe :: Unlinked -> Maybe FilePath
nameOfObject_maybe :: Unlinked -> Maybe FilePath
nameOfObject_maybe (DotO FilePath
fn) = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fn
nameOfObject_maybe (DotA FilePath
fn) = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fn
nameOfObject_maybe (DotDLL FilePath
fn) = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fn
nameOfObject_maybe (BCOs {}) = Maybe FilePath
forall a. Maybe a
Nothing
nameOfObject :: Unlinked -> FilePath
nameOfObject :: Unlinked -> FilePath
nameOfObject Unlinked
o = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> SDoc -> FilePath
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"nameOfObject" (Unlinked -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unlinked
o)) (Unlinked -> Maybe FilePath
nameOfObject_maybe Unlinked
o)
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)
data LibrarySpec
= Objects [FilePath]
| Archive FilePath
| DLL String
| DLLPath FilePath
| Framework String
instance Outputable LibrarySpec where
ppr :: LibrarySpec -> SDoc
ppr (Objects [FilePath]
objs) = FilePath -> SDoc
text FilePath
"Objects" SDoc -> SDoc -> SDoc
<+> [FilePath] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [FilePath]
objs
ppr (Archive FilePath
a) = FilePath -> SDoc
text FilePath
"Archive" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
a
ppr (DLL FilePath
s) = FilePath -> SDoc
text FilePath
"DLL" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
s
ppr (DLLPath FilePath
f) = FilePath -> SDoc
text FilePath
"DLLPath" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
f
ppr (Framework FilePath
s) = FilePath -> SDoc
text FilePath
"Framework" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
s