hashable 1.0.0 → 1.0.1.0

raw patch · 5 files changed

+288/−76 lines, 5 filesdep +QuickCheckdep +hashabledep +randomdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, hashable, random

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/Hashable.hs +173/−54
• cbits/hashByteString.c +10/−0
• hashable.cabal +31/−13
• src/hashByteString.c +0/−9
• tests/Properties.hs +74/−0

@@ -1,59 +1,80 @@-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash #-} ------------------------------------------------------------------------------+------------------------------------------------------------------------ -- | -- Module      :  Data.Hash -- Copyright   :  (c) Milan Straka 2010+--                (c) Johan Tibell 2011 -- License     :  BSD-style -- Maintainer  :  fox@ucw.cz -- Stability   :  provisional -- Portability :  portable ----- 'Hashable' class for hashable types, with instances for basic types. The only--- function of this class is------ @---   'hash' :: Hashable h => h -> Int--- @------ The 'hash' function should be as collision-free as possible, the probability--- of @'hash' a == 'hash' b@ should ideally be 1 over the number of representable--- values in an 'Int'.+-- This module defines a class, 'Hashable', for types that can be+-- converted to a hash value.  This class exists for the benefit of+-- hashing-based data structures.  The module provides instances for+-- basic types and a way to combine hash values. ----- Returning an 'Int' is a result of the 'Data.IntMap.IntMap' using 'Int' as--- a key, as inserting the hash values to the 'Data.IntMap.IntMap' was the--- purpose of creating this class.------------------------------------------------------------------------------+-- The 'hash' function should be as collision-free as possible, which+-- means that the 'hash' function must map the inputs to the hash+-- values as evenly as possible. -module Data.Hashable ( Hashable(..)-                     , combine-                     ) where+module Data.Hashable+    (+      -- * Computing hash values+      Hashable(..) -import Data.Bits-import Data.Int-import Data.Word+      -- * Creating new instances+      -- $blocks+    , hashPtr+#if defined(__GLASGOW_HASKELL__)+    , hashByteArray+#endif+    , combine+    ) where++import Data.Bits (bitSize, shiftL, shiftR, xor)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word, Word8, Word16, Word32, Word64) import Data.List (foldl') import qualified Data.ByteString as B-import qualified Data.ByteString.Internal as BInt-import qualified Data.ByteString.Unsafe as BInt+import qualified Data.ByteString.Internal as B+import qualified Data.ByteString.Unsafe as B import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Lazy.Internal as BLInt-import Foreign.C+import qualified Data.ByteString.Lazy.Internal as BL+import Foreign.C (CInt, CString)+import Foreign.Ptr (Ptr, castPtr) --- | The class containing a function 'hash' which computes the hash values of--- given value.-class Hashable a where-    -- | The computed 'hash' value should be as collision-free as possible, the-    -- probability of @'hash' a == 'hash' b@ should ideally be 1 over the-    -- number of representable values in an 'Int'.-    hash :: a -> Int+#if defined(__GLASGOW_HASKELL__)+import GHC.Base (ByteArray#, Int(..), indexWord8Array#)+import GHC.Word (Word8(..))+#endif --- | Combines two given hash values.-combine :: Int -> Int -> Int-combine h1 h2 = (h1 + h1 `shiftL` 5) `xor` h2+------------------------------------------------------------------------+-- * Computing hash values -hashAndCombine :: Hashable h => Int -> h -> Int-hashAndCombine acc h = acc `combine` hash h+-- | The class of types that can be converted to a hash value.+class Hashable a where+    -- | Return a hash value for the argument.+    --+    -- The general contract of 'hash' is:+    --+    --  * This integer need not remain consistent from one execution+    --    of an application to another execution of the same+    --    application.+    --+    --  * If two values are equal according to the '==' method, then+    --    applying the 'hash' method on each of the two values must+    --    produce the same integer result.+    --+    --  * It is /not/ required that if two values are unequal+    --    according to the '==' method, then applying the 'hash'+    --    method on each of the two values must produce distinct+    --    integer results.  However, the programmer should be aware+    --    that producing distinct integer results for unequal values+    --    may improve the performance of hashing-based data+    --    structures.+    hash :: a -> Int  instance Hashable () where hash _ = 0 @@ -63,51 +84,149 @@ instance Hashable Int8 where hash = fromIntegral instance Hashable Int16 where hash = fromIntegral instance Hashable Int32 where hash = fromIntegral-instance Hashable Int64 where hash = fromIntegral+instance Hashable Int64 where+    hash n+        | bitSize n == 64 = fromIntegral n+        | otherwise = fromIntegral (fromIntegral n `xor`+                                   (fromIntegral n `shiftR` 32 :: Word64))  instance Hashable Word where hash = fromIntegral instance Hashable Word8 where hash = fromIntegral instance Hashable Word16 where hash = fromIntegral instance Hashable Word32 where hash = fromIntegral-instance Hashable Word64 where hash = fromIntegral+instance Hashable Word64 where+    hash n+        | bitSize n == 64 = fromIntegral n+        | otherwise = fromIntegral (n `xor` (n `shiftR` 32))  instance Hashable Char where hash = fromEnum  instance Hashable a => Hashable (Maybe a) where     hash Nothing = 0-    hash (Just a) = 42 `combine` hash a+    hash (Just a) = 1 `combine` hash a +instance (Hashable a, Hashable b) => Hashable (Either a b) where+    hash (Left a)  = 0 `combine` hash a+    hash (Right b) = 1 `combine` hash b+ instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where     hash (a1, a2) = hash a1 `combine` hash a2  instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3) where     hash (a1, a2, a3) = hash a1 `combine` hash a2 `combine` hash a3 -instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4) => Hashable (a1, a2, a3, a4) where-    hash (a1, a2, a3, a4) = hash a1 `combine` hash a2 `combine` hash a3 `combine` hash a4+instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4) =>+         Hashable (a1, a2, a3, a4) where+    hash (a1, a2, a3, a4) = hash a1 `combine` hash a2 `combine` hash a3+                            `combine` hash a4  instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5)       => Hashable (a1, a2, a3, a4, a5) where     hash (a1, a2, a3, a4, a5) =-      hash a1 `combine` hash a2 `combine` hash a3 `combine` hash a4 `combine` hash a5+        hash a1 `combine` hash a2 `combine` hash a3 `combine` hash a4 `combine`+        hash a5 -instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6)-      => Hashable (a1, a2, a3, a4, a5, a6) where+instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5,+          Hashable a6) => Hashable (a1, a2, a3, a4, a5, a6) where     hash (a1, a2, a3, a4, a5, a6) =-      hash a1 `combine` hash a2 `combine` hash a3 `combine` hash a4 `combine` hash a5 `combine` hash a6+        hash a1 `combine` hash a2 `combine` hash a3 `combine` hash a4 `combine`+        hash a5 `combine` hash a6 -instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6, Hashable a7)-      => Hashable (a1, a2, a3, a4, a5, a6, a7) where+instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5,+          Hashable a6, Hashable a7) =>+         Hashable (a1, a2, a3, a4, a5, a6, a7) where     hash (a1, a2, a3, a4, a5, a6, a7) =-      hash a1 `combine` hash a2 `combine` hash a3 `combine` hash a4 `combine` hash a5 `combine` hash a6 `combine` hash a7+        hash a1 `combine` hash a2 `combine` hash a3 `combine` hash a4 `combine`+        hash a5 `combine` hash a6 `combine` hash a7  instance Hashable a => Hashable [a] where     {-# SPECIALIZE instance Hashable [Char] #-}     hash = foldl' hashAndCombine 0 -foreign import ccall unsafe hashByteString :: CString -> CInt -> IO CInt+hashAndCombine :: Hashable h => Int -> h -> Int+hashAndCombine acc h = acc `combine` hash h+ instance Hashable B.ByteString where-    hash bstr = fromIntegral $ BInt.inlinePerformIO $ BInt.unsafeUseAsCStringLen bstr $-                  \(str, len) -> hashByteString str (fromIntegral len)+    hash bs = B.inlinePerformIO $+              B.unsafeUseAsCStringLen bs $ \(p, len) ->+              hashPtr p (fromIntegral len) -instance Hashable BL.ByteString where hash = BLInt.foldlChunks hashAndCombine 0+instance Hashable BL.ByteString where hash = BL.foldlChunks hashAndCombine 0++------------------------------------------------------------------------+-- * Creating new instances++-- $blocks+--+-- The functions below can be used when creating new instances of+-- 'Hashable'.  For example, the 'hash' method for many string-like+-- types can be defined in terms of either 'hashPtr' or+-- 'hashByteArray'.  Here's how you could implement an instance for+-- the 'B.ByteString' data type, from the @bytestring@ package:+--+-- > import qualified Data.ByteString as B+-- > import qualified Data.ByteString.Internal as B+-- > import qualified Data.ByteString.Unsafe as B+-- > import Data.Hashable+-- > import Foreign.Ptr (castPtr)+-- >+-- > instance Hashable B.ByteString where+-- >     hash bs = B.inlinePerformIO $+-- >               B.unsafeUseAsCStringLen bs $ \ (p, len) ->+-- >               hashPtr p (fromIntegral len)+--+-- The 'combine' function can be used to implement 'Hashable'+-- instances for data types with more than one field, using this+-- recipe:+--+-- > instance (Hashable a, Hashable b) => Hashable (Foo a b) where+-- >     hash (Foo a b) = 17 `combine` hash a `combine` hash b+--+-- A nonzero seed is used so the hash value will be affected by+-- initial fields whose hash value is zero.  If no seed was provided,+-- the overall hash value would be unaffected by any such initial+-- fields, which could increase collisions.  The value 17 is+-- arbitrary.++-- | Compute a hash value for the content of this pointer.+hashPtr :: Ptr a      -- ^ pointer to the data to hash+        -> Int        -- ^ length, in bytes+        -> IO Int     -- ^ hash value+hashPtr p len =+    fromIntegral `fmap` hashByteString (castPtr p) (fromIntegral len)++#if defined(__GLASGOW_HASKELL__)+-- | Compute a hash value for the content of this 'ByteArray#',+-- beginning at the specified offset, using specified number of bytes.+-- Availability: GHC.+hashByteArray :: ByteArray#  -- ^ data to hash+              -> 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++-- | 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 #-}+#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 hashByteString :: CString -> CInt -> IO CInt

@@ -0,0 +1,10 @@+/* Bernstein's hash */+int hashByteString(const char* str, int len) {+  int hash = 0;++  while (len--) {+    hash = (hash * 33) ^ *str++;+  }++  return hash;+}

@@ -1,27 +1,45 @@ Name:                hashable-Version:             1.0.0-Synopsis:            Class Hashable providing a hash method.-Description:         This package provides a class 'Hashable', which contains-                     one method @'hash' :: 'Hashable' a => a -> 'Int'@, which-                     returns the hash of the given element.-                     .-                     The instances for various integral types, 'String' and 'ByteString'-                     are provided.-Homepage:            http://fox.auryn.cz/darcs/hashable/+Version:             1.0.1.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+                     exists for the benefit of hashing-based data+                     structures.  The package provides instances for+                     basic types and a way to combine hash values.+Homepage:            http://github.com/tibbe/hashable License:             BSD3 License-file:        LICENSE Author:              Milan Straka-Maintainer:          fox@ucw.cz+Maintainer:          Milan Straka <fox@ucw.cz>+                     Johan Tibell <johan.tibell@gmail.com> Stability:           Provisional Category:            Data Build-type:          Simple-Cabal-version:       >=1.2+Cabal-version:       >=1.10 Extra-source-files:  CHANGES   Library+  Default-language:  Haskell98   Exposed-modules:   Data.Hashable   Build-depends:     base >= 4.0 && < 5,-                     bytestring >= 0.9+                     bytestring >= 0.9 && < 1.0 -  C-sources:         src/hashByteString.c+  C-sources:         cbits/hashByteString.c+  Ghc-options:       -Wall++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.*++  Ghc-options:       -Wall++source-repository head+  type:     git+  location: http://github.com/tibbe/hashable.git

@@ -1,9 +0,0 @@-int hashByteString(const char* str, int len) {-  int hash = 0;--  while (len--) {-    hash = (hash * 33) ^ *str++;-  }--  return hash;-}

@@ -0,0 +1,74 @@+{-# LANGUAGE BangPatterns, 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 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++------------------------------------------------------------------------+-- * 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 Word8 where+    arbitrary = choose (97, 105)+    coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 4))++-- | Validate the implementation by comparing the C and Haskell+-- versions.+pHash :: [Word8] -> Bool+pHash xs = unsafePerformIO $ withArray xs $ \ p ->+    (hashByteArray (fromList xs) 0 len ==) `fmap` hashPtr p len+  where len = length xs++tests :: [TestOptions -> IO TestResult]+tests =+    [ run pHash+    ]++-- 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# ->+    case newByteArray# len# s1# of+        (# s2#, marr# #) -> case go s2# 0 marr# xs0 of+            s3# -> (# s3#, BA (unsafeCoerce# marr#) #)+  where+    !(I# len#) = length xs0+    go s# _         _     []           = s#+    go s# i@(I# i#) marr# ((W8# x):xs) =+        case writeWord8Array# marr# i# x s# of+            s2# -> go s2# (i + 1) marr# xs++------------------------------------------------------------------------+-- 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