diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,9 @@ # Changelog for concurrent-hashtable ## Unreleased changes + +## 0.1.7 + +* Added `modify` +* Included `StmContainers.Map` in the benchmarks. +* Haddock updates. diff --git a/benchmark/Main.hs b/benchmark/Main.hs --- a/benchmark/Main.hs +++ b/benchmark/Main.hs @@ -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) ] ] diff --git a/concurrent-hashtable.cabal b/concurrent-hashtable.cabal --- a/concurrent-hashtable.cabal +++ b/concurrent-hashtable.cabal @@ -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 +description: Please see the README on GitHub at . Benchmarks can be found at 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 diff --git a/src/Data/HashTable.hs b/src/Data/HashTable.hs --- a/src/Data/HashTable.hs +++ b/src/Data/HashTable.hs @@ -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 diff --git a/src/Data/HashTable/Internal.hs b/src/Data/HashTable/Internal.hs --- a/src/Data/HashTable/Internal.hs +++ b/src/Data/HashTable/Internal.hs @@ -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 #-}