concurrent-hashtable 0.1.1 → 0.1.2

raw patch · 4 files changed

+28/−48 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +4/−0
• concurrent-hashtable.cabal +2/−2
• src/Data/HashTable/Internal.hs +18/−33
• test/Spec.hs +4/−13

@@ -1,3 +1,7 @@ # A thread-safe hash table for multi-cores  You can find benchmarks and more information about the internals of this package [here](https://lowerbound.io/blog/2019-10-24_concurrent_hash_table_performance.html).++## Installation++> stack install

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f8119720fafe38e62a12ec4438f8fac609ac78976b248f0ecb39515f8edaf064+-- hash: dfbcbe83f4c3c52e2cf5b9e2db5e3898ada41cfbaf1f37a912b4cdd634a4bc05  name:           concurrent-hashtable-version:        0.1.1+version:        0.1.2 synopsis:       Thread-safe hash tables for multi-cores! description:    Please see the README on GitHub at <https://github.com/pwrobinson/concurrent-hashtable#readme> category:       Concurrency

@@ -9,6 +9,9 @@ -- Portability :  non-portable (requires concurrency, stm) -- -- You can find benchmarks and more information about the internals of this package here:  <https://lowerbound.io/blog/2019-10-24_concurrent_hash_table_performance.html>+--+-- List of atomic operations:+-- /insert/, /insertIfNotExists/, /lookup/, /delete/, /getAssocs/, /resize/ ---------------------------------------------------------------------- {-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables #-} module Data.HashTable.Internal@@ -23,7 +26,6 @@ import Control.Monad import Data.Hashable import System.Random-import System.IO.Unsafe import Data.Maybe import qualified Data.List as L import Data.Vector(Vector,(!))@@ -41,6 +43,7 @@     }     deriving (Eq) +newChainIO :: IO (Chain k v) newChainIO =     Chain <$> newTVarIO []           <*> newTVarIO NotStarted@@ -104,14 +107,8 @@     chainsVec <- readTVarIO $ _chainsVecTV ht     return $ V.length chainsVec --- | Returns the size of the vector representing the hash table.-{-# INLINABLE readSize #-}-readSize :: HashTable k v -> STM Int-readSize ht = do-    chainsVec <- readTVar $ _chainsVecTV ht-    return $ V.length chainsVec--- | Resizes the hash table by scaling it according to the _scaleFactor in the configuration. +-- | Resizes the hash table by scaling it according to the _scaleFactor in the configuration. resize :: (Eq k)        => HashTable k v -> IO () resize ht = do@@ -128,7 +125,6 @@         size2 <- readSizeIO ht         return (hasStarted || (size1 /= size2))     unless alreadyResizing $ do-        let lists = V.toList chainsVec         let oldSize = V.length chainsVec         let numWorkers = _numResizeWorkers $ _config ht         let numSlices = min numWorkers (oldSize `div` numWorkers)@@ -158,20 +154,16 @@         debug "woke up blocked threads..."     where         migrate newVec newSize chain = do-            let idx = 0-            -- debug ("starting to copy nodes of list # ",idx)             atomically $ writeTVar (_migrationStatusTV chain) Ongoing-            -- debug ("updated list status # ",idx)             listOfNodes <- readTVarIO (_itemsTV chain)-            -- debug ("done copying nodes of list # ",idx)             sequence_ [ do let newIndex = (_hashFunc (_config ht) k) `mod` newSize                            let newChain = newVec ! newIndex                            newList <- readTVarIO (_itemsTV newChain)                            atomically $                                writeTVar (_itemsTV newChain) ((k,v):newList)                       | (k,v) <- listOfNodes ]-            -- debug ("finished migrate for list ",idx) +                       -- | Lookup the value for the key in the hash table if it exists. {-# INLINABLE lookup #-} lookup :: (Eq k) => HashTable k v -> k -> IO (Maybe v)@@ -203,7 +195,7 @@         Nothing -> genericModify htable k stmAction         Just v  -> return v -+-- | Inserts the key-value pair `k` `v` into the hash table. Uses chain hashing to resolve collisions. insert :: (Eq k)        => HashTable k v        -> k -- ^ key@@ -219,12 +211,9 @@                     Just _  -> do -- entry was already there, so we overwrite it                         writeTVar tvar ((k,v) : deleteFirstKey k list)                         return $ Just False-    if result then do+    when result $         atomicallyChangeLoad htable 1-        return True-    else-        return False-+    return result   -- | Inserts a key and value pair into the hash table only if the key does not exist yet. Returns 'True' if the insertion was successful, i.e., the hash table did not contain this key before. To get the same behaviour as 'Data.Map.insert', use 'insert'. If you want to update an entry only if it exists, use 'update'.@@ -241,11 +230,9 @@                         writeTVar tvar ((k,v):list)                         return $ Just True                     Just _  -> return $ Just False-    if result then do+    when result $         atomicallyChangeLoad htable 1-        return True-    else-        return False+    return result  -- | 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)@@ -261,11 +248,9 @@                     Just _  -> do                         writeTVar tvar $ deleteFirstKey k list                         return $ Just True-    if result then do+    when result $         atomicallyChangeLoad htable (-1)-        return True-    else-        return False+    return result  -- | Atomically increment/decrement the table load value by adding the provided integer value to the current value. atomicallyChangeLoad :: (Eq k)@@ -292,14 +277,14 @@     let getItemsForChain k = do             chain <- readChainForIndex htable k             readTVar (_itemsTV chain)-    msum <$> mapM getItemsForChain [ k | k <- [0..len-1]]+    msum <$> mapM getItemsForChain [0..len-1]  {-# 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 --- | Read the chain for the given key.+-- | Atomically read the chain for the given key. {-# INLINABLE readChainForKeyIO #-} readChainForKeyIO :: HashTable k v -> k -> IO (Chain k v) readChainForKeyIO htable k = do@@ -308,14 +293,14 @@     let index = (_hashFunc (_config htable) k) `mod` size     return $ chainsVec ! index --- | Read the chain for the given index (warning: bounds are not checked)+-- | Atomically read the chain for the given index. (Warning: bounds are not checked.) {-# INLINABLE readChainForIndexIO #-} readChainForIndexIO :: HashTable k v -> Int -> IO (Chain k v) readChainForIndexIO htable idx = do     chainsVec <- readTVarIO $ _chainsVecTV htable     return $ chainsVec ! idx --- | Get the chain for the given index (warning: bounds are not checked)+-- | Atomically read the chain for the given index. (Warning: bounds are not checked.) {-# INLINABLE readChainForIndex #-} readChainForIndex :: HashTable k v -> Int -> STM (Chain k v) readChainForIndex htable idx = do@@ -324,7 +309,7 @@  {-# INLINABLE debug #-} debug :: Show a => a -> IO ()-debug a = return () {- do+debug _ = return () {- do     -- tid <- myThreadId     -- print a     -- appendFile ("thread" ++ show tid) (show a) -}

@@ -8,8 +8,7 @@ import qualified Data.Map.Strict as M import Test.QuickCheck         as QC import Test.QuickCheck.Monadic as QC-import Prelude hiding (lookup,elems)-import System.IO+import Prelude hiding (lookup) import qualified Data.Set as Set  import qualified Data.HashTable as H@@ -17,7 +16,6 @@ import Data.Hashable import Data.Dictionary import Data.Dictionary.Request-import qualified Data.Vector as V  hasDuplicates :: (Ord a) => [a] -> Bool hasDuplicates list = length list /= length set@@ -77,25 +75,18 @@     runRequest (Update k a) s = H.insert s k a     runRequest (Delete k) s = H.delete s k -instance (QC.Arbitrary k) => QC.Arbitrary (Request k) where-    arbitrary = QC.oneof-        [ Insert <$> QC.arbitrary <*> QC.arbitrary-        , Lookup <$> QC.arbitrary-        , Delete <$> QC.arbitrary-        ]  prop :: IORef TestMap -> TestChainHashTable -> Property prop ioref chainTable = monadicIO $ do     (r :: Request BoundedInt) <- pick arbitrary     run $ appendFile "request_sequence.txt" (show r ++ "\n")-    run $ runRequest r ioref-    run $ runRequest r chainTable+    run $ void (runRequest r ioref >> runRequest r chainTable)      mapAssocs <- run ( M.assocs <$> readIORef ioref)     -- test if all entries in the Map are also in the Hash Table:     resChain <- run $ sequence-                    [ do r <-  H.lookup chainTable k-                         return $ (isJust r) && (fromJust r == a)+                    [ do res <-  H.lookup chainTable k+                         return $ (isJust res) && (fromJust res == a)                     | (k,a) <- mapAssocs ]     list2 <- run $ atomically $ H.getAssocs chainTable     -- test if there aren't any duplicates in the Hash Table: