module GHC.Linker.Types
( Loader (..)
, LoaderState (..)
, uninitializedLoader
, modifyClosureEnv
, LinkerEnv(..)
, filterLinkerEnv
, ClosureEnv
, emptyClosureEnv
, extendClosureEnv
, Linkable(..)
, LinkableSet
, mkLinkableSet
, unionLinkableSet
, ObjFile
, Unlinked(..)
, SptEntry(..)
, isObjectLinkable
, linkableObjs
, isObject
, nameOfObject
, nameOfObject_maybe
, isInterpretable
, byteCodeOfObject
, LibrarySpec(..)
, LoadedPkgInfo(..)
, PkgsLoaded
)
where
import GHC.Prelude
import GHC.Unit ( UnitId, Module )
import GHC.ByteCode.Types ( ItblEnv, AddrEnv, CompiledByteCode )
import GHC.Fingerprint.Type ( Fingerprint )
import GHCi.RemoteTypes ( ForeignHValue )
import GHC.Types.Var ( Id )
import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnvList, filterNameEnv )
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 GHC.Unit.Module.Env
import GHC.Types.Unique.DSet
import GHC.Types.Unique.DFM
newtype Loader = Loader { loader_state :: MVar (Maybe LoaderState) }
data LoaderState = LoaderState
{ linker_env :: !LinkerEnv
, bcos_loaded :: !LinkableSet
, objs_loaded :: !LinkableSet
, pkgs_loaded :: !PkgsLoaded
, temp_sos :: ![(FilePath, String)]
}
uninitializedLoader :: IO Loader
uninitializedLoader = Loader <$> newMVar Nothing
modifyClosureEnv :: LoaderState -> (ClosureEnv -> ClosureEnv) -> LoaderState
modifyClosureEnv pls f =
let le = linker_env pls
ce = closure_env le
in pls { linker_env = le { closure_env = f ce } }
data LinkerEnv = LinkerEnv
{ closure_env :: !ClosureEnv
, itbl_env :: !ItblEnv
, addr_env :: !AddrEnv
}
filterLinkerEnv :: (Name -> Bool) -> LinkerEnv -> LinkerEnv
filterLinkerEnv f le = LinkerEnv
{ closure_env = filterNameEnv (f . fst) (closure_env le)
, itbl_env = filterNameEnv (f . fst) (itbl_env le)
, addr_env = filterNameEnv (f . fst) (addr_env le)
}
type ClosureEnv = NameEnv (Name, ForeignHValue)
emptyClosureEnv :: ClosureEnv
emptyClosureEnv = emptyNameEnv
extendClosureEnv :: ClosureEnv -> [(Name,ForeignHValue)] -> ClosureEnv
extendClosureEnv cl_env pairs
= extendNameEnvList cl_env [ (n, (n,v)) | (n,v) <- pairs]
type PkgsLoaded = UniqDFM UnitId LoadedPkgInfo
data LoadedPkgInfo
= LoadedPkgInfo
{ loaded_pkg_uid :: !UnitId
, loaded_pkg_hs_objs :: ![LibrarySpec]
, loaded_pkg_non_hs_objs :: ![LibrarySpec]
, loaded_pkg_trans_deps :: UniqDSet UnitId
}
instance Outputable LoadedPkgInfo where
ppr (LoadedPkgInfo uid hs_objs non_hs_objs trans_deps) =
vcat [ppr uid
, ppr hs_objs
, ppr non_hs_objs
, ppr trans_deps ]
data Linkable = LM {
linkableTime :: !UTCTime,
linkableModule :: !Module,
linkableUnlinked :: [Unlinked]
}
type LinkableSet = ModuleEnv Linkable
mkLinkableSet :: [Linkable] -> LinkableSet
mkLinkableSet ls = mkModuleEnv [(linkableModule l, l) | l <- ls]
unionLinkableSet :: LinkableSet -> LinkableSet -> LinkableSet
unionLinkableSet = plusModuleEnv_C go
where
go l1 l2
| linkableTime l1 > linkableTime l2 = l1
| otherwise = l2
instance Outputable Linkable where
ppr (LM when_made mod unlinkeds)
= (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod)
$$ nest 3 (ppr unlinkeds)
type ObjFile = FilePath
data Unlinked
= DotO ObjFile
| DotA FilePath
| DotDLL FilePath
| BCOs CompiledByteCode
[SptEntry]
instance Outputable Unlinked where
ppr (DotO path) = text "DotO" <+> text path
ppr (DotA path) = text "DotA" <+> text path
ppr (DotDLL path) = text "DotDLL" <+> text path
ppr (BCOs bcos spt) = text "BCOs" <+> ppr bcos <+> ppr spt
data SptEntry = SptEntry Id Fingerprint
instance Outputable SptEntry where
ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr
isObjectLinkable :: Linkable -> Bool
isObjectLinkable l = not (null unlinked) && all isObject unlinked
where unlinked = linkableUnlinked l
linkableObjs :: Linkable -> [FilePath]
linkableObjs l = [ f | DotO f <- linkableUnlinked l ]
isObject :: Unlinked -> Bool
isObject (DotO _) = True
isObject (DotA _) = True
isObject (DotDLL _) = True
isObject _ = False
isInterpretable :: Unlinked -> Bool
isInterpretable = not . isObject
nameOfObject_maybe :: Unlinked -> Maybe FilePath
nameOfObject_maybe (DotO fn) = Just fn
nameOfObject_maybe (DotA fn) = Just fn
nameOfObject_maybe (DotDLL fn) = Just fn
nameOfObject_maybe (BCOs {}) = Nothing
nameOfObject :: Unlinked -> FilePath
nameOfObject o = fromMaybe (pprPanic "nameOfObject" (ppr o)) (nameOfObject_maybe o)
byteCodeOfObject :: Unlinked -> CompiledByteCode
byteCodeOfObject (BCOs bc _) = bc
byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other)
data LibrarySpec
= Objects [FilePath]
| Archive FilePath
| DLL String
| DLLPath FilePath
| Framework String
instance Outputable LibrarySpec where
ppr (Objects objs) = text "Objects" <+> ppr objs
ppr (Archive a) = text "Archive" <+> text a
ppr (DLL s) = text "DLL" <+> text s
ppr (DLLPath f) = text "DLLPath" <+> text f
ppr (Framework s) = text "Framework" <+> text s