{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ExplicitForAll #-}
module Data.HashTable.IO
( BasicHashTable
, CuckooHashTable
, LinearHashTable
, IOHashTable
, new
, newSized
, insert
, delete
, lookup
, mutate
, mutateIO
, fromList
, fromListWithSizeHint
, toList
, mapM_
, foldM
, computeOverhead
, lookupIndex
, nextByIndex
) where
#if !MIN_VERSION_base(4,8,0)
import Data.Word
#endif
import Control.Monad.Primitive (PrimState)
import Control.Monad.ST (stToIO)
import Data.Hashable (Hashable)
import qualified Data.HashTable.Class as C
import GHC.IO (ioToST)
import Prelude hiding (lookup, mapM_)
import Data.HashTable.Internal.Utils (unsafeIOToST)
import qualified Data.HashTable.ST.Basic as B
import qualified Data.HashTable.ST.Cuckoo as Cu
import qualified Data.HashTable.ST.Linear as L
type BasicHashTable k v = IOHashTable (B.HashTable) k v
type CuckooHashTable k v = IOHashTable (Cu.HashTable) k v
type LinearHashTable k v = IOHashTable (L.HashTable) k v
type IOHashTable tabletype k v = tabletype (PrimState IO) k v
new :: C.HashTable h => IO (IOHashTable h k v)
new :: IO (IOHashTable h k v)
new = ST RealWorld (h RealWorld k v) -> IO (h RealWorld k v)
forall a. ST RealWorld a -> IO a
stToIO ST RealWorld (h RealWorld k v)
forall (h :: * -> * -> * -> *) s k v. HashTable h => ST s (h s k v)
C.new
{-# INLINE new #-}
{-# SPECIALIZE INLINE new :: IO (BasicHashTable k v) #-}
{-# SPECIALIZE INLINE new :: IO (LinearHashTable k v) #-}
{-# SPECIALIZE INLINE new :: IO (CuckooHashTable k v) #-}
newSized :: C.HashTable h => Int -> IO (IOHashTable h k v)
newSized :: Int -> IO (IOHashTable h k v)
newSized = ST RealWorld (h RealWorld k v) -> IO (h RealWorld k v)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (h RealWorld k v) -> IO (h RealWorld k v))
-> (Int -> ST RealWorld (h RealWorld k v))
-> Int
-> IO (h RealWorld k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ST RealWorld (h RealWorld k v)
forall (h :: * -> * -> * -> *) s k v.
HashTable h =>
Int -> ST s (h s k v)
C.newSized
{-# INLINE newSized #-}
{-# SPECIALIZE INLINE newSized :: Int -> IO (BasicHashTable k v) #-}
{-# SPECIALIZE INLINE newSized :: Int -> IO (LinearHashTable k v) #-}
{-# SPECIALIZE INLINE newSized :: Int -> IO (CuckooHashTable k v) #-}
insert :: (C.HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
insert :: IOHashTable h k v -> k -> v -> IO ()
insert IOHashTable h k v
h k
k v
v = ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld () -> IO ()) -> ST RealWorld () -> IO ()
forall a b. (a -> b) -> a -> b
$ h RealWorld k v -> k -> v -> ST RealWorld ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
C.insert h RealWorld k v
IOHashTable h k v
h k
k v
v
{-# INLINE insert #-}
{-# SPECIALIZE INLINE insert :: Hashable k =>
BasicHashTable k v -> k -> v -> IO () #-}
{-# SPECIALIZE INLINE insert :: Hashable k =>
LinearHashTable k v -> k -> v -> IO () #-}
{-# SPECIALIZE INLINE insert :: Hashable k =>
CuckooHashTable k v -> k -> v -> IO () #-}
delete :: (C.HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO ()
delete :: IOHashTable h k v -> k -> IO ()
delete IOHashTable h k v
h k
k = ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld () -> IO ()) -> ST RealWorld () -> IO ()
forall a b. (a -> b) -> a -> b
$ h RealWorld k v -> k -> ST RealWorld ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s ()
C.delete h RealWorld k v
IOHashTable h k v
h k
k
{-# INLINE delete #-}
{-# SPECIALIZE INLINE delete :: Hashable k =>
BasicHashTable k v -> k -> IO () #-}
{-# SPECIALIZE INLINE delete :: Hashable k =>
LinearHashTable k v -> k -> IO () #-}
{-# SPECIALIZE INLINE delete :: Hashable k =>
CuckooHashTable k v -> k -> IO () #-}
lookup :: (C.HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO (Maybe v)
lookup :: IOHashTable h k v -> k -> IO (Maybe v)
lookup IOHashTable h k v
h k
k = ST RealWorld (Maybe v) -> IO (Maybe v)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (Maybe v) -> IO (Maybe v))
-> ST RealWorld (Maybe v) -> IO (Maybe v)
forall a b. (a -> b) -> a -> b
$ h RealWorld k v -> k -> ST RealWorld (Maybe v)
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
C.lookup h RealWorld k v
IOHashTable h k v
h k
k
{-# INLINE lookup #-}
{-# SPECIALIZE INLINE lookup :: Hashable k =>
BasicHashTable k v -> k -> IO (Maybe v) #-}
{-# SPECIALIZE INLINE lookup :: Hashable k =>
LinearHashTable k v -> k -> IO (Maybe v) #-}
{-# SPECIALIZE INLINE lookup :: Hashable k =>
CuckooHashTable k v -> k -> IO (Maybe v) #-}
lookupIndex :: (C.HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO (Maybe Word)
lookupIndex :: IOHashTable h k v -> k -> IO (Maybe Word)
lookupIndex IOHashTable h k v
h k
k = ST RealWorld (Maybe Word) -> IO (Maybe Word)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (Maybe Word) -> IO (Maybe Word))
-> ST RealWorld (Maybe Word) -> IO (Maybe Word)
forall a b. (a -> b) -> a -> b
$ h RealWorld k v -> k -> ST RealWorld (Maybe Word)
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe Word)
C.lookupIndex h RealWorld k v
IOHashTable h k v
h k
k
{-# INLINE lookupIndex #-}
{-# SPECIALIZE INLINE lookupIndex :: Hashable k =>
BasicHashTable k v -> k -> IO (Maybe Word) #-}
{-# SPECIALIZE INLINE lookupIndex :: Hashable k =>
LinearHashTable k v -> k -> IO (Maybe Word) #-}
{-# SPECIALIZE INLINE lookupIndex :: Hashable k =>
CuckooHashTable k v -> k -> IO (Maybe Word) #-}
nextByIndex :: (C.HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> Word -> IO (Maybe (Word,k,v))
nextByIndex :: IOHashTable h k v -> Word -> IO (Maybe (Word, k, v))
nextByIndex IOHashTable h k v
h Word
k = ST RealWorld (Maybe (Word, k, v)) -> IO (Maybe (Word, k, v))
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (Maybe (Word, k, v)) -> IO (Maybe (Word, k, v)))
-> ST RealWorld (Maybe (Word, k, v)) -> IO (Maybe (Word, k, v))
forall a b. (a -> b) -> a -> b
$ h RealWorld k v -> Word -> ST RealWorld (Maybe (Word, k, v))
forall (h :: * -> * -> * -> *) s k v.
HashTable h =>
h s k v -> Word -> ST s (Maybe (Word, k, v))
C.nextByIndex h RealWorld k v
IOHashTable h k v
h Word
k
{-# INLINE nextByIndex #-}
{-# SPECIALIZE INLINE nextByIndex :: Hashable k =>
BasicHashTable k v -> Word -> IO (Maybe (Word,k,v)) #-}
{-# SPECIALIZE INLINE nextByIndex :: Hashable k =>
LinearHashTable k v -> Word -> IO (Maybe (Word,k,v)) #-}
{-# SPECIALIZE INLINE nextByIndex :: Hashable k =>
CuckooHashTable k v -> Word -> IO (Maybe (Word,k,v)) #-}
mutateIO :: (C.HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> (Maybe v -> IO (Maybe v, a)) -> IO a
mutateIO :: IOHashTable h k v -> k -> (Maybe v -> IO (Maybe v, a)) -> IO a
mutateIO IOHashTable h k v
h k
k Maybe v -> IO (Maybe v, a)
f = ST RealWorld a -> IO a
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld a -> IO a) -> ST RealWorld a -> IO a
forall a b. (a -> b) -> a -> b
$ h RealWorld k v
-> k -> (Maybe v -> ST RealWorld (Maybe v, a)) -> ST RealWorld a
forall (h :: * -> * -> * -> *) k s v a.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
C.mutateST h RealWorld k v
IOHashTable h k v
h k
k (IO (Maybe v, a) -> ST RealWorld (Maybe v, a)
forall a. IO a -> ST RealWorld a
ioToST (IO (Maybe v, a) -> ST RealWorld (Maybe v, a))
-> (Maybe v -> IO (Maybe v, a))
-> Maybe v
-> ST RealWorld (Maybe v, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe v -> IO (Maybe v, a)
f)
{-# INLINE mutateIO #-}
{-# SPECIALIZE INLINE mutateIO :: Hashable k =>
BasicHashTable k v -> k -> (Maybe v -> IO (Maybe v, a)) -> IO a #-}
{-# SPECIALIZE INLINE mutateIO :: Hashable k =>
LinearHashTable k v -> k -> (Maybe v -> IO (Maybe v, a)) -> IO a #-}
{-# SPECIALIZE INLINE mutateIO :: Hashable k =>
CuckooHashTable k v -> k -> (Maybe v -> IO (Maybe v, a)) -> IO a #-}
mutate :: (C.HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> (Maybe v -> (Maybe v, a)) -> IO a
mutate :: IOHashTable h k v -> k -> (Maybe v -> (Maybe v, a)) -> IO a
mutate IOHashTable h k v
h k
k Maybe v -> (Maybe v, a)
f = ST RealWorld a -> IO a
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld a -> IO a) -> ST RealWorld a -> IO a
forall a b. (a -> b) -> a -> b
$ h RealWorld k v -> k -> (Maybe v -> (Maybe v, a)) -> ST RealWorld a
forall (h :: * -> * -> * -> *) k s v a.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
C.mutate h RealWorld k v
IOHashTable h k v
h k
k Maybe v -> (Maybe v, a)
f
{-# INLINE mutate #-}
{-# SPECIALIZE INLINE mutate :: Hashable k =>
BasicHashTable k v -> k -> (Maybe v -> (Maybe v, a)) -> IO a #-}
{-# SPECIALIZE INLINE mutate :: Hashable k =>
LinearHashTable k v -> k -> (Maybe v -> (Maybe v, a)) -> IO a #-}
{-# SPECIALIZE INLINE mutate :: Hashable k =>
CuckooHashTable k v -> k -> (Maybe v -> (Maybe v, a)) -> IO a #-}
fromList :: (C.HashTable h, Eq k, Hashable k) =>
[(k,v)] -> IO (IOHashTable h k v)
fromList :: [(k, v)] -> IO (IOHashTable h k v)
fromList = ST RealWorld (h RealWorld k v) -> IO (h RealWorld k v)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (h RealWorld k v) -> IO (h RealWorld k v))
-> ([(k, v)] -> ST RealWorld (h RealWorld k v))
-> [(k, v)]
-> IO (h RealWorld k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, v)] -> ST RealWorld (h RealWorld k v)
forall (h :: * -> * -> * -> *) k v s.
(HashTable h, Eq k, Hashable k) =>
[(k, v)] -> ST s (h s k v)
C.fromList
{-# INLINE fromList #-}
{-# SPECIALIZE INLINE fromList :: Hashable k =>
[(k,v)] -> IO (BasicHashTable k v) #-}
{-# SPECIALIZE INLINE fromList :: Hashable k =>
[(k,v)] -> IO (LinearHashTable k v) #-}
{-# SPECIALIZE INLINE fromList :: Hashable k =>
[(k,v)] -> IO (CuckooHashTable k v) #-}
fromListWithSizeHint :: (C.HashTable h, Eq k, Hashable k) =>
Int -> [(k,v)] -> IO (IOHashTable h k v)
fromListWithSizeHint :: Int -> [(k, v)] -> IO (IOHashTable h k v)
fromListWithSizeHint Int
n = ST RealWorld (h RealWorld k v) -> IO (h RealWorld k v)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (h RealWorld k v) -> IO (h RealWorld k v))
-> ([(k, v)] -> ST RealWorld (h RealWorld k v))
-> [(k, v)]
-> IO (h RealWorld k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(k, v)] -> ST RealWorld (h RealWorld k v)
forall (h :: * -> * -> * -> *) k v s.
(HashTable h, Eq k, Hashable k) =>
Int -> [(k, v)] -> ST s (h s k v)
C.fromListWithSizeHint Int
n
{-# INLINE fromListWithSizeHint #-}
{-# SPECIALIZE INLINE fromListWithSizeHint :: Hashable k =>
Int -> [(k,v)] -> IO (BasicHashTable k v) #-}
{-# SPECIALIZE INLINE fromListWithSizeHint :: Hashable k =>
Int -> [(k,v)] -> IO (LinearHashTable k v) #-}
{-# SPECIALIZE INLINE fromListWithSizeHint :: Hashable k =>
Int -> [(k,v)] -> IO (CuckooHashTable k v) #-}
toList :: (C.HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k,v)]
toList :: IOHashTable h k v -> IO [(k, v)]
toList = ST RealWorld [(k, v)] -> IO [(k, v)]
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld [(k, v)] -> IO [(k, v)])
-> (h RealWorld k v -> ST RealWorld [(k, v)])
-> h RealWorld k v
-> IO [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h RealWorld k v -> ST RealWorld [(k, v)]
forall (h :: * -> * -> * -> *) s k v.
HashTable h =>
h s k v -> ST s [(k, v)]
C.toList
{-# INLINE toList #-}
{-# SPECIALIZE INLINE toList :: Hashable k =>
BasicHashTable k v -> IO [(k,v)] #-}
{-# SPECIALIZE INLINE toList :: Hashable k =>
LinearHashTable k v -> IO [(k,v)] #-}
{-# SPECIALIZE INLINE toList :: Hashable k =>
CuckooHashTable k v -> IO [(k,v)] #-}
foldM :: (C.HashTable h) =>
(a -> (k,v) -> IO a)
-> a
-> IOHashTable h k v -> IO a
foldM :: (a -> (k, v) -> IO a) -> a -> IOHashTable h k v -> IO a
foldM a -> (k, v) -> IO a
f a
seed IOHashTable h k v
ht = ST RealWorld a -> IO a
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld a -> IO a) -> ST RealWorld a -> IO a
forall a b. (a -> b) -> a -> b
$ (a -> (k, v) -> ST RealWorld a)
-> a -> h RealWorld k v -> ST RealWorld a
forall (h :: * -> * -> * -> *) a k v s.
HashTable h =>
(a -> (k, v) -> ST s a) -> a -> h s k v -> ST s a
C.foldM a -> (k, v) -> ST RealWorld a
forall s. a -> (k, v) -> ST s a
f' a
seed h RealWorld k v
IOHashTable h k v
ht
where
f' :: a -> (k, v) -> ST s a
f' !a
i !(k, v)
t = IO a -> ST s a
forall a s. IO a -> ST s a
unsafeIOToST (IO a -> ST s a) -> IO a -> ST s a
forall a b. (a -> b) -> a -> b
$ a -> (k, v) -> IO a
f a
i (k, v)
t
{-# INLINE foldM #-}
{-# SPECIALIZE INLINE foldM :: (a -> (k,v) -> IO a) -> a
-> BasicHashTable k v -> IO a #-}
{-# SPECIALIZE INLINE foldM :: (a -> (k,v) -> IO a) -> a
-> LinearHashTable k v -> IO a #-}
{-# SPECIALIZE INLINE foldM :: (a -> (k,v) -> IO a) -> a
-> CuckooHashTable k v -> IO a #-}
mapM_ :: (C.HashTable h) => ((k,v) -> IO a) -> IOHashTable h k v -> IO ()
mapM_ :: ((k, v) -> IO a) -> IOHashTable h k v -> IO ()
mapM_ (k, v) -> IO a
f IOHashTable h k v
ht = ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld () -> IO ()) -> ST RealWorld () -> IO ()
forall a b. (a -> b) -> a -> b
$ ((k, v) -> ST RealWorld a) -> h RealWorld k v -> ST RealWorld ()
forall (h :: * -> * -> * -> *) k v s b.
HashTable h =>
((k, v) -> ST s b) -> h s k v -> ST s ()
C.mapM_ (k, v) -> ST RealWorld a
forall s. (k, v) -> ST s a
f' h RealWorld k v
IOHashTable h k v
ht
where
f' :: (k, v) -> ST s a
f' = IO a -> ST s a
forall a s. IO a -> ST s a
unsafeIOToST (IO a -> ST s a) -> ((k, v) -> IO a) -> (k, v) -> ST s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, v) -> IO a
f
{-# INLINE mapM_ #-}
{-# SPECIALIZE INLINE mapM_ :: ((k,v) -> IO a) -> BasicHashTable k v
-> IO () #-}
{-# SPECIALIZE INLINE mapM_ :: ((k,v) -> IO a) -> LinearHashTable k v
-> IO () #-}
{-# SPECIALIZE INLINE mapM_ :: ((k,v) -> IO a) -> CuckooHashTable k v
-> IO () #-}
computeOverhead :: (C.HashTable h) => IOHashTable h k v -> IO Double
computeOverhead :: IOHashTable h k v -> IO Double
computeOverhead = ST RealWorld Double -> IO Double
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld Double -> IO Double)
-> (h RealWorld k v -> ST RealWorld Double)
-> h RealWorld k v
-> IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h RealWorld k v -> ST RealWorld Double
forall (h :: * -> * -> * -> *) s k v.
HashTable h =>
h s k v -> ST s Double
C.computeOverhead
{-# INLINE computeOverhead #-}