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 - [email protected]
+
+- update to 0.2.7.1
+- remove useless _service
+* Fix linker error related to popcnt.
+
+-------------------------------------------------------------------
+Sat Feb 20 08:32:45 UTC 2016 - [email protected]
+
+- update to 0.2.7.0
+* support criterion-1.1
+* Add unionWithKey for hash maps.
+
+-------------------------------------------------------------------
+Tue Feb 16 20:05:18 UTC 2016 - [email protected]
+
+- 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,
