fix warnings (including moving things around to avoid orphan
[packages/base.git] / GHC / Fingerprint.hs
1 {-# LANGUAGE NoImplicitPrelude
2 , BangPatterns
3 , ForeignFunctionInterface
4 , EmptyDataDecls
5 #-}
6 -- ----------------------------------------------------------------------------
7 --
8 -- (c) The University of Glasgow 2006
9 --
10 -- Fingerprints for recompilation checking and ABI versioning, and
11 -- implementing fast comparison of Typeable.
12 --
13 -- ----------------------------------------------------------------------------
14
15 module GHC.Fingerprint (
16 Fingerprint(..), fingerprint0,
17 fingerprintData,
18 fingerprintString,
19 fingerprintFingerprints
20 ) where
21
22 import GHC.IO
23 import GHC.Base
24 import GHC.Num
25 import GHC.List
26 import GHC.Real
27 import Foreign
28 import Foreign.C
29 import GHC.IO.Encoding
30 import GHC.Foreign
31
32 import GHC.Fingerprint.Type
33
34 -- for SIZEOF_STRUCT_MD5CONTEXT:
35 #include "HsBaseConfig.h"
36
37 -- XXX instance Storable Fingerprint
38 -- defined in Foreign.Storable to avoid orphan instance
39
40 fingerprint0 :: Fingerprint
41 fingerprint0 = Fingerprint 0 0
42
43 fingerprintFingerprints :: [Fingerprint] -> Fingerprint
44 fingerprintFingerprints fs = unsafeDupablePerformIO $
45 withArrayLen fs $ \len p -> do
46 fingerprintData (castPtr p) (len * sizeOf (head fs))
47
48 fingerprintData :: Ptr Word8 -> Int -> IO Fingerprint
49 fingerprintData buf len = do
50 allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \pctxt -> do
51 c_MD5Init pctxt
52 c_MD5Update pctxt buf (fromIntegral len)
53 allocaBytes 16 $ \pdigest -> do
54 c_MD5Final pdigest pctxt
55 peek (castPtr pdigest :: Ptr Fingerprint)
56
57 fingerprintString :: String -> Fingerprint
58 fingerprintString str = unsafeDupablePerformIO $
59 GHC.Foreign.withCStringLen utf8 str $ \(p,len) ->
60 fingerprintData (castPtr p) len
61
62 data MD5Context
63
64 foreign import ccall unsafe "MD5Init"
65 c_MD5Init :: Ptr MD5Context -> IO ()
66 foreign import ccall unsafe "MD5Update"
67 c_MD5Update :: Ptr MD5Context -> Ptr Word8 -> CInt -> IO ()
68 foreign import ccall unsafe "MD5Final"
69 c_MD5Final :: Ptr Word8 -> Ptr MD5Context -> IO ()