{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP          #-}
{-# LANGUAGE MagicHash    #-}

module Data.HashTable.Internal.Utils
  ( whichBucket
  , nextBestPrime
  , bumpSize
  , shiftL
  , shiftRL
  , iShiftL
  , iShiftRL
  , nextHighestPowerOf2
  , log2
  , highestBitMask
  , wordSize
  , cacheLineSize
  , numElemsInCacheLine
  , cacheLineIntMask
  , cacheLineIntBits
  , forceSameType
  , unsafeIOToST
  ) where

import           Data.Bits                        hiding (shiftL)
import           Data.HashTable.Internal.IntArray (Elem)
import           Data.Vector                      (Vector)
import qualified Data.Vector                      as V
#if __GLASGOW_HASKELL__ >= 503
import           GHC.Exts
#else
import qualified Data.Bits
import           Data.Word
#endif

#if MIN_VERSION_base(4,4,0)
import           Control.Monad.ST.Unsafe          (unsafeIOToST)
#else
import           Control.Monad.ST                 (unsafeIOToST)
#endif

------------------------------------------------------------------------------
wordSize :: Int
wordSize :: Int
wordSize = Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Int
0::Int)


cacheLineSize :: Int
cacheLineSize :: Int
cacheLineSize = Int
64


numElemsInCacheLine :: Int
numElemsInCacheLine :: Int
numElemsInCacheLine = Int
z
  where
    !z :: Int
z = Int
cacheLineSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Elem -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Elem
0::Elem) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)


-- | What you have to mask an integer index by to tell if it's
-- cacheline-aligned
cacheLineIntMask :: Int
cacheLineIntMask :: Int
cacheLineIntMask = Int
z
  where
    !z :: Int
z = Int
numElemsInCacheLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1


cacheLineIntBits :: Int
cacheLineIntBits :: Int
cacheLineIntBits = Word -> Int
log2 (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a. Enum a => Int -> a
toEnum Int
numElemsInCacheLine


------------------------------------------------------------------------------
{-# INLINE whichBucket #-}
whichBucket :: Int -> Int -> Int
whichBucket :: Int -> Int -> Int
whichBucket !Int
h !Int
sz = Int
o
  where
    !o :: Int
o = Int
h Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
sz


------------------------------------------------------------------------------
binarySearch :: (Ord e) => Vector e -> e -> Int
binarySearch :: Vector e -> e -> Int
binarySearch = (e -> e -> Ordering) -> Vector e -> e -> Int
forall e. (e -> e -> Ordering) -> Vector e -> e -> Int
binarySearchBy e -> e -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE binarySearch #-}


------------------------------------------------------------------------------
binarySearchBy :: (e -> e -> Ordering)
               -> Vector e
               -> e
               -> Int
binarySearchBy :: (e -> e -> Ordering) -> Vector e -> e -> Int
binarySearchBy e -> e -> Ordering
cmp Vector e
vec e
e = (e -> e -> Ordering) -> Vector e -> e -> Int -> Int -> Int
forall e.
(e -> e -> Ordering) -> Vector e -> e -> Int -> Int -> Int
binarySearchByBounds e -> e -> Ordering
cmp Vector e
vec e
e Int
0 (Vector e -> Int
forall a. Vector a -> Int
V.length Vector e
vec)
{-# INLINE binarySearchBy #-}


------------------------------------------------------------------------------
binarySearchByBounds :: (e -> e -> Ordering)
                     -> Vector e
                     -> e
                     -> Int
                     -> Int
                     -> Int
binarySearchByBounds :: (e -> e -> Ordering) -> Vector e -> e -> Int -> Int -> Int
binarySearchByBounds e -> e -> Ordering
cmp Vector e
vec e
e = Int -> Int -> Int
loop
 where
 loop :: Int -> Int -> Int
loop !Int
l !Int
u
   | Int
u Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l    = Int
l
   | Bool
otherwise = let e' :: e
e' = Vector e -> Int -> e
forall a. Vector a -> Int -> a
V.unsafeIndex Vector e
vec Int
k
                 in case e -> e -> Ordering
cmp e
e' e
e of
                      Ordering
LT -> Int -> Int -> Int
loop (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
u
                      Ordering
EQ -> Int
k
                      Ordering
GT -> Int -> Int -> Int
loop Int
l     Int
k
  where k :: Int
k = (Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
1
{-# INLINE binarySearchByBounds #-}


------------------------------------------------------------------------------
primeSizes :: Vector Integer
primeSizes :: Vector Integer
primeSizes = [Integer] -> Vector Integer
forall a. [a] -> Vector a
V.fromList [ Integer
19
                        , Integer
31
                        , Integer
37
                        , Integer
43
                        , Integer
47
                        , Integer
53
                        , Integer
61
                        , Integer
67
                        , Integer
79
                        , Integer
89
                        , Integer
97
                        , Integer
107
                        , Integer
113
                        , Integer
127
                        , Integer
137
                        , Integer
149
                        , Integer
157
                        , Integer
167
                        , Integer
181
                        , Integer
193
                        , Integer
211
                        , Integer
233
                        , Integer
257
                        , Integer
281
                        , Integer
307
                        , Integer
331
                        , Integer
353
                        , Integer
389
                        , Integer
409
                        , Integer
421
                        , Integer
443
                        , Integer
467
                        , Integer
503
                        , Integer
523
                        , Integer
563
                        , Integer
593
                        , Integer
631
                        , Integer
653
                        , Integer
673
                        , Integer
701
                        , Integer
733
                        , Integer
769
                        , Integer
811
                        , Integer
877
                        , Integer
937
                        , Integer
1039
                        , Integer
1117
                        , Integer
1229
                        , Integer
1367
                        , Integer
1543
                        , Integer
1637
                        , Integer
1747
                        , Integer
1873
                        , Integer
2003
                        , Integer
2153
                        , Integer
2311
                        , Integer
2503
                        , Integer
2777
                        , Integer
3079
                        , Integer
3343
                        , Integer
3697
                        , Integer
5281
                        , Integer
6151
                        , Integer
7411
                        , Integer
9901
                        , Integer
12289
                        , Integer
18397
                        , Integer
24593
                        , Integer
34651
                        , Integer
49157
                        , Integer
66569
                        , Integer
73009
                        , Integer
98317
                        , Integer
118081
                        , Integer
151051
                        , Integer
196613
                        , Integer
246011
                        , Integer
393241
                        , Integer
600011
                        , Integer
786433
                        , Integer
1050013
                        , Integer
1572869
                        , Integer
2203657
                        , Integer
3145739
                        , Integer
4000813
                        , Integer
6291469
                        , Integer
7801379
                        , Integer
10004947
                        , Integer
12582917
                        , Integer
19004989
                        , Integer
22752641
                        , Integer
25165843
                        , Integer
39351667
                        , Integer
50331653
                        , Integer
69004951
                        , Integer
83004629
                        , Integer
100663319
                        , Integer
133004881
                        , Integer
173850851
                        , Integer
201326611
                        , Integer
293954587
                        , Integer
402653189
                        , Integer
550001761
                        , Integer
702952391
                        , Integer
805306457
                        , Integer
1102951999
                        , Integer
1402951337
                        , Integer
1610612741
                        , Integer
1902802801
                        , Integer
2147483647
                        , Integer
3002954501
                        , Integer
3902954959
                        , Integer
4294967291
                        , Integer
5002902979
                        , Integer
6402754181
                        , Integer
8589934583
                        , Integer
17179869143
                        , Integer
34359738337
                        , Integer
68719476731
                        , Integer
137438953447
                        , Integer
274877906899 ]


------------------------------------------------------------------------------
nextBestPrime :: Int -> Int
nextBestPrime :: Int -> Int
nextBestPrime Int
x = Integer -> Int
forall a. Enum a => a -> Int
fromEnum Integer
yi
  where
    xi :: Integer
xi  = Int -> Integer
forall a. Enum a => Int -> a
toEnum Int
x
    idx :: Int
idx = Vector Integer -> Integer -> Int
forall e. Ord e => Vector e -> e -> Int
binarySearch Vector Integer
primeSizes Integer
xi
    yi :: Integer
yi  = Vector Integer -> Int -> Integer
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Integer
primeSizes Int
idx


------------------------------------------------------------------------------
bumpSize :: Double -> Int -> Int
bumpSize :: Double -> Int -> Int
bumpSize !Double
maxLoad !Int
s = Int -> Int
nextBestPrime (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$! Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
maxLoad)


------------------------------------------------------------------------------
shiftL :: Word -> Int -> Word
shiftRL :: Word -> Int -> Word
iShiftL  :: Int -> Int -> Int
iShiftRL  :: Int -> Int -> Int
#if __GLASGOW_HASKELL__
{--------------------------------------------------------------------
  GHC: use unboxing to get @shiftRL@ inlined.
--------------------------------------------------------------------}
{-# INLINE shiftL #-}
shiftL :: Word -> Int -> Word
shiftL (W# Word#
x) (I# Int#
i)
  = Word# -> Word
W# (Word# -> Int# -> Word#
shiftL# Word#
x Int#
i)

{-# INLINE shiftRL #-}
shiftRL :: Word -> Int -> Word
shiftRL (W# Word#
x) (I# Int#
i)
  = Word# -> Word
W# (Word# -> Int# -> Word#
shiftRL# Word#
x Int#
i)

{-# INLINE iShiftL #-}
iShiftL :: Int -> Int -> Int
iShiftL (I# Int#
x) (I# Int#
i)
  = Int# -> Int
I# (Int# -> Int# -> Int#
iShiftL# Int#
x Int#
i)

{-# INLINE iShiftRL #-}
iShiftRL :: Int -> Int -> Int
iShiftRL (I# Int#
x) (I# Int#
i)
  = Int# -> Int
I# (Int# -> Int# -> Int#
iShiftRL# Int#
x Int#
i)

#else
shiftL x i    = Data.Bits.shiftL x i
shiftRL x i   = shiftR x i
iShiftL x i   = shiftL x i
iShiftRL x i  = shiftRL x i
#endif


------------------------------------------------------------------------------
{-# INLINE nextHighestPowerOf2 #-}
nextHighestPowerOf2 :: Word -> Word
nextHighestPowerOf2 :: Word -> Word
nextHighestPowerOf2 Word
w = Word -> Word
highestBitMask (Word
wWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1


------------------------------------------------------------------------------
log2 :: Word -> Int
log2 :: Word -> Int
log2 Word
w = Word -> Int -> Int
forall t. Num t => Word -> t -> t
go (Word -> Word
nextHighestPowerOf2 Word
w) Int
0
  where
    go :: Word -> t -> t
go Word
0 !t
i  = t
it -> t -> t
forall a. Num a => a -> a -> a
-t
1
    go !Word
n !t
i = Word -> t -> t
go (Word -> Int -> Word
shiftRL Word
n Int
1) (t
it -> t -> t
forall a. Num a => a -> a -> a
+t
1)


------------------------------------------------------------------------------
{-# INLINE highestBitMask #-}
highestBitMask :: Word -> Word
highestBitMask :: Word -> Word
highestBitMask !Word
x0 = case (Word
x0 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word -> Int -> Word
shiftRL Word
x0 Int
1) of
                      Word
x1 -> case (Word
x1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word -> Int -> Word
shiftRL Word
x1 Int
2) of
                       Word
x2 -> case (Word
x2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word -> Int -> Word
shiftRL Word
x2 Int
4) of
                        Word
x3 -> case (Word
x3 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word -> Int -> Word
shiftRL Word
x3 Int
8) of
                         Word
x4 -> case (Word
x4 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word -> Int -> Word
shiftRL Word
x4 Int
16) of
                          Word
x5 -> Word
x5 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word -> Int -> Word
shiftRL Word
x5 Int
32


------------------------------------------------------------------------------
forceSameType :: Monad m => a -> a -> m ()
forceSameType :: a -> a -> m ()
forceSameType a
_ a
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE forceSameType #-}