diff --git a/Control/Concurrent/Map.hs b/Control/Concurrent/Map.hs --- a/Control/Concurrent/Map.hs +++ b/Control/Concurrent/Map.hs @@ -96,7 +96,8 @@ -- | /O(log n)/. Associate the given value with the given key. -- If the key is already present in the map, the old value is replaced. -insert :: (Eq k, Hashable k) => k -> v -> Map k v -> IO () +-- Returns 'True' if the value was inserted, 'False' if it was replaced. +insert :: (Eq k, Hashable k) => k -> v -> Map k v -> IO Bool insert k v (Map root) = go0 where h = hash k @@ -112,21 +113,24 @@ then do let arr' = A.insert (SNode (S k v)) i n arr cn' = CNode (bmp .|. m) arr' - unlessM (fst <$> casIORef inode ticket cn') go0 + success <- fst <$> casIORef inode ticket cn' + if success then return True else go0 else case A.index arr i of SNode (S k2 v2) | k == k2 -> do let arr' = A.update (SNode (S k v)) i n arr cn' = CNode bmp arr' - unlessM (fst <$> casIORef inode ticket cn') go0 + success <- fst <$> casIORef inode ticket cn' + if success then return False else go0 | otherwise -> do let h2 = hash k2 inode2 <- newINode h k v h2 k2 v2 (nextLevel lev) let arr' = A.update (INode inode2) i n arr cn' = CNode bmp arr' - unlessM (fst <$> casIORef inode ticket cn') go0 + success <- fst <$> casIORef inode ticket cn' + if success then return False else go0 INode inode2 -> go (nextLevel lev) inode inode2 @@ -135,13 +139,18 @@ Collision arr -> do let arr' = S k v : filter (\(S k2 _) -> k2 /= k) arr col' = Collision arr' - unlessM (fst <$> casIORef inode ticket col') go0 + success <- fst <$> casIORef inode ticket col' + if success + then return $ not $ any (\(S k2 _) -> k2 == k) arr + else go0 {-# INLINABLE insert #-} + -- | /O(log n)/. Associate the given value with the given key. -- If the key is already present in the map, don't change the value. -insertIfAbsent :: (Eq k, Hashable k) => k -> v -> Map k v -> IO () +-- Returns 'True' if the value was inserted, 'False' otherwise. +insertIfAbsent :: (Eq k, Hashable k) => k -> v -> Map k v -> IO Bool insertIfAbsent k v (Map root) = go0 where h = hash k @@ -157,30 +166,33 @@ then do let arr' = A.insert (SNode (S k v)) i n arr cn' = CNode (bmp .|. m) arr' - unlessM (fst <$> casIORef inode ticket cn') go0 + success <- fst <$> casIORef inode ticket cn' + if success then return True else go0 else case A.index arr i of SNode (S k2 v2) - | k == k2 -> return () + | k == k2 -> return False | otherwise -> do let h2 = hash k2 inode2 <- newINode h k v h2 k2 v2 (nextLevel lev) let arr' = A.update (INode inode2) i n arr cn' = CNode bmp arr' - unlessM (fst <$> casIORef inode ticket cn') go0 + success <- fst <$> casIORef inode ticket cn' + if success then return True else go0 INode inode2 -> go (nextLevel lev) inode inode2 Tomb _ -> clean parent (prevLevel lev) >> go0 - Collision arr -> + Collision arr -> if any (\(S k2 _) -> k2 == k) arr - then return () + then return False else do let arr' = S k v : filter (\(S k2 _) -> k2 /= k) arr col' = Collision arr' - unlessM (fst <$> casIORef inode ticket col') go0 + success <- fst <$> casIORef inode ticket col' + if success then return True else go0 {-# INLINABLE insertIfAbsent #-} @@ -201,7 +213,8 @@ -- | /O(log n)/. Remove the given key and its associated value from the map, -- if present. -delete :: (Eq k, Hashable k) => k -> Map k v -> IO () +-- Returns 'True' if the value was deleted, 'False' otherwise. +delete :: (Eq k, Hashable k) => k -> Map k v -> IO Bool delete k (Map root) = go0 where h = hash k @@ -213,18 +226,20 @@ let m = mask h lev i = sparseIndex bmp m if bmp .&. m == 0 - then return () -- not found + then return False -- not found else case A.index arr i of SNode (S k2 _) | k == k2 -> do let arr' = A.delete i (popCount bmp) arr cn' = CNode (bmp `xor` m) arr' cn'' = contract lev cn' - unlessM (fst <$> casIORef inode ticket cn'') go0 + success <- fst <$> casIORef inode ticket cn'' + result <- if success then return True else go0 whenM (isTomb <$> readIORef inode) $ cleanParent parent inode h (prevLevel lev) + return result - | otherwise -> return () -- not found + | otherwise -> return False -- not found INode inode2 -> go (nextLevel lev) inode inode2 @@ -234,7 +249,8 @@ let arr' = filter (\(S k2 _) -> k2 /= k) $ arr col' | [s] <- arr' = Tomb s | otherwise = Collision arr' - unlessM (fst <$> casIORef inode ticket col') go0 + success <- fst <$> casIORef inode ticket col' + if success then return True else go0 {-# INLINABLE delete #-} diff --git a/benchmarks/Concurrent.hs b/benchmarks/Concurrent.hs --- a/benchmarks/Concurrent.hs +++ b/benchmarks/Concurrent.hs @@ -75,7 +75,7 @@ mkElems :: Int -> Int -> Int -> IO [[Int]] mkElems t o n = return $ [take o $ randomRs (0, n-1) (mkStdGen s) | s <- [1..t]] -runOps :: (k -> IO ()) -> [[k]] -> IO () +runOps :: (k -> IO a) -> [[k]] -> IO () runOps f elems = mapM_ wait =<< mapM (async . sequence_ . map f) elems ----------------------------------------------------------------------- diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,10 +1,17 @@ -# 0.1.1.0 (April 2016) - * Add insertIfAbsent (https://github.com/mcschroeder/ctrie/pull/2) +0.2 (September 2017) +-------------------- +* Change return types of `insertIfAbsent`, `insert` and `delete` to indicate whether or not a value has been inserted/deleted. This is a breaking change, but it should be trivial to adapt your code. There are no changes in performance. Thanks to Tom Shackell for proposing this change. -# 0.1.0.3 (December 2015) - * Eliminate a redundant import warning on GHC 7.10 - * Loosen dependency bounds +0.1.1.0 (April 2016) +-------------------- +* Add `insertIfAbsent` (https://github.com/mcschroeder/ctrie/pull/2) -# 0.1.0.2 (October 2014) - * Use newer versions of base and atomic-primops - * Update benchmarks for criterion 1.0 +0.1.0.3 (December 2015) +----------------------- +* Eliminate a redundant import warning on GHC 7.10 +* Loosen dependency bounds + +0.1.0.2 (October 2014) +----------------------- +* Use newer versions of `base` and `atomic-primops` +* Update benchmarks for `criterion 1.0` diff --git a/ctrie.cabal b/ctrie.cabal --- a/ctrie.cabal +++ b/ctrie.cabal @@ -1,5 +1,5 @@ name: ctrie -version: 0.1.1.0 +version: 0.2 synopsis: Non-blocking concurrent map description: A non-blocking concurrent map implementation based on @@ -10,7 +10,7 @@ maintainer: mc.schroeder@gmail.com homepage: https://github.com/mcschroeder/ctrie bug-reports: https://github.com/mcschroeder/ctrie/issues -copyright: (c) 2013-2016 Michael Schröder +copyright: (c) 2013-2017 Michael Schröder category: Concurrency, Data Structures build-type: Simple cabal-version: >=1.8 diff --git a/tests/MapProperties.hs b/tests/MapProperties.hs --- a/tests/MapProperties.hs +++ b/tests/MapProperties.hs @@ -42,11 +42,11 @@ assert $ a == b eq_ :: (Eq k, Eq v, Hashable k, Ord k) - => (Model k v -> Model k v) -> (CM.Map k v -> IO ()) -> [(k, v)] -> Property + => (Model k v -> Model k v) -> (CM.Map k v -> IO a) -> [(k, v)] -> Property eq_ f g xs = monadicIO $ do let a = M.toAscList $ f $ M.fromList xs m <- run $ CM.fromList xs - run $ g m + run $ void $ g m b <- run $ unsafeToAscList m assert $ a == b