hashable 1.0.1.1 → 1.1.0.0
raw patch · 6 files changed
+171/−73 lines, 6 filesdep +ghc-primdep +textdep −QuickCheckdep −hashabledep −randomdep ~basedep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependencies added: ghc-prim, text
Dependencies removed: QuickCheck, hashable, random
Dependency ranges changed: base, bytestring
API changes (from Hackage documentation)
+ Data.Hashable: hashByteArrayWithSalt :: ByteArray# -> Int -> Int -> Int -> Int
+ Data.Hashable: hashPtrWithSalt :: Ptr a -> Int -> Int -> IO Int
+ Data.Hashable: instance Hashable Text
+ Data.Hashable: instance Hashable ThreadId
Files
- CHANGES +9/−0
- Data/Hashable.hs +73/−25
- benchmarks/Benchmarks.hs +2/−2
- cbits/hashByteString.c +8/−1
- hashable.cabal +21/−16
- tests/Properties.hs +58/−29
CHANGES view
@@ -1,3 +1,12 @@+Version 1.1.0.0++* Added instance for: strict and lazy Texts, ThreadId+* Added hashPtrWithSalt and hashByteArrayWithSalt.+* Faster ByteArray# hashing.+* Fixed a signedness bug that affected ByteString.+* Fix ByteString hashing to work correctly on both 32 and 64-bit+ platforms.+ Version 1.0.1.1 * Fixed bug in Hashable instance for lazy ByteStrings where
Data/Hashable.hs view
@@ -1,10 +1,12 @@-{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash #-}+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,+ UnliftedFFITypes #-} ------------------------------------------------------------------------ -- | -- Module : Data.Hash -- Copyright : (c) Milan Straka 2010 -- (c) Johan Tibell 2011+-- (c) Bryan O'Sullivan 2011 -- License : BSD-style -- Maintainer : fox@ucw.cz -- Stability : provisional@@ -27,8 +29,10 @@ -- * Creating new instances -- $blocks , hashPtr+ , hashPtrWithSalt #if defined(__GLASGOW_HASKELL__) , hashByteArray+ , hashByteArrayWithSalt #endif , combine ) where@@ -42,12 +46,20 @@ import qualified Data.ByteString.Unsafe as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Internal as BL-import Foreign.C (CInt, CString)+import qualified Data.Text as T+import qualified Data.Text.Array as TA+import qualified Data.Text.Internal as T+import qualified Data.Text.Lazy as LT+import Foreign.C (CLong, CString) import Foreign.Ptr (Ptr, castPtr) #if defined(__GLASGOW_HASKELL__)-import GHC.Base (ByteArray#, Int(..), indexWord8Array#)-import GHC.Word (Word8(..))+import Foreign.C.Types (CInt)+import GHC.Base (ByteArray#)+import GHC.Conc (ThreadId(..))+import GHC.Prim (ThreadId#)+#else+import Control.Concurrent (ThreadId) #endif ------------------------------------------------------------------------@@ -143,6 +155,21 @@ {-# SPECIALIZE instance Hashable [Char] #-} hash = foldl' hashAndCombine 0 +-- | Compute the hash of a ThreadId. For GHC, we happen to know a+-- trick to make this fast.+hashThreadId :: ThreadId -> Int+{-# INLINE hashThreadId #-}+#if defined(__GLASGOW_HASKELL__)+hashThreadId (ThreadId t) = hash (fromIntegral (getThreadId t) :: Int)+foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt+#else+hashThreadId = hash . show+#endif++instance Hashable ThreadId where+ hash = hashThreadId+ {-# INLINE hash #-}+ hashAndCombine :: Hashable h => Int -> h -> Int hashAndCombine acc h = acc `combine` hash h @@ -166,6 +193,24 @@ instance Hashable BL.ByteString where hash = BL.foldlChunks hashByteStringWithSalt 0 +instance Hashable T.Text where+ hash (T.Text arr off len) = hashByteArray (TA.aBA arr)+ (off `shiftL` 1) (len `shiftL` 1)++-- The arguments to this function are flipped to make the function+-- easier to use with a left fold.++-- | Compute a hash value for this 'B.Text', using an initial+-- salt.+hashTextWithSalt :: Int -- ^ salt+ -> T.Text -- ^ data to hash+ -> Int -- ^ hash value+hashTextWithSalt salt (T.Text arr off len) =+ hashByteArrayWithSalt (TA.aBA arr) (off `shiftL` 1) (len `shiftL` 1) salt++instance Hashable LT.Text where+ hash = LT.foldlChunks hashTextWithSalt 0+ ------------------------------------------------------------------------ -- * Creating new instances @@ -221,6 +266,8 @@ fromIntegral `fmap` hashCString (castPtr p) (fromIntegral len) (fromIntegral salt) +foreign import ccall unsafe "djb_hash" hashCString+ :: CString -> CLong -> CLong -> IO CLong #if defined(__GLASGOW_HASKELL__) -- | Compute a hash value for the content of this 'ByteArray#',@@ -230,31 +277,32 @@ -> Int -- ^ offset, in bytes -> Int -- ^ length, in bytes -> Int -- ^ hash value-hashByteArray ba0 off len = go ba0 off len 0- where- -- Bernstein's hash- go :: ByteArray# -> Int -> Int -> Int -> Int- go !ba !i !n !h- | i < n = let h' = (h + h `shiftL` 5) `xor`- (fromIntegral $ unsafeIndexWord8 ba i)- in go ba (i + 1) n h'- | otherwise = h+hashByteArray ba0 off len = hashByteArrayWithSalt ba0 off len 0+{-# INLINE hashByteArray #-} --- | Unchecked read of an immutable array. May return garbage or--- crash on an out-of-bounds access.-unsafeIndexWord8 :: ByteArray# -> Int -> Word8-unsafeIndexWord8 ba (I# i#) =- case indexWord8Array# ba i# of r# -> (W8# r#)-{-# INLINE unsafeIndexWord8 #-}+-- | Compute a hash value for the content of this 'ByteArray#', using+-- an initial salt.+--+-- This function can for example be used to hash non-contiguous+-- segments of memory as if they were one contiguous segment, by using+-- the output of one hash as the salt for the next.+--+-- Availability: GHC.+hashByteArrayWithSalt+ :: ByteArray# -- ^ data to hash+ -> Int -- ^ offset, in bytes+ -> Int -- ^ length, in bytes+ -> Int -- ^ salt+ -> Int -- ^ hash value+hashByteArrayWithSalt ba !off !len !h0 =+ fromIntegral $ c_hashByteArray ba (fromIntegral off) (fromIntegral len)+ (fromIntegral h0)++foreign import ccall unsafe "djb_hash_offset" c_hashByteArray+ :: ByteArray# -> CLong -> CLong -> CLong -> CLong #endif -- | Combine two given hash values. 'combine' has zero as a left -- identity. combine :: Int -> Int -> Int combine h1 h2 = (h1 + h1 `shiftL` 5) `xor` h2----------------------------------------------------------------------------- * Foreign imports--foreign import ccall unsafe "djb_hash" hashCString- :: CString -> CInt -> CInt -> IO CInt
benchmarks/Benchmarks.hs view
@@ -53,7 +53,7 @@ data ByteArray = BA { unBA :: !ByteArray# } new :: Int -> ByteArray#-new (I# n#) = unBA $ runST $ ST $ \s1 ->+new (I# n#) = unBA (runST $ ST $ \s1 -> case newByteArray# n# s1 of (# s2, ary #) -> case unsafeFreezeByteArray# ary s2 of- (# s3, ba #) -> (# s3, BA ba #)+ (# s3, ba #) -> (# s3, BA ba #))
cbits/hashByteString.c view
@@ -1,9 +1,16 @@ /* Bernstein's hash */-int djb_hash(const char* str, int len, int hash) {+long djb_hash(const unsigned char* str, long len, long hash) { while (len--) { hash = (hash * 33) ^ *str++; } return hash;+}++/* Used for ByteArray#s. We can't treat them like pointers in+ native Haskell, but we can in unsafe FFI calls.+ */+long djb_hash_offset(const unsigned char* str, long offset, long len, long hash) {+ return djb_hash(str + offset, len, hash); }
hashable.cabal view
@@ -1,5 +1,5 @@ Name: hashable-Version: 1.0.1.1+Version: 1.1.0.0 Synopsis: A class for types that can be converted to a hash value Description: This package defines a class, 'Hashable', for types that can be converted to a hash value. This class@@ -9,13 +9,14 @@ Homepage: http://github.com/tibbe/hashable License: BSD3 License-file: LICENSE-Author: Milan Straka-Maintainer: Milan Straka <fox@ucw.cz>+Author: Milan Straka <fox@ucw.cz> Johan Tibell <johan.tibell@gmail.com>+Maintainer: johan.tibell@gmail.com+bug-reports: https://github.com/tibbe/hashable/issues Stability: Provisional Category: Data Build-type: Simple-Cabal-version: >=1.10+Cabal-version: >=1.8 -- tests/Properties.hs shouldn't have to go here, but the source files -- for the test-suite stanzas don't get picked up by `cabal sdist`. Extra-source-files:@@ -23,27 +24,31 @@ benchmarks/Makefile Library- Default-language: Haskell98 Exposed-modules: Data.Hashable Build-depends: base >= 4.0 && < 5,- bytestring >= 0.9 && < 1.0+ bytestring >= 0.9 && < 1.0,+ ghc-prim < 0.3,+ text >= 0.11.0.5 && < 0.12 C-sources: cbits/hashByteString.c Ghc-options: -Wall if impl(ghc >= 6.8) Ghc-options: -fwarn-tabs -Test-suite tests- Default-language: Haskell98- Type: exitcode-stdio-1.0- Hs-source-dirs: tests- Main-is: Properties.hs- Build-depends: base >= 4.0 && < 5,- hashable,- QuickCheck == 1.2.*,- random == 1.0.*+-- -- Commented out until cabal-install release.+-- Test-suite tests+-- Type: exitcode-stdio-1.0+-- Hs-source-dirs: tests+-- Main-is: Properties.hs+-- Build-depends: base >= 4.0 && < 5,+-- hashable,+-- test-framework >= 0.3.3 && < 0.4,+-- test-framework-quickcheck2 >= 0.2.9 && < 0.3,+-- QuickCheck >= 2.4.0.1,+-- random == 1.0.*,+-- text >= 0.11.0.5 - Ghc-options: -Wall+-- Ghc-options: -Wall source-repository head type: git
tests/Properties.hs view
@@ -1,36 +1,32 @@-{-# LANGUAGE BangPatterns, MagicHash, Rank2Types, UnboxedTuples #-}+{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, MagicHash, Rank2Types,+ UnboxedTuples #-} -- | Tests for the 'Data.Hashable' module. We test functions by -- comparing the C and Haskell implementations. module Main (main) where -import Data.Hashable (hashByteArray, hashPtr)+import Data.Hashable (hash, hashByteArray, hashPtr)+import qualified Data.Text as T+import qualified Data.Text.Lazy as L import Foreign (unsafePerformIO) import Foreign.Marshal.Array (withArray) import GHC.Base (ByteArray#, Int(..), newByteArray#, unsafeCoerce#, writeWord8Array#) import GHC.ST (ST(..), runST) import GHC.Word (Word8(..))-import System.Random import Test.QuickCheck-import Test.QuickCheck.Batch+import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty) ------------------------------------------------------------------------ -- * Properties -integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)-integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,- fromIntegral b :: Integer) g of- (x,g') -> (fromIntegral x, g')--instance Random Word8 where- randomR = integralRandomR- random = randomR (minBound,maxBound)+instance Arbitrary T.Text where+ arbitrary = T.pack `fmap` arbitrary -instance Arbitrary Word8 where- arbitrary = choose (97, 105)- coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 4))+instance Arbitrary L.Text where+ arbitrary = L.pack `fmap` arbitrary -- | Validate the implementation by comparing the C and Haskell -- versions.@@ -39,20 +35,49 @@ (hashByteArray (fromList xs) 0 len ==) `fmap` hashPtr p len where len = length xs -tests :: [TestOptions -> IO TestResult]-tests =- [ run pHash- ]+-- | Content equality implies hash equality.+pText :: T.Text -> T.Text -> Bool+pText a b = (a == b) == (hash a == hash b) +-- | Content equality implies hash equality.+pTextLazy :: L.Text -> L.Text -> Bool+pTextLazy a b = (a == b) == (hash a == hash b)++-- | A small positive integer.+newtype ChunkSize = ChunkSize { unCS :: Int }+ deriving (Eq, Ord, Num, Integral, Real, Enum, Show)++instance Arbitrary ChunkSize where+ arbitrary = (ChunkSize . (`mod` maxChunkSize)) `fmap`+ (arbitrary `suchThat` ((/=0) . (`mod` maxChunkSize)))+ where maxChunkSize = 16++-- | Ensure that the rechunk function causes a rechunked string to+-- still match its original form.+pRechunk :: T.Text -> NonEmptyList ChunkSize -> Bool+pRechunk t cs = L.fromStrict t == rechunk t cs++-- | Content equality implies hash equality.+pLazyRechunked :: T.Text -> NonEmptyList ChunkSize -> Bool+pLazyRechunked t cs = hash (L.fromStrict t) == hash (rechunk t cs)++-- | Break up a string into chunks of different sizes.+rechunk :: T.Text -> NonEmptyList ChunkSize -> L.Text+rechunk t0 (NonEmpty cs0) = L.fromChunks . go t0 . cycle $ cs0+ where+ go t _ | T.null t = []+ go t (c:cs) = a : go b cs+ where (a,b) = T.splitAt (unCS c) t+ -- This wrapper is required by 'runST'. data ByteArray = BA { unBA :: ByteArray# } -- | Create a 'ByteArray#' from a list of 'Word8' values. fromList :: [Word8] -> ByteArray#-fromList xs0 = unBA $ runST $ ST $ \ s1# ->+fromList xs0 = unBA (runST $ ST $ \ s1# -> case newByteArray# len# s1# of (# s2#, marr# #) -> case go s2# 0 marr# xs0 of- s3# -> (# s3#, BA (unsafeCoerce# marr#) #)+ s3# -> (# s3#, BA (unsafeCoerce# marr#) #)) where !(I# len#) = length xs0 go s# _ _ [] = s#@@ -63,12 +88,16 @@ ------------------------------------------------------------------------ -- Test harness -options :: TestOptions-options = TestOptions- { no_of_tests = 1000- , length_of_tests = 1- , debug_tests = False- }- main :: IO ()-main = runTests "Bernstein's hash" options tests+main = defaultMain tests++tests :: [Test]+tests =+ [ testProperty "bernstein" pHash+ , testGroup "text"+ [ testProperty "text/strict" pText+ , testProperty "text/lazy" pTextLazy+ , testProperty "rechunk" pRechunk+ , testProperty "text/rechunked" pLazyRechunked+ ]+ ]