Cuckoo.hs

-- |
-- 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' def pairs key = fromMaybe def .
  (\(ST st_rep) -> case runRW# st_rep of (# _, a #) -> a) . -- Actually is rewritten from the GHC.ST.runST to remove the forall constraint
    lookup2 pairs $ key
{-# INLINE getBFstL' #-}

lookup2 pairs key = H.fromList pairs >>= \ht -> C.lookup ht key
{-# INLINE lookup2 #-}

lookup2Sized n pairs key = H.fromListWithSizeHint n pairs >>= \ht -> C.lookup ht key
{-# INLINE lookup2Sized #-}

lookupL pairs keys = H.fromList pairs >>= \ht -> mapM (C.lookup ht) keys
{-# INLINE lookupL #-}

lookupLSized n pairs keys = H.fromListWithSizeHint n pairs >>= \ht -> mapM (C.lookup ht) keys
{-# INLINE lookupLSized #-}

getBFstLL' :: (Eq k, Hashable k) => b -> [(k, b)] -> [k] -> [b]
getBFstLL' def pairs keys =
 (\(ST st_rep) -> case runRW# st_rep of (# _, a #) -> map (\x -> case x of { Just y -> y; ~rr -> def }) a)
   (lookupL pairs keys)
{-# INLINE getBFstLL' #-}

getBFstLArr' :: (Hashable k, Ix i, Eq k) => b -> [(k, b)] -> Array i k -> Array i b
getBFstLArr' def pairs keysArr =
 (\(ST st_rep) -> case runRW# st_rep of (# _, a #) -> amap (\x -> case x of { Just y -> y; ~rr -> def }) a)
   (lookupL pairs keysArr)
{-# INLINE getBFstLArr' #-}

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

getBFstLLSized' :: (Eq k, Hashable k) => Int -> b -> [(k, b)] -> [k] -> [b]
getBFstLLSized' n def pairs keys =
 (\(ST st_rep) -> case runRW# st_rep of (# _, a #) -> map (\x -> case x of { Just y -> y; ~rr -> def }) a)
   (lookupLSized n pairs keys)
{-# INLINE getBFstLLSized' #-}

getBFstLArrSized' :: (Hashable k, Ix i, Eq k) => Int -> b -> [(k, b)] -> Array i k -> Array i b
getBFstLArrSized' n def pairs keysArr =
 (\(ST st_rep) -> case runRW# st_rep of (# _, a #) -> amap (\x -> case x of { Just y -> y; ~rr -> def }) a)
   (lookupLSized n pairs keysArr)
{-# INLINE getBFstLArrSized' #-}