Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : ghc-7.2

http://hackage.haskell.org/trac/ghc/changeset/ae29d8b804f4cd8e9d3340a3ff3ad2227e1d01c6

>---------------------------------------------------------------

commit ae29d8b804f4cd8e9d3340a3ff3ad2227e1d01c6
Author: Ian Lynagh <[email protected]>
Date:   Fri Jul 22 22:57:16 2011 +0100

    Sync the typeable fingerprinting with base

>---------------------------------------------------------------

 compiler/typecheck/TcGenDeriv.lhs |   11 ++++-------
 compiler/utils/Fingerprint.hsc    |   18 +++++++++++++++++-
 2 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/compiler/typecheck/TcGenDeriv.lhs 
b/compiler/typecheck/TcGenDeriv.lhs
index 4ab3523..cac485a 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 8c487f6..735bf23 100644
--- a/compiler/utils/Fingerprint.hsc
+++ b/compiler/utils/Fingerprint.hsc
@@ -11,7 +11,8 @@
 module Fingerprint (
         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"



_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to