compiler/utils/Fingerprint.hsc

   1 -- ----------------------------------------------------------------------------
   2 --
   3 --  (c) The University of Glasgow 2006
   4 --
   5 -- Fingerprints for recompilation checking and ABI versioning.
   6 --
   7 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
   8 --
   9 -- ----------------------------------------------------------------------------
  10
  11 module Fingerprint (
  12         Fingerprint(..), fingerprint0,
  13         readHexFingerprint,
  14         fingerprintData
  15    ) where
  16
  17 #include "md5.h"
  18 ##include "HsVersions.h"
  19
  20 import Outputable
  21
  22 import Foreign
  23 import Foreign.C
  24 import Text.Printf
  25 import Numeric          ( readHex )
  26
  27 -- Using 128-bit MD5 fingerprints for now.
  28
  29 data Fingerprint = Fingerprint {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
  30   deriving (Eq, Ord)
  31         -- or ByteString?
  32
  33 fingerprint0 :: Fingerprint
  34 fingerprint0 = Fingerprint 0 0
  35
  36 instance Outputable Fingerprint where
  37   ppr (Fingerprint w1 w2) = text (printf "%016x%016x" i1 i2)
  38     where i1 = fromIntegral w1 :: Integer
  39           i2 = fromIntegral w2 :: Integer
  40           -- printf in GHC 6.4.2 didn't have Word64 instances
  41
  42 -- useful for parsing the output of 'md5sum', should we want to do that.
  43 readHexFingerprint :: String -> Fingerprint
  44 readHexFingerprint s = Fingerprint w1 w2
  45  where (s1,s2) = splitAt 16 s
  46        [(w1,"")] = readHex s1
  47        [(w2,"")] = readHex (take 16 s2)
  48
  49 peekFingerprint :: Ptr Word8 -> IO Fingerprint
  50 peekFingerprint p = do
  51       let peekW64 :: Ptr Word8 -> Int -> Word64 -> IO Word64
  52           STRICT3(peekW64)
  53           peekW64 _ 0 i = return i
  54           peekW64 p n i = do
  55                 w8 <- peek p
  56                 peekW64 (p `plusPtr` 1) (n-1)
  57                     ((i `shiftL` 8) .|. fromIntegral w8)
  58
  59       high <- peekW64 p 8 0
  60       low  <- peekW64 (p `plusPtr` 8) 8 0
  61       return (Fingerprint high low)
  62
  63 fingerprintData :: Ptr Word8 -> Int -> IO Fingerprint
  64 fingerprintData buf len = do
  65   allocaBytes (#const sizeof(struct MD5Context)) $ \pctxt -> do
  66     c_MD5Init pctxt
  67     c_MD5Update pctxt buf (fromIntegral len)
  68     allocaBytes 16 $ \pdigest -> do
  69       c_MD5Final pdigest pctxt
  70       peekFingerprint (castPtr pdigest)
  71
  72 data MD5Context
  73
  74 foreign import ccall unsafe "MD5Init"
  75    c_MD5Init   :: Ptr MD5Context -> IO ()
  76 foreign import ccall unsafe "MD5Update"
  77    c_MD5Update :: Ptr MD5Context -> Ptr Word8 -> CInt -> IO ()
  78 foreign import ccall unsafe "MD5Final"
  79    c_MD5Final  :: Ptr Word8 -> Ptr MD5Context -> IO ()