module FlatParse.Internal (readInt, readInteger) where

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

import GHC.Exts
import GHC.ForeignPtr
import GHC.Integer.GMP.Internals (Integer(..))

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 #-}

readInt' :: Int# -> Addr# -> Addr# -> (# Int#, Addr# #)
readInt' :: Int# -> Addr# -> Addr# -> (# Int#, Addr# #)
readInt' Int#
acc Addr#
s Addr#
end = case Addr# -> Addr# -> Int#
eqAddr# Addr#
s Addr#
end of
  Int#
1# -> (# Int#
acc, Addr#
s #)
  Int#
_  -> case Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
s Int#
0# of
    Word#
w | Int#
1# <- Word# -> Word# -> Int#
leWord# Word#
48## Word#
w, Int#
1# <- Word# -> Word# -> Int#
leWord# Word#
w Word#
57## ->
      Int# -> Addr# -> Addr# -> (# Int#, Addr# #)
readInt' (Int# -> Int#
mul10 Int#
acc Int# -> Int# -> Int#
+# (Word# -> Int#
word2Int# Word#
w Int# -> Int# -> Int#
-# Int#
48#)) (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
1#) Addr#
end
    Word#
_ -> (# Int#
acc, Addr#
s #)


-- | Read an `Int` from the input, as a non-empty digit sequence. The `Int` may
--   overflow in the result.
readInt :: Addr# -> Addr# -> (# (##) | (# Int#, Addr# #) #)
readInt :: Addr# -> Addr# -> (# (# #) | (# Int#, Addr# #) #)
readInt Addr#
eob Addr#
s = case Int# -> Addr# -> Addr# -> (# Int#, Addr# #)
readInt' Int#
0# Addr#
s Addr#
eob of
  (# Int#
n, Addr#
s' #) | Int#
1# <- Addr# -> Addr# -> Int#
eqAddr# Addr#
s Addr#
s' -> (# (##) | #)
              | Bool
otherwise          -> (# | (# Int#
n, Addr#
s' #) #)
{-# inline readInt #-}

-- | Read an `Integer` from the input, as a non-empty digit sequence.
readInteger :: ForeignPtrContents -> Addr# -> Addr# -> (# (##) | (# Integer, Addr# #) #)
readInteger :: ForeignPtrContents
-> Addr# -> Addr# -> (# (# #) | (# Integer, Addr# #) #)
readInteger ForeignPtrContents
fp Addr#
eob Addr#
s = case Int# -> Addr# -> Addr# -> (# Int#, Addr# #)
readInt' Int#
0# Addr#
s Addr#
eob of
  (# Int#
n, Addr#
s' #)
    | Int#
1# <- Addr# -> Addr# -> Int#
eqAddr# Addr#
s Addr#
s'            -> (# (##) | #)
    | Int#
1# <- Addr# -> Addr# -> Int#
minusAddr# Addr#
s' Addr#
s Int# -> Int# -> Int#
<=# Int#
18# -> (# | (# Int# -> Integer
S# Int#
n, Addr#
s' #) #)
    | Bool
otherwise -> case ByteString -> Maybe (Integer, ByteString)
B.readInteger (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS (Addr# -> ForeignPtrContents -> ForeignPtr Word8
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 readInteger #-}