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

{- | A poor-man's hash used by 'DataFrame.Internal.Grouping' to bucket rows
without depending on @hashable@. Each value is folded into an 'Int' with an
FxHash-style step (rotate, xor, multiply); small and not cryptographic.
-}
module DataFrame.Internal.Hash (
    fnvOffset,
    nullSalt,
    mixInt,
    mixDouble,
    mixBool,
    mixChar,
    mixText,
    mixBytes,
    mixShow,
) where

import Data.Bits (rotateL, unsafeShiftL, unsafeShiftR, xor)
import Data.Char (ord)
import qualified Data.Text as T
import qualified Data.Text.Array as A
#if MIN_VERSION_text(2,1,0)
import Data.Array.Byte (ByteArray (ByteArray))
#else
import Data.Text.Array (Array (ByteArray))
#endif
import Data.Text.Internal (Text (Text))
import GHC.Exts (Int (I#), indexWord8Array#, indexWord8ArrayAsWord64#)
import GHC.Word (Word64 (W64#), Word8 (W8#))

{- | FNV-1a 64-bit offset basis (used as the initial accumulator).
The literal is unsigned and exceeds 'Int' range, so we round-trip through
'Word64' to get the well-defined two's-complement bit pattern.
-}
fnvOffset :: Int
fnvOffset :: Int
fnvOffset = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
0xcbf29ce484222325 :: Word64)

-- | FNV-1a 64-bit prime.
fnvPrime :: Int
fnvPrime :: Int
fnvPrime = Int
0x00000100000001b3

{- | Sentinel mixed in for a /null/ slot, so @Nothing@ does not hash the same as
a present value with equal bits (e.g. @Just 0@). A fixed distinctive constant
keeps null hashing deterministic; a real value equal to it collides only rarely.
-}
nullSalt :: Int
nullSalt :: Int
nullSalt = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
0x9E3779B97F4A7C15 :: Word64)

{- | Mix an 'Int' into the accumulator with an FxHash-style step. The rotate
diffuses each value's bits before the next is folded in, avoiding the structured
collisions a plain xor-then-multiply produces on small/adjacent group keys.
-}
mixInt :: Int -> Int -> Int
mixInt :: Int -> Int -> Int
mixInt Int
acc Int
x = (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
rotateL Int
acc Int
13 Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
fnvPrime
{-# INLINE mixInt #-}

{- | Mix a 'Double' into the accumulator. Loses sub-millisecond precision
but matches the bucketing the old hashable-based code used.
-}
mixDouble :: Int -> Double -> Int
mixDouble :: Int -> Double -> Int
mixDouble Int
acc Double
d = Int -> Int -> Int
mixInt Int
acc (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000))
{-# INLINE mixDouble #-}

mixBool :: Int -> Bool -> Int
mixBool :: Int -> Bool -> Int
mixBool Int
acc Bool
b = Int -> Int -> Int
mixInt Int
acc (if Bool
b then Int
1 else Int
0)
{-# INLINE mixBool #-}

mixChar :: Int -> Char -> Int
mixChar :: Int -> Char -> Int
mixChar Int
acc = Int -> Int -> Int
mixInt Int
acc (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE mixChar #-}

{- | Mix a 'T.Text' value into the accumulator over its raw UTF-8 bytes, eight at
a time. Reading a whole 'Word64' per step cuts the multiply count ~8x on long
keys while staying collision-equivalent (UTF-8 is injective).
-}
mixText :: Int -> T.Text -> Int
mixText :: Int -> Text -> Int
mixText !Int
acc (Text Array
arr Int
off Int
len) = Int -> Array -> Int -> Int -> Int
mixBytes Int
acc Array
arr Int
off Int
len
{-# INLINE mixText #-}

{- | Mix a raw UTF-8 byte slice @[off, off+len)@ of a 'Data.Text.Array.Array'
into the accumulator, eight bytes at a time. The shared kernel behind
'mixText' and the packed-text hash path, so the two never drift.
-}
mixBytes :: Int -> A.Array -> Int -> Int -> Int
mixBytes :: Int -> Array -> Int -> Int -> Int
mixBytes !Int
acc Array
arr Int
off Int
len = Int -> Int -> Int
goBytes (Int -> Int -> Int
goWords Int
acc Int
off) Int
wordsEnd
  where
    !(ByteArray ByteArray#
ba) = Array
arr
    !nWords :: Int
nWords = Int
len Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
3
    !wordsEnd :: Int
wordsEnd = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
nWords Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
3)
    !end :: Int
end = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
    goWords :: Int -> Int -> Int
goWords !Int
h !Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
wordsEnd = Int
h
        | Bool
otherwise =
            let !(I# Int#
i#) = Int
i
                !w :: Int
w = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64# -> Word64
W64# (ByteArray# -> Int# -> Word64#
indexWord8ArrayAsWord64# ByteArray#
ba Int#
i#)) :: Int
             in Int -> Int -> Int
goWords (Int -> Int -> Int
mixInt Int
h Int
w) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8)
    goBytes :: Int -> Int -> Int
goBytes !Int
h !Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = Int
h
        | Bool
otherwise =
            let !(I# Int#
i#) = Int
i
                !b :: Int
b = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8# -> Word8
W8# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
ba Int#
i#)) :: Int
             in Int -> Int -> Int
goBytes (Int -> Int -> Int
mixInt Int
h Int
b) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE mixBytes #-}

{- | Fallback for arbitrary 'Show'-able values. Slower but covers types
without a dedicated combinator (e.g. 'Day', 'UTCTime').
-}
mixShow :: (Show a) => Int -> a -> Int
mixShow :: forall a. Show a => Int -> a -> Int
mixShow Int
acc = Int -> Text -> Int
mixText Int
acc (Text -> Int) -> (a -> Text) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
{-# INLINE mixShow #-}