bytesmith 0.3.5.0 → 0.3.6.0
raw patch · 7 files changed
+466/−17 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.Bytes.Parser: cstring :: e -> CString -> Parser e s ()
+ Data.Bytes.Parser: measure_ :: Parser e s a -> Parser e s Int
+ Data.Bytes.Parser: measure_# :: Parser e s a -> Parser e s Int#
+ Data.Bytes.Parser: peekRemaining :: Parser e s Bytes
+ Data.Bytes.Parser: skipTrailedBy2 :: e -> Word8 -> Word8 -> Parser e s Bool
+ Data.Bytes.Parser: skipTrailedBy2# :: e -> Word8 -> Word8 -> Parser e s Int#
+ Data.Bytes.Parser: skipTrailedBy3# :: e -> Word8 -> Word8 -> Word8 -> Parser e s Int#
+ Data.Bytes.Parser.Latin: char12 :: e -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Parser e s ()
+ Data.Bytes.Parser.Latin: takeTrailedBy :: e -> Char -> Parser e s Bytes
+ Data.Bytes.Parser.Rebindable: (>>) :: forall e s (a :: TYPE ra) (b :: TYPE rb). Bind ra rb => Parser e s a -> Parser e s b -> Parser e s b
+ Data.Bytes.Parser.Rebindable: (>>=) :: forall e s (a :: TYPE ra) (b :: TYPE rb). Bind ra rb => Parser e s a -> (a -> Parser e s b) -> Parser e s b
+ Data.Bytes.Parser.Rebindable: class Bind (ra :: RuntimeRep) (rb :: RuntimeRep)
+ Data.Bytes.Parser.Rebindable: class Pure (ra :: RuntimeRep)
+ Data.Bytes.Parser.Rebindable: instance Data.Bytes.Parser.Rebindable.Bind 'GHC.Types.IntRep 'GHC.Types.LiftedRep
+ Data.Bytes.Parser.Rebindable: instance Data.Bytes.Parser.Rebindable.Bind 'GHC.Types.IntRep ('GHC.Types.TupleRep '[ 'GHC.Types.IntRep, 'GHC.Types.IntRep])
+ Data.Bytes.Parser.Rebindable: instance Data.Bytes.Parser.Rebindable.Bind 'GHC.Types.LiftedRep 'GHC.Types.IntRep
+ Data.Bytes.Parser.Rebindable: instance Data.Bytes.Parser.Rebindable.Bind 'GHC.Types.LiftedRep 'GHC.Types.LiftedRep
+ Data.Bytes.Parser.Rebindable: instance Data.Bytes.Parser.Rebindable.Bind 'GHC.Types.LiftedRep ('GHC.Types.TupleRep '[ 'GHC.Types.IntRep, 'GHC.Types.IntRep])
+ Data.Bytes.Parser.Rebindable: instance Data.Bytes.Parser.Rebindable.Bind ('GHC.Types.TupleRep '[ 'GHC.Types.IntRep, 'GHC.Types.IntRep]) 'GHC.Types.LiftedRep
+ Data.Bytes.Parser.Rebindable: instance Data.Bytes.Parser.Rebindable.Pure 'GHC.Types.IntRep
+ Data.Bytes.Parser.Rebindable: instance Data.Bytes.Parser.Rebindable.Pure 'GHC.Types.LiftedRep
+ Data.Bytes.Parser.Rebindable: instance Data.Bytes.Parser.Rebindable.Pure ('GHC.Types.TupleRep '[ 'GHC.Types.IntRep, 'GHC.Types.IntRep])
+ Data.Bytes.Parser.Rebindable: pure :: forall e s (a :: TYPE ra). Pure ra => a -> Parser e s a
+ Data.Bytes.Parser.Unsafe: cursor# :: Parser e s Int#
Files
- CHANGELOG.md +12/−0
- bytesmith.cabal +2/−1
- src/Data/Bytes/Parser.hs +125/−1
- src/Data/Bytes/Parser/Internal.hs +22/−12
- src/Data/Bytes/Parser/Latin.hs +43/−2
- src/Data/Bytes/Parser/Rebindable.hs +254/−0
- src/Data/Bytes/Parser/Unsafe.hs +8/−1
CHANGELOG.md view
@@ -1,5 +1,17 @@ # Revision history for bytesmith +## 0.3.6.0 -- 2020-03-04++* Add `char12`+* Add `skipTrailedBy2`, `skipTrailedBy3`, and variants+ with an unboxed result.+* Add `cstring`+* Add `peekRemaining`+* Add `measure_` and `measure_#`, variants of `measure`+ that only give the byte count.+* Add `Data.Bytes.Parser.Rebindable`, the ultimate hack.+* Add `Data.Bytes.Latin.takeTrailedBy`+ ## 0.3.5.0 -- 2020-02-10 * Add big-endian and little-endian `word256` and `word256Array` parsers.
bytesmith.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: bytesmith-version: 0.3.5.0+version: 0.3.6.0 synopsis: Nonresumable byte parser description: Parse bytes as fast as possible. This is a nonresumable parser@@ -23,6 +23,7 @@ Data.Bytes.Parser.LittleEndian Data.Bytes.Parser.Ascii Data.Bytes.Parser.Latin+ Data.Bytes.Parser.Rebindable Data.Bytes.Parser.Unsafe Data.Bytes.Parser.Utf8 other-modules:
src/Data/Bytes/Parser.hs view
@@ -41,15 +41,20 @@ -- * Skip , skipWhile , skipTrailedBy+ , skipTrailedBy2+ , skipTrailedBy2#+ , skipTrailedBy3# -- * Match , byteArray , bytes , satisfy , satisfyWith+ , cstring -- * End of Input , endOfInput , isEndOfInput , remaining+ , peekRemaining -- * Scanning , scan -- * Lookahead@@ -65,6 +70,8 @@ -- * Subparsing , delimit , measure+ , measure_+ , measure_# -- * Lift Effects , effect -- * Box Result@@ -95,11 +102,12 @@ import Data.Bytes.Parser.Internal (InternalResult(..),Parser(..),ST#,unboxBytes) import Data.Bytes.Parser.Internal (boxBytes,Result#,uneffectful,fail)-import Data.Bytes.Parser.Internal (uneffectful#)+import Data.Bytes.Parser.Internal (uneffectful#,uneffectfulInt#) import Data.Bytes.Parser.Types (Result(Failure,Success),Slice(Slice)) import Data.Bytes.Parser.Unsafe (unconsume,expose,cursor) import Data.Bytes.Types (Bytes(..)) import Data.Primitive (ByteArray(..))+import Foreign.C.String (CString) import GHC.Exts (Int(I#),Word#,Int#,Char#,runRW#,(+#),(-#),(>=#)) import GHC.ST (ST(..)) import GHC.Word (Word32(W32#),Word8)@@ -108,6 +116,7 @@ import qualified Data.Bytes as B import qualified Data.Primitive as PM import qualified Data.Primitive.Contiguous as C+import qualified GHC.Exts as Exts -- | Parse a byte sequence. This can succeed even if the -- entire slice was not consumed by the parser.@@ -183,6 +192,7 @@ byteArray :: e -> ByteArray -> Parser e s () byteArray e !expected = bytes e (B.fromByteArray expected) +-- | Consume input matching the byte sequence. bytes :: e -> Bytes -> Parser e s () bytes e !expected = Parser ( \actual@(# _, off, len #) s ->@@ -193,6 +203,20 @@ in (# s, r #) ) +-- | Consume input matching the @NUL@-terminated C String.+cstring :: e -> CString -> Parser e s ()+cstring e (Exts.Ptr ptr0) = Parser+ ( \(# arr, off0, len0 #) s -> + let go !ptr !off !len = case Exts.indexWord8OffAddr# ptr 0# of+ 0## -> (# s, (# | (# (), off, len #) #) #)+ c -> case len of+ 0# -> (# s, (# e | #) #)+ _ -> case Exts.eqWord# c (Exts.indexWord8Array# arr off) of+ 1# -> go (Exts.plusAddr# ptr 1# ) (off +# 1# ) (len -# 1# )+ _ -> (# s, (# e | #) #)+ in go ptr0 off0 len0+ )+ infix 0 <?> -- | Infix version of 'annotate'.@@ -304,6 +328,62 @@ else (# | (# (), unI (offset c + 1), unI (length c - 1) #) #) else (# e | #) +-- | Skip all bytes until either of the bytes in encountered. Then,+-- consume the matched byte. @True@ indicates that the first argument+-- byte was encountered. @False@ indicates that the second argument+-- byte was encountered.+skipTrailedBy2 ::+ e -- ^ Error message+ -> Word8 -- ^ First trailer, @False@ indicates that this was encountered+ -> Word8 -- ^ Second trailer, @True@ indicates that this was encountered+ -> Parser e s Bool+skipTrailedBy2 e !wa !wb = boxBool (skipTrailedBy2# e wa wb)++skipTrailedBy2# ::+ e -- ^ Error message+ -> Word8 -- ^ First trailer, 0 indicates that this was encountered+ -> Word8 -- ^ Second trailer, 1 indicates that this was encountered+ -> Parser e s Int#+skipTrailedBy2# e !wa !wb =+ uneffectfulInt# (\c -> skipUntilConsumeByteEitherLoop e wa wb c)++skipTrailedBy3# ::+ e -- ^ Error message+ -> Word8 -- ^ First trailer, 0 indicates that this was encountered+ -> Word8 -- ^ Second trailer, 1 indicates that this was encountered+ -> Word8 -- ^ Third trailer, 2 indicates that this was encountered+ -> Parser e s Int#+skipTrailedBy3# e !wa !wb !wc =+ uneffectfulInt# (\c -> skipUntilConsumeByte3Loop e wa wb wc c)++skipUntilConsumeByteEitherLoop ::+ e -- Error message+ -> Word8 -- first trailer+ -> Word8 -- second trailer+ -> Bytes -- Chunk+ -> Result# e Int#+skipUntilConsumeByteEitherLoop e !wa !wb !c = if length c > 0+ then let byte = PM.indexByteArray (array c) (offset c) in+ if | byte == wa -> (# | (# 0#, unI (offset c + 1), unI (length c - 1) #) #)+ | byte == wb -> (# | (# 1#, unI (offset c + 1), unI (length c - 1) #) #)+ | otherwise -> skipUntilConsumeByteEitherLoop e wa wb (B.unsafeDrop 1 c)+ else (# e | #)++skipUntilConsumeByte3Loop ::+ e -- Error message+ -> Word8 -- first trailer+ -> Word8 -- second trailer+ -> Word8 -- third trailer+ -> Bytes -- Chunk+ -> Result# e Int#+skipUntilConsumeByte3Loop e !wa !wb !wc !c = if length c > 0+ then let byte = PM.indexByteArray (array c) (offset c) in+ if | byte == wa -> (# | (# 0#, unI (offset c + 1), unI (length c - 1) #) #)+ | byte == wb -> (# | (# 1#, unI (offset c + 1), unI (length c - 1) #) #)+ | byte == wc -> (# | (# 2#, unI (offset c + 1), unI (length c - 1) #) #)+ | otherwise -> skipUntilConsumeByte3Loop e wa wb wc (B.unsafeDrop 1 c)+ else (# e | #)+ -- | Take the given number of bytes. Fails if there is not enough -- remaining input. take :: e -> Int -> Parser e s Bytes@@ -319,6 +399,12 @@ remaining = uneffectful $ \chunk -> InternalSuccess chunk (offset chunk + length chunk) 0 +-- | Return all remaining bytes in the input without consuming them.+peekRemaining :: Parser e s Bytes+{-# inline peekRemaining #-}+peekRemaining = uneffectful $ \b@(Bytes _ off len) ->+ InternalSuccess b off len+ -- | Skip while the predicate is matched. This is always inlined. skipWhile :: (Word8 -> Bool) -> Parser e s () {-# inline skipWhile #-}@@ -398,6 +484,26 @@ ) -- | Convert a @(# Int#, Int# #)@ parser to a @(Int,Int)@ parser.+boxInt :: Parser e s Int# -> Parser e s Int+{-# inline boxInt #-}+boxInt (Parser f) = Parser+ (\x s0 -> case f x s0 of+ (# s1, r #) -> case r of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# y, b, c #) #) -> (# s1, (# | (# I# y, b, c #) #) #)+ )++-- | Convert a @(# Int#, Int# #)@ parser to a @(Int,Int)@ parser.+boxBool :: Parser e s Int# -> Parser e s Bool+{-# inline boxBool #-}+boxBool (Parser f) = Parser+ (\x s0 -> case f x s0 of+ (# s1, r #) -> case r of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# y, b, c #) #) -> (# s1, (# | (# case y of {1# -> True; _ -> False}, b, c #) #) #)+ )++-- | Convert a @(# Int#, Int# #)@ parser to a @(Int,Int)@ parser. boxIntPair :: Parser e s (# Int#, Int# #) -> Parser e s (Int,Int) boxIntPair (Parser f) = Parser (\x s0 -> case f x s0 of@@ -522,6 +628,24 @@ (# e | #) -> (# s1, (# e | #) #) (# | (# y, post, c #) #) -> (# s1, (# | (# (I# (post -# pre), y),post,c #) #) #) )++-- | Run a parser and discard the result, returning instead the number+-- of bytes that the parser consumed.+measure_ :: Parser e s a -> Parser e s Int+{-# inline measure_ #-}+measure_ p = boxInt (measure_# p)++-- | Variant of 'measure_' with an unboxed result.+measure_# :: Parser e s a -> Parser e s Int#+{-# inline measure_# #-}+measure_# (Parser f) = Parser+ (\x@(# _, pre, _ #) s0 -> case f x s0 of+ (# s1, r #) -> case r of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# _, post, c #) #) -> (# s1, (# | (# post -# pre,post,c #) #) #)+ )++ -- | Run a parser in a delimited context, failing if the requested number -- of bytes are not available or if the delimited parser does not
src/Data/Bytes/Parser/Internal.hs view
@@ -27,6 +27,7 @@ , unfailing , uneffectful , uneffectful#+ , uneffectfulInt# , boxBytes , unboxBytes , unboxResult@@ -127,22 +128,11 @@ pure = pureParser (<*>) = Control.Monad.ap -pureParser :: a -> Parser e s a-pureParser a = Parser- (\(# _, b, c #) s -> (# s, (# | (# a, b, c #) #) #))-- instance Monad (Parser e s) where {-# inline return #-} {-# inline (>>=) #-} return = pureParser- Parser f >>= g = Parser- (\x@(# arr, _, _ #) s0 -> case f x s0 of- (# s1, r0 #) -> case r0 of- (# e | #) -> (# s1, (# e | #) #)- (# | (# y, b, c #) #) ->- runParser (g y) (# arr, b, c #) s1- )+ (>>=) = bindParser instance Functor (Parser e s) where {-# inline fmap #-}@@ -163,6 +153,11 @@ uneffectful# f = Parser ( \b s0 -> (# s0, (f (boxBytes b)) #) ) +uneffectfulInt# :: (Bytes -> Result# e Int# ) -> Parser e s Int#+{-# inline uneffectfulInt# #-}+uneffectfulInt# f = Parser+ ( \b s0 -> (# s0, (f (boxBytes b)) #) )+ upcastUnitSuccess :: (# Int#, Int# #) -> Result# e () {-# inline upcastUnitSuccess #-} upcastUnitSuccess (# b, c #) = (# | (# (), b, c #) #)@@ -283,3 +278,18 @@ else pure () go offset 0 length PM.unsafeFreezeByteArray dst++pureParser :: a -> Parser e s a+{-# inline pureParser #-}+pureParser a = Parser+ (\(# _, b, c #) s -> (# s, (# | (# a, b, c #) #) #))++bindParser :: Parser e s a -> (a -> Parser e s b) -> Parser e s b+{-# inline bindParser #-}+bindParser (Parser f) g = Parser+ (\x@(# arr, _, _ #) s0 -> case f x s0 of+ (# s1, r0 #) -> case r0 of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# y, b, c #) #) ->+ runParser (g y) (# arr, b, c #) s1+ )
src/Data/Bytes/Parser/Latin.hs view
@@ -33,13 +33,16 @@ , char9 , char10 , char11+ , char12 -- ** Try , trySatisfy , trySatisfyThen- -- * Get Character+ -- * One Character , any , opt , opt#+ -- * Many Characters+ , takeTrailedBy -- * Skip , skipDigits , skipDigits1@@ -90,6 +93,7 @@ import Data.Bytes.Parser.Internal (InternalResult(..),indexLatinCharArray,upcastUnitSuccess) import Data.Bytes.Parser.Internal (boxBytes) import Data.Bytes.Parser (bindFromLiftedToInt)+import Data.Bytes.Parser.Unsafe (expose,cursor) import Data.Word (Word8) import Data.Char (ord) import Data.Kind (Type)@@ -280,7 +284,7 @@ -> InternalSuccess () (offset chunk + 10) (length chunk - 10) | otherwise -> InternalFailure e --- | Consume ten characters, failing if they do+-- | Consume eleven characters, failing if they do -- not match the expected values. char11 :: e -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Parser e s ()@@ -300,6 +304,27 @@ -> InternalSuccess () (offset chunk + 11) (length chunk - 11) | otherwise -> InternalFailure e +-- | Consume twelve characters, failing if they do+-- not match the expected values.+char12 :: e -> Char -> Char -> Char -> Char -> Char -> Char+ -> Char -> Char -> Char -> Char -> Char -> Char -> Parser e s ()+char12 e !c0 !c1 !c2 !c3 !c4 !c5 !c6 !c7 !c8 !c9 !c10 !c11 = uneffectful $ \chunk ->+ if | length chunk > 11+ , 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+ , indexLatinCharArray (array chunk) (offset chunk + 11) == c11+ -> InternalSuccess () (offset chunk + 12) (length chunk - 12)+ | otherwise -> InternalFailure e+ -- | Consumes and returns the next character in the input. any :: e -> Parser e s Char any e = uneffectful $ \chunk -> if length chunk > 0@@ -848,6 +873,22 @@ char2Word :: Char -> Word char2Word = fromIntegral . ord++-- | Take characters until the specified character is encountered.+-- Consumes the matched character as well. Fails if the character+-- is not present. Visually, the cursor advancement and resulting+-- @Bytes@ for @takeTrailedBy \'D\'@ look like this:+--+-- > A B C D E F | input+-- > |->->->-| | cursor+-- > {-*-*-} | result bytes+takeTrailedBy :: e -> Char -> Parser e s Bytes+takeTrailedBy e !w = do+ !start <- cursor+ skipTrailedBy e w+ !end <- cursor+ !arr <- expose+ pure (Bytes arr start (end - (start + 1))) -- | Skip all characters until the terminator is encountered -- and then consume the matching character as well. Visually,
+ src/Data/Bytes/Parser/Rebindable.hs view
@@ -0,0 +1,254 @@+{-# language FlexibleInstances #-}+{-# language MagicHash #-}+{-# language MultiParamTypeClasses #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language TypeInType #-}+{-# language UnboxedSums #-}+{-# language UnboxedTuples #-}++-- | Provides levity-polymorphic variants of @>>=@, @>>@, and @pure@+-- used to assemble parsers whose result types are unlifted. This+-- cannot be used with the @RebindableSyntax@ extension because that+-- extension disallows representations other than @LiftedRep@. Consequently,+-- users of this module must manually desugar do notation. See the+-- @url-bytes@ library for an example of this module in action.+--+-- Only resort to the functions in this module after checking that+-- GHC is unable to optimize away @I#@ and friends in your code.+module Data.Bytes.Parser.Rebindable+ ( Bind(..)+ , Pure(..)+ ) where++import Prelude () +import GHC.Exts (TYPE,RuntimeRep(..))+import Data.Bytes.Parser.Internal (Parser(..))++class Bind (ra :: RuntimeRep) (rb :: RuntimeRep) where+ (>>=) :: forall e s (a :: TYPE ra) (b :: TYPE rb).+ Parser e s a -> (a -> Parser e s b) -> Parser e s b+ (>>) :: forall e s (a :: TYPE ra) (b :: TYPE rb).+ Parser e s a -> Parser e s b -> Parser e s b++class Pure (ra :: RuntimeRep) where+ pure :: forall e s (a :: TYPE ra). a -> Parser e s a++pureParser :: a -> Parser e s a+{-# inline pureParser #-}+pureParser a = Parser+ (\(# _, b, c #) s -> (# s, (# | (# a, b, c #) #) #))++bindParser :: Parser e s a -> (a -> Parser e s b) -> Parser e s b+{-# inline bindParser #-}+bindParser (Parser f) g = Parser+ (\x@(# arr, _, _ #) s0 -> case f x s0 of+ (# s1, r0 #) -> case r0 of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# y, b, c #) #) ->+ runParser (g y) (# arr, b, c #) s1+ )++sequenceParser :: Parser e s a -> Parser e s b -> Parser e s b+{-# inline sequenceParser #-}+sequenceParser (Parser f) (Parser g) = Parser+ (\x@(# arr, _, _ #) s0 -> case f x s0 of+ (# s1, r0 #) -> case r0 of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# _, b, c #) #) -> g (# arr, b, c #) s1+ )++pureIntParser :: forall (a :: TYPE 'IntRep) e s.+ a -> Parser e s a+{-# inline pureIntParser #-}+pureIntParser a = Parser+ (\(# _, b, c #) s -> (# s, (# | (# a, b, c #) #) #))++bindIntParser :: forall (a :: TYPE 'IntRep) e s b.+ Parser e s a -> (a -> Parser e s b) -> Parser e s b+{-# inline bindIntParser #-}+bindIntParser (Parser f) g = Parser+ (\x@(# arr, _, _ #) s0 -> case f x s0 of+ (# s1, r0 #) -> case r0 of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# y, b, c #) #) ->+ runParser (g y) (# arr, b, c #) s1+ )++sequenceIntParser :: forall (a :: TYPE 'IntRep) e s b.+ Parser e s a -> Parser e s b -> Parser e s b+{-# inline sequenceIntParser #-}+sequenceIntParser (Parser f) (Parser g) = Parser+ (\x@(# arr, _, _ #) s0 -> case f x s0 of+ (# s1, r0 #) -> case r0 of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# _, b, c #) #) -> g (# arr, b, c #) s1+ )++pureIntPairParser :: forall (a :: TYPE ('TupleRep '[ 'IntRep, 'IntRep])) e s.+ a -> Parser e s a+{-# inline pureIntPairParser #-}+pureIntPairParser a = Parser+ (\(# _, b, c #) s -> (# s, (# | (# a, b, c #) #) #))++bindIntPairParser :: forall (a :: TYPE ('TupleRep '[ 'IntRep, 'IntRep])) e s b.+ Parser e s a -> (a -> Parser e s b) -> Parser e s b+{-# inline bindIntPairParser #-}+bindIntPairParser (Parser f) g = Parser+ (\x@(# arr, _, _ #) s0 -> case f x s0 of+ (# s1, r0 #) -> case r0 of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# y, b, c #) #) ->+ runParser (g y) (# arr, b, c #) s1+ )++sequenceIntPairParser :: forall (a :: TYPE ('TupleRep '[ 'IntRep, 'IntRep])) e s b.+ Parser e s a -> Parser e s b -> Parser e s b+{-# inline sequenceIntPairParser #-}+sequenceIntPairParser (Parser f) (Parser g) = Parser+ (\x@(# arr, _, _ #) s0 -> case f x s0 of+ (# s1, r0 #) -> case r0 of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# _, b, c #) #) -> g (# arr, b, c #) s1+ )++instance Bind 'LiftedRep 'LiftedRep where+ {-# inline (>>=) #-}+ {-# inline (>>) #-}+ (>>=) = bindParser+ (>>) = sequenceParser++instance Bind 'IntRep 'LiftedRep where+ {-# inline (>>=) #-}+ {-# inline (>>) #-}+ (>>=) = bindIntParser+ (>>) = sequenceIntParser++instance Bind ('TupleRep '[ 'IntRep, 'IntRep]) 'LiftedRep where+ {-# inline (>>=) #-}+ {-# inline (>>) #-}+ (>>=) = bindIntPairParser+ (>>) = sequenceIntPairParser++instance Bind 'LiftedRep ('TupleRep '[ 'IntRep, 'IntRep]) where+ {-# inline (>>=) #-}+ {-# inline (>>) #-}+ (>>=) = bindFromLiftedToIntPair+ (>>) = sequenceLiftedToIntPair++instance Bind 'IntRep ('TupleRep '[ 'IntRep, 'IntRep]) where+ {-# inline (>>=) #-}+ {-# inline (>>) #-}+ (>>=) = bindFromIntToIntPair+ (>>) = sequenceIntToIntPair++instance Bind 'LiftedRep 'IntRep where+ {-# inline (>>=) #-}+ {-# inline (>>) #-}+ (>>=) = bindFromLiftedToInt+ (>>) = sequenceLiftedToInt++instance Pure 'LiftedRep where+ {-# inline pure #-}+ pure = pureParser++instance Pure 'IntRep where+ {-# inline pure #-}+ pure = pureIntParser++instance Pure ('TupleRep '[ 'IntRep, 'IntRep]) where+ {-# inline pure #-}+ pure = pureIntPairParser++bindFromIntToIntPair ::+ forall s e+ (a :: TYPE 'IntRep)+ (b :: TYPE ('TupleRep '[ 'IntRep, 'IntRep ])).+ Parser s e a+ -> (a -> Parser s e b)+ -> Parser s e b+{-# inline bindFromIntToIntPair #-}+bindFromIntToIntPair (Parser f) g = Parser+ (\x@(# arr, _, _ #) s0 -> case f x s0 of+ (# s1, r0 #) -> case r0 of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# y, b, c #) #) ->+ runParser (g y) (# arr, b, c #) s1+ )++sequenceIntToIntPair ::+ forall s e+ (a :: TYPE 'IntRep)+ (b :: TYPE ('TupleRep '[ 'IntRep, 'IntRep ])).+ Parser s e a+ -> Parser s e b+ -> Parser s e b+{-# inline sequenceIntToIntPair #-}+sequenceIntToIntPair (Parser f) (Parser g) = Parser+ (\x@(# arr, _, _ #) s0 -> case f x s0 of+ (# s1, r0 #) -> case r0 of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# _, b, c #) #) -> g (# arr, b, c #) s1+ )++bindFromLiftedToIntPair ::+ forall s e+ (a :: TYPE 'LiftedRep)+ (b :: TYPE ('TupleRep '[ 'IntRep, 'IntRep ])).+ Parser s e a+ -> (a -> Parser s e b)+ -> Parser s e b+{-# inline bindFromLiftedToIntPair #-}+bindFromLiftedToIntPair (Parser f) g = Parser+ (\x@(# arr, _, _ #) s0 -> case f x s0 of+ (# s1, r0 #) -> case r0 of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# y, b, c #) #) ->+ runParser (g y) (# arr, b, c #) s1+ )++sequenceLiftedToIntPair ::+ forall s e+ (a :: TYPE 'LiftedRep)+ (b :: TYPE ('TupleRep '[ 'IntRep, 'IntRep ])).+ Parser s e a+ -> Parser s e b+ -> Parser s e b+{-# inline sequenceLiftedToIntPair #-}+sequenceLiftedToIntPair (Parser f) (Parser g) = Parser+ (\x@(# arr, _, _ #) s0 -> case f x s0 of+ (# s1, r0 #) -> case r0 of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# _, b, c #) #) -> g (# arr, b, c #) s1+ )++bindFromLiftedToInt ::+ forall s e+ (a :: TYPE 'LiftedRep)+ (b :: TYPE 'IntRep).+ Parser s e a+ -> (a -> Parser s e b)+ -> Parser s e b+{-# inline bindFromLiftedToInt #-}+bindFromLiftedToInt (Parser f) g = Parser+ (\x@(# arr, _, _ #) s0 -> case f x s0 of+ (# s1, r0 #) -> case r0 of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# y, b, c #) #) ->+ runParser (g y) (# arr, b, c #) s1+ )++sequenceLiftedToInt ::+ forall s e+ (a :: TYPE 'LiftedRep)+ (b :: TYPE 'IntRep).+ Parser s e a+ -> Parser s e b+ -> Parser s e b+{-# inline sequenceLiftedToInt #-}+sequenceLiftedToInt (Parser f) (Parser g) = Parser+ (\x@(# arr, _, _ #) s0 -> case f x s0 of+ (# s1, r0 #) -> case r0 of+ (# e | #) -> (# s1, (# e | #) #)+ (# | (# _, b, c #) #) -> g (# arr, b, c #) s1+ )
src/Data/Bytes/Parser/Unsafe.hs view
@@ -25,6 +25,7 @@ Parser(..) -- * Functions , cursor+ , cursor# , expose , unconsume , jump@@ -34,15 +35,21 @@ import Data.Primitive (ByteArray) import Data.Bytes.Types (Bytes(..))-import Data.Bytes.Parser.Internal (Parser(..),uneffectful)+import Data.Bytes.Parser.Internal (Parser(..),uneffectful,uneffectfulInt#) import Data.Bytes.Parser.Internal (InternalResult(..)) +import GHC.Exts (Int#,Int(I#))+ -- | Get the current offset into the chunk. Using this makes -- it possible to observe the internal difference between 'Bytes' -- that refer to equivalent slices. Be careful. cursor :: Parser e s Int cursor = uneffectful $ \Bytes{offset,length} -> InternalSuccess offset offset length++-- | Variant of 'cursor' with unboxed result.+cursor# :: Parser e s Int#+cursor# = uneffectfulInt# $ \Bytes{offset=I# off,length=I# len} -> (# | (# off, off, len #) #) -- | Return the byte array being parsed. This includes bytes -- that preceed the current offset and may include bytes that