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

This is a much more robust way to do recompilation checking.  The idea
is to create a fingerprint of the ABI of an interface, and track
dependencies by recording the fingerprints of ABIs that a module
depends on.  If any of those ABIs have changed, then we need to
recompile.

In bug #1372 we weren't recording dependencies on package modules,
this patch fixes that by recording fingerprints of package modules
that we depend on.  Within a package there is still fine-grained
recompilation avoidance as before.

We currently use MD5 for fingerprints, being a good compromise between
efficiency and security.  We're not worried about attackers, but we
are worried about accidental collisions.

All the MD5 sums do make interface files a bit bigger, but compile
times on the whole are about the same as before.  Recompilation
avoidance should be a bit more accurate than in 6.8.2 due to fixing
#1959, especially when using -O.

5 files changed, 441 insertions, 61 deletions

diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 2ebc856f58..076ae16640 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -20,11 +20,13 @@ module Binary
 --   closeBin,
 
    seekBin,
+   seekBy,
    tellBin,
    castBin,
 
    writeBinMem,
    readBinMem,
+   fingerprintBinMem,
 
    isEOFBin,
 
@@ -47,7 +49,7 @@ module Binary
 
    UserData(..), getUserData, setUserData,
    newReadState, newWriteState,
-   putDictionary, getDictionary,
+   putDictionary, getDictionary, putFS,
   ) where
 
 #include "HsVersions.h"
@@ -57,21 +59,19 @@ module Binary
 
 import {-# SOURCE #-} Name (Name)
 import FastString
-import Unique
 import Panic
 import UniqFM
 import FastMutInt
 import Util
+import Fingerprint
 
 import Foreign
-import Data.Array.IO
 import Data.Array
 import Data.Bits
 import Data.Int
 import Data.Word
 import Data.IORef
 import Data.Char                ( ord, chr )
-import Data.Array.Base          ( unsafeRead, unsafeWrite )
 import Control.Monad            ( when )
 import System.IO as IO
 import System.IO.Unsafe         ( unsafeInterleaveIO )
@@ -92,7 +92,7 @@ import System.IO                ( openBinaryFile )
 openBinaryFile f mode = openFileEx f (BinaryMode mode)
 #endif
 
-type BinArray = IOUArray Int Word8
+type BinArray = ForeignPtr Word8
 
 ---------------------------------------------------------------
 -- BinHandle
@@ -168,7 +168,7 @@ openBinMem :: Int -> IO BinHandle
 openBinMem size
  | size <= 0 = error "Data.Binary.openBinMem: size must be >= 0"
  | otherwise = do
-   arr <- newArray_ (0,size-1)
+   arr <- mallocForeignPtrBytes size
    arr_r <- newIORef arr
    ix_r <- newFastMutInt
    writeFastMutInt ix_r 0
@@ -190,6 +190,20 @@ seekBin h@(BinMem _ ix_r sz_r _) (BinPtr p) = do
         then do expandBin h p; writeFastMutInt ix_r p
         else writeFastMutInt ix_r p
 
+seekBy :: BinHandle -> Int -> IO ()
+seekBy (BinIO _ ix_r h) off = do
+  ix <- readFastMutInt ix_r
+  let ix' = ix + off
+  writeFastMutInt ix_r ix'
+  hSeek h AbsoluteSeek (fromIntegral ix')
+seekBy h@(BinMem _ ix_r sz_r _) off = do
+  sz <- readFastMutInt sz_r
+  ix <- readFastMutInt ix_r
+  let ix' = ix + off
+  if (ix' >= sz)
+        then do expandBin h ix'; writeFastMutInt ix_r ix'
+        else writeFastMutInt ix_r ix'
+
 isEOFBin :: BinHandle -> IO Bool
 isEOFBin (BinMem _ ix_r sz_r _) = do
   ix <- readFastMutInt ix_r
@@ -203,7 +217,7 @@ writeBinMem (BinMem _ ix_r _ arr_r) fn = do
   h <- openBinaryFile fn WriteMode
   arr <- readIORef arr_r
   ix  <- readFastMutInt ix_r
-  hPutArray h arr ix
+  withForeignPtr arr $ \p -> hPutBuf h p ix
   hClose h
 
 readBinMem :: FilePath -> IO BinHandle
@@ -212,10 +226,10 @@ readBinMem filename = do
   h <- openBinaryFile filename ReadMode
   filesize' <- hFileSize h
   let filesize = fromIntegral filesize'
-  arr <- newArray_ (0,filesize-1)
-  count <- hGetArray h arr filesize
-  when (count /= filesize)
-       (error ("Binary.readBinMem: only read " ++ show count ++ " bytes"))
+  arr <- mallocForeignPtrBytes (filesize*2)
+  count <- withForeignPtr arr $ \p -> hGetBuf h p filesize
+  when (count /= filesize) $
+       error ("Binary.readBinMem: only read " ++ show count ++ " bytes")
   hClose h
   arr_r <- newIORef arr
   ix_r <- newFastMutInt
@@ -224,15 +238,23 @@ readBinMem filename = do
   writeFastMutInt sz_r filesize
   return (BinMem noUserData ix_r sz_r arr_r)
 
+fingerprintBinMem :: BinHandle -> IO Fingerprint
+fingerprintBinMem (BinIO _ _ _) = error "Binary.md5BinMem: not a memory handle"
+fingerprintBinMem (BinMem _ ix_r _ arr_r) = do
+  arr <- readIORef arr_r
+  ix <- readFastMutInt ix_r
+  withForeignPtr arr $ \p -> fingerprintData p ix
+
 -- expand the size of the array to include a specified offset
 expandBin :: BinHandle -> Int -> IO ()
 expandBin (BinMem _ _ sz_r arr_r) off = do
    sz <- readFastMutInt sz_r
    let sz' = head (dropWhile (<= off) (iterate (* 2) sz))
    arr <- readIORef arr_r
-   arr' <- newArray_ (0,sz'-1)
-   sequence_ [ unsafeRead arr i >>= unsafeWrite arr' i
-             | i <- [ 0 .. sz-1 ] ]
+   arr' <- mallocForeignPtrBytes sz'
+   withForeignPtr arr $ \old ->
+     withForeignPtr arr' $ \new ->
+       copyBytes new old sz 
    writeFastMutInt sz_r sz'
    writeIORef arr_r arr'
    when debugIsOn $
@@ -253,7 +275,7 @@ putWord8 h@(BinMem _ ix_r sz_r arr_r) w = do
         then do expandBin h ix
                 putWord8 h w
         else do arr <- readIORef arr_r
-                unsafeWrite arr ix w
+                withForeignPtr arr $ \p -> pokeByteOff p ix w
                 writeFastMutInt ix_r (ix+1)
                 return ()
 putWord8 (BinIO _ ix_r h) w = do
@@ -269,7 +291,7 @@ getWord8 (BinMem _ ix_r sz_r arr_r) = do
     when (ix >= sz) $
         ioError (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing)
     arr <- readIORef arr_r
-    w <- unsafeRead arr ix
+    w <- withForeignPtr arr $ \p -> peekByteOff p ix
     writeFastMutInt ix_r (ix+1)
     return w
 getWord8 (BinIO _ ix_r h) = do
@@ -581,43 +603,26 @@ data UserData =
         ud_symtab :: SymbolTable,
 
         -- for *serialising* only:
-        ud_dict_next :: !FastMutInt, -- The next index to use
-        ud_dict_map  :: !(IORef (UniqFM (Int,FastString))),
-                                -- indexed by FastString
-
-        ud_symtab_next :: !FastMutInt, -- The next index to use
-        ud_symtab_map  :: !(IORef (UniqFM (Int,Name)))
-                                -- indexed by Name
+        ud_put_name :: BinHandle -> Name       -> IO (),
+        ud_put_fs   :: BinHandle -> FastString -> IO ()
    }
 
 newReadState :: Dictionary -> IO UserData
 newReadState dict = do
-  dict_next <- newFastMutInt
-  dict_map <- newIORef (undef "dict_map")
-  symtab_next <- newFastMutInt
-  symtab_map <- newIORef (undef "symtab_map")
-  return UserData { ud_dict = dict,
-                    ud_symtab = undef "symtab",
-                    ud_dict_next = dict_next,
-                    ud_dict_map = dict_map,
-                    ud_symtab_next = symtab_next,
-                    ud_symtab_map = symtab_map
+  return UserData { ud_dict     = dict,
+                    ud_symtab   = undef "symtab",
+                    ud_put_name = undef "put_name",
+                    ud_put_fs   = undef "put_fs"
                    }
 
-newWriteState :: IO UserData
-newWriteState = do
-  dict_next <- newFastMutInt
-  writeFastMutInt dict_next 0
-  dict_map <- newIORef emptyUFM
-  symtab_next <- newFastMutInt
-  writeFastMutInt symtab_next 0
-  symtab_map <- newIORef emptyUFM
-  return UserData { ud_dict = undef "dict",
-                    ud_symtab = undef "symtab",
-                    ud_dict_next = dict_next,
-                    ud_dict_map = dict_map,
-                    ud_symtab_next = symtab_next,
-                    ud_symtab_map = symtab_map
+newWriteState :: (BinHandle -> Name       -> IO ()) 
+              -> (BinHandle -> FastString -> IO ())
+              -> IO UserData
+newWriteState put_name put_fs = do
+  return UserData { ud_dict     = undef "dict",
+                    ud_symtab   = undef "symtab",
+                    ud_put_name = put_name,
+                    ud_put_fs   = put_fs
                    }
 
 noUserData :: a
@@ -693,20 +698,16 @@ getFS bh = do
 
 instance Binary FastString where
   put_ bh f =
-    case getUserData bh of {
-        UserData { ud_dict_next = j_r,
-                   ud_dict_map = out_r} -> do
-    out <- readIORef out_r
-    let uniq = getUnique f
-    case lookupUFM out uniq of
-        Just (j, _)  -> put_ bh j
-        Nothing -> do
-           j <- readFastMutInt j_r
-           put_ bh j
-           writeFastMutInt j_r (j + 1)
-           writeIORef out_r $! addToUFM out uniq (j, f)
-    }
+    case getUserData bh of
+        UserData { ud_put_fs = put_fs } -> put_fs bh f
 
   get bh = do
         j <- get bh
         return $! (ud_dict (getUserData bh) ! j)
+
+-- Here to avoid loop
+
+instance Binary Fingerprint where
+  put_ h (Fingerprint w1 w2) = do put_ h w1; put_ h w2
+  get  h = do w1 <- get h; w2 <- get h; return (Fingerprint w1 w2)
+
diff --git a/compiler/utils/FastMutInt.lhs b/compiler/utils/FastMutInt.lhs
index 2039ee5df9..00aba34bba 100644
--- a/compiler/utils/FastMutInt.lhs
+++ b/compiler/utils/FastMutInt.lhs
@@ -7,7 +7,10 @@
 \begin{code}
 module FastMutInt(
 	FastMutInt, newFastMutInt,
-	readFastMutInt, writeFastMutInt
+	readFastMutInt, writeFastMutInt,
+
+	FastMutPtr, newFastMutPtr,
+	readFastMutPtr, writeFastMutPtr
   ) where
 
 #ifdef __GLASGOW_HASKELL__
@@ -19,6 +22,7 @@ module FastMutInt(
 
 import GHC.Base
 import GHC.IOBase
+import GHC.Ptr
 
 #else /* ! __GLASGOW_HASKELL__ */
 
@@ -29,6 +33,10 @@ import Data.IORef
 newFastMutInt :: IO FastMutInt
 readFastMutInt :: FastMutInt -> IO Int
 writeFastMutInt :: FastMutInt -> Int -> IO ()
+
+newFastMutPtr :: IO FastMutPtr
+readFastMutPtr :: FastMutPtr -> IO (Ptr a)
+writeFastMutPtr :: FastMutPtr -> Ptr a -> IO ()
 \end{code}
 
 \begin{code}
@@ -47,6 +55,21 @@ readFastMutInt (FastMutInt arr) = IO $ \s ->
 writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
   case writeIntArray# arr 0# i s of { s ->
   (# s, () #) }
+
+data FastMutPtr = FastMutPtr (MutableByteArray# RealWorld)
+
+newFastMutPtr = IO $ \s ->
+  case newByteArray# size s of { (# s, arr #) ->
+  (# s, FastMutPtr arr #) }
+  where I# size = SIZEOF_VOID_P
+
+readFastMutPtr (FastMutPtr arr) = IO $ \s ->
+  case readAddrArray# arr 0# s of { (# s, i #) ->
+  (# s, Ptr i #) }
+
+writeFastMutPtr (FastMutPtr arr) (Ptr i) = IO $ \s ->
+  case writeAddrArray# arr 0# i s of { s ->
+  (# s, () #) }
 #else /* ! __GLASGOW_HASKELL__ */
 --maybe someday we could use
 --http://haskell.org/haskellwiki/Library/ArrayRef
@@ -67,6 +90,23 @@ readFastMutInt (FastMutInt ioRefInt) = readIORef ioRefInt
 
 -- FastMutInt is strict in the value it contains.
 writeFastMutInt (FastMutInt ioRefInt) i = i `seq` writeIORef ioRefInt i
+
+
+newtype FastMutPtr = FastMutPtr (IORef (Ptr ()))
+
+-- If any default value was chosen, it surely would be 0,
+-- so we will use that since IORef requires a default value.
+-- Or maybe it would be more interesting to package an error,
+-- assuming nothing relies on being able to read a bogus Ptr?
+-- That could interfere with its strictness for smart optimizers
+-- (are they allowed to optimize a 'newtype' that way?) ...
+-- Well, maybe that can be added (in DEBUG?) later.
+newFastMutPtr = fmap FastMutPtr (newIORef (castPtr nullPtr))
+
+readFastMutPtr (FastMutPtr ioRefPtr) = readIORef ioRefPtr
+
+-- FastMutPtr is strict in the value it contains.
+writeFastMutPtr (FastMutPtr ioRefPtr) i = i `seq` writeIORef ioRefPtr i
 #endif
 \end{code}
 
diff --git a/compiler/utils/Fingerprint.hsc b/compiler/utils/Fingerprint.hsc
new file mode 100644
index 0000000000..d5a2409a26
--- /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 ()
diff --git a/compiler/utils/md5.c b/compiler/utils/md5.c
new file mode 100644
index 0000000000..0570cbbdf1
--- /dev/null
+++ b/compiler/utils/md5.c
@@ -0,0 +1,238 @@
+/*
+ * This code implements the MD5 message-digest algorithm.
+ * The algorithm is due to Ron Rivest.  This code was
+ * written by Colin Plumb in 1993, no copyright is claimed.
+ * This code is in the public domain; do with it what you wish.
+ *
+ * Equivalent code is available from RSA Data Security, Inc.
+ * This code has been tested against that, and is equivalent,
+ * except that you don't need to include two pages of legalese
+ * with every copy.
+ *
+ * To compute the message digest of a chunk of bytes, declare an
+ * MD5Context structure, pass it to MD5Init, call MD5Update as
+ * needed on buffers full of bytes, and then call MD5Final, which
+ * will fill a supplied 16-byte array with the digest.
+ */
+
+#include "HsFFI.h"
+#include "md5.h"
+#include <string.h>
+
+void MD5Init(struct MD5Context *context);
+void MD5Update(struct MD5Context *context, byte const *buf, int len);
+void MD5Final(byte digest[16], struct MD5Context *context);
+void MD5Transform(word32 buf[4], word32 const in[16]);
+
+
+/*
+ * Shuffle the bytes into little-endian order within words, as per the
+ * MD5 spec.  Note: this code works regardless of the byte order.
+ */
+void
+byteSwap(word32 *buf, unsigned words)
+{
+	byte *p = (byte *)buf;
+
+	do {
+		*buf++ = (word32)((unsigned)p[3] << 8 | p[2]) << 16 |
+			((unsigned)p[1] << 8 | p[0]);
+		p += 4;
+	} while (--words);
+}
+
+/*
+ * Start MD5 accumulation.  Set bit count to 0 and buffer to mysterious
+ * initialization constants.
+ */
+void
+MD5Init(struct MD5Context *ctx)
+{
+	ctx->buf[0] = 0x67452301;
+	ctx->buf[1] = 0xefcdab89;
+	ctx->buf[2] = 0x98badcfe;
+	ctx->buf[3] = 0x10325476;
+
+	ctx->bytes[0] = 0;
+	ctx->bytes[1] = 0;
+}
+
+/*
+ * Update context to reflect the concatenation of another buffer full
+ * of bytes.
+ */
+void
+MD5Update(struct MD5Context *ctx, byte const *buf, int len)
+{
+	word32 t;
+
+	/* Update byte count */
+
+	t = ctx->bytes[0];
+	if ((ctx->bytes[0] = t + len) < t)
+		ctx->bytes[1]++;	/* Carry from low to high */
+
+	t = 64 - (t & 0x3f);	/* Space available in ctx->in (at least 1) */
+	if ((unsigned)t > len) {
+		memcpy((byte *)ctx->in + 64 - (unsigned)t, buf, len);
+		return;
+	}
+	/* First chunk is an odd size */
+	memcpy((byte *)ctx->in + 64 - (unsigned)t, buf, (unsigned)t);
+	byteSwap(ctx->in, 16);
+	MD5Transform(ctx->buf, ctx->in);
+	buf += (unsigned)t;
+	len -= (unsigned)t;
+
+	/* Process data in 64-byte chunks */
+	while (len >= 64) {
+		memcpy(ctx->in, buf, 64);
+		byteSwap(ctx->in, 16);
+		MD5Transform(ctx->buf, ctx->in);
+		buf += 64;
+		len -= 64;
+	}
+
+	/* Handle any remaining bytes of data. */
+	memcpy(ctx->in, buf, len);
+}
+
+/*
+ * Final wrapup - pad to 64-byte boundary with the bit pattern 
+ * 1 0* (64-bit count of bits processed, MSB-first)
+ */
+void
+MD5Final(byte digest[16], struct MD5Context *ctx)
+{
+	int count = (int)(ctx->bytes[0] & 0x3f); /* Bytes in ctx->in */
+	byte *p = (byte *)ctx->in + count;	/* First unused byte */
+
+	/* Set the first char of padding to 0x80.  There is always room. */
+	*p++ = 0x80;
+
+	/* Bytes of padding needed to make 56 bytes (-8..55) */
+	count = 56 - 1 - count;
+
+	if (count < 0) {	/* Padding forces an extra block */
+		memset(p, 0, count+8);
+		byteSwap(ctx->in, 16);
+		MD5Transform(ctx->buf, ctx->in);
+		p = (byte *)ctx->in;
+		count = 56;
+	}
+	memset(p, 0, count+8);
+	byteSwap(ctx->in, 14);
+
+	/* Append length in bits and transform */
+	ctx->in[14] = ctx->bytes[0] << 3;
+	ctx->in[15] = ctx->bytes[1] << 3 | ctx->bytes[0] >> 29;
+	MD5Transform(ctx->buf, ctx->in);
+
+	byteSwap(ctx->buf, 4);
+	memcpy(digest, ctx->buf, 16);
+	memset(ctx,0,sizeof(ctx));
+}
+
+
+/* The four core functions - F1 is optimized somewhat */
+
+/* #define F1(x, y, z) (x & y | ~x & z) */
+#define F1(x, y, z) (z ^ (x & (y ^ z)))
+#define F2(x, y, z) F1(z, x, y)
+#define F3(x, y, z) (x ^ y ^ z)
+#define F4(x, y, z) (y ^ (x | ~z))
+
+/* This is the central step in the MD5 algorithm. */
+#define MD5STEP(f,w,x,y,z,in,s) \
+	 (w += f(x,y,z) + in, w = (w<<s | w>>(32-s)) + x)
+
+/*
+ * The core of the MD5 algorithm, this alters an existing MD5 hash to
+ * reflect the addition of 16 longwords of new data.  MD5Update blocks
+ * the data and converts bytes into longwords for this routine.
+ */
+
+void
+MD5Transform(word32 buf[4], word32 const in[16])
+{
+	register word32 a, b, c, d;
+
+	a = buf[0];
+	b = buf[1];
+	c = buf[2];
+	d = buf[3];
+
+	MD5STEP(F1, a, b, c, d, in[0] + 0xd76aa478, 7);
+	MD5STEP(F1, d, a, b, c, in[1] + 0xe8c7b756, 12);
+	MD5STEP(F1, c, d, a, b, in[2] + 0x242070db, 17);
+	MD5STEP(F1, b, c, d, a, in[3] + 0xc1bdceee, 22);
+	MD5STEP(F1, a, b, c, d, in[4] + 0xf57c0faf, 7);
+	MD5STEP(F1, d, a, b, c, in[5] + 0x4787c62a, 12);
+	MD5STEP(F1, c, d, a, b, in[6] + 0xa8304613, 17);
+	MD5STEP(F1, b, c, d, a, in[7] + 0xfd469501, 22);
+	MD5STEP(F1, a, b, c, d, in[8] + 0x698098d8, 7);
+	MD5STEP(F1, d, a, b, c, in[9] + 0x8b44f7af, 12);
+	MD5STEP(F1, c, d, a, b, in[10] + 0xffff5bb1, 17);
+	MD5STEP(F1, b, c, d, a, in[11] + 0x895cd7be, 22);
+	MD5STEP(F1, a, b, c, d, in[12] + 0x6b901122, 7);
+	MD5STEP(F1, d, a, b, c, in[13] + 0xfd987193, 12);
+	MD5STEP(F1, c, d, a, b, in[14] + 0xa679438e, 17);
+	MD5STEP(F1, b, c, d, a, in[15] + 0x49b40821, 22);
+
+	MD5STEP(F2, a, b, c, d, in[1] + 0xf61e2562, 5);
+	MD5STEP(F2, d, a, b, c, in[6] + 0xc040b340, 9);
+	MD5STEP(F2, c, d, a, b, in[11] + 0x265e5a51, 14);
+	MD5STEP(F2, b, c, d, a, in[0] + 0xe9b6c7aa, 20);
+	MD5STEP(F2, a, b, c, d, in[5] + 0xd62f105d, 5);
+	MD5STEP(F2, d, a, b, c, in[10] + 0x02441453, 9);
+	MD5STEP(F2, c, d, a, b, in[15] + 0xd8a1e681, 14);
+	MD5STEP(F2, b, c, d, a, in[4] + 0xe7d3fbc8, 20);
+	MD5STEP(F2, a, b, c, d, in[9] + 0x21e1cde6, 5);
+	MD5STEP(F2, d, a, b, c, in[14] + 0xc33707d6, 9);
+	MD5STEP(F2, c, d, a, b, in[3] + 0xf4d50d87, 14);
+	MD5STEP(F2, b, c, d, a, in[8] + 0x455a14ed, 20);
+	MD5STEP(F2, a, b, c, d, in[13] + 0xa9e3e905, 5);
+	MD5STEP(F2, d, a, b, c, in[2] + 0xfcefa3f8, 9);
+	MD5STEP(F2, c, d, a, b, in[7] + 0x676f02d9, 14);
+	MD5STEP(F2, b, c, d, a, in[12] + 0x8d2a4c8a, 20);
+
+	MD5STEP(F3, a, b, c, d, in[5] + 0xfffa3942, 4);
+	MD5STEP(F3, d, a, b, c, in[8] + 0x8771f681, 11);
+	MD5STEP(F3, c, d, a, b, in[11] + 0x6d9d6122, 16);
+	MD5STEP(F3, b, c, d, a, in[14] + 0xfde5380c, 23);
+	MD5STEP(F3, a, b, c, d, in[1] + 0xa4beea44, 4);
+	MD5STEP(F3, d, a, b, c, in[4] + 0x4bdecfa9, 11);
+	MD5STEP(F3, c, d, a, b, in[7] + 0xf6bb4b60, 16);
+	MD5STEP(F3, b, c, d, a, in[10] + 0xbebfbc70, 23);
+	MD5STEP(F3, a, b, c, d, in[13] + 0x289b7ec6, 4);
+	MD5STEP(F3, d, a, b, c, in[0] + 0xeaa127fa, 11);
+	MD5STEP(F3, c, d, a, b, in[3] + 0xd4ef3085, 16);
+	MD5STEP(F3, b, c, d, a, in[6] + 0x04881d05, 23);
+	MD5STEP(F3, a, b, c, d, in[9] + 0xd9d4d039, 4);
+	MD5STEP(F3, d, a, b, c, in[12] + 0xe6db99e5, 11);
+	MD5STEP(F3, c, d, a, b, in[15] + 0x1fa27cf8, 16);
+	MD5STEP(F3, b, c, d, a, in[2] + 0xc4ac5665, 23);
+
+	MD5STEP(F4, a, b, c, d, in[0] + 0xf4292244, 6);
+	MD5STEP(F4, d, a, b, c, in[7] + 0x432aff97, 10);
+	MD5STEP(F4, c, d, a, b, in[14] + 0xab9423a7, 15);
+	MD5STEP(F4, b, c, d, a, in[5] + 0xfc93a039, 21);
+	MD5STEP(F4, a, b, c, d, in[12] + 0x655b59c3, 6);
+	MD5STEP(F4, d, a, b, c, in[3] + 0x8f0ccc92, 10);
+	MD5STEP(F4, c, d, a, b, in[10] + 0xffeff47d, 15);
+	MD5STEP(F4, b, c, d, a, in[1] + 0x85845dd1, 21);
+	MD5STEP(F4, a, b, c, d, in[8] + 0x6fa87e4f, 6);
+	MD5STEP(F4, d, a, b, c, in[15] + 0xfe2ce6e0, 10);
+	MD5STEP(F4, c, d, a, b, in[6] + 0xa3014314, 15);
+	MD5STEP(F4, b, c, d, a, in[13] + 0x4e0811a1, 21);
+	MD5STEP(F4, a, b, c, d, in[4] + 0xf7537e82, 6);
+	MD5STEP(F4, d, a, b, c, in[11] + 0xbd3af235, 10);
+	MD5STEP(F4, c, d, a, b, in[2] + 0x2ad7d2bb, 15);
+	MD5STEP(F4, b, c, d, a, in[9] + 0xeb86d391, 21);
+
+	buf[0] += a;
+	buf[1] += b;
+	buf[2] += c;
+	buf[3] += d;
+}
+
diff --git a/compiler/utils/md5.h b/compiler/utils/md5.h
new file mode 100644
index 0000000000..8d375df268
--- /dev/null
+++ b/compiler/utils/md5.h
@@ -0,0 +1,24 @@
+/* MD5 message digest */
+#ifndef _MD5_H
+#define _MD5_H
+
+#include "HsFFI.h"
+
+typedef HsWord32 word32;
+typedef HsWord8  byte;
+
+struct MD5Context {
+	word32 buf[4];
+	word32 bytes[2];
+	word32 in[16];
+};
+
+void MD5Init(struct MD5Context *context);
+void MD5Update(struct MD5Context *context, byte const *buf, int len);
+void MD5Final(byte digest[16], struct MD5Context *context);
+void MD5Transform(word32 buf[4], word32 const in[16]);
+
+#endif /* _MD5_H */
+
+
+