packages feed

unordered-containers 0.2.0.1 → 0.2.1.0

raw patch · 8 files changed

+178/−54 lines, 8 filesdep +HUnitdep +test-framework-hunitdep ~basedep ~containers

Dependencies added: HUnit, test-framework-hunit

Dependency ranges changed: base, containers

Files

Data/HashMap/Base.hs view
@@ -13,8 +13,10 @@       -- * Basic interface     , null     , size+    , member     , lookup     , lookupDefault+    , (!)     , insert     , insertWith     , unsafeInsert@@ -25,6 +27,7 @@       -- ** Union     , union     , unionWith+    , unions        -- * Transformations     , map@@ -179,6 +182,16 @@     go (Full ary)            n = A.foldl' (flip go) n ary     go (Collision _ ary)     n = n + A.length ary +-- | /O(log n)/ Return 'True' if the specified key is present in the+-- map, 'False' otherwise.+member :: (Eq k, Hashable k) => k -> HashMap k a -> Bool+member k m = case lookup k m of+    Nothing -> False+    Just _  -> True+#if __GLASGOW_HASKELL__ >= 700+{-# INLINEABLE member #-}+#endif+ -- | /O(log n)/ Return the value to which the specified key is mapped, -- or 'Nothing' if this map contains no mapping for the key. lookup :: (Eq k, Hashable k) => k -> HashMap k v -> Maybe v@@ -187,7 +200,7 @@     h0 = hash k0     go !_ !_ !_ Empty = Nothing     go h k _ (Leaf hx (L kx x))-        | h == hx && k == kx = Just x+        | h == hx && k == kx = Just x  -- TODO: Split test in two         | otherwise          = Nothing     go h k s (BitmapIndexed b v)         | b .&. m == 0 = Nothing@@ -211,6 +224,16 @@     _      -> def {-# 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.+(!) :: (Eq k, Hashable k) => HashMap k v -> k -> v+(!) m k = case lookup k m of+    Just v  -> v+    Nothing -> error "Data.HashMap.Base.(!): key not found"+{-# INLINABLE (!) #-}++infixl 9 !+ -- | Create a 'Collision' value with two 'Leaf' values. collision :: Hash -> Leaf k v -> Leaf k v -> HashMap k v collision h e1 e2 =@@ -244,7 +267,7 @@         | otherwise = two s h k x hy ky y     go h k x s t@(BitmapIndexed b ary)         | b .&. m == 0 = do-            ary' <- A.insert' ary i $! Leaf h (L k x)+            !ary' <- A.insert' ary i $! Leaf h (L k x)             return $! bitmapIndexedOrFull (b .|. m) ary'         | otherwise = do             st <- A.index_ ary i@@ -443,7 +466,8 @@             else case st' of             Empty -> do                 ary' <- A.delete' ary i-                return $! BitmapIndexed (mask h s) ary'+                let bm = fullNodeMask .&. complement (1 `unsafeShiftL` i)+                return $! BitmapIndexed bm ary'             _ -> do                 ary' <- A.update' ary i st'                 return $! Full ary'@@ -619,6 +643,13 @@     -- where we copy one array, and then update. {-# INLINE unionArrayBy #-} +-- TODO: Figure out the time complexity of 'unions'.++-- | Construct a set containing all elements from a list of sets.+unions :: (Eq k, Hashable k) => [HashMap k v] -> HashMap k v+unions = L.foldl' union empty+{-# INLINE unions #-}+ ------------------------------------------------------------------------ -- * Transformations @@ -755,7 +786,6 @@         step !ary !mary !b i !j !bi n             | i >= n = case j of                 0 -> return Empty-                1 -> A.read mary 0                 _ -> do                     ary2 <- trim mary j                     return $! if j == maxChildren@@ -1009,8 +1039,7 @@  -- | A bitmask with the 'bitsPerSubkey' least significant bits set. fullNodeMask :: Bitmap-fullNodeMask = complement (complement 0 `unsafeShiftL`-                           fromIntegral (1 `unsafeShiftL` bitsPerSubkey))+fullNodeMask = complement (complement 0 `unsafeShiftL` maxChildren) {-# INLINE fullNodeMask #-}  -- | Check if two the two arguments are the same value.  N.B. This
Data/HashMap/Lazy.hs view
@@ -40,8 +40,10 @@       -- * Basic interface     , HM.null     , size+    , member     , HM.lookup     , lookupDefault+    , (!)     , insert     , insertWith     , delete@@ -51,6 +53,7 @@       -- ** Union     , union     , unionWith+    , unions        -- * Transformations     , HM.map
Data/HashMap/Strict.hs view
@@ -41,8 +41,10 @@       -- * Basic interface     , HM.null     , size+    , HM.member     , HM.lookup     , lookupDefault+    , (!)     , insert     , insertWith     , delete@@ -52,6 +54,7 @@       -- ** Union     , union     , unionWith+    , unions        -- * Transformations     , map@@ -224,7 +227,7 @@ ------------------------------------------------------------------------ -- * Combine --- | /O(n*log m)/ The union of two maps.  If a key occurs in both maps,+-- | /O(n+m)/ The union of two maps.  If a key occurs in both maps, -- the provided function (first argument) will be used to compute the result. unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> HashMap k v -> HashMap k v           -> HashMap k v
Data/HashSet.hs view
@@ -31,6 +31,7 @@      -- * Combine     , union+    , unions      -- * Basic interface     , null@@ -111,13 +112,20 @@ {-# INLINABLE singleton #-} #endif --- | /O(n)/ Construct a set containing all elements from both sets.+-- | /O(n+m)/ Construct a set containing all elements from both sets. -- -- To obtain good performance, the smaller set must be presented as -- the first argument. union :: (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a union s1 s2 = HashSet $ H.union (asMap s1) (asMap s2) {-# INLINE union #-}++-- TODO: Figure out the time complexity of 'unions'.++-- | Construct a set containing all elements from a list of sets.+unions :: (Eq a, Hashable a) => [HashSet a] -> HashSet a+unions = List.foldl' union empty+{-# INLINE unions #-}  -- | /O(1)/ Return 'True' if this set is empty, 'False' otherwise. null :: HashSet a -> Bool
tests/HashMapProperties.hs view
@@ -15,7 +15,7 @@ import qualified Data.HashMap.Lazy as HM #endif import qualified Data.Map as M-import Test.QuickCheck (Arbitrary)+import Test.QuickCheck (Arbitrary, Property, (==>)) import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) @@ -33,7 +33,7 @@ -- ** Instances  pEq :: [(Key, Int)] -> [(Key, Int)] -> Bool-pEq xs ys = (M.fromList xs ==) `eq` (HM.fromList xs ==) $ ys+pEq xs = (M.fromList xs ==) `eq` (HM.fromList xs ==)  pNeq :: [(Key, Int)] -> [(Key, Int)] -> Bool pNeq xs = (M.fromList xs /=) `eq` (HM.fromList xs /=)@@ -51,6 +51,9 @@ pSize :: [(Key, Int)] -> Bool pSize = M.size `eq` HM.size +pMember :: Key -> [(Key, Int)] -> Bool+pMember k = M.member k `eq` HM.member k+ pLookup :: Key -> [(Key, Int)] -> Bool pLookup k = M.lookup k `eq` HM.lookup k @@ -60,6 +63,28 @@ pDelete :: Key -> [(Key, Int)] -> Bool pDelete k = M.delete k `eq_` HM.delete k +newtype AlwaysCollide = AC Int+    deriving (Arbitrary, Eq, Ord, Show)++instance Hashable AlwaysCollide where+    hash _ = 1++-- White-box test that tests the case of deleting one of two keys from+-- a map, where the keys' hash values collide.+pDeleteCollision :: AlwaysCollide -> AlwaysCollide -> Bool -> Property+pDeleteCollision k1 k2 keepFst = k1 /= k2 ==> HM.member toKeep $ HM.delete toDelete $+                                 HM.fromList [(k1, 1 :: Int), (k2, 2)]+  where+    (toDelete, toKeep)+        | keepFst   = (k2, k1)+        | otherwise = (k1, k2)++-- White-box test that tests the case of deleting one of many keys+-- from a map, where the keys' hash values collide.+pDeleteCollisionMany :: AlwaysCollide -> [(AlwaysCollide, Int)] -> Bool+pDeleteCollisionMany k kvs = not $ (HM.member k) $ HM.delete k $+                             HM.fromList ((k, 1):kvs)+ pInsertWith :: Key -> [(Key, Int)] -> Bool pInsertWith k = M.insertWith (+) k 1 `eq_` HM.insertWith (+) k 1 @@ -76,11 +101,15 @@ pUnionWith xs ys = M.unionWith (-) (M.fromList xs) `eq_`                    HM.unionWith (-) (HM.fromList xs) $ ys +pUnions :: [[(Key, Int)]] -> Bool+pUnions xss = M.toAscList (M.unions (map M.fromList xss)) ==+              toAscList (HM.unions (map HM.fromList xss))+ ------------------------------------------------------------------------ -- ** Transformations  pMap :: [(Key, Int)] -> Bool-pMap = M.map (+1 ) `eq_` HM.map (+ 1)+pMap = M.map (+ 1) `eq_` HM.map (+ 1)  ------------------------------------------------------------------------ -- ** Difference and intersection@@ -120,6 +149,14 @@ ------------------------------------------------------------------------ -- ** Conversions +-- '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)+ pToList :: [(Key, Int)] -> Bool pToList = M.toAscList `eq` toAscList @@ -145,15 +182,19 @@     -- Basic interface     , testGroup "basic interface"       [ testProperty "size" pSize+      , testProperty "member" pMember       , testProperty "lookup" pLookup       , testProperty "insert" pInsert       , testProperty "delete" pDelete+      , testProperty "deleteCollision" pDeleteCollision+      , testProperty "deleteCollisionMany" pDeleteCollisionMany       , testProperty "insertWith" pInsertWith       , testProperty "adjust" pAdjust       ]     -- Combine     , testProperty "union" pUnion     , testProperty "unionWith" pUnionWith+    , testProperty "unions" pUnions     -- Transformations     , testProperty "map" pMap     -- Folds@@ -175,6 +216,8 @@     , testGroup "conversions"       [ testProperty "elems" pElems       , testProperty "keys" pKeys+      , testProperty "fromList" pFromList+      , testProperty "fromListWith" pFromListWith       , testProperty "toList" pToList       ]     ]
tests/HashSetProperties.hs view
@@ -16,7 +16,7 @@  -- Key type that generates more hash collisions. newtype Key = K { unK :: Int }-            deriving (Arbitrary, Eq, Ord, Show)+            deriving (Arbitrary, Enum, Eq, Integral, Num, Ord, Show, Real)  instance Hashable Key where     hash k = hash (unK k) `mod` 20@@ -28,10 +28,10 @@ -- ** Instances  pEq :: [Key] -> [Key] -> Bool-pEq xs = (unique xs ==) `eq` (S.fromList xs ==)+pEq xs = (Set.fromList xs ==) `eq` (S.fromList xs ==)  pNeq :: [Key] -> [Key] -> Bool-pNeq xs = (unique xs /=) `eq` (S.fromList xs /=)+pNeq xs = (Set.fromList xs /=) `eq` (S.fromList xs /=)  pFoldable :: [Int] -> Bool pFoldable = (L.sort . Foldable.foldr (:) []) `eq`@@ -41,49 +41,51 @@ -- ** Basic interface  pSize :: [Key] -> Bool-pSize = length `eq` S.size+pSize = Set.size `eq` S.size  pMember :: Key -> [Key] -> Bool-pMember k = L.elem k `eq` S.member k+pMember k = Set.member k `eq` S.member k  pInsert :: Key -> [Key] -> Bool-pInsert a = insert a `eq` (toAscList . S.insert a)+pInsert a = Set.insert a `eq_` S.insert a  pDelete :: Key -> [Key] -> Bool-pDelete a = delete a `eq` (toAscList . S.delete a)+pDelete a = Set.delete a `eq_` S.delete a  ------------------------------------------------------------------------ -- ** Combine  pUnion :: [Key] -> [Key] -> Bool-pUnion xs ys = L.sort (L.union as bs) ==-               toAscList (S.union (S.fromList as) (S.fromList bs))-  where-    as = fromList xs-    bs = fromList ys+pUnion xs ys = Set.union (Set.fromList xs) `eq_`+               S.union (S.fromList xs) $ ys  ------------------------------------------------------------------------ -- ** Transformations  pMap :: [Key] -> Bool-pMap = map f `eq` (toAscList . S.map f)-  where f (K k) = K (k + 1)+pMap = Set.map (+ 1) `eq_` S.map (+ 1)  ------------------------------------------------------------------------ -- ** Folds  pFoldr :: [Int] -> Bool-pFoldr = (L.sort . L.foldr (:) []) `eq`+pFoldr = (L.sort . Set.foldr (:) []) `eq`          (L.sort . S.foldr (:) [])  pFoldl' :: Int -> [Int] -> Bool-pFoldl' z0 = L.foldl' (+) z0 `eq` S.foldl' (+) z0+pFoldl' z0 = Set.foldl' (+) z0 `eq` S.foldl' (+) z0  ------------------------------------------------------------------------+-- ** Filter++pFilter :: [Key] -> Bool+pFilter = Set.filter odd `eq_` S.filter odd++------------------------------------------------------------------------ -- ** Conversions  pToList :: [Key] -> Bool-pToList = id `eq` toAscList+pToList = Set.toAscList `eq` toAscList  ------------------------------------------------------------------------ -- * Test list@@ -113,6 +115,10 @@       [ testProperty "foldr" pFoldr       , testProperty "foldl'" pFoldl'       ]+    -- Filter+    , testGroup "filter"+      [ testProperty "filter" pFilter+      ]     -- Conversions     , testGroup "conversions"       [ testProperty "toList" pToList@@ -123,7 +129,7 @@ -- * Model  -- Invariant: the list is sorted in ascending order, by key.-type Model a = [a]+type Model a = Set.Set a  -- | Check that a function operating on a 'HashMap' is equivalent to -- one operating on a 'Model'.@@ -133,27 +139,17 @@    -> (S.HashSet a -> b)  -- ^ Function that modified a 'HashSet'    -> [a]                 -- ^ Initial content of the 'HashSet' and 'Model'    -> Bool                -- ^ True if the functions are equivalent-eq f g xs = g (S.fromList ys) == f ys-  where ys = fromList xs--insert :: Ord a => a -> Model a -> Model a-insert x [] = [x]-insert x (y:xs)-    | x == y    = x : xs-    | x > y     = y : insert x xs-    | otherwise = x : y : xs--delete :: Ord a => a -> Model a -> Model a-delete _ [] = []-delete k ys@(y:xs)-    | k == y   = xs-    | k > y    = y : delete k xs-    | otherwise = ys+eq f g xs = g (S.fromList xs) == f (Set.fromList xs) --- | 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 a => [a] -> Model a-fromList = L.foldl' (\ m p -> insert p m) []+eq_ :: (Eq a, Hashable a, Ord a)+    => (Model a -> Model a)          -- ^ Function that modifies a 'Model'+    -> (S.HashSet a -> S.HashSet a)  -- ^ Function that modified a+                                     -- 'HashSet' in the same way+    -> [a]                           -- ^ Initial content of the 'HashSet'+                                     -- and 'Model'+    -> Bool                          -- ^ True if the functions are+                                     -- equivalent+eq_ f g = (Set.toAscList . f) `eq` (toAscList . g)  ------------------------------------------------------------------------ -- * Test harness@@ -166,6 +162,3 @@  toAscList :: Ord a => S.HashSet a -> [a] toAscList = L.sort . S.toList--unique :: (Eq a, Ord a) => [a] -> [a]-unique = Set.toList . Set.fromList
+ tests/Regressions.hs view
@@ -0,0 +1,29 @@+module Main where++import qualified Data.HashMap.Strict as HM+import Data.Maybe+import Test.HUnit (Assertion, assert)+import Test.Framework (Test, defaultMain)+import Test.Framework.Providers.HUnit (testCase)++issue32 :: Assertion+issue32 = assert $ isJust $ HM.lookup 7 m'+  where+    ns = [0..16] :: [Int]+    m = HM.fromList (zip ns (repeat []))    +    m' = HM.delete 10 m++------------------------------------------------------------------------+-- * Test list++tests :: [Test]+tests =+    [+      testCase "issue32" issue32+    ]++------------------------------------------------------------------------+-- * Test harness++main :: IO ()+main = defaultMain tests
unordered-containers.cabal view
@@ -1,5 +1,5 @@ name:           unordered-containers-version:        0.2.0.1+version:        0.2.1.0 synopsis:       Efficient hashing-based container types description:   Efficient hashing-based container types.  The containers have been@@ -91,11 +91,27 @@    build-depends:     base,-    containers >= 0.4.1 && < 0.5,+    containers >= 0.4.2 && < 0.5,     hashable >= 1.0.1.1 && < 1.2,     QuickCheck >= 2.4.0.1,     test-framework >= 0.3.3 && < 0.6,     test-framework-quickcheck2 >= 0.2.9 && < 0.3,+    unordered-containers++  ghc-options: -Wall+  cpp-options: -DASSERTS++test-suite regressions+  hs-source-dirs: tests+  main-is: Regressions.hs+  type: exitcode-stdio-1.0++  build-depends:+    base,+    hashable >= 1.0.1.1 && < 1.2,+    HUnit,+    test-framework >= 0.3.3 && < 0.6,+    test-framework-hunit,     unordered-containers    ghc-options: -Wall