    {-# LANGUAGE CPP #-}

    -- | Computing fingerprints of values serializeable with GHC's \"Binary\" module.
    module GHC.Iface.Recomp.Binary
      ( -- * Computing fingerprints
        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 =
            -- we need to take care that we force the result here
            -- lest a reference to the ByteString may leak out of
            -- withBinBuffer.
            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) -- just less than a block
        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

    -- | Used when we want to fingerprint a structure without depending on the
    -- fingerprints of external Names that it refers to.
    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