Use MD5 checksums for recompilation checking (fixes #1372, #1959)

[ghc-hetmet.git] / compiler / utils / Fingerprint.hsc

diff --git a/compiler/utils/Fingerprint.hsc b/compiler/utils/Fingerprint.hsc
new file mode 100644 (file)
index 0000000..d5a2409
--- /dev/null
+++ b/compiler/utils/Fingerprint.hsc
@@ -0,0 +1,77 @@
+-- ----------------------------------------------------------------------------
+-- 
+--  (c) The University of Glasgow 2006
+--
+-- Fingerprints for recompilation checking and ABI versioning.
+--
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
+--
+-- ----------------------------------------------------------------------------
+
+module Fingerprint (
+        Fingerprint(..), fingerprint0, 
+        readHexFingerprint,
+        fingerprintData
+   ) where
+
+#include "md5.h"
+##include "HsVersions.h"
+
+import Outputable
+
+import Foreign
+import Foreign.C
+import Text.Printf
+import Data.Word
+import Numeric          ( readHex )
+
+-- Using 128-bit MD5 fingerprints for now.
+
+data Fingerprint = Fingerprint {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
+  deriving (Eq, Ord)
+        -- or ByteString?
+
+fingerprint0 :: Fingerprint
+fingerprint0 = Fingerprint 0 0
+
+instance Outputable Fingerprint where
+  ppr (Fingerprint w1 w2) = text (printf "%016x%016x" w1 w2)
+
+-- useful for parsing the output of 'md5sum', should we want to do that.
+readHexFingerprint :: String -> Fingerprint
+readHexFingerprint s = Fingerprint w1 w2
+ where (s1,s2) = splitAt 16 s
+       [(w1,"")] = readHex s1
+       [(w2,"")] = readHex (take 16 s2)
+
+peekFingerprint :: Ptr Word8 -> IO Fingerprint
+peekFingerprint p = do
+      let peekW64 :: Ptr Word8 -> Int -> Word64 -> IO Word64
+          STRICT3(peekW64)
+          peekW64 _ 0 i = return i
+          peekW64 p n i = do 
+                w8 <- peek p
+                peekW64 (p `plusPtr` 1) (n-1) 
+                    ((i `shiftL` 8) .|. fromIntegral w8)
+
+      high <- peekW64 p 8 0
+      low  <- peekW64 (p `plusPtr` 8) 8 0
+      return (Fingerprint high low)
+
+fingerprintData :: Ptr Word8 -> Int -> IO Fingerprint
+fingerprintData buf len = do
+  allocaBytes (#const sizeof(struct MD5Context)) $ \pctxt -> do
+    c_MD5Init pctxt
+    c_MD5Update pctxt buf (fromIntegral len)
+    allocaBytes 16 $ \pdigest -> do
+      c_MD5Final pdigest pctxt
+      peekFingerprint (castPtr pdigest)
+
+data MD5Context
+
+foreign import ccall unsafe "MD5Init"
+   c_MD5Init   :: Ptr MD5Context -> IO ()
+foreign import ccall unsafe "MD5Update"
+   c_MD5Update :: Ptr MD5Context -> Ptr Word8 -> CInt -> IO ()
+foreign import ccall unsafe "MD5Final"
+   c_MD5Final  :: Ptr Word8 -> Ptr MD5Context -> IO ()