Hello community, here is the log from the commit of package ghc-hashable for openSUSE:Factory checked in at 2017-03-14 10:04:46 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hashable (Old) and /work/SRC/openSUSE:Factory/.ghc-hashable.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hashable" Tue Mar 14 10:04:46 2017 rev:10 rq:461632 version:1.2.5.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hashable/ghc-hashable.changes 2016-07-21 08:12:13.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-hashable.new/ghc-hashable.changes 2017-03-14 10:04:49.079067071 +0100 @@ -1,0 +2,5 @@ +Sun Feb 12 14:20:09 UTC 2017 - [email protected] + +- Update to version 1.2.5.0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- hashable-1.2.4.0.tar.gz New: ---- hashable-1.2.5.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hashable.spec ++++++ --- /var/tmp/diff_new_pack.qHrcHi/_old 2017-03-14 10:04:49.806964001 +0100 +++ /var/tmp/diff_new_pack.qHrcHi/_new 2017-03-14 10:04:49.810963435 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-hashable # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,15 +19,14 @@ %global pkg_name hashable %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.2.4.0 +Version: 1.2.5.0 Release: 0 Summary: A class for types that can be converted to a hash value License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-bytestring-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-text-devel @@ -41,7 +40,6 @@ BuildRequires: ghc-test-framework-quickcheck2-devel BuildRequires: ghc-unix-devel %endif -# End cabal-rpm deps %description This package defines a class, 'Hashable', for types that can be converted to a @@ -63,23 +61,17 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ifarch i586 %define cabal_configure_options -f"-sse2" %endif %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache @@ -93,6 +85,6 @@ %files devel -f %{name}-devel.files %defattr(-,root,root,-) -%doc README.md +%doc CHANGES.md README.md examples %changelog ++++++ hashable-1.2.4.0.tar.gz -> hashable-1.2.5.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/CHANGES.md new/hashable-1.2.5.0/CHANGES.md --- old/hashable-1.2.4.0/CHANGES.md 2016-01-14 20:32:59.000000000 +0100 +++ new/hashable-1.2.5.0/CHANGES.md 2017-01-02 09:44:38.000000000 +0100 @@ -1,3 +1,11 @@ +## Version 1.2.5.0 + + * Add `Hashable1` and `Hashable2` + + * Add instances for: `Eq1`, `Ord1`, `Show1`, `Ptr`, `FunPtr`, `IntPtr`, `WordPtr` + + * Add `Hashed` type for caching the `hash` function result. + ## Version 1.2.4.0 * Add instances for: Unique, Version, Fixed, NonEmpty, Min, Max, Arg, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/Data/Hashable/Class.hs new/hashable-1.2.5.0/Data/Hashable/Class.hs --- old/hashable-1.2.4.0/Data/Hashable/Class.hs 2016-01-14 20:32:59.000000000 +0100 +++ new/hashable-1.2.5.0/Data/Hashable/Class.hs 2017-01-02 09:44:38.000000000 +0100 @@ -1,7 +1,8 @@ {-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash, - ScopedTypeVariables, UnliftedFFITypes #-} + ScopedTypeVariables, UnliftedFFITypes, DeriveDataTypeable #-} #ifdef GENERICS -{-# LANGUAGE DefaultSignatures, FlexibleContexts #-} +{-# LANGUAGE DefaultSignatures, FlexibleContexts, GADTs, + MultiParamTypeClasses, EmptyDataDecls #-} #endif ------------------------------------------------------------------------ @@ -24,9 +25,14 @@ ( -- * Computing hash values Hashable(..) + , Hashable1(..) + , Hashable2(..) #ifdef GENERICS -- ** Support for generics , GHashable(..) + , HashArgs(..) + , Zero + , One #endif -- * Creating new instances @@ -35,8 +41,20 @@ , hashPtrWithSalt , hashByteArray , hashByteArrayWithSalt + , defaultHashWithSalt + -- * Higher Rank Functions + , hashWithSalt1 + , hashWithSalt2 + , defaultLiftHashWithSalt + -- * Caching hashes + , Hashed + , hashed + , unhashed + , mapHashed + , traverseHashed ) where +import Control.Applicative (Const(..)) import Control.Exception (assert) import Data.Bits (shiftL, shiftR, xor) import qualified Data.ByteString as B @@ -50,12 +68,12 @@ import qualified Data.Text.Array as TA import qualified Data.Text.Internal as T import qualified Data.Text.Lazy as TL -import Data.Typeable +import Data.Typeable (Typeable, TypeRep) import Data.Version (Version(..)) import Data.Word (Word8, Word16, Word32, Word64) import Foreign.C (CString) import Foreign.Marshal.Utils (with) -import Foreign.Ptr (Ptr, castPtr) +import Foreign.Ptr (Ptr, FunPtr, IntPtr, WordPtr, castPtr, castFunPtrToPtr, ptrToIntPtr) import Foreign.Storable (alignment, peek, sizeOf) import GHC.Base (ByteArray#) import GHC.Conc (ThreadId(..)) @@ -64,19 +82,33 @@ import System.Mem.StableName import Data.Unique (Unique, hashUnique) +-- As we use qualified F.Foldable, we don't get warnings with newer base +import qualified Data.Foldable as F + +#if MIN_VERSION_base(4,7,0) +import Data.Proxy (Proxy) +#endif + #if MIN_VERSION_base(4,7,0) import Data.Fixed (Fixed(..)) #endif +#if MIN_VERSION_base(4,8,0) +import Data.Functor.Identity (Identity(..)) +#endif + #ifdef GENERICS import GHC.Generics #endif #if __GLASGOW_HASKELL__ >= 710 +import Data.Typeable (typeRepFingerprint) import GHC.Fingerprint.Type(Fingerprint(..)) #elif __GLASGOW_HASKELL__ >= 702 -import Data.Typeable.Internal(TypeRep(..)) +import Data.Typeable.Internal (TypeRep (..)) import GHC.Fingerprint.Type(Fingerprint(..)) +#elif __GLASGOW_HASKELL__ >= 606 +import Data.Typeable (typeRepKey) #endif #if __GLASGOW_HASKELL__ >= 703 @@ -128,8 +160,15 @@ #if MIN_VERSION_base(4,9,0) import qualified Data.List.NonEmpty as NE import Data.Semigroup +import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..),showsUnaryWith) + +import Data.Functor.Compose (Compose(..)) +import qualified Data.Functor.Product as FP +import qualified Data.Functor.Sum as FS #endif +import Data.String (IsString(..)) + #include "MachDeps.h" infixl 0 `hashWithSalt` @@ -182,14 +221,52 @@ hash = hashWithSalt defaultSalt #ifdef GENERICS - default hashWithSalt :: (Generic a, GHashable (Rep a)) => Int -> a -> Int - hashWithSalt salt = ghashWithSalt salt . from + default hashWithSalt :: (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int + hashWithSalt salt = ghashWithSalt HashArgs0 salt . from + +data Zero +data One + +data HashArgs arity a where + HashArgs0 :: HashArgs Zero a + HashArgs1 :: (Int -> a -> Int) -> HashArgs One a -- | The class of types that can be generically hashed. -class GHashable f where - ghashWithSalt :: Int -> f a -> Int +class GHashable arity f where + ghashWithSalt :: HashArgs arity a -> Int -> f a -> Int + +#endif + +class Hashable1 t where + -- | Lift a hashing function through the type constructor. + liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int +#ifdef GENERICS + default liftHashWithSalt :: (Generic1 t, GHashable One (Rep1 t)) => (Int -> a -> Int) -> Int -> t a -> Int + liftHashWithSalt h salt = ghashWithSalt (HashArgs1 h) salt . from1 #endif +class Hashable2 t where + -- | Lift a hashing function through the binary type constructor. + liftHashWithSalt2 :: (Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int + +-- | Lift the 'hashWithSalt' function through the type constructor. +-- +-- > hashWithSalt1 = liftHashWithSalt hashWithSalt +hashWithSalt1 :: (Hashable1 f, Hashable a) => Int -> f a -> Int +hashWithSalt1 = liftHashWithSalt hashWithSalt + +-- | Lift the 'hashWithSalt' function through the type constructor. +-- +-- > hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt +hashWithSalt2 :: (Hashable2 f, Hashable a, Hashable b) => Int -> f a b -> Int +hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt + +-- | Lift the 'hashWithSalt' function halfway through the type constructor. +-- This function makes a suitable default implementation of 'liftHashWithSalt', +-- given that the type constructor @t@ in question can unify with @f a@. +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 -- cannot also provide a default implementation for that method for -- the non-generic instance use case. Instead we provide @@ -389,48 +466,93 @@ instance Hashable a => Hashable (Maybe a) where hash Nothing = 0 hash (Just a) = distinguisher `hashWithSalt` a - hashWithSalt s Nothing = s `combine` 0 - hashWithSalt s (Just a) = s `combine` distinguisher `hashWithSalt` a + hashWithSalt = hashWithSalt1 + +instance Hashable1 Maybe where + liftHashWithSalt _ s Nothing = s `combine` 0 + liftHashWithSalt h s (Just a) = s `combine` distinguisher `h` a instance (Hashable a, Hashable b) => Hashable (Either a b) where hash (Left a) = 0 `hashWithSalt` a hash (Right b) = distinguisher `hashWithSalt` b - hashWithSalt s (Left a) = s `combine` 0 `hashWithSalt` a - hashWithSalt s (Right b) = s `combine` distinguisher `hashWithSalt` b + hashWithSalt = hashWithSalt1 + +instance Hashable a => Hashable1 (Either a) where + liftHashWithSalt = defaultLiftHashWithSalt + +instance Hashable2 Either where + liftHashWithSalt2 h _ s (Left a) = s `combine` 0 `h` a + liftHashWithSalt2 _ h s (Right b) = s `combine` distinguisher `h` b instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where hash (a1, a2) = hash a1 `hashWithSalt` a2 - hashWithSalt s (a1, a2) = s `hashWithSalt` a1 `hashWithSalt` a2 + hashWithSalt = hashWithSalt1 + +instance Hashable a1 => Hashable1 ((,) a1) where + liftHashWithSalt = defaultLiftHashWithSalt + +instance Hashable2 (,) where + liftHashWithSalt2 h1 h2 s (a1, a2) = s `h1` a1 `h2` a2 instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3) where hash (a1, a2, a3) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3 - hashWithSalt s (a1, a2, a3) = s `hashWithSalt` a1 `hashWithSalt` a2 - `hashWithSalt` a3 + hashWithSalt = hashWithSalt1 + +instance (Hashable a1, Hashable a2) => Hashable1 ((,,) a1 a2) where + liftHashWithSalt = defaultLiftHashWithSalt + +instance Hashable a1 => Hashable2 ((,,) a1) where + liftHashWithSalt2 h1 h2 s (a1, a2, a3) = + (s `hashWithSalt` a1) `h1` a2 `h2` a3 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4) => Hashable (a1, a2, a3, a4) where hash (a1, a2, a3, a4) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 - hashWithSalt s (a1, a2, a3, a4) = s `hashWithSalt` a1 `hashWithSalt` a2 - `hashWithSalt` a3 `hashWithSalt` a4 + hashWithSalt = hashWithSalt1 + +instance (Hashable a1, Hashable a2, Hashable a3) => Hashable1 ((,,,) a1 a2 a3) where + liftHashWithSalt = defaultLiftHashWithSalt + +instance (Hashable a1, Hashable a2) => Hashable2 ((,,,) a1 a2) where + liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4) = + (s `hashWithSalt` a1 `hashWithSalt` a2) `h1` a3 `h2` a4 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5) => Hashable (a1, a2, a3, a4, a5) where hash (a1, a2, a3, a4, a5) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5 - hashWithSalt s (a1, a2, a3, a4, a5) = - s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 - `hashWithSalt` a4 `hashWithSalt` a5 + hashWithSalt = hashWithSalt1 + +instance (Hashable a1, Hashable a2, Hashable a3, + Hashable a4) => Hashable1 ((,,,,) a1 a2 a3 a4) where + liftHashWithSalt = defaultLiftHashWithSalt + +instance (Hashable a1, Hashable a2, Hashable a3) + => Hashable2 ((,,,,) a1 a2 a3) where + liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5) = + (s `hashWithSalt` a1 `hashWithSalt` a2 + `hashWithSalt` a3) `h1` a4 `h2` a5 + instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6) => Hashable (a1, a2, a3, a4, a5, a6) where hash (a1, a2, a3, a4, a5, a6) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 - hashWithSalt s (a1, a2, a3, a4, a5, a6) = - s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 - `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 + hashWithSalt = hashWithSalt1 + +instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, + Hashable a5) => Hashable1 ((,,,,,) a1 a2 a3 a4 a5) where + liftHashWithSalt = defaultLiftHashWithSalt + +instance (Hashable a1, Hashable a2, Hashable a3, + Hashable a4) => Hashable2 ((,,,,,) a1 a2 a3 a4) where + liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5, a6) = + (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 + `hashWithSalt` a4) `h1` a5 `h2` a6 + instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6, Hashable a7) => @@ -442,6 +564,15 @@ s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 `hashWithSalt` a7 +instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6) => Hashable1 ((,,,,,,) a1 a2 a3 a4 a5 a6) where + liftHashWithSalt = defaultLiftHashWithSalt + +instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, + Hashable a5) => Hashable2 ((,,,,,,) a1 a2 a3 a4 a5) where + liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5, a6, a7) = + (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 + `hashWithSalt` a4 `hashWithSalt` a5) `h1` a6 `h2` a7 + instance Hashable (StableName a) where hash = hashStableName hashWithSalt = defaultHashWithSalt @@ -451,10 +582,13 @@ instance Hashable a => Hashable [a] where {-# SPECIALIZE instance Hashable [Char] #-} - hashWithSalt salt arr = finalise (foldl' step (SP salt 0) arr) + hashWithSalt = hashWithSalt1 + +instance Hashable1 [] where + liftHashWithSalt h salt arr = finalise (foldl' step (SP salt 0) arr) where finalise (SP s l) = hashWithSalt s l - step (SP s l) x = SP (hashWithSalt s x) (l + 1) + step (SP s l) x = SP (h s x) (l + 1) instance Hashable B.ByteString where hashWithSalt salt bs = B.inlinePerformIO $ @@ -493,6 +627,20 @@ hash = hashThreadId hashWithSalt = defaultHashWithSalt +instance Hashable (Ptr a) where + hashWithSalt salt p = hashWithSalt salt $ ptrToIntPtr p + +instance Hashable (FunPtr a) where + hashWithSalt salt p = hashWithSalt salt $ castFunPtrToPtr p + +instance Hashable IntPtr where + hash n = fromIntegral n + hashWithSalt = defaultHashWithSalt + +instance Hashable WordPtr where + hash n = fromIntegral n + hashWithSalt = defaultHashWithSalt + -- | Compute the hash of a TypeRep, in various GHC versions we can do this quickly. hashTypeRep :: TypeRep -> Int {-# INLINE hashTypeRep #-} @@ -583,8 +731,37 @@ salt `hashWithSalt` branch `hashWithSalt` tags #if MIN_VERSION_base(4,7,0) +-- Using hashWithSalt1 would cause needless constraint instance Hashable (Fixed a) where hashWithSalt salt (MkFixed i) = hashWithSalt salt i +instance Hashable1 Fixed where + liftHashWithSalt _ salt (MkFixed i) = hashWithSalt salt i +#endif + +#if MIN_VERSION_base(4,8,0) +instance Hashable a => Hashable (Identity a) where + hashWithSalt = hashWithSalt1 +instance Hashable1 Identity where + liftHashWithSalt h salt (Identity x) = h salt x +#endif + +-- Using hashWithSalt1 would cause needless constraint +instance Hashable a => Hashable (Const a b) where + hashWithSalt salt (Const x) = hashWithSalt salt x + +instance Hashable a => Hashable1 (Const a) where + liftHashWithSalt = defaultLiftHashWithSalt + +instance Hashable2 Const where + liftHashWithSalt2 f _ salt (Const x) = f salt x + +#if MIN_VERSION_base(4,7,0) +instance Hashable (Proxy a) where + hash _ = 0 + hashWithSalt s _ = s + +instance Hashable1 Proxy where + liftHashWithSalt _ s _ = s #endif -- instances formerly provided by 'semigroups' package @@ -613,3 +790,90 @@ instance Hashable a => Hashable (Option a) where hashWithSalt p (Option a) = hashWithSalt p a #endif + +-- instances for @Data.Functor.{Product,Sum,Compose}@, present +-- in base-4.9 and onward. +#if MIN_VERSION_base(4,9,0) +-- | In general, @hash (Compose x) ≠ hash x@. However, @hashWithSalt@ satisfies +-- its variant of this equivalence. +instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (Compose f g a) where + hashWithSalt = hashWithSalt1 + +instance (Hashable1 f, Hashable1 g) => Hashable1 (Compose f g) where + liftHashWithSalt h s = liftHashWithSalt (liftHashWithSalt h) s . getCompose + +instance (Hashable1 f, Hashable1 g) => Hashable1 (FP.Product f g) where + liftHashWithSalt h s (FP.Pair a b) = liftHashWithSalt h (liftHashWithSalt h s a) b + +instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FP.Product f g a) where + hashWithSalt = hashWithSalt1 + +instance (Hashable1 f, Hashable1 g) => Hashable1 (FS.Sum f g) where + liftHashWithSalt h s (FS.InL a) = liftHashWithSalt h (s `combine` 0) a + liftHashWithSalt h s (FS.InR a) = liftHashWithSalt h (s `combine` distinguisher) a + +instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FS.Sum f g a) where + hashWithSalt = hashWithSalt1 +#endif + +-- | A hashable value along with the result of the 'hash' function. +data Hashed a = Hashed a {-# UNPACK #-} !Int + deriving (Typeable) + +-- | Wrap a hashable value, caching the 'hash' function result. +hashed :: Hashable a => a -> Hashed a +hashed a = Hashed a (hash a) + +-- | Unwrap hashed value. +unhashed :: Hashed a -> a +unhashed (Hashed a _) = a + +-- | Uses precomputed hash to detect inequality faster +instance Eq a => Eq (Hashed a) where + Hashed a ha == Hashed b hb = ha == hb && a == b + +instance Ord a => Ord (Hashed a) where + Hashed a _ `compare` Hashed b _ = a `compare` b + +instance Show a => Show (Hashed a) where + showsPrec d (Hashed a _) = showParen (d > 10) $ + showString "hashed" . showChar ' ' . showsPrec 11 a + +instance Hashable (Hashed a) where + hashWithSalt = defaultHashWithSalt + hash (Hashed _ h) = h + +-- This instance is a little unsettling. It is unusal for +-- 'liftHashWithSalt' to ignore its first argument when a +-- value is actually available for it to work on. +instance Hashable1 Hashed where + liftHashWithSalt _ s (Hashed _ h) = defaultHashWithSalt s h + +instance (IsString a, Hashable a) => IsString (Hashed a) where + fromString s = let r = fromString s in Hashed r (hash r) + +instance F.Foldable Hashed where + foldr f acc (Hashed a _) = f a acc + +-- | 'Hashed' cannot be 'Functor' +mapHashed :: Hashable b => (a -> b) -> Hashed a -> Hashed b +mapHashed f (Hashed a _) = hashed (f a) + +-- | 'Hashed' cannot be 'Traversable' +traverseHashed :: (Hashable b, Functor f) => (a -> f b) -> Hashed a -> f (Hashed b) +traverseHashed f (Hashed a _) = fmap hashed (f a) + +-- instances for @Data.Functor.Classes@ higher rank typeclasses +-- in base-4.9 and onward. +#if MIN_VERSION_base(4,9,0) +instance Eq1 Hashed where + liftEq f (Hashed a ha) (Hashed b hb) = ha == hb && f a b + +instance Ord1 Hashed where + liftCompare f (Hashed a _) (Hashed b _) = f a b + +instance Show1 Hashed where + liftShowsPrec sp _ d (Hashed a _) = showsUnaryWith sp "hashed" d a +#endif + + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/Data/Hashable/Generic.hs new/hashable-1.2.5.0/Data/Hashable/Generic.hs --- old/hashable-1.2.4.0/Data/Hashable/Generic.hs 2016-01-14 20:32:59.000000000 +0100 +++ new/hashable-1.2.5.0/Data/Hashable/Generic.hs 2017-01-02 09:44:38.000000000 +0100 @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns, FlexibleInstances, KindSignatures, - ScopedTypeVariables, TypeOperators #-} + ScopedTypeVariables, TypeOperators, + MultiParamTypeClasses, GADTs, FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ------------------------------------------------------------------------ @@ -21,43 +22,55 @@ import Data.Hashable.Class import GHC.Generics + -- Type without constructors -instance GHashable V1 where - ghashWithSalt salt _ = hashWithSalt salt () +instance GHashable arity V1 where + ghashWithSalt _ salt _ = hashWithSalt salt () -- Constructor without arguments -instance GHashable U1 where - ghashWithSalt salt U1 = hashWithSalt salt () +instance GHashable arity U1 where + ghashWithSalt _ salt U1 = hashWithSalt salt () -instance (GHashable a, GHashable b) => GHashable (a :*: b) where - ghashWithSalt salt (x :*: y) = salt `ghashWithSalt` x `ghashWithSalt` y +instance (GHashable arity a, GHashable arity b) => GHashable arity (a :*: b) where + ghashWithSalt toHash salt (x :*: y) = + (ghashWithSalt toHash (ghashWithSalt toHash salt x) y) -- Metadata (constructor name, etc) -instance GHashable a => GHashable (M1 i c a) where - ghashWithSalt salt = ghashWithSalt salt . unM1 +instance GHashable arity a => GHashable arity (M1 i c a) where + ghashWithSalt targs salt = ghashWithSalt targs salt . unM1 -- Constants, additional parameters, and rank-1 recursion -instance Hashable a => GHashable (K1 i a) where - ghashWithSalt = hashUsing unK1 +instance Hashable a => GHashable arity (K1 i a) where + ghashWithSalt _ = hashUsing unK1 + +instance GHashable One Par1 where + ghashWithSalt (HashArgs1 h) salt = h salt . unPar1 + +instance Hashable1 f => GHashable One (Rec1 f) where + ghashWithSalt (HashArgs1 h) salt = liftHashWithSalt h salt . unRec1 -class GSum f where - hashSum :: Int -> Int -> Int -> f a -> Int +instance (Hashable1 f, GHashable One g) => GHashable One (f :.: g) where + ghashWithSalt targs salt = liftHashWithSalt (ghashWithSalt targs) salt . unComp1 -instance (GSum a, GSum b, SumSize a, SumSize b) => GHashable (a :+: b) where - ghashWithSalt salt = hashSum salt 0 size +class GSum arity f where + hashSum :: HashArgs arity a -> Int -> Int -> Int -> f a -> Int + +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)) -instance (GSum a, GSum b) => GSum (a :+: b) where - hashSum !salt !code !size s = case s of - L1 x -> hashSum salt code sizeL x - R1 x -> hashSum salt (code + sizeL) sizeR x - where - sizeL = size `shiftR` 1 - sizeR = size - sizeL +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 + where + sizeL = size `shiftR` 1 + sizeR = size - sizeL {-# INLINE hashSum #-} -instance GHashable a => GSum (C1 c a) where - hashSum !salt !code _ x = salt `hashWithSalt` code `ghashWithSalt` x +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) {-# INLINE hashSum #-} class SumSize f where @@ -71,3 +84,4 @@ instance SumSize (C1 c a) where sumSize = Tagged 1 + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/Data/Hashable/Lifted.hs new/hashable-1.2.5.0/Data/Hashable/Lifted.hs --- old/hashable-1.2.4.0/Data/Hashable/Lifted.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hashable-1.2.5.0/Data/Hashable/Lifted.hs 2017-01-02 09:44:38.000000000 +0100 @@ -0,0 +1,96 @@ +------------------------------------------------------------------------ +-- | +-- Module : Data.Hashable.Class +-- Copyright : (c) Milan Straka 2010 +-- (c) Johan Tibell 2011 +-- (c) Bryan O'Sullivan 2011, 2012 +-- License : BSD-style +-- Maintainer : [email protected] +-- Stability : provisional +-- Portability : portable +-- +-- Lifting of the 'Hashable' class to unary and binary type constructors. +-- These classes are needed to express the constraints on arguments of +-- types that are parameterized by type constructors. Fixed-point data +-- types and monad transformers are such types. + +module Data.Hashable.Lifted + ( -- * Type Classes + Hashable1(..) + , Hashable2(..) + -- * Auxiliary Functions + , hashWithSalt1 + , hashWithSalt2 + , defaultLiftHashWithSalt + -- * Motivation + -- $motivation + ) where + +import Data.Hashable.Class + +-- $motivation +-- +-- This type classes provided in this module are used to express constraints +-- on type constructors in a Haskell98-compatible fashion. As an example, consider +-- the following two types (Note that these instances are not actually provided +-- because @hashable@ does not have @transformers@ or @free@ as a dependency): +-- +-- > newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } +-- > data Free f a = Pure a | Free (f (Free f a)) +-- +-- The 'Hashable1' instances for @WriterT@ and @Free@ could be written as: +-- +-- > instance (Hashable w, Hashable1 m) => Hashable1 (WriterT w m) where +-- > liftHashWithSalt h s (WriterT m) = +-- > liftHashWithSalt (liftHashWithSalt2 h hashWithSalt) s m +-- > instance Hashable1 f => Hashable1 (Free f) where +-- > liftHashWithSalt h = go where +-- > go s x = case x of +-- > Pure a -> h s a +-- > Free p -> liftHashWithSalt go s p +-- +-- The 'Hashable' instances for these types can be trivially recovered with +-- 'hashWithSalt1': +-- +-- > instance (Hashable w, Hashable1 m, Hashable a) => Hashable (WriterT w m a) where +-- > hashWithSalt = hashWithSalt1 +-- > instance (Hashable1 f, Hashable a) => Hashable (Free f a) where +-- > hashWithSalt = hashWithSalt1 + +-- +-- $discussion +-- +-- Regardless of whether 'hashWithSalt1' is used to provide an implementation +-- of 'hashWithSalt', they should produce the same hash when called with +-- the same arguments. This is the only law that 'Hashable1' and 'Hashable2' +-- are expected to follow. +-- +-- The typeclasses in this module only provide lifting for 'hashWithSalt', not +-- for 'hash'. This is because such liftings cannot be defined in a way that +-- would satisfy the @liftHash@ variant of the above law. As an illustration +-- of the problem we run into, let us assume that 'Hashable1' were +-- given a 'liftHash' method: +-- +-- > class Hashable1 t where +-- > liftHash :: (Int -> a) -> t a -> Int +-- > liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int +-- +-- Even for a type as simple as 'Maybe', the problem manifests itself. The +-- 'Hashable' instance for 'Maybe' is: +-- +-- > distinguisher :: Int +-- > distinguisher = ... +-- > +-- > instance Hashable a => Hashable (Maybe a) where +-- > hash Nothing = 0 +-- > hash (Just a) = distinguisher `hashWithSalt` a +-- > hashWithSalt s Nothing = ... +-- > hashWithSalt s (Just a) = ... +-- +-- The implementation of 'hash' calls 'hashWithSalt' on @a@. The hypothetical +-- @liftHash@ defined earlier only accepts an argument that corresponds to +-- the implementation of 'hash' for @a@. Consequently, this formulation of +-- @liftHash@ would not provide a way to match the current behavior of 'hash' +-- for 'Maybe'. This problem gets worse when 'Either' and @[]@ are considered. +-- The solution adopted in this library is to omit @liftHash@ entirely. + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/Data/Hashable.hs new/hashable-1.2.5.0/Data/Hashable.hs --- old/hashable-1.2.4.0/Data/Hashable.hs 2016-01-14 20:32:59.000000000 +0100 +++ new/hashable-1.2.5.0/Data/Hashable.hs 2017-01-02 09:44:38.000000000 +0100 @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif @@ -63,9 +64,16 @@ , hashByteArray , hashByteArrayWithSalt #endif + -- * Caching hashes + , Hashed + , hashed + , unhashed + , mapHashed + , traverseHashed ) where import Data.Hashable.Class + #ifdef GENERICS import Data.Hashable.Generic () #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/benchmarks/Benchmarks.hs new/hashable-1.2.5.0/benchmarks/Benchmarks.hs --- old/hashable-1.2.4.0/benchmarks/Benchmarks.hs 2016-01-14 20:32:59.000000000 +0100 +++ new/hashable-1.2.5.0/benchmarks/Benchmarks.hs 2017-01-02 09:44:38.000000000 +0100 @@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash, - UnboxedTuples #-} + UnboxedTuples, DeriveGeneric #-} module Main (main) where @@ -15,6 +15,7 @@ import Foreign.C.Types (CInt(..), CLong(..), CSize(..)) import Foreign.Ptr import Data.ByteString.Internal +import GHC.Generics (Generic) import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Data.Text.Lazy as TL @@ -35,6 +36,10 @@ let !mb = 2^(20 :: Int) -- 1 Mb fp1Mb <- mallocForeignPtrBytes mb + let exP = P 22.0203 234.19 'x' 6424 + exS = S3 + exPS = PS3 'z' 7715 + -- We don't care about the contents of these either. let !ba5 = new 5; !ba8 = new 8; !ba11 = new 11; !ba40 = new 40 !ba128 = new 128; !ba512 = new 512; !ba1Mb = new mb @@ -251,6 +256,11 @@ , bench "jenkins32a" $ whnf hash_jenkins_32a 0xdeadbeef , bench "jenkins32b" $ whnf hash_jenkins_32b 0xdeadbeef ] + , bgroup "Generic" + [ bench "product" $ whnf hash exP + , bench "sum" $ whnf hash exS + , bench "product and sum" $ whnf hash exPS + ] ] data ByteArray = BA { unBA :: !ByteArray# } @@ -285,3 +295,20 @@ :: Word32 -> Word32 foreign import ccall unsafe "hash_jenkins_32b" hash_jenkins_32b :: Word32 -> Word32 + +data PS + = PS1 Int Char Bool + | PS2 String () + | PS3 Char Int + deriving (Generic) + +data P = P Double Float Char Int + deriving (Generic) + +data S = S1 | S2 | S3 | S4 | S5 + deriving (Generic) + +instance Hashable PS +instance Hashable P +instance Hashable S + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/benchmarks/cbits/siphash.h new/hashable-1.2.5.0/benchmarks/cbits/siphash.h --- old/hashable-1.2.4.0/benchmarks/cbits/siphash.h 1970-01-01 01:00:00.000000000 +0100 +++ new/hashable-1.2.5.0/benchmarks/cbits/siphash.h 2017-01-02 09:44:38.000000000 +0100 @@ -0,0 +1,68 @@ +#ifndef _hashable_siphash_h +#define _hashable_siphash_h + +#include <stdint.h> +#include <stdlib.h> + +typedef uint64_t u64; +typedef uint32_t u32; +typedef uint16_t u16; +typedef uint8_t u8; + +#define SIPHASH_ROUNDS 2 +#define SIPHASH_FINALROUNDS 4 + +u64 hashable_siphash(int, int, u64, u64, const u8 *, size_t); +u64 hashable_siphash24(u64, u64, const u8 *, size_t); + +#if defined(__i386) + +/* To use SSE instructions, we have to adjust the stack from its + default of 4-byte alignment to use 16-byte alignment. */ + +# define ALIGNED_STACK __attribute__((force_align_arg_pointer)) + +u64 hashable_siphash24_sse2(u64, u64, const u8 *, size_t) ALIGNED_STACK; +u64 hashable_siphash24_sse41(u64, u64, const u8 *, size_t) ALIGNED_STACK; +#endif + +#if defined(_WIN32) +# define __LITTLE_ENDIAN 1234 +# define __BIG_ENDIAN 4321 +# define __BYTE_ORDER __LITTLE_ENDIAN + +#elif (defined(__FreeBSD__) && __FreeBSD_version >= 470000) || defined(__OpenBSD__) || defined(__NetBSD__) +# include <sys/endian.h> +# define __BIG_ENDIAN BIG_ENDIAN +# define __LITTLE_ENDIAN LITTLE_ENDIAN +# define __BYTE_ORDER BYTE_ORDER + +#elif (defined(BSD) && (BSD >= 199103)) || defined(__APPLE__) +# include <machine/endian.h> +# define __BIG_ENDIAN BIG_ENDIAN +# define __LITTLE_ENDIAN LITTLE_ENDIAN +# define __BYTE_ORDER BYTE_ORDER + +#elif defined(__linux__) +# include <endian.h> +#endif + +static inline u64 peek_u64le(const u64 *p) +{ + u64 x = *p; + +#if __BYTE_ORDER == __BIG_ENDIAN + x = ((x & 0xff00000000000000ull) >> 56) | + ((x & 0x00ff000000000000ull) >> 40) | + ((x & 0x0000ff0000000000ull) >> 24) | + ((x & 0x000000ff00000000ull) >> 8) | + ((x & 0x00000000ff000000ull) << 8) | + ((x & 0x0000000000ff0000ull) << 24) | + ((x & 0x000000000000ff00ull) << 40) | + ((x & 0x00000000000000ffull) << 56); +#endif + + return x; +} + +#endif /* _hashable_siphash_h */ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/examples/Main.hs new/hashable-1.2.5.0/examples/Main.hs --- old/hashable-1.2.4.0/examples/Main.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hashable-1.2.5.0/examples/Main.hs 2017-01-02 09:44:38.000000000 +0100 @@ -0,0 +1,50 @@ +{-# LANGUAGE DeriveGeneric #-} +import Data.Hashable +import Data.Hashable.Lifted +import GHC.Generics (Generic) + +data Foo + = Foo1 Int Char Bool + | Foo2 String () + deriving (Generic) + +instance Hashable Foo + +data Bar = Bar Double Float + deriving (Generic) + +instance Hashable Bar + +-- printHash :: (Hashable a, Show a) => a -> IO () +-- printHash = print . hash + +main :: IO () +main = do + putStrLn "Hashing Foo1" + print . hash $ Foo1 22 'y' True + putStrLn "Hashing Foo2" + print . hash $ Foo2 "hello" () + putStrLn "Hashing Bar" + print . hash $ Bar 55.50 9.125 + +----------------------------------- +-- Higher Rank Hashable Examples -- +----------------------------------- + +newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } +data Free f a = Pure a | Free (f (Free f a)) + +instance (Hashable w, Hashable1 m) => Hashable1 (WriterT w m) where + liftHashWithSalt h s (WriterT m) = + liftHashWithSalt (liftHashWithSalt2 h hashWithSalt) s m +instance Hashable1 f => Hashable1 (Free f) where + liftHashWithSalt h = go where + go s x = case x of + Pure a -> h s a + Free p -> liftHashWithSalt go s p + +instance (Hashable w, Hashable1 m, Hashable a) => Hashable (WriterT w m a) where + hashWithSalt = hashWithSalt1 +instance (Hashable1 f, Hashable a) => Hashable (Free f a) where + hashWithSalt = hashWithSalt1 + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/hashable.cabal new/hashable-1.2.5.0/hashable.cabal --- old/hashable-1.2.4.0/hashable.cabal 2016-01-14 20:32:59.000000000 +0100 +++ new/hashable-1.2.5.0/hashable.cabal 2017-01-02 09:44:38.000000000 +0100 @@ -1,5 +1,5 @@ Name: hashable -Version: 1.2.4.0 +Version: 1.2.5.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 @@ -20,7 +20,8 @@ -- tests/Properties.hs shouldn't have to go here, but the source files -- for the test-suite stanzas don't get picked up by `cabal sdist`. Extra-source-files: - CHANGES.md, README.md, tests/Properties.hs, benchmarks/Benchmarks.hs + CHANGES.md, README.md, tests/Properties.hs, + benchmarks/Benchmarks.hs, benchmarks/cbits/*.c, benchmarks/cbits/*.h Flag integer-gmp Description: Are we using integer-gmp to provide fast Integer instances? @@ -36,8 +37,14 @@ Default: False Manual: True +Flag examples + Description: Build example modules + Default: False + Manual: True + Library Exposed-modules: Data.Hashable + Data.Hashable.Lifted Other-modules: Data.Hashable.Class Build-depends: base >= 4.0 && < 4.10, bytestring >= 0.9 && < 0.11 @@ -115,6 +122,15 @@ if impl(ghc) && flag(integer-gmp) Build-depends: integer-gmp >= 0.2 + if impl(ghc >= 7.2.1) + CPP-Options: -DGENERICS + + include-dirs: + benchmarks/cbits + + includes: + siphash.h + c-sources: benchmarks/cbits/inthash.c benchmarks/cbits/siphash.c @@ -140,6 +156,15 @@ if os(windows) extra-libraries: advapi32 + +Executable hashable-examples + if flag(examples) + build-depends: base, hashable + else + buildable: False + hs-source-dirs: examples + main-is: Main.hs + source-repository head type: git location: https://github.com/tibbe/hashable.git diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/tests/Properties.hs new/hashable-1.2.5.0/tests/Properties.hs --- old/hashable-1.2.4.0/tests/Properties.hs 2016-01-14 20:32:59.000000000 +0100 +++ new/hashable-1.2.5.0/tests/Properties.hs 2017-01-02 09:44:38.000000000 +0100 @@ -9,7 +9,9 @@ module Properties (properties) where -import Data.Hashable (Hashable, hash, hashByteArray, hashPtr) +import Data.Hashable (Hashable, hash, hashByteArray, hashPtr, + Hashed, hashed, unhashed, hashWithSalt) +import Data.Hashable.Lifted (hashWithSalt1) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T @@ -208,6 +210,13 @@ #endif +instance (Arbitrary a, Hashable a) => Arbitrary (Hashed a) where + arbitrary = fmap hashed arbitrary + shrink xs = map hashed $ shrink $ unhashed xs + +pLiftedHashed :: Int -> Hashed (Either Int String) -> Bool +pLiftedHashed s h = hashWithSalt s h == hashWithSalt1 s h + properties :: [Test] properties = [ testProperty "bernstein" pHash @@ -239,6 +248,9 @@ , testProperty "sum3_differ" pSum3_differ ] #endif + , testGroup "lifted law" + [ testProperty "Hashed" pLiftedHashed + ] ] ------------------------------------------------------------------------
