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" i1 i2)
  39     where i1 = fromIntegral w1 :: Integer
  40           i2 = fromIntegral w2 :: Integer
  41           -- printf in GHC 6.4.2 didn't have Word64 instances
  42
  43 -- useful for parsing the output of 'md5sum', should we want to do that.
  44 readHexFingerprint :: String -> Fingerprint
  45 readHexFingerprint s = Fingerprint w1 w2
  46  where (s1,s2) = splitAt 16 s
  47        [(w1,"")] = readHex s1
  48        [(w2,"")] = readHex (take 16 s2)
  49
  50 peekFingerprint :: Ptr Word8 -> IO Fingerprint
  51 peekFingerprint p = do
  52       let peekW64 :: Ptr Word8 -> Int -> Word64 -> IO Word64
  53           STRICT3(peekW64)
  54           peekW64 _ 0 i = return i
  55           peekW64 p n i = do
  56                 w8 <- peek p
  57                 peekW64 (p `plusPtr` 1) (n-1)
  58                     ((i `shiftL` 8) .|. fromIntegral w8)
  59
  60       high <- peekW64 p 8 0
  61       low  <- peekW64 (p `plusPtr` 8) 8 0
  62       return (Fingerprint high low)
  63
  64 fingerprintData :: Ptr Word8 -> Int -> IO Fingerprint
  65 fingerprintData buf len = do
  66   allocaBytes (#const sizeof(struct MD5Context)) $ \pctxt -> do
  67     c_MD5Init pctxt
  68     c_MD5Update pctxt buf (fromIntegral len)
  69     allocaBytes 16 $ \pdigest -> do
  70       c_MD5Final pdigest pctxt
  71       peekFingerprint (castPtr pdigest)
  72
  73 data MD5Context
  74
  75 foreign import ccall unsafe "MD5Init"
  76    c_MD5Init   :: Ptr MD5Context -> IO ()
  77 foreign import ccall unsafe "MD5Update"
  78    c_MD5Update :: Ptr MD5Context -> Ptr Word8 -> CInt -> IO ()
  79 foreign import ccall unsafe "MD5Final"
  80    c_MD5Final  :: Ptr Word8 -> Ptr MD5Context -> IO ()