packages feed

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 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+      ]+    ]