module BinFingerprint
(
fingerprintBinMem
, computeFingerprint
, putNameLiterally
) where
#include "HsVersions.h"
import GhcPrelude
import Fingerprint
import Binary
import Name
import Panic
import Util
fingerprintBinMem :: BinHandle -> IO Fingerprint
fingerprintBinMem bh = withBinBuffer bh f
where
f bs =
let fp = fingerprintByteString bs
in fp `seq` return fp
computeFingerprint :: (Binary a)
=> (BinHandle -> Name -> IO ())
-> a
-> IO Fingerprint
computeFingerprint put_nonbinding_name a = do
bh <- fmap set_user_data $ openBinMem (3*1024)
put_ bh a
fp <- fingerprintBinMem bh
return fp
where
set_user_data bh =
setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS
putNameLiterally :: BinHandle -> Name -> IO ()
putNameLiterally bh name = ASSERT( isExternalName name ) do
put_ bh $! nameModule name
put_ bh $! nameOccName name