hashtables 1.2.2.1 → 1.2.3.0
raw patch · 10 files changed
+107/−17 lines, 10 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Data.HashTable.Class: mutateST :: (HashTable h, Eq k, Hashable k) => h s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
+ Data.HashTable.IO: mutateIO :: (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> (Maybe v -> IO (Maybe v, a)) -> IO a
+ Data.HashTable.ST.Basic: instance Data.Semigroup.Semigroup Data.HashTable.ST.Basic.Slot
+ Data.HashTable.ST.Basic: mutateST :: (Eq k, Hashable k) => (HashTable s k v) -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
+ Data.HashTable.ST.Cuckoo: mutateST :: (Eq k, Hashable k) => HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
+ Data.HashTable.ST.Linear: mutateST :: (Eq k, Hashable k) => (HashTable s k v) -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
Files
- benchmark/src/Criterion/Collection/Internal/Types.hs +1/−1
- changelog.md +8/−0
- hashtables.cabal +1/−1
- src/Data/HashTable/Class.hs +6/−0
- src/Data/HashTable/IO.hs +15/−0
- src/Data/HashTable/Internal/Linear/Bucket.hs +17/−4
- src/Data/HashTable/ST/Basic.hs +27/−4
- src/Data/HashTable/ST/Cuckoo.hs +17/−4
- src/Data/HashTable/ST/Linear.hs +14/−2
- test/suite/Data/HashTable/Test/Common.hs +1/−1
benchmark/src/Criterion/Collection/Internal/Types.hs view
@@ -38,7 +38,7 @@ ------------------------------------------------------------------------------ newtype WorkloadMonad a = WM (ReaderT GenIO IO a)- deriving (Monad, MonadIO)+ deriving (Functor, Applicative, Monad, MonadIO) ------------------------------------------------------------------------------
changelog.md view
@@ -1,5 +1,13 @@ # Hashtables changelog +## 1.2.3.0++ - update for Semigroup/monoid breakage with GHC 8.4 (thx Fumiaki Kinoshita)+ + - Implement mutateST and mutateIO (thx Andy Morris)+ + - Fix build breakage w/ "pre" function (thx Andy Morris)+ ## 1.2.2.1 - Adjusted base lower bound (it was incorrect), bumped some testsuite +
hashtables.cabal view
@@ -1,5 +1,5 @@ Name: hashtables-Version: 1.2.2.1+Version: 1.2.3.0 Synopsis: Mutable hash tables in the ST monad Homepage: http://github.com/gregorycollins/hashtables License: BSD3
src/Data/HashTable/Class.hs view
@@ -72,6 +72,12 @@ -- Returns the second part of the tuple returned by /f/. mutate :: (Eq k, Hashable k) => h s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a+ mutate tbl k f = mutateST tbl k (pure . f)++ -- | As 'mutate', except that the action can perform additional side+ -- effects.+ mutateST :: (Eq k, Hashable k) =>+ h s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a -- | Inserts a key/value mapping into a hash table, replacing any existing -- mapping for that key.
src/Data/HashTable/IO.hs view
@@ -48,6 +48,7 @@ , delete , lookup , mutate+ , mutateIO , fromList , fromListWithSizeHint , toList@@ -64,6 +65,7 @@ import Control.Monad.ST (stToIO) import Data.Hashable (Hashable) import qualified Data.HashTable.Class as C+import GHC.IO (ioToST) import Prelude hiding (lookup, mapM_) ------------------------------------------------------------------------------@@ -178,6 +180,19 @@ LinearHashTable k v -> Word -> IO (Maybe (Word,k,v)) #-} {-# SPECIALIZE INLINE nextByIndex :: (Eq k, Hashable k) => CuckooHashTable k v -> Word -> IO (Maybe (Word,k,v)) #-}++------------------------------------------------------------------------------+-- | See the documentation for this function in "Data.HashTable.Class#v:mutateST".+mutateIO :: (C.HashTable h, Eq k, Hashable k) =>+ IOHashTable h k v -> k -> (Maybe v -> IO (Maybe v, a)) -> IO a+mutateIO h k f = stToIO $ C.mutateST h k (ioToST . f)+{-# INLINE mutateIO #-}+{-# SPECIALIZE INLINE mutateIO :: (Eq k, Hashable k) =>+ BasicHashTable k v -> k -> (Maybe v -> IO (Maybe v, a)) -> IO a #-}+{-# SPECIALIZE INLINE mutateIO :: (Eq k, Hashable k) =>+ LinearHashTable k v -> k -> (Maybe v -> IO (Maybe v, a)) -> IO a #-}+{-# SPECIALIZE INLINE mutateIO :: (Eq k, Hashable k) =>+ CuckooHashTable k v -> k -> (Maybe v -> IO (Maybe v, a)) -> IO a #-} ------------------------------------------------------------------------------ -- | See the documentation for this function in "Data.HashTable.Class#v:mutate".
src/Data/HashTable/Internal/Linear/Bucket.hs view
@@ -14,6 +14,7 @@ elemAt, delete, mutate,+ mutateST, toList, fromList, mapM_,@@ -326,9 +327,20 @@ -> k -> (Maybe v -> (Maybe v, a)) -> ST s (Int, Maybe (Bucket s k v), a)-mutate bucketKey !k !f- | keyIsEmpty bucketKey =- case f Nothing of+mutate bucketKey !k !f = mutateST bucketKey k (pure . f)+{-# INLINE mutate #-}+++------------------------------------------------------------------------------+mutateST :: (Eq k) =>+ Bucket s k v+ -> k+ -> (Maybe v -> ST s (Maybe v, a))+ -> ST s (Int, Maybe (Bucket s k v), a)+mutateST bucketKey !k !f+ | keyIsEmpty bucketKey = do+ fRes <- f Nothing+ case fRes of (Nothing, a) -> return (0, Nothing, a) (Just v', a) -> do (!hw', mbk) <- snoc bucketKey k v'@@ -342,7 +354,8 @@ if pos < 0 then return Nothing else readArray values pos >>= return . Just- case (mv, f mv) of+ fRes <- f mv+ case (mv, fRes) of (Nothing, (Nothing, a)) -> return (hw, Nothing, a) (Nothing, (Just v', a)) -> do (!hw', mbk) <- snoc bucketKey k v'
src/Data/HashTable/ST/Basic.hs view
@@ -88,6 +88,7 @@ , lookup , insert , mutate+ , mutateST , mapM_ , foldM , computeOverhead@@ -103,6 +104,9 @@ import qualified Data.Hashable as H import Data.Maybe import Data.Monoid+#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif import qualified Data.Primitive.ByteArray as A import Data.STRef import GHC.Exts@@ -168,6 +172,7 @@ nextByIndex = nextByIndex computeOverhead = computeOverhead mutate = mutate+ mutateST = mutateST ------------------------------------------------------------------------------@@ -304,13 +309,25 @@ ------------------------------------------------------------------------------ -- | See the documentation for this function in--- "Data.HashTable.Class#v:alter".+-- "Data.HashTable.Class#v:mutate". mutate :: (Eq k, Hashable k) => (HashTable s k v) -> k -> (Maybe v -> (Maybe v, a)) -> ST s a-mutate htRef !k !f = do+mutate htRef !k !f = mutateST htRef k (pure . f)+{-# INLINE mutate #-}+++------------------------------------------------------------------------------+-- | See the documentation for this function in+-- "Data.HashTable.Class#v:mutateST".+mutateST :: (Eq k, Hashable k) =>+ (HashTable s k v)+ -> k+ -> (Maybe v -> ST s (Maybe v, a))+ -> ST s a+mutateST htRef !k !f = do ht <- readRef htRef let values = _values ht debug $ "mutate h=" ++ show h@@ -320,7 +337,7 @@ !mv <- if found then fmap Just $ readArray values b1 else return Nothing- let (!mv', !result) = f mv+ (!mv', !result) <- f mv case (mv, mv') of (Nothing, Nothing) -> return () (Just _, Nothing) -> do@@ -337,7 +354,7 @@ where !h = hash k !he = hashToElem h-{-# INLINE mutate #-}+{-# INLINE mutateST #-} ------------------------------------------------------------------------------@@ -488,6 +505,12 @@ ------------------------------------------------------------------------------++#if MIN_VERSION_base(4,9,0)+instance Semigroup Slot where+ (<>) = mappend+#endif+ instance Monoid Slot where mempty = Slot maxBound (Slot x1) `mappend` (Slot x2) =
src/Data/HashTable/ST/Cuckoo.hs view
@@ -69,6 +69,7 @@ , lookup , insert , mutate+ , mutateST , mapM_ , foldM , lookupIndex@@ -135,6 +136,7 @@ nextByIndex = nextByIndex computeOverhead = computeOverhead mutate = mutate+ mutateST = mutateST ------------------------------------------------------------------------------@@ -174,12 +176,22 @@ -> k -> (Maybe v -> (Maybe v, a)) -> ST s a-mutate htRef !k !f = do+mutate htRef !k !f = mutateST htRef k (pure . f)+{-# INLINE mutate #-}+++------------------------------------------------------------------------------+mutateST :: (Eq k, Hashable k) =>+ HashTable s k v+ -> k+ -> (Maybe v -> ST s (Maybe v, a))+ -> ST s a+mutateST htRef !k !f = do ht <- readRef htRef (newHt, a) <- mutate' ht k f writeRef htRef newHt return a-{-# INLINE mutate #-}+{-# INLINE mutateST #-} ------------------------------------------------------------------------------@@ -414,11 +426,12 @@ mutate' :: (Eq k, Hashable k) => HashTable_ s k v -> k- -> (Maybe v -> (Maybe v, a))+ -> (Maybe v -> ST s (Maybe v, a)) -> ST s (HashTable_ s k v, a) mutate' ht@(HashTable sz _ hashes keys values _) !k !f = do !(maybeVal, idx, hashCode) <- lookupSlot- case (maybeVal, f maybeVal) of+ !fRes <- f maybeVal+ case (maybeVal, fRes) of (Nothing, (Nothing, a)) -> return (ht, a) (Just v, (Just v', a)) -> do writeArray values idx v'
src/Data/HashTable/ST/Linear.hs view
@@ -84,6 +84,7 @@ , lookup , insert , mutate+ , mutateST , mapM_ , foldM , computeOverhead@@ -132,6 +133,7 @@ nextByIndex = nextByIndex computeOverhead = computeOverhead mutate = mutate+ mutateST = mutateST ------------------------------------------------------------------------------@@ -228,7 +230,17 @@ -> k -> (Maybe v -> (Maybe v, a)) -> ST s a-mutate htRef k f = do+mutate htRef k f = mutateST htRef k (pure . f)+{-# INLINE mutate #-}+++------------------------------------------------------------------------------+mutateST :: (Eq k, Hashable k) =>+ (HashTable s k v)+ -> k+ -> (Maybe v -> ST s (Maybe v, a))+ -> ST s a+mutateST htRef k f = do (ht, a) <- readRef htRef >>= work writeRef htRef ht return a@@ -236,7 +248,7 @@ work ht@(HashTable lvl splitptr buckets) = do let !h0 = hashKey lvl splitptr k bucket <- readArray buckets h0- (!bsz, mbk, a) <- Bucket.mutate bucket k f+ (!bsz, mbk, a) <- Bucket.mutateST bucket k f maybe (return ()) (writeArray buckets h0) mbk
test/suite/Data/HashTable/Test/Common.hs view
@@ -29,7 +29,7 @@ import Test.HUnit (assertFailure) import Test.QuickCheck (arbitrary, choose, sample')-import Test.QuickCheck.Monadic (PropertyM, assert,+import Test.QuickCheck.Monadic (PropertyM, assert, pre, forAllM, monadicIO, run) ------------------------------------------------------------------------------ import qualified Data.HashTable.Class as C