diff options
| -rw-r--r-- | compiler/typecheck/TcGenDeriv.lhs | 11 | ||||
| -rw-r--r-- | compiler/utils/Fingerprint.hsc | 20 |
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" |