hashabler 1.2.1 → 1.3.0
raw patch · 8 files changed
+769/−66 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.Hashabler: siphash64_1_3 :: Hashable a => SipKey -> a -> Hash64 a
- Data.Hashabler: mixType :: StableHashable a => TypeHash t -> TypeHash (t a)
+ Data.Hashabler: mixType :: forall a t. StableHashable a => TypeHash t -> TypeHash (t a)
Files
- CHANGELOG.markdown +5/−0
- benchmarks/Main.hs +432/−13
- core.hs +5/−1
- hashabler.cabal +16/−3
- src/Data/Hashabler.hs +17/−0
- src/Data/Hashabler/Internal.hs +159/−15
- src/Data/Hashabler/SipHash.hs +117/−33
- tests/Main.hs +18/−1
CHANGELOG.markdown view
@@ -1,3 +1,8 @@+1.3.0+---+* Performance improvements+* Implement a faster siphash-1-3+ 1.2.1 --- * Eq, Read, Show for SipKey
benchmarks/Main.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric,StandaloneDeriving #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main ( main@@ -12,6 +14,7 @@ import Data.Ratio import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Char8 as B8 import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL@@ -21,6 +24,7 @@ import Data.Hashabler import qualified Data.Hashable as Their + instance NFData FNV32 where rnf = rnf . fnv32 instance NFData (Hash32 a) where rnf = rnf . hashWord32 instance NFData (Hash64 a) where rnf = rnf . hashWord64@@ -43,11 +47,36 @@ main :: IO () main = do+# ifdef ASSERTIONS_ON+ error "Sorry, please reconfigure without -finstrumented so that we turn off assertions in library code."+# endif+ let bs50 = B.pack $ replicate 48 1 bs1000 = B.pack $ replicate 1000 1 t50 = T.pack $ replicate 25 'a' -- TODO verify this is 50 bytes t1000 = T.pack $ replicate 500 'a' -- TODO verify this is 1000 bytes+ --+ bs1 = B.pack $ replicate 1 1+ bs2 = B.pack $ replicate 2 1+ bs3 = B.pack $ replicate 3 1+ bs4 = B.pack $ replicate 4 1+ bs5 = B.pack $ replicate 5 1+ bs6 = B.pack $ replicate 6 1+ bs7 = B.pack $ replicate 7 1+ bs8 = B.pack $ replicate 8 1+ bs9 = B.pack $ replicate 9 1+ bs11 = B.pack $ replicate 11 1+ bs16 = B.pack $ replicate 16 1+ bs32 = B.pack $ replicate 32 1+ bs64 = B.pack $ replicate 64 1+ bs128 = B.pack $ replicate 128 1+ bs256 = B.pack $ replicate 256 1+ bs512 = B.pack $ replicate 512 1+ bs1024 = B.pack $ replicate 1024 1+ ba50 <- P.newByteArray 50 >>= \ba'-> P.fillByteArray ba' 0 50 1 >> P.unsafeFreezeByteArray ba'+ ba50Aligned <- P.newAlignedPinnedByteArray 50 (P.alignment (undefined::Word64)) >>= \ba'-> P.fillByteArray ba' 0 50 1 >> P.unsafeFreezeByteArray ba'+ ba50AlignedBadly <- P.newAlignedPinnedByteArray 50 (7) >>= \ba'-> P.fillByteArray ba' 0 50 1 >> P.unsafeFreezeByteArray ba' ba1000 <- P.newByteArray 1000 >>= \ba'-> P.fillByteArray ba' 0 1000 1 >> P.unsafeFreezeByteArray ba' -- lazy Text and ByteString: let bs50LazyTrivial = BL.fromStrict bs50@@ -93,6 +122,11 @@ , bench "[Text], hashabler" $ nf (hashWord32 . hashFNV32) allWordsListText -- TODO ByteString ],+ bgroup "compare with hashable" [+ hashableBenchmarkTheir "hashable"+ , hashableBenchmarkFNV64+ , hashableBenchmarkSiphash64+ ], bgroup "dev" [ -- We can more or less subtract this from benchmarks producing a Word32 hash: @@ -139,27 +173,108 @@ , bench "(,,,,,,,)" $ nf (hash32Times 100) (byt,byt,byt,byt,byt,byt,byt,byt) ] - , bgroup "hashFNV32 on array types" [- bench "strict ByteString x50" $ nf hashFNV32 bs50 - , bench "COMPARE ABOVE" $ nf (hashWord64 . siphash64 (SipKey 0x0706050403020100 0x0F0E0D0C0B0A0908)) bs50 -- TODO just testing+ , bgroup "on array types, hashFNV64" [+ bench "strict ByteString x50" $ nf hashFNV64 bs50 -- ought to be same as above:- , bench "trivial lazy ByteString x50" $ nf hashFNV32 bs50LazyTrivial- , bench "Text x50" $ nf hashFNV32 t50+ , bench "trivial lazy ByteString x50" $ nf hashFNV64 bs50LazyTrivial+ , bench "Text x50" $ nf hashFNV64 t50 -- ought to be same as above:- , bench "trivial lazy Text x50" $ nf hashFNV32 t50LazyTrivial- , bench "ByteArray x50" $ nf hashFNV32 ba50+ , bench "trivial lazy Text x50" $ nf hashFNV64 t50LazyTrivial+ , bench "ByteArray x50" $ nf hashFNV64 ba50+ , bench "ByteArray x50 (pinned, aligned)" $ nf hashFNV64 ba50Aligned -- (maybe non-aligned creation is aligned to word size)+ , bench "ByteArray x50 (pinned, incorrectly-aligned)" $ nf hashFNV64 ba50AlignedBadly -- (no difference here either) - , bench "ByteArray x1000" $ nf hashFNV32 ba1000- , bench "strict ByteString x1000" $ nf hashFNV32 bs1000- , bench "COMPARE ABOVE" $ nf (hashWord64 . siphash64 (SipKey 0x0706050403020100 0x0F0E0D0C0B0A0908)) bs1000 -- TODO just testing- , bench "lazy ByteString x1000, in 20 chunks" $ nf hashFNV32 bs1000Lazy_by20Chunks- , bench "Text x1000" $ nf hashFNV32 t1000- , bench "lazy Text x1000, in 20 chunks" $ nf hashFNV32 t1000Lazy_by20Chunks+ , bench "ByteArray x1000" $ nf hashFNV64 ba1000+ , bench "strict ByteString x1000" $ nf hashFNV64 bs1000+ , bench "lazy ByteString x1000, in 20 chunks" $ nf hashFNV64 bs1000Lazy_by20Chunks+ , bench "Text x1000" $ nf hashFNV64 t1000+ , bench "lazy Text x1000, in 20 chunks" $ nf hashFNV64 t1000Lazy_by20Chunks -- TODO Integer of comparable size to above -- TODO BigNat on GHC 7.10 -- TODO Natural on GHC 7.10 ] + , bgroup "on ByteStrings of various sizes, siphash64" [+ -- try to fool branch prediction in hashByteString and+ let ls = [ 1, 1, 1, 1, 1, 1, 1, 1, 1 ]+ in bench "(baseline for fooling branch prediction)" $ nf (map (Hash64 :: Word64 -> Hash64 B.ByteString)) ls+ , bench "100 (fooling branch prediction)" $ nf+ (map (hashWord64 . siphash64 (SipKey 1 2)))+ [ bs1, bs9, bs8, bs32, bs11, bs9, bs3, bs16, bs11 ]+ , bench "96 (#1 more predictable branches)" $ nf+ (map (hashWord64 . siphash64 (SipKey 1 2)))+ [ bs16, bs16, bs16, bs16, bs16, bs16 ]+ , bench "96 (#2 more predictable branches)" $ nf+ (map (hashWord64 . siphash64 (SipKey 1 2)))+ [ bs8, bs8, bs8, bs8, bs8, bs8, bs8, bs8, bs8, bs8, bs8, bs8 ]++ , bench "1" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs1+ , bench "2" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs2+ , bench "3" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs3+ , bench "4" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs4+ , bench "5" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs5+ , bench "6" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs6+ , bench "7" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs7+ , bench "8" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs8+ , bench "16" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs16+ , bench "32" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs32+ , bench "64" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs64+ , bench "128" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs128+ , bench "256" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs256+ , bench "512" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs512+ , bench "1024" $ nf (hashWord64 . siphash64 (SipKey 1 2)) bs1024+ ]+ , bgroup "on ByteStrings of various sizes, hashable" [+ -- try to fool branch prediction in hashByteString and+ let ls = [ 1, 1, 1, 1, 1, 1, 1, 1, 1 ]+ in bench "(baseline for fooling branch prediction)" $ nf (map (Hash64 :: Word64 -> Hash64 B.ByteString)) ls+ , bench "100 (fooling branch prediction)" $ nf+ (map Their.hash)+ [ bs1, bs9, bs8, bs32, bs11, bs9, bs3, bs16, bs11 ]+ , bench "96 (#1 more predictable branches)" $ nf+ (map Their.hash)+ [ bs16, bs16, bs16, bs16, bs16, bs16 ]+ , bench "96 (#2 more predictable branches)" $ nf+ (map Their.hash)+ [ bs8, bs8, bs8, bs8, bs8, bs8, bs8, bs8, bs8, bs8, bs8, bs8 ]++ , bench "1" $ nf Their.hash bs1+ , bench "2" $ nf Their.hash bs2+ , bench "3" $ nf Their.hash bs3+ , bench "4" $ nf Their.hash bs4+ , bench "5" $ nf Their.hash bs5+ , bench "6" $ nf Their.hash bs6+ , bench "7" $ nf Their.hash bs7+ , bench "8" $ nf Their.hash bs8+ , bench "16" $ nf Their.hash bs16+ , bench "32" $ nf Their.hash bs32+ , bench "64" $ nf Their.hash bs64+ , bench "128" $ nf Their.hash bs128+ , bench "256" $ nf Their.hash bs256+ , bench "512" $ nf Their.hash bs512+ , bench "1024" $ nf Their.hash bs1024+ ]+ , bgroup "on array types, siphash64" [+ bench "strict ByteString x50" $ nf (hashWord64 . siphash64 (SipKey 0x0706050403020100 0x0F0E0D0C0B0A0908)) bs50+ -- ought to be same as above:+ , bench "trivial lazy ByteString x50" $ nf (hashWord64 . siphash64 (SipKey 0x0706050403020100 0x0F0E0D0C0B0A0908)) bs50LazyTrivial+ , bench "Text x50" $ nf (hashWord64 . siphash64 (SipKey 0x0706050403020100 0x0F0E0D0C0B0A0908)) t50+ -- ought to be same as above:+ , bench "trivial lazy Text x50" $ nf (hashWord64 . siphash64 (SipKey 0x0706050403020100 0x0F0E0D0C0B0A0908)) t50LazyTrivial+ , bench "ByteArray x50" $ nf (hashWord64 . siphash64 (SipKey 0x0706050403020100 0x0F0E0D0C0B0A0908)) ba50+ , bench "ByteArray x50 (pinned, aligned)" $ nf (hashWord64 . siphash64 (SipKey 0x0706050403020100 0x0F0E0D0C0B0A0908)) ba50Aligned -- (maybe non-aligned creation is aligned to word size)+ , bench "ByteArray x50 (pinned, incorrectly-aligned)" $ nf (hashWord64 . siphash64 (SipKey 0x0706050403020100 0x0F0E0D0C0B0A0908)) ba50AlignedBadly -- (no difference here either)++ , bench "ByteArray x1000" $ nf (hashWord64 . siphash64 (SipKey 0x0706050403020100 0x0F0E0D0C0B0A0908)) ba1000+ , bench "strict ByteString x1000" $ nf (hashWord64 . siphash64 (SipKey 0x0706050403020100 0x0F0E0D0C0B0A0908)) bs1000+ , bench "lazy ByteString x1000, in 20 chunks" $ nf (hashWord64 . siphash64 (SipKey 0x0706050403020100 0x0F0E0D0C0B0A0908)) bs1000Lazy_by20Chunks+ , bench "Text x1000" $ nf (hashWord64 . siphash64 (SipKey 0x0706050403020100 0x0F0E0D0C0B0A0908)) t1000+ , bench "lazy Text x1000, in 20 chunks" $ nf (hashWord64 . siphash64 (SipKey 0x0706050403020100 0x0F0E0D0C0B0A0908)) t1000Lazy_by20Chunks+ -- TODO Integer of comparable size to above+ -- TODO BigNat on GHC 7.10+ -- TODO Natural on GHC 7.10+ ]+ , listBgroup "medium-size lists" 250 -- In line with above, although NoList variants win out by a greater margin:@@ -167,3 +282,307 @@ ] ]++++-- --------------------------------------------------------+-- Sorry, couldn't figure out how to turn these into CPP macros:+++-- Taken from 'hashable' Benchmarks.hs @47eaf9f:+hashableBenchmarkFNV64 :: Benchmark+{-# INLINE hashableBenchmarkFNV64 #-}+hashableBenchmarkFNV64 =+ let+ !mb = (2::Int)^(20 :: Int) -- 1 Mb+ s5 = ['\0'..'\4']; s8 = ['\0'..'\7']; s11 = ['\0'..'\10']+ s40 = ['\0'..'\39']; s128 = ['\0'..'\127']; s512 = ['\0'..'\511']+ s1Mb = ['\0'..'\999999']++ !bs5 = B8.pack s5; !bs8 = B8.pack s8; !bs11 = B8.pack s11+ !bs40 = B8.pack s40; !bs128 = B8.pack s128; !bs512 = B8.pack s512+ !bs1Mb = B8.pack s1Mb++ blmeg = BL.take (fromIntegral mb) . BL.fromChunks . repeat+ bl5 = BL.fromChunks [bs5]; bl8 = BL.fromChunks [bs8]+ bl11 = BL.fromChunks [bs11]; bl40 = BL.fromChunks [bs40]+ bl128 = BL.fromChunks [bs128]; bl512 = BL.fromChunks [bs512]+ bl1Mb_40 = blmeg bs40; bl1Mb_128 = blmeg bs128+ bl1Mb_64k = blmeg (B8.take 65536 bs1Mb)++ !t5 = T.pack s5; !t8 = T.pack s8; !t11 = T.pack s11+ !t40 = T.pack s40; !t128 = T.pack s128; !t512 = T.pack s512+ !t1Mb = T.pack s1Mb++ tlmeg = TL.take (fromIntegral mb) . TL.fromChunks . repeat+ tl5 = TL.fromStrict t5; tl8 = TL.fromStrict t8+ tl11 = TL.fromStrict t11; tl40 = TL.fromStrict t40+ tl128 = TL.fromStrict t128; tl512 = TL.fromChunks (replicate 4 t128)+ tl1Mb_40 = tlmeg t40; tl1Mb_128 = tlmeg t128+ tl1Mb_64k = tlmeg (T.take 65536 t1Mb)+ in bgroup "hashabler hashFNV64"+ [ bgroup "ByteString"+ [ bgroup "strict"+ [ bench "5" $ whnf (hashWord64 . hashFNV64) bs5+ , bench "8" $ whnf (hashWord64 . hashFNV64) bs8+ , bench "11" $ whnf (hashWord64 . hashFNV64) bs11+ , bench "40" $ whnf (hashWord64 . hashFNV64) bs40+ , bench "128" $ whnf (hashWord64 . hashFNV64) bs128+ , bench "512" $ whnf (hashWord64 . hashFNV64) bs512+ , bench "2^20" $ whnf (hashWord64 . hashFNV64) bs1Mb+ ]+ , bgroup "lazy"+ [ bench "5" $ whnf (hashWord64 . hashFNV64) bl5+ , bench "8" $ whnf (hashWord64 . hashFNV64) bl8+ , bench "11" $ whnf (hashWord64 . hashFNV64) bl11+ , bench "40" $ whnf (hashWord64 . hashFNV64) bl40+ , bench "128" $ whnf (hashWord64 . hashFNV64) bl128+ , bench "512" $ whnf (hashWord64 . hashFNV64) bl512+ , bench "2^20_40" $ whnf (hashWord64 . hashFNV64) bl1Mb_40+ , bench "2^20_128" $ whnf (hashWord64 . hashFNV64) bl1Mb_128+ , bench "2^20_64k" $ whnf (hashWord64 . hashFNV64) bl1Mb_64k+ ]+ ]+ , bgroup "String"+ [ bench "5" $ whnf (hashWord64 . hashFNV64) s5+ , bench "8" $ whnf (hashWord64 . hashFNV64) s8+ , bench "11" $ whnf (hashWord64 . hashFNV64) s11+ , bench "40" $ whnf (hashWord64 . hashFNV64) s40+ , bench "128" $ whnf (hashWord64 . hashFNV64) s128+ , bench "512" $ whnf (hashWord64 . hashFNV64) s512+ , bench "2^20" $ whnf (hashWord64 . hashFNV64) s1Mb+ ]+ , bgroup "Text"+ [ bgroup "strict"+ [ bench "5" $ whnf (hashWord64 . hashFNV64) t5+ , bench "8" $ whnf (hashWord64 . hashFNV64) t8+ , bench "11" $ whnf (hashWord64 . hashFNV64) t11+ , bench "40" $ whnf (hashWord64 . hashFNV64) t40+ , bench "128" $ whnf (hashWord64 . hashFNV64) t128+ , bench "512" $ whnf (hashWord64 . hashFNV64) t512+ , bench "2^20" $ whnf (hashWord64 . hashFNV64) t1Mb+ ]+ , bgroup "lazy"+ [ bench "5" $ whnf (hashWord64 . hashFNV64) tl5+ , bench "8" $ whnf (hashWord64 . hashFNV64) tl8+ , bench "11" $ whnf (hashWord64 . hashFNV64) tl11+ , bench "40" $ whnf (hashWord64 . hashFNV64) tl40+ , bench "128" $ whnf (hashWord64 . hashFNV64) tl128+ , bench "512" $ whnf (hashWord64 . hashFNV64) tl512+ , bench "2^20_40" $ whnf (hashWord64 . hashFNV64) tl1Mb_40+ , bench "2^20_128" $ whnf (hashWord64 . hashFNV64) tl1Mb_128+ , bench "2^20_64k" $ whnf (hashWord64 . hashFNV64) tl1Mb_64k+ ]+ ]+ , bench "Int8" $ whnf (hashWord64 . hashFNV64) (127 :: Int8)+ , bench "Int16" $ whnf (hashWord64 . hashFNV64) (0x7eef :: Int16)+ , bench "Int32" $ whnf (hashWord64 . hashFNV64) (0x7eadbeef :: Int32)+ , bench "Int" $ whnf (hashWord64 . hashFNV64) (0x7eadbeefdeadbeef :: Int)+ , bench "Int64" $ whnf (hashWord64 . hashFNV64) (0x7eadbeefdeadbeef :: Int64)+ , bench "Double" $ whnf (hashWord64 . hashFNV64) (0.3780675796601578 :: Double)+ ]++-- Taken from 'hashable' Benchmarks.hs @47eaf9f:+hashableBenchmarkSiphash64 :: Benchmark+{-# INLINE hashableBenchmarkSiphash64 #-}+hashableBenchmarkSiphash64 =+ let+ !mb = (2::Int)^(20 :: Int) -- 1 Mb+ s5 = ['\0'..'\4']; s8 = ['\0'..'\7']; s11 = ['\0'..'\10']+ s40 = ['\0'..'\39']; s128 = ['\0'..'\127']; s512 = ['\0'..'\511']+ s1Mb = ['\0'..'\999999']++ !bs5 = B8.pack s5; !bs8 = B8.pack s8; !bs11 = B8.pack s11+ !bs40 = B8.pack s40; !bs128 = B8.pack s128; !bs512 = B8.pack s512+ !bs1Mb = B8.pack s1Mb++ blmeg = BL.take (fromIntegral mb) . BL.fromChunks . repeat+ bl5 = BL.fromChunks [bs5]; bl8 = BL.fromChunks [bs8]+ bl11 = BL.fromChunks [bs11]; bl40 = BL.fromChunks [bs40]+ bl128 = BL.fromChunks [bs128]; bl512 = BL.fromChunks [bs512]+ bl1Mb_40 = blmeg bs40; bl1Mb_128 = blmeg bs128+ bl1Mb_64k = blmeg (B8.take 65536 bs1Mb)++ !t5 = T.pack s5; !t8 = T.pack s8; !t11 = T.pack s11+ !t40 = T.pack s40; !t128 = T.pack s128; !t512 = T.pack s512+ !t1Mb = T.pack s1Mb++ tlmeg = TL.take (fromIntegral mb) . TL.fromChunks . repeat+ tl5 = TL.fromStrict t5; tl8 = TL.fromStrict t8+ tl11 = TL.fromStrict t11; tl40 = TL.fromStrict t40+ tl128 = TL.fromStrict t128; tl512 = TL.fromChunks (replicate 4 t128)+ tl1Mb_40 = tlmeg t40; tl1Mb_128 = tlmeg t128+ tl1Mb_64k = tlmeg (T.take 65536 t1Mb)+ in bgroup "hashabler siphash64"+ [ bgroup "ByteString"+ [ bgroup "strict"+ [ bench "5" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bs5+ , bench "8" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bs8+ , bench "11" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bs11+ , bench "40" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bs40+ , bench "128" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bs128+ , bench "512" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bs512+ , bench "2^20" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bs1Mb+ ]+ , bgroup "strict (with siphash-1-3)" -- TODO make proper benchmark set for siphash64_1_3+ [ bench "5" $ whnf (hashWord64 . siphash64_1_3 (SipKey 1 2)) bs5+ , bench "8" $ whnf (hashWord64 . siphash64_1_3 (SipKey 1 2)) bs8+ , bench "11" $ whnf (hashWord64 . siphash64_1_3 (SipKey 1 2)) bs11+ , bench "40" $ whnf (hashWord64 . siphash64_1_3 (SipKey 1 2)) bs40+ , bench "128" $ whnf (hashWord64 . siphash64_1_3 (SipKey 1 2)) bs128+ , bench "512" $ whnf (hashWord64 . siphash64_1_3 (SipKey 1 2)) bs512+ , bench "2^20" $ whnf (hashWord64 . siphash64_1_3 (SipKey 1 2)) bs1Mb+ ]+ , bgroup "lazy"+ [ bench "5" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bl5+ , bench "8" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bl8+ , bench "11" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bl11+ , bench "40" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bl40+ , bench "128" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bl128+ , bench "512" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bl512+ , bench "2^20_40" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bl1Mb_40+ , bench "2^20_128" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bl1Mb_128+ , bench "2^20_64k" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) bl1Mb_64k+ ]+ ]+ , bgroup "String"+ [ bench "5" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) s5+ , bench "8" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) s8+ , bench "11" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) s11+ , bench "40" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) s40+ , bench "128" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) s128+ , bench "512" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) s512+ , bench "2^20" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) s1Mb+ ]+ , bgroup "Text"+ [ bgroup "strict"+ [ bench "5" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) t5+ , bench "8" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) t8+ , bench "11" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) t11+ , bench "40" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) t40+ , bench "128" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) t128+ , bench "512" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) t512+ , bench "2^20" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) t1Mb+ ]+ , bgroup "strict (with siphash-1-3)" -- TODO make proper benchmark set for siphash64_1_3+ [ bench "5" $ whnf (hashWord64 . siphash64_1_3 (SipKey 1 2)) t5+ , bench "8" $ whnf (hashWord64 . siphash64_1_3 (SipKey 1 2)) t8+ , bench "11" $ whnf (hashWord64 . siphash64_1_3 (SipKey 1 2)) t11+ , bench "40" $ whnf (hashWord64 . siphash64_1_3 (SipKey 1 2)) t40+ , bench "128" $ whnf (hashWord64 . siphash64_1_3 (SipKey 1 2)) t128+ , bench "512" $ whnf (hashWord64 . siphash64_1_3 (SipKey 1 2)) t512+ , bench "2^20" $ whnf (hashWord64 . siphash64_1_3 (SipKey 1 2)) t1Mb+ ]+ , bgroup "lazy"+ [ bench "5" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) tl5+ , bench "8" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) tl8+ , bench "11" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) tl11+ , bench "40" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) tl40+ , bench "128" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) tl128+ , bench "512" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) tl512+ , bench "2^20_40" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) tl1Mb_40+ , bench "2^20_128" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) tl1Mb_128+ , bench "2^20_64k" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) tl1Mb_64k+ ]+ ]+ , bench "Int8" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) (127 :: Int8)+ , bench "Int16" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) (0x7eef :: Int16)+ , bench "Int32" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) (0x7eadbeef :: Int32)+ , bench "Int" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) (0x7eadbeefdeadbeef :: Int)+ , bench "Int64" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) (0x7eadbeefdeadbeef :: Int64)+ , bench "Double" $ whnf (hashWord64 . siphash64 (SipKey 1 2)) (0.3780675796601578 :: Double)+ ]+++-- Same as above; just couldn't quite figure out how to get this to work+hashableBenchmarkTheir :: String -> Benchmark+{-# INLINE hashableBenchmarkTheir #-}+hashableBenchmarkTheir nm =+ let+ !mb = (2::Int)^(20 :: Int) -- 1 Mb+ s5 = ['\0'..'\4']; s8 = ['\0'..'\7']; s11 = ['\0'..'\10']+ s40 = ['\0'..'\39']; s128 = ['\0'..'\127']; s512 = ['\0'..'\511']+ s1Mb = ['\0'..'\999999']++ !bs5 = B8.pack s5; !bs8 = B8.pack s8; !bs11 = B8.pack s11+ !bs40 = B8.pack s40; !bs128 = B8.pack s128; !bs512 = B8.pack s512+ !bs1Mb = B8.pack s1Mb++ blmeg = BL.take (fromIntegral mb) . BL.fromChunks . repeat+ bl5 = BL.fromChunks [bs5]; bl8 = BL.fromChunks [bs8]+ bl11 = BL.fromChunks [bs11]; bl40 = BL.fromChunks [bs40]+ bl128 = BL.fromChunks [bs128]; bl512 = BL.fromChunks [bs512]+ bl1Mb_40 = blmeg bs40; bl1Mb_128 = blmeg bs128+ bl1Mb_64k = blmeg (B8.take 65536 bs1Mb)++ !t5 = T.pack s5; !t8 = T.pack s8; !t11 = T.pack s11+ !t40 = T.pack s40; !t128 = T.pack s128; !t512 = T.pack s512+ !t1Mb = T.pack s1Mb++ tlmeg = TL.take (fromIntegral mb) . TL.fromChunks . repeat+ tl5 = TL.fromStrict t5; tl8 = TL.fromStrict t8+ tl11 = TL.fromStrict t11; tl40 = TL.fromStrict t40+ tl128 = TL.fromStrict t128; tl512 = TL.fromChunks (replicate 4 t128)+ tl1Mb_40 = tlmeg t40; tl1Mb_128 = tlmeg t128+ tl1Mb_64k = tlmeg (T.take 65536 t1Mb)+ in bgroup nm+ [ bgroup "ByteString"+ [ bgroup "strict"+ [ bench "5" $ whnf Their.hash bs5+ , bench "8" $ whnf Their.hash bs8+ , bench "11" $ whnf Their.hash bs11+ , bench "40" $ whnf Their.hash bs40+ , bench "128" $ whnf Their.hash bs128+ , bench "512" $ whnf Their.hash bs512+ , bench "2^20" $ whnf Their.hash bs1Mb+ ]+ , bgroup "lazy"+ [ bench "5" $ whnf Their.hash bl5+ , bench "8" $ whnf Their.hash bl8+ , bench "11" $ whnf Their.hash bl11+ , bench "40" $ whnf Their.hash bl40+ , bench "128" $ whnf Their.hash bl128+ , bench "512" $ whnf Their.hash bl512+ , bench "2^20_40" $ whnf Their.hash bl1Mb_40+ , bench "2^20_128" $ whnf Their.hash bl1Mb_128+ , bench "2^20_64k" $ whnf Their.hash bl1Mb_64k+ ]+ ]+ , bgroup "String"+ [ bench "5" $ whnf Their.hash s5+ , bench "8" $ whnf Their.hash s8+ , bench "11" $ whnf Their.hash s11+ , bench "40" $ whnf Their.hash s40+ , bench "128" $ whnf Their.hash s128+ , bench "512" $ whnf Their.hash s512+ , bench "2^20" $ whnf Their.hash s1Mb+ ]+ , bgroup "Text"+ [ bgroup "strict"+ [ bench "5" $ whnf Their.hash t5+ , bench "8" $ whnf Their.hash t8+ , bench "11" $ whnf Their.hash t11+ , bench "40" $ whnf Their.hash t40+ , bench "128" $ whnf Their.hash t128+ , bench "512" $ whnf Their.hash t512+ , bench "2^20" $ whnf Their.hash t1Mb+ ]+ , bgroup "lazy"+ [ bench "5" $ whnf Their.hash tl5+ , bench "8" $ whnf Their.hash tl8+ , bench "11" $ whnf Their.hash tl11+ , bench "40" $ whnf Their.hash tl40+ , bench "128" $ whnf Their.hash tl128+ , bench "512" $ whnf Their.hash tl512+ , bench "2^20_40" $ whnf Their.hash tl1Mb_40+ , bench "2^20_128" $ whnf Their.hash tl1Mb_128+ , bench "2^20_64k" $ whnf Their.hash tl1Mb_64k+ ]+ ]+ , bench "Int8" $ whnf Their.hash (127 :: Int8)+ , bench "Int16" $ whnf Their.hash (0x7eef :: Int16)+ , bench "Int32" $ whnf Their.hash (0x7eadbeef :: Int32)+ , bench "Int" $ whnf Their.hash (0x7eadbeefdeadbeef :: Int)+ , bench "Int64" $ whnf Their.hash (0x7eadbeefdeadbeef :: Int64)+ , bench "Double" $ whnf Their.hash (0.3780675796601578 :: Double)+ ]
core.hs view
@@ -2,10 +2,14 @@ module Main (main) where import Data.Word+import qualified Data.ByteString.Char8 as C import Data.Hashabler +-- neat; ghc fully evaluates this hash at compile time before core:+-- main = print $ siphash64 (SipKey 1 2) (1::Word64, 2::Word32, 3::Word16, 4::Word8) -main = print $ siphash64 (SipKey 1 2) (1::Word64, 2::Word32, 3::Word16, 4::Word8)+main =+ C.getLine >>= print . siphash64 (SipKey 1 2) {- main = print $ (hash32Times 1000000000) (9999::Word32)
hashabler.cabal view
@@ -1,5 +1,5 @@ name: hashabler-version: 1.2.1+version: 1.3.0 synopsis: Principled, portable & extensible hashing of data and types, including an implementation of the FNV-1a and SipHash algorithms. description: This package is a rewrite of the @hashable@ library by Milan Straka and@@ -62,9 +62,17 @@ -- TODO did this solve our issues with having executable sections and hackage deps?: Manual: True +Flag instrumented+ Description: Enables assertions in library code. When --enable-library-profiling and --enable-executable-profiling is turned on, you can get stacktraces as well+ Default: False+ Manual: True+ library if flag(dev) CPP-Options: -DEXPORT_INTERNALS+ if flag(instrumented)+ ghc-options: -fno-ignore-asserts+ ghc-prof-options: -fprof-auto -auto-all -caf-all exposed-modules: Data.Hashabler other-modules: MachDeps, Data.Hashabler.Internal, Data.Hashabler.SipHash@@ -102,6 +110,8 @@ , Vectors.SipHash ghc-options: -Wall -O2 -threaded -funbox-strict-fields -fno-ignore-asserts+ if flag(instrumented)+ CPP-Options: -DASSERTIONS_ON if flag(dev) buildable: True build-depends: base@@ -124,6 +134,8 @@ main-is: Main.hs ghc-options: -Wall -O2 -threaded -funbox-strict-fields hs-source-dirs: benchmarks+ if flag(instrumented)+ CPP-Options: -DASSERTIONS_ON if flag(dev) buildable: True build-depends: base@@ -145,7 +157,7 @@ type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: Main.hs- ghc-options: -Wall -O2 -threaded -funbox-strict-fields+ ghc-options: -O2 -threaded -funbox-strict-fields hs-source-dirs: viz if flag(dev) buildable: True@@ -173,12 +185,13 @@ build-depends: base , hashabler+ , bytestring else buildable: False if flag(dev) ghc-options: -ddump-to-file -ddump-simpl -dsuppress-module-prefixes -dsuppress-uniques -ddump-core-stats -ddump-inlinings- ghc-options: -O2 -rtsopts + ghc-options: -O2 -rtsopts -funbox-strict-fields -- Either do threaded for eventlogging and simple timing... --ghc-options: -threaded -eventlog
src/Data/Hashabler.hs view
@@ -35,6 +35,7 @@ -} , SipKey(..) , siphash64+ , siphash64_1_3 , siphash128 -- ** Hashing with the FNV-1a algorithm@@ -163,8 +164,24 @@ , bytes32, bytes64, floatToWord, doubleToWord , _byteSwap32, _byteSwap64, _hash32Integer, _hash32_Word_64, _hash32_Int_64 , _bytes64_32 , _bytes64_64, _signByte+ , assertionCanary #endif ) where import Data.Hashabler.Internal import Data.Hashabler.SipHash++#ifdef EXPORT_INTERNALS+import Control.Exception++-- This could go anywhere, and lets us ensure that assertions are turned on+-- when running test suite.+assertionCanary :: IO Bool+assertionCanary = do+ assertionsWorking <- try $ assert False $ return ()+ return $+ case assertionsWorking of+ Left (AssertionFailed _) -> True+ _ -> False+#endif+
src/Data/Hashabler/Internal.hs view
@@ -42,9 +42,6 @@ import Data.Version(Version, versionBranch) import Data.Unique(Unique, hashUnique) --- for reading the bytes of ByteStrings:-import System.IO.Unsafe (unsafeDupablePerformIO)- -- For getting our Int from ThreadId: import Foreign.C (CInt(..)) import GHC.Conc(ThreadId(..))@@ -95,6 +92,21 @@ import Unsafe.Coerce +-- for reading the bytes of ByteStrings:+# if MIN_VERSION_bytestring(0,10,6)+-- This eliminates ~5ns overhead vs unsafeDupablePerformIO. We don't understand+-- the implications but will use it in the same way it's used in ByteString.+import Data.ByteString.Internal(accursedUnutterablePerformIO)+# else+import System.IO.Unsafe (unsafeDupablePerformIO)++----------------------------- END IMPORTS --------------------------------++accursedUnutterablePerformIO :: IO a -> a+accursedUnutterablePerformIO = unsafeDupablePerformIO+# endif++ -- COMMENTED BELOW, WHEN FOUND NOT BENEFICIAL: -- These should be fine in all cases: coerceInt32Word32 :: Int32 -> Word32@@ -367,7 +379,6 @@ instance HashState FNV32 where {-# INLINE mix8 #-} mix8 (FNV32 h32) = \b-> FNV32 $ (h32 `xor` fromIntegral b) * fnvPrime32- -- TODO look at inlining -- | Hash a value using the standard spec-prescribed 32-bit seed value.@@ -386,7 +397,6 @@ instance HashState FNV64 where {-# INLINE mix8 #-} mix8 (FNV64 h64) = \b-> FNV64 $ (h64 `xor` fromIntegral b) * fnvPrime64- -- TODO look at inlining -- | Hash a value using the standard spec-prescribed 64-bit seed value. This@@ -1147,37 +1157,173 @@ -- WISHLIST: -- - :: Word64 -> (Word32,Word32) for 32-bit machines. +-- TODO PERFORMANCE:+-- x try using peek, where: peekByteOff addr off = peek (addr `plusPtr` off)+-- (if it works add elsewhere)+-- - when we have branch pred test:+-- x try doing single conditional check at beginning to determine code path to take (whether we can skip hashRemainingBytes)+-- x can we do branchless be using a function pointer (or a haskell array of functions)?+-- - also make preferential use of mix16/mix32+-- - we can enumerate all possibilities with a case, matching all rem bytes 0-7.+-- X try moving unsafe calls closer into branches make things not in monad+-- X (then test again with unsafeDupablePerformIO+-- - look again at core+-- - consider Text improvements+-- - try again making hash8ByteLoop a totally self-recursive function, or combine with hashRemainingBytes + -- This is about twice as fast as a loop with single byte peeks: hashByteString :: (HashState h)=> h -> B.ByteString -> h {-# INLINE hashByteString #-}-hashByteString h = \(B.PS fp off lenBytes) -> unsafeDupablePerformIO $+hashByteString h = \(B.PS fp off lenBytes) ->+ -- similar to: https://github.com/haskell/bytestring/blob/dd3c07d115840d13482426a0084a39201eb6b6d4/Data/ByteString/Unsafe.hs#L78+ -- 'hashable' also uses this.+ accursedUnutterablePerformIO $ withForeignPtr fp $ \base -> let !bytesRem = lenBytes .&. 7 -- lenBytes `mod` 8+ !ixOutOfBounds = off+lenBytes -- index where we begin to read (bytesRem < 8) individual bytes:- !bytesIx = off+lenBytes-bytesRem- !ixFinal = off+lenBytes-1+ !bytesIx = ixOutOfBounds-bytesRem hash8ByteLoop !hAcc !ix | ix == bytesIx = hashRemainingBytes hAcc bytesIx | otherwise = assert (ix < bytesIx) $ do+ -- TODO do we need to worry about alignment constraints for peek here?+ -- Test with new bytestring, and using 'drop' 1, 2, 3 etc+ -- Also benchmark these.+ -- TODO PERFORMANCE: especially if above is necessary:+ -- try eliminating a branch advancing ix by 0 for remaining byts of a word, so we replicate last byte w64Dirty <- peekByteOff base ix let w64 = if littleEndian then byteSwap64 w64Dirty else w64Dirty hash8ByteLoop (hAcc `mix64` w64) (ix + 8)- - -- TODO we could unroll this for [0..7], and/or call mix16 and mix32+ hashRemainingBytes !hAcc !ix - | ix > ixFinal = return hAcc - | otherwise = assert (ix <= ixFinal) $ do+ | ix == ixOutOfBounds = return hAcc+ | otherwise = assert (ix < ixOutOfBounds) $ do byt <- peekByteOff base ix hashRemainingBytes (hAcc `mix8` byt) (ix+1)- + in hash8ByteLoop h off +{- +import Foreign.Ptr (castPtr, plusPtr)+import Foreign.Storable (peek) +-- This is about twice as fast as a loop with single byte peeks:+hashByteString :: (HashState h)=> h -> B.ByteString -> h+{-# INLINE hashByteString #-}+hashByteString h = \(B.PS fp off lenBytes) ->+ -- similar to: https://github.com/haskell/bytestring/blob/dd3c07d115840d13482426a0084a39201eb6b6d4/Data/ByteString/Unsafe.hs#L78+ accursedUnutterablePerformIO $+ withForeignPtr fp $ \base ->+ let !bytesRem = lenBytes .&. 7 -- lenBytes `mod` 8+ !ix0 = base `plusPtr` off+ !ixOutOfBounds = ix0 `plusPtr` lenBytes+ -- index where we begin to read (bytesRem < 8) individual bytes:+ !bytesIx = ixOutOfBounds `plusPtr` negate bytesRem++ hash8ByteLoop !hAcc !ix + | ix == bytesIx = hashRemainingBytes hAcc (castPtr bytesIx)+ | otherwise = assert (ix < bytesIx) $ do+ w64Dirty <- peek ix -- (base `plusPtr` ix)+ let w64 = if littleEndian+ then byteSwap64 w64Dirty+ else w64Dirty++ hash8ByteLoop (hAcc `mix64` w64) (ix `plusPtr` 8)++ hashRemainingBytes !hAcc !ix + | ix == ixOutOfBounds = return hAcc+ | otherwise = assert (ix < ixOutOfBounds) $ do+ byt <- peek ix+ hashRemainingBytes (hAcc `mix8` byt) (ix `plusPtr` 1)++ in hash8ByteLoop h ix0+-}+{- FAILED UNFOLDING EXPERIMENT #1+-- import GHC.Prim(tagToEnum#)++-- This is about twice as fast as a loop with single byte peeks:+hashByteString :: (HashState h)=> h -> B.ByteString -> h+{-# INLINE hashByteString #-}+hashByteString h = \(B.PS fp off lenBytes) ->+ -- similar to: https://github.com/haskell/bytestring/blob/dd3c07d115840d13482426a0084a39201eb6b6d4/Data/ByteString/Unsafe.hs#L78+ accursedUnutterablePerformIO $+ withForeignPtr fp $ \base ->+ let !bytesRem = lenBytes .&. 7 -- lenBytes `mod` 8+ !word64Chunks = lenBytes `unsafeShiftR` 3 -- `div` 8+ !ixOutOfBounds = off+lenBytes+ -- index where we begin to read (bytesRem < 8) individual bytes:+ !bytesIx = ixOutOfBounds-bytesRem++ hash8ByteLoop !hAcc !ix + | ix == bytesIx = return hAcc+ -- | ix == bytesIx = hashRemainingBytes hAcc bytesIx+ | otherwise = assert (ix < bytesIx) $ do+ w64Dirty <- peekByteOff base ix+ let w64 = if littleEndian+ then byteSwap64 w64Dirty+ else w64Dirty++ hash8ByteLoop (hAcc `mix64` w64) (ix + 8)++ hashRemainingBytes !hAcc !ix + | ix == ixOutOfBounds = return hAcc+ | otherwise = assert (ix < ixOutOfBounds) $ do+ byt <- peekByteOff base ix+ hashRemainingBytes (hAcc `mix8` byt) (ix+1)++ -- TODO - Inline,+ -- - try nested, non-tuple case+ -- - move accursed... into here+ -- - tagToEnum to get jump table+ in case tagToEnum word64Chunks of+ N0-> case tagToEnum bytesRem of+ -- small, no need for hash8ByteLoop+ N1 -> mix8 h <$> peekByteOff base off+ N2 -> mix16 h <$> peekByteOff base off+ N3 -> do+ hAcc <- mix16 h <$> peekByteOff base off+ mix8 hAcc <$> peekByteOff base (off+2)+ N4 -> mix32 h <$> peekByteOff base off+ N5 -> do+ hAcc <- mix32 h <$> peekByteOff base off+ mix8 hAcc <$> peekByteOff base (off+4)+ N6 -> do+ hAcc <- mix32 h <$> peekByteOff base off+ mix16 hAcc <$> peekByteOff base (off+4)+ _ -> assert (bytesRem == 7) $ do+ hAcc <- mix32 h <$> peekByteOff base off+ hAcc' <- mix16 hAcc <$> peekByteOff base (off+4)+ mix8 hAcc' <$> peekByteOff base (off+6)+ -- no need for hashRemainingBytes+ _ -> case bytesRem of+ 0 -> hash8ByteLoop h off+ _ -> error "TODO"+ -- for some word64 chunks:+ -- (1, _) -> + -- (2, _) -> + -- (3, _) ->+ -- (4, _) ->+ -- (5, _) ->+ -- (6, _) ->+ -- (7, _) ->++tagToEnum :: Int -> N+{-# INLINE tagToEnum #-}+tagToEnum (I# i#) = tagToEnum# i# :: N+data N = N0 | N1 | N2 | N3 | N4 | N5 | N6 | N7 | N8+-}+++-- TODO PERFORMANCE:+-- copy ByteString benchmark+-- try out an incorrect version with mix64+-- if faster try out mix64 with proper endian adjustments.+ -- NOTE: we can't simply call hashByteArray here; Text is stored as -- machine-endian UTF-16 (as promised by public Data.Text.Foreign), so we need -- to read Word16 here in order to hash as Big-Endian UTF-16.@@ -1201,7 +1347,6 @@ w3 = P.indexByteArray ba (ix+3) in hash4Word16sLoop (hAcc `mix16` w0 `mix16` w1 `mix16` w2 `mix16` w3) (ix + 4) - -- TODO we could unroll this for [0..3] hashRemainingWord16s !hAcc !ix | ix > ixFinal = hAcc | otherwise = assert (ix <= ixFinal) $@@ -1231,7 +1376,6 @@ in hash8ByteLoop (hAcc `mix64` w64) (ix + 1) - -- TODO we could unroll this for [0..7], and/or call mix16 and mix32 hashRemainingBytes !hAcc !ix | ix > ixFinal = hAcc | otherwise = assert (ix <= ixFinal) $
src/Data/Hashabler/SipHash.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE RecordWildCards, BangPatterns, CPP #-} module Data.Hashabler.SipHash ( siphash64+ , siphash64_1_3 , siphash128 , SipKey(..) ) where@@ -32,12 +33,13 @@ -- #define ROTL(x,b) (uint64_t)( ((x) << (b)) | ( (x) >> (64 - (b))) ) rotl :: Word64 -> Int -> Word64 {-# INLINE rotl #-}-rotl x b = (x `unsafeShiftL` b) .|. (x `unsafeShiftR` (64 - b))+rotl x b = assert (b > 0 && b < 64) $+ (x `unsafeShiftL` b) .|. (x `unsafeShiftR` (64 - b)) -sipRound :: Word64 -> Word64 -> Word64 -> Word64 -> (Word64, Word64, Word64, Word64)-{-# INLINE sipRound #-}-sipRound v0 v1 v2 v3 = runIdentity $ do+sipRound :: Word64 -> Word64 -> Word64 -> Word64 -> Identity (Word64, Word64, Word64, Word64)+{-# INLINE[2] sipRound #-}+sipRound v0 v1 v2 v3 = do v0 <- return $ v0 + v1 v1 <- return $ rotl v1 13 v1 <- return $ v1 `xor` v0@@ -57,7 +59,32 @@ v2 <- return $ rotl v2 32 return (v0, v1, v2, v3) +-- to promote inlining:+sipRounds :: Int -> Word64 -> Word64 -> Word64 -> Word64 -> Identity (Word64, Word64, Word64, Word64)+{-# INLINE[3] sipRounds #-}+sipRounds 0 = error "The number of rounds must be > 0" +sipRounds 1 = \v0 v1 v2 v3 -> do+ sipRound v0 v1 v2 v3+sipRounds 2 = \v0 v1 v2 v3 -> do + (v0,v1,v2,v3) <- sipRound v0 v1 v2 v3+ sipRound v0 v1 v2 v3+sipRounds 3 = \v0 v1 v2 v3 -> do + (v0,v1,v2,v3) <- sipRound v0 v1 v2 v3+ (v0,v1,v2,v3) <- sipRound v0 v1 v2 v3+ sipRound v0 v1 v2 v3+sipRounds 4 = \v0 v1 v2 v3 -> do + (v0,v1,v2,v3) <- sipRound v0 v1 v2 v3+ (v0,v1,v2,v3) <- sipRound v0 v1 v2 v3+ (v0,v1,v2,v3) <- sipRound v0 v1 v2 v3+ sipRound v0 v1 v2 v3+sipRounds n = go n where+ go 0 v0 v1 v2 v3 = return (v0,v1,v2,v3)+ go n' v0 v1 v2 v3 = do+ (v0,v1,v2,v3) <- sipRound v0 v1 v2 v3+ go (n'-1) v0 v1 v2 v3 ++ -- | A 128-bit secret key. This should be generated randomly and must be kept -- secret. data SipKey = SipKey !Word64 !Word64@@ -75,13 +102,29 @@ , inlen :: !Word64 -- ^ we'll accumulate this as we consume } deriving Eq -instance HashState SipState where- mix8 st m = siphashForWord st m- mix16 st m = siphashForWord st m- mix32 st m = siphashForWord st m- mix64 st m = siphashForWord st m+-- NOTE: we tried to include cROUNDS in SipState and let cROUNDS and dROUNDS be+-- specified directly by the user at the call-site, but couldn't figure out how+-- to avoid a performance regression. Instead for now we use this unfortunate+-- scheme, and duplicate the body of siphash64 for siphash64_1_3. +-- Wrappers for different cROUNDS:+newtype Sip_2 = Sip_2 SipState+newtype Sip_1 = Sip_1 SipState++instance HashState Sip_2 where+ mix8 (Sip_2 st) m = Sip_2 $ siphashForWord 2 st m+ mix16 (Sip_2 st) m = Sip_2 $ siphashForWord 2 st m+ mix32 (Sip_2 st) m = Sip_2 $ siphashForWord 2 st m+ mix64 (Sip_2 st) m = Sip_2 $ siphashForWord 2 st m++instance HashState Sip_1 where+ mix8 (Sip_1 st) m = Sip_1 $ siphashForWord 1 st m+ mix16 (Sip_1 st) m = Sip_1 $ siphashForWord 1 st m+ mix32 (Sip_1 st) m = Sip_1 $ siphashForWord 1 st m+ mix64 (Sip_1 st) m = Sip_1 $ siphashForWord 1 st m++ -- Corresponds to body of loop: -- for ( ; in != end; in += 8 ) -- with special handling for the way we accumulate chunks of input until it@@ -99,10 +142,10 @@ # else Bits m # endif- )=> SipState -> m -> SipState+ )=> Int -> SipState -> m -> SipState {-# INLINE siphashForWord #-}-siphashForWord (SipState{ .. }) m = runIdentity $- assert (bytesRemaining > 0 && bytesRemaining <= 8) $ +siphashForWord cROUNDS (SipState{ .. }) m = runIdentity $+ assert (bytesRemaining > 0 && bytesRemaining <= 8) $ case compare bytesRemaining mSize of -- room in mPart with room leftover GT -> do mPart <- orMparts mPart m@@ -149,24 +192,34 @@ mSize = case mSizeBits of 8 -> 1 ; 16 -> 2 ; 32 -> 4 ; 64 -> 8 ; _ -> error "Impossible size!" {-# INLINE orMparts #-}- orMparts mPart m = return $ + orMparts mPart m = return $ (mPart `unsafeShiftL` mSizeBits) .|. (fromIntegral m) {-# INLINE sipMix #-} sipMix v0 v1 v2 v3 m = do v3 <- return $ v3 `xor` m -- for( i=0; i<cROUNDS; ++i ) SIPROUND;- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3+ (v0,v1,v2,v3) <- sipRounds cROUNDS v0 v1 v2 v3 v0 <- return $ v0 `xor` m return (v0,v1,v2,v3) +-- TODO PERFORMANCE:+-- - look at crazy branches in ByteString impl and try to eliminate.+-- -Using Ints might help+-- -See the branchless ghc wiki page.+-- -Look for eliminating `case`+-- - fiddling w/ ptr arith and unsafe bullshit thing in bytestring instance.+-- x play with tagToEnum in siphashForWord -- | An implementation of 64-bit siphash-2-4. -- -- This function is fast on 64-bit machines, and provides very good hashing -- properties and protection against hash flooding attacks.+--+-- This uses the \"standard\" recommended parameters of 2 and 4 rounds,+-- recommended by the original paper, but 'siphash64_1_3' may be a faster and+-- equally secure choice. siphash64 :: Hashable a => SipKey -> a -> Hash64 a {-# INLINE siphash64 #-} siphash64 (SipKey k0 k1) = \a-> runIdentity $ do@@ -184,30 +237,68 @@ let mPart = 0 bytesRemaining = 8 inlen = 0- SipState{ .. } <- return $ hash (SipState { .. }) a+ (Sip_2 SipState{ .. }) <- return $ hash (Sip_2 $ SipState { .. }) a let !b = inlen `unsafeShiftL` 56 b <- return $ b .|. mPart v3 <- return $ v3 `xor` b -- for( i=0; i<cROUNDS; ++i ) SIPROUND;- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3+ (v0,v1,v2,v3) <- sipRounds 2 v0 v1 v2 v3 v0 <- return $ v0 `xor` b -- 0xff may be "Any non-zero value": v2 <- return $ v2 `xor` 0xff -- for( i=0; i<dROUNDS; ++i ) SIPROUND;- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3+ (v0,v1,v2,v3) <- sipRounds 4 v0 v1 v2 v3 return $! Hash64 $! v0 `xor` v1 `xor` v2 `xor` v3 +-- | An implementation of 64-bit siphash-1-3.+--+-- This is somewhat faster than siphash-2-4 (implemented in 'siphash64'), while+-- the authors claim it should still offer good protection against known+-- attacks. This is currently the standard hash function used in the Rust+-- language.+siphash64_1_3 :: Hashable a => SipKey -> a -> Hash64 a+{-# INLINE siphash64_1_3 #-}+siphash64_1_3 (SipKey k0 k1) = \a-> runIdentity $ do+ let v0 = 0x736f6d6570736575+ v1 = 0x646f72616e646f6d+ v2 = 0x6c7967656e657261+ v3 = 0x7465646279746573++ v3 <- return $ v3 `xor` k1;+ v2 <- return $ v2 `xor` k0;+ v1 <- return $ v1 `xor` k1;+ v0 <- return $ v0 `xor` k0;++ -- Initialize rest of SipState:+ let mPart = 0+ bytesRemaining = 8+ inlen = 0+ (Sip_1 SipState{ .. }) <- return $ hash (Sip_1 $ SipState { .. }) a++ let !b = inlen `unsafeShiftL` 56+ b <- return $ b .|. mPart++ v3 <- return $ v3 `xor` b+ -- for( i=0; i<cROUNDS; ++i ) SIPROUND;+ (v0,v1,v2,v3) <- sipRounds 1 v0 v1 v2 v3+ v0 <- return $ v0 `xor` b++ -- 0xff may be "Any non-zero value":+ v2 <- return $ v2 `xor` 0xff++-- for( i=0; i<dROUNDS; ++i ) SIPROUND;+ (v0,v1,v2,v3) <- sipRounds 3 v0 v1 v2 v3++ return $! Hash64 $! v0 `xor` v1 `xor` v2 `xor` v3++ -- TODO if we extend this approach beyond 128-bits, then re-combine as much as -- possible (at least factor out up until final mixing. @@ -235,15 +326,14 @@ let mPart = 0 bytesRemaining = 8 inlen = 0- SipState{ .. } <- return $ hash (SipState { .. }) a+ (Sip_2 SipState{ .. }) <- return $ hash (Sip_2 $ SipState { .. }) a let !b = inlen `unsafeShiftL` 56 b <- return $ b .|. mPart v3 <- return $ v3 `xor` b -- for( i=0; i<cROUNDS; ++i ) SIPROUND;- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3+ (v0,v1,v2,v3) <- sipRounds 2 v0 v1 v2 v3 v0 <- return $ v0 `xor` b -- N.B. 0xff CHANGED to 0xee in 128:@@ -251,20 +341,14 @@ v2 <- return $ v2 `xor` 0xee -- for( i=0; i<dROUNDS; ++i ) SIPROUND;- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3+ (v0,v1,v2,v3) <- sipRounds 4 v0 v1 v2 v3 let !b0 = v0 `xor` v1 `xor` v2 `xor` v3 -- N.B. ADDED in 128: v1 <- return $ v1 `xor` 0xdd -- for( i=0; i<dROUNDS; ++i ) SIPROUND;- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3- (v0,v1,v2,v3) <- return $ sipRound v0 v1 v2 v3+ (v0,v1,v2,v3) <- sipRounds 4 v0 v1 v2 v3 let !b1 = v0 `xor` v1 `xor` v2 `xor` v3
tests/Main.hs view
@@ -21,12 +21,12 @@ import System.IO import System.Environment(getArgs)-import Control.Exception(assert) import Consistency(generatedVectorsDir, checkGeneratedVectors, regenerateVectors) import System.Directory import Control.Monad import Control.Applicative import Data.List+import Control.Exception import Data.Word import Data.Int@@ -63,10 +63,27 @@ testsMain :: IO () testsMain = do+# ifdef ASSERTIONS_ON+ checkAssertionsOn+# else+ putStrLn "!!! WARNING !!!: assertions not turned on in library code. configure with -finstrumented if you want to run tests with assertions enabled (it's good to test with both)"+# endif checkMiscUnitTests checkHashableInstances checkVectors checkSiphashSanity+ putStrLn "ALL TESTS PASSED"++checkAssertionsOn :: IO ()+checkAssertionsOn = do+ -- Make sure testing environment is sane:+ assertionsWorking <- try $ assert False $ return ()+ assertionsWorkingInLib <- assertionCanary+ case assertionsWorking of+ Left (AssertionFailed _)+ | assertionsWorkingInLib -> putStrLn "Assertions: On"+ _ -> error "Assertions aren't working"+ -- TODO better. Just bootstrap test vectors mixConstructorFNV32 :: Word8 -> Word32 -> Word32