    -- | Computing fingerprints of values serializable with GHC's \"Binary\" module.
    module GHC.Iface.Recomp.Binary
      ( -- * Computing fingerprints
        fingerprintBinMem
      , computeFingerprint
      , putNameLiterally
      ) where

    import GHC.Prelude

    import GHC.Utils.Fingerprint
    import GHC.Utils.Binary
    import GHC.Types.Name
    import GHC.Utils.Panic.Plain
    import GHC.Iface.Type (putIfaceType)

    fingerprintBinMem :: WriteBinHandle -> IO Fingerprint
    fingerprintBinMem :: WriteBinHandle -> IO Fingerprint
    fingerprintBinMem WriteBinHandle
    bh = WriteBinHandle -> (ByteString -> IO Fingerprint) -> IO Fingerprint
    forall a. WriteBinHandle -> (ByteString -> IO a) -> IO a
    withBinBuffer WriteBinHandle
    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
    forall a b. a -> b -> b
    `seq` Fingerprint -> m Fingerprint
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Fingerprint
    fp

    computeFingerprint :: (Binary a)
                       => (WriteBinHandle -> Name -> IO ())
                       -> a
                       -> IO Fingerprint
    computeFingerprint :: forall a.
    Binary a =>
    (WriteBinHandle -> Name -> IO ()) -> a -> IO Fingerprint
    computeFingerprint WriteBinHandle -> Name -> IO ()
    put_nonbinding_name a
    a = do
        bh <- (WriteBinHandle -> WriteBinHandle)
    -> IO WriteBinHandle -> IO WriteBinHandle
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap WriteBinHandle -> WriteBinHandle
    set_user_data (IO WriteBinHandle -> IO WriteBinHandle)
    -> IO WriteBinHandle -> IO WriteBinHandle
    forall a b. (a -> b) -> a -> b
    $ Int -> IO WriteBinHandle
    openBinMem (Int
    3Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    1024) -- just less than a block
        put_ bh a
        fingerprintBinMem bh
      where
        set_user_data :: WriteBinHandle -> WriteBinHandle
    set_user_data WriteBinHandle
    bh = WriteBinHandle -> WriterUserData -> WriteBinHandle
    setWriterUserData WriteBinHandle
    bh (WriterUserData -> WriteBinHandle)
    -> WriterUserData -> WriteBinHandle
    forall a b. (a -> b) -> a -> b
    $ [SomeBinaryWriter] -> WriterUserData
    mkWriterUserData
          [ BinaryWriter IfaceType -> SomeBinaryWriter
    forall a. Typeable a => BinaryWriter a -> SomeBinaryWriter
    mkSomeBinaryWriter (BinaryWriter IfaceType -> SomeBinaryWriter)
    -> BinaryWriter IfaceType -> SomeBinaryWriter
    forall a b. (a -> b) -> a -> b
    $ (WriteBinHandle -> IfaceType -> IO ()) -> BinaryWriter IfaceType
    forall s. (WriteBinHandle -> s -> IO ()) -> BinaryWriter s
    mkWriter WriteBinHandle -> IfaceType -> IO ()
    putIfaceType
          , BinaryWriter Name -> SomeBinaryWriter
    forall a. Typeable a => BinaryWriter a -> SomeBinaryWriter
    mkSomeBinaryWriter (BinaryWriter Name -> SomeBinaryWriter)
    -> BinaryWriter Name -> SomeBinaryWriter
    forall a b. (a -> b) -> a -> b
    $ (WriteBinHandle -> Name -> IO ()) -> BinaryWriter Name
    forall s. (WriteBinHandle -> s -> IO ()) -> BinaryWriter s
    mkWriter WriteBinHandle -> Name -> IO ()
    put_nonbinding_name
          , BinaryWriter BindingName -> SomeBinaryWriter
    forall a. Typeable a => BinaryWriter a -> SomeBinaryWriter
    mkSomeBinaryWriter (BinaryWriter BindingName -> SomeBinaryWriter)
    -> BinaryWriter BindingName -> SomeBinaryWriter
    forall a b. (a -> b) -> a -> b
    $ BinaryWriter Name -> BinaryWriter BindingName
    simpleBindingNameWriter (BinaryWriter Name -> BinaryWriter BindingName)
    -> BinaryWriter Name -> BinaryWriter BindingName
    forall a b. (a -> b) -> a -> b
    $ (WriteBinHandle -> Name -> IO ()) -> BinaryWriter Name
    forall s. (WriteBinHandle -> s -> IO ()) -> BinaryWriter s
    mkWriter WriteBinHandle -> Name -> IO ()
    putNameLiterally
          , BinaryWriter FastString -> SomeBinaryWriter
    forall a. Typeable a => BinaryWriter a -> SomeBinaryWriter
    mkSomeBinaryWriter (BinaryWriter FastString -> SomeBinaryWriter)
    -> BinaryWriter FastString -> SomeBinaryWriter
    forall a b. (a -> b) -> a -> b
    $ (WriteBinHandle -> FastString -> IO ()) -> BinaryWriter FastString
    forall s. (WriteBinHandle -> s -> IO ()) -> BinaryWriter s
    mkWriter WriteBinHandle -> FastString -> IO ()
    putFS
          ]

    -- | Used when we want to fingerprint a structure without depending on the
    -- fingerprints of external Names that it refers to.
    putNameLiterally :: WriteBinHandle -> Name -> IO ()
    putNameLiterally :: WriteBinHandle -> Name -> IO ()
    putNameLiterally WriteBinHandle
    bh Name
    name = Bool -> IO () -> IO ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Name -> Bool
    isExternalName Name
    name) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        WriteBinHandle -> Module -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh (Module -> IO ()) -> Module -> IO ()
    forall a b. (a -> b) -> a -> b
    $! HasDebugCallStack => Name -> Module
    Name -> Module
    nameModule Name
    name
        WriteBinHandle -> OccName -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh (OccName -> IO ()) -> OccName -> IO ()
    forall a b. (a -> b) -> a -> b
    $! Name -> OccName
    nameOccName Name
    name