-- |
-- Module      :  Case.Hashable.Cuckoo
-- Copyright   :  (c) OleksandrZhabenko 2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- A library that can be used as a @case ... of@ constuction analogue for the Hashable keys.
-- For the large lists can be more time efficient than CaseBi.Arr.getBFst' analogue. For the lists of 'Int's
-- the benchmarks does not show significant improvements, but it definitely uses more memory if linked statically.
-- If you plan to use it together with the former one, please, use qualified import to avoid names ambiguity.


{-# LANGUAGE MagicHash, UnboxedTuples #-}

module Case.Hashable.Cuckoo where

import qualified Data.HashTable.ST.Cuckoo as C
import qualified Data.HashTable.Class as H (fromList, fromListWithSizeHint)
import GHC.ST
import GHC.Magic (runRW# )
import Data.Maybe (fromMaybe)
import Data.Hashable (Hashable(..))
import GHC.Arr

getBFstL' :: (Eq k, Hashable k) => v -> [(k, v)] -> k -> v
getBFstL' :: v -> [(k, v)] -> k -> v
getBFstL' v
def [(k, v)]
pairs k
key = v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe v
def (Maybe v -> v) -> (k -> Maybe v) -> k -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (\(ST STRep RealWorld (Maybe v)
st_rep) -> case STRep RealWorld (Maybe v) -> (# State# RealWorld, Maybe v #)
forall o. (State# RealWorld -> o) -> o
runRW# STRep RealWorld (Maybe v)
st_rep of (# State# RealWorld
_, Maybe v
a #) -> Maybe v
a) (ST RealWorld (Maybe v) -> Maybe v)
-> (k -> ST RealWorld (Maybe v)) -> k -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. -- Actually is rewritten from the GHC.ST.runST to remove the forall constraint
    [(k, v)] -> k -> ST RealWorld (Maybe v)
forall k v s. (Eq k, Hashable k) => [(k, v)] -> k -> ST s (Maybe v)
lookup2 [(k, v)]
pairs (k -> v) -> k -> v
forall a b. (a -> b) -> a -> b
$ k
key
{-# INLINE getBFstL' #-}

lookup2 :: [(k, v)] -> k -> ST s (Maybe v)
lookup2 [(k, v)]
pairs k
key = [(k, v)] -> ST s (HashTable s k v)
forall (h :: * -> * -> * -> *) k v s.
(HashTable h, Eq k, Hashable k) =>
[(k, v)] -> ST s (h s k v)
H.fromList [(k, v)]
pairs ST s (HashTable s k v)
-> (HashTable s k v -> ST s (Maybe v)) -> ST s (Maybe v)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HashTable s k v
ht -> HashTable s k v -> k -> ST s (Maybe v)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
C.lookup HashTable s k v
ht k
key
{-# INLINE lookup2 #-}

lookup2Sized :: Int -> [(k, v)] -> k -> ST s (Maybe v)
lookup2Sized Int
n [(k, v)]
pairs k
key = Int -> [(k, v)] -> ST s (HashTable s k v)
forall (h :: * -> * -> * -> *) k v s.
(HashTable h, Eq k, Hashable k) =>
Int -> [(k, v)] -> ST s (h s k v)
H.fromListWithSizeHint Int
n [(k, v)]
pairs ST s (HashTable s k v)
-> (HashTable s k v -> ST s (Maybe v)) -> ST s (Maybe v)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HashTable s k v
ht -> HashTable s k v -> k -> ST s (Maybe v)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
C.lookup HashTable s k v
ht k
key
{-# INLINE lookup2Sized #-}

lookupL :: [(k, v)] -> t k -> ST s (t (Maybe v))
lookupL [(k, v)]
pairs t k
keys = [(k, v)] -> ST s (HashTable s k v)
forall (h :: * -> * -> * -> *) k v s.
(HashTable h, Eq k, Hashable k) =>
[(k, v)] -> ST s (h s k v)
H.fromList [(k, v)]
pairs ST s (HashTable s k v)
-> (HashTable s k v -> ST s (t (Maybe v))) -> ST s (t (Maybe v))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HashTable s k v
ht -> (k -> ST s (Maybe v)) -> t k -> ST s (t (Maybe v))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HashTable s k v -> k -> ST s (Maybe v)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
C.lookup HashTable s k v
ht) t k
keys
{-# INLINE lookupL #-}

lookupLSized :: Int -> [(k, v)] -> t k -> ST s (t (Maybe v))
lookupLSized Int
n [(k, v)]
pairs t k
keys = Int -> [(k, v)] -> ST s (HashTable s k v)
forall (h :: * -> * -> * -> *) k v s.
(HashTable h, Eq k, Hashable k) =>
Int -> [(k, v)] -> ST s (h s k v)
H.fromListWithSizeHint Int
n [(k, v)]
pairs ST s (HashTable s k v)
-> (HashTable s k v -> ST s (t (Maybe v))) -> ST s (t (Maybe v))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HashTable s k v
ht -> (k -> ST s (Maybe v)) -> t k -> ST s (t (Maybe v))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HashTable s k v -> k -> ST s (Maybe v)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
C.lookup HashTable s k v
ht) t k
keys
{-# INLINE lookupLSized #-}

getBFstLL' :: (Eq k, Hashable k) => b -> [(k, b)] -> [k] -> [b]
getBFstLL' :: b -> [(k, b)] -> [k] -> [b]
getBFstLL' b
def [(k, b)]
pairs [k]
keys =
 (\(ST STRep RealWorld [Maybe b]
st_rep) -> case STRep RealWorld [Maybe b] -> (# State# RealWorld, [Maybe b] #)
forall o. (State# RealWorld -> o) -> o
runRW# STRep RealWorld [Maybe b]
st_rep of (# State# RealWorld
_, [Maybe b]
a #) -> (Maybe b -> b) -> [Maybe b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (\Maybe b
x -> case Maybe b
x of { Just b
y -> b
y; ~Maybe b
rr -> b
def }) [Maybe b]
a)
   ([(k, b)] -> [k] -> ST RealWorld [Maybe b]
forall k (t :: * -> *) v s.
(Eq k, Hashable k, Traversable t) =>
[(k, v)] -> t k -> ST s (t (Maybe v))
lookupL [(k, b)]
pairs [k]
keys)
{-# INLINE getBFstLL' #-}

getBFstLArr' :: (Hashable k, Ix i, Eq k) => b -> [(k, b)] -> Array i k -> Array i b
getBFstLArr' :: b -> [(k, b)] -> Array i k -> Array i b
getBFstLArr' b
def [(k, b)]
pairs Array i k
keysArr =
 (\(ST STRep RealWorld (Array i (Maybe b))
st_rep) -> case STRep RealWorld (Array i (Maybe b))
-> (# State# RealWorld, Array i (Maybe b) #)
forall o. (State# RealWorld -> o) -> o
runRW# STRep RealWorld (Array i (Maybe b))
st_rep of (# State# RealWorld
_, Array i (Maybe b)
a #) -> (Maybe b -> b) -> Array i (Maybe b) -> Array i b
forall a b i. (a -> b) -> Array i a -> Array i b
amap (\Maybe b
x -> case Maybe b
x of { Just b
y -> b
y; ~Maybe b
rr -> b
def }) Array i (Maybe b)
a)
   ([(k, b)] -> Array i k -> ST RealWorld (Array i (Maybe b))
forall k (t :: * -> *) v s.
(Eq k, Hashable k, Traversable t) =>
[(k, v)] -> t k -> ST s (t (Maybe v))
lookupL [(k, b)]
pairs Array i k
keysArr)
{-# INLINE getBFstLArr' #-}

getBFstLSized' :: (Eq k, Hashable k) => Int -> v -> [(k, v)] -> k -> v
getBFstLSized' :: Int -> v -> [(k, v)] -> k -> v
getBFstLSized' Int
n v
def [(k, v)]
pairs k
key = v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe v
def (Maybe v -> v) -> (k -> Maybe v) -> k -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (\(ST STRep RealWorld (Maybe v)
st_rep) -> case STRep RealWorld (Maybe v) -> (# State# RealWorld, Maybe v #)
forall o. (State# RealWorld -> o) -> o
runRW# STRep RealWorld (Maybe v)
st_rep of (# State# RealWorld
_, Maybe v
a #) -> Maybe v
a) (ST RealWorld (Maybe v) -> Maybe v)
-> (k -> ST RealWorld (Maybe v)) -> k -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. -- Actually is rewritten from the GHC.ST.runST to remove the forall constraint
    Int -> [(k, v)] -> k -> ST RealWorld (Maybe v)
forall k v s.
(Eq k, Hashable k) =>
Int -> [(k, v)] -> k -> ST s (Maybe v)
lookup2Sized Int
n [(k, v)]
pairs (k -> v) -> k -> v
forall a b. (a -> b) -> a -> b
$ k
key
{-# INLINE getBFstLSized' #-}

getBFstLLSized' :: (Eq k, Hashable k) => Int -> b -> [(k, b)] -> [k] -> [b]
getBFstLLSized' :: Int -> b -> [(k, b)] -> [k] -> [b]
getBFstLLSized' Int
n b
def [(k, b)]
pairs [k]
keys =
 (\(ST STRep RealWorld [Maybe b]
st_rep) -> case STRep RealWorld [Maybe b] -> (# State# RealWorld, [Maybe b] #)
forall o. (State# RealWorld -> o) -> o
runRW# STRep RealWorld [Maybe b]
st_rep of (# State# RealWorld
_, [Maybe b]
a #) -> (Maybe b -> b) -> [Maybe b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (\Maybe b
x -> case Maybe b
x of { Just b
y -> b
y; ~Maybe b
rr -> b
def }) [Maybe b]
a)
   (Int -> [(k, b)] -> [k] -> ST RealWorld [Maybe b]
forall k (t :: * -> *) v s.
(Eq k, Hashable k, Traversable t) =>
Int -> [(k, v)] -> t k -> ST s (t (Maybe v))
lookupLSized Int
n [(k, b)]
pairs [k]
keys)
{-# INLINE getBFstLLSized' #-}

getBFstLArrSized' :: (Hashable k, Ix i, Eq k) => Int -> b -> [(k, b)] -> Array i k -> Array i b
getBFstLArrSized' :: Int -> b -> [(k, b)] -> Array i k -> Array i b
getBFstLArrSized' Int
n b
def [(k, b)]
pairs Array i k
keysArr =
 (\(ST STRep RealWorld (Array i (Maybe b))
st_rep) -> case STRep RealWorld (Array i (Maybe b))
-> (# State# RealWorld, Array i (Maybe b) #)
forall o. (State# RealWorld -> o) -> o
runRW# STRep RealWorld (Array i (Maybe b))
st_rep of (# State# RealWorld
_, Array i (Maybe b)
a #) -> (Maybe b -> b) -> Array i (Maybe b) -> Array i b
forall a b i. (a -> b) -> Array i a -> Array i b
amap (\Maybe b
x -> case Maybe b
x of { Just b
y -> b
y; ~Maybe b
rr -> b
def }) Array i (Maybe b)
a)
   (Int -> [(k, b)] -> Array i k -> ST RealWorld (Array i (Maybe b))
forall k (t :: * -> *) v s.
(Eq k, Hashable k, Traversable t) =>
Int -> [(k, v)] -> t k -> ST s (t (Maybe v))
lookupLSized Int
n [(k, b)]
pairs Array i k
keysArr)
{-# INLINE getBFstLArrSized' #-}