diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for mono-hash +## 0.1.0.2 -- 2026-10-27 + +* Internal: replace the hand-rolled `byteSwap32`/`byteSwap64` from `Data.Hash.Mono.Internal` with the equivalents already provided by base in `Data.Word`. +* Performance: use unchecked shifts (`unsafeShiftL`/`unsafeShiftR`) instead of the bounds-checked `shiftL`/`shiftR` in the byte encoders and in the SipHash/HalfSipHash inner loop. + ## 0.1.0.1 -- 2026-10-25 * Documentation: credit the authors of FNV and SipHash/HalfSipHash. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -109,7 +109,7 @@ ## Encoding and byte order Hashing is defined over the concatenation of the elements' byte encodings. -The encoding is not type-tagged, so `[0x01, 0x02 :: Word8]` and +By design, the encoding is not type-tagged, so `[0x01, 0x02 :: Word8]` and `[0x0102 :: Word16]` hash the same bytes. `Word8` and `Int8` contribute one byte. Wider integers contribute @@ -127,6 +127,8 @@ own type: ```haskell +{-# LANGUAGE TypeApplications #-} + import Data.Hash.Mono.FNV (fnv1a) import Data.Hash.Mono.Internal.ByteFoldable (ByteFoldable (..)) import Data.Word (Word8, Word64) @@ -142,6 +144,39 @@ The bytes an instance emits are the bytes hashed, so changing an instance changes every hash of containers holding that element type. + +Because the encoding is untagged (see above), two element types with the same +underlying bytes hash alike. An instance can prevent this by folding a tag +byte of its own. Here `Rgb` and `Hsl` both hold three `Word8`, yet `0x01` and +`0x02` keep their encodings apart: + +```haskell +{-# LANGUAGE TypeApplications #-} + +import Data.Hash.Mono.FNV (fnv1a) +import Data.Hash.Mono.Internal.ByteFoldable (ByteFoldable (..)) +import Data.Word (Word8, Word64) + +data Rgb = Rgb Word8 Word8 Word8 + +data Hsl = Hsl Word8 Word8 Word8 + +instance ByteFoldable Rgb where + foldlBytes f z (Rgb r g b) = f (f (f (f z 0x01) r) g) b + +instance ByteFoldable Hsl where + foldlBytes f z (Hsl h s l) = f (f (f (f z 0x02) h) s) l + +fnv1a @Word64 [Rgb 0x12 0x34 0x56] +-- 0x49593a77a021b074 + +fnv1a @Word64 [Hsl 0x12 0x34 0x56] +-- 0x292dee90a2ab967f +``` + +Tags are a convention of the instance and are worth it when distinct types with +overlapping byte layouts would otherwise collide, such as values in a sum +type or records that share a shape. ## Formatting and linting diff --git a/mono-hash.cabal b/mono-hash.cabal --- a/mono-hash.cabal +++ b/mono-hash.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: mono-hash -version: 0.1.0.1 +version: 0.1.0.2 synopsis: Hashing for monomorphic containers. description: FNV, SipHash, and HalfSipHash hashing for monomorphic containers. @@ -35,9 +35,6 @@ Data.Hash.Mono.HalfSipHash Data.Hash.Mono.Internal.ByteFoldable Data.Hash.Mono.SipHash - - other-modules: - Data.Hash.Mono.Internal build-depends: base >=4.14.3.0 && <5, diff --git a/src/Data/Hash/Mono/HalfSipHash.hs b/src/Data/Hash/Mono/HalfSipHash.hs --- a/src/Data/Hash/Mono/HalfSipHash.hs +++ b/src/Data/Hash/Mono/HalfSipHash.hs @@ -19,11 +19,10 @@ ) where -import Data.Bits (Bits (rotateL, shiftL, shiftR, xor, (.&.), (.|.))) -import Data.Hash.Mono.Internal (byteSwap32) +import Data.Bits (Bits (rotateL, unsafeShiftL, unsafeShiftR, xor, (.&.), (.|.))) import Data.Hash.Mono.Internal.ByteFoldable (ByteFoldable (..)) import Data.MonoTraversable (Element, MonoFoldable (ofoldl')) -import Data.Word (Word32, Word64, Word8) +import Data.Word (Word32, Word64, Word8, byteSwap32) -- | Result types that 'halfSipHash' can produce. class HalfSipHashResult a where @@ -55,7 +54,7 @@ v1'' = v1' `xor` 0xdd (HalfSipData _ !v1''' _ !v3'') = halfSipRounds d (HalfSipData v0' v1'' v2'' v3') word1 = v1''' `xor` v3'' - in (fromIntegral word1 `shiftL` 32) + fromIntegral word0 + in (fromIntegral word1 `unsafeShiftL` 32) + fromIntegral word0 -- | Constraint for containers hashed with HalfSipHash. type HalfSipHashData a = (MonoFoldable a, ByteFoldable (Element a)) @@ -101,7 +100,7 @@ halfSipHash c d key mono = case ofoldl' (foldlBytes (step c)) initStream mono of HalfSipStream{hsData = state, hsWord = word, hsLen = len} -> - finalization d (compress c state (word .|. (fromIntegral len `shiftL` 24))) + finalization d (compress c state (word .|. (fromIntegral len `unsafeShiftL` 24))) where initData :: HalfSipData initData = @@ -113,7 +112,7 @@ } where k0 :: Word32 - k0 = byteSwap32 . fromIntegral $ key `shiftR` 32 + k0 = byteSwap32 . fromIntegral $ key `unsafeShiftR` 32 k1 :: Word32 k1 = byteSwap32 . fromIntegral $ key .&. 0xffffffff @@ -130,7 +129,7 @@ step :: Word -> HalfSipStream -> Word8 -> HalfSipStream step c HalfSipStream{hsData = d, hsWord = word, hsCount = n, hsLen = len} !b = - let word' = word .|. (fromIntegral b `shiftL` (8 * n)) + let word' = word .|. (fromIntegral b `unsafeShiftL` (8 * n)) len' = len + 1 in if n == 3 then HalfSipStream{hsData = compress c d word', hsWord = 0, hsCount = 0, hsLen = len'} diff --git a/src/Data/Hash/Mono/Internal.hs b/src/Data/Hash/Mono/Internal.hs deleted file mode 100644 --- a/src/Data/Hash/Mono/Internal.hs +++ /dev/null @@ -1,43 +0,0 @@ --- | Internal helpers shared by the hash implementations. -module Data.Hash.Mono.Internal ( - byteSwap64, - byteSwap32, -) -where - -import Data.Bits (Bits (shiftL, shiftR, (.&.))) -import Data.Word (Word32, Word64) - --- | Byte-swap a 'Word64'. -byteSwap64 :: Word64 -> Word64 -byteSwap64 w = - let c0 = (w `shiftR` 56) .&. 0xff - c1 = (w `shiftR` 48) .&. 0xff - c2 = (w `shiftR` 40) .&. 0xff - c3 = (w `shiftR` 32) .&. 0xff - c4 = (w `shiftR` 24) .&. 0xff - c5 = (w `shiftR` 16) .&. 0xff - c6 = (w `shiftR` 8) .&. 0xff - c7 = w .&. 0xff - in c0 - + (c1 `shiftL` 8) - + (c2 `shiftL` 16) - + (c3 `shiftL` 24) - + (c4 `shiftL` 32) - + (c5 `shiftL` 40) - + (c6 `shiftL` 48) - + (c7 `shiftL` 56) -{-# INLINEABLE byteSwap64 #-} - --- | Byte-swap a 'Word32'. -byteSwap32 :: Word32 -> Word32 -byteSwap32 w = - let c0 = (w `shiftR` 24) .&. 0xff - c1 = (w `shiftR` 16) .&. 0xff - c2 = (w `shiftR` 8) .&. 0xff - c3 = w .&. 0xff - in c0 - + (c1 `shiftL` 8) - + (c2 `shiftL` 16) - + (c3 `shiftL` 24) -{-# INLINEABLE byteSwap32 #-} diff --git a/src/Data/Hash/Mono/Internal/ByteFoldable.hs b/src/Data/Hash/Mono/Internal/ByteFoldable.hs --- a/src/Data/Hash/Mono/Internal/ByteFoldable.hs +++ b/src/Data/Hash/Mono/Internal/ByteFoldable.hs @@ -6,7 +6,7 @@ ) where -import Data.Bits (Bits (shiftR, (.&.))) +import Data.Bits (Bits (unsafeShiftR, (.&.))) import Data.Char qualified as Char import Data.Int (Int16, Int32, Int64, Int8) import Data.WideWord.Word128 (Word128 (..)) @@ -37,23 +37,23 @@ | n < 0x80 = f z (fromIntegral n) | n < 0x800 = f - (f z (fromIntegral (0xc0 + (n `shiftR` 6)))) + (f z (fromIntegral (0xc0 + (n `unsafeShiftR` 6)))) (fromIntegral (0x80 + (n .&. 0x3f))) | n < 0x10000 = f ( f - (f z (fromIntegral (0xe0 + (n `shiftR` 12)))) - (fromIntegral (0x80 + ((n `shiftR` 6) .&. 0x3f))) + (f z (fromIntegral (0xe0 + (n `unsafeShiftR` 12)))) + (fromIntegral (0x80 + ((n `unsafeShiftR` 6) .&. 0x3f))) ) (fromIntegral (0x80 + (n .&. 0x3f))) | otherwise = f ( f ( f - (f z (fromIntegral (0xf0 + (n `shiftR` 18)))) - (fromIntegral (0x80 + ((n `shiftR` 12) .&. 0x3f))) + (f z (fromIntegral (0xf0 + (n `unsafeShiftR` 18)))) + (fromIntegral (0x80 + ((n `unsafeShiftR` 12) .&. 0x3f))) ) - (fromIntegral (0x80 + ((n `shiftR` 6) .&. 0x3f))) + (fromIntegral (0x80 + ((n `unsafeShiftR` 6) .&. 0x3f))) ) (fromIntegral (0x80 + (n .&. 0x3f))) where @@ -75,7 +75,7 @@ -- | Encoded as two bytes, most significant first. instance ByteFoldable Word16 where foldlBytes f z w = - f (f z (fromIntegral (w `shiftR` 8))) (fromIntegral w) + f (f z (fromIntegral (w `unsafeShiftR` 8))) (fromIntegral w) {-# INLINE foldlBytes #-} {- | Encoded as its two's-complement bit pattern, the same bytes as the @@ -91,10 +91,10 @@ f ( f ( f - (f z (fromIntegral (w `shiftR` 24))) - (fromIntegral (w `shiftR` 16)) + (f z (fromIntegral (w `unsafeShiftR` 24))) + (fromIntegral (w `unsafeShiftR` 16)) ) - (fromIntegral (w `shiftR` 8)) + (fromIntegral (w `unsafeShiftR` 8)) ) (fromIntegral w) {-# INLINE foldlBytes #-} @@ -116,18 +116,18 @@ ( f ( f ( f - (f z (fromIntegral (w `shiftR` 56))) - (fromIntegral (w `shiftR` 48)) + (f z (fromIntegral (w `unsafeShiftR` 56))) + (fromIntegral (w `unsafeShiftR` 48)) ) - (fromIntegral (w `shiftR` 40)) + (fromIntegral (w `unsafeShiftR` 40)) ) - (fromIntegral (w `shiftR` 32)) + (fromIntegral (w `unsafeShiftR` 32)) ) - (fromIntegral (w `shiftR` 24)) + (fromIntegral (w `unsafeShiftR` 24)) ) - (fromIntegral (w `shiftR` 16)) + (fromIntegral (w `unsafeShiftR` 16)) ) - (fromIntegral (w `shiftR` 8)) + (fromIntegral (w `unsafeShiftR` 8)) ) (fromIntegral w) {-# INLINE foldlBytes #-} diff --git a/src/Data/Hash/Mono/SipHash.hs b/src/Data/Hash/Mono/SipHash.hs --- a/src/Data/Hash/Mono/SipHash.hs +++ b/src/Data/Hash/Mono/SipHash.hs @@ -16,12 +16,11 @@ ) where -import Data.Bits (Bits (rotateL, shiftL, xor, (.|.))) -import Data.Hash.Mono.Internal (byteSwap64) +import Data.Bits (Bits (rotateL, unsafeShiftL, xor, (.|.))) import Data.Hash.Mono.Internal.ByteFoldable (ByteFoldable (..)) import Data.MonoTraversable (Element, MonoFoldable (ofoldl')) import Data.WideWord.Word128 (Word128 (..)) -import Data.Word (Word64, Word8) +import Data.Word (Word64, Word8, byteSwap64) -- | Result types that 'sipHash' can produce. class SipHashResult a where @@ -99,7 +98,7 @@ sipHash c d key mono = case ofoldl' (foldlBytes (step c)) initStream mono of SipStream{ssData = state, ssWord = word, ssLen = len} -> - finalization d (compress c state (word .|. (fromIntegral len `shiftL` 56))) + finalization d (compress c state (word .|. (fromIntegral len `unsafeShiftL` 56))) where initData :: SipData initData = @@ -128,7 +127,7 @@ step :: Word -> SipStream -> Word8 -> SipStream step c SipStream{ssData = d, ssWord = word, ssCount = n, ssLen = len} !b = - let word' = word .|. (fromIntegral b `shiftL` (8 * n)) + let word' = word .|. (fromIntegral b `unsafeShiftL` (8 * n)) len' = len + 1 in if n == 7 then SipStream{ssData = compress c d word', ssWord = 0, ssCount = 0, ssLen = len'}