hashable 1.2.5.0 → 1.2.6.0
raw patch · 5 files changed
+140/−32 lines, 5 filesdep +deepseqdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: deepseq
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- CHANGES.md +6/−0
- Data/Hashable/Class.hs +45/−14
- Data/Hashable/Generic.hs +51/−13
- hashable.cabal +4/−3
- tests/Regress.hs +34/−2
CHANGES.md view
@@ -1,3 +1,9 @@+## Version 1.2.6.0++ * Add support for type-indexed `Typeable`.++ * Rework the `Generic` hashable for sums.+ ## Version 1.2.5.0 * Add `Hashable1` and `Hashable2`
Data/Hashable/Class.hs view
@@ -1,5 +1,14 @@ {-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,- ScopedTypeVariables, UnliftedFFITypes, DeriveDataTypeable #-}+ ScopedTypeVariables, UnliftedFFITypes #-}++#if __GLASGOW_HASKELL__ < 710+{-# LANGUAGE DeriveDataTypeable #-}+#endif++#if __GLASGOW_HASKELL__ >= 801+{-# LANGUAGE PolyKinds #-} -- For TypeRep instances+#endif+ #ifdef GENERICS {-# LANGUAGE DefaultSignatures, FlexibleContexts, GADTs, MultiParamTypeClasses, EmptyDataDecls #-}@@ -56,9 +65,9 @@ import Control.Applicative (Const(..)) import Control.Exception (assert)+import Control.DeepSeq (NFData(rnf)) import Data.Bits (shiftL, shiftR, xor) import qualified Data.ByteString as B-import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Unsafe as B import Data.Int (Int8, Int16, Int32, Int64)@@ -68,7 +77,6 @@ import qualified Data.Text.Array as TA import qualified Data.Text.Internal as T import qualified Data.Text.Lazy as TL-import Data.Typeable (Typeable, TypeRep) import Data.Version (Version(..)) import Data.Word (Word8, Word16, Word32, Word64) import Foreign.C (CString)@@ -78,7 +86,7 @@ import GHC.Base (ByteArray#) import GHC.Conc (ThreadId(..)) import GHC.Prim (ThreadId#)-import System.IO.Unsafe (unsafePerformIO)+import System.IO.Unsafe (unsafeDupablePerformIO) import System.Mem.StableName import Data.Unique (Unique, hashUnique) @@ -101,14 +109,17 @@ import GHC.Generics #endif -#if __GLASGOW_HASKELL__ >= 710-import Data.Typeable (typeRepFingerprint)+#if __GLASGOW_HASKELL__ >= 801+import Type.Reflection (typeRepFingerprint, Typeable, TypeRep, SomeTypeRep(..)) import GHC.Fingerprint.Type(Fingerprint(..))+#elif __GLASGOW_HASKELL__ >= 710+import Data.Typeable (typeRepFingerprint, Typeable, TypeRep)+import GHC.Fingerprint.Type(Fingerprint(..)) #elif __GLASGOW_HASKELL__ >= 702-import Data.Typeable.Internal (TypeRep (..))+import Data.Typeable.Internal (Typeable, TypeRep (..)) import GHC.Fingerprint.Type(Fingerprint(..)) #elif __GLASGOW_HASKELL__ >= 606-import Data.Typeable (typeRepKey)+import Data.Typeable (typeRepKey, Typeable, TypeRep) #endif #if __GLASGOW_HASKELL__ >= 703@@ -267,11 +278,10 @@ defaultLiftHashWithSalt :: (Hashable2 f, Hashable a) => (Int -> b -> Int) -> Int -> f a b -> Int defaultLiftHashWithSalt h = liftHashWithSalt2 hashWithSalt h --- Since we support a generic implementation of 'hashWithSalt' we+-- | Since we support a generic implementation of 'hashWithSalt' we -- cannot also provide a default implementation for that method for -- the non-generic instance use case. Instead we provide -- 'defaultHashWith'.- defaultHashWithSalt :: Hashable a => Int -> a -> Int defaultHashWithSalt salt x = salt `combine` hash x @@ -443,7 +453,7 @@ | isIEEE x = assert (sizeOf x >= sizeOf (0::Word32) && alignment x >= alignment (0::Word32)) $- hash ((unsafePerformIO $ with x $ peek . castPtr) :: Word32)+ hash ((unsafeDupablePerformIO $ with x $ peek . castPtr) :: Word32) | otherwise = hash (show x) hashWithSalt = defaultHashWithSalt @@ -452,7 +462,7 @@ | isIEEE x = assert (sizeOf x >= sizeOf (0::Word64) && alignment x >= alignment (0::Word64)) $- hash ((unsafePerformIO $ with x $ peek . castPtr) :: Word64)+ hash ((unsafeDupablePerformIO $ with x $ peek . castPtr) :: Word64) | otherwise = hash (show x) hashWithSalt = defaultHashWithSalt @@ -591,7 +601,7 @@ step (SP s l) x = SP (h s x) (l + 1) instance Hashable B.ByteString where- hashWithSalt salt bs = B.inlinePerformIO $+ hashWithSalt salt bs = unsafeDupablePerformIO $ B.unsafeUseAsCStringLen bs $ \(p, len) -> hashPtrWithSalt p (fromIntegral len) salt @@ -641,6 +651,7 @@ hash n = fromIntegral n hashWithSalt = defaultHashWithSalt +#if __GLASGOW_HASKELL__ < 801 -- | Compute the hash of a TypeRep, in various GHC versions we can do this quickly. hashTypeRep :: TypeRep -> Int {-# INLINE hashTypeRep #-}@@ -651,7 +662,7 @@ -- Fingerprint is just the MD5, so taking any Int from it is fine hashTypeRep (TypeRep (Fingerprint x _) _ _) = fromIntegral x #elif __GLASGOW_HASKELL__ >= 606-hashTypeRep = B.inlinePerformIO . typeRepKey+hashTypeRep = unsafeDupablePerformIO . typeRepKey #else hashTypeRep = hash . show #endif@@ -661,6 +672,23 @@ hashWithSalt = defaultHashWithSalt {-# INLINE hash #-} +#else++hashTypeRep :: Type.Reflection.TypeRep a -> Int+hashTypeRep tr =+ let Fingerprint x _ = typeRepFingerprint tr in fromIntegral x++instance Hashable Type.Reflection.SomeTypeRep where+ hash (Type.Reflection.SomeTypeRep r) = hashTypeRep r+ hashWithSalt = defaultHashWithSalt+ {-# INLINE hash #-}++instance Hashable (Type.Reflection.TypeRep a) where+ hash = hashTypeRep+ hashWithSalt = defaultHashWithSalt+ {-# INLINE hash #-}+#endif+ #if MIN_VERSION_base(4,8,0) instance Hashable Void where hashWithSalt _ = absurd@@ -854,6 +882,9 @@ instance F.Foldable Hashed where foldr f acc (Hashed a _) = f a acc++instance NFData a => NFData (Hashed a) where+ rnf = rnf . unhashed -- | 'Hashed' cannot be 'Functor' mapHashed :: Hashable b => (a -> b) -> Hashed a -> Hashed b
Data/Hashable/Generic.hs view
@@ -22,7 +22,6 @@ import Data.Hashable.Class import GHC.Generics - -- Type without constructors instance GHashable arity V1 where ghashWithSalt _ salt _ = hashWithSalt salt ()@@ -52,25 +51,64 @@ instance (Hashable1 f, GHashable One g) => GHashable One (f :.: g) where ghashWithSalt targs salt = liftHashWithSalt (ghashWithSalt targs) salt . unComp1 -class GSum arity f where- hashSum :: HashArgs arity a -> Int -> Int -> Int -> f a -> Int+class SumSize f => GSum arity f where+ hashSum :: HashArgs arity a -> Int -> Int -> f a -> Int+ -- hashSum args salt index value = ... -instance (GSum arity a, GSum arity b, SumSize a, SumSize b) => GHashable arity (a :+: b) where- ghashWithSalt toHash salt = hashSum toHash salt 0 size- where size = unTagged (sumSize :: Tagged (a :+: b))+-- [Note: Hashing a sum type]+--+-- The tree structure is used in GHC.Generics to represent the sum (and+-- product) part of the generic represention of the type, e.g.:+--+-- (C0 ... :+: C1 ...) :+: (C2 ... :+: (C3 ... :+: C4 ...))+--+-- The value constructed with C2 constructor is represented as (R1 (L1 ...)).+-- Yet, if we think that this tree is a flat (heterogenous) list:+--+-- [C0 ..., C1 ..., C2 ..., C3 ..., C4... ]+--+-- then the value constructed with C2 is a (dependent) pair (2, ...), and+-- hashing it is simple:+--+-- salt `hashWithSalt` (2 :: Int) `hashWithSalt` ...+--+-- This is what we do below. When drilling down the tree, we count how many+-- leafs are to the left (`index` variable). At the leaf case C1, we'll have an+-- actual index into the sum.+--+-- This works well for balanced data. However for recursive types like:+--+-- data Nat = Z | S Nat+--+-- the `hashWithSalt salt (S (S (S Z)))` is+--+-- salt `hashWithSalt` (1 :: Int) -- first S+-- `hashWithSalt` (1 :: Int) -- second S+-- `hashWithSalt` (1 :: Int) -- third S+-- `hashWithSalt` (0 :: Int) -- Z+-- `hashWithSalt` () -- U1+--+-- For that type the manual implementation:+--+-- instance Hashable Nat where+-- hashWithSalt salt n = hashWithSalt salt (natToInteger n)+--+-- would be better performing CPU and hash-quality wise (assuming that+-- Integer's Hashable is of high quality).+--+instance (GSum arity a, GSum arity b) => GHashable arity (a :+: b) where+ ghashWithSalt toHash salt = hashSum toHash salt 0 instance (GSum arity a, GSum arity b) => GSum arity (a :+: b) where- hashSum toHash !salt !code !size s = case s of- L1 x -> hashSum toHash salt code sizeL x- R1 x -> hashSum toHash salt (code + sizeL) sizeR x+ hashSum toHash !salt !index s = case s of+ L1 x -> hashSum toHash salt index x+ R1 x -> hashSum toHash salt (index + sizeL) x where- sizeL = size `shiftR` 1- sizeR = size - sizeL+ sizeL = unTagged (sumSize :: Tagged a) {-# INLINE hashSum #-} instance GHashable arity a => GSum arity (C1 c a) where- -- hashSum toHash !salt !code _ (M1 x) = ghashWithSalt toHash (hashWithSalt salt code) x- hashSum toHash !salt !code _ (M1 x) = hashWithSalt salt (ghashWithSalt toHash code x)+ hashSum toHash !salt !index (M1 x) = ghashWithSalt toHash (hashWithSalt salt index) x {-# INLINE hashSum #-} class SumSize f where
hashable.cabal view
@@ -1,5 +1,5 @@ Name: hashable-Version: 1.2.5.0+Version: 1.2.6.0 Synopsis: A class for types that can be converted to a hash value Description: This package defines a class, 'Hashable', for types that can be converted to a hash value. This class@@ -46,8 +46,9 @@ Exposed-modules: Data.Hashable Data.Hashable.Lifted Other-modules: Data.Hashable.Class- Build-depends: base >= 4.0 && < 4.10,- bytestring >= 0.9 && < 0.11+ Build-depends: base >= 4.0 && < 4.11,+ bytestring >= 0.9 && < 0.11,+ deepseq >= 1.3 if impl(ghc) Build-depends: ghc-prim, text >= 0.11.0.5
tests/Regress.hs view
@@ -1,15 +1,47 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-} module Regress (regressions) where import qualified Test.Framework as F+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit ((@=?))+import GHC.Generics (Generic)+import Data.List (nub) #ifdef HAVE_MMAP import qualified Regress.Mmap as Mmap #endif +import Data.Hashable+ regressions :: [F.Test]-regressions = []+regressions = [] ++ #ifdef HAVE_MMAP- ++ Mmap.regressions+ Mmap.regressions ++ #endif+ [ F.testGroup "Generic: sum of nullary constructors"+ [ testCase "0" $ nullaryCase 0 S0+ , testCase "1" $ nullaryCase 1 S1+ , testCase "2" $ nullaryCase 2 S2+ , testCase "3" $ nullaryCase 3 S3+ , testCase "4" $ nullaryCase 4 S4+ ]+ , testCase "Generic: Peano https://github.com/tibbe/hashable/issues/135" $ do+ let ns = take 20 $ iterate S Z+ let hs = map hash ns+ hs @=? nub hs+ ]+ where+ nullaryCase :: Int -> SumOfNullary -> IO ()+ nullaryCase n s = do+ let salt = 42+ let expected = salt `hashWithSalt` n `hashWithSalt` ()+ let actual = hashWithSalt salt s+ expected @=? actual++data SumOfNullary = S0 | S1 | S2 | S3 | S4 deriving (Generic)+instance Hashable SumOfNullary++data Nat = Z | S Nat deriving (Generic)+instance Hashable Nat