unordered-containers 0.2.10.0 → 0.2.11.0
raw patch · 12 files changed
+742/−129 lines, 12 filesdep +gaugedep −criterionnew-uploader
Dependencies added: gauge
Dependencies removed: criterion
Files
- CHANGES.md +38/−0
- Data/HashMap/Array.hs +38/−2
- Data/HashMap/Base.hs +299/−62
- Data/HashMap/Lazy.hs +10/−2
- Data/HashMap/Strict.hs +18/−1
- Data/HashMap/Strict/Base.hs +81/−20
- Data/HashSet/Base.hs +88/−4
- benchmarks/Benchmarks.hs +6/−2
- tests/HashMapProperties.hs +83/−11
- tests/Regressions.hs +55/−0
- tests/Strictness.hs +4/−0
- unordered-containers.cabal +22/−25
CHANGES.md view
@@ -1,3 +1,41 @@+## 0.2.11.0++ * Add `HashMap.findWithDefault` (soft-deprecates `HashMap.lookupDefault`).+ Thanks, Matt Renaud.++ * Add `HashMap.fromListWithKey`. Thanks, Josef Svenningsson.++ * Add more folding functions and use them in `Foldable` instances. Thanks,+ David Feuer.++ * Add `HashMap.!?`, a flipped version of `lookup`. Thanks, Matt Renaud.++ * Add a `Bifoldable` instance for `HashMap`. Thanks, Joseph Sible.++ * Add a `HasCallStack` constraint to `(!)`. Thanks, Roman Cheplyaka.++### Bug fixes++ * Fix a space leak affecting updates on keys with hash collisions. Thanks,+ Neil Mitchell. ([#254])++ * Get rid of some silly thunks that could be left lying around. ([#232]).+ Thanks, David Feuer.++### Other changes++ * Speed up the `Hashable` instances for `HashMap` and `HashSet`. Thanks,+ Edward Amsden.++ * Remove a dependency cycle hack from the benchmark suite. Thanks,+ Andrew Martin.++ * Improve documentation. Thanks, Tristan McLeay, Li-yao Xia, Gareth Smith,+ Simon Jakobi, Sergey Vinokurov, and likely others.++[#232]: https://github.com/haskell-unordered-containers/unordered-containers/issues/232+[#254]: https://github.com/haskell-unordered-containers/unordered-containers/issues/254+ ## 0.2.10.0 * Add `HashMap.alterF`.
Data/HashMap/Array.hs view
@@ -41,8 +41,11 @@ , copyM -- * Folds+ , foldl , foldl' , foldr+ , foldr'+ , foldMap , thaw , map@@ -63,9 +66,9 @@ import Control.Monad.ST (stToIO) #if __GLASGOW_HASKELL__ >= 709-import Prelude hiding (filter, foldr, length, map, read, traverse)+import Prelude hiding (filter, foldMap, foldr, foldl, length, map, read, traverse) #else-import Prelude hiding (filter, foldr, length, map, read)+import Prelude hiding (filter, foldr, foldl, length, map, read) #endif #if __GLASGOW_HASKELL__ >= 710@@ -79,6 +82,7 @@ indexArray#, unsafeFreezeArray#, unsafeThawArray#, MutableArray#, sizeofArray#, copyArray#, thawArray#, sizeofMutableArray#, copyMutableArray#, cloneMutableArray#)+import Data.Monoid (Monoid (..)) #endif #if defined(ASSERTS)@@ -418,6 +422,15 @@ (# x #) -> go ary n (i+1) (f z x) {-# INLINE foldl' #-} +foldr' :: (a -> b -> b) -> b -> Array a -> b+foldr' f = \ z0 ary0 -> go ary0 (length ary0 - 1) z0+ where+ go !_ary (-1) z = z+ go !ary i !z+ | (# x #) <- index# ary i+ = go ary (i - 1) (f x z)+{-# INLINE foldr' #-}+ foldr :: (a -> b -> b) -> b -> Array a -> b foldr f = \ z0 ary0 -> go ary0 (length ary0) 0 z0 where@@ -427,6 +440,29 @@ = case index# ary i of (# x #) -> f x (go ary n (i+1) z) {-# INLINE foldr #-}++foldl :: (b -> a -> b) -> b -> Array a -> b+foldl f = \ z0 ary0 -> go ary0 (length ary0 - 1) z0+ where+ go _ary (-1) z = z+ go ary i z+ | (# x #) <- index# ary i+ = f (go ary (i - 1) z) x+{-# INLINE foldl #-}++-- We go to a bit of trouble here to avoid appending an extra mempty.+-- The below implementation is by Mateusz Kowalczyk, who indicates that+-- benchmarks show it to be faster than one that avoids lifting out+-- lst.+foldMap :: Monoid m => (a -> m) -> Array a -> m+foldMap f = \ary0 -> case length ary0 of+ 0 -> mempty+ len ->+ let !lst = len - 1+ go i | (# x #) <- index# ary0 i, let fx = f x =+ if i == lst then fx else fx `mappend` go (i + 1)+ in go 0+{-# INLINE foldMap #-} undefinedElem :: a undefinedElem = error "Data.HashMap.Array: Undefined element"
Data/HashMap/Base.hs view
@@ -25,6 +25,8 @@ , size , member , lookup+ , (!?)+ , findWithDefault , lookupDefault , (!) , insert@@ -56,10 +58,15 @@ , intersectionWithKey -- * Folds+ , foldr' , foldl'+ , foldrWithKey' , foldlWithKey' , foldr+ , foldl , foldrWithKey+ , foldlWithKey+ , foldMapWithKey -- * Filter , mapMaybe@@ -75,6 +82,7 @@ , toList , fromList , fromListWith+ , fromListWithKey -- Internals used by the strict version , Hash@@ -124,9 +132,12 @@ import Data.Bits ((.&.), (.|.), complement, popCount) import Data.Data hiding (Typeable) import qualified Data.Foldable as Foldable+#if MIN_VERSION_base(4,10,0)+import Data.Bifoldable+#endif import qualified Data.List as L import GHC.Exts ((==#), build, reallyUnsafePtrEquality#)-import Prelude hiding (filter, foldr, lookup, map, null, pred)+import Prelude hiding (filter, foldl, foldr, lookup, map, null, pred) import Text.Read hiding (step) import qualified Data.HashMap.Array as A@@ -142,6 +153,7 @@ #if MIN_VERSION_base(4,9,0) import Data.Functor.Classes+import GHC.Stack #endif #if MIN_VERSION_hashable(1,2,5)@@ -197,14 +209,58 @@ fmap = map instance Foldable.Foldable (HashMap k) where- foldr f = foldrWithKey (const f)+ foldMap f = foldMapWithKey (\ _k v -> f v)+ {-# INLINE foldMap #-}+ foldr = foldr+ {-# INLINE foldr #-}+ foldl = foldl+ {-# INLINE foldl #-}+ foldr' = foldr'+ {-# INLINE foldr' #-}+ foldl' = foldl'+ {-# INLINE foldl' #-}+#if MIN_VERSION_base(4,8,0)+ null = null+ {-# INLINE null #-}+ length = size+ {-# INLINE length #-}+#endif +#if MIN_VERSION_base(4,10,0)+-- | @since 0.2.11+instance Bifoldable HashMap where+ bifoldMap f g = foldMapWithKey (\ k v -> f k `mappend` g v)+ {-# INLINE bifoldMap #-}+ bifoldr f g = foldrWithKey (\ k v acc -> k `f` (v `g` acc))+ {-# INLINE bifoldr #-}+ bifoldl f g = foldlWithKey (\ acc k v -> (acc `f` k) `g` v)+ {-# INLINE bifoldl #-}+#endif+ #if __GLASGOW_HASKELL__ >= 711+-- | '<>' = 'union'+--+-- If a key occurs in both maps, the mapping from the first will be the mapping in the result.+--+-- ==== __Examples__+--+-- >>> fromList [(1,'a'),(2,'b')] <> fromList [(2,'c'),(3,'d')]+-- fromList [(1,'a'),(2,'b'),(3,'d')] instance (Eq k, Hashable k) => Semigroup (HashMap k v) where (<>) = union {-# INLINE (<>) #-} #endif +-- | 'mempty' = 'empty'+--+-- 'mappend' = 'union'+--+-- If a key occurs in both maps, the mapping from the first will be the mapping in the result.+--+-- ==== __Examples__+--+-- >>> mappend (fromList [(1,'a'),(2,'b')]) (fromList [(2,'c'),(3,'d')])+-- fromList [(1,'a'),(2,'b'),(3,'d')] instance (Eq k, Hashable k) => Monoid (HashMap k v) where mempty = empty {-# INLINE mempty #-}@@ -277,6 +333,24 @@ liftEq = equal1 #endif +-- | Note that, in the presence of hash collisions, equal @HashMap@s may+-- behave differently, i.e. substitutivity may be violated:+--+-- >>> data D = A | B deriving (Eq, Show)+-- >>> instance Hashable D where hashWithSalt salt _d = salt+--+-- >>> x = fromList [(A,1), (B,2)]+-- >>> y = fromList [(B,2), (A,1)]+--+-- >>> x == y+-- True+-- >>> toList x+-- [(A,1),(B,2)]+-- >>> toList y+-- [(B,2),(A,1)]+--+-- In general, the lack of substitutivity can be observed with any function+-- that depends on the key ordering, such as folds and traversals. instance (Eq k, Eq v) => Eq (HashMap k v) where (==) = equal1 (==) @@ -329,11 +403,9 @@ liftCompare = cmp compare #endif --- | The order is total.------ /Note:/ Because the hash is not guaranteed to be stable across library--- versions, OSes, or architectures, neither is an actual order of elements in--- 'HashMap' or an result of `compare`.is stable.+-- | The ordering is total and consistent with the `Eq` instance. However,+-- nothing else about the ordering is specified, and it may change from +-- version to version of either this package or of hashable. instance (Ord k, Ord v) => Ord (HashMap k v) where compare = cmp compare compare @@ -355,7 +427,7 @@ go [] [] = EQ go [] _ = LT go _ [] = GT- go _ _ = error "cmp: Should never happend, toList' includes non Leaf / Collision"+ go _ _ = error "cmp: Should never happen, toList' includes non Leaf / Collision" leafCompare (L k v) (L k' v') = cmpk k k' `mappend` cmpv v v' @@ -420,17 +492,18 @@ #endif instance (Hashable k, Hashable v) => Hashable (HashMap k v) where- hashWithSalt salt hm = go salt (toList' hm [])+ hashWithSalt salt hm = go salt hm where- go :: Int -> [HashMap k v] -> Int- go s [] = s- go s (Leaf _ l : tl)- = s `hashLeafWithSalt` l `go` tl+ go :: Int -> HashMap k v -> Int+ go s Empty = s+ go s (BitmapIndexed _ a) = A.foldl' go s a+ go s (Leaf h (L _ v))+ = s `H.hashWithSalt` h `H.hashWithSalt` v -- 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+ go s (Full a) = A.foldl' go s a+ go s (Collision h a)+ = (s `H.hashWithSalt` h) `hashCollisionWithSalt` a hashLeafWithSalt :: Int -> Leaf k v -> Int hashLeafWithSalt s (L k v) = s `H.hashWithSalt` k `H.hashWithSalt` v@@ -614,18 +687,47 @@ {-# INLINE lookupCont #-} -- | /O(log n)/ Return the value to which the specified key is mapped,+-- or 'Nothing' if this map contains no mapping for the key.+--+-- This is a flipped version of 'lookup'.+--+-- @since 0.2.11+(!?) :: (Eq k, Hashable k) => HashMap k v -> k -> Maybe v+(!?) m k = lookup k m+{-# INLINE (!?) #-}+++-- | /O(log n)/ Return the value to which the specified key is mapped, -- or the default value if this map contains no mapping for the key.-lookupDefault :: (Eq k, Hashable k)+--+-- @since 0.2.11+findWithDefault :: (Eq k, Hashable k) => v -- ^ Default value to return. -> k -> HashMap k v -> v-lookupDefault def k t = case lookup k t of+findWithDefault def k t = case lookup k t of Just v -> v _ -> def-{-# INLINABLE lookupDefault #-}+{-# INLINABLE findWithDefault #-} ++-- | /O(log n)/ Return the value to which the specified key is mapped,+-- or the default value if this map contains no mapping for the key.+--+-- DEPRECATED: lookupDefault is deprecated as of version 0.2.10, replaced+-- by 'findWithDefault'.+lookupDefault :: (Eq k, Hashable k)+ => v -- ^ Default value to return.+ -> k -> HashMap k v -> v+lookupDefault def k t = findWithDefault def k t+{-# INLINE lookupDefault #-}+ -- | /O(log n)/ Return the value to which the specified key is mapped. -- Calls 'error' if this map contains no mapping for the key.+#if MIN_VERSION_base(4,9,0)+(!) :: (Eq k, Hashable k, HasCallStack) => HashMap k v -> k -> v+#else (!) :: (Eq k, Hashable k) => HashMap k v -> k -> v+#endif (!) m k = case lookup k m of Just v -> v Nothing -> error "Data.HashMap.Base.(!): key not found"@@ -666,7 +768,7 @@ then t else Leaf h (L k x) else collision h l (L k x)- | otherwise = runST (two s h k x hy ky y)+ | otherwise = runST (two s h k x hy t) go h k x s t@(BitmapIndexed b ary) | b .&. m == 0 = let !ary' = A.insert ary i $! Leaf h (L k x)@@ -687,7 +789,7 @@ else Full (update16 ary i st') where i = index h s go h k x s t@(Collision hy v)- | h == hy = Collision h (updateOrSnocWith const k x v)+ | h == hy = Collision h (updateOrSnocWith (\a _ -> (# a #)) k x v) | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t) {-# INLINABLE insert' #-} @@ -702,9 +804,9 @@ insertNewKey !h0 !k0 x0 !m0 = go h0 k0 x0 0 m0 where go !h !k x !_ Empty = Leaf h (L k x)- go h k x s (Leaf hy l@(L ky y))+ go h k x s t@(Leaf hy l) | hy == h = collision h l (L k x)- | otherwise = runST (two s h k x hy ky y)+ | otherwise = runST (two s h k x hy t) go h k x s (BitmapIndexed b ary) | b .&. m == 0 = let !ary' = A.insert ary i $! Leaf h (L k x)@@ -791,7 +893,7 @@ then return t else return $! Leaf h (L k x) else return $! collision h l (L k x)- | otherwise = two s h k x hy ky y+ | otherwise = two s h k x hy t go h k x s t@(BitmapIndexed b ary) | b .&. m == 0 = do ary' <- A.insertM ary i $! Leaf h (L k x)@@ -810,24 +912,31 @@ return t where i = index h s go h k x s t@(Collision hy v)- | h == hy = return $! Collision h (updateOrSnocWith const k x v)+ | h == hy = return $! Collision h (updateOrSnocWith (\a _ -> (# a #)) k x v) | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t) {-# INLINABLE unsafeInsert #-} --- | Create a map from two key-value pairs which hashes don't collide.-two :: Shift -> Hash -> k -> v -> Hash -> k -> v -> ST s (HashMap k v)+-- | Create a map from two key-value pairs which hashes don't collide. To+-- enhance sharing, the second key-value pair is represented by the hash of its+-- key and a singleton HashMap pairing its key with its value.+--+-- Note: to avoid silly thunks, this function must be strict in the+-- key. See issue #232. We don't need to force the HashMap argument+-- because it's already in WHNF (having just been matched) and we+-- just put it directly in an array.+two :: Shift -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v) two = go where- go s h1 k1 v1 h2 k2 v2+ go s h1 k1 v1 h2 t2 | bp1 == bp2 = do- st <- go (s+bitsPerSubkey) h1 k1 v1 h2 k2 v2+ st <- go (s+bitsPerSubkey) h1 k1 v1 h2 t2 ary <- A.singletonM st- return $! BitmapIndexed bp1 ary+ return $ BitmapIndexed bp1 ary | otherwise = do- mary <- A.new 2 $ Leaf h1 (L k1 v1)- A.write mary idx2 $ Leaf h2 (L k2 v2)+ mary <- A.new 2 $! Leaf h1 (L k1 v1)+ A.write mary idx2 t2 ary <- A.unsafeFreeze mary- return $! BitmapIndexed (bp1 .|. bp2) ary+ return $ BitmapIndexed (bp1 .|. bp2) ary where bp1 = mask h1 s bp2 = mask h2 s@@ -866,7 +975,7 @@ (# v' #) | ptrEq y v' -> t | otherwise -> Leaf h (L k (v')) else collision h l (L k x)- | otherwise = runST (two s h k x hy ky y)+ | otherwise = runST (two s h k x hy t) go h k s t@(BitmapIndexed b ary) | b .&. m == 0 = let ary' = A.insert ary i $! Leaf h (L k x)@@ -921,16 +1030,22 @@ unsafeInsertWith :: forall k v. (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v-unsafeInsertWith f k0 v0 m0 = runST (go h0 k0 v0 0 m0)+unsafeInsertWith f k0 v0 m0 = unsafeInsertWithKey (const f) k0 v0 m0+{-# INLINABLE unsafeInsertWith #-}++unsafeInsertWithKey :: forall k v. (Eq k, Hashable k)+ => (k -> v -> v -> v) -> k -> v -> HashMap k v+ -> HashMap k v+unsafeInsertWithKey f k0 v0 m0 = runST (go h0 k0 v0 0 m0) where h0 = hash k0 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))+ go h k x s t@(Leaf hy l@(L ky y)) | hy == h = if ky == k- then return $! Leaf h (L k (f x y))+ then return $! Leaf h (L k (f k x y)) else return $! collision h l (L k x)- | otherwise = two s h k x hy ky y+ | otherwise = two s h k x hy t go h k x s t@(BitmapIndexed b ary) | b .&. m == 0 = do ary' <- A.insertM ary i $! Leaf h (L k x)@@ -949,9 +1064,9 @@ return t where i = index h s go h k x s t@(Collision hy v)- | h == hy = return $! Collision h (updateOrSnocWith f k x v)+ | h == hy = return $! Collision h (updateOrSnocWithKey (\key a b -> (# f key a b #) ) k x v) | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)-{-# INLINABLE unsafeInsertWith #-}+{-# INLINABLE unsafeInsertWithKey #-} -- | /O(log n)/ Remove the mapping for the specified key from this map -- if present.@@ -1110,9 +1225,9 @@ | 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.+-- | /O(log n)/ The expression @('update' f k map)@ updates the value @x@ at @k@+-- (if it is in the map). If @(f 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 #-}@@ -1136,7 +1251,7 @@ -- Note: 'alterF' is a flipped version of the 'at' combinator from -- <https://hackage.haskell.org/package/lens-4.15.4/docs/Control-Lens-At.html#v:at Control.Lens.At>. ----- @since 0.2.9+-- @since 0.2.10 alterF :: (Functor f, Eq k, Hashable k) => (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v) -- We only calculate the hash once, but unless this is rewritten@@ -1283,6 +1398,11 @@ -- | /O(n+m)/ The union of two maps. If a key occurs in both maps, the -- mapping from the first will be the mapping in the result.+--+-- ==== __Examples__+--+-- >>> union (fromList [(1,'a'),(2,'b')]) (fromList [(2,'c'),(3,'d')])+-- fromList [(1,'a'),(2,'b'),(3,'d')] union :: (Eq k, Hashable k) => HashMap k v -> HashMap k v -> HashMap k v union = unionWith const {-# INLINABLE union #-}@@ -1312,10 +1432,10 @@ 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 (updateOrSnocWithKey f k1 v1 ls2)+ | h1 == h2 = Collision h1 (updateOrSnocWithKey (\k a b -> (# f k a b #)) 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 (updateOrSnocWithKey (flip . f) k2 v2 ls1)+ | h1 == h2 = Collision h1 (updateOrSnocWithKey (\k a b -> (# f k b a #)) k2 v2 ls1) | otherwise = goDifferentHash s h1 h2 t1 t2 go s t1@(Collision h1 ls1) t2@(Collision h2 ls2) | h1 == h2 = Collision h1 (updateOrConcatWithKey f ls1 ls2)@@ -1500,7 +1620,7 @@ _ -> m {-# INLINABLE intersection #-} --- | /O(n+m)/ Intersection of two maps. If a key occurs in both maps+-- | /O(n*log 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. intersectionWith :: (Eq k, Hashable k) => (v1 -> v2 -> v3) -> HashMap k v1@@ -1512,7 +1632,7 @@ _ -> m {-# INLINABLE intersectionWith #-} --- | /O(n+m)/ Intersection of two maps. If a key occurs in both maps+-- | /O(n*log 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)@@ -1530,7 +1650,7 @@ -- | /O(n)/ Reduce this map by applying a binary operator to all -- elements, using the given starting value (typically the -- left-identity of the operator). Each application of the operator--- is evaluated before using the result in the next application. +-- is evaluated before using the result in the next application. -- This function is strict in the starting value. foldl' :: (a -> v -> a) -> a -> HashMap k v -> a foldl' f = foldlWithKey' (\ z _ v -> f z v)@@ -1538,8 +1658,17 @@ -- | /O(n)/ Reduce this map by applying a binary operator to all -- elements, using the given starting value (typically the+-- right-identity of the operator). Each application of the operator+-- is evaluated before using the result in the next application.+-- This function is strict in the starting value.+foldr' :: (v -> a -> a) -> a -> HashMap k v -> a+foldr' f = foldrWithKey' (\ _ v z -> f v z)+{-# INLINE foldr' #-}++-- | /O(n)/ Reduce this map by applying a binary operator to all+-- elements, using the given starting value (typically the -- left-identity of the operator). Each application of the operator--- is evaluated before using the result in the next application. +-- is evaluated before using the result in the next application. -- This function is strict in the starting value. foldlWithKey' :: (a -> k -> v -> a) -> a -> HashMap k v -> a foldlWithKey' f = go@@ -1553,6 +1682,21 @@ -- | /O(n)/ Reduce this map by applying a binary operator to all -- elements, using the given starting value (typically the+-- right-identity of the operator). Each application of the operator+-- is evaluated before using the result in the next application.+-- This function is strict in the starting value.+foldrWithKey' :: (k -> v -> a -> a) -> a -> HashMap k v -> a+foldrWithKey' f = flip go+ where+ go Empty z = z+ go (Leaf _ (L k v)) !z = f k v z+ go (BitmapIndexed _ ary) !z = A.foldr' go z ary+ go (Full ary) !z = A.foldr' go z ary+ go (Collision _ ary) !z = A.foldr' (\ (L k v) z' -> f k v z') z ary+{-# INLINE foldrWithKey' #-}++-- | /O(n)/ Reduce this map by applying a binary operator to all+-- elements, using the given starting value (typically the -- right-identity of the operator). foldr :: (v -> a -> a) -> a -> HashMap k v -> a foldr f = foldrWithKey (const f)@@ -1560,17 +1704,49 @@ -- | /O(n)/ Reduce this map by applying a binary operator to all -- elements, using the given starting value (typically the+-- left-identity of the operator).+foldl :: (a -> v -> a) -> a -> HashMap k v -> a+foldl f = foldlWithKey (\a _k v -> f a v)+{-# INLINE foldl #-}++-- | /O(n)/ Reduce this map by applying a binary operator to all+-- elements, using the given starting value (typically the -- right-identity of the operator). foldrWithKey :: (k -> v -> a -> a) -> a -> HashMap k v -> a-foldrWithKey f = go+foldrWithKey f = flip go where- go z Empty = z- go z (Leaf _ (L k v)) = f k v z- go z (BitmapIndexed _ ary) = A.foldr (flip go) z ary- go z (Full ary) = A.foldr (flip go) z ary- go z (Collision _ ary) = A.foldr (\ (L k v) z' -> f k v z') z ary+ go Empty z = z+ go (Leaf _ (L k v)) z = f k v z+ go (BitmapIndexed _ ary) z = A.foldr go z ary+ go (Full ary) z = A.foldr go z ary+ go (Collision _ ary) z = A.foldr (\ (L k v) z' -> f k v z') z ary {-# INLINE foldrWithKey #-} +-- | /O(n)/ Reduce this map by applying a binary operator to all+-- elements, using the given starting value (typically the+-- left-identity of the operator).+foldlWithKey :: (a -> k -> v -> a) -> a -> HashMap k v -> a+foldlWithKey f = go+ where+ go z Empty = z+ go z (Leaf _ (L k v)) = f z k v+ go z (BitmapIndexed _ ary) = A.foldl go z ary+ go z (Full ary) = A.foldl go z ary+ go z (Collision _ ary) = A.foldl (\ z' (L k v) -> f z' k v) z ary+{-# INLINE foldlWithKey #-}++-- | /O(n)/ Reduce the map by applying a function to each element+-- and combining the results with a monoid operation.+foldMapWithKey :: Monoid m => (k -> v -> m) -> HashMap k v -> m+foldMapWithKey f = go+ where+ go Empty = mempty+ go (Leaf _ (L k v)) = f k v+ go (BitmapIndexed _ ary) = A.foldMap go ary+ go (Full ary) = A.foldMap go ary+ go (Collision _ ary) = A.foldMap (\ (L k v) -> f k v) ary+{-# INLINE foldMapWithKey #-}+ ------------------------------------------------------------------------ -- * Filter @@ -1712,11 +1888,69 @@ {-# 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 with+-- @(f newVal oldVal)@.+--+-- === Examples+--+-- Given a list @xs@, create a map with the number of occurrences of each+-- element in @xs@:+--+-- > let xs = ['a', 'b', 'a']+-- > in fromListWith (+) [ (x, 1) | x <- xs ]+-- >+-- > = fromList [('a', 2), ('b', 1)]+--+-- Given a list of key-value pairs @xs :: [(k, v)]@, group all values by their+-- keys and return a @HashMap k [v]@.+--+-- > let xs = [('a', 1), ('b', 2), ('a', 3)]+-- > in fromListWith (++) [ (k, [v]) | (k, v) <- xs ]+-- >+-- > = fromList [('a', [3, 1]), ('b', [2])]+--+-- Note that the lists in the resulting map contain elements in reverse order+-- from their occurences in the original list.+--+-- More generally, duplicate entries are accumulated as follows;+-- this matters when @f@ is not commutative or not associative.+--+-- > fromListWith f [(k, a), (k, b), (k, c), (k, d)]+-- > = fromList [(k, f d (f c (f b a)))] 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 #-} +-- | /O(n*log n)/ Construct a map from a list of elements. Uses+-- the provided function to merge duplicate entries.+--+-- === Examples+--+-- Given a list of key-value pairs where the keys are of different flavours, e.g:+--+-- > data Key = Div | Sub+--+-- and the values need to be combined differently when there are duplicates,+-- depending on the key:+--+-- > combine Div = div+-- > combine Sub = (-)+--+-- then @fromListWithKey@ can be used as follows:+--+-- > fromListWithKey combine [(Div, 2), (Div, 6), (Sub, 2), (Sub, 3)]+-- > = fromList [(Div, 3), (Sub, 1)]+--+-- More generally, duplicate entries are accumulated as follows;+--+-- > fromListWith f [(k, a), (k, b), (k, c), (k, d)]+-- > = fromList [(k, f k d (f k c (f k b a)))]+--+-- @since 0.2.11+fromListWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> [(k, v)] -> HashMap k v+fromListWithKey f = L.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) empty+{-# INLINE fromListWithKey #-}+ ------------------------------------------------------------------------ -- Array operations @@ -1766,12 +2000,12 @@ | otherwise -> go k ary (i+1) n {-# INLINABLE updateWith# #-} -updateOrSnocWith :: Eq k => (v -> v -> v) -> k -> v -> A.Array (Leaf k v)+updateOrSnocWith :: Eq k => (v -> v -> (# v #)) -> k -> v -> A.Array (Leaf k v) -> A.Array (Leaf k v) updateOrSnocWith f = updateOrSnocWithKey (const f) {-# INLINABLE updateOrSnocWith #-} -updateOrSnocWithKey :: Eq k => (k -> v -> v -> v) -> k -> v -> A.Array (Leaf k v)+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@@ -1782,9 +2016,12 @@ A.copy ary 0 mary 0 n 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 k v y))- | otherwise -> go k v ary (i+1) n+ | L kx y <- A.index ary i+ , k == kx+ , (# v2 #) <- f k v y+ = A.update ary i (L k v2)+ | otherwise+ = go k v ary (i+1) n {-# INLINABLE updateOrSnocWithKey #-} updateOrConcatWith :: Eq k => (v -> v -> v) -> A.Array (Leaf k v) -> A.Array (Leaf k v) -> A.Array (Leaf k v)
Data/HashMap/Lazy.hs view
@@ -38,6 +38,8 @@ , size , member , lookup+ , (!?)+ , findWithDefault , lookupDefault , (!) , insert@@ -68,10 +70,15 @@ , intersectionWithKey -- * Folds+ , foldMapWithKey+ , foldr+ , foldl+ , foldr' , foldl'+ , foldrWithKey' , foldlWithKey'- , foldr , foldrWithKey+ , foldlWithKey -- * Filter , filter@@ -87,6 +94,7 @@ , toList , fromList , fromListWith+ , fromListWithKey -- ** HashSets , HS.keysSet@@ -100,4 +108,4 @@ -- -- This module satisfies the following strictness property: ----- * Key arguments are evaluated to WHNF+-- * Key arguments are evaluated to WHNF.
Data/HashMap/Strict.hs view
@@ -37,6 +37,8 @@ , size , member , lookup+ , (!?)+ , findWithDefault , lookupDefault , (!) , insert@@ -67,10 +69,15 @@ , intersectionWithKey -- * Folds+ , foldMapWithKey+ , foldr+ , foldl+ , foldr' , foldl'+ , foldrWithKey' , foldlWithKey'- , foldr , foldrWithKey+ , foldlWithKey -- * Filter , filter@@ -86,6 +93,7 @@ , toList , fromList , fromListWith+ , fromListWithKey -- ** HashSets , HS.keysSet@@ -94,3 +102,12 @@ import Data.HashMap.Strict.Base as HM import qualified Data.HashSet.Base as HS import Prelude ()++-- $strictness+--+-- This module satisfies the following strictness properties:+--+-- 1. Key arguments are evaluated to WHNF;+--+-- 2. Keys and values are evaluated to WHNF before they are stored in+-- the map.
Data/HashMap/Strict/Base.hs view
@@ -39,6 +39,8 @@ , size , HM.member , HM.lookup+ , (HM.!?)+ , HM.findWithDefault , lookupDefault , (!) , insert@@ -69,10 +71,15 @@ , intersectionWithKey -- * Folds+ , foldMapWithKey+ , foldr' , foldl'+ , foldrWithKey' , foldlWithKey' , HM.foldr+ , HM.foldl , foldrWithKey+ , foldlWithKey -- * Filter , HM.filter@@ -88,6 +95,7 @@ , toList , fromList , fromListWith+ , fromListWithKey ) where import Data.Bits ((.&.), (.|.))@@ -102,7 +110,8 @@ import qualified Data.HashMap.Array as A import qualified Data.HashMap.Base as HM import Data.HashMap.Base hiding (- alter, alterF, adjust, fromList, fromListWith, insert, insertWith,+ alter, alterF, adjust, fromList, fromListWith, fromListWithKey,+ insert, insertWith, differenceWith, intersectionWith, intersectionWithKey, map, mapWithKey, mapMaybe, mapMaybeWithKey, singleton, update, unionWith, unionWithKey, traverseWithKey)@@ -152,11 +161,11 @@ where h0 = hash k0 go !h !k x !_ Empty = leaf h k x- go h k x s (Leaf hy l@(L ky y))+ go h k x s t@(Leaf hy l@(L ky y)) | hy == h = if ky == k then leaf h k (f x y) else x `seq` (collision h l (L k x))- | otherwise = x `seq` runST (two s h k x hy ky y)+ | otherwise = x `seq` runST (two s h k x hy t) go h k x s (BitmapIndexed b ary) | b .&. m == 0 = let ary' = A.insert ary i $! leaf h k x@@ -182,17 +191,22 @@ -- | In-place update version of insertWith unsafeInsertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v-unsafeInsertWith f k0 v0 m0 = runST (go h0 k0 v0 0 m0)+unsafeInsertWith f k0 v0 m0 = unsafeInsertWithKey (const f) k0 v0 m0+{-# INLINABLE unsafeInsertWith #-}++unsafeInsertWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> k -> v -> HashMap k v+ -> HashMap k v+unsafeInsertWithKey f k0 v0 m0 = runST (go h0 k0 v0 0 m0) where h0 = hash k0 go !h !k x !_ Empty = return $! leaf h k x- go h k x s (Leaf hy l@(L ky y))+ go h k x s t@(Leaf hy l@(L ky y)) | hy == h = if ky == k- then return $! leaf h k (f x y)+ then return $! leaf h k (f k x y) else do let l' = x `seq` (L k x) return $! collision h l l'- | otherwise = x `seq` two s h k x hy ky y+ | otherwise = x `seq` two s h k x hy t go h k x s t@(BitmapIndexed b ary) | b .&. m == 0 = do ary' <- A.insertM ary i $! leaf h k x@@ -211,9 +225,9 @@ return t where i = index h s go h k x s t@(Collision hy v)- | h == hy = return $! Collision h (updateOrSnocWith f k x v)+ | h == hy = return $! Collision h (updateOrSnocWithKey f k x v) | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)-{-# INLINABLE unsafeInsertWith #-}+{-# INLINABLE unsafeInsertWithKey #-} -- | /O(log n)/ Adjust the value tied to a given key in this map only -- if it is present. Otherwise, leave the map alone.@@ -244,9 +258,9 @@ | 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.+-- | /O(log n)/ The expression @('update' f k map)@ updates the value @x@ at @k@+-- (if it is in the map). If @(f 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 #-}@@ -268,7 +282,7 @@ -- Note: 'alterF' is a flipped version of the 'at' combinator from -- <https://hackage.haskell.org/package/lens-4.15.4/docs/Control-Lens-At.html#v:at Control.Lens.At>. ----- @since 0.2.9+-- @since 0.2.10 alterF :: (Functor f, Eq k, Hashable k) => (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v) -- Special care is taken to only calculate the hash once. When we rewrite@@ -599,21 +613,68 @@ {-# INLINABLE fromList #-} -- | /O(n*log n)/ Construct a map from a list of elements. Uses--- the provided function f to merge duplicate entries (f newVal oldVal).+-- the provided function @f@ to merge duplicate entries with+-- @(f newVal oldVal)@. ----- For example:+-- === Examples ----- > fromListWith (+) [ (x, 1) | x <- xs ]+-- Given a list @xs@, create a map with the number of occurrences of each+-- element in @xs@: ----- will create a map with number of occurrences of each element in xs.+-- > let xs = ['a', 'b', 'a']+-- > in fromListWith (+) [ (x, 1) | x <- xs ]+-- >+-- > = fromList [('a', 2), ('b', 1)] ----- > fromListWith (++) [ (k, [v]) | (k, v) <- xs ]+-- Given a list of key-value pairs @xs :: [(k, v)]@, group all values by their+-- keys and return a @HashMap k [v]@. ----- will group all values by their keys in a list 'xs :: [(k, v)]' and--- return a 'HashMap k [v]'.+-- > let xs = ('a', 1), ('b', 2), ('a', 3)]+-- > in fromListWith (++) [ (k, [v]) | (k, v) <- xs ]+-- >+-- > = fromList [('a', [3, 1]), ('b', [2])]+--+-- Note that the lists in the resulting map contain elements in reverse order+-- from their occurences in the original list.+--+-- More generally, duplicate entries are accumulated as follows;+-- this matters when @f@ is not commutative or not associative.+--+-- > fromListWith f [(k, a), (k, b), (k, c), (k, d)]+-- > = fromList [(k, f d (f c (f b a)))] 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 #-}++-- | /O(n*log n)/ Construct a map from a list of elements. Uses+-- the provided function to merge duplicate entries.+--+-- === Examples+--+-- Given a list of key-value pairs where the keys are of different flavours, e.g:+--+-- > data Key = Div | Sub+--+-- and the values need to be combined differently when there are duplicates,+-- depending on the key:+--+-- > combine Div = div+-- > combine Sub = (-)+--+-- then @fromListWithKey@ can be used as follows:+--+-- > fromListWithKey combine [(Div, 2), (Div, 6), (Sub, 2), (Sub, 3)]+-- > = fromList [(Div, 3), (Sub, 1)]+--+-- More generally, duplicate entries are accumulated as follows;+--+-- > fromListWith f [(k, a), (k, b), (k, c), (k, d)]+-- > = fromList [(k, f k d (f k c (f k b a)))]+--+-- @since 0.2.11+fromListWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> [(k, v)] -> HashMap k v+fromListWithKey f = L.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) empty+{-# INLINE fromListWithKey #-} ------------------------------------------------------------------------ -- Array operations
Data/HashSet/Base.hs view
@@ -55,8 +55,10 @@ , intersection -- * Folds- , foldl' , foldr+ , foldr'+ , foldl+ , foldl' -- * Filter , filter@@ -77,7 +79,9 @@ import Control.DeepSeq (NFData(..)) import Data.Data hiding (Typeable)-import Data.HashMap.Base (HashMap, foldrWithKey, equalKeys, equalKeys1)+import Data.HashMap.Base+ ( HashMap, foldMapWithKey, foldlWithKey, foldrWithKey+ , equalKeys, equalKeys1) import Data.Hashable (Hashable(hashWithSalt)) #if __GLASGOW_HASKELL__ >= 711 import Data.Semigroup (Semigroup(..))@@ -85,7 +89,7 @@ import Data.Monoid (Monoid(..)) #endif import GHC.Exts (build)-import Prelude hiding (filter, foldr, map, null)+import Prelude hiding (filter, foldr, foldl, map, null) import qualified Data.Foldable as Foldable import qualified Data.HashMap.Base as H import qualified Data.List as List@@ -119,6 +123,24 @@ rnf = rnf . asMap {-# INLINE rnf #-} +-- | Note that, in the presence of hash collisions, equal @HashSet@s may+-- behave differently, i.e. substitutivity may be violated:+--+-- >>> data D = A | B deriving (Eq, Show)+-- >>> instance Hashable D where hashWithSalt salt _d = salt+--+-- >>> x = fromList [A, B]+-- >>> y = fromList [B, A]+--+-- >>> x == y+-- True+-- >>> toList x+-- [A,B]+-- >>> toList y+-- [B,A]+--+-- In general, the lack of substitutivity can be observed with any function+-- that depends on the key ordering, such as folds and traversals. instance (Eq a) => Eq (HashSet a) where HashSet a == HashSet b = equalKeys a b {-# INLINE (==) #-}@@ -138,15 +160,54 @@ #endif instance Foldable.Foldable HashSet where- foldr = Data.HashSet.Base.foldr+ foldMap f = foldMapWithKey (\a _ -> f a) . asMap+ foldr = foldr {-# INLINE foldr #-}+ foldl = foldl+ {-# INLINE foldl #-}+ foldl' = foldl'+ {-# INLINE foldl' #-}+ foldr' = foldr'+ {-# INLINE foldr' #-}+#if MIN_VERSION_base(4,8,0)+ toList = toList+ {-# INLINE toList #-}+ null = null+ {-# INLINE null #-}+ length = size+ {-# INLINE length #-}+#endif #if __GLASGOW_HASKELL__ >= 711+-- | '<>' = 'union'+--+-- /O(n+m)/+--+-- To obtain good performance, the smaller set must be presented as+-- the first argument.+--+-- ==== __Examples__+--+-- >>> fromList [1,2] <> fromList [2,3]+-- fromList [1,2,3] instance (Hashable a, Eq a) => Semigroup (HashSet a) where (<>) = union {-# INLINE (<>) #-} #endif +-- | 'mempty' = 'empty'+--+-- 'mappend' = 'union'+--+-- /O(n+m)/+--+-- To obtain good performance, the smaller set must be presented as+-- the first argument.+--+-- ==== __Examples__+--+-- >>> mappend (fromList [1,2]) (fromList [2,3])+-- fromList [1,2,3] instance (Hashable a, Eq a) => Monoid (HashSet a) where mempty = empty {-# INLINE mempty #-}@@ -225,6 +286,11 @@ -- -- To obtain good performance, the smaller set must be presented as -- the first argument.+--+-- ==== __Examples__+--+-- >>> union (fromList [1,2]) (fromList [2,3])+-- fromList [1,2,3] union :: (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a union s1 s2 = HashSet $ H.union (asMap s1) (asMap s2) {-# INLINE union #-}@@ -295,11 +361,29 @@ -- | /O(n)/ Reduce this set by applying a binary operator to all -- elements, using the given starting value (typically the+-- right-identity of the operator). Each application of the operator+-- is evaluated before before using the result in the next+-- application. This function is strict in the starting value.+foldr' :: (b -> a -> a) -> a -> HashSet b -> a+foldr' f z0 = H.foldrWithKey' g z0 . asMap+ where g k _ z = f k z+{-# INLINE foldr' #-}++-- | /O(n)/ Reduce this set by applying a binary operator to all+-- elements, using the given starting value (typically the -- right-identity of the operator). foldr :: (b -> a -> a) -> a -> HashSet b -> a foldr f z0 = foldrWithKey g z0 . asMap where g k _ z = f k z {-# INLINE foldr #-}++-- | /O(n)/ Reduce this set by applying a binary operator to all+-- elements, using the given starting value (typically the+-- left-identity of the operator).+foldl :: (a -> b -> a) -> a -> HashSet b -> a+foldl f z0 = foldlWithKey g z0 . asMap+ where g z k _ = f z k+{-# INLINE foldl #-} -- | /O(n)/ Filter this set by retaining only elements satisfying a -- predicate.
benchmarks/Benchmarks.hs view
@@ -4,10 +4,10 @@ import Control.DeepSeq import Control.DeepSeq.Generics (genericRnf)-import Criterion.Main (bench, bgroup, defaultMain, env, nf, whnf)+import Gauge (bench, bgroup, defaultMain, env, nf, whnf) import Data.Bits ((.&.)) import Data.Functor.Identity-import Data.Hashable (Hashable)+import Data.Hashable (Hashable, hash) import qualified Data.ByteString as BS import qualified "hashmap" Data.HashMap as IHM import qualified Data.HashMap.Strict as HM@@ -179,6 +179,10 @@ , bgroup "fromList" [ bench "String" $ whnf IHM.fromList elems , bench "ByteString" $ whnf IHM.fromList elemsBS+ ]+ , bgroup "hash"+ [ bench "String" $ whnf hash hm+ , bench "ByteString" $ whnf hash hmbs ] ]
tests/HashMapProperties.hs view
@@ -7,6 +7,9 @@ import Control.Monad ( guard ) import qualified Data.Foldable as Foldable+#if MIN_VERSION_base(4,10,0)+import Data.Bifoldable+#endif import Data.Function (on) import Data.Hashable (Hashable(hashWithSalt)) import qualified Data.List as L@@ -122,6 +125,9 @@ pLookup :: Key -> [(Key, Int)] -> Bool pLookup k = M.lookup k `eq` HM.lookup k +pLookupOperator :: Key -> [(Key, Int)] -> Bool+pLookupOperator k = M.lookup k `eq` (HM.!? k)+ pInsert :: Key -> Int -> [(Key, Int)] -> Bool pInsert k v = M.insert k v `eq_` HM.insert k v @@ -285,22 +291,57 @@ pFoldr :: [(Int, Int)] -> Bool pFoldr = (L.sort . M.foldr (:) []) `eq` (L.sort . HM.foldr (:) []) +pFoldl :: [(Int, Int)] -> Bool+pFoldl = (L.sort . M.foldl (flip (:)) []) `eq` (L.sort . HM.foldl (flip (:)) [])++#if MIN_VERSION_base(4,10,0)+pBifoldMap :: [(Int, Int)] -> Bool+pBifoldMap xs = concatMap f (HM.toList m) == bifoldMap (:[]) (:[]) m+ where f (k, v) = [k, v]+ m = HM.fromList xs++pBifoldr :: [(Int, Int)] -> Bool+pBifoldr xs = concatMap f (HM.toList m) == bifoldr (:) (:) [] m+ where f (k, v) = [k, v]+ m = HM.fromList xs++pBifoldl :: [(Int, Int)] -> Bool+pBifoldl xs = reverse (concatMap f $ HM.toList m) == bifoldl (flip (:)) (flip (:)) [] m+ where f (k, v) = [k, v]+ m = HM.fromList xs+#endif+ pFoldrWithKey :: [(Int, Int)] -> Bool pFoldrWithKey = (sortByKey . M.foldrWithKey f []) `eq` (sortByKey . HM.foldrWithKey f []) where f k v z = (k, v) : z -pFoldl' :: Int -> [(Int, Int)] -> Bool-pFoldl' z0 = foldlWithKey'Map (\ z _ v -> v + z) z0 `eq` HM.foldl' (+) z0+pFoldMapWithKey :: [(Int, Int)] -> Bool+pFoldMapWithKey = (sortByKey . M.foldMapWithKey f) `eq`+ (sortByKey . HM.foldMapWithKey f)+ where f k v = [(k, v)] -foldlWithKey'Map :: (b -> k -> a -> b) -> b -> M.Map k a -> b-#if MIN_VERSION_containers(4,2,0)-foldlWithKey'Map = M.foldlWithKey'-#else--- Equivalent except for bottoms, which we don't test.-foldlWithKey'Map = M.foldlWithKey-#endif+pFoldrWithKey' :: [(Int, Int)] -> Bool+pFoldrWithKey' = (sortByKey . M.foldrWithKey' f []) `eq`+ (sortByKey . HM.foldrWithKey' f [])+ where f k v z = (k, v) : z +pFoldlWithKey :: [(Int, Int)] -> Bool+pFoldlWithKey = (sortByKey . M.foldlWithKey f []) `eq`+ (sortByKey . HM.foldlWithKey f [])+ where f z k v = (k, v) : z++pFoldlWithKey' :: [(Int, Int)] -> Bool+pFoldlWithKey' = (sortByKey . M.foldlWithKey' f []) `eq`+ (sortByKey . HM.foldlWithKey' f [])+ where f z k v = (k, v) : z++pFoldl' :: [(Int, Int)] -> Bool+pFoldl' = (L.sort . M.foldl' (flip (:)) []) `eq` (L.sort . HM.foldl' (flip (:)) [])++pFoldr' :: [(Int, Int)] -> Bool+pFoldr' = (L.sort . M.foldr' (:) []) `eq` (L.sort . HM.foldr' (:) [])+ ------------------------------------------------------------------------ -- ** Filter @@ -322,14 +363,32 @@ ------------------------------------------------------------------------ -- ** Conversions +-- The free magma is used to test that operations are applied in the+-- same order.+data Magma a+ = Leaf a+ | Op (Magma a) (Magma a)+ deriving (Show, Eq, Ord)++instance Hashable a => Hashable (Magma a) where+ hashWithSalt s (Leaf a) = hashWithSalt s (hashWithSalt (1::Int) a)+ hashWithSalt s (Op m n) = hashWithSalt s (hashWithSalt (hashWithSalt (2::Int) m) n)+ -- 'eq_' already calls fromList. pFromList :: [(Key, Int)] -> Bool pFromList = id `eq_` id pFromListWith :: [(Key, Int)] -> Bool-pFromListWith kvs = (M.toAscList $ M.fromListWith (+) kvs) ==- (toAscList $ HM.fromListWith (+) kvs)+pFromListWith kvs = (M.toAscList $ M.fromListWith Op kvsM) ==+ (toAscList $ HM.fromListWith Op kvsM)+ where kvsM = fmap (fmap Leaf) kvs +pFromListWithKey :: [(Key, Int)] -> Bool+pFromListWithKey kvs = (M.toAscList $ M.fromListWithKey combine kvsM) ==+ (toAscList $ HM.fromListWithKey combine kvsM)+ where kvsM = fmap (\(K k,v) -> (Leaf k, Leaf v)) kvs+ combine k v1 v2 = Op k (Op v1 v2)+ pToList :: [(Key, Int)] -> Bool pToList = M.toAscList `eq` toAscList @@ -363,6 +422,7 @@ [ testProperty "size" pSize , testProperty "member" pMember , testProperty "lookup" pLookup+ , testProperty "!?" pLookupOperator , testProperty "insert" pInsert , testProperty "delete" pDelete , testProperty "deleteCollision" pDeleteCollision@@ -391,8 +451,19 @@ -- Folds , testGroup "folds" [ testProperty "foldr" pFoldr+ , testProperty "foldl" pFoldl+#if MIN_VERSION_base(4,10,0)+ , testProperty "bifoldMap" pBifoldMap+ , testProperty "bifoldr" pBifoldr+ , testProperty "bifoldl" pBifoldl+#endif , testProperty "foldrWithKey" pFoldrWithKey+ , testProperty "foldlWithKey" pFoldlWithKey+ , testProperty "foldrWithKey'" pFoldrWithKey'+ , testProperty "foldlWithKey'" pFoldlWithKey' , testProperty "foldl'" pFoldl'+ , testProperty "foldr'" pFoldr'+ , testProperty "foldMapWithKey" pFoldMapWithKey ] , testGroup "difference and intersection" [ testProperty "difference" pDifference@@ -414,6 +485,7 @@ , testProperty "keys" pKeys , testProperty "fromList" pFromList , testProperty "fromListWith" pFromListWith+ , testProperty "fromListWithKey" pFromListWithKey , testProperty "toList" pToList ] ]
tests/Regressions.hs view
@@ -1,10 +1,21 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-} module Main where import Control.Applicative ((<$>))+import Control.Exception (evaluate) import Control.Monad (replicateM)+import Data.Hashable (Hashable(..)) import qualified Data.HashMap.Strict as HM+import qualified Data.HashMap.Lazy as HML import Data.List (delete) import Data.Maybe+import GHC.Exts (touch#)+import GHC.IO (IO (..))+import System.Mem (performGC)+import System.Mem.Weak (mkWeakPtr, deRefWeak)+import System.Random (randomIO) import Test.HUnit (Assertion, assert) import Test.Framework (Test, defaultMain) import Test.Framework.Providers.HUnit (testCase)@@ -72,6 +83,48 @@ mapFromKeys keys = HM.fromList (zip keys (repeat ())) ------------------------------------------------------------------------+-- Issue #254++-- Key type that always collides.+newtype KC = KC Int+ deriving (Eq, Ord, Show)+instance Hashable KC where+ hashWithSalt salt _ = salt++touch :: a -> IO ()+touch a = IO (\s -> (# touch# a s, () #))++-- We want to make sure that old values in the HashMap are evicted when new values are inserted,+-- even if they aren't evaluated. To do that, we use the WeakPtr trick described at+-- http://simonmar.github.io/posts/2018-06-20-Finding-fixing-space-leaks.html.+-- We insert a value named oldV into the HashMap, then insert over it, checking oldV is no longer reachable.+--+-- To make the test robust, it's important that oldV isn't hoisted up to the top or shared.+-- To do that, we generate it randomly.+issue254Lazy :: Assertion+issue254Lazy = do+ i :: Int <- randomIO+ let oldV = error $ "Should not be evaluated: " ++ show i+ weakV <- mkWeakPtr oldV Nothing -- add the ability to test whether oldV is alive+ mp <- evaluate $ HML.insert (KC 1) (error "Should not be evaluated") $ HML.fromList [(KC 0, "1"), (KC 1, oldV)]+ performGC+ res <- deRefWeak weakV -- gives Just if oldV is still alive+ touch mp -- makes sure that we didn't GC away the whole HashMap, just oldV+ assert $ isNothing res++-- Like issue254Lazy, but using strict HashMap+issue254Strict :: Assertion+issue254Strict = do+ i :: Int <- randomIO+ let oldV = show i+ weakV <- mkWeakPtr oldV Nothing+ mp <- evaluate $ HM.insert (KC 1) "3" $ HM.fromList [(KC 0, "1"), (KC 1, oldV)]+ performGC+ res <- deRefWeak weakV+ touch mp+ assert $ isNothing res++------------------------------------------------------------------------ -- * Test list tests :: [Test]@@ -80,6 +133,8 @@ testCase "issue32" issue32 , testCase "issue39a" issue39 , testProperty "issue39b" propEqAfterDelete+ , testCase "issue254 lazy" issue254Lazy+ , testCase "issue254 strict" issue254Strict ] ------------------------------------------------------------------------
tests/Strictness.hs view
@@ -55,6 +55,9 @@ pLookupDefaultKeyStrict :: Int -> HashMap Key Int -> Bool pLookupDefaultKeyStrict def m = isBottom $ HM.lookupDefault def bottom m +pFindWithDefaultKeyStrict :: Int -> HashMap Key Int -> Bool+pFindWithDefaultKeyStrict def m = isBottom $ HM.findWithDefault def bottom m+ pAdjustKeyStrict :: (Int -> Int) -> HashMap Key Int -> Bool pAdjustKeyStrict f m = isBottom $ HM.adjust f bottom m @@ -161,6 +164,7 @@ , testProperty "member is key-strict" $ keyStrict HM.member , testProperty "lookup is key-strict" $ keyStrict HM.lookup , testProperty "lookupDefault is key-strict" pLookupDefaultKeyStrict+ , testProperty "findWithDefault is key-strict" pFindWithDefaultKeyStrict , testProperty "! is key-strict" $ keyStrict (flip (HM.!)) , testProperty "delete is key-strict" $ keyStrict HM.delete , testProperty "adjust is key-strict" pAdjustKeyStrict
unordered-containers.cabal view
@@ -1,5 +1,5 @@ name: unordered-containers-version: 0.2.10.0+version: 0.2.11.0 synopsis: Efficient hashing-based container types description: Efficient hashing-based container types. The containers have been@@ -11,17 +11,26 @@ license: BSD3 license-file: LICENSE author: Johan Tibell-maintainer: johan.tibell@gmail.com-Homepage: https://github.com/tibbe/unordered-containers-bug-reports: https://github.com/tibbe/unordered-containers/issues+maintainer: johan.tibell@gmail.com, David.Feuer@gmail.com+Homepage: https://github.com/haskell-unordered-containers/unordered-containers+bug-reports: https://github.com/haskell-unordered-containers/unordered-containers/issues copyright: 2010-2014 Johan Tibell 2010 Edward Z. Yang category: Data build-type: Simple cabal-version: >=1.10 extra-source-files: CHANGES.md-tested-with: GHC==8.4.1, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4 +tested-with:+ GHC ==8.10.1+ || ==8.8.3+ || ==8.6.5+ || ==8.4.4+ || ==8.2.2+ || ==8.0.2+ || ==7.10.3+ || ==7.8.4+ flag debug description: Enable debug support default: False@@ -43,7 +52,7 @@ build-depends: base >= 4.7 && < 5, deepseq >= 1.1,- hashable >= 1.0.1.1 && < 1.3+ hashable >= 1.0.1.1 && < 1.4 default-language: Haskell2010 @@ -146,6 +155,7 @@ hashable >= 1.0.1.1, HUnit, QuickCheck >= 2.4.0.1,+ random, test-framework >= 0.3.3, test-framework-hunit, test-framework-quickcheck2,@@ -175,44 +185,31 @@ cpp-options: -DASSERTS benchmark benchmarks- -- We cannot depend on the unordered-containers library directly as- -- that creates a dependency cycle.- hs-source-dirs: . benchmarks-+ hs-source-dirs: benchmarks main-is: Benchmarks.hs type: exitcode-stdio-1.0 other-modules:- Data.HashMap.Array- Data.HashMap.Base- Data.HashMap.Lazy- Data.HashMap.Strict- Data.HashMap.Strict.Base- Data.HashMap.Unsafe- Data.HashMap.UnsafeShift- Data.HashSet- Data.HashSet.Base Util.ByteString- Util.Int Util.String+ Util.Int build-depends: base >= 4.8.0, bytestring, containers,- criterion >= 1.0 && < 1.3,+ gauge >= 0.2.5 && < 0.3, deepseq >= 1.1, deepseq-generics, hashable >= 1.0.1.1, hashmap, mtl,- random+ random,+ unordered-containers default-language: Haskell2010 ghc-options: -Wall -O2 -rtsopts -fwarn-tabs -ferror-spans- if flag(debug)- cpp-options: -DASSERTS source-repository head type: git- location: https://github.com/tibbe/unordered-containers.git+ location: https://github.com/haskell-unordered-containers/unordered-containers.git