Hello community, here is the log from the commit of package ghc-unordered-containers for openSUSE:Factory checked in at 2016-06-14 23:08:36 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-unordered-containers (Old) and /work/SRC/openSUSE:Factory/.ghc-unordered-containers.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-unordered-containers" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-unordered-containers/ghc-unordered-containers.changes 2015-05-21 08:13:21.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-unordered-containers.new/ghc-unordered-containers.changes 2016-06-14 23:08:37.000000000 +0200 @@ -1,0 +2,24 @@ +Fri Jun 10 07:00:11 UTC 2016 - mimi.vx@gmail.com + +- update to 0.2.7.1 +- remove useless _service +* Fix linker error related to popcnt. + +------------------------------------------------------------------- +Sat Feb 20 08:32:45 UTC 2016 - mimi.vx@gmail.com + +- update to 0.2.7.0 +* support criterion-1.1 +* Add unionWithKey for hash maps. + +------------------------------------------------------------------- +Tue Feb 16 20:05:18 UTC 2016 - mimi.vx@gmail.com + +- update to 0.2.6.0 +* Mark several modules as Trustworthy. +* Add Hashable instances for HashMap and HashSet. +* Add mapMaybe, mapMaybeWithKey, update, alter, and intersectionWithKey. +* Add roles. +* Add Hashable and Semigroup instances. + +------------------------------------------------------------------- Old: ---- _service unordered-containers-0.2.5.1.tar.gz New: ---- unordered-containers-0.2.7.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-unordered-containers.spec ++++++ --- /var/tmp/diff_new_pack.mhRwJk/_old 2016-06-14 23:08:37.000000000 +0200 +++ /var/tmp/diff_new_pack.mhRwJk/_new 2016-06-14 23:08:37.000000000 +0200 @@ -19,7 +19,7 @@ %global pkg_name unordered-containers Name: ghc-unordered-containers -Version: 0.2.5.1 +Version: 0.2.7.1 Release: 0 Summary: Efficient hashing-based container types License: BSD-3-Clause ++++++ unordered-containers-0.2.5.1.tar.gz -> unordered-containers-0.2.7.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/CHANGES.md new/unordered-containers-0.2.7.1/CHANGES.md --- old/unordered-containers-0.2.5.1/CHANGES.md 1970-01-01 01:00:00.000000000 +0100 +++ new/unordered-containers-0.2.7.1/CHANGES.md 2016-06-09 02:00:11.000000000 +0200 @@ -0,0 +1,30 @@ +## 0.2.7.1 + + * Fix linker error related to popcnt. + + * Haddock improvements. + + * Fix benchmark compilation when downloaded from Hackage. + +## 0.2.7.0 + + * Support criterion 1.1 + + * Add unionWithKey for hash maps. + +## 0.2.6.0 + + * Mark several modules as Trustworthy. + + * Add Hashable instances for HashMap and HashSet. + + * Add mapMaybe, mapMaybeWithKey, update, alter, and + intersectionWithKey. + + * Add roles. + + * Add Hashable and Semigroup instances. + +## 0.2.5.1 (2014-10-11) + + * Support base-4.8 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/Data/HashMap/Array.hs new/unordered-containers-0.2.7.1/Data/HashMap/Array.hs --- old/unordered-containers-0.2.5.1/Data/HashMap/Array.hs 2014-10-11 15:04:46.000000000 +0200 +++ new/unordered-containers-0.2.7.1/Data/HashMap/Array.hs 2016-06-09 02:00:11.000000000 +0200 @@ -53,7 +53,6 @@ import Control.Applicative (Applicative) #endif import Control.DeepSeq -import Control.Monad.ST hiding (runST) -- GHC 7.7 exports toList/fromList from GHC.Exts -- In order to avoid warnings on previous GHC versions, we provide -- an explicit import list instead of only hiding the offending symbols diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/Data/HashMap/Base.hs new/unordered-containers-0.2.7.1/Data/HashMap/Base.hs --- old/unordered-containers-0.2.5.1/Data/HashMap/Base.hs 2014-10-11 15:04:46.000000000 +0200 +++ new/unordered-containers-0.2.7.1/Data/HashMap/Base.hs 2016-06-09 02:00:11.000000000 +0200 @@ -1,6 +1,8 @@ {-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PatternGuards #-} #if __GLASGOW_HASKELL__ >= 708 +{-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE TypeFamilies #-} #endif {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-} @@ -26,11 +28,14 @@ , unsafeInsert , delete , adjust + , update + , alter -- * Combine -- ** Union , union , unionWith + , unionWithKey , unions -- * Transformations @@ -42,6 +47,7 @@ , difference , intersection , intersectionWith + , intersectionWithKey -- * Folds , foldl' @@ -50,6 +56,8 @@ , foldrWithKey -- * Filter + , mapMaybe + , mapMaybeWithKey , filter , filterWithKey @@ -79,16 +87,19 @@ , update16M , update16With' , updateOrConcatWith + , updateOrConcatWithKey + , filterMapAux ) where -#if __GLASGOW_HASKELL__ >= 709 -import Data.Functor ((<$>)) -#else +#if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>), Applicative(pure)) import Data.Monoid (Monoid(mempty, mappend)) import Data.Traversable (Traversable(..)) import Data.Word (Word) #endif +#if __GLASGOW_HASKELL__ >= 711 +import Data.Semigroup (Semigroup((<>))) +#endif import Control.DeepSeq (NFData(rnf)) import Control.Monad.ST (ST) import Data.Bits ((.&.), (.|.), complement) @@ -140,6 +151,10 @@ | Collision !Hash !(A.Array (Leaf k v)) deriving (Typeable) +#if __GLASGOW_HASKELL__ >= 708 +type role HashMap nominal representational +#endif + instance (NFData k, NFData v) => NFData (HashMap k v) where rnf Empty = () rnf (BitmapIndexed _ ary) = rnf ary @@ -153,10 +168,20 @@ instance Foldable.Foldable (HashMap k) where foldr f = foldrWithKey (const f) +#if __GLASGOW_HASKELL__ >= 711 +instance (Eq k, Hashable k) => Semigroup (HashMap k v) where + (<>) = union + {-# INLINE (<>) #-} +#endif + instance (Eq k, Hashable k) => Monoid (HashMap k v) where mempty = empty {-# INLINE mempty #-} +#if __GLASGOW_HASKELL__ >= 711 + mappend = (<>) +#else mappend = union +#endif {-# INLINE mappend #-} instance (Data k, Data v, Eq k, Hashable k) => Data (HashMap k v) where @@ -213,11 +238,39 @@ go [] [] = True go _ _ = False - toList' (BitmapIndexed _ ary) a = A.foldr toList' a ary - toList' (Full ary) a = A.foldr toList' a ary - toList' l@(Leaf _ _) a = l : a - toList' c@(Collision _ _) a = c : a - toList' Empty a = a +instance (Hashable k, Hashable v) => Hashable (HashMap k v) where + hashWithSalt salt hm = go salt (toList' hm []) + where + go :: Int -> [HashMap k v] -> Int + go s [] = s + go s (Leaf _ l : tl) + = s `hashLeafWithSalt` l `go` tl + -- For collisions we hashmix hash value + -- and then array of values' hashes sorted + go s (Collision h a : tl) + = (s `H.hashWithSalt` h) `hashCollisionWithSalt` a `go` tl + go s (_ : tl) = s `go` tl + + hashLeafWithSalt :: Int -> Leaf k v -> Int + hashLeafWithSalt s (L k v) = s `H.hashWithSalt` k `H.hashWithSalt` v + + hashCollisionWithSalt :: Int -> A.Array (Leaf k v) -> Int + hashCollisionWithSalt s + = L.foldl' H.hashWithSalt s . arrayHashesSorted + + arrayHashesSorted :: A.Array (Leaf k v) -> [Int] + arrayHashesSorted = L.sort . L.map leafValueHash . A.toList + + leafValueHash :: Leaf k v -> Int + leafValueHash (L _ v) = H.hash v + + -- Helper to get 'Leaf's and 'Collision's as a list. +toList' :: HashMap k v -> [HashMap k v] -> [HashMap k v] +toList' (BitmapIndexed _ ary) a = A.foldr toList' a ary +toList' (Full ary) a = A.foldr toList' a ary +toList' l@(Leaf _ _) a = l : a +toList' c@(Collision _ _) a = c : a +toList' Empty a = a -- Helper function to detect 'Leaf's and 'Collision's. isLeafOrCollision :: HashMap k v -> Bool @@ -460,8 +513,7 @@ unsafeInsertWith f k0 v0 m0 = runST (go h0 k0 v0 0 m0) where h0 = hash k0 - go :: (Eq k, Hashable k) => Hash -> k -> v -> Shift -> HashMap k v - -> ST s (HashMap k v) + go :: Hash -> k -> v -> Shift -> HashMap k v -> ST s (HashMap k v) go !h !k x !_ Empty = return $! Leaf h (L k x) go h k x s (Leaf hy l@(L ky y)) | hy == h = if ky == k @@ -574,6 +626,24 @@ | otherwise = t {-# INLINABLE adjust #-} +-- | /O(log n)/ The expression (@'update' f k map@) updates the value @x@ at @k@, +-- (if it is in the map). If (f k x) is @'Nothing', the element is deleted. +-- If it is (@'Just' y), the key k is bound to the new value y. +update :: (Eq k, Hashable k) => (a -> Maybe a) -> k -> HashMap k a -> HashMap k a +update f = alter (>>= f) +{-# INLINABLE update #-} + + +-- | /O(log n)/ The expression (@'alter' f k map@) alters the value @x@ at @k@, or +-- absence thereof. @alter@ can be used to insert, delete, or update a value in a +-- map. In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@. +alter :: (Eq k, Hashable k) => (Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v +alter f k m = + case f (lookup k m) of + Nothing -> delete k m + Just v -> insert k v m +{-# INLINABLE alter #-} + ------------------------------------------------------------------------ -- * Combine @@ -588,7 +658,15 @@ -- result. unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v -unionWith f = go 0 +unionWith f = unionWithKey (const f) +{-# INLINE unionWith #-} + +-- | /O(n+m)/ The union of two maps. If a key occurs in both maps, +-- the provided function (first argument) will be used to compute the +-- result. +unionWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> HashMap k v -> HashMap k v + -> HashMap k v +unionWithKey f = go 0 where -- empty vs. anything go !_ t1 Empty = t1 @@ -596,17 +674,17 @@ -- leaf vs. leaf go s t1@(Leaf h1 l1@(L k1 v1)) t2@(Leaf h2 l2@(L k2 v2)) | h1 == h2 = if k1 == k2 - then Leaf h1 (L k1 (f v1 v2)) + then Leaf h1 (L k1 (f k1 v1 v2)) else collision h1 l1 l2 | otherwise = goDifferentHash s h1 h2 t1 t2 go s t1@(Leaf h1 (L k1 v1)) t2@(Collision h2 ls2) - | h1 == h2 = Collision h1 (updateOrSnocWith f k1 v1 ls2) + | h1 == h2 = Collision h1 (updateOrSnocWithKey f k1 v1 ls2) | otherwise = goDifferentHash s h1 h2 t1 t2 go s t1@(Collision h1 ls1) t2@(Leaf h2 (L k2 v2)) - | h1 == h2 = Collision h1 (updateOrSnocWith (flip f) k2 v2 ls1) + | h1 == h2 = Collision h1 (updateOrSnocWithKey (flip . f) k2 v2 ls1) | otherwise = goDifferentHash s h1 h2 t1 t2 go s t1@(Collision h1 ls1) t2@(Collision h2 ls2) - | h1 == h2 = Collision h1 (updateOrConcatWith f ls1 ls2) + | h1 == h2 = Collision h1 (updateOrConcatWithKey f ls1 ls2) | otherwise = goDifferentHash s h1 h2 t1 t2 -- branch vs. branch go s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) = @@ -668,7 +746,7 @@ where m1 = mask h1 s m2 = mask h2 s -{-# INLINE unionWith #-} +{-# INLINE unionWithKey #-} -- | Strict in the result of @f@. unionArrayBy :: (a -> a -> a) -> Bitmap -> Bitmap -> A.Array a -> A.Array a @@ -777,6 +855,18 @@ _ -> m {-# INLINABLE intersectionWith #-} +-- | /O(n+m)/ Intersection of two maps. If a key occurs in both maps +-- the provided function is used to combine the values from the two +-- maps. +intersectionWithKey :: (Eq k, Hashable k) => (k -> v1 -> v2 -> v3) + -> HashMap k v1 -> HashMap k v2 -> HashMap k v3 +intersectionWithKey f a b = foldlWithKey' go empty a + where + go m k v = case lookup k b of + Just w -> insert k (f k v w) m + _ -> m +{-# INLINABLE intersectionWithKey #-} + ------------------------------------------------------------------------ -- * Folds @@ -835,14 +925,47 @@ A.unsafeFreeze mary2 {-# INLINE trim #-} +-- | /O(n)/ Transform this map by applying a function to every value +-- and retaining only some of them. +mapMaybeWithKey :: (k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2 +mapMaybeWithKey f = filterMapAux onLeaf onColl + where onLeaf (Leaf h (L k v)) | Just v' <- f k v = Just (Leaf h (L k v')) + onLeaf _ = Nothing + + onColl (L k v) | Just v' <- f k v = Just (L k v') + | otherwise = Nothing +{-# INLINE mapMaybeWithKey #-} + +-- | /O(n)/ Transform this map by applying a function to every value +-- and retaining only some of them. +mapMaybe :: (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2 +mapMaybe f = mapMaybeWithKey (const f) +{-# INLINE mapMaybe #-} + -- | /O(n)/ Filter this map by retaining only elements satisfying a -- predicate. filterWithKey :: forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v -filterWithKey pred = go +filterWithKey pred = filterMapAux onLeaf onColl + where onLeaf t@(Leaf _ (L k v)) | pred k v = Just t + onLeaf _ = Nothing + + onColl el@(L k v) | pred k v = Just el + onColl _ = Nothing +{-# INLINE filterWithKey #-} + + +-- | Common implementation for 'filterWithKey' and 'mapMaybeWithKey', +-- allowing the former to former to reuse terms. +filterMapAux :: forall k v1 v2 + . (HashMap k v1 -> Maybe (HashMap k v2)) + -> (Leaf k v1 -> Maybe (Leaf k v2)) + -> HashMap k v1 + -> HashMap k v2 +filterMapAux onLeaf onColl = go where go Empty = Empty - go t@(Leaf _ (L k v)) - | pred k v = t + go t@Leaf{} + | Just t' <- onLeaf t = t' | otherwise = Empty go (BitmapIndexed b ary) = filterA ary b go (Full ary) = filterA ary fullNodeMask @@ -854,9 +977,9 @@ mary <- A.new_ n step ary0 mary b0 0 0 1 n where - step :: A.Array (HashMap k v) -> A.MArray s (HashMap k v) + step :: A.Array (HashMap k v1) -> A.MArray s (HashMap k v2) -> Bitmap -> Int -> Int -> Bitmap -> Int - -> ST s (HashMap k v) + -> ST s (HashMap k v2) step !ary !mary !b i !j !bi n | i >= n = case j of 0 -> return Empty @@ -883,9 +1006,9 @@ mary <- A.new_ n step ary0 mary 0 0 n where - step :: A.Array (Leaf k v) -> A.MArray s (Leaf k v) + step :: A.Array (Leaf k v1) -> A.MArray s (Leaf k v2) -> Int -> Int -> Int - -> ST s (HashMap k v) + -> ST s (HashMap k v2) step !ary !mary i !j n | i >= n = case j of 0 -> return Empty @@ -895,10 +1018,10 @@ return $! Collision h ary2 | otherwise -> do ary2 <- trim mary j return $! Collision h ary2 - | pred k v = A.write mary j el >> step ary mary (i+1) (j+1) n + | Just el <- onColl (A.index ary i) + = A.write mary j el >> step ary mary (i+1) (j+1) n | otherwise = step ary mary (i+1) j n - where el@(L k v) = A.index ary i -{-# INLINE filterWithKey #-} +{-# INLINE filterMapAux #-} -- | /O(n)/ Filter this map by retaining only elements which values -- satisfy a predicate. @@ -928,7 +1051,7 @@ -- ** Lists -- | /O(n)/ Return a list of this map's elements. The list is --- produced lazily. +-- produced lazily. The order of its elements is unspecified. toList :: HashMap k v -> [(k, v)] toList t = build (\ c z -> foldrWithKey (curry c) z t) {-# INLINE toList #-} @@ -986,7 +1109,12 @@ updateOrSnocWith :: Eq k => (v -> v -> v) -> k -> v -> A.Array (Leaf k v) -> A.Array (Leaf k v) -updateOrSnocWith f k0 v0 ary0 = go k0 v0 ary0 0 (A.length ary0) +updateOrSnocWith f = updateOrSnocWithKey (const f) +{-# INLINABLE updateOrSnocWith #-} + +updateOrSnocWithKey :: Eq k => (k -> v -> v -> v) -> k -> v -> A.Array (Leaf k v) + -> A.Array (Leaf k v) +updateOrSnocWithKey f k0 v0 ary0 = go k0 v0 ary0 0 (A.length ary0) where go !k v !ary !i !n | i >= n = A.run $ do @@ -996,12 +1124,16 @@ A.write mary n (L k v) return mary | otherwise = case A.index ary i of - (L kx y) | k == kx -> A.update ary i (L k (f v y)) + (L kx y) | k == kx -> A.update ary i (L k (f k v y)) | otherwise -> go k v ary (i+1) n -{-# INLINABLE updateOrSnocWith #-} +{-# INLINABLE updateOrSnocWithKey #-} updateOrConcatWith :: Eq k => (v -> v -> v) -> A.Array (Leaf k v) -> A.Array (Leaf k v) -> A.Array (Leaf k v) -updateOrConcatWith f ary1 ary2 = A.run $ do +updateOrConcatWith f = updateOrConcatWithKey (const f) +{-# INLINABLE updateOrConcatWith #-} + +updateOrConcatWithKey :: Eq k => (k -> v -> v -> v) -> A.Array (Leaf k v) -> A.Array (Leaf k v) -> A.Array (Leaf k v) +updateOrConcatWithKey f ary1 ary2 = A.run $ do -- first: look up the position of each element of ary2 in ary1 let indices = A.map (\(L k _) -> indexOf k ary1) ary2 -- that tells us how large the overlap is: @@ -1019,14 +1151,14 @@ Just i1 -> do -- key occurs in both arrays, store combination in position i1 L k v1 <- A.indexM ary1 i1 L _ v2 <- A.indexM ary2 i2 - A.write mary i1 (L k (f v1 v2)) + A.write mary i1 (L k (f k v1 v2)) go iEnd (i2+1) Nothing -> do -- key is only in ary2, append to end A.write mary iEnd =<< A.indexM ary2 i2 go (iEnd+1) (i2+1) go n1 0 return mary -{-# INLINABLE updateOrConcatWith #-} +{-# INLINABLE updateOrConcatWithKey #-} ------------------------------------------------------------------------ -- Manually unrolled loops diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/Data/HashMap/Lazy.hs new/unordered-containers-0.2.7.1/Data/HashMap/Lazy.hs --- old/unordered-containers-0.2.5.1/Data/HashMap/Lazy.hs 2014-10-11 15:04:46.000000000 +0200 +++ new/unordered-containers-0.2.7.1/Data/HashMap/Lazy.hs 2016-06-09 02:00:11.000000000 +0200 @@ -47,11 +47,14 @@ , insertWith , delete , adjust + , update + , alter -- * Combine -- ** Union , union , unionWith + , unionWithKey , unions -- * Transformations @@ -63,6 +66,7 @@ , difference , intersection , intersectionWith + , intersectionWithKey -- * Folds , foldl' @@ -73,6 +77,8 @@ -- * Filter , HM.filter , filterWithKey + , mapMaybe + , mapMaybeWithKey -- * Conversions , keys diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/Data/HashMap/Strict.hs new/unordered-containers-0.2.7.1/Data/HashMap/Strict.hs --- old/unordered-containers-0.2.5.1/Data/HashMap/Strict.hs 2014-10-11 15:04:46.000000000 +0200 +++ new/unordered-containers-0.2.7.1/Data/HashMap/Strict.hs 2016-06-09 02:00:11.000000000 +0200 @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns, CPP #-} +{-# LANGUAGE BangPatterns, CPP, PatternGuards #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} @@ -47,11 +47,14 @@ , insertWith , delete , adjust + , update + , alter -- * Combine -- ** Union , union , unionWith + , unionWithKey , unions -- * Transformations @@ -63,6 +66,7 @@ , difference , intersection , intersectionWith + , intersectionWithKey -- * Folds , foldl' @@ -73,6 +77,8 @@ -- * Filter , HM.filter , filterWithKey + , mapMaybe + , mapMaybeWithKey -- * Conversions , keys @@ -92,8 +98,9 @@ import qualified Data.HashMap.Array as A import qualified Data.HashMap.Base as HM import Data.HashMap.Base hiding ( - adjust, fromList, fromListWith, insert, insertWith, intersectionWith, - map, mapWithKey, singleton, unionWith) + alter, adjust, fromList, fromListWith, insert, insertWith, intersectionWith, + intersectionWithKey, map, mapWithKey, mapMaybe, mapMaybeWithKey, singleton, + update, unionWith, unionWithKey) import Data.HashMap.Unsafe (runST) -- $strictness @@ -227,6 +234,23 @@ | otherwise = t {-# INLINABLE adjust #-} +-- | /O(log n)/ The expression (@'update' f k map@) updates the value @x@ at @k@, +-- (if it is in the map). If (f k x) is @'Nothing', the element is deleted. +-- If it is (@'Just' y), the key k is bound to the new value y. +update :: (Eq k, Hashable k) => (a -> Maybe a) -> k -> HashMap k a -> HashMap k a +update f = alter (>>= f) +{-# INLINABLE update #-} + +-- | /O(log n)/ The expression (@'alter' f k map@) alters the value @x@ at @k@, or +-- absence thereof. @alter@ can be used to insert, delete, or update a value in a +-- map. In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@. +alter :: (Eq k, Hashable k) => (Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v +alter f k m = + case f (HM.lookup k m) of + Nothing -> delete k m + Just v -> insert k v m +{-# INLINABLE alter #-} + ------------------------------------------------------------------------ -- * Combine @@ -234,7 +258,14 @@ -- the provided function (first argument) will be used to compute the result. unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v -unionWith f = go 0 +unionWith f = unionWithKey (const f) +{-# INLINE unionWith #-} + +-- | /O(n+m)/ The union of two maps. If a key occurs in both maps, +-- the provided function (first argument) will be used to compute the result. +unionWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> HashMap k v -> HashMap k v + -> HashMap k v +unionWithKey f = go 0 where -- empty vs. anything go !_ t1 Empty = t1 @@ -242,17 +273,17 @@ -- leaf vs. leaf go s t1@(Leaf h1 l1@(L k1 v1)) t2@(Leaf h2 l2@(L k2 v2)) | h1 == h2 = if k1 == k2 - then leaf h1 k1 (f v1 v2) + then leaf h1 k1 (f k1 v1 v2) else collision h1 l1 l2 | otherwise = goDifferentHash s h1 h2 t1 t2 go s t1@(Leaf h1 (L k1 v1)) t2@(Collision h2 ls2) - | h1 == h2 = Collision h1 (updateOrSnocWith f k1 v1 ls2) + | h1 == h2 = Collision h1 (updateOrSnocWithKey f k1 v1 ls2) | otherwise = goDifferentHash s h1 h2 t1 t2 go s t1@(Collision h1 ls1) t2@(Leaf h2 (L k2 v2)) - | h1 == h2 = Collision h1 (updateOrSnocWith (flip f) k2 v2 ls1) + | h1 == h2 = Collision h1 (updateOrSnocWithKey (flip . f) k2 v2 ls1) | otherwise = goDifferentHash s h1 h2 t1 t2 go s t1@(Collision h1 ls1) t2@(Collision h2 ls2) - | h1 == h2 = Collision h1 (updateOrConcatWith f ls1 ls2) + | h1 == h2 = Collision h1 (updateOrConcatWithKey f ls1 ls2) | otherwise = goDifferentHash s h1 h2 t1 t2 -- branch vs. branch go s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) = @@ -314,7 +345,7 @@ where m1 = mask h1 s m2 = mask h2 s -{-# INLINE unionWith #-} +{-# INLINE unionWithKey #-} ------------------------------------------------------------------------ -- * Transformations @@ -336,6 +367,28 @@ map f = mapWithKey (const f) {-# INLINE map #-} + +------------------------------------------------------------------------ +-- * Filter + +-- | /O(n)/ Transform this map by applying a function to every value +-- and retaining only some of them. +mapMaybeWithKey :: (k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2 +mapMaybeWithKey f = filterMapAux onLeaf onColl + where onLeaf (Leaf h (L k v)) | Just v' <- f k v = Just (leaf h k v') + onLeaf _ = Nothing + + onColl (L k v) | Just v' <- f k v = Just (L k v') + | otherwise = Nothing +{-# INLINE mapMaybeWithKey #-} + +-- | /O(n)/ Transform this map by applying a function to every value +-- and retaining only some of them. +mapMaybe :: (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2 +mapMaybe f = mapMaybeWithKey (const f) +{-# INLINE mapMaybe #-} + + -- TODO: Should we add a strict traverseWithKey? ------------------------------------------------------------------------ @@ -353,6 +406,18 @@ _ -> m {-# INLINABLE intersectionWith #-} +-- | /O(n+m)/ Intersection of two maps. If a key occurs in both maps +-- the provided function is used to combine the values from the two +-- maps. +intersectionWithKey :: (Eq k, Hashable k) => (k -> v1 -> v2 -> v3) + -> HashMap k v1 -> HashMap k v2 -> HashMap k v3 +intersectionWithKey f a b = foldlWithKey' go empty a + where + go m k v = case HM.lookup k b of + Just w -> insert k (f k v w) m + _ -> m +{-# INLINABLE intersectionWithKey #-} + ------------------------------------------------------------------------ -- ** Lists @@ -364,7 +429,18 @@ {-# INLINABLE fromList #-} -- | /O(n*log n)/ Construct a map from a list of elements. Uses --- the provided function to merge duplicate entries. +-- the provided function f to merge duplicate entries (f newVal oldVal). +-- +-- For example: +-- +-- > fromListWith (+) [ (x, 1) | x <- xs ] +-- +-- will create a map with number of occurrences of each element in xs. +-- +-- > fromListWith (++) [ (k, [v]) | (k, v) <- xs ] +-- +-- will group all values by their keys in a list 'xs :: [(k, v)]' and +-- return a 'HashMap k [v]'. fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v fromListWith f = L.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty {-# INLINE fromListWith #-} @@ -389,7 +465,17 @@ -- array. updateOrSnocWith :: Eq k => (v -> v -> v) -> k -> v -> A.Array (Leaf k v) -> A.Array (Leaf k v) -updateOrSnocWith f k0 v0 ary0 = go k0 v0 ary0 0 (A.length ary0) +updateOrSnocWith f = updateOrSnocWithKey (const f) +{-# INLINABLE updateOrSnocWith #-} + +-- | Append the given key and value to the array. If the key is +-- already present, instead update the value of the key by applying +-- the given function to the new and old value (in that order). The +-- value is always evaluated to WHNF before being inserted into the +-- array. +updateOrSnocWithKey :: Eq k => (k -> v -> v -> v) -> k -> v -> A.Array (Leaf k v) + -> A.Array (Leaf k v) +updateOrSnocWithKey f k0 v0 ary0 = go k0 v0 ary0 0 (A.length ary0) where go !k v !ary !i !n | i >= n = A.run $ do @@ -400,9 +486,9 @@ A.write mary n l return mary | otherwise = case A.index ary i of - (L kx y) | k == kx -> let !v' = f v y in A.update ary i (L k v') + (L kx y) | k == kx -> let !v' = f k v y in A.update ary i (L k v') | otherwise -> go k v ary (i+1) n -{-# INLINABLE updateOrSnocWith #-} +{-# INLINABLE updateOrSnocWithKey #-} ------------------------------------------------------------------------ -- Smart constructors diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/Data/HashMap/Unsafe.hs new/unordered-containers-0.2.7.1/Data/HashMap/Unsafe.hs --- old/unordered-containers-0.2.5.1/Data/HashMap/Unsafe.hs 2014-10-11 15:04:46.000000000 +0200 +++ new/unordered-containers-0.2.7.1/Data/HashMap/Unsafe.hs 2016-06-09 02:00:11.000000000 +0200 @@ -13,16 +13,16 @@ ) where import GHC.Base (realWorld#) -import GHC.ST hiding (runST, runSTRep) +import qualified GHC.ST as ST -- | Return the value computed by a state transformer computation. -- The @forall@ ensures that the internal state used by the 'ST' -- computation is inaccessible to the rest of the program. -runST :: (forall s. ST s a) -> a -runST st = runSTRep (case st of { ST st_rep -> st_rep }) +runST :: (forall s. ST.ST s a) -> a +runST st = runSTRep (case st of { ST.ST st_rep -> st_rep }) {-# INLINE runST #-} -runSTRep :: (forall s. STRep s a) -> a +runSTRep :: (forall s. ST.STRep s a) -> a runSTRep st_rep = case st_rep realWorld# of (# _, r #) -> r {-# INLINE [0] runSTRep #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/Data/HashSet.hs new/unordered-containers-0.2.7.1/Data/HashSet.hs --- old/unordered-containers-0.2.5.1/Data/HashSet.hs 2014-10-11 15:04:46.000000000 +0200 +++ new/unordered-containers-0.2.7.1/Data/HashSet.hs 2016-06-09 02:00:11.000000000 +0200 @@ -1,7 +1,11 @@ {-# LANGUAGE CPP, DeriveDataTypeable #-} #if __GLASGOW_HASKELL__ >= 708 +{-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE TypeFamilies #-} #endif +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif ------------------------------------------------------------------------ -- | @@ -57,16 +61,24 @@ -- * Filter , filter + -- * Conversions + -- ** Lists , toList , fromList + + -- * HashMaps + , toMap + , fromMap ) where import Control.DeepSeq (NFData(..)) import Data.Data hiding (Typeable) import Data.HashMap.Base (HashMap, foldrWithKey) -import Data.Hashable (Hashable) -#if __GLASGOW_HASKELL__ < 709 +import Data.Hashable (Hashable(hashWithSalt)) +#if __GLASGOW_HASKELL__ >= 711 +import Data.Semigroup (Semigroup(..), Monoid(..)) +#elif __GLASGOW_HASKELL__ < 709 import Data.Monoid (Monoid(..)) #endif import GHC.Exts (build) @@ -86,6 +98,10 @@ asMap :: HashMap a () } deriving (Typeable) +#if __GLASGOW_HASKELL__ >= 708 +type role HashSet nominal +#endif + instance (NFData a) => NFData (HashSet a) where rnf = rnf . asMap {-# INLINE rnf #-} @@ -100,10 +116,20 @@ foldr = Data.HashSet.foldr {-# INLINE foldr #-} +#if __GLASGOW_HASKELL__ >= 711 +instance (Hashable a, Eq a) => Semigroup (HashSet a) where + (<>) = union + {-# INLINE (<>) #-} +#endif + instance (Hashable a, Eq a) => Monoid (HashSet a) where mempty = empty {-# INLINE mempty #-} +#if __GLASGOW_HASKELL__ >= 711 + mappend = (<>) +#else mappend = union +#endif {-# INLINE mappend #-} instance (Eq a, Hashable a, Read a) => Read (HashSet a) where @@ -127,6 +153,9 @@ dataTypeOf _ = hashSetDataType dataCast1 f = gcast1 f +instance (Hashable a) => Hashable (HashSet a) where + hashWithSalt salt = hashWithSalt salt . asMap + fromListConstr :: Constr fromListConstr = mkConstr hashSetDataType "fromList" [] Prefix @@ -142,6 +171,14 @@ singleton a = HashSet (H.singleton a ()) {-# INLINABLE singleton #-} +-- | /O(1)/ Convert to the equivalent 'HashMap'. +toMap :: HashSet a -> HashMap a () +toMap = asMap + +-- | /O(1)/ Convert from the equivalent 'HashMap'. +fromMap :: HashMap a () -> HashSet a +fromMap = HashSet + -- | /O(n+m)/ Construct a set containing all elements from both sets. -- -- To obtain good performance, the smaller set must be presented as diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/benchmarks/Benchmarks.hs new/unordered-containers-0.2.7.1/benchmarks/Benchmarks.hs --- old/unordered-containers-0.2.5.1/benchmarks/Benchmarks.hs 2014-10-11 15:04:46.000000000 +0200 +++ new/unordered-containers-0.2.7.1/benchmarks/Benchmarks.hs 2016-06-09 02:00:11.000000000 +0200 @@ -1,12 +1,10 @@ -{-# LANGUAGE CPP, GADTs, PackageImports #-} +{-# LANGUAGE CPP, DeriveGeneric, GADTs, PackageImports, RecordWildCards #-} module Main where import Control.DeepSeq -import Control.Exception (evaluate) -import Control.Monad.Trans (liftIO) -import Criterion.Config -import Criterion.Main +import Control.DeepSeq.Generics (genericRnf) +import Criterion.Main (bench, bgroup, defaultMain, env, nf, whnf) import Data.Bits ((.&.)) import Data.Hashable (Hashable) import qualified Data.ByteString as BS @@ -16,6 +14,7 @@ import qualified Data.Map as M import Data.List (foldl') import Data.Maybe (fromMaybe) +import GHC.Generics (Generic) import Prelude hiding (lookup) import qualified Util.ByteString as UBS @@ -32,20 +31,82 @@ instance NFData B where rnf (B b) = rnf b +-- TODO: This a stopgap measure to keep the benchmark work with +-- Criterion 1.0. +data Env = Env { + n :: !Int, + + elems :: ![(String, Int)], + keys :: ![String], + elemsBS :: ![(BS.ByteString, Int)], + keysBS :: ![BS.ByteString], + elemsI :: ![(Int, Int)], + keysI :: ![Int], + elemsI2 :: ![(Int, Int)], -- for union + + keys' :: ![String], + keysBS' :: ![BS.ByteString], + keysI' :: ![Int], + + keysDup :: ![String], + keysDupBS :: ![BS.ByteString], + keysDupI :: ![Int], + elemsDup :: ![(String, Int)], + elemsDupBS :: ![(BS.ByteString, Int)], + elemsDupI :: ![(Int, Int)], + + hm :: !(HM.HashMap String Int), + hmbs :: !(HM.HashMap BS.ByteString Int), + hmi :: !(HM.HashMap Int Int), + hmi2 :: !(HM.HashMap Int Int), + m :: !(M.Map String Int), + mbs :: !(M.Map BS.ByteString Int), + im :: !(IM.IntMap Int), + ihm :: !(IHM.Map String Int), + ihmbs :: !(IHM.Map BS.ByteString Int) + } deriving Generic + +instance NFData Env where rnf = genericRnf + +setupEnv :: IO Env +setupEnv = do + let n = 2^(12 :: Int) + + elems = zip keys [1..n] + keys = US.rnd 8 n + elemsBS = zip keysBS [1..n] + keysBS = UBS.rnd 8 n + elemsI = zip keysI [1..n] + keysI = UI.rnd (n+n) n + elemsI2 = zip [n `div` 2..n + (n `div` 2)] [1..n] -- for union + + keys' = US.rnd' 8 n + keysBS' = UBS.rnd' 8 n + keysI' = UI.rnd' (n+n) n + + keysDup = US.rnd 2 n + keysDupBS = UBS.rnd 2 n + keysDupI = UI.rnd (n`div`4) n + elemsDup = zip keysDup [1..n] + elemsDupBS = zip keysDupBS [1..n] + elemsDupI = zip keysDupI [1..n] + + hm = HM.fromList elems + hmbs = HM.fromList elemsBS + hmi = HM.fromList elemsI + hmi2 = HM.fromList elemsI2 + m = M.fromList elems + mbs = M.fromList elemsBS + im = IM.fromList elemsI + ihm = IHM.fromList elems + ihmbs = IHM.fromList elemsBS + return Env{..} + main :: IO () main = do - let hm = HM.fromList elems :: HM.HashMap String Int - hmbs = HM.fromList elemsBS :: HM.HashMap BS.ByteString Int - hmi = HM.fromList elemsI :: HM.HashMap Int Int - hmi2 = HM.fromList elemsI2 :: HM.HashMap Int Int - m = M.fromList elems :: M.Map String Int - mbs = M.fromList elemsBS :: M.Map BS.ByteString Int - im = IM.fromList elemsI :: IM.IntMap Int - ihm = IHM.fromList elems :: IHM.Map String Int - ihmbs = IHM.fromList elemsBS :: IHM.Map BS.ByteString Int - defaultMainWith defaultConfig - (liftIO . evaluate $ rnf [B m, B mbs, B hm, B hmbs, B hmi, B im]) + defaultMain [ + env setupEnv $ \ ~(Env{..}) -> -- * Comparison to other data structures -- ** Map bgroup "Map" @@ -84,7 +145,8 @@ ] -- ** Map from the hashmap package - , bgroup "hashmap/Map" + , env setupEnv $ \ ~(Env{..}) -> + bgroup "hashmap/Map" [ bgroup "lookup" [ bench "String" $ whnf (lookupIHM keys) ihm , bench "ByteString" $ whnf (lookupIHM keysBS) ihmbs @@ -120,7 +182,8 @@ ] -- ** IntMap - , bgroup "IntMap" + , env setupEnv $ \ ~(Env{..}) -> + bgroup "IntMap" [ bench "lookup" $ whnf (lookupIM keysI) im , bench "lookup-miss" $ whnf (lookupIM keysI') im , bench "insert" $ whnf (insertIM elemsI) IM.empty @@ -131,7 +194,8 @@ , bench "fromList" $ whnf IM.fromList elemsI ] - , bgroup "HashMap" + , env setupEnv $ \ ~(Env{..}) -> + bgroup "HashMap" [ -- * Basic interface bgroup "lookup" [ bench "String" $ whnf (lookup keys) hm @@ -217,28 +281,6 @@ ] ] ] - where - n :: Int - n = 2^(12 :: Int) - - elems = zip keys [1..n] - keys = US.rnd 8 n - elemsBS = zip keysBS [1..n] - keysBS = UBS.rnd 8 n - elemsI = zip keysI [1..n] - keysI = UI.rnd (n+n) n - elemsI2 = zip [n `div` 2..n + (n `div` 2)] [1..n] -- for union - - keys' = US.rnd' 8 n - keysBS' = UBS.rnd' 8 n - keysI' = UI.rnd' (n+n) n - - keysDup = US.rnd 2 n - keysDupBS = UBS.rnd 2 n - keysDupI = UI.rnd (n`div`4) n - elemsDup = zip keysDup [1..n] - elemsDupBS = zip keysDupBS [1..n] - elemsDupI = zip keysDupI [1..n] ------------------------------------------------------------------------ -- * HashMap diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/benchmarks/Util/ByteString.hs new/unordered-containers-0.2.7.1/benchmarks/Util/ByteString.hs --- old/unordered-containers-0.2.5.1/benchmarks/Util/ByteString.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/unordered-containers-0.2.7.1/benchmarks/Util/ByteString.hs 2016-06-09 02:00:11.000000000 +0200 @@ -0,0 +1,29 @@ +-- | Benchmarking utilities. For example, functions for generating +-- random 'ByteString's. +module Util.ByteString where + +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as C + +import Util.String as String + +-- | Generate a number of fixed length 'ByteString's where the content +-- of the strings are letters in ascending order. +asc :: Int -- ^ Length of each string + -> Int -- ^ Number of strings + -> [S.ByteString] +asc strlen num = map C.pack $ String.asc strlen num + +-- | Generate a number of fixed length 'ByteString's where the content +-- of the strings are letters in random order. +rnd :: Int -- ^ Length of each string + -> Int -- ^ Number of strings + -> [S.ByteString] +rnd strlen num = map C.pack $ String.rnd strlen num + +-- | Generate a number of fixed length 'ByteString's where the content +-- of the strings are letters in random order, different from @rnd@. +rnd' :: Int -- ^ Length of each string + -> Int -- ^ Number of strings + -> [S.ByteString] +rnd' strlen num = map C.pack $ String.rnd' strlen num diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/benchmarks/Util/Int.hs new/unordered-containers-0.2.7.1/benchmarks/Util/Int.hs --- old/unordered-containers-0.2.5.1/benchmarks/Util/Int.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/unordered-containers-0.2.7.1/benchmarks/Util/Int.hs 2016-06-09 02:00:11.000000000 +0200 @@ -0,0 +1,19 @@ +-- | Benchmarking utilities. For example, functions for generating +-- random integers. +module Util.Int where + +import System.Random (mkStdGen, randomRs) + +-- | Generate a number of uniform random integers in the interval +-- @[0..upper]@. +rnd :: Int -- ^ Upper bound (inclusive) + -> Int -- ^ Number of integers + -> [Int] +rnd upper num = take num $ randomRs (0, upper) $ mkStdGen 1234 + +-- | Generate a number of uniform random integers in the interval +-- @[0..upper]@ different from @rnd@. +rnd' :: Int -- ^ Upper bound (inclusive) + -> Int -- ^ Number of integers + -> [Int] +rnd' upper num = take num $ randomRs (0, upper) $ mkStdGen 5678 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/benchmarks/Util/String.hs new/unordered-containers-0.2.7.1/benchmarks/Util/String.hs --- old/unordered-containers-0.2.5.1/benchmarks/Util/String.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/unordered-containers-0.2.7.1/benchmarks/Util/String.hs 2016-06-09 02:00:11.000000000 +0200 @@ -0,0 +1,34 @@ +-- | Benchmarking utilities. For example, functions for generating +-- random strings. +module Util.String where + +import System.Random (mkStdGen, randomRs) + +-- | Generate a number of fixed length strings where the content of +-- the strings are letters in ascending order. +asc :: Int -- ^ Length of each string + -> Int -- ^ Number of strings + -> [String] +asc strlen num = take num $ iterate (snd . inc) $ replicate strlen 'a' + where inc [] = (True, []) + inc (c:cs) = case inc cs of (True, cs') | c == 'z' -> (True, 'a' : cs') + | otherwise -> (False, succ c : cs') + (False, cs') -> (False, c : cs') + +-- | Generate a number of fixed length strings where the content of +-- the strings are letters in random order. +rnd :: Int -- ^ Length of each string + -> Int -- ^ Number of strings + -> [String] +rnd strlen num = take num $ split $ randomRs ('a', 'z') $ mkStdGen 1234 + where + split cs = case splitAt strlen cs of (str, cs') -> str : split cs' + +-- | Generate a number of fixed length strings where the content of +-- the strings are letters in random order, different from rnd +rnd' :: Int -- ^ Length of each string + -> Int -- ^ Number of strings + -> [String] +rnd' strlen num = take num $ split $ randomRs ('a', 'z') $ mkStdGen 5678 + where + split cs = case splitAt strlen cs of (str, cs') -> str : split cs' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/cbits/popc.c new/unordered-containers-0.2.7.1/cbits/popc.c --- old/unordered-containers-0.2.5.1/cbits/popc.c 2014-10-11 15:04:46.000000000 +0200 +++ new/unordered-containers-0.2.7.1/cbits/popc.c 2016-06-09 02:00:11.000000000 +0200 @@ -261,7 +261,7 @@ }; /* Table-driven popcount, with 8-bit tables */ /* 6 ops plus 4 casts and 4 lookups, 0 long immediates, 4 stages */ -inline uint32_t +uint32_t popcount(uint32_t x) { return popcount_table_8[(uint8_t)x] + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/tests/HashMapProperties.hs new/unordered-containers-0.2.7.1/tests/HashMapProperties.hs --- old/unordered-containers-0.2.5.1/tests/HashMapProperties.hs 2014-10-11 15:04:46.000000000 +0200 +++ new/unordered-containers-0.2.7.1/tests/HashMapProperties.hs 2016-06-09 02:00:11.000000000 +0200 @@ -5,17 +5,19 @@ module Main (main) where +import Control.Monad ( guard ) import qualified Data.Foldable as Foldable import Data.Function (on) import Data.Hashable (Hashable(hashWithSalt)) import qualified Data.List as L +import Data.Ord (comparing) #if defined(STRICT) import qualified Data.HashMap.Strict as HM #else import qualified Data.HashMap.Lazy as HM #endif import qualified Data.Map as M -import Test.QuickCheck (Arbitrary, Property, (==>)) +import Test.QuickCheck (Arbitrary, Property, (==>), (===)) import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) @@ -48,6 +50,19 @@ pFoldable = (L.sort . Foldable.foldr (:) []) `eq` (L.sort . Foldable.foldr (:) []) +pHashable :: [(Key, Int)] -> [Int] -> Int -> Property +pHashable xs is salt = + x == y ==> hashWithSalt salt x === hashWithSalt salt y + where + ys = shuffle is xs + x = HM.fromList xs + y = HM.fromList ys + -- Shuffle the list using indexes in the second + shuffle :: [Int] -> [a] -> [a] + shuffle idxs = L.map snd + . L.sortBy (comparing fst) + . L.zip (idxs ++ [L.maximum (0:is) + 1 ..]) + ------------------------------------------------------------------------ -- ** Basic interface @@ -98,6 +113,21 @@ pAdjust :: Key -> [(Key, Int)] -> Bool pAdjust k = M.adjust succ k `eq_` HM.adjust succ k +pUpdateAdjust :: Key -> [(Key, Int)] -> Bool +pUpdateAdjust k = M.update (Just . succ) k `eq_` HM.update (Just . succ) k + +pUpdateDelete :: Key -> [(Key, Int)] -> Bool +pUpdateDelete k = M.update (const Nothing) k `eq_` HM.update (const Nothing) k + +pAlterAdjust :: Key -> [(Key, Int)] -> Bool +pAlterAdjust k = M.alter (fmap succ) k `eq_` HM.alter (fmap succ) k + +pAlterInsert :: Key -> [(Key, Int)] -> Bool +pAlterInsert k = M.alter (const $ Just 3) k `eq_` HM.alter (const $ Just 3) k + +pAlterDelete :: Key -> [(Key, Int)] -> Bool +pAlterDelete k = M.alter (const Nothing) k `eq_` HM.alter (const Nothing) k + ------------------------------------------------------------------------ -- ** Combine @@ -108,6 +138,13 @@ pUnionWith xs ys = M.unionWith (-) (M.fromList xs) `eq_` HM.unionWith (-) (HM.fromList xs) $ ys +pUnionWithKey :: [(Key, Int)] -> [(Key, Int)] -> Bool +pUnionWithKey xs ys = M.unionWithKey go (M.fromList xs) `eq_` + HM.unionWithKey go (HM.fromList xs) $ ys + where + go :: Key -> Int -> Int -> Int + go (K k) i1 i2 = k - i1 + i2 + pUnions :: [[(Key, Int)]] -> Bool pUnions xss = M.toAscList (M.unions (map M.fromList xss)) == toAscList (HM.unions (map HM.fromList xss)) @@ -133,6 +170,13 @@ pIntersectionWith xs ys = M.intersectionWith (-) (M.fromList xs) `eq_` HM.intersectionWith (-) (HM.fromList xs) $ ys +pIntersectionWithKey :: [(Key, Int)] -> [(Key, Int)] -> Bool +pIntersectionWithKey xs ys = M.intersectionWithKey go (M.fromList xs) `eq_` + HM.intersectionWithKey go (HM.fromList xs) $ ys + where + go :: Key -> Int -> Int -> Int + go (K k) i1 i2 = k - i1 - i2 + ------------------------------------------------------------------------ -- ** Folds @@ -158,6 +202,14 @@ ------------------------------------------------------------------------ -- ** Filter +pMapMaybeWithKey :: [(Key, Int)] -> Bool +pMapMaybeWithKey = M.mapMaybeWithKey f `eq_` HM.mapMaybeWithKey f + where f k v = guard (odd (unK k + v)) >> Just (v + 1) + +pMapMaybe :: [(Key, Int)] -> Bool +pMapMaybe = M.mapMaybe f `eq_` HM.mapMaybe f + where f v = guard (odd v) >> Just (v + 1) + pFilter :: [(Key, Int)] -> Bool pFilter = M.filter odd `eq_` HM.filter odd @@ -198,6 +250,7 @@ , testProperty "Read/Show" pReadShow , testProperty "Functor" pFunctor , testProperty "Foldable" pFoldable + , testProperty "Hashable" pHashable ] -- Basic interface , testGroup "basic interface" @@ -209,10 +262,16 @@ , testProperty "deleteCollision" pDeleteCollision , testProperty "insertWith" pInsertWith , testProperty "adjust" pAdjust + , testProperty "updateAdjust" pUpdateAdjust + , testProperty "updateDelete" pUpdateDelete + , testProperty "alterAdjust" pAlterAdjust + , testProperty "alterInsert" pAlterInsert + , testProperty "alterDelete" pAlterDelete ] -- Combine , testProperty "union" pUnion , testProperty "unionWith" pUnionWith + , testProperty "unionWithKey" pUnionWithKey , testProperty "unions" pUnions -- Transformations , testProperty "map" pMap @@ -226,11 +285,14 @@ [ testProperty "difference" pDifference , testProperty "intersection" pIntersection , testProperty "intersectionWith" pIntersectionWith + , testProperty "intersectionWithKey" pIntersectionWithKey ] -- Filter , testGroup "filter" [ testProperty "filter" pFilter , testProperty "filterWithKey" pFilterWithKey + , testProperty "mapMaybe" pMapMaybe + , testProperty "mapMaybeWithKey" pMapMaybeWithKey ] -- Conversions , testGroup "conversions" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/tests/HashSetProperties.hs new/unordered-containers-0.2.7.1/tests/HashSetProperties.hs --- old/unordered-containers-0.2.5.1/tests/HashSetProperties.hs 2014-10-11 15:04:46.000000000 +0200 +++ new/unordered-containers-0.2.7.1/tests/HashSetProperties.hs 2016-06-09 02:00:11.000000000 +0200 @@ -10,7 +10,8 @@ import qualified Data.List as L import qualified Data.HashSet as S import qualified Data.Set as Set -import Test.QuickCheck (Arbitrary) +import Data.Ord (comparing) +import Test.QuickCheck (Arbitrary, Property, (==>), (===)) import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) @@ -40,6 +41,25 @@ pFoldable = (L.sort . Foldable.foldr (:) []) `eq` (L.sort . Foldable.foldr (:) []) +pPermutationEq :: [Key] -> [Int] -> Bool +pPermutationEq xs is = S.fromList xs == S.fromList ys + where + ys = shuffle is xs + shuffle idxs = L.map snd + . L.sortBy (comparing fst) + . L.zip (idxs ++ [L.maximum (0:is) + 1 ..]) + +pHashable :: [Key] -> [Int] -> Int -> Property +pHashable xs is salt = + x == y ==> hashWithSalt salt x === hashWithSalt salt y + where + ys = shuffle is xs + x = S.fromList xs + y = S.fromList ys + shuffle idxs = L.map snd + . L.sortBy (comparing fst) + . L.zip (idxs ++ [L.maximum (0:is) + 1 ..]) + ------------------------------------------------------------------------ -- ** Basic interface @@ -113,9 +133,11 @@ -- Instances testGroup "instances" [ testProperty "==" pEq + , testProperty "Permutation ==" pPermutationEq , testProperty "/=" pNeq , testProperty "Read/Show" pReadShow , testProperty "Foldable" pFoldable + , testProperty "Hashable" pHashable ] -- Basic interface , testGroup "basic interface" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/unordered-containers-0.2.5.1/unordered-containers.cabal new/unordered-containers-0.2.7.1/unordered-containers.cabal --- old/unordered-containers-0.2.5.1/unordered-containers.cabal 2014-10-11 15:04:46.000000000 +0200 +++ new/unordered-containers-0.2.7.1/unordered-containers.cabal 2016-06-09 02:00:11.000000000 +0200 @@ -1,5 +1,5 @@ name: unordered-containers -version: 0.2.5.1 +version: 0.2.7.1 synopsis: Efficient hashing-based container types description: Efficient hashing-based container types. The containers have been @@ -19,6 +19,8 @@ category: Data build-type: Simple cabal-version: >=1.8 +extra-source-files: CHANGES.md +tested-with: GHC==8.0.1, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 flag debug description: Enable debug support @@ -39,7 +41,7 @@ build-depends: base >= 4 && < 5, deepseq >= 1.1, - hashable >= 1.0.1.1 + hashable >= 1.0.1.1 && < 1.3 if impl(ghc < 7.4) c-sources: cbits/popc.c @@ -147,12 +149,18 @@ main-is: Benchmarks.hs type: exitcode-stdio-1.0 + other-modules: + Util.ByteString + Util.Int + Util.String + build-depends: base, bytestring, containers, - criterion, + criterion >= 1.0 && < 1.2, deepseq >= 1.1, + deepseq-generics, hashable >= 1.0.1.1, hashmap, mtl,