concurrent-hashtable 0.1.6 → 0.1.7
raw patch · 5 files changed
+66/−12 lines, 5 filesdep +stm-containersPVP ok
version bump matches the API change (PVP)
Dependencies added: stm-containers
API changes (from Hackage documentation)
+ Data.HashTable: modify :: Eq k => HashTable k v -> k -> (v -> v) -> IO Bool
+ Data.HashTable.Internal: modify :: Eq k => HashTable k v -> k -> (v -> v) -> IO Bool
Files
- ChangeLog.md +6/−0
- benchmark/Main.hs +24/−1
- concurrent-hashtable.cabal +5/−4
- src/Data/HashTable.hs +7/−2
- src/Data/HashTable/Internal.hs +24/−5
ChangeLog.md view
@@ -1,3 +1,9 @@ # Changelog for concurrent-hashtable ## Unreleased changes++## 0.1.7++* Added `modify`+* Included `StmContainers.Map` in the benchmarks.+* Haddock updates.
benchmark/Main.hs view
@@ -14,7 +14,8 @@ -- -- The above will run all benchmarks with 10^6 requests split among 32 threads -- and keys chosen from a range 10^4. You need to change the integer after "-N"--- according to the number of cores that you have. Saves the results in files -- --- results-32.html and results-32.csv.+-- according to the number of cores that you have. Saves the results in files+-- results-32.html and results-32.csv. -- ---------------------------------------------------------------------- {-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, AllowAmbiguousTypes #-}@@ -43,9 +44,20 @@ import qualified Data.HashTable as H import qualified Data.IntMap.Strict as M import qualified Data.HashMap.Strict as UO+import qualified StmContainers.Map as SM -- Dictionary data type instances for all the test containers: +newtype STMContainersMap a = STMContainersMap (SM.Map Int a)+instance Dictionary (STMContainersMap Int) Int IO where+ runRequest (Lookup k) (STMContainersMap m) = do+ r <- atomically $ SM.lookup k m+ case r of+ Nothing -> return False+ Just _ -> return True+ runRequest (Insert k a) (STMContainersMap m) = atomically $ SM.insert k a m >> SM.null m+ runRequest (Delete k) (STMContainersMap m) = atomically $ SM.delete k m >> SM.null m+ newtype MVarHashMap a = MVarHashMap (MVar (UO.HashMap Int a)) instance Dictionary (MVarHashMap Int) Int IO where runRequest (Lookup k) (MVarHashMap m) = do@@ -189,6 +201,9 @@ mkMVarMap = MVarHashMap <$> newMVar (UO.empty :: UO.HashMap Int Int) + let mkSTMMap :: IO (STMContainersMap Int)+ mkSTMMap = STMContainersMap <$> SM.newIO+ numProcs <- getNumCapabilities print ("number of available cores: ",numProcs) threadDelay 3000000@@ -272,6 +287,7 @@ , bench "IORef atomic-primops HashMap" $ nfIO (mkIOPrimOpsHashMap >>= evaluate tests_0_50_50) , bench "TVar HashMap" $ nfIO (mkTVarMap >>= evaluate tests_0_50_50) , bench "MVar HashMap" $ nfIO (mkMVarMap >>= evaluate tests_0_50_50)+ , bench "StmContainers.Map" $ nfIO (mkSTMMap >>= evaluate tests_0_50_50) , bench "Concurrent HashTable" $ nfIO (mkCHT >>= evaluate tests_0_50_50) ] , bgroup "20% Lookups; 40% Inserts; 40% Deletes"@@ -281,6 +297,7 @@ , bench "IORef atomic-primops HashMap" $ nfIO (mkIOPrimOpsHashMap >>= evaluate tests_20_40_40) , bench "TVar HashMap" $ nfIO (mkTVarMap >>= evaluate tests_20_40_40) , bench "MVar HashMap" $ nfIO (mkMVarMap >>= evaluate tests_20_40_40)+ , bench "StmContainers.Map" $ nfIO (mkSTMMap >>= evaluate tests_20_40_40) , bench "Concurrent HashTable" $ nfIO (mkCHT >>= evaluate tests_20_40_40) ] , bgroup "40% Lookups; 30% Inserts; 30% Deletes"@@ -290,6 +307,7 @@ , bench "IORef atomic-primops HashMap" $ nfIO (mkIOPrimOpsHashMap >>= evaluate tests_40_30_30) , bench "TVar HashMap" $ nfIO (mkTVarMap >>= evaluate tests_40_30_30) , bench "MVar HashMap" $ nfIO (mkMVarMap >>= evaluate tests_40_30_30)+ , bench "StmContainers.Map" $ nfIO (mkSTMMap >>= evaluate tests_40_30_30) , bench "Concurrent HashTable" $ nfIO (mkCHT >>= evaluate tests_40_30_30) ] , bgroup "50% Lookups; 25% Inserts; 25% Deletes"@@ -299,6 +317,7 @@ , bench "IORef atomic-primops HashMap" $ nfIO (mkIOPrimOpsHashMap >>= evaluate tests_50_25_25) , bench "TVar HashMap" $ nfIO (mkTVarMap >>= evaluate tests_50_25_25) , bench "MVar HashMap" $ nfIO (mkMVarMap >>= evaluate tests_50_25_25)+ , bench "StmContainers.Map" $ nfIO (mkSTMMap >>= evaluate tests_50_25_25) , bench "Concurrent HashTable" $ nfIO (mkCHT >>= evaluate tests_50_25_25) ] , bgroup "60% Lookups; 20% Inserts; 20% Deletes"@@ -308,6 +327,7 @@ , bench "IORef atomic-primops HashMap" $ nfIO (mkIOPrimOpsHashMap >>= evaluate tests_60_20_20) , bench "TVar HashMap" $ nfIO (mkTVarMap >>= evaluate tests_60_20_20) , bench "MVar HashMap" $ nfIO (mkMVarMap >>= evaluate tests_60_20_20)+ , bench "StmContainers.Map" $ nfIO (mkSTMMap >>= evaluate tests_60_20_20) , bench "Concurrent HashTable" $ nfIO (mkCHT >>= evaluate tests_60_20_20) ] , bgroup "70% Lookups; 15% Inserts; 15% Deletes"@@ -317,6 +337,7 @@ , bench "IORef atomic-primops HashMap" $ nfIO (mkIOPrimOpsHashMap >>= evaluate tests_70_15_15) , bench "TVar HashMap" $ nfIO (mkTVarMap >>= evaluate tests_70_15_15) , bench "MVar HashMap" $ nfIO (mkMVarMap >>= evaluate tests_70_15_15)+ , bench "StmContainers.Map" $ nfIO (mkSTMMap >>= evaluate tests_70_15_15) , bench "Concurrent HashTable" $ nfIO (mkCHT >>= evaluate tests_70_15_15) ] , bgroup "80% Lookups; 10% Inserts; 10% Deletes"@@ -326,6 +347,7 @@ , bench "IORef atomic-primops HashMap" $ nfIO (mkIOPrimOpsHashMap >>= evaluate tests_80_10_10) , bench "TVar HashMap" $ nfIO (mkTVarMap >>= evaluate tests_80_10_10) , bench "MVar HashMap" $ nfIO (mkMVarMap >>= evaluate tests_80_10_10)+ , bench "StmContainers.Map" $ nfIO (mkSTMMap >>= evaluate tests_80_10_10) , bench "Concurrent HashTable" $ nfIO (mkCHT >>= evaluate tests_80_10_10) ] , bgroup "90% Lookups; 5% Inserts; 5% Deletes"@@ -335,6 +357,7 @@ , bench "IORef atomic-primops HashMap" $ nfIO (mkIOPrimOpsHashMap >>= evaluate tests_90_5_5) , bench "TVar HashMap" $ nfIO (mkTVarMap >>= evaluate tests_90_5_5) , bench "MVar HashMap" $ nfIO (mkMVarMap >>= evaluate tests_90_5_5)+ , bench "StmContainers.Map" $ nfIO (mkSTMMap >>= evaluate tests_90_5_5) , bench "Concurrent HashTable" $ nfIO (mkCHT >>= evaluate tests_90_5_5) ] ]
concurrent-hashtable.cabal view
@@ -4,12 +4,12 @@ -- -- see: https://github.com/sol/hpack ----- hash: 52facc0875c55e5699c89da7fd34cc82941cf1e89d804012a77d6332ee3e712e+-- hash: 0e6ba310bf66a8401f71fdaaa4ffa5e4639795300dafe5a4e400ce91834dad4d name: concurrent-hashtable-version: 0.1.6+version: 0.1.7 synopsis: Thread-safe hash tables for multi-cores!-description: Please see the README on GitHub at <https://github.com/pwrobinson/concurrent-hashtable#readme>+description: Please see the README on GitHub at <https://github.com/pwrobinson/concurrent-hashtable#readme>. Benchmarks can be found at <https://lowerbound.io/blog/2019-10-24_concurrent_hash_table_performance.html> category: Concurrency homepage: https://github.com/pwrobinson/concurrent-hashtable#readme bug-reports: https://github.com/pwrobinson/concurrent-hashtable/issues@@ -74,7 +74,7 @@ Paths_concurrent_hashtable hs-source-dirs: benchmark- ghc-options: -threaded -rtsopts -with-rtsopts=-N -eventlog -O2+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 build-depends: async >=2.2.2 && <3 , atomic-primops >=0.8.3 && <2@@ -86,6 +86,7 @@ , hashable >=1.2.7.0 && <2 , random >=1.1 && <2 , stm >=2.4.5.1 && <3+ , stm-containers , unordered-containers >=0.2.10.0 && <1 , vector >=0.12.0.3 && <1 default-language: Haskell2010
src/Data/HashTable.hs view
@@ -19,28 +19,33 @@ -- >> atomically $ readAssocs ht -- convert to a key-value list -- > [(1,"hello"),(2,"world")] -- >> readSizeIO ht -- returns 4--- >> insert ht 3 "!" -- adds key-value pair (3,"!") and triggers a resize as the load fraction is ≥ 0.75+-- >> insert ht 3 "!" -- adds key-value pair (3,"!") and triggers a resize since load/size is ≥ 0.75 -- >> readSizeIO ht -- returns 8 -- >> atomically $ readAssocs ht -- convert to a key-value list -- > [(1,"hello"),(3,"!"),(2,"world")] -- -- List of atomic operations:--- 'insert', 'insertIfNotExists', 'update', 'lookup', 'delete', 'readAssocs', 'resize'+-- 'insert', 'insertIfNotExists', 'update', 'modify', 'lookup', 'delete', 'readAssocs', 'resize' -- ---------------------------------------------------------------------- module Data.HashTable(+ -- * Data Type HashTable, Chain,+ -- * Construction new, newWithDefaults, mkDefaultConfig, Config(..),+ -- * Atomic Operations lookup, insert, insertIfNotExists, update,+ modify, delete,+ -- * Utilities readAssocs, readSizeIO, readSize
src/Data/HashTable/Internal.hs view
@@ -68,7 +68,7 @@ -- | Default configuration: scale factor = 2.0; resizing threshold = 0.75; -- number of worker threads for resizing = 'getNumCapabilities';--- hash function = use 'hashWithSalt' with a random salt+-- hash function = use 'hashWithSalt' with a random salt. mkDefaultConfig :: Hashable k => IO (Config k) mkDefaultConfig = do numCPUs <- getNumCapabilities@@ -98,7 +98,7 @@ -> IO (HashTable k v) newWithDefaults size = mkDefaultConfig >>= new size --- | Returns the size of the vector representing the hash table.+-- | Returns the size of the vector representing the hash table. (Atomic) {-# INLINABLE readSizeIO #-} readSizeIO :: HashTable k v -> IO Int readSizeIO ht = do@@ -175,10 +175,10 @@ return $ L.lookup k list --- | Used internally. An action to be executed atomically for the given chain.+-- | An action to be executed atomically for the chain (list) stored at a specific table idnex. Used by 'genericModify'. type STMAction k v a = TVar [(k,v)] -> STM (Maybe a) --- | Used internally by 'insert', 'insertIfNotExists', 'delete', 'update'+-- | Used by 'insert', 'insertIfNotExists', 'delete', and 'update'. genericModify :: (Eq k) => HashTable k v -> k -- ^ key@@ -212,6 +212,7 @@ writeTVar tvar ((k,v):list) return $ Just True Just _ -> do -- entry was already there, so we overwrite it+ -- Moves the most-recently modified item to the front: writeTVar tvar ((k,v) : deleteFirstKey k list) return $ Just False when result $@@ -243,7 +244,7 @@ -> k -- ^ key -> v -- ^ value -> IO Bool-update htable k v = +update htable k v = genericModify htable k $ \tvar -> do list <- readTVar tvar case L.lookup k list of@@ -254,6 +255,22 @@ return $ Just True +-- | Applies an update-function to the value for key `k`. If `k` is not in the hash table, it just returns `False`.+modify :: (Eq k)+ => HashTable k v+ -> k -- ^ key+ -> (v -> v) -- ^ update-function+ -> IO Bool+modify htable k f =+ genericModify htable k $ \tvar -> do+ list <- readTVar tvar+ case L.lookup k list of+ Nothing -> do+ return $ Just False+ Just v -> do -- entry was already there, so we overwrite it+ writeTVar tvar ((k,f v) : deleteFirstKey k list)+ return $ Just True+ -- | Deletes the entry for the given key from the hash table. Returns `True` if and only if an entry was deleted from the table. delete :: (Eq k) => HashTable k v@@ -304,10 +321,12 @@ msum <$> mapM getItemsForChain [0..len-1] +-- | Takes a key `k` and an assocation list `ys`, and deletes the first entry with key `k` in `ys`. Used internally. {-# INLINABLE deleteFirstKey #-} deleteFirstKey :: Eq a => a -> [(a,b)] -> [(a,b)] deleteFirstKey _ [] = [] deleteFirstKey x (y:ys) = if x == fst y then ys else y : deleteFirstKey x ys+ -- | Atomically read the chain for the given key. {-# INLINABLE readChainForKeyIO #-}