version 0.1.0.3HEAD0.1.0.3master

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