Add PlainPanic for throwing exceptions without depending on pprint
[ghc.git] / compiler / iface / BinFingerprint.hs
1 {-# LANGUAGE CPP #-}
2
3 -- | Computing fingerprints of values serializeable with GHC's "Binary" module.
4 module BinFingerprint
5 ( -- * Computing fingerprints
6 fingerprintBinMem
7 , computeFingerprint
8 , putNameLiterally
9 ) where
10
11 #include "HsVersions.h"
12
13 import GhcPrelude
14
15 import Fingerprint
16 import Binary
17 import Name
18 import PlainPanic
19 import Util
20
21 fingerprintBinMem :: BinHandle -> IO Fingerprint
22 fingerprintBinMem bh = withBinBuffer bh f
23 where
24 f bs =
25 -- we need to take care that we force the result here
26 -- lest a reference to the ByteString may leak out of
27 -- withBinBuffer.
28 let fp = fingerprintByteString bs
29 in fp `seq` return fp
30
31 computeFingerprint :: (Binary a)
32 => (BinHandle -> Name -> IO ())
33 -> a
34 -> IO Fingerprint
35 computeFingerprint put_nonbinding_name a = do
36 bh <- fmap set_user_data $ openBinMem (3*1024) -- just less than a block
37 put_ bh a
38 fp <- fingerprintBinMem bh
39 return fp
40 where
41 set_user_data bh =
42 setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS
43
44 -- | Used when we want to fingerprint a structure without depending on the
45 -- fingerprints of external Names that it refers to.
46 putNameLiterally :: BinHandle -> Name -> IO ()
47 putNameLiterally bh name = ASSERT( isExternalName name ) do
48 put_ bh $! nameModule name
49 put_ bh $! nameOccName name