swisstable 0.1.0.2 → 0.1.0.3
raw patch · 7 files changed
+211/−150 lines, 7 filesdep +weighdep ~primitivePVP ok
version bump matches the API change (PVP)
Dependencies added: weigh
Dependency ranges changed: primitive
API changes (from Hackage documentation)
Files
- README.md +14/−0
- bench/Main.hs +0/−1
- space/Main.hs +26/−0
- src/Data/HashTable/ST/Swiss.hs +13/−11
- swisstable.cabal +25/−6
- test/Test/Basic.hs +0/−132
- test/Test/Data/HashTable/ST/Swiss.hs +133/−0
README.md view
@@ -5,9 +5,12 @@ ## links - [Hackage](https://hackage.haskell.org/package/swisstable-0.1.0.1)+- [Instance definition of Data.HashTable.Class](https://github.com/nakaji-dayo/hs-swisstable-hashtables-class) ## Benchmark snapshot +### time+ 15564c4 ``` benchmarking lookup(seq)/small/SwissTable@@ -45,4 +48,15 @@ 1.000 R² (1.000 R² .. 1.000 R²) mean 1.321 ms (1.319 ms .. 1.322 ms) std dev 5.360 μs (4.111 μs .. 6.704 μs)+```++### space++8557655+```+Case Allocated GCs+Swiss.insert 362,035,256 314+Data.HashTable.ST.Basic.insert 192,201,784 108+Swiss.insert sized 162,891,112 140+Data.HashTable.ST.Basic.insert sized 152,675,336 94 ```
bench/Main.hs view
@@ -2,7 +2,6 @@ module Main where import Control.DeepSeq-import Control.DeepSeq (NFData) import Control.Monad import Criterion import Criterion.Main
+ space/Main.hs view
@@ -0,0 +1,26 @@+module Main where++import Control.DeepSeq+import qualified Data.HashTable.IO as H+import Data.HashTable.IO.Swiss hiding (fildM, mapM_)+import qualified Data.HashTable.ST.Basic+import qualified Data.HashTable.ST.Swiss as S+import Weigh++ssize = 1000000++main =+ mainWith $ do+ io "Swiss.insert" (testInsert new insert) ssize+ io "Data.HashTable.ST.Basic.insert" (testInsert (H.new :: IO (H.BasicHashTable Int Int)) H.insert) ssize+ io "Swiss.insert sized" (testInsert (newSized (2^21)) insert) ssize+ io "Data.HashTable.ST.Basic.insert sized" (testInsert (H.newSized (2^21) :: IO (H.BasicHashTable Int Int)) H.insert) ssize++testInsert new insert size = do+ t <- new+ mapM_ (\x -> insert t x x) ([1..size] :: [Int])+ pure t++instance NFData (Data.HashTable.ST.Basic.HashTable s k v) where+ rnf x = seq x ()+instance NFData (S.Table s k v)
src/Data/HashTable/ST/Swiss.hs view
@@ -98,6 +98,7 @@ iterateCtrlIdx (f (mutablePrimArrayContents ctrl) size elems ctrl) size (mask .&. h1') modifySTRef' used (+ 1) checkOverflow m >>= \x -> when x $ grow ref+ pure () where f !ptr !size !elems !ctrl !idx = do let !pc = PP.advancePtr ptr idx@@ -158,7 +159,7 @@ {-# INLINE listBitmaskSet #-} iterateBitmaskSet :: Monad m => (Int -> m (Maybe a)) -> Word32 -> m (Maybe a)-iterateBitmaskSet !f !mask = do+iterateBitmaskSet f !mask = do let bitidxs = listBitmaskSet mask go bitidxs where@@ -248,23 +249,23 @@ writeRef ref =<< readRef t' pure () where- f t (k, v) = insert t k v+ f t (!k, !v) = rawInsert (hash k) t k v mapM_ :: ((k, v) -> ST s a) -> Table s k v -> ST s () mapM_ f ref = do t <- readRef ref let idx = 0- void $ iterateCtrlIdx (h t) (size t) idx+ void $ iterateCtrlIdx (h (mutablePrimArrayContents (ctrl t)) t) (size t) idx where- g t idx bidx = do+ g elms !idx !bidx = do let idx' = idx + bidx - 1- e <- readArray (elems t) idx'+ !e <- readArray elms idx' void $ f e pure Nothing- h t idx = do- let pc = PP.advancePtr (mutablePrimArrayContents (ctrl t)) idx+ h ptr t !idx = do+ let pc = PP.advancePtr ptr idx let mask = cElmAddMovemask 128 pc- r <- iterateBitmaskSet (g t idx) mask+ r <- iterateBitmaskSet (g (elems t) idx) mask if idx + 32 > size t then pure (Just Nothing) else pure r foldM :: (a -> (k,v) -> ST s a) -> a -> Table s k v -> ST s a@@ -323,14 +324,15 @@ mutateST' :: (Eq k, Hashable k) => (k -> Int) -> Table s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a mutateST' h ref k f = do- t <- readRef ref let !h1' = h1 h k lookup'' h1' ref k >>= \case Just (v, idx) -> f (Just v) >>= \case- (Just v', a) -> -- update+ (Just v', a) -> do -- update+ t <- readRef ref writeArray (elems t) idx (k, v') >> pure a- (Nothing, a) -> --delete+ (Nothing, a) -> do--delete+ t <- readRef ref deleteIdx t idx >> pure a Nothing -> f Nothing >>= \case
swisstable.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 5fef574e1937b884f6bad8ceedf9e2b80334d6db31ecd33f899c1aab7643f6c5+-- hash: 3ef14fa03a61f138cc4f0c33f762ab65d32e97c4397ce2e3af5c587e8b506ecb name: swisstable-version: 0.1.0.2+version: 0.1.0.3 synopsis: SwissTable hash map description: Please see the README on GitHub at <https://github.com/nakaji-dayo/hs-swisstable#readme> category: Data@@ -43,7 +43,7 @@ build-depends: base >=4.7 && <5 , hashable- , primitive+ , primitive >=0.7.1.0 , vector default-language: Haskell2010 @@ -51,7 +51,7 @@ type: exitcode-stdio-1.0 main-is: Spec.hs other-modules:- Test.Basic+ Test.Data.HashTable.ST.Swiss Paths_swisstable hs-source-dirs: test@@ -60,7 +60,7 @@ QuickCheck , base >=4.7 && <5 , hashable- , primitive+ , primitive >=0.7.1.0 , swisstable , tasty , tasty-discover@@ -83,7 +83,26 @@ , deepseq , hashable , hashtables- , primitive+ , primitive >=0.7.1.0 , swisstable , vector+ default-language: Haskell2010++benchmark swisstable-space+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Paths_swisstable+ hs-source-dirs:+ space+ ghc-options: -O2+ build-depends:+ base >=4.7 && <5+ , deepseq+ , hashable+ , hashtables+ , primitive >=0.7.1.0+ , swisstable+ , vector+ , weigh default-language: Haskell2010
− test/Test/Basic.hs
@@ -1,132 +0,0 @@-module Test.Basic where--import Prelude hiding (lookup)--import Control.Monad-import Data.HashTable.IO.Swiss hiding (foldM, mapM_)-import qualified Data.HashTable.IO.Swiss as S-import Test.Tasty-import Test.Tasty.HUnit--import Control.Monad.ST (stToIO)-import Data.Primitive.Array as A-import Data.Primitive.PrimArray-import Test.QuickCheck (Gen, generate, vector)---unit_insertAndLookup :: IO ()-unit_insertAndLookup = do- let ks = ["A", "Z", "C", "Y", "E", "X", "G", "W"]- ref <- new- mapM_ (\k -> insert ref k k) ks- forM_ ks $ \k -> do- h <- lookup ref k- Just k @=? h--unit_insertAndLookup_rand :: IO ()-unit_insertAndLookup_rand = do- ks <- generate (vector 1000 :: Gen [Int])- ref <- new- mapM_ (\k -> insert ref k k) ks- forM_ ks $ \k -> do- h <- lookup ref k- Just k @=? h--unit_insert_conflict :: IO ()-unit_insert_conflict = do- let ks = ["head", "Z", "C", "last"]- t <- newSized 8- mapM_ (\x -> insert' h t x x) ks- forM_ ks $ \k -> do- h <- lookup' h t k- Just k @=? h- where- h = const 0--unit_insert_right_overflow :: IO ()-unit_insert_right_overflow = do- let ks = ["head", "Z", "C", "last"]- t <- newSized 8- mapM_ (\x -> insert' h t x x) ks- forM_ ks $ \k -> do- h <- lookup' h t k- Just k @=? h- where- h = const 7---- 一旦deleteでごまかす--- vのswapできるようにすべき-unit_update :: IO ()-unit_update = do- let ks = take 5 $ repeat "A"- t <- newSized 4- mapM_ (\x -> insert t x x) ks- s <- getSize t- 4 @=? s--unit_lookup_nothing_conflict :: IO ()-unit_lookup_nothing_conflict = do- let ks = ["A", "B", "C", "D"]- t <- new- mapM_ (\x -> insert' h t x x) ks- h <- lookup' h t "X"- h @=? Nothing- where- h = const 7--unit_lookup_nothing :: IO ()-unit_lookup_nothing = do- let ks = ["A", "B", "C", "D"]- t <- new- mapM_ (\x -> insert t x x) ks- h <- lookup t "X"- h @=? Nothing--unit_grow_rehash :: IO ()-unit_grow_rehash = do- let ks = ["A","Z", "C", "Y", "E", "X", "G", "W", "ab", "cd", "ef", "gh", "xx"]- t <- newSized 8- mapM_ (\k -> insert t k k) ks- forM_ ks $ \k -> do- h <- lookup t k- Just k @=? h--unit_grow_rehash2 :: IO ()-unit_grow_rehash2 = do- let ks = [0..99::Int]- t <- newSized 8- mapM_ (\k -> insert t k k) ks- forM_ ks $ \k -> do- h <- lookup t k- Just k @=? h--unit_delete :: IO ()-unit_delete = do- let ks = ["A","B", "C"]- t <- new- mapM_ (\k -> insert t k k) ks- delete t "B"- h <- lookup t "B"- h @=? Nothing- h <- lookup t "C"- h @=? Just "C"--unit_foldM :: IO ()-unit_foldM = do- let ks = ["A","B", "C"]- t <- new- mapM_ (\k -> insert t k k) ks- x <- S.foldM (\acc (k, _) -> pure (acc ++ k)) "" t- "ABC" @=? x--unit_mutate :: IO ()-unit_mutate = do- let ks = ["A","B", "C"]- t <- new- mapM_ (\k -> insert t k k) ks- mutate t "A" (\(Just v) -> (Just (v ++ "!"), ()))- mutate t "B" (const (Nothing, ()))- a <- lookup t "A"- Just "A!" @=? a- a <- lookup t "B"- Nothing @=? a
+ test/Test/Data/HashTable/ST/Swiss.hs view
@@ -0,0 +1,133 @@+module Test.Data.HashTable.ST.Swiss where++import Prelude hiding (lookup)++import Control.Monad+import Data.HashTable.IO.Swiss hiding (foldM, mapM_)+import qualified Data.HashTable.IO.Swiss as S+import Test.Tasty+import Test.Tasty.HUnit++import Control.Monad.ST (stToIO)+import Data.List (sort)+import Data.Primitive.Array as A+import Data.Primitive.PrimArray+import Test.QuickCheck (Gen, generate, vector)+++unit_insertAndLookup :: IO ()+unit_insertAndLookup = do+ let ks = ["A", "Z", "C", "Y", "E", "X", "G", "W"]+ ref <- new+ mapM_ (\k -> insert ref k k) ks+ forM_ ks $ \k -> do+ h <- lookup ref k+ Just k @=? h++unit_insertAndLookup_rand :: IO ()+unit_insertAndLookup_rand = do+ ks <- generate (vector 1000 :: Gen [Int])+ ref <- new+ mapM_ (\k -> insert ref k k) ks+ forM_ ks $ \k -> do+ h <- lookup ref k+ Just k @=? h++unit_insert_conflict :: IO ()+unit_insert_conflict = do+ let ks = ["head", "Z", "C", "last"]+ t <- newSized 8+ mapM_ (\x -> insert' h t x x) ks+ forM_ ks $ \k -> do+ h <- lookup' h t k+ Just k @=? h+ where+ h = const 0++unit_insert_right_overflow :: IO ()+unit_insert_right_overflow = do+ let ks = ["head", "Z", "C", "last"]+ t <- newSized 8+ mapM_ (\x -> insert' h t x x) ks+ forM_ ks $ \k -> do+ h <- lookup' h t k+ Just k @=? h+ where+ h = const 7++-- 一旦deleteでごまかす+-- vのswapできるようにすべき+unit_update :: IO ()+unit_update = do+ let ks = replicate 5 "A"+ t <- newSized 4+ mapM_ (\x -> insert t x x) ks+ s <- getSize t+ 4 @=? s++unit_lookup_nothing_conflict :: IO ()+unit_lookup_nothing_conflict = do+ let ks = ["A", "B", "C", "D"]+ t <- new+ mapM_ (\x -> insert' h t x x) ks+ h <- lookup' h t "X"+ h @=? Nothing+ where+ h = const 7++unit_lookup_nothing :: IO ()+unit_lookup_nothing = do+ let ks = ["A", "B", "C", "D"]+ t <- new+ mapM_ (\x -> insert t x x) ks+ h <- lookup t "X"+ h @=? Nothing++unit_grow_rehash :: IO ()+unit_grow_rehash = do+ let ks = ["A","Z", "C", "Y", "E", "X", "G", "W", "ab", "cd", "ef", "gh", "xx"]+ t <- newSized 8+ mapM_ (\k -> insert t k k) ks+ forM_ ks $ \k -> do+ h <- lookup t k+ Just k @=? h++unit_grow_rehash2 :: IO ()+unit_grow_rehash2 = do+ let ks = [0..99::Int]+ t <- newSized 8+ mapM_ (\k -> insert t k k) ks+ forM_ ks $ \k -> do+ h <- lookup t k+ Just k @=? h++unit_delete :: IO ()+unit_delete = do+ let ks = ["A","B", "C"]+ t <- new+ mapM_ (\k -> insert t k k) ks+ delete t "B"+ h <- lookup t "B"+ h @=? Nothing+ h <- lookup t "C"+ h @=? Just "C"++unit_foldM :: IO ()+unit_foldM = do+ let ks = ["A","B", "C"]+ t <- new+ mapM_ (\k -> insert t k k) ks+ x <- S.foldM (\acc (k, _) -> pure (acc ++ k)) "" t+ sort "ABC" @=? sort x++unit_mutate :: IO ()+unit_mutate = do+ let ks = ["A","B", "C"]+ t <- new+ mapM_ (\k -> insert t k k) ks+ mutate t "A" (\(Just v) -> (Just (v ++ "!"), ()))+ mutate t "B" (const (Nothing, ()))+ a <- lookup t "A"+ Just "A!" @=? a+ a <- lookup t "B"+ Nothing @=? a