packages feed

hashable 1.2.0.4 → 1.2.0.5

raw patch · 8 files changed

+131/−207 lines, 8 files

Files

Data/Hashable/Class.hs view
@@ -23,7 +23,7 @@ module Data.Hashable.Class     (       -- * Computing hash values-      Hashable(..)+      Hashable(hashWithSalt) #ifdef GENERICS       -- ** Support for generics     , GHashable(..)@@ -186,6 +186,11 @@     -- implementation.     hashWithSalt :: Int -> a -> Int +    -- | (/Not public/) Hash a list of values. Used to make hashing of+    -- 'String' and 'Word8' more efficient.+    hashListWithSalt :: Int -> [a] -> Int+    hashListWithSalt = foldl' hashWithSalt+ #ifdef GENERICS     default hashWithSalt :: (Generic a, GHashable (Rep a)) => Int -> a -> Int     hashWithSalt salt = ghashWithSalt salt . from@@ -225,13 +230,11 @@ {-# INLINE hashUsing #-}  instance Hashable Int where hashWithSalt = hashNative-instance Hashable Int8 where hashWithSalt = hashNative instance Hashable Int16 where hashWithSalt = hashNative instance Hashable Int32 where hashWithSalt = hashNative instance Hashable Int64 where hashWithSalt = hash64  instance Hashable Word where hashWithSalt = hashNative-instance Hashable Word8 where hashWithSalt = hashNative instance Hashable Word16 where hashWithSalt = hashNative instance Hashable Word32 where hashWithSalt = hashNative instance Hashable Word64 where hashWithSalt = hash64@@ -239,8 +242,22 @@ instance Hashable () where hashWithSalt = hashUsing fromEnum instance Hashable Bool where hashWithSalt = hashUsing fromEnum instance Hashable Ordering where hashWithSalt = hashUsing fromEnum-instance Hashable Char where hashWithSalt = hashUsing fromEnum +instance Hashable Int8 where+    hashWithSalt = hashNative+    hashListWithSalt salt = hashUsing B.pack salt . map fromIntegral+    {-# NOINLINE hashListWithSalt #-}++instance Hashable Word8 where+    hashWithSalt = hashNative+    hashListWithSalt = hashUsing B.pack+    {-# NOINLINE hashListWithSalt #-}++instance Hashable Char where+    hashWithSalt = hashUsing fromEnum+    hashListWithSalt = hashUsing T.pack+    {-# NOINLINE hashListWithSalt #-}+ -- | Hash an integer of at most the native width supported by the -- machine. hashNative :: (Integral a) => Int -> a -> Int@@ -348,13 +365,7 @@ #endif  instance Hashable a => Hashable [a] where-    hashWithSalt = foldl' hashWithSalt--{-# RULES "hashWithSalt/String"-    forall s v. hashWithSalt s (v::[Char]) = hashWithSalt s (T.pack v) #-}--{-# RULES "hash/String"-    forall v. hash (v::[Char]) = hash (T.pack v) #-}+    hashWithSalt = hashListWithSalt  instance Hashable B.ByteString where     hashWithSalt salt bs = B.inlinePerformIO $
− Data/Hashable/SipHash.hs
@@ -1,159 +0,0 @@-{-# 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/getRandomBytes.c view
@@ -35,7 +35,7 @@  int hashable_getRandomBytes(unsigned char *dest, int nbytes); -#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +#if defined(mingw32_HOST_OS) || defined(__MINGW32__)  #include <windows.h> #include <wincrypt.h>@@ -46,9 +46,9 @@   int ret;    if (!CryptAcquireContextA(&hCryptProv, NULL, NULL, PROV_RSA_FULL,-			    CRYPT_VERIFYCONTEXT)) +			    CRYPT_VERIFYCONTEXT))     return -1;-  +   ret = CryptGenRandom(hCryptProv, (DWORD) nbytes, (BYTE *) dest) ? nbytes : -1;    CryptReleaseContext(hCryptProv, 0);@@ -70,7 +70,7 @@ {   ssize_t off, nread;   int fd;-  +   fd = open("/dev/urandom", O_RDONLY);   if (fd == -1)     return -1;
cbits/siphash-sse2.c view
@@ -4,6 +4,8 @@  *  * Used with permission.  */+#pragma GCC target("sse2")+ #include <emmintrin.h> #include "siphash.h" @@ -17,13 +19,32 @@ 	size_t i, k; 	union { u64 gpr; __m128i xmm; } hash; +	/* We used to use the _mm_seti_epi32 intrinsic to initialize+	   SSE2 registers. This compiles to a movdqa instruction,+	   which requires 16-byte alignment. On 32-bit Windows, it+	   looks like ghc's runtime linker doesn't align ".rdata"+	   sections as requested, so we got segfaults for our trouble.++	   Now we use an intrinsic that cares less about alignment+	   (_mm_loadu_si128, aka movdqu) instead, and all seems+	   happy. */++	static const u32 const iv[6][4] = {+		{ 0x70736575, 0x736f6d65, 0, 0 },+		{ 0x6e646f6d, 0x646f7261, 0, 0 },+		{ 0x6e657261, 0x6c796765, 0, 0 },+		{ 0x79746573, 0x74656462, 0, 0 },+		{ -1, -1, 0, 0 },+		{ 255, 0, 0, 0 },+	};+ 	k0 = _mm_loadl_epi64((__m128i*)(&ik0)); 	k1 = _mm_loadl_epi64((__m128i*)(&ik1)); -	v0 = _mm_xor_si128(k0, _mm_set_epi32(0, 0, 0x736f6d65, 0x70736575));-	v1 = _mm_xor_si128(k1, _mm_set_epi32(0, 0, 0x646f7261, 0x6e646f6d));-	v2 = _mm_xor_si128(k0, _mm_set_epi32(0, 0, 0x6c796765, 0x6e657261));-	v3 = _mm_xor_si128(k1, _mm_set_epi32(0, 0, 0x74656462, 0x79746573));+	v0 = _mm_xor_si128(k0, _mm_loadu_si128((__m128i*) &iv[0]));+	v1 = _mm_xor_si128(k1, _mm_loadu_si128((__m128i*) &iv[1]));+	v2 = _mm_xor_si128(k0, _mm_loadu_si128((__m128i*) &iv[2]));+	v3 = _mm_xor_si128(k1, _mm_loadu_si128((__m128i*) &iv[3]));  #define HALF_ROUND(a,b,c,d,s,t) \ 	do \@@ -46,21 +67,37 @@ 	{ 		mi = _mm_loadl_epi64((__m128i*)(m + i)); 		v3 = _mm_xor_si128(v3, mi);-		for(k = 0; k < SIPHASH_ROUNDS; ++k) COMPRESS(v0,v1,v2,v3);+		if (SIPHASH_ROUNDS == 2) {+			COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3);+		} else {+			for (k = 0; k < SIPHASH_ROUNDS; ++k)+				COMPRESS(v0,v1,v2,v3);+		} 		v0 = _mm_xor_si128(v0, mi); 	}  	mi = _mm_loadl_epi64((__m128i*)(m + i)); 	len = _mm_set_epi32(0, 0, (n&0xff) << 24, 0);-	mask = _mm_srli_epi64(_mm_set_epi32(0, 0, 0xffffffff, 0xffffffff), 8*(8-n%8));+	mask = _mm_srli_epi64(_mm_loadu_si128((__m128i*) &iv[4]), 8*(8-n%8)); 	mi = _mm_xor_si128(_mm_and_si128(mi, mask), len);  	v3 = _mm_xor_si128(v3, mi);-	for(k = 0; k < SIPHASH_ROUNDS; ++k) COMPRESS(v0,v1,v2,v3);+	if (SIPHASH_ROUNDS == 2) {+		COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3);+	} else {	+		for (k = 0; k < SIPHASH_ROUNDS; ++k)+			COMPRESS(v0,v1,v2,v3);+	} 	v0 = _mm_xor_si128(v0, mi); -	v2 = _mm_xor_si128(v2, _mm_set_epi32(0, 0, 0, 0xff));-	for(k = 0; k < SIPHASH_FINALROUNDS; ++k) COMPRESS(v0,v1,v2,v3);+	v2 = _mm_xor_si128(v2, _mm_loadu_si128((__m128i*) &iv[5]));+	if (SIPHASH_FINALROUNDS == 4) {+		COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3);+		COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3);+	} else {+		for (k = 0; k < SIPHASH_FINALROUNDS; ++k)+			COMPRESS(v0,v1,v2,v3);+	}  	v0 = _mm_xor_si128(_mm_xor_si128(v0, v1), _mm_xor_si128(v2, v3)); 	hash.xmm = v0;
cbits/siphash-sse41.c view
@@ -4,6 +4,8 @@  *  * Used with permission.  */+#pragma GCC target("sse4.1")+ #include <smmintrin.h> #include "siphash.h" 
cbits/siphash.c view
@@ -43,7 +43,7 @@     int i;      for (p = str, end = str + (len & ~7); p < end; p += 8) {-	u64 m = *(u64 *) p;+	u64 m = peek_u64le((u64 *) p); 	v3 ^= m; 	if (c == 2) { 	    SIPROUND;@@ -185,7 +185,7 @@     }      for (p = str, end = str + (len & ~7); p < end; p += 8) {-	m = *(u64 *) p;+	m = peek_u64le((u64 *) p); 	v3 ^= m; 	if (c == 2) { 	    SIPROUND;
cbits/siphash.h view
@@ -14,19 +14,54 @@ u64 hashable_siphash(int, int, u64, u64, const u8 *, size_t); u64 hashable_siphash24(u64, u64, const u8 *, size_t); -#if defined(__i386) || defined(__x86_64)+#if defined(__i386) -/* To use SSE instructions on Windows, we have to adjust the stack-   from its default of 4-byte alignment to use 16-byte alignment. */+/* To use SSE instructions, we have to adjust the stack from its+   default of 4-byte alignment to use 16-byte alignment. */ -# if defined(_WIN32)-#  define ALIGNED_STACK __attribute__((force_align_arg_pointer))-# else-#  define ALIGNED_STACK-# endif+# define ALIGNED_STACK __attribute__((force_align_arg_pointer))  u64 hashable_siphash24_sse2(u64, u64, const u8 *, size_t) ALIGNED_STACK; u64 hashable_siphash24_sse41(u64, u64, const u8 *, size_t) ALIGNED_STACK; #endif++#if defined(_WIN32)+# define __LITTLE_ENDIAN 1234+# define __BIG_ENDIAN 4321+# define __BYTE_ORDER __LITTLE_ENDIAN++#elif (defined(__FreeBSD__) && __FreeBSD_version >= 470000) || defined(__OpenBSD__) || defined(__NetBSD__)+# include <sys/endian.h>+# define __BIG_ENDIAN BIG_ENDIAN+# define __LITTLE_ENDIAN LITTLE_ENDIAN+# define __BYTE_ORDER BYTE_ORDER++#elif (defined(BSD) && (BSD >= 199103)) || defined(__APPLE__)+# include <machine/endian.h>+# define __BIG_ENDIAN BIG_ENDIAN+# define __LITTLE_ENDIAN LITTLE_ENDIAN+# define __BYTE_ORDER BYTE_ORDER++#elif defined(__linux__)+# include <endian.h>+#endif++static inline u64 peek_u64le(const u64 *p)+{+    u64 x = *p;++#if __BYTE_ORDER == __BIG_ENDIAN+    x = ((x & 0xff00000000000000ull) >> 56) |+	((x & 0x00ff000000000000ull) >> 40) |+	((x & 0x0000ff0000000000ull) >> 24) |+	((x & 0x000000ff00000000ull) >> 8) |+	((x & 0x00000000ff000000ull) << 8) |+	((x & 0x0000000000ff0000ull) << 24) |+	((x & 0x000000000000ff00ull) << 40) |+	((x & 0x00000000000000ffull) << 56);+#endif++    return x;+}  #endif /* _hashable_siphash_h */
hashable.cabal view
@@ -1,5 +1,5 @@ Name:                hashable-Version:             1.2.0.4+Version:             1.2.0.5 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@@ -38,8 +38,6 @@ Library   Exposed-modules:   Data.Hashable   Other-modules:     Data.Hashable.Class-                     Data.Hashable.RandomSource-                     Data.Hashable.SipHash   Build-depends:     base >= 4.0 && < 5.0,                      bytestring >= 0.9   if impl(ghc)@@ -52,16 +50,14 @@     CPP-Options:     -DGENERICS     Other-modules:   Data.Hashable.Generic -  C-sources:         cbits/getRandomBytes.c+  C-sources:                      cbits/inthash.c                      cbits/siphash.c   if arch(i386)     C-sources:       cbits/siphash-sse2.c-    CC-options:      -msse2      if flag(sse41)       CPP-Options:   -DHAVE_SSE41-      CC-options:    -msse41       C-sources:     cbits/siphash-sse41.c    Ghc-options:       -Wall@@ -69,8 +65,11 @@     Ghc-options: -fwarn-tabs   if flag(fixed-salt)     Cpp-options: -DFIXED_SALT-  if os(windows)-    extra-libraries: advapi32+  else+    c-sources:         cbits/getRandomBytes.c+    other-modules:     Data.Hashable.RandomSource+    if os(windows)+      extra-libraries: advapi32  Test-suite tests   Type:              exitcode-stdio-1.0@@ -100,7 +99,6 @@     Data.Hashable     Data.Hashable.Class     Data.Hashable.RandomSource-    Data.Hashable.SipHash   type: exitcode-stdio-1.0    build-depends:@@ -118,7 +116,6 @@     Build-depends:   integer-gmp >= 0.2    c-sources:-    cbits/getRandomBytes.c     cbits/inthash.c     cbits/siphash.c     benchmarks/cbits/fnv.c@@ -126,13 +123,11 @@    if arch(i386) || arch(x86_64)     cpp-options: -DHAVE_SSE2-    cc-options: -msse2     c-sources:       cbits/siphash-sse2.c      if flag(sse41)       cpp-options: -DHAVE_SSE41-      cc-options: -msse4.1       c-sources:         cbits/siphash-sse41.c @@ -141,8 +136,11 @@     Ghc-options: -fwarn-tabs   if flag(fixed-salt)     Cpp-options: -DFIXED_SALT-  if os(windows)-    extra-libraries: advapi32+  else+    c-sources:         cbits/getRandomBytes.c+    other-modules:     Data.Hashable.RandomSource+    if os(windows)+      extra-libraries: advapi32  source-repository head   type:     git