diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,8 @@ +1.3.0 +--- +* Performance improvements +* Implement a faster siphash-1-3 + 1.2.1 --- * Eq, Read, Show for SipKey diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs --- a/benchmarks/Main.hs +++ b/benchmarks/Main.hs @@ -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) + ] diff --git a/core.hs b/core.hs --- a/core.hs +++ b/core.hs @@ -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) diff --git a/hashabler.cabal b/hashabler.cabal --- a/hashabler.cabal +++ b/hashabler.cabal @@ -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 diff --git a/src/Data/Hashabler.hs b/src/Data/Hashabler.hs --- a/src/Data/Hashabler.hs +++ b/src/Data/Hashabler.hs @@ -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 + diff --git a/src/Data/Hashabler/Internal.hs b/src/Data/Hashabler/Internal.hs --- a/src/Data/Hashabler/Internal.hs +++ b/src/Data/Hashabler/Internal.hs @@ -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) $ diff --git a/src/Data/Hashabler/SipHash.hs b/src/Data/Hashabler/SipHash.hs --- a/src/Data/Hashabler/SipHash.hs +++ b/src/Data/Hashabler/SipHash.hs @@ -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 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 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 putStrLn "Assertions: On" + _ -> error "Assertions aren't working" + -- TODO better. Just bootstrap test vectors mixConstructorFNV32 :: Word8 -> Word32 -> Word32