unordered-containers 0.2.5.1 → 0.2.6.0
raw patch · 11 files changed
+424/−76 lines, 11 filesdep +deepseq-genericsdep ~basedep ~criteriondep ~hashable
Dependencies added: deepseq-generics
Dependency ranges changed: base, criterion, hashable
Files
- CHANGES.md +16/−0
- Data/HashMap/Array.hs +0/−1
- Data/HashMap/Base.hs +133/−20
- Data/HashMap/Lazy.hs +5/−0
- Data/HashMap/Strict.hs +60/−3
- Data/HashMap/Unsafe.hs +4/−4
- Data/HashSet.hs +39/−2
- benchmarks/Benchmarks.hs +83/−41
- tests/HashMapProperties.hs +55/−1
- tests/HashSetProperties.hs +23/−1
- unordered-containers.cabal +6/−3
+ CHANGES.md view
@@ -0,0 +1,16 @@+## 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
Data/HashMap/Array.hs view
@@ -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
Data/HashMap/Base.hs view
@@ -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,6 +28,8 @@ , unsafeInsert , delete , adjust+ , update+ , alter -- * Combine -- ** Union@@ -42,6 +46,7 @@ , difference , intersection , intersectionWith+ , intersectionWithKey -- * Folds , foldl'@@ -50,6 +55,8 @@ , foldrWithKey -- * Filter+ , mapMaybe+ , mapMaybeWithKey , filter , filterWithKey @@ -79,16 +86,18 @@ , update16M , update16With' , updateOrConcatWith+ , 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 +149,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 +166,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,12 +236,40 @@ 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 isLeafOrCollision (Leaf _ _) = True@@ -460,8 +511,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 +624,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 @@ -777,6 +845,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 +915,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 +967,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 +996,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 +1008,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.
Data/HashMap/Lazy.hs view
@@ -47,6 +47,8 @@ , insertWith , delete , adjust+ , update+ , alter -- * Combine -- ** Union@@ -63,6 +65,7 @@ , difference , intersection , intersectionWith+ , intersectionWithKey -- * Folds , foldl'@@ -73,6 +76,8 @@ -- * Filter , HM.filter , filterWithKey+ , mapMaybe+ , mapMaybeWithKey -- * Conversions , keys
Data/HashMap/Strict.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, CPP #-}+{-# LANGUAGE BangPatterns, CPP, PatternGuards #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}@@ -47,6 +47,8 @@ , insertWith , delete , adjust+ , update+ , alter -- * Combine -- ** Union@@ -63,6 +65,7 @@ , difference , intersection , intersectionWith+ , intersectionWithKey -- * Folds , foldl'@@ -73,6 +76,8 @@ -- * Filter , HM.filter , filterWithKey+ , mapMaybe+ , mapMaybeWithKey -- * Conversions , keys@@ -92,8 +97,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) import Data.HashMap.Unsafe (runST) -- $strictness@@ -227,6 +233,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 @@ -336,6 +359,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? ------------------------------------------------------------------------@@ -352,6 +397,18 @@ Just w -> insert k (f v w) m _ -> 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
Data/HashMap/Unsafe.hs view
@@ -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 #-}
Data/HashSet.hs view
@@ -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 @@ -141,6 +170,14 @@ singleton :: Hashable a => a -> HashSet a 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. --
benchmarks/Benchmarks.hs view
@@ -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
tests/HashMapProperties.hs view
@@ -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 @@ -133,6 +163,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 +195,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 +243,7 @@ , testProperty "Read/Show" pReadShow , testProperty "Functor" pFunctor , testProperty "Foldable" pFoldable+ , testProperty "Hashable" pHashable ] -- Basic interface , testGroup "basic interface"@@ -209,6 +255,11 @@ , 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@@ -226,11 +277,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"
tests/HashSetProperties.hs view
@@ -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"
unordered-containers.cabal view
@@ -1,5 +1,5 @@ name: unordered-containers-version: 0.2.5.1+version: 0.2.6.0 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==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@@ -151,8 +153,9 @@ base, bytestring, containers,- criterion,+ criterion >= 1.0 && < 1.1, deepseq >= 1.1,+ deepseq-generics, hashable >= 1.0.1.1, hashmap, mtl,