{-# language BangPatterns #-}
{-# language BinaryLiterals #-}
{-# language DataKinds #-}
{-# language DeriveFunctor #-}
{-# language DerivingStrategies #-}
{-# language GADTSyntax #-}
{-# language KindSignatures #-}
{-# language LambdaCase #-}
{-# language MagicHash #-}
{-# language MultiWayIf #-}
{-# language PolyKinds #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneDeriving #-}
{-# language TypeApplications #-}
{-# language UnboxedSums #-}
{-# language UnboxedTuples #-}
module Data.Bytes.Parser.Latin
(
char
, char2
, char3
, char4
, char5
, char6
, char7
, char8
, char9
, char10
, char11
, trySatisfy
, trySatisfyThen
, any
, opt
, opt#
, skipDigits
, skipDigits1
, skipChar
, skipChar1
, skipTrailedBy
, skipUntil
, decWord
, decWord8
, decWord16
, decWord32
, decWord64
, decUnsignedInt
, decUnsignedInt#
, decSignedInt
, decStandardInt
, decTrailingInt
, decTrailingInt#
, decSignedInteger
, decUnsignedInteger
, decTrailingInteger
, hexWord8
, hexWord16
, hexFixedWord8
, hexFixedWord16
, hexFixedWord32
, hexNibbleLower
, tryHexNibbleLower
, hexNibble
, tryHexNibble
) where
import Prelude hiding (length,any,fail,takeWhile)
import Data.Bits ((.|.))
import Data.Bytes.Types (Bytes(..))
import Data.Bytes.Parser.Internal (InternalStep(..),unfailing)
import Data.Bytes.Parser.Internal (Parser(..),ST#,uneffectful,Result#,uneffectful#)
import Data.Bytes.Parser.Internal (InternalResult(..),indexLatinCharArray,upcastUnitSuccess)
import Data.Bytes.Parser.Internal (boxBytes)
import Data.Bytes.Parser (bindFromLiftedToInt)
import Data.Word (Word8)
import Data.Char (ord)
import Data.Kind (Type)
import GHC.Exts (Int(I#),Char(C#),Word#,Int#,Char#,(+#),(-#),indexCharArray#)
import GHC.Exts (TYPE,RuntimeRep,int2Word#,or#)
import GHC.Exts (ltWord#,gtWord#,notI#)
import GHC.Word (Word(W#),Word8(W8#),Word16(W16#),Word32(W32#),Word64(W64#))
import qualified GHC.Exts as Exts
import qualified Data.Bytes as Bytes
import qualified Data.Primitive as PM
trySatisfy :: (Char -> Bool) -> Parser e s Bool
trySatisfy f = uneffectful $ \chunk -> case length chunk of
0 -> InternalSuccess False (offset chunk) (length chunk)
_ -> case f (indexLatinCharArray (array chunk) (offset chunk)) of
True -> InternalSuccess True (offset chunk + 1) (length chunk - 1)
False -> InternalSuccess False (offset chunk) (length chunk)
trySatisfyThen :: forall (r :: RuntimeRep) (e :: Type) (s :: Type) (a :: TYPE r).
Parser e s a
-> (Char -> Maybe (Parser e s a))
-> Parser e s a
{-# inline trySatisfyThen #-}
trySatisfyThen (Parser g) f = Parser
(\input@(# arr,off0,len0 #) s0 -> case len0 of
0# -> g input s0
_ -> case f (C# (indexCharArray# arr off0)) of
Nothing -> g input s0
Just (Parser p) -> p (# arr, off0 +# 1#, len0 -# 1# #) s0
)
char :: e -> Char -> Parser e s ()
char e !c = uneffectful $ \chunk -> if length chunk > 0
then if indexLatinCharArray (array chunk) (offset chunk) == c
then InternalSuccess () (offset chunk + 1) (length chunk - 1)
else InternalFailure e
else InternalFailure e
char2 :: e -> Char -> Char -> Parser e s ()
char2 e !c0 !c1 = uneffectful $ \chunk ->
if | length chunk > 1
, indexLatinCharArray (array chunk) (offset chunk) == c0
, indexLatinCharArray (array chunk) (offset chunk + 1) == c1
-> InternalSuccess () (offset chunk + 2) (length chunk - 2)
| otherwise -> InternalFailure e
char3 :: e -> Char -> Char -> Char -> Parser e s ()
char3 e !c0 !c1 !c2 = uneffectful $ \chunk ->
if | length chunk > 2
, indexLatinCharArray (array chunk) (offset chunk) == c0
, indexLatinCharArray (array chunk) (offset chunk + 1) == c1
, indexLatinCharArray (array chunk) (offset chunk + 2) == c2
-> InternalSuccess () (offset chunk + 3) (length chunk - 3)
| otherwise -> InternalFailure e
char4 :: e -> Char -> Char -> Char -> Char -> Parser e s ()
char4 e !c0 !c1 !c2 !c3 = uneffectful $ \chunk ->
if | length chunk > 3
, indexLatinCharArray (array chunk) (offset chunk) == c0
, indexLatinCharArray (array chunk) (offset chunk + 1) == c1
, indexLatinCharArray (array chunk) (offset chunk + 2) == c2
, indexLatinCharArray (array chunk) (offset chunk + 3) == c3
-> InternalSuccess () (offset chunk + 4) (length chunk - 4)
| otherwise -> InternalFailure e
char5 :: e -> Char -> Char -> Char -> Char -> Char -> Parser e s ()
char5 e !c0 !c1 !c2 !c3 !c4 = uneffectful $ \chunk ->
if | length chunk > 4
, indexLatinCharArray (array chunk) (offset chunk) == c0
, indexLatinCharArray (array chunk) (offset chunk + 1) == c1
, indexLatinCharArray (array chunk) (offset chunk + 2) == c2
, indexLatinCharArray (array chunk) (offset chunk + 3) == c3
, indexLatinCharArray (array chunk) (offset chunk + 4) == c4
-> InternalSuccess () (offset chunk + 5) (length chunk - 5)
| otherwise -> InternalFailure e
char6 :: e -> Char -> Char -> Char -> Char -> Char -> Char -> Parser e s ()
char6 e !c0 !c1 !c2 !c3 !c4 !c5 = uneffectful $ \chunk ->
if | length chunk > 5
, indexLatinCharArray (array chunk) (offset chunk) == c0
, indexLatinCharArray (array chunk) (offset chunk + 1) == c1
, indexLatinCharArray (array chunk) (offset chunk + 2) == c2
, indexLatinCharArray (array chunk) (offset chunk + 3) == c3
, indexLatinCharArray (array chunk) (offset chunk + 4) == c4
, indexLatinCharArray (array chunk) (offset chunk + 5) == c5
-> InternalSuccess () (offset chunk + 6) (length chunk - 6)
| otherwise -> InternalFailure e
char7 :: e -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Parser e s ()
char7 e !c0 !c1 !c2 !c3 !c4 !c5 !c6 = uneffectful $ \chunk ->
if | length chunk > 6
, indexLatinCharArray (array chunk) (offset chunk) == c0
, indexLatinCharArray (array chunk) (offset chunk + 1) == c1
, indexLatinCharArray (array chunk) (offset chunk + 2) == c2
, indexLatinCharArray (array chunk) (offset chunk + 3) == c3
, indexLatinCharArray (array chunk) (offset chunk + 4) == c4
, indexLatinCharArray (array chunk) (offset chunk + 5) == c5
, indexLatinCharArray (array chunk) (offset chunk + 6) == c6
-> InternalSuccess () (offset chunk + 7) (length chunk - 7)
| otherwise -> InternalFailure e
char8 :: e -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Parser e s ()
char8 e !c0 !c1 !c2 !c3 !c4 !c5 !c6 !c7 = uneffectful $ \chunk ->
if | length chunk > 7
, indexLatinCharArray (array chunk) (offset chunk) == c0
, indexLatinCharArray (array chunk) (offset chunk + 1) == c1
, indexLatinCharArray (array chunk) (offset chunk + 2) == c2
, indexLatinCharArray (array chunk) (offset chunk + 3) == c3
, indexLatinCharArray (array chunk) (offset chunk + 4) == c4
, indexLatinCharArray (array chunk) (offset chunk + 5) == c5
, indexLatinCharArray (array chunk) (offset chunk + 6) == c6
, indexLatinCharArray (array chunk) (offset chunk + 7) == c7
-> InternalSuccess () (offset chunk + 8) (length chunk - 8)
| otherwise -> InternalFailure e
char9 :: e -> Char -> Char -> Char -> Char
-> Char -> Char -> Char -> Char -> Char -> Parser e s ()
char9 e !c0 !c1 !c2 !c3 !c4 !c5 !c6 !c7 !c8 = uneffectful $ \chunk ->
if | length chunk > 8
, indexLatinCharArray (array chunk) (offset chunk) == c0
, indexLatinCharArray (array chunk) (offset chunk + 1) == c1
, indexLatinCharArray (array chunk) (offset chunk + 2) == c2
, indexLatinCharArray (array chunk) (offset chunk + 3) == c3
, indexLatinCharArray (array chunk) (offset chunk + 4) == c4
, indexLatinCharArray (array chunk) (offset chunk + 5) == c5
, indexLatinCharArray (array chunk) (offset chunk + 6) == c6
, indexLatinCharArray (array chunk) (offset chunk + 7) == c7
, indexLatinCharArray (array chunk) (offset chunk + 8) == c8
-> InternalSuccess () (offset chunk + 9) (length chunk - 9)
| otherwise -> InternalFailure e
char10 :: e -> Char -> Char -> Char -> Char -> Char
-> Char -> Char -> Char -> Char -> Char -> Parser e s ()
char10 e !c0 !c1 !c2 !c3 !c4 !c5 !c6 !c7 !c8 !c9 = uneffectful $ \chunk ->
if | length chunk > 9
, indexLatinCharArray (array chunk) (offset chunk) == c0
, indexLatinCharArray (array chunk) (offset chunk + 1) == c1
, indexLatinCharArray (array chunk) (offset chunk + 2) == c2
, indexLatinCharArray (array chunk) (offset chunk + 3) == c3
, indexLatinCharArray (array chunk) (offset chunk + 4) == c4
, indexLatinCharArray (array chunk) (offset chunk + 5) == c5
, indexLatinCharArray (array chunk) (offset chunk + 6) == c6
, indexLatinCharArray (array chunk) (offset chunk + 7) == c7
, indexLatinCharArray (array chunk) (offset chunk + 8) == c8
, indexLatinCharArray (array chunk) (offset chunk + 9) == c9
-> InternalSuccess () (offset chunk + 10) (length chunk - 10)
| otherwise -> InternalFailure e
char11 :: e -> Char -> Char -> Char -> Char -> Char -> Char
-> Char -> Char -> Char -> Char -> Char -> Parser e s ()
char11 e !c0 !c1 !c2 !c3 !c4 !c5 !c6 !c7 !c8 !c9 !c10 = uneffectful $ \chunk ->
if | length chunk > 10
, indexLatinCharArray (array chunk) (offset chunk) == c0
, indexLatinCharArray (array chunk) (offset chunk + 1) == c1
, indexLatinCharArray (array chunk) (offset chunk + 2) == c2
, indexLatinCharArray (array chunk) (offset chunk + 3) == c3
, indexLatinCharArray (array chunk) (offset chunk + 4) == c4
, indexLatinCharArray (array chunk) (offset chunk + 5) == c5
, indexLatinCharArray (array chunk) (offset chunk + 6) == c6
, indexLatinCharArray (array chunk) (offset chunk + 7) == c7
, indexLatinCharArray (array chunk) (offset chunk + 8) == c8
, indexLatinCharArray (array chunk) (offset chunk + 9) == c9
, indexLatinCharArray (array chunk) (offset chunk + 10) == c10
-> InternalSuccess () (offset chunk + 11) (length chunk - 11)
| otherwise -> InternalFailure e
any :: e -> Parser e s Char
any e = uneffectful $ \chunk -> if length chunk > 0
then
let c = indexLatinCharArray (array chunk) (offset chunk)
in InternalSuccess c (offset chunk + 1) (length chunk - 1)
else InternalFailure e
opt :: Parser e s (Maybe Char)
opt = uneffectful $ \chunk -> case length chunk of
0 -> InternalSuccess Nothing (offset chunk) (length chunk)
_ -> InternalSuccess
(Just (indexLatinCharArray (array chunk) (offset chunk)))
(offset chunk + 1) (length chunk - 1)
opt# :: Parser e s (# (# #) | Char# #)
{-# inline opt# #-}
opt# = Parser
(\(# arr, off, len #) s0 -> case len of
0# -> (# s0, (# | (# (# (# #) | #), off, len #) #) #)
_ -> (# s0, (# | (# (# | indexCharArray# arr off #), off +# 1#, len -# 1# #) #) #)
)
skipDigitsAsciiLoop ::
Bytes
-> (# Int#, Int# #)
skipDigitsAsciiLoop !c = if length c > 0
then
let w = indexLatinCharArray (array c) (offset c)
in if w >= '0' && w <= '9'
then skipDigitsAsciiLoop (Bytes.unsafeDrop 1 c)
else (# unI (offset c), unI (length c) #)
else (# unI (offset c), unI (length c) #)
skipDigitsAscii1LoopStart ::
e
-> Bytes
-> Result# e ()
skipDigitsAscii1LoopStart e !c = if length c > 0
then
let w = indexLatinCharArray (array c) (offset c)
in if w >= '0' && w <= '9'
then upcastUnitSuccess (skipDigitsAsciiLoop (Bytes.unsafeDrop 1 c))
else (# e | #)
else (# e | #)
skipDigits1 :: e -> Parser e s ()
skipDigits1 e = uneffectful# $ \c ->
skipDigitsAscii1LoopStart e c
skipDigits :: Parser e s ()
skipDigits = uneffectful# $ \c ->
upcastUnitSuccess (skipDigitsAsciiLoop c)
unI :: Int -> Int#
unI (I# w) = w
skipChar :: Char -> Parser e s ()
skipChar !w = uneffectful# $ \c ->
upcastUnitSuccess (skipLoop w c)
skipChar1 :: e -> Char -> Parser e s ()
skipChar1 e !w = uneffectful# $ \c ->
skipLoop1Start e w c
skipLoop ::
Char
-> Bytes
-> (# Int#, Int# #)
skipLoop !w !c = if length c > 0
then if indexLatinCharArray (array c) (offset c) == w
then skipLoop w (Bytes.unsafeDrop 1 c)
else (# unI (offset c), unI (length c) #)
else (# unI (offset c), unI (length c) #)
skipLoop1Start ::
e
-> Char
-> Bytes
-> Result# e ()
skipLoop1Start e !w !chunk0 = if length chunk0 > 0
then if indexLatinCharArray (array chunk0) (offset chunk0) == w
then upcastUnitSuccess (skipLoop w (Bytes.unsafeDrop 1 chunk0))
else (# e | #)
else (# e | #)
decWord8 :: e -> Parser e s Word8
decWord8 e = Parser
(\chunk0 s0 -> case decSmallWordStart e 256 (boxBytes chunk0) s0 of
(# s1, r #) -> (# s1, upcastWord8Result r #)
)
hexWord8 :: e -> Parser e s Word8
hexWord8 e = Parser
(\chunk0 s0 -> case hexSmallWordStart e 256 (boxBytes chunk0) s0 of
(# s1, r #) -> (# s1, upcastWord8Result r #)
)
hexWord16 :: e -> Parser e s Word16
hexWord16 e = Parser
(\chunk0 s0 -> case hexSmallWordStart e 65536 (boxBytes chunk0) s0 of
(# s1, r #) -> (# s1, upcastWord16Result r #)
)
decWord16 :: e -> Parser e s Word16
decWord16 e = Parser
(\chunk0 s0 -> case decSmallWordStart e 65536 (boxBytes chunk0) s0 of
(# s1, r #) -> (# s1, upcastWord16Result r #)
)
decWord32 :: e -> Parser e s Word32
decWord32 e = Parser
(\chunk0 s0 -> case decSmallWordStart e 4294967296 (boxBytes chunk0) s0 of
(# s1, r #) -> (# s1, upcastWord32Result r #)
)
decWord :: e -> Parser e s Word
decWord e = Parser
(\chunk0 s0 -> case decWordStart e (boxBytes chunk0) s0 of
(# s1, r #) -> (# s1, upcastWordResult r #)
)
decWord64 :: e -> Parser e s Word64
decWord64 e = Parser
(\chunk0 s0 -> case decWordStart e (boxBytes chunk0) s0 of
(# s1, r #) -> (# s1, upcastWord64Result r #)
)
hexSmallWordStart ::
e
-> Word
-> Bytes
-> ST# s (Result# e Word# )
hexSmallWordStart e !limit !chunk0 s0 = if length chunk0 > 0
then case oneHexMaybe (PM.indexByteArray (array chunk0) (offset chunk0)) of
Nothing -> (# s0, (# e | #) #)
Just w -> (# s0, hexSmallWordMore e w limit (Bytes.unsafeDrop 1 chunk0) #)
else (# s0, (# e | #) #)
decSmallWordStart ::
e
-> Word
-> Bytes
-> ST# s (Result# e Word# )
decSmallWordStart e !limit !chunk0 s0 = if length chunk0 > 0
then
let !w = fromIntegral @Word8 @Word
(PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < 10
then (# s0, decSmallWordMore e w limit (Bytes.unsafeDrop 1 chunk0) #)
else (# s0, (# e | #) #)
else (# s0, (# e | #) #)
decWordMore ::
e
-> Word
-> Bytes
-> Result# e Word#
decWordMore e !acc !chunk0 = case len of
0 -> (# | (# unW (fromIntegral acc), unI (offset chunk0), 0# #) #)
_ ->
let !w = fromIntegral @Word8 @Word
(PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < 10
then
let (overflow,acc') = unsignedPushBase10 acc w
in if overflow
then (# e | #)
else decWordMore e acc' (Bytes.unsafeDrop 1 chunk0)
else (# | (# unW (fromIntegral acc), unI (offset chunk0), len# #) #)
where
!len@(I# len# ) = length chunk0
upcastWordResult :: Result# e Word# -> Result# e Word
upcastWordResult (# e | #) = (# e | #)
upcastWordResult (# | (# a, b, c #) #) = (# | (# W# a, b, c #) #)
upcastWord64Result :: Result# e Word# -> Result# e Word64
upcastWord64Result (# e | #) = (# e | #)
upcastWord64Result (# | (# a, b, c #) #) = (# | (# W64# a, b, c #) #)
hexSmallWordMore ::
e
-> Word
-> Word
-> Bytes
-> Result# e Word#
hexSmallWordMore e !acc !limit !chunk0 = if length chunk0 > 0
then case oneHexMaybe (PM.indexByteArray (array chunk0) (offset chunk0)) of
Nothing -> (# | (# unW acc, unI (offset chunk0), unI (length chunk0) #) #)
Just w -> let w' = acc * 16 + w in
if w' < limit
then hexSmallWordMore e w' limit (Bytes.unsafeDrop 1 chunk0)
else (# e | #)
else (# | (# unW acc, unI (offset chunk0), 0# #) #)
decSmallWordMore ::
e
-> Word
-> Word
-> Bytes
-> Result# e Word#
decSmallWordMore e !acc !limit !chunk0 = if length chunk0 > 0
then
let !w = fromIntegral @Word8 @Word
(PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < 10
then
let w' = acc * 10 + w
in if w' < limit
then decSmallWordMore e w' limit (Bytes.unsafeDrop 1 chunk0)
else (# e | #)
else (# | (# unW acc, unI (offset chunk0), unI (length chunk0) #) #)
else (# | (# unW acc, unI (offset chunk0), 0# #) #)
unW :: Word -> Word#
unW (W# w) = w
decWordStart ::
e
-> Bytes
-> ST# s (Result# e Word# )
decWordStart e !chunk0 s0 = if length chunk0 > 0
then
let !w = fromIntegral @Word8 @Word
(PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < 10
then (# s0, decWordMore e w (Bytes.unsafeDrop 1 chunk0) #)
else (# s0, (# e | #) #)
else (# s0, (# e | #) #)
upcastWord16Result :: Result# e Word# -> Result# e Word16
upcastWord16Result (# e | #) = (# e | #)
upcastWord16Result (# | (# a, b, c #) #) = (# | (# W16# a, b, c #) #)
upcastWord32Result :: Result# e Word# -> Result# e Word32
upcastWord32Result (# e | #) = (# e | #)
upcastWord32Result (# | (# a, b, c #) #) = (# | (# W32# a, b, c #) #)
upcastWord8Result :: Result# e Word# -> Result# e Word8
upcastWord8Result (# e | #) = (# e | #)
upcastWord8Result (# | (# a, b, c #) #) = (# | (# W8# a, b, c #) #)
decUnsignedInt :: e -> Parser e s Int
decUnsignedInt e = Parser
(\chunk0 s0 -> case decPosIntStart e (boxBytes chunk0) s0 of
(# s1, r #) -> (# s1, upcastIntResult r #)
)
decUnsignedInt# :: e -> Parser e s Int#
decUnsignedInt# e = Parser
(\chunk0 s0 -> decPosIntStart e (boxBytes chunk0) s0)
decSignedInt :: e -> Parser e s Int
decSignedInt e = Parser
(\chunk0 s0 -> case runParser (decSignedInt# e) chunk0 s0 of
(# s1, r #) -> (# s1, upcastIntResult r #)
)
decTrailingInt ::
e
-> Int
-> Parser e s Int
decTrailingInt e (I# w) = Parser
(\chunk0 s0 -> case runParser (decTrailingInt# e w) chunk0 s0 of
(# s1, r #) -> (# s1, upcastIntResult r #)
)
decTrailingInt# ::
e
-> Int#
-> Parser e s Int#
decTrailingInt# e !w =
Parser (\chunk0 s0 -> (# s0, decPosIntMore e (W# (int2Word# w)) maxIntAsWord (boxBytes chunk0) #))
maxIntAsWord :: Word
maxIntAsWord = fromIntegral (maxBound :: Int)
decStandardInt :: e -> Parser e s Int
decStandardInt e = Parser
(\chunk0 s0 -> case runParser (decStandardInt# e) chunk0 s0 of
(# s1, r #) -> (# s1, upcastIntResult r #)
)
decSignedInt# :: e -> Parser e s Int#
{-# noinline decSignedInt# #-}
decSignedInt# e = any e `bindFromLiftedToInt` \c -> case c of
'+' -> Parser
(\chunk0 s0 -> decPosIntStart e (boxBytes chunk0) s0)
'-' -> Parser
(\chunk0 s0 -> decNegIntStart e (boxBytes chunk0) s0)
_ -> Parser
(\chunk0 s0 ->
let !w = char2Word c - 48
in if w < 10
then (# s0, decPosIntMore e w maxIntAsWord (boxBytes chunk0) #)
else (# s0, (# e | #) #)
)
decStandardInt# :: e -> Parser e s Int#
{-# noinline decStandardInt# #-}
decStandardInt# e = any e `bindFromLiftedToInt` \c -> case c of
'-' -> Parser
(\chunk0 s0 -> decNegIntStart e (boxBytes chunk0) s0)
_ -> Parser
(\chunk0 s0 ->
let !w = char2Word c - 48
in if w < 10
then (# s0, decPosIntMore e w maxIntAsWord (boxBytes chunk0) #)
else (# s0, (# e | #) #)
)
decTrailingInteger ::
Int
-> Parser e s Integer
decTrailingInteger (I# w) =
Parser (\chunk0 s0 -> (# s0, (# | decIntegerChunks (I# w) 10 0 (boxBytes chunk0) #) #))
decUnsignedInteger :: e -> Parser e s Integer
decUnsignedInteger e = Parser
(\chunk0 s0 -> decUnsignedIntegerStart e (boxBytes chunk0) s0)
decSignedInteger :: e -> Parser e s Integer
{-# noinline decSignedInteger #-}
decSignedInteger e = any e >>= \c -> case c of
'+' -> do
decUnsignedInteger e
'-' -> do
x <- decUnsignedInteger e
pure $! negate x
_ -> Parser
(\chunk0 s0 ->
let !w = char2Word c - 48 in
if w < 10
then
let !r = decIntegerChunks
(fromIntegral @Word @Int w)
10
0
(boxBytes chunk0)
in (# s0, (# | r #) #)
else (# s0, (# e | #) #)
)
decPosIntStart ::
e
-> Bytes
-> ST# s (Result# e Int# )
decPosIntStart e !chunk0 s0 = if length chunk0 > 0
then
let !w = fromIntegral @Word8 @Word
(PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < 10
then (# s0, decPosIntMore e w maxIntAsWord (Bytes.unsafeDrop 1 chunk0) #)
else (# s0, (# e | #) #)
else (# s0, (# e | #) #)
decNegIntStart ::
e
-> Bytes
-> ST# s (Result# e Int# )
decNegIntStart e !chunk0 s0 = if length chunk0 > 0
then
let !w = fromIntegral @Word8 @Word
(PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < 10
then
case decPosIntMore e w (maxIntAsWord + 1) (Bytes.unsafeDrop 1 chunk0) of
(# | (# x, y, z #) #) ->
(# s0, (# | (# (notI# x +# 1# ), y, z #) #) #)
(# err | #) ->
(# s0, (# err | #) #)
else (# s0, (# e | #) #)
else (# s0, (# e | #) #)
decUnsignedIntegerStart ::
e
-> Bytes
-> ST# s (Result# e Integer)
decUnsignedIntegerStart e !chunk0 s0 = if length chunk0 > 0
then
let !w = (PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < (10 :: Word8)
then
let !r = decIntegerChunks
(fromIntegral @Word8 @Int w)
10
0
(Bytes.unsafeDrop 1 chunk0)
in (# s0, (# | r #) #)
else (# s0, (# e | #) #)
else (# s0, (# e | #) #)
decPosIntMore ::
e
-> Word
-> Word
-> Bytes
-> Result# e Int#
decPosIntMore e !acc !upper !chunk0 = if len > 0
then
let !w = fromIntegral @Word8 @Word
(PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < 10
then
let (overflow,acc') = positivePushBase10 acc w upper
in if overflow
then (# e | #)
else decPosIntMore e acc' upper (Bytes.unsafeDrop 1 chunk0)
else (# | (# unI (fromIntegral acc), unI (offset chunk0), len# #) #)
else (# | (# unI (fromIntegral acc), unI (offset chunk0), 0# #) #)
where
!len@(I# len# ) = length chunk0
decIntegerChunks ::
Int
-> Int
-> Integer
-> Bytes
-> (# Integer, Int#, Int# #)
decIntegerChunks !nAcc !eAcc acc !chunk0 = if len > 0
then
let !w = fromIntegral @Word8 @Word
(PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < 10
then let !eAcc' = eAcc * 10 in
if eAcc' >= eAcc
then decIntegerChunks
(nAcc * 10 + fromIntegral @Word @Int w)
eAcc'
acc
(Bytes.unsafeDrop 1 chunk0)
else
let !r = (acc * fromIntegral @Int @Integer eAcc)
+ (fromIntegral @Int @Integer nAcc)
in decIntegerChunks 0 1 r chunk0
else
let !r = (acc * fromIntegral @Int @Integer eAcc)
+ (fromIntegral @Int @Integer nAcc)
in (# r, unI (offset chunk0), len# #)
else
let !r = (acc * fromIntegral @Int @Integer eAcc)
+ (fromIntegral @Int @Integer nAcc)
in (# r, unI (offset chunk0), 0# #)
where
!len@(I# len# ) = length chunk0
upcastIntResult :: Result# e Int# -> Result# e Int
upcastIntResult (# e | #) = (# e | #)
upcastIntResult (# | (# a, b, c #) #) = (# | (# I# a, b, c #) #)
char2Word :: Char -> Word
char2Word = fromIntegral . ord
skipTrailedBy :: e -> Char -> Parser e s ()
skipTrailedBy e !w = uneffectful# $ \c ->
skipUntilConsumeLoop e w c
skipUntil :: Char -> Parser e s ()
skipUntil !w = uneffectful# $ \c -> skipUntilLoop w c
skipUntilLoop ::
Char
-> Bytes
-> Result# e ()
skipUntilLoop !w !c = case length c of
0 -> (# | (# (), unI (offset c), 0# #) #)
_ -> if indexLatinCharArray (array c) (offset c) /= w
then skipUntilLoop w (Bytes.unsafeDrop 1 c)
else (# | (# (), unI (offset c), unI (length c) #) #)
skipUntilConsumeLoop ::
e
-> Char
-> Bytes
-> Result# e ()
skipUntilConsumeLoop e !w !c = case length c of
0 -> (# e | #)
_ -> if indexLatinCharArray (array c) (offset c) /= w
then skipUntilConsumeLoop e w (Bytes.unsafeDrop 1 c)
else (# | (# (), unI (offset c + 1), unI (length c - 1) #) #)
hexFixedWord32 :: e -> Parser e s Word32
{-# inline hexFixedWord32 #-}
hexFixedWord32 e = Parser
(\x s0 -> case runParser (hexFixedWord32# e) x s0 of
(# s1, r #) -> case r of
(# err | #) -> (# s1, (# err | #) #)
(# | (# a, b, c #) #) -> (# s1, (# | (# W32# a, b, c #) #) #)
)
hexFixedWord32# :: e -> Parser e s Word#
{-# noinline hexFixedWord32# #-}
hexFixedWord32# e = uneffectfulWord# $ \chunk -> if length chunk >= 8
then
let !w0@(W# n0) = oneHex $ PM.indexByteArray (array chunk) (offset chunk)
!w1@(W# n1) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 1)
!w2@(W# n2) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 2)
!w3@(W# n3) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 3)
!w4@(W# n4) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 4)
!w5@(W# n5) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 5)
!w6@(W# n6) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 6)
!w7@(W# n7) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 7)
in if | w0 .|. w1 .|. w2 .|. w3 .|. w4 .|. w5 .|. w6 .|. w7 /= maxBound ->
(# |
(# (n0 `Exts.timesWord#` 268435456##) `Exts.plusWord#`
(n1 `Exts.timesWord#` 16777216##) `Exts.plusWord#`
(n2 `Exts.timesWord#` 1048576##) `Exts.plusWord#`
(n3 `Exts.timesWord#` 65536##) `Exts.plusWord#`
(n4 `Exts.timesWord#` 4096##) `Exts.plusWord#`
(n5 `Exts.timesWord#` 256##) `Exts.plusWord#`
(n6 `Exts.timesWord#` 16##) `Exts.plusWord#`
n7
, unI (offset chunk) +# 8#
, unI (length chunk) -# 8# #) #)
| otherwise -> (# e | #)
else (# e | #)
hexFixedWord16 :: e -> Parser e s Word16
{-# inline hexFixedWord16 #-}
hexFixedWord16 e = Parser
(\x s0 -> case runParser (hexFixedWord16# e) x s0 of
(# s1, r #) -> case r of
(# err | #) -> (# s1, (# err | #) #)
(# | (# a, b, c #) #) -> (# s1, (# | (# W16# a, b, c #) #) #)
)
hexFixedWord16# :: e -> Parser e s Word#
{-# noinline hexFixedWord16# #-}
hexFixedWord16# e = uneffectfulWord# $ \chunk -> if length chunk >= 4
then
let !w0@(W# n0) = oneHex $ PM.indexByteArray (array chunk) (offset chunk)
!w1@(W# n1) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 1)
!w2@(W# n2) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 2)
!w3@(W# n3) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 3)
in if | w0 .|. w1 .|. w2 .|. w3 /= maxBound ->
(# |
(# (n0 `Exts.timesWord#` 4096##) `Exts.plusWord#`
(n1 `Exts.timesWord#` 256##) `Exts.plusWord#`
(n2 `Exts.timesWord#` 16##) `Exts.plusWord#`
n3
, unI (offset chunk) +# 4#
, unI (length chunk) -# 4# #) #)
| otherwise -> (# e | #)
else (# e | #)
hexFixedWord8 :: e -> Parser e s Word8
{-# inline hexFixedWord8 #-}
hexFixedWord8 e = Parser
(\x s0 -> case runParser (hexFixedWord8# e) x s0 of
(# s1, r #) -> case r of
(# err | #) -> (# s1, (# err | #) #)
(# | (# a, b, c #) #) -> (# s1, (# | (# W8# a, b, c #) #) #)
)
hexFixedWord8# :: e -> Parser e s Word#
{-# noinline hexFixedWord8# #-}
hexFixedWord8# e = uneffectfulWord# $ \chunk -> if length chunk >= 2
then
let !w0@(W# n0) = oneHex $ PM.indexByteArray (array chunk) (offset chunk)
!w1@(W# n1) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 1)
in if | w0 .|. w1 /= maxBound ->
(# |
(# (n0 `Exts.timesWord#` 16##) `Exts.plusWord#`
n1
, unI (offset chunk) +# 2#
, unI (length chunk) -# 2# #) #)
| otherwise -> (# e | #)
else (# e | #)
hexNibbleLower :: e -> Parser e s Word
hexNibbleLower e = uneffectful $ \chunk -> case length chunk of
0 -> InternalFailure e
_ ->
let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8 in
if | w >= 48 && w < 58 -> InternalSuccess (fromIntegral w - 48) (offset chunk + 1) (length chunk - 1)
| w >= 97 && w < 103 -> InternalSuccess (fromIntegral w - 87) (offset chunk + 1) (length chunk - 1)
| otherwise -> InternalFailure e
hexNibble :: e -> Parser e s Word
hexNibble e = uneffectful $ \chunk -> case length chunk of
0 -> InternalFailure e
_ ->
let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8 in
if | w >= 48 && w < 58 -> InternalSuccess (fromIntegral w - 48) (offset chunk + 1) (length chunk - 1)
| w >= 65 && w < 71 -> InternalSuccess (fromIntegral w - 55) (offset chunk + 1) (length chunk - 1)
| w >= 97 && w < 103 -> InternalSuccess (fromIntegral w - 87) (offset chunk + 1) (length chunk - 1)
| otherwise -> InternalFailure e
tryHexNibbleLower :: Parser e s (Maybe Word)
tryHexNibbleLower = unfailing $ \chunk -> case length chunk of
0 -> InternalStep Nothing (offset chunk) (length chunk)
_ ->
let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8 in
if | w >= 48 && w < 58 -> InternalStep (Just (fromIntegral w - 48)) (offset chunk + 1) (length chunk - 1)
| w >= 97 && w < 103 -> InternalStep (Just (fromIntegral w - 87)) (offset chunk + 1) (length chunk - 1)
| otherwise -> InternalStep Nothing (offset chunk) (length chunk)
tryHexNibble :: Parser e s (Maybe Word)
tryHexNibble = unfailing $ \chunk -> case length chunk of
0 -> InternalStep Nothing (offset chunk) (length chunk)
_ ->
let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8 in
if | w >= 48 && w < 58 -> InternalStep (Just (fromIntegral w - 48)) (offset chunk + 1) (length chunk - 1)
| w >= 65 && w < 71 -> InternalStep (Just (fromIntegral w - 55)) (offset chunk + 1) (length chunk - 1)
| w >= 97 && w < 103 -> InternalStep (Just (fromIntegral w - 87)) (offset chunk + 1) (length chunk - 1)
| otherwise -> InternalStep Nothing (offset chunk) (length chunk)
oneHex :: Word8 -> Word
oneHex w
| w >= 48 && w < 58 = (fromIntegral w - 48)
| w >= 65 && w < 71 = (fromIntegral w - 55)
| w >= 97 && w < 103 = (fromIntegral w - 87)
| otherwise = maxBound
oneHexMaybe :: Word8 -> Maybe Word
{-# inline oneHexMaybe #-}
oneHexMaybe w
| w >= 48 && w < 58 = Just (fromIntegral w - 48)
| w >= 65 && w < 71 = Just (fromIntegral w - 55)
| w >= 97 && w < 103 = Just (fromIntegral w - 87)
| otherwise = Nothing
uneffectfulWord# :: (Bytes -> Result# e Word#) -> Parser e s Word#
uneffectfulWord# f = Parser
( \b s0 -> (# s0, (f (boxBytes b)) #) )
positivePushBase10 :: Word -> Word -> Word -> (Bool,Word)
positivePushBase10 (W# a) (W# b) (W# upper) =
let !(# ca, r0 #) = Exts.timesWord2# a 10##
!r1 = Exts.plusWord# r0 b
!cb = int2Word# (gtWord# r1 upper)
!cc = int2Word# (ltWord# r1 0##)
!c = ca `or#` cb `or#` cc
in (case c of { 0## -> False; _ -> True }, W# r1)
unsignedPushBase10 :: Word -> Word -> (Bool,Word)
unsignedPushBase10 (W# a) (W# b) =
let !(# ca, r0 #) = Exts.timesWord2# a 10##
!r1 = Exts.plusWord# r0 b
!cb = int2Word# (ltWord# r1 r0)
!c = ca `or#` cb
in (case c of { 0## -> False; _ -> True }, W# r1)