hashable 1.2.0.7 → 1.2.0.8
raw patch · 4 files changed
+168/−3 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Data/Hashable/Class.hs +4/−2
- Data/Hashable/SipHash.hs +159/−0
- cbits/siphash.c +2/−0
- hashable.cabal +3/−1
Data/Hashable/Class.hs view
@@ -276,10 +276,12 @@ instance Hashable Integer where #if defined(__GLASGOW_HASKELL__) && defined(VERSION_integer_gmp) hashWithSalt salt (S# int) = hashWithSalt salt (I# int)- hashWithSalt salt n@(J# size byteArray)+ hashWithSalt salt n@(J# size# byteArray) | n >= minInt && n <= maxInt = hashWithSalt salt (fromInteger n :: Int)- | otherwise = let numBytes = SIZEOF_HSWORD * (I# size)+ | otherwise = let size = I# size#+ numBytes = SIZEOF_HSWORD * abs size in hashByteArrayWithSalt byteArray 0 numBytes salt+ `hashWithSalt` size where minInt = fromIntegral (minBound :: Int) maxInt = fromIntegral (maxBound :: Int) #else
+ Data/Hashable/SipHash.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++module Data.Hashable.SipHash+ (+ LE64+ , Sip+ , fromWord64+ , fullBlock+ , lastBlock+ , finalize+ , hashByteString+ ) where++#include "MachDeps.h"++import Data.Bits ((.|.), (.&.), rotateL, shiftL, xor)+#if MIN_VERSION_base(4,5,0)+import Data.Bits (unsafeShiftL)+#endif+import Data.Word (Word8, Word64)+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (Ptr, castPtr, plusPtr)+import Data.ByteString.Internal (ByteString(PS), inlinePerformIO)+import Foreign.Storable (peek)+import Numeric (showHex)++newtype LE64 = LE64 { fromLE64 :: Word64 }+ deriving (Eq)++instance Show LE64 where+ show (LE64 !v) = let s = showHex v ""+ in "0x" ++ replicate (16 - length s) '0' ++ s++data Sip = Sip {+ v0 :: {-# UNPACK #-} !Word64, v1 :: {-# UNPACK #-} !Word64+ , v2 :: {-# UNPACK #-} !Word64, v3 :: {-# UNPACK #-} !Word64+ }++fromWord64 :: Word64 -> LE64+#ifndef WORDS_BIGENDIAN+fromWord64 = LE64+#else+#error big endian support TBD+#endif++initState :: (Sip -> r) -> Word64 -> Word64 -> r+initState k k0 k1 = k (Sip s0 s1 s2 s3)+ where !s0 = (k0 `xor` 0x736f6d6570736575)+ !s1 = (k1 `xor` 0x646f72616e646f6d)+ !s2 = (k0 `xor` 0x6c7967656e657261)+ !s3 = (k1 `xor` 0x7465646279746573)++sipRound :: (Sip -> r) -> Sip -> r+sipRound k Sip{..} = k (Sip v0_c v1_d v2_c v3_d)+ where v0_a = v0 + v1+ v2_a = v2 + v3+ v1_a = v1 `rotateL` 13+ v3_a = v3 `rotateL` 16+ v1_b = v1_a `xor` v0_a+ v3_b = v3_a `xor` v2_a+ v0_b = v0_a `rotateL` 32+ v2_b = v2_a + v1_b+ v0_c = v0_b + v3_b+ v1_c = v1_b `rotateL` 17+ v3_c = v3_b `rotateL` 21+ v1_d = v1_c `xor` v2_b+ v3_d = v3_c `xor` v0_c+ v2_c = v2_b `rotateL` 32++fullBlock :: Int -> LE64 -> (Sip -> r) -> Sip -> r+fullBlock c m k st@Sip{..}+ | c == 2 = sipRound (sipRound k') st'+ | otherwise = runRounds c k' st'+ where k' st1@Sip{..} = k st1{ v0 = v0 `xor` fromLE64 m }+ st' = st{ v3 = v3 `xor` fromLE64 m }+{-# INLINE fullBlock #-}++runRounds :: Int -> (Sip -> r) -> Sip -> r+runRounds c k = go 0+ where go i st+ | i < c = sipRound (go (i+1)) st+ | otherwise = k st+{-# INLINE runRounds #-}++lastBlock :: Int -> Int -> LE64 -> (Sip -> r) -> Sip -> r+lastBlock !c !len !m k st =+#ifndef WORDS_BIGENDIAN+ fullBlock c (LE64 m') k st+#else+#error big endian support TBD+#endif+ where m' = fromLE64 m .|. ((fromIntegral len .&. 0xff) `shiftL` 56)+{-# INLINE lastBlock #-}++finalize :: Int -> (Word64 -> r) -> Sip -> r+finalize d k st@Sip{..}+ | d == 4 = sipRound (sipRound (sipRound (sipRound k'))) st'+ | otherwise = runRounds d k' st'+ where k' Sip{..} = k $! v0 `xor` v1 `xor` v2 `xor` v3+ st' = st{ v2 = v2 `xor` 0xff }+{-# INLINE finalize #-}++hashByteString :: Int -> Int -> Word64 -> Word64 -> ByteString -> Word64+hashByteString !c !d k0 k1 (PS fp off len) =+ inlinePerformIO . withForeignPtr fp $ \basePtr ->+ let ptr0 = basePtr `plusPtr` off+ scant = len .&. 7+ endBlocks = ptr0 `plusPtr` (len - scant)+ go !ptr st+ | ptr == endBlocks = readLast ptr+ | otherwise = do+ m <- peekLE64 ptr+ fullBlock c m (go (ptr `plusPtr` 8)) st+ where+ zero !m _ _ = lastBlock c len (LE64 m) (finalize d return) st+ one k m p s = do+ w <- fromIntegral `fmap` peekByte p+ k (m .|. (w `unsafeShiftL` s)) (p `plusPtr` 1) (s+8)+ readLast p =+ case scant of+ 0 -> zero 0 p (0::Int)+ 1 -> one zero 0 p 0+ 2 -> one (one zero) 0 p 0+ 3 -> one (one (one zero)) 0 p 0+ 4 -> one (one (one (one zero))) 0 p 0+ 5 -> one (one (one (one (one zero)))) 0 p 0+ 6 -> one (one (one (one (one (one zero))))) 0 p 0+ _ -> one (one (one (one (one (one (one zero)))))) 0 p 0+ in initState (go ptr0) k0 k1++peekByte :: Ptr Word8 -> IO Word8+peekByte = peek++peekLE64 :: Ptr Word8 -> IO LE64+#if defined(x86_64_HOST_ARCH) || defined(i386_HOST_ARCH)+-- platforms on which unaligned loads are legal and usually fast+peekLE64 p = LE64 `fmap` peek (castPtr p)+#else+peekLE64 p = do+ let peek8 d = fromIntegral `fmap` peekByte (p `plusPtr` d)+ b0 <- peek8 0+ b1 <- peek8 1+ b2 <- peek8 2+ b3 <- peek8 3+ b4 <- peek8 4+ b5 <- peek8 5+ b6 <- peek8 6+ b7 <- peek8 7+ let !w = (b7 `shiftL` 56) .|. (b6 `shiftL` 48) .|. (b5 `shiftL` 40) .|.+ (b4 `shiftL` 32) .|. (b3 `shiftL` 24) .|. (b2 `shiftL` 16) .|.+ (b1 `shiftL` 8) .|. b0+ return (fromWord64 w)+#endif++#if !MIN_VERSION_base(4,5,0)+unsafeShiftL :: Word64 -> Int -> Word64+unsafeShiftL = shiftL+#endif
cbits/siphash.c view
@@ -107,6 +107,7 @@ :"+a" (eax), "=S" (ebx), "=c" (ecx), "=d" (edx) : :"edi"); +#if defined(HAVE_SSE2) if (edx & (1 << 26)) _siphash24 = hashable_siphash24_sse2; #if defined(HAVE_SSE41)@@ -114,6 +115,7 @@ _siphash24 = hashable_siphash24_sse41; #endif else+#endif _siphash24 = plain_siphash24; }
hashable.cabal view
@@ -1,5 +1,5 @@ Name: hashable-Version: 1.2.0.7+Version: 1.2.0.8 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@@ -58,6 +58,7 @@ cbits/inthash.c cbits/siphash.c if arch(i386) && flag(sse2)+ CPP-Options: -DHAVE_SSE2 C-sources: cbits/siphash-sse2.c if flag(sse41)@@ -110,6 +111,7 @@ Data.Hashable Data.Hashable.Class Data.Hashable.RandomSource+ Data.Hashable.SipHash type: exitcode-stdio-1.0 build-depends: