Sync the typeable fingerprinting with base

2 files changed, 22 insertions, 9 deletions

diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index 4ab3523b3f..cac485a82d 100644
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -59,11 +59,9 @@ import MonadUtils
 import Outputable
 import FastString
 import Bag
-import Binary hiding (get,put)
 import Fingerprint
 import Constants
 
-import System.IO.Unsafe ( unsafePerformIO )
 import Data.List        ( partition, intersperse )
 \end{code}
 
@@ -1197,11 +1195,10 @@ gen_Typeable_binds loc tycon
                                   HsString modl_fs,
                                   HsString name_fs])
 
-    Fingerprint high low = unsafePerformIO $ -- ugh
-             computeFingerprint (error "gen_typeable_binds")
-                                (unpackFS pkg_fs ++
-                                 unpackFS modl_fs ++
-                                 unpackFS name_fs)
+    Fingerprint high low =
+             fingerprintString (unpackFS pkg_fs ++
+                                unpackFS modl_fs ++
+                                unpackFS name_fs)
 
     int64
       | wORD_SIZE == 4 = HsWord64Prim . fromIntegral
diff --git a/compiler/utils/Fingerprint.hsc b/compiler/utils/Fingerprint.hsc
index 8c487f665e..735bf23628 100644
--- a/compiler/utils/Fingerprint.hsc
+++ b/compiler/utils/Fingerprint.hsc
@@ -9,9 +9,10 @@
 -- ----------------------------------------------------------------------------
 
 module Fingerprint (
-        Fingerprint(..), fingerprint0, 
+        Fingerprint(..), fingerprint0,
         readHexFingerprint,
-        fingerprintData
+        fingerprintData,
+        fingerprintString
    ) where
 
 #include "md5.h"
@@ -28,8 +29,10 @@ import GHC.Fingerprint
 ##endif
 
 ##if __GLASGOW_HASKELL__ < 701
+import Data.Char
 import Foreign
 import Foreign.C
+import GHC.IO (unsafeDupablePerformIO)
 
 -- Using 128-bit MD5 fingerprints for now.
 
@@ -63,6 +66,19 @@ fingerprintData buf len = do
       c_MD5Final pdigest pctxt
       peekFingerprint (castPtr pdigest)
 
+-- This is duplicated in libraries/base/GHC/Fingerprint.hs
+fingerprintString :: String -> Fingerprint
+fingerprintString str = unsafeDupablePerformIO $
+  withArrayLen word8s $ \len p ->
+     fingerprintData p len
+    where word8s = concatMap f str
+          f c = let w32 :: Word32
+                    w32 = fromIntegral (ord c)
+                in [fromIntegral (w32 `shiftR` 24),
+                    fromIntegral (w32 `shiftR` 16),
+                    fromIntegral (w32 `shiftR` 8),
+                    fromIntegral w32]
+
 data MD5Context
 
 foreign import ccall unsafe "MD5Init"