{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
module Data.HashTable.Class
( HashTable(..)
, fromList
, fromListWithSizeHint
, toList
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
import Data.Word (Word)
#endif
import Control.Monad.ST
import Data.Hashable
import Prelude hiding (mapM_)
class HashTable h where
new :: ST s (h s k v)
newSized :: Int -> ST s (h s k v)
mutate :: (Eq k, Hashable k) =>
h s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
mutate h s k v
tbl k
k Maybe v -> (Maybe v, a)
f = h s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s 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
mutateST h s k v
tbl k
k ((Maybe v, a) -> ST s (Maybe v, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe v, a) -> ST s (Maybe v, a))
-> (Maybe v -> (Maybe v, a)) -> Maybe v -> ST s (Maybe v, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe v -> (Maybe v, a)
f)
mutateST :: (Eq k, Hashable k) =>
h s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
insert :: (Eq k, Hashable k) => h s k v -> k -> v -> ST s ()
delete :: (Eq k, Hashable k) => h s k v -> k -> ST s ()
lookup :: (Eq k, Hashable k) => h s k v -> k -> ST s (Maybe v)
foldM :: (a -> (k,v) -> ST s a) -> a -> h s k v -> ST s a
mapM_ :: ((k,v) -> ST s b) -> h s k v -> ST s ()
lookupIndex :: (Eq k, Hashable k) => h s k v -> k -> ST s (Maybe Word)
nextByIndex :: h s k v -> Word -> ST s (Maybe (Word,k,v))
computeOverhead :: h s k v -> ST s Double
fromList :: (HashTable h, Eq k, Hashable k) => [(k,v)] -> ST s (h s k v)
fromList :: [(k, v)] -> ST s (h s k v)
fromList [(k, v)]
l = do
h s k v
ht <- ST s (h s k v)
forall (h :: * -> * -> * -> *) s k v. HashTable h => ST s (h s k v)
new
h s k v -> [(k, v)] -> ST s (h s k v)
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> [(k, v)] -> ST s (h s k v)
go h s k v
ht [(k, v)]
l
where
go :: h s k v -> [(k, v)] -> ST s (h s k v)
go h s k v
ht = [(k, v)] -> ST s (h s k v)
go'
where
go' :: [(k, v)] -> ST s (h s k v)
go' [] = h s k v -> ST s (h s k v)
forall (m :: * -> *) a. Monad m => a -> m a
return h s k v
ht
go' ((!k
k,!v
v):[(k, v)]
xs) = do
h s k v -> k -> v -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
insert h s k v
ht k
k v
v
[(k, v)] -> ST s (h s k v)
go' [(k, v)]
xs
{-# INLINE fromList #-}
fromListWithSizeHint :: (HashTable h, Eq k, Hashable k) =>
Int
-> [(k,v)]
-> ST s (h s k v)
fromListWithSizeHint :: Int -> [(k, v)] -> ST s (h s k v)
fromListWithSizeHint Int
n [(k, v)]
l = do
h s k v
ht <- Int -> ST s (h s k v)
forall (h :: * -> * -> * -> *) s k v.
HashTable h =>
Int -> ST s (h s k v)
newSized Int
n
h s k v -> [(k, v)] -> ST s (h s k v)
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> [(k, v)] -> ST s (h s k v)
go h s k v
ht [(k, v)]
l
where
go :: h s k v -> [(k, v)] -> ST s (h s k v)
go h s k v
ht = [(k, v)] -> ST s (h s k v)
go'
where
go' :: [(k, v)] -> ST s (h s k v)
go' [] = h s k v -> ST s (h s k v)
forall (m :: * -> *) a. Monad m => a -> m a
return h s k v
ht
go' ((!k
k,!v
v):[(k, v)]
xs) = do
h s k v -> k -> v -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
insert h s k v
ht k
k v
v
[(k, v)] -> ST s (h s k v)
go' [(k, v)]
xs
{-# INLINE fromListWithSizeHint #-}
toList :: (HashTable h) => h s k v -> ST s [(k,v)]
toList :: h s k v -> ST s [(k, v)]
toList h s k v
ht = do
[(k, v)]
l <- ([(k, v)] -> (k, v) -> ST s [(k, v)])
-> [(k, v)] -> h s k v -> ST s [(k, v)]
forall (h :: * -> * -> * -> *) a k v s.
HashTable h =>
(a -> (k, v) -> ST s a) -> a -> h s k v -> ST s a
foldM [(k, v)] -> (k, v) -> ST s [(k, v)]
forall (m :: * -> *) a. Monad m => [a] -> a -> m [a]
f [] h s k v
ht
[(k, v)] -> ST s [(k, v)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(k, v)]
l
where
f :: [a] -> a -> m [a]
f ![a]
l !a
t = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
ta -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
l)
{-# INLINE toList #-}