{-# LANGUAGE UnboxedTuples, BinaryLiterals #-}

module FlatParse.Common.Numbers where

import FlatParse.Common.Assorted ( shortInteger )

import GHC.Exts
import GHC.ForeignPtr

import qualified Data.ByteString.Char8 as BC8
import qualified Data.ByteString.Internal as B

-- | Parse a non-empty ASCII decimal digit sequence as a 'Word'.
--   Fails on overflow.
anyAsciiDecimalWord# :: Addr# -> Addr# -> (# (##) | (# Word#, Addr# #) #)
anyAsciiDecimalWord# :: Addr# -> Addr# -> (# (# #) | (# Word#, Addr# #) #)
anyAsciiDecimalWord# Addr#
eob Addr#
s = case Word# -> Addr# -> Addr# -> (# (# #) | (# Word#, Addr# #) #)
anyAsciiDecimalWord_# Word#
0## Addr#
eob Addr#
s of
    (# | (# Word#
n, Addr#
s' #) #) | Int#
0# <- Addr# -> Addr# -> Int#
eqAddr# Addr#
s Addr#
s'
                        -> (# | (# Word#
n, Addr#
s' #) #)
    (# (# #) | (# Word#, Addr# #) #)
_                   -> (# (# #) | #)
{-# inline anyAsciiDecimalWord# #-}

-- | Parse a non-empty ASCII decimal digit sequence as a positive 'Int'.
--   Fails on overflow.
anyAsciiDecimalInt# :: Addr# -> Addr# -> (# (##) | (# Int#, Addr# #) #)
anyAsciiDecimalInt# :: Addr# -> Addr# -> (# (# #) | (# Int#, Addr# #) #)
anyAsciiDecimalInt# Addr#
eob Addr#
s = case Word# -> Addr# -> Addr# -> (# (# #) | (# Word#, Addr# #) #)
anyAsciiDecimalWord_# Word#
0## Addr#
eob Addr#
s of
    (# | (# Word#
n, Addr#
s' #) #) | Int#
0# <- Addr# -> Addr# -> Int#
eqAddr# Addr#
s Addr#
s'
                        , Int#
1# <- Word# -> Word# -> Int#
leWord# Word#
n (Int# -> Word#
int2Word# (Int -> Int#
unI# forall a. Bounded a => a
maxBound))
                        -> (# | (# Word# -> Int#
word2Int# Word#
n, Addr#
s' #) #)
    (# (# #) | (# Word#, Addr# #) #)
_                   -> (# (##) | #)
{-# inline anyAsciiDecimalInt# #-}

anyAsciiDecimalWord_# :: Word# -> Addr# -> Addr# -> (# (##) | (# Word#, Addr# #) #)
anyAsciiDecimalWord_# :: Word# -> Addr# -> Addr# -> (# (# #) | (# Word#, Addr# #) #)
anyAsciiDecimalWord_# Word#
acc Addr#
eob Addr#
s = case Addr# -> Addr# -> Int#
eqAddr# Addr#
s Addr#
eob of
  Int#
1# -> (# | (# Word#
acc, Addr#
s #) #)
  Int#
_  -> case Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
s Int#
0# of
#if MIN_VERSION_base(4,16,0)
    Word8#
w | Int#
1# <- Word8# -> Word8# -> Int#
leWord8# (Word# -> Word8#
wordToWord8# Word#
0x30##) Word8#
w
      , Int#
1# <- Word8# -> Word8# -> Int#
leWord8# Word8#
w (Word# -> Word8#
wordToWord8# Word#
0x39##)
      -> case Word# -> Word# -> (# Word#, Word# #)
timesWord2# Word#
acc Word#
10## of
          (# Word#
0##, Word#
r #) -> case Word# -> Word# -> (# Word#, Int# #)
addWordC# Word#
r (Word8# -> Word#
word8ToWord# Word8#
w Word# -> Word# -> Word#
`minusWord#` Word#
0x30##) of
#else
    w | 1# <- leWord# 0x30## w
      , 1# <- leWord# w 0x39##
      -> case timesWord2# acc 10## of
          (# 0##, r #) -> case addWordC# r (w `minusWord#` 0x30##) of
#endif
            (# Word#
q, Int#
0# #) -> Word# -> Addr# -> Addr# -> (# (# #) | (# Word#, Addr# #) #)
anyAsciiDecimalWord_# Word#
q Addr#
eob (Addr#
s Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#)
            (# Word#, Int# #)
_           -> (# (##) | #)
          (# Word#, Word# #)
_             -> (# (##) | #)
    Word8#
_ -> (# | (# Word#
acc, Addr#
s #) #)

--------------------------------------------------------------------------------

-- | Parse a non-empty ASCII decimal digit sequence as a positive 'Int'.
--   May overflow.
anyAsciiDecimalIntOverflow# :: Addr# -> Addr# -> (# (##) | (# Int#, Addr# #) #)
anyAsciiDecimalIntOverflow# :: Addr# -> Addr# -> (# (# #) | (# Int#, Addr# #) #)
anyAsciiDecimalIntOverflow# Addr#
eob Addr#
s = case Int# -> Addr# -> Addr# -> (# Int#, Addr# #)
anyAsciiDecimalIntOverflow_# Int#
0# Addr#
eob Addr#
s of
    (# Int#
n, Addr#
s' #) | Int#
0# <- Addr# -> Addr# -> Int#
eqAddr# Addr#
s Addr#
s'
                -> (# | (# Int#
n, Addr#
s' #) #)

                | Bool
otherwise
                -> (# (##) | #)
{-# inline anyAsciiDecimalIntOverflow# #-}

-- | Parse a non-empty ASCII decimal digit sequence as a positive 'Integer'.
anyAsciiDecimalInteger# :: ForeignPtrContents -> Addr# -> Addr# -> (# (##) | (# Integer, Addr# #) #)
anyAsciiDecimalInteger# :: ForeignPtrContents
-> Addr# -> Addr# -> (# (# #) | (# Integer, Addr# #) #)
anyAsciiDecimalInteger# ForeignPtrContents
fp Addr#
eob Addr#
s = case Int# -> Addr# -> Addr# -> (# Int#, Addr# #)
anyAsciiDecimalIntOverflow_# Int#
0# Addr#
eob Addr#
s of
  (# Int#
n, Addr#
s' #)
    | Int#
1# <- Addr# -> Addr# -> Int#
eqAddr# Addr#
s Addr#
s'            -> (# (##) | #)

    -- Simple heuristic, 18 digits correspond to somewhere between 2^59 and 2^60, which is
    -- well inside the 'IS' constructor.
    | Int#
1# <- Addr# -> Addr# -> Int#
minusAddr# Addr#
s' Addr#
s Int# -> Int# -> Int#
<=# Int#
18# -> (# | (# Int# -> Integer
shortInteger Int#
n, Addr#
s' #) #)
    | Bool
otherwise -> case ByteString -> Maybe (Integer, ByteString)
BC8.readInteger (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS (forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
s ForeignPtrContents
fp) Int
0 (Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
s' Addr#
s))) of
        Maybe (Integer, ByteString)
Nothing     -> (# (##) | #)
        Just (Integer
i, ByteString
_) -> (# | (# Integer
i, Addr#
s' #) #)
{-# inline anyAsciiDecimalInteger# #-}

-- | Parse a non-empty ASCII decimal digit sequence as a positive 'Int'.
--   May overflow.
anyAsciiDecimalIntOverflow_# :: Int# -> Addr# -> Addr# -> (# Int#, Addr# #)
anyAsciiDecimalIntOverflow_# :: Int# -> Addr# -> Addr# -> (# Int#, Addr# #)
anyAsciiDecimalIntOverflow_# Int#
acc Addr#
eob Addr#
s = case Addr# -> Addr# -> Int#
eqAddr# Addr#
s Addr#
eob of
  Int#
1# -> (# Int#
acc, Addr#
s #)
  Int#
_  -> case Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
s Int#
0# of
#if MIN_VERSION_base(4,16,0)
    Word8#
w | Int#
1# <- Word8# -> Word8# -> Int#
leWord8# (Word# -> Word8#
wordToWord8# Word#
0x30##) Word8#
w, Int#
1# <- Word8# -> Word8# -> Int#
leWord8# Word8#
w (Word# -> Word8#
wordToWord8# Word#
0x39##) ->
      Int# -> Addr# -> Addr# -> (# Int#, Addr# #)
anyAsciiDecimalIntOverflow_# (Int# -> Int#
mul10# Int#
acc Int# -> Int# -> Int#
+# (Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
w) Int# -> Int# -> Int#
-# Int#
0x30#)) Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
1#)
#else
    w | 1# <- leWord# 0x30## w, 1# <- leWord# w 0x39## ->
      anyAsciiDecimalIntOverflow_# (mul10# acc +# (word2Int# w -# 0x30#)) eob (plusAddr# s 1#)
#endif
    Word8#
_ -> (# Int#
acc, Addr#
s #)

--------------------------------------------------------------------------------

-- | Parse a non-empty, case-insensitive ASCII hexadecimal digit sequence as a
--   'Word'.
--   Fails on overflow.
anyAsciiHexWord# :: Addr# -> Addr# -> (# (##) | (# Word#, Addr# #) #)
anyAsciiHexWord# :: Addr# -> Addr# -> (# (# #) | (# Word#, Addr# #) #)
anyAsciiHexWord# Addr#
eob Addr#
s = case Word# -> Addr# -> Addr# -> (# (# #) | (# Word#, Addr# #) #)
anyAsciiHexWord_# Word#
0## Addr#
eob Addr#
s of
    (# | (# Word#
n, Addr#
s' #) #) | Int#
0# <- Addr# -> Addr# -> Int#
eqAddr# Addr#
s Addr#
s'
                        -> (# | (# Word#
n, Addr#
s' #) #)
    (# (# #) | (# Word#, Addr# #) #)
_                   -> (# (# #) | #)
{-# inline anyAsciiHexWord# #-}

-- | Parse a non-empty, case-insensitive ASCII hexadecimal digit sequence as a
--   positive 'Int'.
--   Fails on overflow.
anyAsciiHexInt# :: Addr# -> Addr# -> (# (##) | (# Int#, Addr# #) #)
anyAsciiHexInt# :: Addr# -> Addr# -> (# (# #) | (# Int#, Addr# #) #)
anyAsciiHexInt# Addr#
eob Addr#
s = case Word# -> Addr# -> Addr# -> (# (# #) | (# Word#, Addr# #) #)
anyAsciiHexWord_# Word#
0## Addr#
eob Addr#
s of
    (# | (# Word#
n, Addr#
s' #) #) | Int#
0# <- Addr# -> Addr# -> Int#
eqAddr# Addr#
s Addr#
s'
                        , Int#
1# <- Word# -> Word# -> Int#
leWord# Word#
n (Int# -> Word#
int2Word# (Int -> Int#
unI# forall a. Bounded a => a
maxBound))
                        -> (# | (# Word# -> Int#
word2Int# Word#
n, Addr#
s' #) #)

                        | Bool
otherwise
                        -> (# (##) | #)
    (# (##) | #)        -> (# (##) | #)
{-# inline anyAsciiHexInt# #-}

anyAsciiHexWord_# :: Word# -> Addr# -> Addr# -> (# (##) | (# Word#, Addr# #) #)
anyAsciiHexWord_# :: Word# -> Addr# -> Addr# -> (# (# #) | (# Word#, Addr# #) #)
anyAsciiHexWord_# Word#
acc Addr#
eob Addr#
s = case Addr# -> Addr# -> Int#
eqAddr# Addr#
s Addr#
eob of
  Int#
1# -> (# | (# Word#
acc, Addr#
s #) #)
  Int#
_  -> case Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
s Int#
0# of
#if MIN_VERSION_base(4,16,0)
    Word8#
w | Int#
1# <- Word8# -> Word8# -> Int#
leWord8# (Word# -> Word8#
wordToWord8# Word#
0x30##) Word8#
w
      , Int#
1# <- Word8# -> Word8# -> Int#
leWord8# Word8#
w (Word# -> Word8#
wordToWord8# Word#
0x39##)
      -> case Word# -> Word# -> (# Word#, Word# #)
timesWord2# Word#
acc Word#
16## of
          (# Word#
0##, Word#
r #) -> case Word# -> Word# -> (# Word#, Int# #)
addWordC# Word#
r (Word8# -> Word#
word8ToWord# Word8#
w Word# -> Word# -> Word#
`minusWord#` Word#
0x30##) of
#else
    w | 1# <- leWord# 0x30## w
      , 1# <- leWord# w 0x39##
      -> case timesWord2# acc 16## of
          (# 0##, r #) -> case addWordC# r (w `minusWord#` 0x30##) of
#endif
            (# Word#
q, Int#
0# #) -> Word# -> Addr# -> Addr# -> (# (# #) | (# Word#, Addr# #) #)
anyAsciiHexWord_# Word#
q Addr#
eob (Addr#
s Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#)
            (# Word#, Int# #)
_           -> (# (##) | #)
          (# Word#, Word# #)
_             -> (# (##) | #)
#if MIN_VERSION_base(4,16,0)
      | Int#
1# <- Word8# -> Word8# -> Int#
leWord8# (Word# -> Word8#
wordToWord8# Word#
0x41##) Word8#
w
      , Int#
1# <- Word8# -> Word8# -> Int#
leWord8# Word8#
w (Word# -> Word8#
wordToWord8# Word#
0x46##)
      -> case Word# -> Word# -> (# Word#, Word# #)
timesWord2# Word#
acc Word#
16## of
          (# Word#
0##, Word#
r #) -> case Word# -> Word# -> (# Word#, Int# #)
addWordC# Word#
r (Word8# -> Word#
word8ToWord# Word8#
w Word# -> Word# -> Word#
`minusWord#` Word#
0x37##) of
#else
      | 1# <- leWord# 0x41## w
      , 1# <- leWord# w 0x46##
      -> case timesWord2# acc 16## of
          (# 0##, r #) -> case addWordC# r (w `minusWord#` 0x37##) of
#endif
            (# Word#
q, Int#
0# #) -> Word# -> Addr# -> Addr# -> (# (# #) | (# Word#, Addr# #) #)
anyAsciiHexWord_# Word#
q Addr#
eob (Addr#
s Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#)
            (# Word#, Int# #)
_           -> (# (##) | #)
          (# Word#, Word# #)
_             -> (# (##) | #)
#if MIN_VERSION_base(4,16,0)
      | Int#
1# <- Word8# -> Word8# -> Int#
leWord8# (Word# -> Word8#
wordToWord8# Word#
0x61##) Word8#
w
      , Int#
1# <- Word8# -> Word8# -> Int#
leWord8# Word8#
w (Word# -> Word8#
wordToWord8# Word#
0x66##)
      -> case Word# -> Word# -> (# Word#, Word# #)
timesWord2# Word#
acc Word#
16## of

          (# Word#
0##, Word#
r #) -> case Word# -> Word# -> (# Word#, Int# #)
addWordC# Word#
r (Word8# -> Word#
word8ToWord# Word8#
w Word# -> Word# -> Word#
`minusWord#` Word#
0x57##) of
#else
      | 1# <- leWord# 0x61## w
      , 1# <- leWord# w 0x66##
      -> case timesWord2# acc 16## of

          (# 0##, r #) -> case addWordC# r (w `minusWord#` 0x57##) of
#endif
            (# Word#
q, Int#
0# #) -> Word# -> Addr# -> Addr# -> (# (# #) | (# Word#, Addr# #) #)
anyAsciiHexWord_# Word#
q Addr#
eob (Addr#
s Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#)
            (# Word#, Int# #)
_           -> (# (##) | #)
          (# Word#, Word# #)
_             -> (# (##) | #)
    Word8#
_ -> (# | (# Word#
acc, Addr#
s #) #)

--------------------------------------------------------------------------------
-- Zigzag encoding
-- See: https://hackage.haskell.org/package/zigzag-0.0.1.0/docs/src/Data.Word.Zigzag.html

fromZigzagNative :: Word -> Int
fromZigzagNative :: Word -> Int
fromZigzagNative (W# Word#
w#) = Int# -> Int
I# (Word# -> Int#
fromZigzagNative# Word#
w#)
{-# inline fromZigzagNative #-}

-- GHC should optimize to this, but to be sure, here it is
fromZigzagNative# :: Word# -> Int#
fromZigzagNative# :: Word# -> Int#
fromZigzagNative# Word#
w# =
    Word# -> Int#
word2Int# ((Word#
w# Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
1#) Word# -> Word# -> Word#
`xor#` (Word# -> Word#
not# (Word#
w# Word# -> Word# -> Word#
`and#` Word#
1##) Word# -> Word# -> Word#
`plusWord#` Word#
1##))
{-# inline fromZigzagNative# #-}

toZigzagNative :: Int -> Word
toZigzagNative :: Int -> Word
toZigzagNative (I# Int#
i#) = Word# -> Word
W# (Int# -> Word#
toZigzagNative# Int#
i#)
{-# inline toZigzagNative #-}

-- GHC should optimize to this, but to be sure, here it is
toZigzagNative# :: Int# -> Word#
toZigzagNative# :: Int# -> Word#
toZigzagNative# Int#
i# = Word# -> Word#
toZigzagNative'# (Int# -> Word#
int2Word# Int#
i#)
{-# inline toZigzagNative# #-}

-- GHC should optimize to this, but to be sure, here it is
toZigzagNative'# :: Word# -> Word#
toZigzagNative'# :: Word# -> Word#
toZigzagNative'# Word#
w# =
    (Word#
w# Word# -> Int# -> Word#
`uncheckedShiftL#` Int#
1#) Word# -> Word# -> Word#
`xor#` (Word#
w# Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
63#)
{-# inline toZigzagNative'# #-}

--------------------------------------------------------------------------------

-- | protobuf style (LE, redundant, on continues)
anyVarintProtobuf# :: Addr# -> Addr# -> (# (##) | (# Int#, Addr#, Int# #) #)

#if MIN_VERSION_base(4,16,0)

anyVarintProtobuf# :: Addr# -> Addr# -> (# (# #) | (# Int#, Addr#, Int# #) #)
anyVarintProtobuf# Addr#
end# = Int# -> Int# -> Addr# -> (# (# #) | (# Int#, Addr#, Int# #) #)
go Int#
0# Int#
0#
  where
    word8ToInt# :: Word8# -> Int#
    word8ToInt# :: Word8# -> Int#
word8ToInt# Word8#
w8# = Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
w8#)
    {-# inline word8ToInt# #-}
    go :: Int# -> Int# -> Addr# -> (# (##) | (# Int#, Addr#, Int# #) #)
    go :: Int# -> Int# -> Addr# -> (# (# #) | (# Int#, Addr#, Int# #) #)
go Int#
i# Int#
n# Addr#
s# = case Addr# -> Addr# -> Int#
eqAddr# Addr#
s# Addr#
end# of
      Int#
1# -> (# (##) | #)
      Int#
_  ->
        let w8# :: Word8#
w8# = Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
s# Int#
0#
            w8'# :: Int#
w8'# = Word8# -> Int#
word8ToInt# (Word8#
w8# Word8# -> Word8# -> Word8#
`andWord8#` (Word# -> Word8#
wordToWord8# Word#
0b01111111##))
            i'# :: Int#
i'# = Int#
i# Int# -> Int# -> Int#
`orI#` (Int#
w8'# Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
n#)
            s'# :: Addr#
s'# = Addr#
s# Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#
            n'# :: Int#
n'# = Int#
n# Int# -> Int# -> Int#
+# Int#
7#
        in  case Word8#
w8# Word8# -> Word8# -> Int#
`geWord8#` Word# -> Word8#
wordToWord8# Word#
0b10000000## of
              Int#
1# -> Int# -> Int# -> Addr# -> (# (# #) | (# Int#, Addr#, Int# #) #)
go Int#
i'# Int#
n'# Addr#
s'#
              Int#
_  -> (# | (# Int#
i'#, Addr#
s'#, Int#
n'# #) #)

#else

anyVarintProtobuf# end# = go 0# 0#
  where
    go :: Int# -> Int# -> Addr# -> (# (##) | (# Int#, Addr#, Int# #) #)
    go i# n# s# = case eqAddr# s# end# of
      1# -> (# (##) | #)
      _  ->
        let w8# = indexWord8OffAddr# s# 0#
            w8'# = word2Int# (w8# `and#` 0b01111111##)
            i'# = i# `orI#` (w8'# `uncheckedIShiftL#` n#)
            s'# = s# `plusAddr#` 1#
            n'# = n# +# 7#
        in  case w8# `geWord#` 0b10000000## of
              1# -> go i'# n'# s'#
              _  -> (# | (# i'#, s'#, n'# #) #)

#endif

--------------------------------------------------------------------------------

unI# :: Int -> Int#
unI# :: Int -> Int#
unI# (I# Int#
i) = Int#
i
{-# inline unI# #-}

mul10# :: Int# -> Int#
mul10# :: Int# -> Int#
mul10# Int#
n = Int# -> Int# -> Int#
uncheckedIShiftL# Int#
n Int#
3# Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
uncheckedIShiftL# Int#
n Int#
1#
{-# inline mul10# #-}