{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE DuplicateRecordFields #-}
module GHC.Unit.Module.WholeCoreBindings where
import GHC.Cmm.CLabel
import GHC.Driver.DynFlags (DynFlags (targetPlatform), initSDocContext)
import GHC.ForeignSrcLang (ForeignSrcLang (..))
import GHC.Iface.Syntax
import GHC.Prelude
import GHC.Types.ForeignStubs
import GHC.Unit.Module.Location
import GHC.Unit.Types (Module)
import GHC.Utils.Binary
import GHC.Utils.Error (debugTraceMsg)
import GHC.Utils.Logger (Logger)
import GHC.Utils.Outputable
import GHC.Utils.Panic (panic, pprPanic)
import GHC.Utils.TmpFs
import Control.DeepSeq (NFData (..))
import Data.Traversable (for)
import Data.Word (Word8)
import Data.Maybe (fromMaybe)
import System.FilePath (takeExtension)
data WholeCoreBindings = WholeCoreBindings
{ WholeCoreBindings -> [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
wcb_bindings :: [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
, WholeCoreBindings -> Module
wcb_module :: Module
, WholeCoreBindings -> ModLocation
wcb_mod_location :: ModLocation
, WholeCoreBindings -> IfaceForeign
wcb_foreign :: IfaceForeign
}
newtype IfaceCLabel = IfaceCLabel CStubLabel
instance Binary IfaceCLabel where
get :: ReadBinHandle -> IO IfaceCLabel
get ReadBinHandle
bh = do
csl_is_initializer <- ReadBinHandle -> IO Bool
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
csl_module <- get bh
csl_name <- get bh
pure (IfaceCLabel CStubLabel {csl_is_initializer, csl_module, csl_name})
put_ :: WriteBinHandle -> IfaceCLabel -> IO ()
put_ WriteBinHandle
bh (IfaceCLabel CStubLabel {Bool
csl_is_initializer :: CStubLabel -> Bool
csl_is_initializer :: Bool
csl_is_initializer, Module
csl_module :: CStubLabel -> Module
csl_module :: Module
csl_module, FastString
csl_name :: CStubLabel -> FastString
csl_name :: FastString
csl_name}) = do
WriteBinHandle -> Bool -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Bool
csl_is_initializer
WriteBinHandle -> Module -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Module
csl_module
WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FastString
csl_name
instance NFData IfaceCLabel where
rnf :: IfaceCLabel -> ()
rnf (IfaceCLabel CStubLabel {Bool
csl_is_initializer :: CStubLabel -> Bool
csl_is_initializer :: Bool
csl_is_initializer, Module
csl_module :: CStubLabel -> Module
csl_module :: Module
csl_module, FastString
csl_name :: CStubLabel -> FastString
csl_name :: FastString
csl_name}) =
Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
csl_is_initializer () -> () -> ()
forall a b. a -> b -> b
`seq` Module -> ()
forall a. NFData a => a -> ()
rnf Module
csl_module () -> () -> ()
forall a b. a -> b -> b
`seq` FastString -> ()
forall a. NFData a => a -> ()
rnf FastString
csl_name
instance Outputable IfaceCLabel where
ppr :: IfaceCLabel -> SDoc
ppr (IfaceCLabel CStubLabel
l) = CStubLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CStubLabel
l
data IfaceCStubs =
IfaceCStubs {
:: String,
IfaceCStubs -> String
source :: String,
IfaceCStubs -> [IfaceCLabel]
initializers :: [IfaceCLabel],
IfaceCStubs -> [IfaceCLabel]
finalizers :: [IfaceCLabel]
}
instance Outputable IfaceCStubs where
ppr :: IfaceCStubs -> SDoc
ppr IfaceCStubs {String
header :: IfaceCStubs -> String
header :: String
header, String
source :: IfaceCStubs -> String
source :: String
source, [IfaceCLabel]
initializers :: IfaceCStubs -> [IfaceCLabel]
initializers :: [IfaceCLabel]
initializers, [IfaceCLabel]
finalizers :: IfaceCStubs -> [IfaceCLabel]
finalizers :: [IfaceCLabel]
finalizers} =
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"header:") Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> [String] -> [SDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
lines String
header)),
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"source:") Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> [String] -> [SDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
lines String
source)),
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"initializers:") Int
2 ([IfaceCLabel] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfaceCLabel]
initializers),
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"finalizers:") Int
2 ([IfaceCLabel] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfaceCLabel]
finalizers)
]
binary_put_ForeignSrcLang :: WriteBinHandle -> ForeignSrcLang -> IO ()
binary_put_ForeignSrcLang :: WriteBinHandle -> ForeignSrcLang -> IO ()
binary_put_ForeignSrcLang WriteBinHandle
bh ForeignSrcLang
lang =
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ @Word8 WriteBinHandle
bh (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ case ForeignSrcLang
lang of
ForeignSrcLang
LangC -> Word8
0
ForeignSrcLang
LangCxx -> Word8
1
ForeignSrcLang
LangObjc -> Word8
2
ForeignSrcLang
LangObjcxx -> Word8
3
ForeignSrcLang
LangAsm -> Word8
4
ForeignSrcLang
LangJs -> Word8
5
ForeignSrcLang
RawObject -> Word8
6
binary_get_ForeignSrcLang :: ReadBinHandle -> IO ForeignSrcLang
binary_get_ForeignSrcLang :: ReadBinHandle -> IO ForeignSrcLang
binary_get_ForeignSrcLang ReadBinHandle
bh = do
b <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
pure $ case b of
Word8
0 -> ForeignSrcLang
LangC
Word8
1 -> ForeignSrcLang
LangCxx
Word8
2 -> ForeignSrcLang
LangObjc
Word8
3 -> ForeignSrcLang
LangObjcxx
Word8
4 -> ForeignSrcLang
LangAsm
Word8
5 -> ForeignSrcLang
LangJs
Word8
6 -> ForeignSrcLang
RawObject
Word8
_ -> String -> ForeignSrcLang
forall a. HasCallStack => String -> a
panic String
"invalid Binary value for ForeignSrcLang"
instance Binary IfaceCStubs where
get :: ReadBinHandle -> IO IfaceCStubs
get ReadBinHandle
bh = do
header <- ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
source <- get bh
initializers <- get bh
finalizers <- get bh
pure IfaceCStubs {..}
put_ :: WriteBinHandle -> IfaceCStubs -> IO ()
put_ WriteBinHandle
bh IfaceCStubs {String
[IfaceCLabel]
header :: IfaceCStubs -> String
source :: IfaceCStubs -> String
initializers :: IfaceCStubs -> [IfaceCLabel]
finalizers :: IfaceCStubs -> [IfaceCLabel]
header :: String
source :: String
initializers :: [IfaceCLabel]
finalizers :: [IfaceCLabel]
..} = do
WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh String
header
WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh String
source
WriteBinHandle -> [IfaceCLabel] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [IfaceCLabel]
initializers
WriteBinHandle -> [IfaceCLabel] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [IfaceCLabel]
finalizers
instance NFData IfaceCStubs where
rnf :: IfaceCStubs -> ()
rnf IfaceCStubs {String
[IfaceCLabel]
header :: IfaceCStubs -> String
source :: IfaceCStubs -> String
initializers :: IfaceCStubs -> [IfaceCLabel]
finalizers :: IfaceCStubs -> [IfaceCLabel]
header :: String
source :: String
initializers :: [IfaceCLabel]
finalizers :: [IfaceCLabel]
..} =
String -> ()
forall a. NFData a => a -> ()
rnf String
header
() -> () -> ()
forall a b. a -> b -> b
`seq`
String -> ()
forall a. NFData a => a -> ()
rnf String
source
() -> () -> ()
forall a b. a -> b -> b
`seq`
[IfaceCLabel] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCLabel]
initializers
() -> () -> ()
forall a b. a -> b -> b
`seq`
[IfaceCLabel] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCLabel]
finalizers
data IfaceForeignFile =
IfaceForeignFile {
IfaceForeignFile -> ForeignSrcLang
lang :: ForeignSrcLang,
IfaceForeignFile -> String
source :: String,
IfaceForeignFile -> String
extension :: FilePath
}
instance Outputable IfaceForeignFile where
ppr :: IfaceForeignFile -> SDoc
ppr IfaceForeignFile {ForeignSrcLang
lang :: IfaceForeignFile -> ForeignSrcLang
lang :: ForeignSrcLang
lang, String
source :: IfaceForeignFile -> String
source :: String
source} =
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text (ForeignSrcLang -> String
forall a. Show a => a -> String
show ForeignSrcLang
lang) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon) Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> [String] -> [SDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
lines String
source))
instance Binary IfaceForeignFile where
get :: ReadBinHandle -> IO IfaceForeignFile
get ReadBinHandle
bh = do
lang <- ReadBinHandle -> IO ForeignSrcLang
binary_get_ForeignSrcLang ReadBinHandle
bh
source <- get bh
extension <- get bh
pure IfaceForeignFile {lang, source, extension}
put_ :: WriteBinHandle -> IfaceForeignFile -> IO ()
put_ WriteBinHandle
bh IfaceForeignFile {ForeignSrcLang
lang :: IfaceForeignFile -> ForeignSrcLang
lang :: ForeignSrcLang
lang, String
source :: IfaceForeignFile -> String
source :: String
source, String
extension :: IfaceForeignFile -> String
extension :: String
extension} = do
WriteBinHandle -> ForeignSrcLang -> IO ()
binary_put_ForeignSrcLang WriteBinHandle
bh ForeignSrcLang
lang
WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh String
source
WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh String
extension
instance NFData IfaceForeignFile where
rnf :: IfaceForeignFile -> ()
rnf IfaceForeignFile {ForeignSrcLang
lang :: IfaceForeignFile -> ForeignSrcLang
lang :: ForeignSrcLang
lang, String
source :: IfaceForeignFile -> String
source :: String
source, String
extension :: IfaceForeignFile -> String
extension :: String
extension} =
ForeignSrcLang
lang ForeignSrcLang -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
source () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
extension
data IfaceForeign =
IfaceForeign {
IfaceForeign -> Maybe IfaceCStubs
stubs :: Maybe IfaceCStubs,
IfaceForeign -> [IfaceForeignFile]
files :: [IfaceForeignFile]
}
instance Outputable IfaceForeign where
ppr :: IfaceForeign -> SDoc
ppr IfaceForeign {Maybe IfaceCStubs
stubs :: IfaceForeign -> Maybe IfaceCStubs
stubs :: Maybe IfaceCStubs
stubs, [IfaceForeignFile]
files :: IfaceForeign -> [IfaceForeignFile]
files :: [IfaceForeignFile]
files} =
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"stubs:") Int
2 (SDoc -> (IfaceCStubs -> SDoc) -> Maybe IfaceCStubs -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"empty") IfaceCStubs -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe IfaceCStubs
stubs) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (IfaceForeignFile -> SDoc
forall a. Outputable a => a -> SDoc
ppr (IfaceForeignFile -> SDoc) -> [IfaceForeignFile] -> [SDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IfaceForeignFile]
files)
emptyIfaceForeign :: IfaceForeign
emptyIfaceForeign :: IfaceForeign
emptyIfaceForeign = IfaceForeign {stubs :: Maybe IfaceCStubs
stubs = Maybe IfaceCStubs
forall a. Maybe a
Nothing, files :: [IfaceForeignFile]
files = []}
encodeIfaceForeign ::
Logger ->
DynFlags ->
ForeignStubs ->
[(ForeignSrcLang, FilePath)] ->
IO IfaceForeign
encodeIfaceForeign :: Logger
-> DynFlags
-> ForeignStubs
-> [(ForeignSrcLang, String)]
-> IO IfaceForeign
encodeIfaceForeign Logger
logger DynFlags
dflags ForeignStubs
foreign_stubs [(ForeignSrcLang, String)]
lang_paths = do
files <- IO [IfaceForeignFile]
read_foreign_files
stubs <- encode_stubs foreign_stubs
let iff = IfaceForeign {Maybe IfaceCStubs
stubs :: Maybe IfaceCStubs
stubs :: Maybe IfaceCStubs
stubs, [IfaceForeignFile]
files :: [IfaceForeignFile]
files :: [IfaceForeignFile]
files}
debugTraceMsg logger 3 $
hang (text "Encoding foreign data for iface:") 2 (ppr iff)
pure iff
where
read_foreign_files :: IO [IfaceForeignFile]
read_foreign_files =
[(ForeignSrcLang, String)]
-> ((ForeignSrcLang, String) -> IO IfaceForeignFile)
-> IO [IfaceForeignFile]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(ForeignSrcLang, String)]
lang_paths (((ForeignSrcLang, String) -> IO IfaceForeignFile)
-> IO [IfaceForeignFile])
-> ((ForeignSrcLang, String) -> IO IfaceForeignFile)
-> IO [IfaceForeignFile]
forall a b. (a -> b) -> a -> b
$ \ (ForeignSrcLang
lang, String
path) -> do
source <- String -> IO String
readFile String
path
pure IfaceForeignFile {lang, source, extension = takeExtension path}
encode_stubs :: ForeignStubs -> IO (Maybe IfaceCStubs)
encode_stubs = \case
ForeignStubs
NoStubs ->
Maybe IfaceCStubs -> IO (Maybe IfaceCStubs)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe IfaceCStubs
forall a. Maybe a
Nothing
ForeignStubs (CHeader SDoc
header) (CStub SDoc
source [CLabel]
inits [CLabel]
finals) ->
Maybe IfaceCStubs -> IO (Maybe IfaceCStubs)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe IfaceCStubs -> IO (Maybe IfaceCStubs))
-> Maybe IfaceCStubs -> IO (Maybe IfaceCStubs)
forall a b. (a -> b) -> a -> b
$ IfaceCStubs -> Maybe IfaceCStubs
forall a. a -> Maybe a
Just IfaceCStubs {
header :: String
header = SDoc -> String
render SDoc
header,
source :: String
source = SDoc -> String
render SDoc
source,
initializers :: [IfaceCLabel]
initializers = CLabel -> IfaceCLabel
encode_label (CLabel -> IfaceCLabel) -> [CLabel] -> [IfaceCLabel]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CLabel]
inits,
finalizers :: [IfaceCLabel]
finalizers = CLabel -> IfaceCLabel
encode_label (CLabel -> IfaceCLabel) -> [CLabel] -> [IfaceCLabel]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CLabel]
finals
}
encode_label :: CLabel -> IfaceCLabel
encode_label CLabel
clabel =
IfaceCLabel -> Maybe IfaceCLabel -> IfaceCLabel
forall a. a -> Maybe a -> a
fromMaybe (CLabel -> IfaceCLabel
invalid_label CLabel
clabel) (CStubLabel -> IfaceCLabel
IfaceCLabel (CStubLabel -> IfaceCLabel)
-> Maybe CStubLabel -> Maybe IfaceCLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel -> Maybe CStubLabel
cStubLabel CLabel
clabel)
invalid_label :: CLabel -> IfaceCLabel
invalid_label CLabel
clabel =
String -> SDoc -> IfaceCLabel
forall a. HasCallStack => String -> SDoc -> a
pprPanic
String
"-fwrite-if-simplified-core is incompatible with this foreign stub:"
(Platform -> CLabel -> SDoc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel (DynFlags -> Platform
targetPlatform DynFlags
dflags) CLabel
clabel)
render :: SDoc -> String
render = SDocContext -> SDoc -> String
renderWithContext (DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
dflags PprStyle
PprCode)
decodeIfaceForeign ::
Logger ->
TmpFs ->
TempDir ->
IfaceForeign ->
IO (ForeignStubs, [(ForeignSrcLang, FilePath)])
decodeIfaceForeign :: Logger
-> TmpFs
-> TempDir
-> IfaceForeign
-> IO (ForeignStubs, [(ForeignSrcLang, String)])
decodeIfaceForeign Logger
logger TmpFs
tmpfs TempDir
tmp_dir iff :: IfaceForeign
iff@IfaceForeign {Maybe IfaceCStubs
stubs :: IfaceForeign -> Maybe IfaceCStubs
stubs :: Maybe IfaceCStubs
stubs, [IfaceForeignFile]
files :: IfaceForeign -> [IfaceForeignFile]
files :: [IfaceForeignFile]
files} = do
Logger -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger Int
3 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Decoding foreign data from iface:") Int
2 (IfaceForeign -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceForeign
iff)
lang_paths <- [IfaceForeignFile]
-> (IfaceForeignFile -> IO (ForeignSrcLang, String))
-> IO [(ForeignSrcLang, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [IfaceForeignFile]
files ((IfaceForeignFile -> IO (ForeignSrcLang, String))
-> IO [(ForeignSrcLang, String)])
-> (IfaceForeignFile -> IO (ForeignSrcLang, String))
-> IO [(ForeignSrcLang, String)]
forall a b. (a -> b) -> a -> b
$ \ IfaceForeignFile {ForeignSrcLang
lang :: IfaceForeignFile -> ForeignSrcLang
lang :: ForeignSrcLang
lang, String
source :: IfaceForeignFile -> String
source :: String
source, String
extension :: IfaceForeignFile -> String
extension :: String
extension} -> do
f <- Logger
-> TmpFs -> TempDir -> TempFileLifetime -> String -> IO String
newTempName Logger
logger TmpFs
tmpfs TempDir
tmp_dir TempFileLifetime
TFL_GhcSession String
extension
writeFile f source
pure (lang, f)
pure (maybe NoStubs decode_stubs stubs, lang_paths)
where
decode_stubs :: IfaceCStubs -> ForeignStubs
decode_stubs IfaceCStubs {String
header :: IfaceCStubs -> String
header :: String
header, String
source :: IfaceCStubs -> String
source :: String
source, [IfaceCLabel]
initializers :: IfaceCStubs -> [IfaceCLabel]
initializers :: [IfaceCLabel]
initializers, [IfaceCLabel]
finalizers :: IfaceCStubs -> [IfaceCLabel]
finalizers :: [IfaceCLabel]
finalizers} =
CHeader -> CStub -> ForeignStubs
ForeignStubs
(SDoc -> CHeader
CHeader (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
header))
(SDoc -> [CLabel] -> [CLabel] -> CStub
CStub (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
source) ([IfaceCLabel] -> [CLabel]
labels [IfaceCLabel]
initializers) ([IfaceCLabel] -> [CLabel]
labels [IfaceCLabel]
finalizers))
labels :: [IfaceCLabel] -> [CLabel]
labels [IfaceCLabel]
ls = [CStubLabel -> CLabel
fromCStubLabel CStubLabel
l | IfaceCLabel CStubLabel
l <- [IfaceCLabel]
ls]
instance Binary IfaceForeign where
get :: ReadBinHandle -> IO IfaceForeign
get ReadBinHandle
bh = do
stubs <- ReadBinHandle -> IO (Maybe IfaceCStubs)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
files <- get bh
pure IfaceForeign {stubs, files}
put_ :: WriteBinHandle -> IfaceForeign -> IO ()
put_ WriteBinHandle
bh IfaceForeign {Maybe IfaceCStubs
stubs :: IfaceForeign -> Maybe IfaceCStubs
stubs :: Maybe IfaceCStubs
stubs, [IfaceForeignFile]
files :: IfaceForeign -> [IfaceForeignFile]
files :: [IfaceForeignFile]
files} = do
WriteBinHandle -> Maybe IfaceCStubs -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe IfaceCStubs
stubs
WriteBinHandle -> [IfaceForeignFile] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [IfaceForeignFile]
files
instance NFData IfaceForeign where
rnf :: IfaceForeign -> ()
rnf IfaceForeign {Maybe IfaceCStubs
stubs :: IfaceForeign -> Maybe IfaceCStubs
stubs :: Maybe IfaceCStubs
stubs, [IfaceForeignFile]
files :: IfaceForeign -> [IfaceForeignFile]
files :: [IfaceForeignFile]
files} = Maybe IfaceCStubs -> ()
forall a. NFData a => a -> ()
rnf Maybe IfaceCStubs
stubs () -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceForeignFile] -> ()
forall a. NFData a => a -> ()
rnf [IfaceForeignFile]
files