-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT
{-# LANGUAGE UnboxedTuples #-}

{- | The first copy of each key and string that one document's retained values hold, found by the
bytes the lexer read before any text is built. Keep one table per read and drop it when the read
ends, so no table outlives the document it serves. The table hashes with SipHash-1-3 under a key
drawn for its read, so upstream text cannot choose which names collide.
-}
module Ecluse.Core.Registry.Json.Intern (
    -- * Names as read
    Name (Plain),
    decodedName,
    foldName,
    nameText,
    nameBytes,

    -- * The table
    InternTable,
    SipKey (..),
    newTableKey,
    newInternTable,
    Entry,
    entryText,
    entryString,
    entryKeeps,
    entryIndex,
    Interned (..),
    internName,
    tableTexts,
    sipHash,
) where

import Crypto.Random (getRandomBytes)
import Data.Aeson (Value (String))
import Data.Bits (rotateL, shiftL, (.|.))
import Data.ByteArray.Hash (SipKey (..))
import Data.ByteString qualified as BS
import Data.ByteString.Unsafe qualified as BSU
import Data.HashMap.Strict qualified as HashMap
import Data.Hashable (Hashable (..))
import Data.JsonStream.Unescape (unsafeDecodeASCII)
import Data.Primitive.SmallArray (SmallArray, newSmallArray, runSmallArray, writeSmallArray)
import Data.Text.Array qualified as TA
import Data.Text.Internal qualified as TI

-- | A member name or string as the lexer read it: plain ASCII bytes, or text decoded from escapes or UTF-8.
data Name = Plain !ByteString | Decoded !Text ~ByteString

-- | A name decoded from escapes or UTF-8. Its bytes are encoded once, when first asked for.
decodedName :: Text -> Name
decodedName :: Text -> Name
decodedName Text
text = Text -> ByteString -> Name
Decoded Text
text (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
text)

-- | Take a name as its plain ASCII bytes or as its decoded text.
foldName :: (ByteString -> a) -> (Text -> a) -> Name -> a
foldName :: forall a. (ByteString -> a) -> (Text -> a) -> Name -> a
foldName ByteString -> a
onPlain Text -> a
onDecoded = \case
    Plain ByteString
bytes -> ByteString -> a
onPlain ByteString
bytes
    Decoded Text
text ByteString
_ -> Text -> a
onDecoded Text
text
{-# INLINE foldName #-}

-- | The name's text on an array of its own. Plain bytes are copied, so no text keeps its input chunk.
nameText :: Name -> Text
nameText :: Name -> Text
nameText = \case
    Plain ByteString
bytes -> ByteString -> Text
unsafeDecodeASCII ByteString
bytes
    Decoded Text
text ByteString
_ -> Text
text

-- | The name's UTF-8 bytes. Plain bytes are the input's own, so hold them only for the current lookup.
nameBytes :: Name -> ByteString
nameBytes :: Name -> ByteString
nameBytes = \case
    Plain ByteString
bytes -> ByteString
bytes
    Decoded Text
_ ByteString
bytes -> ByteString
bytes

-- | A fresh key for one read's table, so no key outlives the table it seeds.
newTableKey :: IO SipKey
newTableKey :: IO SipKey
newTableKey = do
    bytes <- Int -> IO ByteString
forall byteArray. ByteArray byteArray => Int -> IO byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
16 :: IO ByteString
    let word = (Word64 -> Word8 -> Word64) -> Word64 -> ByteString -> Word64
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (\Word64
total Word8
byte -> Word64
total Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
256 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte) Word64
0
        (first8, last8) = BS.splitAt 8 bytes
    pure (SipKey (word first8) (word last8))

{- | One table entry: the shared text, its shared string value, whether a member's value is kept as
read, and its index. Only a table makes one, so every index lies within its table.
-}
data Entry = Entry !Text !Value !Bool !Int

-- | The entry's shared text.
entryText :: Entry -> Text
entryText :: Entry -> Text
entryText (Entry Text
text Value
_ Bool
_ Int
_) = Text
text

-- | The entry's text as its shared string value.
entryString :: Entry -> Value
entryString :: Entry -> Value
entryString (Entry Text
_ Value
string Bool
_ Int
_) = Value
string

-- | Whether a member of this name keeps its value as read.
entryKeeps :: Entry -> Bool
entryKeeps :: Entry -> Bool
entryKeeps (Entry Text
_ Value
_ Bool
keeps Int
_) = Bool
keeps

-- | The entry's index, which lies within the table that made it.
entryIndex :: Entry -> Int
entryIndex :: Entry -> Int
entryIndex (Entry Text
_ Value
_ Bool
_ Int
index) = Int
index

-- | The table's entry for a name, with the table that holds it.
data Interned = Interned !Entry !InternTable

-- | One read's table and its entry count. Each entry's text is also its key, and each key carries its hash.
data InternTable = InternTable !SipKey !(HashMap.HashMap Probe Entry) !Int

{- | A table for one document that keeps the values of the named members as read. Name the members
whose values differ in every release or file, so they never enter the table.
-}
newInternTable :: SipKey -> [Text] -> InternTable
newInternTable :: SipKey -> [Text] -> InternTable
newInternTable SipKey
key = (InternTable -> Text -> InternTable)
-> InternTable -> [Text] -> InternTable
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' InternTable -> Text -> InternTable
seed (SipKey -> HashMap Probe Entry -> Int -> InternTable
InternTable SipKey
key HashMap Probe Entry
forall a. Monoid a => a
mempty Int
0)
  where
    seed :: InternTable -> Text -> InternTable
seed table :: InternTable
table@(InternTable SipKey
_ HashMap Probe Entry
entries Int
count) Text
name
        | Probe -> HashMap Probe Entry -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member (SipKey -> ByteString -> Probe
probeOf SipKey
key (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
name)) HashMap Probe Entry
entries = InternTable
table
        | Bool
otherwise = ByteString -> Entry -> InternTable -> InternTable
insertEntry (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
name) (Text -> Value -> Bool -> Int -> Entry
Entry Text
name (Text -> Value
String Text
name) Bool
True Int
count) InternTable
table

{- | The table's entry for a name. A name the table lacks gets an entry of its own text, which the
returned table holds from then on.
-}
internName :: Name -> InternTable -> Interned
internName :: Name -> InternTable -> Interned
internName Name
name table :: InternTable
table@(InternTable SipKey
key HashMap Probe Entry
entries Int
count) = case Probe -> HashMap Probe Entry -> Maybe Entry
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Int -> Bytes -> Probe
Probe Int
code (ByteString -> Bytes
Slice ByteString
probe)) HashMap Probe Entry
entries of
    Just Entry
entry -> Entry -> InternTable -> Interned
Interned Entry
entry InternTable
table
    Maybe Entry
Nothing ->
        let text :: Text
text = Name -> Text
nameText Name
name
            entry :: Entry
entry = Text -> Value -> Bool -> Int -> Entry
Entry Text
text (Text -> Value
String Text
text) Bool
False Int
count
         in Entry -> InternTable -> Interned
Interned Entry
entry (SipKey -> HashMap Probe Entry -> Int -> InternTable
InternTable SipKey
key (Probe -> Entry -> HashMap Probe Entry -> HashMap Probe Entry
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert (Int -> Bytes -> Probe
Probe Int
code (Text -> Bytes
Owned Text
text)) Entry
entry HashMap Probe Entry
entries) (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  where
    probe :: ByteString
probe = Name -> ByteString
nameBytes Name
name
    code :: Int
code = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> SipKey -> ByteString -> Word64
sipHash Int
1 Int
3 SipKey
key ByteString
probe)
{-# INLINE internName #-}

insertEntry :: ByteString -> Entry -> InternTable -> InternTable
insertEntry :: ByteString -> Entry -> InternTable -> InternTable
insertEntry ByteString
bytes Entry
entry (InternTable SipKey
key HashMap Probe Entry
entries Int
count) =
    SipKey -> HashMap Probe Entry -> Int -> InternTable
InternTable SipKey
key (Probe -> Entry -> HashMap Probe Entry -> HashMap Probe Entry
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert (Int -> Bytes -> Probe
Probe (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> SipKey -> ByteString -> Word64
sipHash Int
1 Int
3 SipKey
key ByteString
bytes)) (Text -> Bytes
Owned (Entry -> Text
entryText Entry
entry))) Entry
entry HashMap Probe Entry
entries) (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

probeOf :: SipKey -> ByteString -> Probe
probeOf :: SipKey -> ByteString -> Probe
probeOf SipKey
key ByteString
bytes = Int -> Bytes -> Probe
Probe (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> SipKey -> ByteString -> Word64
sipHash Int
1 Int
3 SipKey
key ByteString
bytes)) (ByteString -> Bytes
Slice ByteString
bytes)

-- | Every entry's text in index order. Each index below the table's count holds exactly one entry.
tableTexts :: InternTable -> SmallArray Text
tableTexts :: InternTable -> SmallArray Text
tableTexts (InternTable SipKey
_ HashMap Probe Entry
entries Int
count) = (forall s. ST s (SmallMutableArray s Text)) -> SmallArray Text
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray ((forall s. ST s (SmallMutableArray s Text)) -> SmallArray Text)
-> (forall s. ST s (SmallMutableArray s Text)) -> SmallArray Text
forall a b. (a -> b) -> a -> b
$ do
    slots <- Int -> Text -> ST s (SmallMutableArray (PrimState (ST s)) Text)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
count Text
""
    forM_ (HashMap.elems entries) $ \Entry
entry -> Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Entry -> Int
entryIndex Entry
entry Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
count) (SmallMutableArray (PrimState (ST s)) Text -> Int -> Text -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s Text
SmallMutableArray (PrimState (ST s)) Text
slots (Entry -> Int
entryIndex Entry
entry) (Entry -> Text
entryText Entry
entry))
    pure slots

-- A key with its hash computed once. A probe holds the bytes it looks up, and a stored key its entry's text.
data Probe = Probe {-# UNPACK #-} !Int !Bytes

data Bytes = Slice !ByteString | Owned !Text

instance Eq Probe where
    Probe Int
left Bytes
leftBytes == :: Probe -> Probe -> Bool
== Probe Int
right Bytes
rightBytes = Int
left Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
right Bool -> Bool -> Bool
&& Bytes -> Bytes -> Bool
sameBytes Bytes
leftBytes Bytes
rightBytes

instance Hashable Probe where
    hashWithSalt :: Int -> Probe -> Int
hashWithSalt Int
salt (Probe Int
code Bytes
_) = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Int
code
    hash :: Probe -> Int
hash (Probe Int
code Bytes
_) = Int
code

sameBytes :: Bytes -> Bytes -> Bool
sameBytes :: Bytes -> Bytes -> Bool
sameBytes = ((Bytes, Bytes) -> Bool) -> Bytes -> Bytes -> Bool
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((Bytes, Bytes) -> Bool) -> Bytes -> Bytes -> Bool)
-> ((Bytes, Bytes) -> Bool) -> Bytes -> Bytes -> Bool
forall a b. (a -> b) -> a -> b
$ \case
    (Owned Text
left, Owned Text
right) -> Text
left Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
right
    (Slice ByteString
left, Slice ByteString
right) -> ByteString
left ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
right
    (Slice ByteString
bytes, Owned Text
text) -> ByteString -> Text -> Bool
sliceMatches ByteString
bytes Text
text
    (Owned Text
text, Slice ByteString
bytes) -> ByteString -> Text -> Bool
sliceMatches ByteString
bytes Text
text

sliceMatches :: ByteString -> Text -> Bool
sliceMatches :: ByteString -> Text -> Bool
sliceMatches ByteString
bytes (TI.Text Array
array Int
offset Int
len) = ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len Bool -> Bool -> Bool
&& Int -> Bool
go Int
0
  where
    go :: Int -> Bool
go !Int
index
        | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Bool
True
        | ByteString -> Int -> Word8
BSU.unsafeIndex ByteString
bytes Int
index Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Array -> Int -> Word8
TA.unsafeIndex Array
array (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
index) = Int -> Bool
go (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        | Bool
otherwise = Bool
False

{- | SipHash with the given compression and finalisation rounds, from one to four each, over the
message's little-endian words. The table uses SipHash-1-3.
-}
sipHash :: Int -> Int -> SipKey -> ByteString -> Word64
{-# INLINE sipHash #-}
sipHash :: Int -> Int -> SipKey -> ByteString -> Word64
sipHash Int
compression Int
finalisation (SipKey Word64
k0 Word64
k1) ByteString
bytes =
    Int -> Word64 -> Word64 -> Word64 -> Word64 -> Word64
absorb Int
0 (Word64
k0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
0x736f6d6570736575) (Word64
k1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
0x646f72616e646f6d) (Word64
k0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
0x6c7967656e657261) (Word64
k1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
0x7465646279746573)
  where
    size :: Int
size = ByteString -> Int
BS.length ByteString
bytes
    whole :: Int
whole = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
size Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
8
    absorb :: Int -> Word64 -> Word64 -> Word64 -> Word64 -> Word64
absorb !Int
offset !Word64
v0 !Word64
v1 !Word64
v2 !Word64
v3
        | Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
whole = case Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
inject (Int -> Word64
fullWord Int
offset) Word64
v0 Word64
v1 Word64
v2 Word64
v3 of
            (# Word64
a, Word64
b, Word64
c, Word64
d #) -> Int -> Word64 -> Word64 -> Word64 -> Word64 -> Word64
absorb (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) Word64
a Word64
b Word64
c Word64
d
        | Bool
otherwise = case Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
inject ((Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
56) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Word64
wordAt Int
offset (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset)) Word64
v0 Word64
v1 Word64
v2 Word64
v3 of
            (# Word64
a, Word64
b, Word64
c, Word64
d #) -> case Int
-> Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds Int
finalisation Word64
a Word64
b (Word64
c Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
0xff) Word64
d of
                (# Word64
a', Word64
b', Word64
c', Word64
d' #) -> Word64
a' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
b' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
c' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
d'
    inject :: Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
inject !Word64
message !Word64
v0 !Word64
v1 !Word64
v2 !Word64
v3 = case Int
-> Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds Int
compression Word64
v0 Word64
v1 Word64
v2 (Word64
v3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
message) of
        (# Word64
a, Word64
b, Word64
c, Word64
d #) -> (# Word64
a Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
message, Word64
b, Word64
c, Word64
d #)
    byte :: Int -> Word64
byte Int
offset = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BSU.unsafeIndex ByteString
bytes Int
offset) :: Word64
    fullWord :: Int -> Word64
fullWord !Int
offset =
        Int -> Word64
byte Int
offset
            Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Int -> Word64
byte (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
            Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Int -> Word64
byte (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
            Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Int -> Word64
byte (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
            Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Int -> Word64
byte (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
            Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Int -> Word64
byte (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
40)
            Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Int -> Word64
byte (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
48)
            Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Int -> Word64
byte (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
56)
    wordAt :: Int -> Int -> Word64
wordAt !Int
offset !Int
count = Int -> Word64 -> Word64
go Int
0 Word64
0
      where
        go :: Int -> Word64 -> Word64
go !Int
index !Word64
acc
            | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
count = Word64
acc
            | Bool
otherwise = Int -> Word64 -> Word64
go (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word64
acc Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Int -> Word64
byte (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
index) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
index)))

-- Rounds are unrolled, so no state word is boxed between them.
rounds :: Int -> Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #)
rounds :: Int
-> Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
rounds Int
count Word64
v0 Word64
v1 Word64
v2 Word64
v3 = case Int
count of
    Int
1 -> Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0 Word64
v1 Word64
v2 Word64
v3
    Int
2 -> case Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0 Word64
v1 Word64
v2 Word64
v3 of (# Word64
a, Word64
b, Word64
c, Word64
d #) -> Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
a Word64
b Word64
c Word64
d
    Int
3 -> case Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0 Word64
v1 Word64
v2 Word64
v3 of (# Word64
a, Word64
b, Word64
c, Word64
d #) -> case Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
a Word64
b Word64
c Word64
d of (# Word64
e, Word64
f, Word64
g, Word64
h #) -> Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
e Word64
f Word64
g Word64
h
    Int
_ -> case Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
v0 Word64
v1 Word64
v2 Word64
v3 of (# Word64
a, Word64
b, Word64
c, Word64
d #) -> case Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
a Word64
b Word64
c Word64
d of (# Word64
e, Word64
f, Word64
g, Word64
h #) -> case Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
e Word64
f Word64
g Word64
h of (# Word64
i, Word64
j, Word64
k, Word64
l #) -> Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound Word64
i Word64
j Word64
k Word64
l
{-# INLINE rounds #-}

sipRound :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #)
sipRound :: Word64
-> Word64
-> Word64
-> Word64
-> (# Word64, Word64, Word64, Word64 #)
sipRound !Word64
v0 !Word64
v1 !Word64
v2 !Word64
v3 =
    let !a0 :: Word64
a0 = Word64
v0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
v1
        !b0 :: Word64
b0 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
rotateL Word64
v1 Int
13 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
a0
        !a1 :: Word64
a1 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
rotateL Word64
a0 Int
32
        !c0 :: Word64
c0 = Word64
v2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
v3
        !d0 :: Word64
d0 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
rotateL Word64
v3 Int
16 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
c0
        !a2 :: Word64
a2 = Word64
a1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
d0
        !d1 :: Word64
d1 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
rotateL Word64
d0 Int
21 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
a2
        !c1 :: Word64
c1 = Word64
c0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
b0
        !b1 :: Word64
b1 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
rotateL Word64
b0 Int
17 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
c1
        !c2 :: Word64
c2 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
rotateL Word64
c1 Int
32
     in (# Word64
a2, Word64
b1, Word64
c2, Word64
d1 #)
{-# INLINE sipRound #-}