-- Copyright 2020 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE BangPatterns #-}
-- | Seed class to hash 'Derive.Stack.Frame's into the random seed.  This is
-- like Hashable, except that it must be stable (so hashable isn't suitable),
-- and since it's for a random seed, doesn't care about being well-distributed.
-- So I use the addition algorithm, which has been stable for a while.
module Util.Seed (
    Seed(to_seed), (&)
) where
import qualified Data.Text as Text
import qualified Data.Text.Array as Text.Array
import qualified Data.Text.Internal as Text.Internal
import qualified Data.Word as Word

import qualified Foreign
import qualified System.IO.Unsafe as Unsafe


class Seed a where
    to_seed :: Int -> a -> Int

(&) :: Seed a => Int -> a -> Int
& :: forall a. Seed a => Int -> a -> Int
(&) = forall a. Seed a => Int -> a -> Int
to_seed
infixl 1 &

combine :: Int -> Int -> Int
combine :: Int -> Int -> Int
combine = forall a. Num a => a -> a -> a
(+)
-- This is fnv, which hashable uses (for now):
-- combine h1 h2 = (h1 * 16777619) `Bit.xor` h2

instance Seed Int where
    to_seed :: Int -> Int -> Int
to_seed Int
salt Int
n = Int -> Int -> Int
combine Int
salt Int
n

instance Seed Word.Word64 where
    to_seed :: Int -> Word64 -> Int
to_seed Int
salt Word64
n = Int
salt Int -> Int -> Int
`combine` forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n
instance Seed Word.Word32 where
    to_seed :: Int -> Word32 -> Int
to_seed Int
salt Word32
n = Int
salt Int -> Int -> Int
`combine` forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n

instance Seed Double where
    to_seed :: Int -> Double -> Int
to_seed Int
salt Double
n = forall a. Seed a => Int -> a -> Int
to_seed Int
salt
        ((forall a. IO a -> a
Unsafe.unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
Foreign.with Double
n forall a b. (a -> b) -> a -> b
$
            forall a. Storable a => Ptr a -> IO a
Foreign.peek forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
Foreign.castPtr) :: Word.Word64)

instance Seed Text.Text where
    to_seed :: Int -> Text -> Int
to_seed = Int -> Text -> Int
simple_text

simple_text :: Int -> Text.Text -> Int
simple_text :: Int -> Text -> Int
simple_text = forall a. (a -> Char -> a) -> a -> Text -> a
Text.foldl' (\Int
n -> (Int
n+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum)

_prim_text :: Int -> Text.Text -> Int
_prim_text :: Int -> Text -> Int
_prim_text Int
salt Text
t = Int
salt Int -> Int -> Int
`combine` Text -> Int
prim_text_sum Text
t

-- | Sum the components of the Text directly.  In theory this should be faster
-- than Text.foldl', since it skips decoding to a Char, but in practice it
-- seems to be just the same.
prim_text_sum :: Text.Text -> Int
prim_text_sum :: Text -> Int
prim_text_sum (Text.Internal.Text Array
array Int
offset Int
len) = forall {t}. Num t => t -> Int -> t
go Int
0 Int
offset
    where
    go :: t -> Int -> t
go !t
accum Int
offset
        | Int
offset forall a. Ord a => a -> a -> Bool
< Int
end =
            let !v :: t
v = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Array -> Int -> Word8
Text.Array.unsafeIndex Array
array Int
offset
            in t -> Int -> t
go (t
accum forall a. Num a => a -> a -> a
+ t
v) (Int
offsetforall a. Num a => a -> a -> a
+Int
1)
        | Bool
otherwise = t
accum
    end :: Int
end = Int
offset forall a. Num a => a -> a -> a
+ Int
len

-- TODO: hashable now uses C for this: hashable_fnv_hash_offset
-- I'll probably get vectorization and a big speedup if I do the same,
-- just like vectorc.cc
-- On the other hand, I probably don't hash large Texts so maybe irrelevant.
{-
hashByteArrayWithSalt
    :: ByteArray#  -- ^ data to hash
    -> Int         -- ^ offset, in bytes
    -> Int         -- ^ length, in bytes
    -> Salt        -- ^ salt
    -> Salt        -- ^ hash value
hashByteArrayWithSalt ba !off !len !h =
    fromIntegral $ c_hashByteArray ba (fromIntegral off) (fromIntegral len)
    (fromIntegral h)

foreign import capi unsafe "HsHashable.h hashable_fnv_hash_offset"
    c_hashByteArray :: ByteArray# -> Int64 -> Int64 -> Int64 -> Word64

FNV_UNSIGNED
hashable_fnv_hash(const unsigned char* str, FNV_SIGNED len, FNV_UNSIGNED salt)
{
  FNV_UNSIGNED hash = salt;
  while (len--) {
    hash = (hash * FNV_PRIME) ^ *str++;
  }

  return hash;
}

FNV_UNSIGNED
hashable_fnv_hash_offset(
    const unsigned char* str, FNV_SIGNED offset, FNV_SIGNED len,
    FNV_UNSIGNED salt)
{
    return hashable_fnv_hash(str + offset, len, salt);
}
-}