unordered-containers 0.1.0.0 → 0.1.1.0
raw patch · 12 files changed
+379/−144 lines, 12 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.HashMap.Lazy: adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HashMap k v -> HashMap k v
+ Data.HashMap.Lazy: lookupDefault :: (Eq k, Hashable k) => v -> k -> HashMap k v -> v
+ Data.HashMap.Lazy: traverseWithKey :: Applicative f => (k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
+ Data.HashMap.Strict: adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HashMap k v -> HashMap k v
+ Data.HashMap.Strict: lookupDefault :: (Eq k, Hashable k) => v -> k -> HashMap k v -> v
+ Data.HashMap.Strict: traverseWithKey :: Applicative f => (k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
Files
- Data/FullList/Lazy.hs +33/−0
- Data/FullList/Strict.hs +22/−1
- Data/HashMap/Common.hs +46/−40
- Data/HashMap/Lazy.hs +77/−29
- Data/HashMap/Strict.hs +32/−10
- benchmarks/Benchmarks.hs +52/−12
- benchmarks/Makefile +1/−1
- benchmarks/Util/ByteString.hs +7/−0
- benchmarks/Util/Int.hs +7/−0
- benchmarks/Util/String.hs +9/−0
- tests/Properties.hs +87/−47
- unordered-containers.cabal +6/−4
Data/FullList/Lazy.hs view
@@ -23,9 +23,11 @@ , insert , delete , insertWith+ , adjust -- * Transformations , map+ , traverseWithKey -- * Folds , foldlWithKey'@@ -35,6 +37,7 @@ , filterWithKey ) where +import Control.Applicative import Control.DeepSeq (NFData(rnf)) import Prelude hiding (lookup, map) @@ -174,6 +177,25 @@ {-# INLINABLE insertWithL #-} #endif +adjust :: Eq k => (v -> v) -> k -> FullList k v -> FullList k v+adjust f !k (FL k' v xs)+ | k == k' = FL k' (f v) xs+ | otherwise = FL k' v (adjustL f k xs)+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE adjust #-}+#endif++adjustL :: Eq k => (v -> v) -> k -> List k v -> List k v+adjustL f = go+ where+ go !_ Nil = Nil+ go k (Cons k' v xs)+ | k == k' = Cons k' (f v) xs+ | otherwise = Cons k' v (go k xs)+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE adjustL #-}+#endif+ ------------------------------------------------------------------------ -- * Transformations @@ -189,6 +211,17 @@ go (Cons k v xs) = let (k', v') = f k v in Cons k' v' (go xs) {-# INLINE mapL #-}++traverseWithKey :: Applicative m => (k -> v1 -> m v2) -> FullList k v1 -> m (FullList k v2)+traverseWithKey f (FL k v xs) = FL k <$> f k v <*> traverseWithKeyL f xs+{-# INLINE traverseWithKey #-}++traverseWithKeyL :: Applicative m => (k -> v1 -> m v2) -> List k v1 -> m (List k v2)+traverseWithKeyL f = go+ where+ go Nil = pure Nil+ go (Cons k v xs) = Cons k <$> f k v <*> go xs+{-# INLINE traverseWithKeyL #-} ------------------------------------------------------------------------ -- * Folds
Data/FullList/Strict.hs view
@@ -22,9 +22,11 @@ , insert , delete , insertWith+ , adjust -- * Transformations , map+ , traverseWithKey -- * Folds , foldlWithKey'@@ -36,7 +38,7 @@ import Prelude hiding (lookup, map) -import Data.FullList.Lazy hiding (insertWith, map)+import Data.FullList.Lazy hiding (insertWith, map, adjust) insertWith :: Eq k => (v -> v -> v) -> k -> v -> FullList k v -> FullList k v insertWith f !k v (FL k' v' xs)@@ -55,6 +57,25 @@ | otherwise = Cons k' v' (go f k v xs) #if __GLASGOW_HASKELL__ >= 700 {-# INLINABLE insertWithL #-}+#endif++adjust :: Eq k => (v -> v) -> k -> FullList k v -> FullList k v+adjust f !k (FL k' v xs)+ | k == k' = let v' = f v in v' `seq` FL k' v' xs+ | otherwise = FL k' v (adjustL f k xs)+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE adjust #-}+#endif++adjustL :: Eq k => (v -> v) -> k -> List k v -> List k v+adjustL f = go+ where+ go !_ Nil = Nil+ go k (Cons k' v xs)+ | k == k' = let v' = f v in v' `seq` Cons k' v' xs+ | otherwise = Cons k' v (go k xs)+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE adjustL #-} #endif ------------------------------------------------------------------------
Data/HashMap/Common.hs view
@@ -6,7 +6,7 @@ ( -- * Types HashMap(..)- , Prefix+ , Suffix , Mask , Hash @@ -16,16 +16,21 @@ , zero , nomatch , mask- , maskW- , branchMask- , highBit++ -- * Transformations+ , traverseWithKey++ -- * Folds+ , foldrWithKey ) where #include "MachDeps.h" +import Control.Applicative import Control.DeepSeq (NFData(rnf))-import Data.Bits ((.&.), (.|.), complement, shiftR, xor)+import Data.Bits ((.&.), xor) import qualified Data.Foldable as Foldable+import Data.Traversable (Traversable(..)) import Data.Word (Word) import Prelude hiding (foldr, map) @@ -40,13 +45,13 @@ = Nil | Tip {-# UNPACK #-} !Hash {-# UNPACK #-} !(FL.FullList k v)- | Bin {-# UNPACK #-} !Prefix+ | Bin {-# UNPACK #-} !Suffix {-# UNPACK #-} !Mask !(HashMap k v) !(HashMap k v) deriving Show -type Prefix = Int+type Suffix = Int type Mask = Int type Hash = Int @@ -77,7 +82,7 @@ instance (NFData k, NFData v) => NFData (HashMap k v) where rnf Nil = () rnf (Tip _ xs) = rnf xs- rnf (Bin _ _ l r) = rnf l `seq` rnf r `seq` ()+ rnf (Bin _ _ l r) = rnf l `seq` rnf r instance Functor (HashMap k) where fmap = map@@ -86,7 +91,7 @@ map :: (v1 -> v2) -> HashMap k v1 -> HashMap k v2 map f = go where- go (Bin p m l r) = Bin p m (go l) (go r)+ go (Bin s m l r) = Bin s m (go l) (go r) go (Tip h l) = Tip h (FL.map f' l) go Nil = Nil f' k v = (k, f v)@@ -106,20 +111,34 @@ go z Nil = z {-# INLINE foldrWithKey #-} +instance Traversable (HashMap k) where+ traverse f = traverseWithKey (const f)++-- | /O(n)/ Transform this map by accumulating an Applicative result+-- from every value.+traverseWithKey :: Applicative f => (k -> v1 -> f v2) -> HashMap k v1+ -> f (HashMap k v2)+traverseWithKey f = go+ where+ go (Bin p m l r) = Bin p m <$> go l <*> go r+ go (Tip h l) = Tip h <$> FL.traverseWithKey f l+ go Nil = pure Nil+{-# INLINE traverseWithKey #-}+ ------------------------------------------------------------------------ -- Helpers -join :: Prefix -> HashMap k v -> Prefix -> HashMap k v -> HashMap k v-join p1 t1 p2 t2- | zero p1 m = Bin p m t1 t2- | otherwise = Bin p m t2 t1+join :: Suffix -> HashMap k v -> Suffix -> HashMap k v -> HashMap k v+join s1 t1 s2 t2+ | zero s1 m = Bin s m t1 t2+ | otherwise = Bin s m t2 t1 where- m = branchMask p1 p2- p = mask p1 m+ m = branchMask s1 s2+ s = mask s1 m {-# INLINE join #-} -- | @bin@ assures that we never have empty trees within a tree.-bin :: Prefix -> Mask -> HashMap k v -> HashMap k v -> HashMap k v+bin :: Suffix -> Mask -> HashMap k v -> HashMap k v -> HashMap k v bin _ _ l Nil = l bin _ _ Nil r = r bin p m l r = Bin p m l r@@ -132,40 +151,27 @@ zero i m = (fromIntegral i :: Word) .&. (fromIntegral m :: Word) == 0 {-# INLINE zero #-} -nomatch :: Hash -> Prefix -> Mask -> Bool-nomatch i p m = (mask i m) /= p+nomatch :: Hash -> Suffix -> Mask -> Bool+nomatch i s m = (mask i m) /= s {-# INLINE nomatch #-} -mask :: Hash -> Mask -> Prefix+mask :: Hash -> Mask -> Suffix mask i m = maskW (fromIntegral i :: Word) (fromIntegral m :: Word) {-# INLINE mask #-} ------------------------------------------------------------------------ -- Big endian operations -maskW :: Word -> Word -> Prefix-maskW i m = fromIntegral (i .&. (complement (m-1) `xor` m))+maskW :: Word -> Word -> Suffix+maskW i m = fromIntegral (i .&. (m-1)) {-# INLINE maskW #-} -branchMask :: Prefix -> Prefix -> Mask+branchMask :: Suffix -> Suffix -> Mask branchMask p1 p2 =- fromIntegral (highBit (fromIntegral p1 `xor` fromIntegral p2 :: Word))+ fromIntegral (critBit (fromIntegral p1 `xor` fromIntegral p2 :: Word)) {-# INLINE branchMask #-} --- | Return a 'Word' where only the highest bit is set.-highBit :: Word -> Word-highBit x0 =- let !x1 = x0 .|. shiftR x0 1- !x2 = x1 .|. shiftR x1 2- !x3 = x2 .|. shiftR x2 4- !x4 = x3 .|. shiftR x3 8- !x5 = x4 .|. shiftR x4 16-#if WORD_SIZE_IN_BITS == 32- in x5 `xor` (shiftR x5 1)-#elif WORD_SIZE_IN_BITS == 64- !x6 = x5 .|. shiftR x5 32- in x6 `xor` (shiftR x6 1)-#else-# error WORD_SIZE_IN_BITS not supported-#endif-{-# INLINE highBit #-}+-- | Return a 'Word' whose single set bit corresponds to the lowest set bit of w.+critBit :: Word -> Word+critBit w = w .&. (negate w)+{-# INLINE critBit #-}
Data/HashMap/Lazy.hs view
@@ -39,12 +39,15 @@ , null , size , lookup+ , lookupDefault , insert , delete , insertWith+ , adjust -- * Transformations , map+ , traverseWithKey -- * Folds , foldl'@@ -86,10 +89,11 @@ -- | /O(n)/ Return the number of key-value mappings in this map. size :: HashMap k v -> Int-size t = case t of- Bin _ _ l r -> size l + size r- Tip _ l -> FL.size l- Nil -> 0+size t = go t 0+ where+ go (Bin _ _ l r) !sz = go r (go l sz)+ go (Tip _ l) !sz = sz + FL.size l+ go Nil !sz = sz -- | /O(min(n,W))/ Return the value to which the specified key is -- mapped, or 'Nothing' if this map contains no mapping for the key.@@ -108,6 +112,17 @@ {-# INLINABLE lookup #-} #endif +-- | /O(min(n,W))/ 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)+ => v -- ^ Default value to return.+ -> k -> HashMap k v -> v+lookupDefault def k t = case lookup k t of+ Just v -> v+ _ -> def+{-# INLINE lookupDefault #-}+ -- | /O(1)/ Construct an empty map. empty :: HashMap k v empty = Nil@@ -127,10 +142,10 @@ insert k0 v0 t0 = go h0 k0 v0 t0 where h0 = hash k0- go !h !k v t@(Bin p m l r)- | nomatch h p m = join h (Tip h $ FL.singleton k v) p t- | zero h m = Bin p m (go h k v l) r- | otherwise = Bin p m l (go h k v r)+ go !h !k v t@(Bin s m l r)+ | nomatch h s m = join h (Tip h $ FL.singleton k v) s t+ | zero h m = Bin s m (go h k v l) r+ | otherwise = Bin s m l (go h k v r) go h k v t@(Tip h' l) | h == h' = Tip h $ FL.insert k v l | otherwise = join h (Tip h $ FL.singleton k v) h' t@@ -145,10 +160,10 @@ delete k0 = go h0 k0 where h0 = hash k0- go !h !k t@(Bin p m l r)- | nomatch h p m = t- | zero h m = bin p m (go h k l) r -- takes this branch- | otherwise = bin p m l (go h k r)+ go !h !k t@(Bin s m l r)+ | nomatch h s m = t+ | zero h m = bin s m (go h k l) r+ | otherwise = bin s m l (go h k r) go h k t@(Tip h' l) | h == h' = case FL.delete k l of Nothing -> Nil@@ -171,10 +186,10 @@ insertWith f k0 v0 t0 = go h0 k0 v0 t0 where h0 = hash k0- go !h !k v t@(Bin p m l r)- | nomatch h p m = join h (Tip h $ FL.singleton k v) p t- | zero h m = Bin p m (go h k v l) r- | otherwise = Bin p m l (go h k v r)+ go !h !k v t@(Bin s m l r)+ | nomatch h s m = join h (Tip h $ FL.singleton k v) s t+ | zero h m = Bin s m (go h k v l) r+ | otherwise = Bin s m l (go h k v r) go h k v t@(Tip h' l) | h == h' = Tip h $ FL.insertWith f k v l | otherwise = join h (Tip h $ FL.singleton k v) h' t@@ -183,6 +198,24 @@ {-# INLINABLE insertWith #-} #endif +-- | /O(min(n,W)/ Adjust the value tied to a given key in this map+-- only if it is present. Otherwise, leave the map alone.+adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HashMap k v -> HashMap k v+adjust f k0 t0 = go h0 k0 t0+ where+ h0 = hash k0+ go !h !k t@(Bin p m l r)+ | nomatch h p m = t+ | zero h m = Bin p m (go h k l) r+ | otherwise = Bin p m l (go h k r)+ go h k t@(Tip h' l)+ | h == h' = Tip h $ FL.adjust f k l+ | otherwise = t+ go _ _ Nil = Nil+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE adjust #-}+#endif+ ------------------------------------------------------------------------ -- * Transformations @@ -190,7 +223,7 @@ map :: (v1 -> v2) -> HashMap k v1 -> HashMap k v2 map f = go where- go (Bin p m l r) = Bin p m (go l) (go r)+ go (Bin s m l r) = Bin s m (go l) (go r) go (Tip h l) = Tip h (FL.map f' l) go Nil = Nil f' k v = (k, f v)@@ -208,17 +241,6 @@ -- | /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- where- go z (Bin _ _ l r) = go (go z r) l- go z (Tip _ l) = FL.foldrWithKey f z l- go z Nil = z-{-# 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). Each application of the operator -- is evaluated before before using the result in the next -- application. This function is strict in the starting value.@@ -248,7 +270,7 @@ filterWithKey :: (k -> v -> Bool) -> HashMap k v -> HashMap k v filterWithKey pred = go where- go (Bin p m l r) = bin p m (go l) (go r)+ go (Bin s m l r) = bin s m (go l) (go r) go (Tip h l) = case FL.filterWithKey pred l of Just l' -> Tip h l' Nothing -> Nil@@ -290,3 +312,29 @@ elems :: HashMap k v -> [v] elems = List.map snd . toList {-# INLINE elems #-}+++-------------------------------------------------------------------+-- Metadata about map behavior++-- | /O(n)/ Return the number of hash collisions in this map.+collisions :: HashMap k v -> Int+collisions t = go t 0+ where+ go (Bin _ _ l r) !sz = go r (go l sz)+ go (Tip _ l) !sz+ | fl_sz <= 1 = sz+ | otherwise = sz + fl_sz+ where fl_sz = FL.size l+ go Nil !sz = sz++-- | /O(n)/ Return histogram of hash collisions in this map.+-- Keys are number of entries in bucket, values are number of buckets+-- of that size.+collisionHistogram :: HashMap k v -> HashMap Int Int+collisionHistogram t = go t Nil+ where+ go (Bin _ _ l r) h = go r (go l h)+ go (Tip _ l) h = (insert sz $! maybe 1 (1+) (lookup sz h)) h+ where sz = FL.size l+ go Nil h = h
Data/HashMap/Strict.hs view
@@ -40,12 +40,15 @@ , null , size , lookup+ , lookupDefault , insert , delete , insertWith+ , adjust -- * Transformations , map+ , traverseWithKey -- * Folds , foldl'@@ -71,7 +74,7 @@ import qualified Data.FullList.Strict as FL import Data.HashMap.Common-import Data.HashMap.Lazy hiding (fromList, insert, insertWith, map, singleton)+import Data.HashMap.Lazy hiding (fromList, insert, insertWith, adjust, map, singleton) import qualified Data.HashMap.Lazy as L import qualified Data.List as List @@ -90,10 +93,10 @@ insert k0 !v0 t0 = go h0 k0 v0 t0 where h0 = hash k0- go !h !k v t@(Bin p m l r)- | nomatch h p m = join h (Tip h $ FL.singleton k v) p t- | zero h m = Bin p m (go h k v l) r- | otherwise = Bin p m l (go h k v r)+ go !h !k v t@(Bin s m l r)+ | nomatch h s m = join h (Tip h $ FL.singleton k v) s t+ | zero h m = Bin s m (go h k v l) r+ | otherwise = Bin s m l (go h k v r) go h k v t@(Tip h' l) | h == h' = Tip h $ FL.insert k v l | otherwise = join h (Tip h $ FL.singleton k v) h' t@@ -114,10 +117,10 @@ insertWith f k0 !v0 t0 = go h0 k0 v0 t0 where h0 = hash k0- go !h !k v t@(Bin p m l r)- | nomatch h p m = join h (Tip h $ FL.singleton k v) p t- | zero h m = Bin p m (go h k v l) r- | otherwise = Bin p m l (go h k v r)+ go !h !k v t@(Bin s m l r)+ | nomatch h s m = join h (Tip h $ FL.singleton k v) s t+ | zero h m = Bin s m (go h k v l) r+ | otherwise = Bin s m l (go h k v r) go h k v t@(Tip h' l) | h == h' = Tip h $ FL.insertWith f k v l | otherwise = join h (Tip h $ FL.singleton k v) h' t@@ -126,6 +129,25 @@ {-# INLINABLE insertWith #-} #endif +-- | /O(min(n,W)/ Adjust the value tied to a given key in this map+-- only if it is present. Otherwise, leave the map alone.+adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HashMap k v -> HashMap k v+adjust f k0 t0 = go h0 k0 t0+ where+ h0 = hash k0+ go !h !k t@(Bin p m l r)+ | nomatch h p m = t+ | zero h m = Bin p m (go h k l) r+ | otherwise = Bin p m l (go h k r)+ go h k t@(Tip h' l)+ | h == h' = Tip h $ FL.adjust f k l+ | otherwise = t+ go _ _ Nil = Nil+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE adjust #-}+#endif++ ------------------------------------------------------------------------ -- * Transformations @@ -133,7 +155,7 @@ map :: (v1 -> v2) -> HashMap k v1 -> HashMap k v2 map f = go where- go (Bin p m l r) = Bin p m (go l) (go r)+ go (Bin s m l r) = Bin s m (go l) (go r) go (Tip h l) = Tip h (FL.map f' l) go Nil = Nil f' k v = (k, f v)
benchmarks/Benchmarks.hs view
@@ -31,9 +31,9 @@ main :: IO () main = do- let hm = fromList elems :: HM.HashMap String Int- hmbs = fromList elemsBS :: HM.HashMap BS.ByteString Int- hmi = fromList elemsI :: HM.HashMap Int Int+ 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 m = M.fromList elems :: M.Map String Int mbs = M.fromList elemsBS :: M.Map BS.ByteString Int im = IM.fromList elemsI :: IM.IntMap Int@@ -47,21 +47,41 @@ [ bench "String" $ whnf (lookupM keys) m , bench "ByteString" $ whnf (lookupM keysBS) mbs ]+ , bgroup "lookup-miss"+ [ bench "String" $ whnf (lookupM keys') m+ , bench "ByteString" $ whnf (lookupM keysBS') mbs+ ] , bgroup "insert" [ bench "String" $ whnf (insertM elems) M.empty , bench "ByteStringString" $ whnf (insertM elemsBS) M.empty ]+ , bgroup "insert-dup"+ [ bench "String" $ whnf (insertM elems) m+ , bench "ByteStringString" $ whnf (insertM elemsBS) mbs+ ] , bgroup "delete"- [ bench "String" $ whnf (insertM elems) M.empty- , bench "ByteString" $ whnf (insertM elemsBS) M.empty+ [ bench "String" $ whnf (deleteM keys) m+ , bench "ByteString" $ whnf (deleteM keysBS) mbs ]+ , bgroup "delete-miss"+ [ bench "String" $ whnf (deleteM keys') m+ , bench "ByteString" $ whnf (deleteM keysBS') mbs+ ]+ , bgroup "size"+ [ bench "String" $ whnf M.size m+ , bench "ByteString" $ whnf M.size mbs+ ] ] -- ** IntMap , bgroup "IntMap" [ bench "lookup" $ whnf (lookupIM keysI) im+ , bench "lookup-miss" $ whnf (lookupIM keysI') im , bench "insert" $ whnf (insertIM elemsI) IM.empty+ , bench "insert-dup" $ whnf (insertIM elemsI) im , bench "delete" $ whnf (deleteIM keysI) im+ , bench "delete-miss" $ whnf (deleteIM keysI') im+ , bench "size" $ whnf IM.size im ] -- * Basic interface@@ -70,16 +90,31 @@ , bench "ByteString" $ whnf (lookup keysBS) hmbs , bench "Int" $ whnf (lookup keysI) hmi ]+ , bgroup "lookup-miss"+ [ bench "String" $ whnf (lookup keys') hm+ , bench "ByteString" $ whnf (lookup keysBS') hmbs+ , bench "Int" $ whnf (lookup keysI') hmi+ ] , bgroup "insert" [ bench "String" $ whnf (insert elems) HM.empty , bench "ByteString" $ whnf (insert elemsBS) HM.empty , bench "Int" $ whnf (insert elemsI) HM.empty ]+ , bgroup "insert-dup"+ [ bench "String" $ whnf (insert elems) hm+ , bench "ByteString" $ whnf (insert elemsBS) hmbs+ , bench "Int" $ whnf (insert elemsI) hmi+ ] , bgroup "delete" [ bench "String" $ whnf (delete keys) hm , bench "ByteString" $ whnf (delete keysBS) hmbs , bench "Int" $ whnf (delete keysI) hmi ]+ , bgroup "delete-miss"+ [ bench "String" $ whnf (delete keys') hm+ , bench "ByteString" $ whnf (delete keysBS') hmbs+ , bench "Int" $ whnf (delete keysI') hmi+ ] -- Transformations , bench "map" $ whnf (HM.map (\ v -> v + 1)) hmi@@ -91,6 +126,13 @@ -- Filter , bench "filter" $ whnf (HM.filter (\ v -> v .&. 1 == 0)) hmi , bench "filterWithKey" $ whnf (HM.filterWithKey (\ k _ -> k .&. 1 == 0)) hmi++ -- Size+ , bgroup "size"+ [ bench "String" $ whnf HM.size hm+ , bench "ByteString" $ whnf HM.size hmbs+ , bench "Int" $ whnf HM.size hmi+ ] ] where n :: Int@@ -101,8 +143,12 @@ elemsBS = zip keysBS [1..n] keysBS = UBS.rnd 8 n elemsI = zip keysI [1..n]- keysI = UI.rnd n n+ keysI = UI.rnd (n+n) n + keys' = US.rnd' 8 n+ keysBS' = UBS.rnd' 8 n+ keysI' = UI.rnd' (n+n) n+ ------------------------------------------------------------------------ -- * HashMap @@ -163,9 +209,3 @@ deleteIM :: [Int] -> IM.IntMap Int -> IM.IntMap Int deleteIM xs m0 = foldl' (\m k -> IM.delete k m) m0 xs----------------------------------------------------------------------------- * Helpers--fromList :: (Eq k, Hashable k) => [(k, v)] -> HM.HashMap k v-fromList = foldl' (\m (k, v) -> HM.insert k v m) HM.empty
benchmarks/Makefile view
@@ -19,7 +19,7 @@ -package-conf ../dist/package.conf.inplace -package base -package mtl \ -package unordered-containers -package containers -package criterion \ -package deepseq -package hashable -package random -package bytestring \- $(ghc-prof-flags) -rtsopts+ $(ghc-prof-flags) %.o: %.hs $(ghc) $(ghc-flags) -c -o $@ $<
benchmarks/Util/ByteString.hs view
@@ -20,3 +20,10 @@ -> 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
benchmarks/Util/Int.hs view
@@ -10,3 +10,10 @@ -> 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
benchmarks/Util/String.hs view
@@ -23,3 +23,12 @@ 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'
tests/Properties.hs view
@@ -1,16 +1,18 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Tests for the 'Data.HashMap.Lazy' module. We test functions by -- comparing them to a simpler model, an association list. module Main (main) where +import qualified Data.Foldable as Foldable import Data.Function (on) import Data.Hashable (Hashable(hash)) import qualified Data.List as L import qualified Data.HashMap.Lazy as M import Test.QuickCheck (Arbitrary)-import Test.QuickCheck.Batch+import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty) -- Key type that generates more hash collisions. newtype Key = K { unK :: Int }@@ -26,11 +28,18 @@ -- ** Instances pEq :: [(Key, Int)] -> [(Key, Int)] -> Bool-pEq xs = (xs ==) `eq` (fromList xs ==)+pEq xs = (xs ==) `eq` (M.fromList xs ==) pNeq :: [(Key, Int)] -> [(Key, Int)] -> Bool-pNeq xs = (xs /=) `eq` (fromList xs /=)+pNeq xs = (xs /=) `eq` (M.fromList xs /=) +pFunctor :: [(Key, Int)] -> Bool+pFunctor = fmap (\ (k, v) -> (k, v + 1)) `eq` (toAscList . fmap (+ 1))++pFoldable :: [(Int, Int)] -> Bool+pFoldable = (L.sort . Foldable.foldr (\ (_, v) z -> v:z) []) `eq`+ (L.sort . Foldable.foldr (:) [])+ ------------------------------------------------------------------------ -- ** Basic interface @@ -46,46 +55,83 @@ pDelete :: Key -> [(Key, Int)] -> Bool pDelete k = delete k `eq` (toAscList . M.delete k) -pAdjustWithDefault :: Key -> [(Key, Int)] -> Bool-pAdjustWithDefault k = insertWith (+) (k, 1) `eq`- (toAscList . M.insertWith (+) k 1)--pToList :: [(Key, Int)] -> Bool-pToList = id `eq` toAscList--tests :: [TestOptions -> IO TestResult]-tests =- [ run pEq- , run pNeq- , run pSize- , run pLookup- , run pInsert- , run pDelete- , run pAdjustWithDefault+pInsertWith :: Key -> [(Key, Int)] -> Bool+pInsertWith k = insertWith (+) (k, 1) `eq`+ (toAscList . M.insertWith (+) k 1) - -- Folds- , run pFoldr- , run pFoldl'+------------------------------------------------------------------------+-- ** Transformations - -- Conversions- , run pToList- ]+pMap :: [(Key, Int)] -> Bool+pMap = map (\ (k, v) -> (k, v + 1)) `eq` (toAscList . M.map (+ 1)) ------------------------------------------------------------------------ -- ** Folds pFoldr :: [(Int, Int)] -> Bool-pFoldr = (sortByKey . L.foldr (\ p z -> p : z) []) `eq`- (sortByKey . M.foldrWithKey f [])+pFoldr = (L.sort . L.foldr (\ (_, v) z -> v:z) []) `eq`+ (L.sort . M.foldr (:) [])++pFoldrWithKey :: [(Int, Int)] -> Bool+pFoldrWithKey = (sortByKey . L.foldr (:) []) `eq`+ (sortByKey . M.foldrWithKey f []) where f k v z = (k, v) : z pFoldl' :: Int -> [(Int, Int)] -> Bool-pFoldl' z0 = L.foldl' (\ z (_, v) -> z + v) z0 `eq` M.foldlWithKey' f z0- where f _ v z = v + z+pFoldl' z0 = L.foldl' (\ z (_, v) -> z + v) z0 `eq` M.foldl' (+) z0 --------------------------------------------------------------------------- Model+-- ** Conversions +pToList :: [(Key, Int)] -> Bool+pToList = id `eq` toAscList++pElems :: [(Key, Int)] -> Bool+pElems = (L.sort . map snd) `eq` (L.sort . M.elems)++pKeys :: [(Key, Int)] -> Bool+pKeys = map fst `eq` (L.sort . M.keys)++------------------------------------------------------------------------+-- * Test list++tests :: [Test]+tests =+ [+ -- Instances+ testGroup "instances"+ [ testProperty "==" pEq+ , testProperty "/=" pNeq+ , testProperty "Functor" pFunctor+ , testProperty "Foldable" pFoldable+ ]+ -- Basic interface+ , testGroup "basic interface"+ [ testProperty "size" pSize+ , testProperty "lookup" pLookup+ , testProperty "insert" pInsert+ , testProperty "delete" pDelete+ , testProperty "insertWith" pInsertWith+ ]+ -- Transformations+ , testProperty "map" pMap+ -- Folds+ , testGroup "folds"+ [ testProperty "foldr" pFoldr+ , testProperty "foldrWithKey" pFoldrWithKey+ , testProperty "foldl'" pFoldl'+ ]+ -- Conversions+ , testGroup "conversions"+ [ testProperty "elems" pElems+ , testProperty "keys" pKeys+ , testProperty "toList" pToList+ ]+ ]++------------------------------------------------------------------------+-- * Model+ -- Invariant: the list is sorted in ascending order, by key. type Model k v = [(k, v)] @@ -97,8 +143,8 @@ -> (M.HashMap k v -> a) -- ^ Function that modified a 'HashMap' -> [(k, v)] -- ^ Initial content of the 'HashMap' and 'Model' -> Bool -- ^ True if the functions are equivalent-eq f g xs = g (fromList ys) == f ys- where ys = L.nubBy ((==) `on` fst) $ L.sortBy (compare `on` fst) $ xs+eq f g xs = g (M.fromList ys) == f ys+ where ys = fromList xs insert :: Ord k => (k, v) -> Model k v -> Model k v insert x [] = [x]@@ -121,25 +167,19 @@ | k > k' = y : insertWith f x xs | otherwise = x : y : xs ---------------------------------------------------------------------------- Test harness+-- | Create a model from a list of key-value pairs. If the input+-- contains multiple entries for the same key, the latter one is used.+fromList :: Ord k => [(k, v)] -> Model k v+fromList = L.foldl' (\ m p -> insert p m) [] -options :: TestOptions-options = TestOptions- { no_of_tests = 500- , length_of_tests = 1- , debug_tests = False- }+------------------------------------------------------------------------+-- * Test harness main :: IO ()-main = runTests "basics" options tests+main = defaultMain tests --------------------------------------------------------------------------- Helpers--fromList :: (Eq k, Hashable k) => [(k, v)] -> M.HashMap k v-fromList = L.foldl' ins M.empty- where ins m (k, v) = M.insert k v m+-- * Helpers sortByKey :: Ord k => [(k, v)] -> [(k, v)] sortByKey = L.sortBy (compare `on` fst)
unordered-containers.cabal view
@@ -1,5 +1,5 @@ name: unordered-containers-version: 0.1.0.0+version: 0.1.1.0 synopsis: Efficient hashing-based container types description: Efficient hashing-based container types. The containers have been@@ -52,9 +52,11 @@ -- build-depends: -- base,--- hashable >= 1.0.1.1 && < 1.1,--- unordered-containers,--- QuickCheck == 1.2.0.*+-- hashable >= 1.0.1.1 && < 1.2,+-- QuickCheck >= 2.4.0.1,+-- test-framework >= 0.3.3 && < 0.4,+-- test-framework-quickcheck2 >= 0.2.9 && < 0.3,+-- unordered-containers -- ghc-options: -Wall