Commit 8f57a40b authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Sync the typeable fingerprinting with base

parent 8dfa34fb
......@@ -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
......
......@@ -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"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment