content: 
  
  -- | 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)
  import System.IO.Unsafe (unsafePerformIO)
  
  fingerprintBinMem :: WriteBinHandle -> IO Fingerprint
  fingerprintBinMem bh = withBinBuffer bh f
    where
      f 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 = fingerprintByteString bs
          in fp `seq` return fp
  
  computeFingerprint :: (Binary a)
                     => (WriteBinHandle -> Name -> IO ())
                     -> a
                     -> Fingerprint
  computeFingerprint put_nonbinding_name a = unsafePerformIO $ do
      bh <- fmap set_user_data $ openBinMem (3*1024) -- just less than a block
      put_ bh a
      fingerprintBinMem bh
    where
      set_user_data bh = setWriterUserData bh $ mkWriterUserData
        [ mkSomeBinaryWriter $ mkWriter putIfaceType
        , mkSomeBinaryWriter $ mkWriter put_nonbinding_name
        , mkSomeBinaryWriter $ simpleBindingNameWriter $ mkWriter putNameLiterally
        , mkSomeBinaryWriter $ mkWriter 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 bh name = assert (isExternalName name) $ do
      put_ bh $! nameModule name
      put_ bh $! nameOccName name
  