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 Data.Word
  26 import Numeric          ( readHex )
  27
  28 -- Using 128-bit MD5 fingerprints for now.
  29
  30 data Fingerprint = Fingerprint {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
  31   deriving (Eq, Ord)
  32         -- or ByteString?
  33
  34 fingerprint0 :: Fingerprint
  35 fingerprint0 = Fingerprint 0 0
  36
  37 instance Outputable Fingerprint where
  38   ppr (Fingerprint w1 w2) = text (printf "%016x%016x" w1 w2)
  39
  40 -- useful for parsing the output of 'md5sum', should we want to do that.
  41 readHexFingerprint :: String -> Fingerprint
  42 readHexFingerprint s = Fingerprint w1 w2
  43  where (s1,s2) = splitAt 16 s
  44        [(w1,"")] = readHex s1
  45        [(w2,"")] = readHex (take 16 s2)
  46
  47 peekFingerprint :: Ptr Word8 -> IO Fingerprint
  48 peekFingerprint p = do
  49       let peekW64 :: Ptr Word8 -> Int -> Word64 -> IO Word64
  50           STRICT3(peekW64)
  51           peekW64 _ 0 i = return i
  52           peekW64 p n i = do
  53                 w8 <- peek p
  54                 peekW64 (p `plusPtr` 1) (n-1)
  55                     ((i `shiftL` 8) .|. fromIntegral w8)
  56
  57       high <- peekW64 p 8 0
  58       low  <- peekW64 (p `plusPtr` 8) 8 0
  59       return (Fingerprint high low)
  60
  61 fingerprintData :: Ptr Word8 -> Int -> IO Fingerprint
  62 fingerprintData buf len = do
  63   allocaBytes (#const sizeof(struct MD5Context)) $ \pctxt -> do
  64     c_MD5Init pctxt
  65     c_MD5Update pctxt buf (fromIntegral len)
  66     allocaBytes 16 $ \pdigest -> do
  67       c_MD5Final pdigest pctxt
  68       peekFingerprint (castPtr pdigest)
  69
  70 data MD5Context
  71
  72 foreign import ccall unsafe "MD5Init"
  73    c_MD5Init   :: Ptr MD5Context -> IO ()
  74 foreign import ccall unsafe "MD5Update"
  75    c_MD5Update :: Ptr MD5Context -> Ptr Word8 -> CInt -> IO ()
  76 foreign import ccall unsafe "MD5Final"
  77    c_MD5Final  :: Ptr Word8 -> Ptr MD5Context -> IO ()