packages feed

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