{-# LANGUAGE CPP #-}
module GHC.Iface.Recomp.Binary
(
fingerprintBinMem
, computeFingerprint
, putNameLiterally
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Utils.Fingerprint
import GHC.Utils.Binary
import GHC.Types.Name
import GHC.Utils.Panic.Plain
import GHC.Utils.Misc
fingerprintBinMem :: BinHandle -> IO Fingerprint
fingerprintBinMem :: BinHandle -> IO Fingerprint
fingerprintBinMem BinHandle
bh = BinHandle -> (ByteString -> IO Fingerprint) -> IO Fingerprint
forall a. BinHandle -> (ByteString -> IO a) -> IO a
withBinBuffer BinHandle
bh ByteString -> IO Fingerprint
forall {m :: * -> *}. Monad m => ByteString -> m Fingerprint
f
where
f :: ByteString -> m Fingerprint
f ByteString
bs =
let fp :: Fingerprint
fp = ByteString -> Fingerprint
fingerprintByteString ByteString
bs
in Fingerprint
fp Fingerprint -> m Fingerprint -> m Fingerprint
`seq` Fingerprint -> m Fingerprint
forall (m :: * -> *) a. Monad m => a -> m a
return Fingerprint
fp
computeFingerprint :: (Binary a)
=> (BinHandle -> Name -> IO ())
-> a
-> IO Fingerprint
computeFingerprint :: forall a.
Binary a =>
(BinHandle -> Name -> IO ()) -> a -> IO Fingerprint
computeFingerprint BinHandle -> Name -> IO ()
put_nonbinding_name a
a = do
BinHandle
bh <- (BinHandle -> BinHandle) -> IO BinHandle -> IO BinHandle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BinHandle -> BinHandle
set_user_data (IO BinHandle -> IO BinHandle) -> IO BinHandle -> IO BinHandle
forall a b. (a -> b) -> a -> b
$ Int -> IO BinHandle
openBinMem (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
1024)
BinHandle -> a -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
a
BinHandle -> IO Fingerprint
fingerprintBinMem BinHandle
bh
where
set_user_data :: BinHandle -> BinHandle
set_user_data BinHandle
bh =
BinHandle -> UserData -> BinHandle
setUserData BinHandle
bh (UserData -> BinHandle) -> UserData -> BinHandle
forall a b. (a -> b) -> a -> b
$ (BinHandle -> Name -> IO ())
-> (BinHandle -> Name -> IO ())
-> (BinHandle -> FastString -> IO ())
-> UserData
newWriteState BinHandle -> Name -> IO ()
put_nonbinding_name BinHandle -> Name -> IO ()
putNameLiterally BinHandle -> FastString -> IO ()
putFS
putNameLiterally :: BinHandle -> Name -> IO ()
putNameLiterally :: BinHandle -> Name -> IO ()
putNameLiterally BinHandle
bh Name
name = ASSERT( isExternalName name ) do
put_ bh $! nameModule name
put_ bh $! nameOccName name