summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xREADME.md14
-rw-r--r--bench/Main.hs1
-rw-r--r--space/Main.hs26
-rw-r--r--src/Data/HashTable/ST/Swiss.hs24
-rw-r--r--swisstable.cabal31
-rw-r--r--test/Test/Data/HashTable/ST/Swiss.hs (renamed from test/Test/Basic.hs)7
6 files changed, 82 insertions, 21 deletions
diff --git a/README.md b/README.md
index 7c7e051..bd77aa8 100755
--- a/README.md
+++ b/README.md
@@ -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
@@ -46,3 +49,14 @@ time 1.315 ms (1.311 ms .. 1.319 ms)
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
+```
diff --git a/bench/Main.hs b/bench/Main.hs
index 4ca27dc..79a0542 100644
--- a/bench/Main.hs
+++ b/bench/Main.hs
@@ -2,7 +2,6 @@
module Main where
import Control.DeepSeq
-import Control.DeepSeq (NFData)
import Control.Monad
import Criterion
import Criterion.Main
diff --git a/space/Main.hs b/space/Main.hs
new file mode 100644
index 0000000..4e98ece
--- /dev/null
+++ b/space/Main.hs
@@ -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)
diff --git a/src/Data/HashTable/ST/Swiss.hs b/src/Data/HashTable/ST/Swiss.hs
index 46d32dc..b085a0b 100644
--- a/src/Data/HashTable/ST/Swiss.hs
+++ b/src/Data/HashTable/ST/Swiss.hs
@@ -98,6 +98,7 @@ rawInsert !h1' ref !k !v = do
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 @@ listBitmaskSet = map cFfs . iterate (\x -> x .&. (x - 1))
{-# 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 @@ grow ref = do
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 @@ analyze ref = do
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
diff --git a/swisstable.cabal b/swisstable.cabal
index c85fc46..5599c1b 100644
--- a/swisstable.cabal
+++ b/swisstable.cabal
@@ -4,10 +4,10 @@ cabal-version: 1.12
--
-- 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 @@ library
build-depends:
base >=4.7 && <5
, hashable
- , primitive
+ , primitive >=0.7.1.0
, vector
default-language: Haskell2010
@@ -51,7 +51,7 @@ test-suite swisstable-test
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 @@ test-suite swisstable-test
QuickCheck
, base >=4.7 && <5
, hashable
- , primitive
+ , primitive >=0.7.1.0
, swisstable
, tasty
, tasty-discover
@@ -83,7 +83,26 @@ benchmark swisstable-bench
, 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
diff --git a/test/Test/Basic.hs b/test/Test/Data/HashTable/ST/Swiss.hs
index 2caec6d..65dfe34 100644
--- a/test/Test/Basic.hs
+++ b/test/Test/Data/HashTable/ST/Swiss.hs
@@ -1,4 +1,4 @@
-module Test.Basic where
+module Test.Data.HashTable.ST.Swiss where
import Prelude hiding (lookup)
@@ -9,6 +9,7 @@ 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)
@@ -58,7 +59,7 @@ unit_insert_right_overflow = do
-- vのswapできるようにすべき
unit_update :: IO ()
unit_update = do
- let ks = take 5 $ repeat "A"
+ let ks = replicate 5 "A"
t <- newSized 4
mapM_ (\x -> insert t x x) ks
s <- getSize t
@@ -117,7 +118,7 @@ unit_foldM = do
t <- new
mapM_ (\k -> insert t k k) ks
x <- S.foldM (\acc (k, _) -> pure (acc ++ k)) "" t
- "ABC" @=? x
+ sort "ABC" @=? sort x
unit_mutate :: IO ()
unit_mutate = do