vector-hashtables-0.1.2.0/ 0000755 0000000 0000000 00000000000 07346545000 013457 5 ustar 00 0000000 0000000 vector-hashtables-0.1.2.0/LICENSE 0000644 0000000 0000000 00000002770 07346545000 014472 0 ustar 00 0000000 0000000 Copyright Author name here (c) 2017
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Author name here nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. vector-hashtables-0.1.2.0/README.md 0000644 0000000 0000000 00000040551 07346545000 014743 0 ustar 00 0000000 0000000 # vector-hashtables
[](https://hackage.haskell.org/package/vector-hashtables)
[](https://www.stackage.org/package/vector-hashtables)
[](https://www.stackage.org/package/vector-hashtables)
[](https://github.com/klapaucius/vector-hashtables/actions?query=workflow%3Ahaskell-ci)
A brief history of this library is given in [this blog post](https://an-pro.org/posts/12-vector-hashtables.html).
## Benchmarks vs `hashtables`
(and `vector` where relevant)
Benchmarks below are produced under GHC 9.4.8, and can be reproduced locally with
```shellsession
cabal bench --benchmark-options="--csv results.csv"
bench-show report results.csv
```
(You will need the `bench-show` tool, which is available from Hackage.)
| Benchmark | v.0.1.1.4 (ns) | current (ns) |
| ----------------------------------------------------------------- | ------------ | ------------ |
| Comparison/1000/insert/hashtables basic | 36083.57 | 36907.68 |
| Comparison/1000/insert/vector-hashtables boxed | 25735.13 | 17055.86 |
| Comparison/1000/insert/vector-hashtables unboxed keys | 23601.08 | 15333.05 |
| Comparison/1000/insert/vector-hashtables | 25298.67 | 13881.72 |
| Comparison/1000/insert/mutable vector boxed | 6458.14 | 3658.16 |
| Comparison/1000/insert/mutable vector | 2526.35 | 1282.13 |
| Comparison/1000/insert (resize)/hashtables basic | 318207.51 | 159834.87 |
| Comparison/1000/insert (resize)/vector-hashtables boxed | 106490.84 | 25900.28 |
| Comparison/1000/insert (resize)/vector-hashtables unboxed keys | 66848.40 | 25382.56 |
| Comparison/1000/insert (resize)/vector-hashtables | 65694.66 | 21393.31 |
| Comparison/1000/insert, delete/hashtables basic | 96776.41 | 72615.51 |
| Comparison/1000/insert, delete/vector-hashtables | 79701.44 | 20920.26 |
| Comparison/1000/find/hashtables basic | 22841.85 | 23678.93 |
| Comparison/1000/find/vector-hashtables | 16398.19 | 5586.93 |
| Comparison/1000/find/vector-hashtables (frozen) | 11967.63 | 3128.18 |
| Comparison/1000/lookupIndex/hashtables basic | 19744.27 | 19209.79 |
| Comparison/1000/lookupIndex/vector-hashtables | 13624.09 | 4978.75 |
| Comparison/1000/fromList/hashtables basic | 167277.66 | 162920.75 |
| Comparison/1000/fromList/vector-hashtables | 48670.75 | 25283.17 |
| Comparison/1000/toList/hashtables basic | 9296.91 | 9286.65 |
| Comparison/1000/toList/vector-hashtables | 9753.58 | 10022.51 |
| Comparison/10000/insert/hashtables basic | 384031.02 | 373885.01 |
| Comparison/10000/insert/vector-hashtables boxed | 246923.90 | 175892.73 |
| Comparison/10000/insert/vector-hashtables unboxed keys | 229812.05 | 147689.46 |
| Comparison/10000/insert/vector-hashtables | 216924.38 | 128417.71 |
| Comparison/10000/insert/mutable vector boxed | 43104.20 | 42712.36 |
| Comparison/10000/insert/mutable vector | 12298.81 | 12193.85 |
| Comparison/10000/insert (resize)/hashtables basic | 1342541.64 | 1378595.70 |
| Comparison/10000/insert (resize)/vector-hashtables boxed | 487188.49 | 273187.43 |
| Comparison/10000/insert (resize)/vector-hashtables unboxed keys | 441635.60 | 242659.06 |
| Comparison/10000/insert (resize)/vector-hashtables | 412651.12 | 188011.22 |
| Comparison/10000/insert, delete/hashtables basic | 722883.16 | 736250.66 |
| Comparison/10000/insert, delete/vector-hashtables | 407113.19 | 200643.92 |
| Comparison/10000/find/hashtables basic | 228154.09 | 232874.24 |
| Comparison/10000/find/vector-hashtables | 164343.06 | 55693.39 |
| Comparison/10000/find/vector-hashtables (frozen) | 119669.00 | 31291.02 |
| Comparison/10000/lookupIndex/hashtables basic | 197212.48 | 191707.57 |
| Comparison/10000/lookupIndex/vector-hashtables | 136205.70 | 49762.50 |
| Comparison/10000/fromList/hashtables basic | 1391968.88 | 1562065.86 |
| Comparison/10000/fromList/vector-hashtables | 430590.93 | 233128.12 |
| Comparison/10000/toList/hashtables basic | 112894.13 | 114543.83 |
| Comparison/10000/toList/vector-hashtables | 152214.13 | 154034.89 |
| Comparison/100000/insert/hashtables basic | 4492224.86 | 4546924.57 |
| Comparison/100000/insert/vector-hashtables boxed | 2414664.98 | 1767261.44 |
| Comparison/100000/insert/vector-hashtables unboxed keys | 2243027.45 | 1476174.02 |
| Comparison/100000/insert/vector-hashtables | 2144269.70 | 1272101.52 |
| Comparison/100000/insert/mutable vector boxed | 667945.33 | 666673.13 |
| Comparison/100000/insert/mutable vector | 121264.87 | 123138.53 |
| Comparison/100000/insert (resize)/hashtables basic | 18217163.16 | 18777839.68 |
| Comparison/100000/insert (resize)/vector-hashtables boxed | 9452674.69 | 7287443.14 |
| Comparison/100000/insert (resize)/vector-hashtables unboxed keys | 7721635.33 | 5698107.38 |
| Comparison/100000/insert (resize)/vector-hashtables | 4722092.98 | 2574932.04 |
| Comparison/100000/insert, delete/hashtables basic | 8699786.66 | 8790937.73 |
| Comparison/100000/insert, delete/vector-hashtables | 4073127.47 | 2010559.30 |
| Comparison/100000/find/hashtables basic | 2283995.01 | 2346364.66 |
| Comparison/100000/find/vector-hashtables | 1676135.49 | 588427.30 |
| Comparison/100000/find/vector-hashtables (frozen) | 1201572.29 | 319639.97 |
| Comparison/100000/lookupIndex/hashtables basic | 1963727.73 | 1931036.13 |
| Comparison/100000/lookupIndex/vector-hashtables | 1363501.76 | 499992.98 |
| Comparison/100000/fromList/hashtables basic | 20681183.31 | 30059346.94 |
| Comparison/100000/fromList/vector-hashtables | 5262183.79 | 3945839.47 |
| Comparison/100000/toList/hashtables basic | 2675794.96 | 2702739.12 |
| Comparison/100000/toList/vector-hashtables | 5155629.15 | 5118781.70 |
| Comparison/1000000/insert/hashtables basic | 86723317.72 | 85752701.43 |
| Comparison/1000000/insert/vector-hashtables boxed | 68162021.23 | 75667649.90 |
| Comparison/1000000/insert/vector-hashtables unboxed keys | 50777620.44 | 46615543.58 |
| Comparison/1000000/insert/vector-hashtables | 23334885.43 | 16025927.63 |
| Comparison/1000000/insert/mutable vector boxed | 30281652.62 | 32068295.04 |
| Comparison/1000000/insert/mutable vector | 1283399.43 | 1393859.51 |
| Comparison/1000000/insert (resize)/hashtables basic | 228726522.46 | 282346897.14 |
| Comparison/1000000/insert (resize)/vector-hashtables boxed | 104556190.01 | 84385042.40 |
| Comparison/1000000/insert (resize)/vector-hashtables unboxed keys | 79183320.30 | 62413398.66 |
| Comparison/1000000/insert (resize)/vector-hashtables | 45925222.08 | 28777902.04 |
| Comparison/1000000/insert, delete/hashtables basic | 130189177.30 | 134399640.44 |
| Comparison/1000000/insert, delete/vector-hashtables | 42722592.04 | 23648387.28 |
| Comparison/1000000/find/hashtables basic | 23094297.73 | 24583079.42 |
| Comparison/1000000/find/vector-hashtables | 16709242.48 | 6178348.57 |
| Comparison/1000000/find/vector-hashtables (frozen) | 12176361.82 | 3425505.60 |
| Comparison/1000000/lookupIndex/hashtables basic | 20222788.08 | 19753759.16 |
| Comparison/1000000/lookupIndex/vector-hashtables | 14041315.59 | 5357116.98 |
| Comparison/1000000/fromList/hashtables basic | 210947448.60 | 222974094.62 |
| Comparison/1000000/fromList/vector-hashtables | 56875691.60 | 49212505.34 |
| Comparison/1000000/toList/hashtables basic | 62256321.15 | 66351583.99 |
| Comparison/1000000/toList/vector-hashtables | 95883670.57 | 98441804.39 |
Utilities benchmark:
| Benchmark | v.0.1.1.4 (ns) | current (ns) |
| --------- | -------------- | ------------ |
| Utilities/1000/at' | 14554.08 | 4755.41 |
| Utilities/1000/insert | 16704.55 | 6842.45 |
| Utilities/1000/delete | 11166.80 | 3959.44 |
| Utilities/1000/lookup | 14510.59 | 5161.87 |
| Utilities/1000/lookup' | 14181.87 | 4739.19 |
| Utilities/1000/lookupIndex | 17171.76 | 4196.40 |
| Utilities/1000/null | 7.19 | 7.92 |
| Utilities/1000/length | 7.31 | 7.41 |
| Utilities/1000/size | 6.85 | 6.53 |
| Utilities/1000/member | 17364.48 | 4344.27 |
| Utilities/1000/findWithDefault | 15747.10 | 4802.97 |
| Utilities/1000/upsert | 32633.25 | 12708.79 |
| Utilities/1000/alter | 31908.54 | 11109.48 |
| Utilities/1000/alterM | 32564.14 | 11110.53 |
| Utilities/1000/union | 46432.10 | 29468.82 |
| Utilities/1000/difference | 25741.68 | 16296.53 |
| Utilities/1000/intersection | 58828.38 | 38587.57 |
| Utilities/1000/fromList | 45355.85 | 26156.93 |
| Utilities/1000/toList | 9626.89 | 10101.05 |
| Utilities/10000/at' | 147509.66 | 48699.88 |
| Utilities/10000/insert | 171201.56 | 68568.34 |
| Utilities/10000/delete | 111650.42 | 39392.43 |
| Utilities/10000/lookup | 149138.47 | 49800.41 |
| Utilities/10000/lookup' | 144283.31 | 46886.69 |
| Utilities/10000/lookupIndex | 172630.09 | 40088.94 |
| Utilities/10000/null | 7.20 | 7.24 |
| Utilities/10000/length | 7.30 | 6.77 |
| Utilities/10000/size | 6.87 | 6.43 |
| Utilities/10000/member | 170650.68 | 43369.07 |
| Utilities/10000/findWithDefault | 157236.92 | 49471.03 |
| Utilities/10000/upsert | 329212.06 | 125290.78 |
| Utilities/10000/alter | 322814.62 | 111817.84 |
| Utilities/10000/alterM | 330094.30 | 112444.63 |
| Utilities/10000/union | 478541.46 | 329790.79 |
| Utilities/10000/difference | 295042.17 | 193790.26 |
| Utilities/10000/intersection | 644396.71 | 419483.32 |
| Utilities/10000/fromList | 494164.34 | 331449.21 |
| Utilities/10000/toList | 151375.79 | 167580.99 |
| Utilities/100000/at' | 1491045.70 | 495418.68 |
| Utilities/100000/insert | 1741058.94 | 765507.51 |
| Utilities/100000/delete | 1127146.84 | 436707.82 |
| Utilities/100000/lookup | 1601916.69 | 562205.51 |
| Utilities/100000/lookup' | 1441526.57 | 488540.28 |
| Utilities/100000/lookupIndex | 1763172.42 | 405596.28 |
| Utilities/100000/null | 7.19 | 7.26 |
| Utilities/100000/length | 7.38 | 7.17 |
| Utilities/100000/size | 6.92 | 6.83 |
| Utilities/100000/member | 1740066.09 | 464281.90 |
| Utilities/100000/findWithDefault | 1577458.36 | 489790.85 |
| Utilities/100000/upsert | 3383104.75 | 1265454.18 |
| Utilities/100000/alter | 3329820.09 | 1211692.27 |
| Utilities/100000/alterM | 3356140.57 | 1220060.24 |
| Utilities/100000/union | 5563999.76 | 3705665.39 |
| Utilities/100000/difference | 6372930.19 | 5630405.29 |
| Utilities/100000/intersection | 12353680.59 | 9595098.36 |
| Utilities/100000/fromList | 5161712.37 | 3685646.90 |
| Utilities/100000/toList | 5109243.49 | 5118785.28 |
| Utilities/1000000/at' | 14831244.23 | 5055419.26 |
| Utilities/1000000/insert | 17633535.06 | 7209602.12 |
| Utilities/1000000/delete | 11251853.98 | 4072535.57 |
| Utilities/1000000/lookup | 15169518.90 | 5208497.64 |
| Utilities/1000000/lookup' | 14532451.21 | 4929673.79 |
| Utilities/1000000/lookupIndex | 17529914.96 | 4216663.23 |
| Utilities/1000000/null | 7.20 | 7.25 |
| Utilities/1000000/length | 7.30 | 6.81 |
| Utilities/1000000/size | 6.86 | 6.43 |
| Utilities/1000000/member | 17461069.35 | 4604944.15 |
| Utilities/1000000/findWithDefault | 15945541.78 | 5058608.89 |
| Utilities/1000000/upsert | 34444162.79 | 12052143.01 |
| Utilities/1000000/alter | 33820504.88 | 11842773.92 |
| Utilities/1000000/alterM | 33991841.71 | 11908234.12 |
| Utilities/1000000/union | 59911378.73 | 44470700.12 |
| Utilities/1000000/difference | 117323371.53 | 107670945.26 |
| Utilities/1000000/intersection | 195009586.71 | 161847790.47 |
| Utilities/1000000/fromList | 97086662.77 | 52734408.34 |
| Utilities/1000000/toList | 166554860.99 | 99619875.06 |
vector-hashtables-0.1.2.0/Setup.hs 0000644 0000000 0000000 00000000056 07346545000 015114 0 ustar 00 0000000 0000000 import Distribution.Simple
main = defaultMain
vector-hashtables-0.1.2.0/bench/ 0000755 0000000 0000000 00000000000 07346545000 014536 5 ustar 00 0000000 0000000 vector-hashtables-0.1.2.0/bench/Main.hs 0000644 0000000 0000000 00000025615 07346545000 015767 0 ustar 00 0000000 0000000 {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
module Main (main) where
import qualified Data.Vector.Storable as V
import qualified Data.Vector.Storable.Mutable as VM
import qualified Data.Vector.Mutable as BV
import Control.Monad.Primitive (PrimMonad(PrimState))
import qualified Data.HashTable.IO as H
import Criterion.Main (bench, bgroup, defaultMain, nfIO)
import Criterion (Benchmark)
import qualified Data.Vector.Hashtables.Internal as VH
vh :: Int -> IO (VH.Dictionary (PrimState IO) VM.MVector Int VM.MVector Int)
vh n = do
ht <- VH.initialize n :: IO (VH.Dictionary (PrimState IO) VM.MVector Int VM.MVector Int)
let go !i | i <= n = VH.insert ht i i >> go (i + 1)
| otherwise = return ()
go 0
return ht
fvh :: Int -> IO (VH.FrozenDictionary V.Vector Int V.Vector Int)
fvh n = do
h <- vh n
c <- VH.clone h
VH.unsafeFreeze c
bh :: Int -> IO (H.BasicHashTable Int Int)
bh n = do
ht <- H.newSized n :: IO (H.BasicHashTable Int Int)
let go !i | i <= n = H.insert ht i i >> go (i + 1)
| otherwise = return ()
go 0
return ht
fl :: Int -> [(Int, Int)]
fl n = mkPair <$> [0 .. n]
where
mkPair !x = (x, x)
vhfind :: Int -> VH.Dictionary (PrimState IO) VM.MVector Int VM.MVector Int -> IO Int
vhfind n ht = do
let go !i !s | i <= n = do
x <- VH.findEntry ht i
go (i + 1) (s + x)
| otherwise = return s
go 0 0
fvhfind :: Int -> VH.FrozenDictionary V.Vector Int V.Vector Int -> IO Int
fvhfind n ht = return $ go 0 0 where
go !i !s | i <= n = go (i + 1) (s + VH.findElem ht i)
| otherwise = s
bhfind :: Int -> H.BasicHashTable Int Int -> IO Int
bhfind n ht = do
let go !i !s | i <= n = do
Just x <- H.lookup ht i
go (i + 1) (s + x)
| otherwise = return s
go 0 0
htb :: Int -> IO ()
htb n = do
ht <- H.newSized n :: IO (H.BasicHashTable Int Int)
let go !i | i <= n = H.insert ht i i >> go (i + 1)
| otherwise = return ()
go 0
vht :: Int -> IO ()
vht n = do
ht <- VH.initialize n :: IO (VH.Dictionary (PrimState IO) VM.MVector Int VM.MVector Int)
let go !i | i <= n = VH.insert ht i i >> go (i + 1)
| otherwise = return ()
go 0
vhtd :: Int -> IO ()
vhtd n = do
ht <- VH.initialize n :: IO (VH.Dictionary (PrimState IO) VM.MVector Int VM.MVector Int)
let go !i | i <= n = VH.insert ht i i >> go (i + 1)
| otherwise = return ()
go 0
let go1 !i | i <= n = VH.delete ht i >> go1 (i + 1)
| otherwise = return ()
go1 0
htbd :: Int -> IO ()
htbd n = do
ht <- H.newSized n :: IO (H.BasicHashTable Int Int)
let go !i | i <= n = H.insert ht i i >> go (i + 1)
| otherwise = return ()
go 0
let go1 !i | i <= n = H.delete ht i >> go1 (i + 1)
| otherwise = return ()
go1 0
vhtb :: Int -> IO ()
vhtb n = do
ht <- VH.initialize n :: IO (VH.Dictionary (PrimState IO) BV.MVector Int BV.MVector Int)
let go !i | i <= n = VH.insert ht i i >> go (i + 1)
| otherwise = return ()
go 0
vhtk :: Int -> IO ()
vhtk n = do
ht <- VH.initialize n :: IO (VH.Dictionary (PrimState IO) VM.MVector Int BV.MVector Int)
let go !i | i <= n = VH.insert ht i i >> go (i + 1)
| otherwise = return ()
go 0
htbg :: Int -> IO ()
htbg n = do
ht <- H.newSized 1 :: IO (H.BasicHashTable Int Int)
let go !i | i <= n = H.insert ht i i >> go (i + 1)
| otherwise = return ()
go 0
vhtg :: Int -> IO ()
vhtg n = do
ht <- VH.initialize 1 :: IO (VH.Dictionary (PrimState IO) VM.MVector Int VM.MVector Int)
let go !i | i <= n = VH.insert ht i i >> go (i + 1)
| otherwise = return ()
go 0
vhtbg :: Int -> IO ()
vhtbg n = do
ht <- VH.initialize 1 :: IO (VH.Dictionary (PrimState IO) BV.MVector Int BV.MVector Int)
let go !i | i <= n = VH.insert ht i i >> go (i + 1)
| otherwise = return ()
go 0
vhtkg :: Int -> IO ()
vhtkg n = do
ht <- VH.initialize 1 :: IO (VH.Dictionary (PrimState IO) VM.MVector Int BV.MVector Int)
let go !i | i <= n = VH.insert ht i i >> go (i + 1)
| otherwise = return ()
go 0
mvb :: Int -> IO ()
mvb n = do
ht <- BV.new (n+1)
let go !i | i <= n = BV.write ht i i >> go (i + 1)
| otherwise = return ()
go 0
mv :: Int -> IO ()
mv n = do
ht <- VM.new (n+1)
let go !i | i <= n = VM.write ht i i >> go (i + 1)
| otherwise = return ()
go 0
bhfromList l = do
_bht <- H.fromList l :: IO (H.BasicHashTable Int Int)
return ()
vhfromList l = do
_ht <- VH.fromList l :: IO (VH.Dictionary (PrimState IO) VM.MVector Int VM.MVector Int)
return ()
bhlookupIndex :: Int -> H.BasicHashTable Int Int -> IO Int
bhlookupIndex n ht = do
let go !i !s | i <= n = do
Just x <- H.lookupIndex ht i
go (i + 1) (s + fromIntegral x)
| otherwise = return s
go 0 0
vhlookupIndex :: Int -> VH.Dictionary (PrimState IO) VM.MVector Int VM.MVector Int -> IO Int
vhlookupIndex n ht = do
let go !i !s | i <= n = do
Just x <- VH.lookupIndex ht i
go (i + 1) (s + x)
| otherwise = return s
go 0 0
bhtoList = H.toList
vhtoList = VH.toList
bgc :: Int -> IO Benchmark
bgc n = do
h <- vh n
h2 <- bh n
fh <- fvh n
let l = fl n
return $ bgroup (show n)
[ bgroup "insert"
[ bench "hashtables basic" $ nfIO (htb n)
, bench "vector-hashtables boxed" $ nfIO (vhtb n)
, bench "vector-hashtables unboxed keys" $ nfIO (vhtk n)
, bench "vector-hashtables" $ nfIO (vht n)
, bench "mutable vector boxed" $ nfIO (mvb n)
, bench "mutable vector" $ nfIO (mv n) ]
, bgroup "insert (resize)"
[ bench "hashtables basic" $ nfIO (htbg n)
, bench "vector-hashtables boxed" $ nfIO (vhtbg n)
, bench "vector-hashtables unboxed keys" $ nfIO (vhtkg n)
, bench "vector-hashtables" $ nfIO (vhtg n) ]
, bgroup "insert, delete"
[ bench "hashtables basic" $ nfIO (htbd n)
, bench "vector-hashtables" $ nfIO (vhtd n) ]
, bgroup "find"
[ bench "hashtables basic" $ nfIO (bhfind n h2)
, bench "vector-hashtables" $ nfIO (vhfind n h)
, bench "vector-hashtables (frozen)" $ nfIO (fvhfind n fh) ]
, bgroup "lookupIndex"
[ bench "hashtables basic" $ nfIO (bhlookupIndex n h2)
, bench "vector-hashtables" $ nfIO (vhlookupIndex n h) ]
, bgroup "fromList"
[ bench "hashtables basic" $ nfIO (bhfromList l)
, bench "vector-hashtables" $ nfIO (vhfromList l) ]
, bgroup "toList"
[ bench "hashtables basic" $ nfIO (bhtoList h2)
, bench "vector-hashtables" $ nfIO (vhtoList h) ]]
main :: IO ()
main = do
let inputs = [1000,10000,100000,1000000]
comparisonBench <- mapM bgc inputs
utilitiesBench <- mapM utilities inputs
defaultMain
[ bgroup "Comparison" comparisonBench
, bgroup "Utilities" utilitiesBench ]
-- ** Utilities benchmark
utilities n = do
-- utilities input data
hAt' <- vh n
hInsert <- vh n
hDelete <- vh n
hLookup <- vh n
hLookup' <- vh n
hLookupIndex <- vh n
hNull <- vh n
hLength <- vh n
hSize <- vh n
hMember <- vh n
hFindWithDefault <- vh n
hUpsert <- vh n
hAlter <- vh n
hAlterM <- vh n
hUnion1 <- vh n
hUnion2 <- vh n
hDifference1 <- vh n
hDifference2 <- vh n
hIntersection1 <- vh n
hIntersection2 <- vh n
hFromList <- VH.toList =<< vh n
hToList <- vh n
return $ bgroup (show n)
[ bench "at'" $ nfIO (bhuat' n hAt')
, bench "insert" $ nfIO (bhuinsert n hInsert)
, bench "delete" $ nfIO (bhudelete n hDelete)
, bench "lookup" $ nfIO (bhulookup n hLookup)
, bench "lookup'" $ nfIO (bhulookup' n hLookup')
, bench "lookupIndex" $ nfIO (bhulookupIndex n hLookupIndex)
, bench "null" $ nfIO (bhunull hNull)
, bench "length" $ nfIO (bhulength hLength)
, bench "size" $ nfIO (bhusize hSize)
, bench "member" $ nfIO (bhumember n hMember)
, bench "findWithDefault" $ nfIO (bhufindWithDefault n hFindWithDefault)
, bench "upsert" $ nfIO (bhuupsert n hUpsert)
, bench "alter" $ nfIO (bhualter n hAlter)
, bench "alterM" $ nfIO (bhualterM n hAlterM)
, bench "union" $ nfIO (bhuunion hUnion1 hUnion2)
, bench "difference" $ nfIO (bhudifference hDifference1 hDifference2)
, bench "intersection" $ nfIO (bhuintersection hIntersection1 hIntersection2)
, bench "fromList" $ nfIO (bhufromList hFromList)
, bench "toList" $ nfIO (VH.toList hToList) ]
bhuat' n ht = do
let go !i | i <= n = VH.at' ht i >> go (i + 1)
| otherwise = return ()
go 0
bhuinsert n ht = do
let go !i | i <= n = VH.insert ht i i >> go (i + 1)
| otherwise = return ()
go 0
bhudelete n ht = do
let go !i | i <= n = VH.delete ht i >> go (i + 1)
| otherwise = return ()
go 0
bhulookup n ht = do
let go !i | i <= n = VH.lookup ht i >> go (i + 1)
| otherwise = return ()
go 0
bhulookup' n ht = do
let go !i | i <= n = VH.lookup' ht i >> go (i + 1)
| otherwise = return ()
go 0
bhulookupIndex n ht = do
let go !i | i <= n = VH.lookupIndex ht i >> go (i + 1)
| otherwise = return ()
go 0
bhunull = VH.null
bhulength = VH.length
bhusize = VH.size
bhumember n ht = do
let go !i | i <= n = VH.member ht i >> go (i + 1)
| otherwise = return ()
go 0
bhufindWithDefault n ht = do
let go !i | i <= n = VH.findWithDefault ht 0 i >> go (i + 1)
| otherwise = return ()
go 0
bhuupsert n ht = do
let go !i | i <= n = VH.upsert ht (maybe minBound succ) i >> go (i + 1)
| otherwise = return ()
go 0
bhualter n ht = do
let go !i | i <= n = VH.alter ht (fmap succ) i >> go (i + 1)
| otherwise = return ()
go 0
bhualterM :: Int -> VH.Dictionary (PrimState IO) VM.MVector Int VM.MVector Int -> IO ()
bhualterM n ht = do
let f = return . fmap succ
go !i | i <= n = VH.alterM ht f i >> go (i + 1)
| otherwise = return ()
go 0
bhuunion ht1 ht2 = VH.union ht1 ht2 >> return ()
bhudifference ht1 ht2 = VH.difference ht1 ht2 >> return ()
bhuintersection ht1 ht2 = VH.intersection ht1 ht2 >> return ()
bhufromList htlist = do
ht <- VH.fromList htlist :: IO (VH.Dictionary (PrimState IO) VM.MVector Int VM.MVector Int)
return ()
bhutoList ht = VH.toList ht >> return ()
vector-hashtables-0.1.2.0/changelog.md 0000644 0000000 0000000 00000004101 07346545000 015724 0 ustar 00 0000000 0000000 # 0.1.2.0 (2024-04-26)
* Add `upsert` function to public interface (see [#21](https://github.com/klapaucius/vector-hashtables/pull/21)).
* Simplify support of 32-bit architectures via `maxBound` (see [#22](https://github.com/klapaucius/vector-hashtables/pull/22)).
* Improve performance via strictness annotations and bang patterns (see [#24](https://github.com/klapaucius/vector-hashtables/pull/24)).
* Suggest using strict boxed vectors to avoid accumulation of thunks (see [#27](https://github.com/klapaucius/vector-hashtables/pull/27)).
* Speed up division by bucket's size (see [#28](https://github.com/klapaucius/vector-hashtables/pull/28)).
* Avoid deprecated `sizeofMutablePrimArray` (see [#29](https://github.com/klapaucius/vector-hashtables/pull/29)).
* Introduce `findEntry_` and avoid examining `MutVar` twice in `at` (see [#32](https://github.com/klapaucius/vector-hashtables/pull/32)).
* Bump `QuickCheck` boundary (see [#33](https://github.com/klapaucius/vector-hashtables/pull/33)).
# 0.1.1.4 (2023-12-13)
* Add `wasm32` support (see [#20](https://github.com/klapaucius/vector-hashtables/pull/20)).
# 0.1.1.3 (2023-04-23)
* cleanup the cabal file
* CI based on Haskell-CI (see [#15](https://github.com/klapaucius/vector-hashtables/pull/15))
* readme: minimal improvement of benchmark data presentation (see [#16](https://github.com/klapaucius/vector-hashtables/pull/16))
* bump hspec to <2.12 (see [#17](https://github.com/klapaucius/vector-hashtables/pull/17))
# 0.1.1.2 (2023-01-31)
- Relax `hspec` boundaries (see [#14](https://github.com/klapaucius/vector-hashtables/pull/14)).
- Set lower bound for `primtive` (see [#12](https://github.com/klapaucius/vector-hashtables/pull/12)).
# 0.1.1.1 (2021-09-10)
- Optimise `insertWithIndex` function ([#10](https://github.com/klapaucius/vector-hashtables/pull/10)).
# 0.1.1.0 (2021-09-10)
- Add `alter` function to public interface ([#9](https://github.com/klapaucius/vector-hashtables/pull/9)).
# 0.1.0.1 (2021-09-10)
- Remove outdated executable in favor of benchmark.
# 0.1.0.0 (2021-09-07)
- Release vector-hastables to the world.
vector-hashtables-0.1.2.0/gen/ 0000755 0000000 0000000 00000000000 07346545000 014230 5 ustar 00 0000000 0000000 vector-hashtables-0.1.2.0/gen/GenPrimes.hs 0000644 0000000 0000000 00000003304 07346545000 016455 0 ustar 00 0000000 0000000 #!/usr/bin/env cabal
{- cabal:
build-depends: arithmoi, base, quote-quot
-}
import Data.Bits (FiniteBits)
import Data.Int (Int32, Int64)
import Math.NumberTheory.Primes (nextPrime, unPrime)
import Numeric.QuoteQuot (AST (..), assumeNonNegArg, astQuot)
-- | For a given bitness, expressed as a ~ Int32 or a ~ Int64,
-- generate a list of primes such that each prime is at least 20% larger
-- than the previous. Additionally, for each of selected primes
-- there exist numbers m and s such that (assuming Int64) for every n >= 0
--
-- n `quot` p = (n * m) `shiftR` (64 + s)
--
-- The function returns a list of tuples (p, m, s).
--
genPrimes :: (FiniteBits a, Integral a, Show a, Bounded a) => [(a, a, Int)]
genPrimes = go 3
where
go n
| n < 0 = []
| n >= maxBound `quot` 2 = []
| p < n = []
| otherwise = case assumeNonNegArg (astQuot p) of
Shr (MulHi Arg mul) shft -> (p, mul, shft) : go p'
_ -> go (p + 1)
where
p = fromInteger (unPrime (nextPrime (toInteger n)))
p' = ceiling (fromIntegral p * 1.2 :: Double)
main :: IO ()
main = do
putStrLn "-- | This data is auto-generated by GenPrimes.hs."
putStrLn "-- The vector contains tuples (p, m, s) such that p is prime"
putStrLn "-- and (assuming 64-bit architecture) for every n >= 0"
putStrLn "-- it holds that n `quot` p = (n * m) `shiftR` (64 + s),"
putStrLn "-- enabling faster computation of remainders."
putStrLn "primesWithFastRem :: UI.Vector (Int, Int, Int)"
putStrLn "primesWithFastRem = UI.fromList $"
putStrLn " if finiteBitSize (0 :: Int) == 32"
putStrLn $ " then " ++ show (genPrimes :: [(Int32, Int32, Int)])
putStrLn $ " else " ++ show (genPrimes :: [(Int64, Int64, Int)])
vector-hashtables-0.1.2.0/src/Data/Primitive/PrimArray/ 0000755 0000000 0000000 00000000000 07346545000 020775 5 ustar 00 0000000 0000000 vector-hashtables-0.1.2.0/src/Data/Primitive/PrimArray/Utils.hs 0000644 0000000 0000000 00000003750 07346545000 022436 0 ustar 00 0000000 0000000 {-|
Module : Data.Primitive.PrimArray.Utils
Description : Provides useful utilities for operating with mutable primitive arrays.
Copyright : (c) klapaucius, swamp_agr, 2016-2021
License : BSD3
-}
module Data.Primitive.PrimArray.Utils where
import Data.Primitive.PrimArray
import Control.Monad.Primitive
import Data.Primitive
replicate :: (PrimMonad m, Prim a)
=> Int -> a -> m (MutablePrimArray (PrimState m) a)
replicate n x = do
xs <- newPrimArray n
sz <- getSizeofMutablePrimArray xs
setPrimArray xs 0 sz x
return xs
{-# INLINE replicate #-}
clone :: (PrimMonad m, Prim a)
=> MutablePrimArray (PrimState m) a -> m (MutablePrimArray (PrimState m) a)
clone xs = do
sz <- getSizeofMutablePrimArray xs
cloneMutablePrimArray xs 0 sz
{-# INLINE clone #-}
unsafeFreeze :: PrimMonad m
=> MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreeze = unsafeFreezePrimArray
{-# INLINE unsafeFreeze #-}
unsafeThaw :: PrimMonad m
=> PrimArray a -> m (MutablePrimArray (PrimState m) a)
unsafeThaw = unsafeThawPrimArray
{-# INLINE unsafeThaw #-}
growWith :: (PrimMonad m, Prim a)
=> a -> MutablePrimArray (PrimState m) a -> Int -> m (MutablePrimArray (PrimState m) a)
growWith a xs delta = do
r <- growNoZ xs delta
sz <- getSizeofMutablePrimArray xs
setPrimArray r sz delta a
return r
{-# INLINE growWith #-}
growNoZ :: (PrimMonad m, Prim a)
=> MutablePrimArray (PrimState m) a -> Int -> m (MutablePrimArray (PrimState m) a)
growNoZ xs delta = do
sz <- getSizeofMutablePrimArray xs
resizeMutablePrimArray xs (sz + delta)
{-# INLINE growNoZ #-}
freeze :: (PrimMonad m, Prim a)
=> MutablePrimArray (PrimState m) a -> m (PrimArray a)
freeze xs = do
r <- unsafeFreezePrimArray xs
return $ clonePrimArray r 0 (sizeofPrimArray r)
{-# INLINE freeze #-}
length :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> m Int
length = getSizeofMutablePrimArray
{-# INLINE length #-}
vector-hashtables-0.1.2.0/src/Data/Vector/ 0000755 0000000 0000000 00000000000 07346545000 016361 5 ustar 00 0000000 0000000 vector-hashtables-0.1.2.0/src/Data/Vector/Hashtables.hs 0000644 0000000 0000000 00000004011 07346545000 020767 0 ustar 00 0000000 0000000 {-|
Module : Data.Vector.Hashtables
Description : Provides hashtables, basic interface and set of utilities.
Copyright : (c) klapaucius, swamp_agr, 2016-2021
License : BSD3
-}
module Data.Vector.Hashtables
( -- * Documentation
-- $doc
-- ** Usage
-- $usage
-- ** Types
Dictionary (..)
, FrozenDictionary (..)
, findElem
-- ** Construction
, initialize
, clone
-- ** Basic interface
, null
, size
, keys
, values
, lookup
, lookup'
, insert
, delete
, upsert
, alter
, alterM
, findEntry
-- ** Combine
-- *** Union
, union
, unionWith
, unionWithKey
-- *** Difference
, difference
, differenceWith
-- *** Intersection
, intersection
, intersectionWith
, intersectionWithKey
-- ** Conversions
-- *** Mutable
, unsafeFreeze
, unsafeThaw
-- *** List
, fromList
, toList
-- ** Low-level interface
, Dictionary_ (..)
, findEntry_
, module Control.Monad.Primitive
) where
import Prelude hiding (null, lookup)
import Control.Monad.Primitive
import Data.Vector.Hashtables.Internal
-- $doc
--
-- - This package provides hashtable implementation similar to .NET Generic Dictionary implementation (at the time of 2015) .
--
-- - It was originated as response to .
--
-- - For more hashtables implementations see .
-- $usage
--
-- >>> import qualified Data.Vector.Storable.Mutable as VM
-- >>> import qualified Data.Vector.Unboxed.Mutable as UM
-- >>> import Data.Vector.Hashtables
-- >>> type HashTable k v = Dictionary (PrimState IO) VM.MVector k UM.MVector v
-- >>> ht <- initialize 0 :: IO (HashTable Int Int)
-- >>> insert ht 0 1
--
vector-hashtables-0.1.2.0/src/Data/Vector/Hashtables/ 0000755 0000000 0000000 00000000000 07346545000 020437 5 ustar 00 0000000 0000000 vector-hashtables-0.1.2.0/src/Data/Vector/Hashtables/Internal.hs 0000644 0000000 0000000 00000127307 07346545000 022561 0 ustar 00 0000000 0000000 {-|
Module : Data.Vector.Hashtables.Internal
Description : Provides internals of hashtables and set of utilities.
Copyright : (c) klapaucius, swamp_agr, 2016-2021
License : BSD3
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
module Data.Vector.Hashtables.Internal where
import Control.Monad
import Control.Monad.Primitive
import Data.Bits
import Data.Hashable
import Data.Maybe
import Data.Primitive.MutVar
import Data.Vector.Generic (Mutable, Vector)
import qualified Data.Vector.Generic as VI
import Data.Vector.Generic.Mutable (MVector)
import qualified Data.Vector.Generic.Mutable as V
import qualified Data.Vector.Mutable as B
import qualified Data.Vector.Storable as SI
import qualified Data.Vector.Storable.Mutable as S
import qualified Data.Vector.Unboxed as UI
import qualified Data.Vector.Unboxed.Mutable as U
import qualified GHC.Exts as Exts
import Prelude hiding (length, lookup)
import qualified Data.Primitive.PrimArray as A
import qualified Data.Primitive.PrimArray.Utils as A
import Data.Vector.Hashtables.Internal.Mask (mask)
-- | Alias for 'MutablePrimArray' @s@ 'Int'.
type IntArray s = A.MutablePrimArray s Int
-- | Single-element mutable array of 'Dictionary_' with primitive state token
-- parameterized with state, keys and values types.
--
-- Different flavors of 'MVector' could be used for keys and values.
-- It's preferable to use "Data.Vector.Unboxed.Mutable"
-- or "Data.Vector.Storable.Mutable" if possible. Otherwise,
-- if you must use boxed vectors, consider employing strict ones from
-- [@strict-containers@](https://hackage.haskell.org/package/strict-containers)
-- to eliminate potential accumulation of thunks.
--
-- ==== Example
--
-- >>> import qualified Data.Vector.Storable.Mutable as VM
-- >>> import qualified Data.Vector.Unboxed.Mutable as UM
-- >>> import Data.Vector.Hashtables
-- >>> type HashTable k v = Dictionary (PrimState IO) VM.MVector k UM.MVector v
--
newtype Dictionary s ks k vs v = DRef { getDRef :: MutVar s (Dictionary_ s ks k vs v) }
-- | Represents collection of hashtable internal primitive arrays and vectors.
--
-- - hash codes,
--
-- - references to the next element,
--
-- - buckets,
--
-- - keys
--
-- - and values.
--
data Dictionary_ s ks k vs v = Dictionary {
hashCode,
next,
buckets,
refs :: !(IntArray s),
key :: !(ks s k),
value :: !(vs s v),
remSize :: {-# UNPACK #-} !FastRem
}
getCount, getFreeList, getFreeCount :: Int
getCount = 0
getFreeList = 1
getFreeCount = 2
-- | Represents immutable dictionary as collection of immutable arrays and vectors.
-- See 'unsafeFreeze' and 'unsafeThaw' for conversions from/to mutable dictionary.
data FrozenDictionary ks k vs v = FrozenDictionary {
fhashCode,
fnext,
fbuckets :: !(A.PrimArray Int),
count, freeList, freeCount :: !Int,
fkey :: !(ks k),
fvalue :: !(vs v),
fremSize :: {-# UNPACK #-} !FastRem
} deriving (Eq, Ord, Show)
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- Find dictionary entry by given key in immutable 'FrozenDictionary'.
-- If entry not found @-1@ returned.
findElem :: (Vector ks k, Vector vs v, Hashable k, Eq k)
=> FrozenDictionary ks k vs v -> k -> Int
findElem FrozenDictionary{..} key' = go $ fbuckets !. (hashCode' `fastRem` fremSize) where
hashCode' = hash key' .&. mask
go i | i >= 0 =
if fhashCode !. i == hashCode' && fkey !.~ i == key'
then i else go $ fnext !. i
| otherwise = -1
{-# INLINE findElem #-}
-- | Infix version of @unsafeRead@.
(!~) :: (MVector v a, PrimMonad m) => v (PrimState m) a -> Int -> m a
(!~) xs !i = V.unsafeRead xs i
-- Why do we need ! before i?
-- The reason is that V.unsafeRead is essentially V.basicUnsafeRead,
-- which is an opaque class member and, unless V.unsafeRead was
-- already specialised to a specific v, GHC has no clue that i is most certainly
-- to be used eagerly. Bang before i hints this vital for optimizer information.
-- | Infix version of @unsafeIndex@.
(!.~) :: (Vector v a) => v a -> Int -> a
(!.~) xs !i = VI.unsafeIndex xs i
-- | Infix version of @unsafeWrite@.
(<~~) :: (MVector v a, PrimMonad m) => v (PrimState m) a -> Int -> a -> m ()
(<~~) xs !i x = V.unsafeWrite xs i x
-- | Infix version of @readPrimArray@.
(!) :: PrimMonad m => A.MutablePrimArray (PrimState m) Int -> Int -> m Int
(!) = A.readPrimArray
-- | Infix version of @indexPrimArray@.
(!.) :: A.PrimArray Int -> Int -> Int
(!.) = A.indexPrimArray
-- | Infix version of @writePrimArray@.
(<~) :: PrimMonad m => A.MutablePrimArray (PrimState m) Int -> Int -> Int -> m ()
(<~) = A.writePrimArray
-- | /O(1)/ Dictionary with given capacity.
initialize
:: (MVector ks k, MVector vs v, PrimMonad m)
=> Int
-> m (Dictionary (PrimState m) ks k vs v)
initialize capacity = do
let !remSize = getFastRem capacity
size = frmPrime remSize
hashCode <- A.replicate size 0
next <- A.replicate size 0
key <- V.new size
value <- V.new size
buckets <- A.replicate size (-1)
refs <- A.replicate 3 0
refs <~ 1 $ -1
dr <- newMutVar Dictionary {..}
return . DRef $ dr
-- | Create a copy of mutable dictionary.
clone
:: (MVector ks k, MVector vs v, PrimMonad m)
=> Dictionary (PrimState m) ks k vs v
-> m (Dictionary (PrimState m) ks k vs v)
clone DRef {..} = do
Dictionary {..} <- readMutVar getDRef
hashCode <- A.clone hashCode
next <- A.clone next
key <- V.clone key
value <- V.clone value
buckets <- A.clone buckets
refs <- A.clone refs
dr <- newMutVar Dictionary {..}
return . DRef $ dr
-- | /O(1)/ Unsafe convert a mutable dictionary to an immutable one without copying.
-- The mutable dictionary may not be used after this operation.
unsafeFreeze
:: (VI.Vector ks k, VI.Vector vs v, PrimMonad m)
=> Dictionary (PrimState m) (Mutable ks) k (Mutable vs) v
-> m (FrozenDictionary ks k vs v)
unsafeFreeze DRef {..} = do
Dictionary {..} <- readMutVar getDRef
let fremSize = remSize
fhashCode <- A.unsafeFreeze hashCode
fnext <- A.unsafeFreeze next
fbuckets <- A.unsafeFreeze buckets
count <- refs ! getCount
freeList <- refs ! getFreeList
freeCount <- refs ! getFreeCount
fkey <- VI.unsafeFreeze key
fvalue <- VI.unsafeFreeze value
return FrozenDictionary {..}
-- | /O(1)/ Unsafely convert immutable 'FrozenDictionary' to a mutable 'Dictionary' without copying.
-- The immutable dictionary may not be used after this operation.
unsafeThaw
:: (Vector ks k, Vector vs v, PrimMonad m)
=> FrozenDictionary ks k vs v
-> m (Dictionary (PrimState m) (Mutable ks) k (Mutable vs) v)
unsafeThaw FrozenDictionary {..} = do
let remSize = fremSize
hashCode <- A.unsafeThaw fhashCode
next <- A.unsafeThaw fnext
buckets <- A.unsafeThaw fbuckets
refs <- A.unsafeThaw $ A.primArrayFromListN 3 [count, freeList, freeCount]
key <- VI.unsafeThaw fkey
value <- VI.unsafeThaw fvalue
dr <- newMutVar Dictionary {..}
return . DRef $ dr
-- | /O(n)/ Retrieve list of keys from 'Dictionary'.
keys :: (Vector ks k, PrimMonad m)
=> Dictionary (PrimState m) (Mutable ks) k vs v -> m (ks k)
keys DRef{..} = do
Dictionary{..} <- readMutVar getDRef
hcs <- A.freeze hashCode
ks <- VI.freeze key
count <- refs ! getCount
return . VI.ifilter (\i _ -> hcs !. i >= 0) . VI.take count $ ks
-- | /O(n)/ Retrieve list of values from 'Dictionary'.
values :: (Vector vs v, PrimMonad m)
=> Dictionary (PrimState m) ks k (Mutable vs) v -> m (vs v)
values DRef{..} = do
Dictionary{..} <- readMutVar getDRef
hcs <- A.freeze hashCode
vs <- VI.freeze value
count <- refs ! getCount
return . VI.ifilter (\i _ -> hcs !. i >= 0) . VI.take count $ vs
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- Find value by given key in 'Dictionary'. Throws an error if value not found.
at :: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Dictionary (PrimState m) ks k vs v -> k -> m v
at d k = fromMaybe (error "KeyNotFoundException!") <$!> at' d k
{-# INLINE at #-}
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- Find value by given key in 'Dictionary'. Like 'at'' but return 'Nothing' if value not found.
at' :: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Dictionary (PrimState m) ks k vs v -> k -> m (Maybe v)
at' d k = do
d_@Dictionary{..} <- readMutVar . getDRef $ d
i <- findEntry_ d_ k
if i >= 0
then Just <$> value !~ i
else return Nothing
{-# INLINE at' #-}
atWithOrElse :: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Dictionary (PrimState m) ks k vs v
-> k
-> (Dictionary (PrimState m) ks k vs v -> Int -> m a)
-> (Dictionary (PrimState m) ks k vs v -> m a)
-> m a
atWithOrElse d k onFound onNothing = do
i <- findEntry d k
if i >= 0
then onFound d i
else onNothing d
{-# INLINE atWithOrElse #-}
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- Find dictionary entry by given key. If entry not found @-1@ returned.
findEntry :: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Dictionary (PrimState m) ks k vs v -> k -> m Int
findEntry d key' = do
d_ <- readMutVar . getDRef $ d
findEntry_ d_ key'
{-# INLINE findEntry #-}
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- Same as 'findEntry', but for 'Dictionary_'.
findEntry_ :: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Dictionary_ (PrimState m) ks k vs v -> k -> m Int
findEntry_ Dictionary{..} key' = do
let hashCode' = hash key' .&. mask
go i | i >= 0 = do
hc <- hashCode ! i
if hc == hashCode'
then do
k <- key !~ i
if k == key'
then return i
else go =<< next ! i
else go =<< next ! i
| otherwise = return $ -1
go =<< buckets ! (hashCode' `fastRem` remSize)
{-# INLINE findEntry_ #-}
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- Insert key and value in dictionary by key's hash.
-- If entry with given key found value will be replaced.
insert :: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Dictionary (PrimState m) ks k vs v -> k -> v -> m ()
insert DRef{..} key' value' = do
d@Dictionary{..} <- readMutVar getDRef
let
hashCode' = hash key' .&. mask
!targetBucket = hashCode' `fastRem` remSize
go i | i >= 0 = do
hc <- hashCode ! i
if hc == hashCode'
then do
k <- key !~ i
if k == key'
then value <~~ i $ value'
else go =<< next ! i
else go =<< next ! i
| otherwise = addOrResize
addOrResize = do
freeCount <- refs ! getFreeCount
if freeCount > 0
then do
index <- refs ! getFreeList
nxt <- next ! index
refs <~ getFreeList $ nxt
refs <~ getFreeCount $ freeCount - 1
add index targetBucket
else do
count <- refs ! getCount
refs <~ getCount $ count + 1
nextLen <- A.length next
if count == nextLen
then do
nd <- resize d count hashCode' key' value'
writeMutVar getDRef nd
else add (fromIntegral count) (fromIntegral targetBucket)
add !index !targetBucket = do
hashCode <~ index $ hashCode'
b <- buckets ! targetBucket
next <~ index $ b
key <~~ index $ key'
value <~~ index $ value'
buckets <~ targetBucket $ index
go =<< buckets ! targetBucket
{-# INLINE insert #-}
insertWithIndex
:: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Int
-- ^ Target bucket, key's hash modulo table size
-> Int
-- ^ Key's hash
-> k
-- ^ Key
-> v
-- ^ Value
-> MutVar (PrimState m) (Dictionary_ (PrimState m) ks k vs v)
-- ^ MutVar with 'Dictionary_'
-> Dictionary_ (PrimState m) ks k vs v
-- ^ 'Dictionary_' itself
-> Int
-> m ()
insertWithIndex !targetBucket !hashCode' key' value' getDRef d@Dictionary{..} = go where
go i
| i >= 0 = do
hc <- hashCode ! i
if hc == hashCode'
then do
k <- key !~ i
if k == key'
then value <~~ i $ value'
else go =<< next ! i
else go =<< next ! i
| otherwise = addOrResize targetBucket hashCode' key' value' getDRef d
{-# INLINE insertWithIndex #-}
addOrResize
:: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Int
-- ^ Target bucket, key's hash modulo table size
-> Int
-- ^ Key's hash
-> k
-- ^ Key
-> v
-- ^ Value
-> MutVar (PrimState m) (Dictionary_ (PrimState m) ks k vs v)
-- ^ MutVar with 'Dictionary_'
-> Dictionary_ (PrimState m) ks k vs v
-- ^ 'Dictionary_' itself
-> m ()
addOrResize !targetBucket !hashCode' !key' !value' dref d@Dictionary{..} = do
freeCount <- refs ! getFreeCount
if freeCount > 0
then do
index <- refs ! getFreeList
nxt <- next ! index
refs <~ getFreeList $ nxt
refs <~ getFreeCount $ freeCount - 1
add index targetBucket hashCode' key' value' d
else do
count <- refs ! getCount
refs <~ getCount $ count + 1
nextLen <- A.length next
if count == nextLen
then do
nd <- resize d count hashCode' key' value'
writeMutVar dref nd
else add (fromIntegral count) (fromIntegral targetBucket) hashCode' key' value' d
{-# INLINE addOrResize #-}
add :: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Int -> Int -> Int -> k -> v -> Dictionary_ (PrimState m) ks k vs v -> m ()
add !index !targetBucket !hashCode' !key' !value' Dictionary{..} = do
hashCode <~ index $ hashCode'
b <- buckets ! targetBucket
next <~ index $ b
key <~~ index $ key'
value <~~ index $ value'
buckets <~ targetBucket $ index
{-# INLINE add #-}
resize
:: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Dictionary_ (PrimState m) ks k vs v
-- ^ The original 'Dictionary_'
-> Int
--
-> Int
-- ^ Key's hash
-> k
-- ^ Key
-> v
-- ^ Value
-> m (Dictionary_ (PrimState m) ks k vs v)
resize Dictionary{..} index hashCode' key' value' = do
let !newRemSize = getFastRem (index*2)
newSize = frmPrime newRemSize
delta = newSize - index
buckets <- A.replicate newSize (-1)
hashCode <- A.growNoZ hashCode delta
next <- A.growNoZ next delta
key <- V.grow key delta
value <- V.grow value delta
let go i | i < index = do
hc <- hashCode ! i
when (hc >= 0) $ do
let !bucket = hc `fastRem` newRemSize
nx <- buckets ! bucket
next <~ i $ nx
buckets <~ bucket $ i
go (i + 1)
| otherwise = return ()
go 0
let !targetBucket = hashCode' `fastRem` newRemSize
hashCode <~ index $ hashCode'
b <- buckets ! targetBucket
next <~ index $ b
key <~~ index $ key'
value <~~ index $ value'
buckets <~ targetBucket $ index
let remSize = newRemSize
return Dictionary{..}
{-# INLINE resize #-}
class DeleteEntry xs where
deleteEntry :: (MVector xs x, PrimMonad m) => xs (PrimState m) x -> Int -> m ()
instance DeleteEntry S.MVector where
deleteEntry _ _ = return ()
instance DeleteEntry U.MVector where
deleteEntry _ _ = return ()
instance DeleteEntry B.MVector where
deleteEntry v i = v <~~ i $ undefined
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- Delete entry from 'Dictionary' by given key.
delete :: (Eq k, MVector ks k, MVector vs v, Hashable k, PrimMonad m, DeleteEntry ks, DeleteEntry vs)
=> Dictionary (PrimState m) ks k vs v -> k -> m ()
delete DRef{..} key' = do
Dictionary{..} <- readMutVar getDRef
let hashCode' = hash key' .&. mask
!bucket = hashCode' `fastRem` remSize
go !last !i | i >= 0 = do
hc <- hashCode ! i
k <- key !~ i
if hc == hashCode' && k == key' then do
nxt <- next ! i
if last < 0
then buckets <~ bucket $ nxt
else next <~ last $ nxt
hashCode <~ i $ -1
next <~ i =<< refs ! getFreeList
deleteEntry key i
deleteEntry value i
refs <~ getFreeList $ i
fc <- refs ! getFreeCount
refs <~ getFreeCount $ fc + 1
else go i =<< next ! i
| otherwise = return ()
go (-1) =<< buckets ! bucket
{-# INLINE delete #-}
deleteWithIndex
:: (Eq k, MVector ks k, MVector vs v, Hashable k, PrimMonad m, DeleteEntry ks, DeleteEntry vs)
=> Int -> Int -> Dictionary_ (PrimState m) ks k vs v -> k -> Int -> Int -> m ()
deleteWithIndex !bucket !hashCode' d@Dictionary{..} key' !last !i
| i >= 0 = do
hc <- hashCode ! i
k <- key !~ i
if hc == hashCode' && k == key' then do
nxt <- next ! i
if last < 0
then buckets <~ bucket $ nxt
else next <~ last $ nxt
hashCode <~ i $ -1
next <~ i =<< refs ! getFreeList
deleteEntry key i
deleteEntry value i
refs <~ getFreeList $ i
fc <- refs ! getFreeCount
refs <~ getFreeCount $ fc + 1
else deleteWithIndex bucket hashCode' d key' i =<< next ! i
| otherwise = return ()
{-# INLINE deleteWithIndex #-}
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- Find value by given key in 'Dictionary'. Like 'lookup'' but return 'Nothing' if value not found.
lookup :: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Dictionary (PrimState m) ks k vs v -> k -> m (Maybe v)
lookup = at'
{-# INLINE lookup #-}
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- Find value by given key in 'Dictionary'. Throws an error if value not found.
lookup' :: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Dictionary (PrimState m) ks k vs v -> k -> m v
lookup' = at
{-# INLINE lookup' #-}
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- Lookup the index of a key, which is its zero-based index in the sequence sorted by keys.
-- The index is a number from 0 up to, but not including, the size of the dictionary.
lookupIndex :: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Dictionary (PrimState m) ks k vs v -> k -> m (Maybe Int)
lookupIndex ht k = do
let safeIndex i | i < 0 = Nothing
| otherwise = Just i
return . safeIndex =<< findEntry ht k
{-# INLINE lookupIndex #-}
-- | /O(1)/ Return 'True' if dictionary is empty, 'False' otherwise.
null
:: (MVector ks k, PrimMonad m)
=> Dictionary (PrimState m) ks k vs v -> m Bool
null ht = return . (== 0) =<< length ht
{-# INLINE null #-}
-- | /O(1)/ Return the number of non-empty entries of dictionary.
length
:: (MVector ks k, PrimMonad m)
=> Dictionary (PrimState m) ks k vs v -> m Int
length DRef {..} = do
Dictionary {..} <- readMutVar getDRef
count <- refs ! getCount
freeCount <- refs ! getFreeCount
return (count - freeCount)
{-# INLINE length #-}
-- | /O(1)/ Return the number of non-empty entries of dictionary. Synonym of 'length'.
size
:: (MVector ks k, PrimMonad m)
=> Dictionary (PrimState m) ks k vs v -> m Int
size = length
{-# INLINE size #-}
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- Return 'True' if the specified key is present in the dictionary, 'False' otherwise.
member
:: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Dictionary (PrimState m) ks k vs v -> k -> m Bool
member ht k = return . (>= 0) =<< findEntry ht k
{-# INLINE member #-}
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- The expression @'findWithDefault' ht def k@ returns
-- the value at key @k@ or returns default value @def@
-- when the key is not in the dictionary.
findWithDefault
:: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Dictionary (PrimState m) ks k vs v -> v -> k -> m v
findWithDefault ht v k = return . fromMaybe v =<< at' ht k
{-# INLINE findWithDefault #-}
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- The expression (@'upsert' ht f k@) updates or inserts the value @x@ at @k@.
--
-- It's a responsibility of 'MVector' @vs@ to force evaluation of the updated value.
-- Unboxed / storable vectors do it automatically. If you use boxed vectors,
-- consider employing strict ones from
-- [@strict-containers@](https://hackage.haskell.org/package/strict-containers)
-- to eliminate potential accumulation of thunks.
--
-- > let f _ = "c"
-- > ht <- fromList [(5,"a"), (3,"b")]
-- > upsert ht f 7
-- > toList ht
-- > [(3, "b"), (5, "a"), (7, "c")]
--
-- > ht <- fromList [(5,"a"), (3,"b")]
-- > upsert ht f 5
-- > toList ht
-- > [(3, "b"), (5, "c")]
--
upsert
:: ( MVector ks k, MVector vs v
, PrimMonad m, Hashable k, Eq k
)
=> Dictionary (PrimState m) ks k vs v -> (Maybe v -> v) -> k -> m ()
upsert ht f k = do
d@Dictionary{..} <- readMutVar . getDRef $ ht
let
hashCode' = hash k .&. mask
!targetBucket = hashCode' `fastRem` remSize
onFound' value' dict i = insertWithIndex targetBucket hashCode' k value' (getDRef ht) dict i
onFound dict i = do
d'@Dictionary{..} <- readMutVar . getDRef $ dict
v <- value !~ i
onFound' (f (Just v)) d' i
onNothing dict = do
d' <- readMutVar . getDRef $ dict
onFound' (f Nothing) d' (-1)
void $ atWithOrElse ht k onFound onNothing
{-# INLINE upsert #-}
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- The expression (@'alter' ht f k@) alters the value @x@ at @k@, or absence thereof.
-- 'alter' can be used to insert, delete, or update a value in a 'Dictionary'.
--
-- It's a responsibility of 'MVector' @vs@ to force evaluation of the updated value.
-- Unboxed / storable vectors do it automatically. If you use boxed vectors,
-- consider employing strict ones from
-- [@strict-containers@](https://hackage.haskell.org/package/strict-containers)
-- to eliminate potential accumulation of thunks.
--
-- > let f _ = Nothing
-- > ht <- fromList [(5,"a"), (3,"b")]
-- > alter ht f 7
-- > toList ht
-- > [(3, "b"), (5, "a")]
--
-- > ht <- fromList [(5,"a"), (3,"b")]
-- > alter ht f 5
-- > toList ht
-- > [(3 "b")]
--
-- > let f _ = Just "c"
-- > ht <- fromList [(5,"a"), (3,"b")]
-- > alter ht f 7
-- > toList ht
-- > [(3, "b"), (5, "a"), (7, "c")]
--
-- > ht <- fromList [(5,"a"), (3,"b")]
-- > alter ht f 5
-- > toList ht
-- > [(3, "b"), (5, "c")]
--
alter
:: ( MVector ks k, MVector vs v, DeleteEntry ks, DeleteEntry vs
, PrimMonad m, Hashable k, Eq k
)
=> Dictionary (PrimState m) ks k vs v -> (Maybe v -> Maybe v) -> k -> m ()
alter ht f k = do
d@Dictionary{..} <- readMutVar . getDRef $ ht
let
hashCode' = hash k .&. mask
!targetBucket = hashCode' `fastRem` remSize
onFound' value' dict i = insertWithIndex targetBucket hashCode' k value' (getDRef ht) dict i
onNothing' dict i = deleteWithIndex targetBucket hashCode' d k (-1) i
onFound dict i = do
d'@Dictionary{..} <- readMutVar . getDRef $ dict
v <- value !~ i
case f (Just v) of
Nothing -> onNothing' d' i
Just v' -> onFound' v' d' i
onNothing dict = do
d' <- readMutVar . getDRef $ dict
case f Nothing of
Nothing -> return ()
Just v' -> onFound' v' d' (-1)
void $ atWithOrElse ht k onFound onNothing
{-# INLINE alter #-}
-- | /O(1)/ in the best case, /O(n)/ in the worst case.
-- The expression (@'alterM' ht f k@) alters the value @x@ at @k@, or absence thereof.
-- 'alterM' can be used to insert, delete, or update a value in a 'Dictionary' in the same @'PrimMonad' m@.
alterM
:: ( MVector ks k, MVector vs v, DeleteEntry ks, DeleteEntry vs
, PrimMonad m, Hashable k, Eq k
)
=> Dictionary (PrimState m) ks k vs v -> (Maybe v -> m (Maybe v)) -> k -> m ()
alterM ht f k = do
d@Dictionary{..} <- readMutVar . getDRef $ ht
let
hashCode' = hash k .&. mask
!targetBucket = hashCode' `fastRem` remSize
onFound' value' dict i = insertWithIndex targetBucket hashCode' k value' (getDRef ht) dict i
onNothing' dict i = deleteWithIndex targetBucket hashCode' d k (-1) i
onFound dict i = do
d'@Dictionary{..} <- readMutVar . getDRef $ dict
v <- value !~ i
res <- f (Just v)
case res of
Nothing -> onNothing' d' i
Just v' -> onFound' v' d' i
onNothing dict = do
d' <- readMutVar . getDRef $ dict
res <- f Nothing
case res of
Nothing -> return ()
Just v' -> onFound' v' d' (-1)
void $ atWithOrElse ht k onFound onNothing
{-# INLINE alterM #-}
-- * Combine
-- | /O(min n m)/ in the best case, /O(min n m * max n m)/ in the worst case.
-- The union of two maps.
-- If a key occurs in both maps,
-- the mapping from the first will be the mapping in the result.
union
:: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> Dictionary (PrimState m) ks k vs v
-> Dictionary (PrimState m) ks k vs v
-> m (Dictionary (PrimState m) ks k vs v)
union = unionWith const
{-# INLINE union #-}
-- | /O(min n m)/ in the best case, /O(min n m * max n m)/ in the worst case.
-- The union of two maps.
-- The provided function (first argument) will be used to compute the result.
unionWith
:: (MVector ks k, MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> (v -> v -> v)
-> Dictionary (PrimState m) ks k vs v
-> Dictionary (PrimState m) ks k vs v
-> m (Dictionary (PrimState m) ks k vs v)
unionWith f = unionWithKey (const f)
{-# INLINE unionWith #-}
-- | /O(min n m)/ in the best case, /O(min n m * max n m)/ in the worst case.
-- The union of two maps.
-- If a key occurs in both maps,
-- the provided function (first argument) will be used to compute the result.
unionWithKey
:: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> (k -> v -> v -> v)
-> Dictionary (PrimState m) ks k vs v
-> Dictionary (PrimState m) ks k vs v
-> m (Dictionary (PrimState m) ks k vs v)
unionWithKey f t1 t2 = do
l1 <- length t1
l2 <- length t2
let smallest = min l1 l2
greatest = max l1 l2
g k v1 v2 = if smallest == l1 then f k v1 v2 else f k v2 v1
(tS, tG) = if smallest == l1 then (t1, t2) else (t2, t1)
ht <- clone tG
dictG <- readMutVar . getDRef $ tG
dictS <- readMutVar . getDRef $ tS
hcsS <- A.freeze . hashCode $ dictS
let indices = catMaybes . zipWith collect [0 ..] . take smallest . A.primArrayToList $ hcsS
collect i _ | hcsS !. i >= 0 = Just i
| otherwise = Nothing
go !i = do
k <- key dictS !~ i
v <- value dictS !~ i
let
hashCode' = hash k .&. mask
!targetBucket = hashCode' `fastRem` remSize dictG
onFound dict i = do
d@Dictionary{..} <- readMutVar . getDRef $ dict
vG <- value !~ i
insertWithIndex targetBucket hashCode' k (g k v vG) (getDRef dict) d i
onNothing dict = do
d@Dictionary{..} <- readMutVar . getDRef $ dict
insertWithIndex targetBucket hashCode' k v (getDRef dict) d
=<< buckets ! targetBucket
void $ atWithOrElse ht k onFound onNothing
mapM_ go indices
return ht
{-# INLINE unionWithKey #-}
-- * Difference and intersection
-- | /O(n)/ in the best case, /O(n * m)/ in the worst case.
-- Difference of two tables. Return elements of the first table
-- not existing in the second.
difference
:: (MVector ks k, MVector vs v, MVector vs w, PrimMonad m, Hashable k, Eq k)
=> Dictionary (PrimState m) ks k vs v
-> Dictionary (PrimState m) ks k vs w
-> m (Dictionary (PrimState m) ks k vs v)
difference a b = do
kvs <- toList a
ht <- initialize 10
mapM_ (go ht) kvs
return ht
where
go ht (!k, !v) = do
mv <- lookup b k
case mv of
Nothing -> insert ht k v
_ -> return ()
{-# INLINE difference #-}
-- | /O(n)/ in the best case, /O(n * m)/ in the worst case.
-- Difference with a combining function. When two equal keys are
-- encountered, the combining function is applied to the values of these keys.
-- If it returns 'Nothing', the element is discarded (proper set difference). If
-- it returns (@'Just' y@), the element is updated with a new value @y@.
differenceWith
:: (MVector ks k, MVector vs v, MVector vs w, PrimMonad m, Hashable k, Eq k)
=> (v -> w -> Maybe v)
-> Dictionary (PrimState m) ks k vs v
-> Dictionary (PrimState m) ks k vs w
-> m (Dictionary (PrimState m) ks k vs v)
differenceWith f a b = do
kvs <- toList a
ht <- initialize 10
mapM_ (go ht) kvs
return ht
where
go ht (!k, !v) = do
mv <- lookup b k
case mv of
Nothing -> insert ht k v
Just w -> maybe (return ()) (insert ht k) (f v w)
{-# INLINE differenceWith #-}
-- | /O(n)/ in the best case, /O(n * m)/ in the worst case.
-- Intersection of two maps. Return elements of the first
-- map for keys existing in the second.
intersection
:: (MVector ks k, MVector vs v, MVector vs w, PrimMonad m, Hashable k, Eq k)
=> Dictionary (PrimState m) ks k vs v
-> Dictionary (PrimState m) ks k vs w
-> m (Dictionary (PrimState m) ks k vs v)
intersection a b = do
kvs <- toList a
ht <- initialize 10
mapM_ (go ht) kvs
return ht
where
go ht (!k, !v) = do
mv <- lookup b k
case mv of
Nothing -> return ()
Just _ -> insert ht k v
{-# INLINE intersection #-}
-- | Intersection of two maps. If a key occurs in both maps
-- the provided function is used to combine the values from the two
-- maps.
intersectionWith
:: (MVector ks k, MVector vs v1, MVector vs v2, MVector vs v3, PrimMonad m, Hashable k, Eq k)
=> (v1 -> v2 -> v3)
-> Dictionary (PrimState m) ks k vs v1
-> Dictionary (PrimState m) ks k vs v2
-> m (Dictionary (PrimState m) ks k vs v3)
intersectionWith f a b = do
kvs <- toList a
ht <- initialize 10
mapM_ (go ht) kvs
return ht
where
go ht (!k, !v) = do
mv <- lookup b k
case mv of
Nothing -> return ()
Just w -> insert ht k (f v w)
{-# INLINE intersectionWith #-}
-- | Intersection of two maps. If a key occurs in both maps
-- the provided function is used to combine the values from the two
-- maps.
intersectionWithKey
:: (MVector ks k, MVector vs v1, MVector vs v2, MVector vs v3, PrimMonad m, Hashable k, Eq k)
=> (k -> v1 -> v2 -> v3)
-> Dictionary (PrimState m) ks k vs v1
-> Dictionary (PrimState m) ks k vs v2
-> m (Dictionary (PrimState m) ks k vs v3)
intersectionWithKey f a b = do
kvs <- toList a
ht <- initialize 10
mapM_ (go ht) kvs
return ht
where
go ht (!k, !v) = do
mv <- lookup b k
case mv of
Nothing -> return ()
Just w -> insert ht k (f k v w)
{-# INLINE intersectionWithKey #-}
-- * List conversions
-- | /O(n)/ Convert list to a 'Dictionary'.
fromList
:: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> [(k, v)] -> m (Dictionary (PrimState m) ks k vs v)
fromList kv = do
ht <- initialize 1
mapM_ (uncurry (insert ht)) kv
return ht
{-# INLINE fromList #-}
-- | /O(n)/ Convert 'Dictionary' to a list.
toList
:: (MVector ks k, MVector vs v, PrimMonad m, Hashable k, Eq k)
=> (Dictionary (PrimState m) ks k vs v) -> m [(k, v)]
toList DRef {..} = do
Dictionary {..} <- readMutVar getDRef
hcs <- A.freeze hashCode
count <- refs ! getCount
let go !i xs
| i < 0 = return xs
| hcs !. i < 0 = go (i - 1) xs
| otherwise = do
k <- key !~ i
v <- value !~ i
go (i - 1) ((k, v) : xs)
{-# INLINE go #-}
go (count - 1) []
{-# INLINE toList #-}
-- * Extras
-- | This data is auto-generated by GenPrimes.hs.
-- The vector contains tuples (p, m, s) such that p is prime
-- and (assuming 64-bit architecture) for every n >= 0
-- it holds that n \`'quot'\` p = (n * m) \`'shiftR'\` (64 + s),
-- enabling faster computation of remainders.
primesWithFastRem :: UI.Vector (Int, Int, Int)
primesWithFastRem = UI.fromList $
if finiteBitSize (0 :: Int) == 32
then [(5,1717986919,1),(11,780903145,1),(17,2021161081,3),(41,1676084799,4),(53,1296593901,4),(67,128207979,1),(83,827945503,4),(101,680390859,4),(131,1049152317,5),(163,210795941,3),(197,1395319325,6),(241,285143057,4),(311,883851791,6),(379,1450543045,7),(457,601483385,6),(557,123374285,4),(673,1633746847,8),(809,84943729,4),(977,562697865,7),(1187,1852589095,9),(1427,24078303,3),(1721,638879505,8),(2069,2125687053,10),(2503,1757110073,10),(3041,723125043,9),(3673,299349749,8),(4409,1995031305,11),(5297,103786259,7),(6367,1381512961,11),(7649,287491601,9),(9181,1916151405,12),(11047,1592485385,12),(13291,330904109,10),(15959,1102336365,12),(19157,57394771,8),(22993,382555257,11),(27611,637144111,12),(33149,1061400709,13),(39779,1768992287,14),(47741,736984397,13),(57301,1228054383,14),(68767,511646169,13),(82529,426327377,13),(99041,177625287,12),(118861,1184051021,15),(142657,1973089135,16),(171203,1644100727,16),(205477,684930617,15),(246577,285382433,14),(295901,951247129,16),(355087,792692993,16),(426131,1321072519,17),(511361,1100885585,17),(613637,917398973,17),(736369,1528988737,18),(883661,637065519,17),(1060421,2123496059,19),(1272539,1769533047,19),(1527061,184324645,16),(1832497,1228815007,19),(2199061,2047964849,20),(2638879,1706633623,20),(3166661,1422191901,20),(3800051,1185141891,20),(4560071,123452015,17),(5472109,411504927,19),(6566551,685839435,20),(7879897,285765133,19),(9455881,238137495,19),(11347079,793790125,21),(13616503,1322982745,22),(16339877,275620167,20),(19607893,229682997,20),(23529511,191402177,20),(28235483,1276011359,23),(33882593,2126684757,24),(40659149,1772235667,24),(48791009,738431071,23),(58549219,1230718279,24),(70259107,1025597921,24),(84310943,427332393,23),(101173139,712220603,24),(121407857,74189591,21),(145689433,1978389031,26),(174827333,206082175,23),(209792827,1373880987,26),(251751509,286225073,24),(302101841,1908166963,27),(362522213,1590139119,27),(435026701,662557897,26),(522032051,1104263141,27),(626438489,1840438487,28),(751726211,766849345,27),(902071483,1278082199,28)]
else [(5,7378697629483820647,1),(7,5270498306774157605,1),(11,3353953467947191203,1),(17,8680820740569200761,3),(29,5088756985850910791,3),(37,3988485205126389539,3),(47,6279742663390485657,4),(67,8810385229234412713,5),(83,3555998857582564167,4),(107,1379195818595106663,3),(131,281629680514649643,1),(163,7242893378634425175,6),(197,1498212716646461045,4),(241,1224680104478642431,4),(293,503665367200260795,3),(353,1672226091667721393,5),(433,681634884940768651,4),(521,9064043153300662599,8),(631,7483940543375032035,8),(761,3102737505170594753,7),(919,642324059149842929,5),(1103,4281383937325154319,8),(1327,7117357170866081709,9),(1597,739255867700320165,6),(1949,2422968949650921095,8),(2339,4037936282915472607,9),(2833,6667654758728761333,10),(3407,5544310517017487777,10),(4093,4615066193862345677,10),(4919,7680205705012637063,11),(5903,6399954576140464461,11),(7103,2659364484228999135,10),(8527,8861013688977873041,12),(10243,7376536534795892163,12),(12301,6142416366629893783,12),(14767,2558334926725615339,11),(17729,4261823212020662385,12),(21277,887788030806907969,10),(25561,1477991153043979567,11),(30677,4926026907840683471,13),(36821,4104063644437376683,13),(44201,1709415255897249461,12),(53051,5696998264003643545,14),(63667,4747066060968119963,14),(76403,7911507529904775825,15),(91691,6592390854143968191,15),(110039,5493169783506889261,15),(132047,9155269105808001505,16),(158507,3813477700084630883,15),(190243,6354640221267690137,16),(228299,5295361870243098633,16),(273967,8825338961368552963,17),(328777,3677038903617434233,16),(394549,6128140330426026551,17),(473471,5106652021410515849,17),(568171,8510999819523553119,18),(681809,3546230160102401625,17),(818173,5910367707634591583,18),(981809,4925299399841024781,18),(1178173,8208817004732779819,19),(1413827,1710146743009758867,17),(1696601,5700460247823167261,19),(2035927,4750370006840634953,19),(2443151,7917158257444614269,20),(2931793,6597605326786054403,20),(3518209,5497914738389352877,20),(4221851,9163190796564855935,21),(5066231,7635977559583866901,21),(6079481,3181655327787695495,20),(7295381,1325689029389559421,19),(8754461,8837923026367501915,22),(10505377,7364919169996114103,22),(12606463,1534356870268374785,20),(15127831,5114497409135273073,22),(18153427,8524148355606494265,23),(21784129,7103451550010217731,23),(26140973,5919538837007808943,23),(31369243,2466468586931991543,22),(37643093,8221561650668425911,24),(45171733,856412266221181587,21),(54206099,5709413064779759723,24),(65047343,4757842450557051481,24),(78056833,247804226362015825,20),(93668203,6608112463123586747,25),(112401881,1376689638411589699,23),(134882263,9177930528088635901,26),(161858731,7648274712381010049,26),(194230481,3186781067811339753,25),(233076601,663912654667005953,23),(279691949,4426083924515754563,26),(335630353,7376806228758340429,27),(402756463,48026077520285669,20),(483307787,5122781269342057073,27),(579969349,4268984357259129137,27),(695963227,7114973844934943811,28),(835155913,5929144582541584783,28),(1002187163,617619185811393333,25),(1202624651,8234922098136039455,29),(1443149623,6862434883013541971,29),(1731779563,357418480311913773,25),(2078135531,4765579610448921293,29),(2493762643,7942632665608538591,30),(2992515199,3309430247035160405,29),(3591018241,5515717075012787271,30),(4309221899,9192861770781641709,31),(5171066297,7660718115355497017,31),(6205279567,6383931751891069761,31),(7446335483,1329985781179588333,29),(8935602619,2216642958858742015,30),(10722723161,3694404925160612267,31),(12867267797,6157341540115949263,32),(15440721377,1282779485812755651,30),(18528865703,8551863215397642261,33),(22234638851,890819084640777303,30),(26681566631,2969396947711947027,32),(32017880003,309312181610871977,29),(38421456013,4124162420469296211,33),(46105747229,6873604032117775405,34),(55326896741,1432000838311112129,32),(66392276177,1193334030347810553,32),(79670731433,3977780100130856927,34),(95604877727,6629633499704948593,35),(114725853301,172646705678443951,30),(137671023989,575489018811937629,32),(165205228889,3836593456372840199,35),(198246274687,6394322426636527325,36),(237895529659,5328602021422103605,36),(285474635629,4440501683924226201,36),(342569562761,7400836139739766199,37),(411083475323,3083681724818056003,36),(493300170481,1284867385097583665,35),(591960204599,8565782567001774073,38),(710352245527,7138152139085745311,38),(852422694637,5948460115872687585,38),(1022907233639,4957050096199058351,38),(1227488680427,4130875079963290535,38),(1472986416527,3442395899935288315,38),(1767583699907,5737326499650006151,39),(2121100439917,2390552708155269385,38),(2545320527903,996063628397011449,37),(3054384633659,6640424188932079035,40),(3665261560423,5533686824061451401,40),(4398313872521,9222811373407653915,41),(5277976647059,7685676144457159429,41),(6333571976483,6404730120368629123,41),(7600286371789,2668637550150294909,40),(9120343646191,8895458500457872893,42),(10944412375433,7412882083712320257,42),(13133294850551,6177401736412164183,42),(15759953820697,5147834780331776433,42),(18911944584839,1072465579235639315,40),(22694333501813,7149770528235642145,43),(27233200202177,2979071053431364413,42),(32679840242663,1241279605594479897,41),(39215808291301,8275197370607624801,44),(47058969949679,3447998904411212491,43),(56470763939783,1436666210167059381,42),(67764916727749,1197221841805716745,42),(81317900073323,7981478945369069699,45),(97581480088031,3325616227235633285,44),(117097776105689,5542693712056936913,45),(140517331326899,4618911426711740825,45),(168620797592327,3849092855592017097,45),(202344957110837,3207577379659307247,45),(242813948533111,5345962299429831765,46),(291376738239791,8909937165714618823,47),(349652085887761,3712473819047632555,46),(419582503065331,1546864091269781275,45),(503499003678427,5156213637565632409,47),(604198804414123,8593689395942569915,48),(725038565296949,7161407829952127767,48),(870046278356531,745979982286515183,45),(1044055534027841,4973199881910083119,48),(1252866640833481,259020827182801985,44),(1503439969000181,6907222058208035475,49),(1804127962800257,2878009190919951291,48),(2164953555360361,299792624054154309,45),(2597944266432433,999308746847181107,47),(3117533119718951,1665514578078618403,48),(3741039743662841,693964407532739155,47),(4489247692395509,4626429383551491517,50),(5387097230874631,7710715639252456949,51),(6464516677049609,1606399091510915659,49),(7757420012459563,5354663638369696637,51),(9308904014951479,2231109849320706117,50),(11170684817941799,7437032831069004279,52),(13404821781530213,3098763679612072587,51),(16085786137836413,5164606132686737109,52),(19302943365403697,8607676887811227891,53),(23163532038484451,7173064073176018721,53),(27796238446181363,2988776697156672123,52),(33355486135417657,4981294495261117009,53),(40026583362501191,8302157492101861143,54),(48031900035001457,1729616144187886737,52),(57638280042001759,2882693573646477365,53),(69165936050402159,1201122322352698065,52),(82999123260482599,8007482149017986309,55),(99598947912579133,6672901790848320973,55),(119518737495095009,347546968273349907,51),(143422484994114059,4633959576977997203,55),(172106981992936889,7723265961629994521,56),(206528378391524347,6436054968024992935,56),(247834054069829309,2681689570010412721,55),(297400864883795143,8938965233368043239,57),(356881037860554209,7449137694473368585,57),(428257245432665101,6207614745394473093,57),(513908694519198103,5173012287828727761,57),(616690433423037709,8621687146381213139,58),(740028520107645211,898092411081376417,55),(888034224129174191,2993641370271254933,57),(1065641068955008969,2494701141892712585,57),(1278769282746010901,4157835236487853859,58),(1534523139295213087,216553918567075721,54),(1841427767154255641,1443692790447171523,57),(2209713320585106689,2406154650745285959,58),(2651655984702128147,8020515502484286167,60),(3181987181642553871,1670940729684226235,58),(3818384617971064327,5569802432280754581,60),(4582061541565277261,1160375506725157187,58)]
getFastRem :: Int -> FastRem
getFastRem n =
(\(p, m, s) -> FastRem p m s) $ fromJust $
UI.find (\(p, _, _) -> p >= n) primesWithFastRem
-- | For 64-bit architectures
-- 'frmPrime' is a prime number such that for each @n@ >= 0
-- it holds that @n@ \`'quot'\` 'frmPrime' = (n * '_frmMulHi') \`'shiftR'\` (64 + s).
data FastRem = FastRem
{ frmPrime :: !Int
, _frmMulHi :: !Int
, _frmShift :: !Int
} deriving (Eq, Ord, Show)
fastRem :: Int -> FastRem -> Int
#ifndef aarch64_HOST_ARCH
fastRem !i (FastRem !p !m !s) = i - p * q
where
q = fromIntegral (mulHi (fromIntegral i) (fromIntegral m)) `unsafeShiftR` s
mulHi (Exts.W# x) (Exts.W# y) =
let (# z, _ #) = Exts.timesWord2# x y in Exts.W# z
#else
-- At the moment GHC NCG does not make use of UMULH instruction,
-- so timesWord2# is painfully slow on ARM. This is being worked on
-- at https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10832,
-- but in the meantime we should resort to a usual division.
fastRem !i (FastRem !p _ _) = i `rem` p
#endif
vector-hashtables-0.1.2.0/src/Data/Vector/Hashtables/Internal/ 0000755 0000000 0000000 00000000000 07346545000 022213 5 ustar 00 0000000 0000000 vector-hashtables-0.1.2.0/src/Data/Vector/Hashtables/Internal/Mask.hs 0000644 0000000 0000000 00000000563 07346545000 023446 0 ustar 00 0000000 0000000 {-|
Module : Data.Vector.Hashtables.Internal.Mask
Description : Provides arch-dependent mask for hashtables.
Copyright : (c) klapaucius, swamp_agr, 2016-2021
License : BSD3
-}
module Data.Vector.Hashtables.Internal.Mask where
-- | 'Int' mask. For 32-bit it is equal to @0x7FFFFFFF@. Otherwise, @0x7FFFFFFFFFFFFFFF@.
mask = maxBound :: Int
{-# INLINE mask #-}
vector-hashtables-0.1.2.0/test/Data/Vector/ 0000755 0000000 0000000 00000000000 07346545000 016551 5 ustar 00 0000000 0000000 vector-hashtables-0.1.2.0/test/Data/Vector/HashTablesSpec.hs 0000644 0000000 0000000 00000036167 07346545000 021753 0 ustar 00 0000000 0000000 {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Vector.HashTablesSpec where
import Control.Monad.Primitive
import Data.Hashable (Hashable (hashWithSalt))
import qualified Data.List as L
import Data.Primitive.MutVar
import Data.Proxy (Proxy (..))
import qualified Data.Set as Set
import Data.Vector.Generic (Mutable, Vector)
import qualified Data.Vector.Generic as VI
import Data.Vector.Generic.Mutable (MVector)
import qualified Data.Vector.Mutable as M
import qualified Data.Vector.Storable.Mutable as SM
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as UM
import GHC.Generics (Generic)
import Test.Hspec.QuickCheck (modifyMaxSuccess)
import Test.QuickCheck (Arbitrary (..), Gen,
NonNegative (..),
Positive (..), Property,
choose, elements, forAll,
generate, property, shuffle,
vector)
import Test.Hspec (Spec, describe, errorCall, it,
shouldBe, shouldThrow)
import qualified Data.Vector.Hashtables.Internal as VH
newtype AlwaysCollide = AC Int
deriving newtype (Arbitrary, SM.Storable, Num, Eq, Ord, Show)
deriving stock Generic
instance Hashable AlwaysCollide where
hashWithSalt _ _ = 1
listN :: Int -> Gen [(Int, Int)]
listN n = do
keys <- vector n
vals <- vector n
let keys' = Set.toList (Set.fromList keys)
return (zip keys' vals)
shuffledListN :: Int -> Gen ([(Int, Int)], [(Int, Int)])
shuffledListN n = do
testData <- listN n
shuffledTestData <- shuffle testData
return (testData, shuffledTestData)
listsForRemoveN :: Int -> Gen ([(Int, Int)], [Int])
listsForRemoveN n = do
testData <- listN n
dropCount <- min (n - 1) <$> choose (1, n)
let deleteData = fst <$> take dropCount testData
return (testData, deleteData)
twoListsN :: Int -> Gen ([(Int, Int)], [(Int, Int)])
twoListsN n = do
list1 <- listN n
list2 <- listN n
return (list1, list2)
spec :: Spec
spec = mutableSpec
*> storableMutableSpec
*> storableKeysSpec
*> unboxedKeysSpec
class HashTableTest ks vs where
specDescription :: Proxy ks -> Proxy vs -> String
testInit :: Proxy ks -> Proxy vs -> Int -> IO (VH.Dictionary (PrimState IO) ks Int vs Int)
testInsert :: (VH.Dictionary (PrimState IO) ks Int vs Int) -> Int -> Int -> IO ()
testAt :: (VH.Dictionary (PrimState IO) ks Int vs Int) -> Int -> IO Int
testAt' :: (VH.Dictionary (PrimState IO) ks Int vs Int) -> Int -> IO (Maybe Int)
testDelete :: (VH.Dictionary (PrimState IO) ks Int vs Int) -> Int -> IO ()
testInitCollide
:: Proxy ks
-> Proxy vs
-> Int
-> IO (VH.Dictionary (PrimState IO) ks AlwaysCollide vs Int)
testInsertCollide
:: (VH.Dictionary (PrimState IO) ks AlwaysCollide vs Int) -> AlwaysCollide -> Int -> IO ()
testAtCollide
:: (VH.Dictionary (PrimState IO) ks AlwaysCollide vs Int) -> AlwaysCollide -> IO Int
testFromList
:: Proxy ks -> Proxy vs -> [(Int, Int)] -> IO (VH.Dictionary (PrimState IO) ks Int vs Int)
testToList :: VH.Dictionary (PrimState IO) ks Int vs Int -> IO [(Int, Int)]
testLength :: VH.Dictionary (PrimState IO) ks Int vs Int -> IO Int
testNull :: VH.Dictionary (PrimState IO) ks Int vs Int -> IO Bool
testMember :: VH.Dictionary (PrimState IO) ks Int vs Int -> Int -> IO Bool
testAlter :: VH.Dictionary (PrimState IO) ks Int vs Int -> (Maybe Int -> Maybe Int) -> Int -> IO ()
testUpsert :: VH.Dictionary (PrimState IO) ks Int vs Int -> (Maybe Int -> Int) -> Int -> IO ()
testUnion
:: VH.Dictionary (PrimState IO) ks Int vs Int
-> VH.Dictionary (PrimState IO) ks Int vs Int
-> IO (VH.Dictionary (PrimState IO) ks Int vs Int)
testDifference
:: VH.Dictionary (PrimState IO) ks Int vs Int
-> VH.Dictionary (PrimState IO) ks Int vs Int
-> IO (VH.Dictionary (PrimState IO) ks Int vs Int)
testIntersection
:: VH.Dictionary (PrimState IO) ks Int vs Int
-> VH.Dictionary (PrimState IO) ks Int vs Int
-> IO (VH.Dictionary (PrimState IO) ks Int vs Int)
mkSpec
:: forall ks vs. (HashTableTest ks vs)
=> Proxy ks -> Proxy vs -> Spec
mkSpec ksp vsp = describe (specDescription ksp vsp) $
modifyMaxSuccess (const 1000) $ do
it "lookup for inserted value at specific index returns value" $
property prop_insertLookup
it "lookup for inserted value at specific index returns nothing" $
property prop_insertLookupNothing
it "lookup for inserted value at specific index throws error" $
property prop_insertLookupError
it "lookup for updated value at specific index returns updated value" $
property prop_insertUpdateLookup
it "lookup for deleted value at specific index returns nothing" $
property prop_insertDeleteLookupNothing
it "lookup for deleted value at specific index throws error" $
property prop_insertDeleteLookupError
it "table size increases when multiple elements added" $
property prop_insertMultipleElements
it "lookup for inserted value with hash collision returns value" $
property prop_insertLookupHashCollisions
it "fromList . toList === id" $ property prop_fromListToList
it "deleted entries are not present in key-value list after deleting from hashtable" $
property prop_insertDeleteKeysSize
it "new table is null" $ property prop_newIsNull
it "non-empty table is not null" $ property prop_fromListIsNotNull
it "inserted key is table member" $ property prop_isMember
it "deleted key is not a member" $ property prop_isNotMember
it "when altering is nothing - key deleted from table" $ property prop_alterDelete
it "when altering is just a result - key updated with result" $ property prop_alterUpdate
it "when upserting a new key - key is set to value" $ property prop_upsertInsert
it "when upserting an existing key - key updated with result" $ property prop_upsertUpdate
it "intersection + symmetric difference of two tables is equal to union of two tables" $ property prop_union
where
prop_insertLookup
:: HashTableTest ks vs => (Int, Int) -> IO ()
prop_insertLookup (x, y) = do
ht <- testInit (Proxy @ks) (Proxy @vs) 10
testInsert ht x y
v <- testAt ht x
v `shouldBe` y
prop_insertLookupNothing :: HashTableTest ks vs => (Int, Int) -> IO ()
prop_insertLookupNothing (x, y) = do
ht <- testInit (Proxy @ks) (Proxy @vs) 10
testInsert ht (x + 1) y
v <- testAt' ht x
v `shouldBe` Nothing
prop_insertLookupError :: HashTableTest ks vs => (Int, Int) -> IO ()
prop_insertLookupError (x, y) = do
ht <- testInit (Proxy @ks) (Proxy @vs) 10
testInsert ht (x + 1) y
testAt ht x `shouldThrow` errorCall "KeyNotFoundException!"
prop_insertUpdateLookup :: HashTableTest ks vs => (Int, Int) -> IO ()
prop_insertUpdateLookup (x, y) = do
ht <- testInit (Proxy @ks) (Proxy @vs) 10
testInsert ht x y
testInsert ht x (y + 1)
v <- testAt ht x
v `shouldBe` (y + 1)
prop_insertDeleteLookupNothing :: HashTableTest ks vs => (Int, Int) -> IO ()
prop_insertDeleteLookupNothing (x, y) = do
ht <- testInit (Proxy @ks) (Proxy @vs) 10
testInsert ht x y
testDelete ht x
v <- testAt' ht x
v `shouldBe` Nothing
prop_insertDeleteLookupError :: HashTableTest ks vs => (Int, Int) -> IO ()
prop_insertDeleteLookupError (x, y) = do
ht <- testInit (Proxy @ks) (Proxy @vs) 10
testInsert ht 0 1
testDelete ht 0
testAt ht 0 `shouldThrow` errorCall "KeyNotFoundException!"
prop_insertMultipleElements
:: HashTableTest ks vs
=> (NonNegative Int) -> Property
prop_insertMultipleElements (NonNegative n) = forAll (listN n) $ \xs -> do
ht <- testInit (Proxy @ks) (Proxy @vs) 2
mapM_ (uncurry (testInsert ht)) xs
htl <- testLength ht
htl `shouldBe` (length . Set.toList . Set.fromList) (fst <$> xs)
prop_insertLookupHashCollisions
:: HashTableTest ks vs => (AlwaysCollide, Int) -> (AlwaysCollide, Int) -> IO ()
prop_insertLookupHashCollisions (x1, y1) (x2, y2) = do
ht <- testInitCollide (Proxy @ks) (Proxy @vs) 10
let x2' = if x1 /= x2 then x2 else x2 + 1
testInsertCollide ht x1 y1
testInsertCollide ht x2' y2
v <- testAtCollide ht x1
v `shouldBe` y1
prop_fromListToList :: NonNegative Int -> Property
prop_fromListToList (NonNegative n) = forAll (shuffledListN n) $ \(xs, ys) -> do
ht <- testFromList (Proxy @ks) (Proxy @vs) xs
xs' <- testToList ht
L.sort xs' `shouldBe` L.sort ys
prop_insertDeleteKeysSize :: NonNegative Int -> Property
prop_insertDeleteKeysSize (NonNegative n) = forAll (listsForRemoveN n) go
where
go (insertData, deleteData) = do
ht <- testInit (Proxy @ks) (Proxy @vs) 2
mapM_ (uncurry (testInsert ht)) insertData
mapM_ (testDelete ht) deleteData
kvs <- testToList ht
L.length insertData - L.length deleteData `shouldBe` L.length kvs
prop_newIsNull :: IO ()
prop_newIsNull = do
ht <- testInit (Proxy @ks) (Proxy @vs) 2
result <- testNull ht
result `shouldBe` True
prop_fromListIsNotNull :: Positive Int -> Property
prop_fromListIsNotNull (Positive n) = forAll (listN n) $ \xs -> do
ht <- testFromList (Proxy @ks) (Proxy @vs) xs
result <- testNull ht
result `shouldBe` False
prop_isMember :: HashTableTest ks vs => (Int, Int) -> IO ()
prop_isMember (x, y) = do
ht <- testInit (Proxy @ks) (Proxy @vs) 10
testInsert ht x y
v <- testMember ht x
v `shouldBe` True
prop_isNotMember :: HashTableTest ks vs => (Int, Int) -> IO ()
prop_isNotMember (x, y) = do
ht <- testInit (Proxy @ks) (Proxy @vs) 10
testInsert ht x y
testDelete ht x
v <- testMember ht x
v `shouldBe` False
prop_alterDelete :: HashTableTest ks vs => (Int, Int) -> IO ()
prop_alterDelete (x, y) = do
ht <- testInit (Proxy @ks) (Proxy @vs) 10
testInsert ht x y
testAlter ht (const Nothing) x
v <- testMember ht x
v `shouldBe` False
prop_alterUpdate :: HashTableTest ks vs => (Int, Int) -> IO ()
prop_alterUpdate (x, y) = do
ht <- testInit (Proxy @ks) (Proxy @vs) 10
testInsert ht x y
testAlter ht (fmap negate) x
v <- testAt ht x
v `shouldBe` (negate y)
prop_upsertInsert :: HashTableTest ks vs => (Int, Int) -> IO ()
prop_upsertInsert (x, y) = do
ht <- testInit (Proxy @ks) (Proxy @vs) 10
testUpsert ht (maybe 0 negate) x
v <- testAt ht x
v `shouldBe` 0
prop_upsertUpdate :: HashTableTest ks vs => (Int, Int) -> IO ()
prop_upsertUpdate (x, y) = do
ht <- testInit (Proxy @ks) (Proxy @vs) 10
testInsert ht x y
testUpsert ht (maybe 0 negate) x
v <- testAt ht x
v `shouldBe` (negate y)
prop_union :: Positive Int -> Property
prop_union (Positive n) = forAll (twoListsN n) $ \(xs, ys) -> do
ht1 <- testFromList (Proxy @ks) (Proxy @vs) xs
ht2 <- testFromList (Proxy @ks) (Proxy @vs) ys
u1 <- testUnion ht1 ht2
d1 <- testDifference ht1 ht2
d2 <- testDifference ht2 ht1
i <- testIntersection ht1 ht2
res <- do
u2 <- testUnion d1 d2
testUnion i u2
resultList <- testToList res
unionList <- testToList u1
Set.fromList resultList `shouldBe` Set.fromList unionList
instance HashTableTest M.MVector M.MVector where
specDescription _ _ = "Data.Vector.HashTables.Mutable keys and values"
testInit _ _ n = VH.initialize n
testInitCollide _ _ n = VH.initialize n
testInsert = VH.insert
testAt = VH.at
testAt' = VH.at'
testDelete = VH.delete
testInsertCollide = VH.insert
testAtCollide = VH.at
testLength = VH.length
testFromList _ _ = VH.fromList
testToList = VH.toList
testNull = VH.null
testMember = VH.member
testAlter = VH.alter
testUpsert = VH.upsert
testUnion = VH.union
testDifference = VH.difference
testIntersection = VH.intersection
mutableSpec :: Spec
mutableSpec = mkSpec (Proxy :: Proxy M.MVector) (Proxy :: Proxy M.MVector)
instance HashTableTest SM.MVector SM.MVector where
specDescription _ _ = "Data.Vector.HashTables.Storable.Mutable keys and values"
testInit _ _ n = VH.initialize n
testInitCollide _ _ n = VH.initialize n
testInsert = VH.insert
testAt = VH.at
testAt' = VH.at'
testDelete = VH.delete
testInsertCollide = VH.insert
testAtCollide = VH.at
testLength = VH.length
testFromList _ _ = VH.fromList
testToList = VH.toList
testNull = VH.null
testMember = VH.member
testAlter = VH.alter
testUpsert = VH.upsert
testUnion = VH.union
testDifference = VH.difference
testIntersection = VH.intersection
storableMutableSpec :: Spec
storableMutableSpec = mkSpec (Proxy @SM.MVector) (Proxy @SM.MVector)
instance HashTableTest SM.MVector M.MVector where
specDescription _ _ = "Data.Vector.HashTables.Mutable keys and Data.Vector.HashTables.Storable.Mutable values"
testInit _ _ n = VH.initialize n
testInitCollide _ _ n = VH.initialize n
testInsert = VH.insert
testAt = VH.at
testAt' = VH.at'
testDelete = VH.delete
testInsertCollide = VH.insert
testAtCollide = VH.at
testLength = VH.length
testFromList _ _ = VH.fromList
testToList = VH.toList
testNull = VH.null
testMember = VH.member
testAlter = VH.alter
testUpsert = VH.upsert
testUnion = VH.union
testDifference = VH.difference
testIntersection = VH.intersection
storableKeysSpec :: Spec
storableKeysSpec = mkSpec (Proxy @SM.MVector) (Proxy @M.MVector)
instance HashTableTest M.MVector UM.MVector where
specDescription _ _ = "Data.Vector.HashTables.Mutable keys and Data.Vector.HashTables.Unboxed.Mutable values"
testInit _ _ n = VH.initialize n
testInitCollide _ _ n = VH.initialize n
testInsert = VH.insert
testAt = VH.at
testAt' = VH.at'
testDelete = VH.delete
testInsertCollide = VH.insert
testAtCollide = VH.at
testLength = VH.length
testFromList _ _ = VH.fromList
testToList = VH.toList
testNull = VH.null
testMember = VH.member
testAlter = VH.alter
testUpsert = VH.upsert
testUnion = VH.union
testDifference = VH.difference
testIntersection = VH.intersection
unboxedKeysSpec :: Spec
unboxedKeysSpec = mkSpec (Proxy @M.MVector) (Proxy @UM.MVector)
vector-hashtables-0.1.2.0/test/ 0000755 0000000 0000000 00000000000 07346545000 014436 5 ustar 00 0000000 0000000 vector-hashtables-0.1.2.0/test/Spec.hs 0000644 0000000 0000000 00000000054 07346545000 015663 0 ustar 00 0000000 0000000 {-# OPTIONS_GHC -F -pgmF hspec-discover #-}
vector-hashtables-0.1.2.0/vector-hashtables.cabal 0000644 0000000 0000000 00000005250 07346545000 020063 0 ustar 00 0000000 0000000 cabal-version: 2.0
name: vector-hashtables
version: 0.1.2.0
synopsis: Efficient vector-based mutable hashtables implementation.
description:
This package provides efficient vector-based hashtable implementation similar to .NET Generic Dictionary implementation (at the time of 2015).
.
See "Data.Vector.Hashtables" for documentation.
homepage: https://github.com/klapaucius/vector-hashtables#readme
license: BSD3
license-file: LICENSE
author: klapaucius
maintainer: klapaucius, swamp_agr, ArtemPelenitsyn
copyright: 2016-2024 klapaucius, swamp_agr
category: Data
build-type: Simple
extra-doc-files: README.md,
changelog.md
extra-source-files: gen/GenPrimes.hs
tested-with:
GHC == 9.8.1
GHC == 9.6.3
GHC == 9.4.7
GHC == 9.2.8
GHC == 9.0.2
GHC == 8.10.7
GHC == 8.8.4
GHC == 8.6.5
library
hs-source-dirs: src
exposed-modules: Data.Vector.Hashtables,
Data.Vector.Hashtables.Internal,
Data.Vector.Hashtables.Internal.Mask,
Data.Primitive.PrimArray.Utils
ghc-options: -O2
build-depends: base >= 4.7 && < 5
, primitive >= 0.7.1.0
, vector
, hashable
default-language: Haskell2010
benchmark vector-hashtables-bench
type: exitcode-stdio-1.0
hs-source-dirs: bench
main-is: Main.hs
ghc-options: -O2 -rtsopts
build-depends: base
, vector-hashtables
, vector
, primitive
, criterion
, hashtables
, unordered-containers
default-language: Haskell2010
test-suite vector-hashtables-test
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: Spec.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
default-language: Haskell2010
other-modules: Data.Vector.HashTablesSpec
build-depends: base
, primitive
, containers
, hashable
, vector
, vector-hashtables
-- Additional dependencies
build-depends:
hspec >= 2.6.0 && < 2.12
, QuickCheck >= 2.12.6.1 && < 2.16
, quickcheck-instances >= 0.3.19 && < 0.4
build-tool-depends:
hspec-discover:hspec-discover >= 2.6.0 && < 2.12
source-repository head
type: git
location: https://github.com/klapaucius/vector-hashtables