flatparse 0.3.5.1 → 0.4.0.0

raw patch · 34 files changed

+5154/−3362 lines, 34 filesdep +utf8-stringPVP ok

version bump matches the API change (PVP)

Dependencies added: utf8-string

API changes (from Hackage documentation)

Files

• README.md +26/−25
• bench/Bench.hs +19/−0
• bench/FPBasic.hs +10/−6
• bench/FPStateful.hs +7/−6
• bench/ReadInteger.hs +2/−2
• flatparse.cabal +32/−10
• src/FlatParse/Basic.hs +504/−1437
• src/FlatParse/Basic/Addr.hs +91/−0
• src/FlatParse/Basic/Base.hs +356/−0
• src/FlatParse/Basic/Bytes.hs +63/−0
• src/FlatParse/Basic/Integers.hs +391/−0
• src/FlatParse/Basic/Parser.hs +177/−0
• src/FlatParse/Basic/Switch.hs +167/−0
• src/FlatParse/Basic/Text.hs +298/−0
• src/FlatParse/Common/Assorted.hs +168/−0
• src/FlatParse/Common/GHCExts.hs +23/−0
• src/FlatParse/Common/Numbers.hs +251/−0
• src/FlatParse/Common/Parser.hs +24/−0
• src/FlatParse/Common/Position.hs +48/−0
• src/FlatParse/Common/Strings.hs +69/−0
• src/FlatParse/Common/Switch.hs +89/−0
• src/FlatParse/Examples/BasicLambda/Lexer.hs +8/−5
• src/FlatParse/Examples/BasicLambda/Parser.hs +3/−2
• src/FlatParse/Internal.hs +0/−252
• src/FlatParse/Internal/UnboxedNumerics.hs +0/−115
• src/FlatParse/Stateful.hs +483/−1269
• src/FlatParse/Stateful/Addr.hs +91/−0
• src/FlatParse/Stateful/Base.hs +359/−0
• src/FlatParse/Stateful/Bytes.hs +64/−0
• src/FlatParse/Stateful/Integers.hs +392/−0
• src/FlatParse/Stateful/Parser.hs +178/−0
• src/FlatParse/Stateful/Switch.hs +166/−0
• src/FlatParse/Stateful/Text.hs +299/−0
• test/Test.hs +296/−233

@@ -17,18 +17,18 @@  ## Features and non-features -* __Excellent performance__. On microbenchmarks, `flatparse` is around 10 times faster than `attoparsec` or `megaparsec`. On larger examples with heavier use of source positions and spans and/or indentation parsing, the performance difference grows to 20-30 times. Compile times and exectuable sizes are also significantly better with `flatparse` than with `megaparsec` or `attoparsec`. `flatparse` internals make liberal use of unboxed tuples and GHC primops. As a result, pure validators (parsers returning `()`) in `flatparse` are not difficult to implement with zero heap allocation.+* __Excellent performance__. On microbenchmarks, `flatparse` is around 10 times faster than `attoparsec` or `megaparsec`. On larger examples with heavier use of source positions and spans and/or indentation parsing, the performance difference grows to 20-30 times. Compile times and executable sizes are also significantly better with `flatparse` than with `megaparsec` or `attoparsec`. `flatparse` internals make liberal use of unboxed tuples and GHC primops. As a result, pure validators (parsers returning `()`) in `flatparse` are not difficult to implement with zero heap allocation. * __No incremental parsing__, and __only strict `ByteString`__ is supported as input. However, it can be still useful to convert from `Text`, `String` or other types to `ByteString`, and then use `flatparse` for parsing, since `flatparse` performance usually more than makes up for the conversion costs.-* __Only little-endian 64 bit systems are currently supported as the host machine__. This may change in the future. Getting good performance requires architecture-specific optimizations; I've only considered the most common setting at this point. However, `flatparse` does include specific big-endian parsers for primitive integer types.+* __Only little-endian 64 bit systems are currently supported as the host machine__. This may change in the future. Getting good performance requires architecture-specific optimizations; I've only considered the most common setting at this point. However, `flatparse` does include primitive integer parsers with specific endianness. * __Support for fast source location handling, indentation parsing and informative error messages__. `flatparse` provides a low-level interface to these. Batteries are _not included_, but it should be possible for users to build custom solutions, which are more sophisticated, but still as fast as possible. In my experience, the included batteries in other libraries often come with major unavoidable overheads, and often we still have to extend existing machinery in order to scale to production features. * The __backtracking model__ of `flatparse` is different to parsec libraries, and is more close to the [nom](https://github.com/Geal/nom) library in Rust. The idea is that _parser failure_ is distinguished from _parsing error_. The former is used for control flow, and we can backtrack from it. The latter is used for unrecoverable errors, and by default it's propagated to the top. `flatparse` does not track whether parsers have consumed inputs. In my experience, what we really care about is the failure/error distinction, and in `parsec` or `megaparsec` the consumed/non-consumed separation is often muddled and discarded in larger parser implementations. By default, basic `flatparse` parsers can fail but can not throw errors, with the exception of the specifically error-throwing operations. Hence, `flatparse` users have to be mindful about grammar, and explicitly insert errors where it is known that the input can't be valid. -`flatparse` comes in two flavors: [`FlatParse.Basic`][basic] and [`FlatParse.Stateful`][stateful]. Both support a custom error type.+`flatparse` comes in two flavors: [`FlatParse.Basic`][basic] and [`FlatParse.Stateful`][stateful]. Both support a custom error type. Also, both come in three modes, where we can respectively run `IO` actions, `ST` actions, or no side effects. The modes are selected by a state token type parameter on the parser types.  * [`FlatParse.Basic`][basic] only supports the above features. If you don't need indentation   parsing, this is sufficient. * [`FlatParse.Stateful`][stateful] additionally supports a built-in `Int` worth of internal state-  and an additional custom reader environemnt. This can support a wide range of indentation parsing+  and an additional custom reader environment. This can support a wide range of indentation parsing   features. There is a slight overhead in performance and code size compared to `Basic`. However, in   small parsers and microbenchmarks the difference between `Basic` and `Stateful` is often reduced   to near zero by GHC and/or LLVM optimization.@@ -45,35 +45,36 @@ ## Some benchmarks  Execution times below. See source code in [bench](bench). Compiled with GHC-8.10.7 `-O2 -fllvm`. Executed on Intel 1165G7 CPU at 28W power draw.+9.4.4 `-O2 -fllvm`. Executed on Intel 1165G7 CPU at 28W power draw. Uses+`nightly-2023-02-06` Stackage snapshot for the involved packages.  |      benchmark              |  runtime   | |-----------------------------|--------------|sexp/fpbasic                 | 1.625 ms   |-|sexp/fpstateful              | 1.815 ms   |-|sexp/attoparsec              | 21.75 ms   |-|sexp/megaparsec              | 33.12 ms   |-|sexp/parsec                  | 98.65 ms   |-|long keyword/fpbasic         | 115.9 μs   |-|long keyword/fpstateful      | 117.7 μs   |-|long keyword/attoparsec      | 2.955 ms   |-|long keyword/megaparsec      | 2.185 ms   |-|long keyword/parsec          | 29.91 ms   |-|numeral csv/fpbasic          | 549.3 μs   |-|numeral csv/fpstateful       | 595.5 μs   |-|numeral csv/attoparsec       | 10.82 ms   |-|numeral csv/megaparsec       | 6.581 ms   |-|numeral csv/parsec           | 39.33 ms   |+|sexp/fpbasic                 | 1.93 ms    |+|sexp/fpstateful              | 2.00 ms    |+|sexp/attoparsec              | 21.82 ms   |+|sexp/megaparsec              | 59.60 ms   |+|sexp/parsec                  | 79.81 ms   |+|long keyword/fpbasic         | 96.95 μs   |+|long keyword/fpstateful      | 95.30 μs   |+|long keyword/attoparsec      | 2.43 ms    |+|long keyword/megaparsec      | 5.196 ms   |+|long keyword/parsec          | 10.02 ms   |+|numeral csv/fpbasic          | 715.2 μs   |+|numeral csv/fpstateful       | 555.0 μs   |+|numeral csv/attoparsec       | 10.52 ms   |+|numeral csv/megaparsec       | 19.77 ms   |+|numeral csv/parsec           | 26.46 ms   |  Object file sizes for each module containing the `s-exp`, `long keyword` and `numeral csv` benchmarks.  | library    | object file size (bytes) | | -------    | ------------------------ |-| fpbasic    |  23752                   |-| fpstateful |  25920                   |-| attoparsec |  93584                   |-| megaparsec |  257000                  |-| parsec     |  134296                  |+| fpbasic    |  20656                   |+| fpstateful |  26664                   |+| attoparsec |  69384                   |+| megaparsec |  226232                  |+| parsec     |  117696                  |  [basic]: https://hackage.haskell.org/package/flatparse/docs/FlatParse-Basic.html [stateful]: https://hackage.haskell.org/package/flatparse/docs/FlatParse-Stateful.html

@@ -14,6 +14,10 @@ import qualified FPBasic import qualified ReadInteger +import qualified Data.ByteString.UTF8+import qualified FlatParse.Common.Assorted+import qualified FlatParse.Basic+ sexpInp :: B.ByteString sexpInp =   B.concat $ "(" : replicate 33333 "(foo (foo (foo ((bar baza)))))" ++ [")"]@@ -27,8 +31,23 @@ readIntInp :: B.ByteString readIntInp = "12345678910" +longString :: String+longString =+  concat $ "(" : replicate 33333 "(foo (foo (foo ((bar baza)))))" ++ [")"]+ main :: IO () main = defaultMain [+{-+  bgroup "String -> UTF-8 ByteString" [+    bench "utf8-string" $ whnf Data.ByteString.UTF8.toString sexpInp,+    bench "fp" $ whnf FlatParse.Common.Assorted.utf8ToStr sexpInp+  ],+  bgroup "UTF-8 ByteString -> String" [+    bench "utf8-string" $ whnf Data.ByteString.UTF8.fromString longString,+    bench "fp" $ whnf FlatParse.Common.Assorted.strToUtf8 longString+  ]+ ]+-}   bgroup "sexp" [     bench "fpbasic"     $ whnf FPBasic.runSexp    sexpInp,     bench "fpstateful"  $ whnf FPStateful.runSexp sexpInp,

@@ -5,20 +5,24 @@   , runNumcsv) where  import FlatParse.Basic+import FlatParse.Common.Assorted -ws      = many_ $(switch [| case _ of " " -> pure (); "\n" -> pure () |])+ws, open, close, ident, sexp, src :: Parser () ()+ws      = skipMany $(switch [| case _ of " " -> pure (); "\n" -> pure () |]) open    = $(char '(') >> ws close   = $(char ')') >> ws-ident   = some_ (satisfyASCII_ isLatinLetter) >> ws-sexp    = branch open (some_ sexp >> close) ident+ident   = skipSome (skipSatisfyAscii isLatinLetter) >> ws+sexp    = branch open (skipSome sexp >> close) ident src     = sexp >> eof runSexp = runParser src +longw, longws :: Parser () () longw     = $(string "thisisalongkeyword")-longws    = some_ (longw >> ws) >> eof+longws    = skipSome (longw >> ws) >> eof runLongws = runParser longws -numeral   = some_ (satisfyASCII_ isDigit) >> ws+numeral, comma, numcsv :: Parser () ()+numeral   = skipSome (skipSatisfyAscii isDigit) >> ws comma     = $(char ',') >> ws-numcsv    = numeral >> many_ (comma >> numeral) >> eof+numcsv    = numeral >> skipMany (comma >> numeral) >> eof runNumcsv = runParser numcsv

@@ -5,23 +5,24 @@   , runNumcsv) where  import FlatParse.Stateful+import FlatParse.Common.Assorted  ws, open, close, ident, sexp, src :: Parser () () ()-ws      = many_ $(switch [| case _ of " " -> pure (); "\n" -> pure () |])+ws      = skipMany $(switch [| case _ of " " -> pure (); "\n" -> pure () |]) open    = $(char '(') >> ws close   = $(char ')') >> ws-ident   = some_ (satisfyASCII_ isLatinLetter) >> ws-sexp    = branch open (some_ sexp >> close) ident+ident   = skipSome (skipSatisfyAscii isLatinLetter) >> ws+sexp    = branch open (skipSome sexp >> close) ident src     = sexp >> eof runSexp = runParser src () 0  longw, longws :: Parser () () () longw     = $(string "thisisalongkeyword")-longws    = some_ (longw >> ws) >> eof+longws    = skipSome (longw >> ws) >> eof runLongws = runParser longws () 0  numeral, comma, numcsv :: Parser () () ()-numeral   = some_ (satisfyASCII_ isDigit) >> ws+numeral   = skipSome (skipSatisfyAscii isDigit) >> ws comma     = $(char ',') >> ws-numcsv    = numeral >> many_ (comma >> numeral) >> eof+numcsv    = numeral >> skipMany (comma >> numeral) >> eof runNumcsv = runParser numcsv () 0

@@ -3,5 +3,5 @@  import FlatParse.Basic as FPBasic -readInt     = runParser FPBasic.readInt-readInteger = runParser FPBasic.readInteger+readInt     = runParser FPBasic.anyAsciiDecimalInt+readInteger = runParser FPBasic.anyAsciiDecimalInteger

@@ -1,14 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack  name:           flatparse-version:        0.3.5.1+version:        0.4.0.0 synopsis:       High-performance parsing from strict bytestrings-description:    @Flatparse@ is a high-performance parsing library, focusing on programming languages and-                human-readable data formats. See the README for more information:+description:    @Flatparse@ is a high-performance parsing library for strict bytestring input. See the README for more information:                 <https://github.com/AndrasKovacs/flatparse>. category:       Parsing homepage:       https://github.com/AndrasKovacs/flatparse#readme@@ -24,7 +23,8 @@   , GHC == 8.8.4   , GHC == 8.10.7   , GHC == 9.0.2-  , GHC == 9.2.2+  , GHC == 9.2.5+  , GHC == 9.4.4 extra-source-files:     README.md @@ -45,11 +45,30 @@ library   exposed-modules:       FlatParse.Basic+      FlatParse.Basic.Addr+      FlatParse.Basic.Base+      FlatParse.Basic.Bytes+      FlatParse.Basic.Integers+      FlatParse.Basic.Parser+      FlatParse.Basic.Switch+      FlatParse.Basic.Text+      FlatParse.Common.Assorted+      FlatParse.Common.GHCExts+      FlatParse.Common.Numbers+      FlatParse.Common.Parser+      FlatParse.Common.Position+      FlatParse.Common.Strings+      FlatParse.Common.Switch       FlatParse.Examples.BasicLambda.Lexer       FlatParse.Examples.BasicLambda.Parser-      FlatParse.Internal-      FlatParse.Internal.UnboxedNumerics       FlatParse.Stateful+      FlatParse.Stateful.Addr+      FlatParse.Stateful.Base+      FlatParse.Stateful.Bytes+      FlatParse.Stateful.Integers+      FlatParse.Stateful.Parser+      FlatParse.Stateful.Switch+      FlatParse.Stateful.Text   other-modules:       Paths_flatparse   hs-source-dirs:@@ -72,11 +91,12 @@     , containers     , integer-gmp     , template-haskell+    , utf8-string >=1.0.2 && <1.1+  default-language: Haskell2010   if flag(dump)     ghc-options: -ddump-simpl -ddump-stg-final -ddump-cmm -dsuppress-all -dno-suppress-type-signatures -ddump-to-file   if flag(llvm)     ghc-options: -fllvm-  default-language: Haskell2010  test-suite spec   type: exitcode-stdio-1.0@@ -106,11 +126,12 @@     , flatparse     , hspec     , quickcheck-instances+    , utf8-string >=1.0.2 && <1.1+  default-language: Haskell2010   if flag(dump)     ghc-options: -ddump-simpl -ddump-stg-final -ddump-cmm -dsuppress-all -dno-suppress-type-signatures -ddump-to-file   if flag(llvm)     ghc-options: -fllvm-  default-language: Haskell2010  benchmark bench   type: exitcode-stdio-1.0@@ -147,8 +168,9 @@     , megaparsec     , parsec     , primitive+    , utf8-string >=1.0.2 && <1.1+  default-language: Haskell2010   if flag(dump)     ghc-options: -ddump-simpl -ddump-stg-final -ddump-cmm -dsuppress-all -dno-suppress-type-signatures -ddump-to-file   if flag(llvm)     ghc-options: -fllvm-  default-language: Haskell2010

@@ -1,1437 +1,504 @@-{-# language UnboxedTuples #-}--{-|-This module implements a `Parser` supporting custom error types.  If you need efficient indentation-parsing, use "FlatParse.Stateful" instead.--Many internals are exposed for hacking on and extending. These are generally-denoted by a @#@ hash suffix.--}--module FlatParse.Basic (--  -- * Parser types and constructors-    type Parser(..)-  , type Res#-  , pattern OK#-  , pattern Fail#-  , pattern Err#-  , Result(..)--  -- * Running parsers-  , runParser-  , runParserS--  -- * Errors and failures-  , empty-  , err-  , lookahead-  , fails-  , try-  , optional-  , optional_-  , withOption-  , cut-  , cutting--  -- * Basic lexing and parsing-  , eof-  , takeBs-  , takeRestBs-  , skip-  , char-  , byte-  , bytes-  , string-  , switch-  , switchWithPost-  , rawSwitchWithPost-  , satisfy-  , satisfy_-  , satisfyASCII-  , satisfyASCII_-  , fusedSatisfy-  , fusedSatisfy_-  , anyWord8-  , anyWord8_-  , anyWord16-  , anyWord16_-  , anyWord32-  , anyWord32_-  , anyWord64-  , anyWord64_-  , anyWord-  , anyWord_-  , anyInt8-  , anyInt16-  , anyInt32-  , anyInt64-  , anyInt-  , anyChar-  , anyChar_-  , anyCharASCII-  , anyCharASCII_-  , FlatParse.Internal.isDigit-  , FlatParse.Internal.isGreekLetter-  , FlatParse.Internal.isLatinLetter-  , FlatParse.Basic.readInt-  , FlatParse.Basic.readInteger-  , anyCString--  -- ** Explicit-endianness machine integers-  , anyWord16le-  , anyWord16be-  , anyWord32le-  , anyWord32be-  , anyWord64le-  , anyWord64be-  , anyInt16le-  , anyInt16be-  , anyInt32le-  , anyInt32be-  , anyInt64le-  , anyInt64be--  -- * Combinators-  , (<|>)-  , branch-  , chainl-  , chainr-  , many-  , many_-  , some-  , some_-  , notFollowedBy-  , isolate--  -- * Positions and spans-  , Pos(..)-  , Span(..)-  , getPos-  , setPos-  , endPos-  , spanOf-  , withSpan-  , byteStringOf-  , withByteString-  , inSpan--  -- ** Position and span conversions-  , validPos-  , posLineCols-  , unsafeSpanToByteString-  , unsafeSlice-  , mkPos-  , FlatParse.Basic.lines--  -- * Getting the rest of the input as a 'String'-  , takeLine-  , traceLine-  , takeRest-  , traceRest--  -- * `String` conversions-  , packUTF8-  , unpackUTF8--  -- * Internal functions-  , ensureBytes#--  -- ** Unboxed arguments-  , takeBs#-  , atSkip#--  -- *** Location & address primitives-  , setBack#-  , withAddr#-  , takeBsOffAddr#-  , lookaheadFromAddr#-  , atAddr#--  -- ** Machine integer continuation parsers-  , withAnyWord8#-  , withAnyWord16#-  , withAnyWord32#-  , withAnyWord64#-  , withAnyInt8#-  , withAnyInt16#-  , withAnyInt32#-  , withAnyInt64#--  -- ** Unsafe-  , anyCStringUnsafe-  , scan8#-  , scan16#-  , scan32#-  , scan64#-  , scanAny8#-  , scanBytes#--  ) where--import Control.Monad-import Data.Foldable-import Data.List (sortBy)-import Data.Map (Map)-import Data.Ord (comparing)-import Data.Word-import GHC.Exts-import GHC.Word-import GHC.Int-import GHC.ForeignPtr-import Language.Haskell.TH-import System.IO.Unsafe--import qualified Data.ByteString as B-import qualified Data.ByteString.Unsafe as B-import qualified Data.ByteString.Internal as B-import qualified Data.Map.Strict as M--import FlatParse.Internal-import FlatParse.Internal.UnboxedNumerics-------------------------------------------------------------------------------------- | Primitive result of a parser. Possible results are given by `OK#`, `Err#` and `Fail#`---   pattern synonyms.-type Res# e a =-  (#-    (# a, Addr# #)-  | (# #)-  | (# e #)-  #)---- | Contains return value and a pointer to the rest of the input buffer.-pattern OK# :: a -> Addr# -> Res# e a-pattern OK# a s = (# (# a, s #) | | #)---- | Constructor for errors which are by default non-recoverable.-pattern Err# :: e -> Res# e a-pattern Err# e = (# | | (# e #) #)---- | Constructor for recoverable failure.-pattern Fail# :: Res# e a-pattern Fail# = (# | (# #) | #)-{-# complete OK#, Err#, Fail# #-}---- | @Parser e a@ has an error type @e@ and a return type @a@.-newtype Parser e a = Parser {runParser# :: ForeignPtrContents -> Addr# -> Addr# -> Res# e a}--instance Functor (Parser e) where-  fmap f (Parser g) = Parser \fp eob s -> case g fp eob s of-    OK# a s -> let !b = f a in OK# b s-    x       -> unsafeCoerce# x-  {-# inline fmap #-}--  (<$) a' (Parser g) = Parser \fp eob s -> case g fp eob s of-    OK# a s -> OK# a' s-    x       -> unsafeCoerce# x-  {-# inline (<$) #-}--instance Applicative (Parser e) where-  pure a = Parser \fp eob s -> OK# a s-  {-# inline pure #-}-  Parser ff <*> Parser fa = Parser \fp eob s -> case ff fp eob s of-    OK# f s -> case fa fp eob s of-      OK# a s  -> let !b = f a in OK# b s-      x        -> unsafeCoerce# x-    x -> unsafeCoerce# x-  {-# inline (<*>) #-}-  Parser fa <* Parser fb = Parser \fp eob s -> case fa fp eob s of-    OK# a s   -> case fb fp eob s of-      OK# b s -> OK# a s-      x -> unsafeCoerce# x-    x -> unsafeCoerce# x-  {-# inline (<*) #-}-  Parser fa *> Parser fb = Parser \fp eob s -> case fa fp eob s of-    OK# a s -> fb fp eob s-    x       -> unsafeCoerce# x-  {-# inline (*>) #-}--instance Monad (Parser e) where-  return = pure-  {-# inline return #-}-  Parser fa >>= f = Parser \fp eob s -> case fa fp eob s of-    OK# a s -> runParser# (f a) fp eob s-    x       -> unsafeCoerce# x-  {-# inline (>>=) #-}-  (>>) = (*>)-  {-# inline (>>) #-}---- | Higher-level boxed data type for parsing results.-data Result e a =-    OK a !(B.ByteString)  -- ^ Contains return value and unconsumed input.-  | Fail                  -- ^ Recoverable-by-default failure.-  | Err !e                -- ^ Unrecoverble-by-default error.-  deriving Show--instance Functor (Result e) where-  fmap f (OK a s) = let !b = f a in OK b s-  fmap f r        = unsafeCoerce# r-  {-# inline fmap #-}-  (<$) a (OK _ s) = OK a s-  (<$) _ r        = unsafeCoerce# r-  {-# inline (<$) #-}--------------------------------------------------------------------------------------- | Run a parser.-runParser :: Parser e a -> B.ByteString -> Result e a-runParser (Parser f) b@(B.PS (ForeignPtr _ fp) _ (I# len)) = unsafeDupablePerformIO do-  B.unsafeUseAsCString b \(Ptr buf) -> do-    let end = plusAddr# buf len-    case f fp end buf of-      Err# e ->-        pure (Err e)-      OK# a s -> do-        let offset = minusAddr# s buf-        pure (OK a (B.drop (I# offset) b))-      Fail# ->-        pure Fail-{-# inlinable runParser #-}---- | Run a parser on a `String` input. Reminder: @OverloadedStrings@ for `B.ByteString` does not---   yield a valid UTF-8 encoding! For non-ASCII `B.ByteString` literal input, use `runParserS` or---   `packUTF8` for testing.-runParserS :: Parser e a -> String -> Result e a-runParserS pa s = runParser pa (packUTF8 s)--------------------------------------------------------------------------------------- | The failing parser. By default, parser choice `(<|>)` arbitrarily backtracks---   on parser failure.-empty :: Parser e a-empty = Parser \fp eob s -> Fail#-{-# inline empty #-}---- | Throw a parsing error. By default, parser choice `(<|>)` can't backtrack---   on parser error. Use `try` to convert an error to a recoverable failure.-err :: e -> Parser e a-err e = Parser \fp eob s -> Err# e-{-# inline err #-}---- | Save the parsing state, then run a parser, then restore the state.-lookahead :: Parser e a -> Parser e a-lookahead (Parser f) = Parser \fp eob s ->-  case f fp eob s of-    OK# a _ -> OK# a s-    x       -> x-{-# inline lookahead #-}---- | Convert a parsing failure to a success.-fails :: Parser e a -> Parser e ()-fails (Parser f) = Parser \fp eob s ->-  case f fp eob s of-    OK# _ _ -> Fail#-    Fail#   -> OK# () s-    Err# e  -> Err# e-{-# inline fails #-}---- | Convert a parsing error into failure.-try :: Parser e a -> Parser e a-try (Parser f) = Parser \fp eob s -> case f fp eob s of-  Err# _ -> Fail#-  x      -> x-{-# inline try #-}---- | Convert a parsing failure to a `Maybe`. If possible, use `withOption` instead.-optional :: Parser e a -> Parser e (Maybe a)-optional p = (Just <$> p) <|> pure Nothing-{-# inline optional #-}---- | Convert a parsing failure to a `()`.-optional_ :: Parser e a -> Parser e ()-optional_ p = (() <$ p) <|> pure ()-{-# inline optional_ #-}---- | CPS'd version of `optional`. This is usually more efficient, since it gets rid of the---   extra `Maybe` allocation.-withOption :: Parser e a -> (a -> Parser e b) -> Parser e b -> Parser e b-withOption (Parser f) just (Parser nothing) = Parser \fp eob s -> case f fp eob s of-  OK# a s -> runParser# (just a) fp eob s-  Fail#   -> nothing fp eob s-  Err# e  -> Err# e-{-# inline withOption #-}---- | Convert a parsing failure to an error.-cut :: Parser e a -> e -> Parser e a-cut (Parser f) e = Parser \fp eob s -> case f fp eob s of-  Fail# -> Err# e-  x     -> x-{-# inline cut #-}---- | Run the parser, if we get a failure, throw the given error, but if we get an error, merge the---   inner and the newly given errors using the @e -> e -> e@ function. This can be useful for---   implementing parsing errors which may propagate hints or accummulate contextual information.-cutting :: Parser e a -> e -> (e -> e -> e) -> Parser e a-cutting (Parser f) e merge = Parser \fp eob s -> case f fp eob s of-  Fail#   -> Err# e-  Err# e' -> let !e'' = merge e' e in Err# e''-  x       -> x-{-# inline cutting #-}--------------------------------------------------------------------------------------- | Succeed if the input is empty.-eof :: Parser e ()-eof = Parser \fp eob s -> case eqAddr# eob s of-  1# -> OK# () s-  _  -> Fail#-{-# inline eof #-}---- | Read the given number of bytes as a 'ByteString'.------ Throws a runtime error if given a negative integer.-takeBs :: Int -> Parser e B.ByteString-takeBs (I# n#) = takeBs# n#-{-# inline takeBs #-}---- | Consume the rest of the input. May return the empty bytestring.-takeRestBs :: Parser e B.ByteString-takeRestBs = Parser \fp eob s ->-  let n# = minusAddr# eob s-  in  OK# (B.PS (ForeignPtr s fp) 0 (I# n#)) eob-{-# inline takeRestBs #-}---- | Skip forward @n@ bytes. Fails if fewer than @n@ bytes are available.------ Throws a runtime error if given a negative integer.-skip :: Int -> Parser e ()-skip (I# os#) = atSkip# os# (pure ())-{-# inline skip #-}---- | Parse a UTF-8 character literal. This is a template function, you can use it as---   @$(char \'x\')@, for example, and the splice in this case has type @Parser e ()@.-char :: Char -> Q Exp-char c = string [c]---- | Read a `Word8`.-byte :: Word8 -> Parser e ()-byte w = ensureBytes# 1 >> scan8# w-{-# inline byte #-}---- | Read a sequence of bytes. This is a template function, you can use it as @$(bytes [3, 4, 5])@,---   for example, and the splice has type @Parser e ()@.-bytes :: [Word] -> Q Exp-bytes bytes = do-  let !len = length bytes-  [| ensureBytes# len >> $(scanBytes# bytes) |]---- | Parse a UTF-8 string literal. This is a template function, you can use it as @$(string "foo")@,---   for example, and the splice has type @Parser e ()@.-string :: String -> Q Exp-string str = bytes (strToBytes str)--{-|-This is a template function which makes it possible to branch on a collection of string literals in-an efficient way. By using `switch`, such branching is compiled to a trie of primitive parsing-operations, which has optimized control flow, vectorized reads and grouped checking for needed input-bytes.--The syntax is slightly magical, it overloads the usual @case@ expression. An example:--@-    $(switch [| case _ of-        "foo" -> pure True-        "bar" -> pure False |])-@--The underscore is mandatory in @case _ of@. Each branch must be a string literal, but optionally-we may have a default case, like in--@-    $(switch [| case _ of-        "foo" -> pure 10-        "bar" -> pure 20-        _     -> pure 30 |])-@--All case right hand sides must be parsers with the same type. That type is also the type-of the whole `switch` expression.--A `switch` has longest match semantics, and the order of cases does not matter, except for-the default case, which may only appear as the last case.--If a `switch` does not have a default case, and no case matches the input, then it returns with-failure, \without\ having consumed any input. A fallthrough to the default case also does not-consume any input.--}-switch :: Q Exp -> Q Exp-switch = switchWithPost Nothing--{-|-Switch expression with an optional first argument for performing a post-processing action after-every successful branch matching, not including the default branch. For example, if we have-@ws :: Parser e ()@ for a whitespace parser, we might want to consume whitespace after matching-on any of the switch cases. For that case, we can define a "lexeme" version of `switch` as-follows.--@-  switch' :: Q Exp -> Q Exp-  switch' = switchWithPost (Just [| ws |])-@--Note that this @switch'@ function cannot be used in the same module it's defined in, because of the-stage restriction of Template Haskell.--}-switchWithPost :: Maybe (Q Exp) -> Q Exp -> Q Exp-switchWithPost postAction exp = do-  !postAction <- sequence postAction-  (!cases, !fallback) <- parseSwitch exp-  genTrie $! genSwitchTrie' postAction cases fallback---- | Version of `switchWithPost` without syntactic sugar. The second argument is the---   list of cases, the third is the default case.-rawSwitchWithPost :: Maybe (Q Exp) -> [(String, Q Exp)] -> Maybe (Q Exp) -> Q Exp-rawSwitchWithPost postAction cases fallback = do-  !postAction <- sequence postAction-  !cases <- forM cases \(str, rhs) -> (str,) <$> rhs-  !fallback <- sequence fallback-  genTrie $! genSwitchTrie' postAction cases fallback---- | Parse a UTF-8 `Char` for which a predicate holds.-satisfy :: (Char -> Bool) -> Parser e Char-satisfy f = Parser \fp eob s -> case runParser# anyChar fp eob s of-  OK# c s | f c -> OK# c s-  _             -> Fail#-{-#  inline satisfy #-}---- | Skip a UTF-8 `Char` for which a predicate holds.-satisfy_ :: (Char -> Bool) -> Parser e ()-satisfy_ f = Parser \fp eob s -> case runParser# anyChar fp eob s of-  OK# c s | f c -> OK# () s-  _             -> Fail#-{-#  inline satisfy_ #-}---- | Parse an ASCII `Char` for which a predicate holds. Assumption: the predicate must only return---   `True` for ASCII-range characters. Otherwise this function might read a 128-255 range byte,---   thereby breaking UTF-8 decoding.-satisfyASCII :: (Char -> Bool) -> Parser e Char-satisfyASCII f = Parser \fp eob s -> case eqAddr# eob s of-  1# -> Fail#-  _  -> case derefChar8# s of-    c1 | f (C# c1) -> OK# (C# c1) (plusAddr# s 1#)-       | otherwise -> Fail#-{-#  inline satisfyASCII #-}---- | Skip an ASCII `Char` for which a predicate holds. Assumption: the predicate---   must only return `True` for ASCII-range characters.-satisfyASCII_ :: (Char -> Bool) -> Parser e ()-satisfyASCII_ f = Parser \fp eob s -> case eqAddr# eob s of-  1# -> Fail#-  _  -> case derefChar8# s of-    c1 | f (C# c1) -> OK# () (plusAddr# s 1#)-       | otherwise -> Fail#-{-#  inline satisfyASCII_ #-}---- | This is a variant of `satisfy` which allows more optimization. We can pick four testing---   functions for the four cases for the possible number of bytes in the UTF-8 character. So in---   @fusedSatisfy f1 f2 f3 f4@, if we read a one-byte character, the result is scrutinized with---   @f1@, for two-bytes, with @f2@, and so on. This can result in dramatic lexing speedups.------   For example, if we want to accept any letter, the naive solution would be to use---   `Data.Char.isLetter`, but this accesses a large lookup table of Unicode character classes. We---   can do better with @fusedSatisfy isLatinLetter isLetter isLetter isLetter@, since here the---   `isLatinLetter` is inlined into the UTF-8 decoding, and it probably handles a great majority of---   all cases without accessing the character table.-fusedSatisfy :: (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> Parser e Char-fusedSatisfy f1 f2 f3 f4 = Parser \fp eob buf -> case eqAddr# eob buf of-  1# -> Fail#-  _  -> case derefChar8# buf of-    c1 -> case c1 `leChar#` '\x7F'# of-      1# | f1 (C# c1) -> OK# (C# c1) (plusAddr# buf 1#)-         | otherwise  -> Fail#-      _  -> case eqAddr# eob (plusAddr# buf 1#) of-        1# -> Fail#-        _ -> case indexCharOffAddr# buf 1# of-          c2 -> case c1 `leChar#` '\xDF'# of-            1# ->-              let resc = C# (chr# (((ord# c1 -# 0xC0#) `uncheckedIShiftL#` 6#) `orI#`-                                   (ord# c2 -# 0x80#)))-              in case f2 resc of-                   True -> OK# resc (plusAddr# buf 2#)-                   _    -> Fail#-            _ -> case eqAddr# eob (plusAddr# buf 2#) of-              1# -> Fail#-              _  -> case indexCharOffAddr# buf 2# of-                c3 -> case c1 `leChar#` '\xEF'# of-                  1# ->-                    let resc = C# (chr# (((ord# c1 -# 0xE0#) `uncheckedIShiftL#` 12#) `orI#`-                                         ((ord# c2 -# 0x80#) `uncheckedIShiftL#`  6#) `orI#`-                                         (ord# c3 -# 0x80#)))-                    in case f3 resc of-                         True -> OK# resc (plusAddr# buf 3#)-                         _    -> Fail#-                  _ -> case eqAddr# eob (plusAddr# buf 3#) of-                    1# -> Fail#-                    _  -> case indexCharOffAddr# buf 3# of-                      c4 ->-                        let resc = C# (chr# (((ord# c1 -# 0xF0#) `uncheckedIShiftL#` 18#) `orI#`-                                             ((ord# c2 -# 0x80#) `uncheckedIShiftL#` 12#) `orI#`-                                             ((ord# c3 -# 0x80#) `uncheckedIShiftL#`  6#) `orI#`-                                              (ord# c4 -# 0x80#)))-                        in case f4 resc of-                             True -> OK# resc (plusAddr# buf 4#)-                             _    -> Fail#-{-# inline fusedSatisfy #-}---- | Skipping variant of `fusedSatisfy`.-fusedSatisfy_ :: (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> Parser e ()-fusedSatisfy_ f1 f2 f3 f4 = () <$ fusedSatisfy f1 f2 f3 f4-{-# inline fusedSatisfy_ #-}---- | Parse any UTF-8-encoded `Char`.-anyChar :: Parser e Char-anyChar = Parser \fp eob buf -> case eqAddr# eob buf of-  1# -> Fail#-  _  -> case derefChar8# buf of-    c1 -> case c1 `leChar#` '\x7F'# of-      1# -> OK# (C# c1) (plusAddr# buf 1#)-      _  -> case eqAddr# eob (plusAddr# buf 1#) of-        1# -> Fail#-        _ -> case indexCharOffAddr# buf 1# of-          c2 -> case c1 `leChar#` '\xDF'# of-            1# ->-              let resc = ((ord# c1 -# 0xC0#) `uncheckedIShiftL#` 6#) `orI#`-                          (ord# c2 -# 0x80#)-              in OK# (C# (chr# resc)) (plusAddr# buf 2#)-            _ -> case eqAddr# eob (plusAddr# buf 2#) of-              1# -> Fail#-              _  -> case indexCharOffAddr# buf 2# of-                c3 -> case c1 `leChar#` '\xEF'# of-                  1# ->-                    let resc = ((ord# c1 -# 0xE0#) `uncheckedIShiftL#` 12#) `orI#`-                               ((ord# c2 -# 0x80#) `uncheckedIShiftL#`  6#) `orI#`-                                (ord# c3 -# 0x80#)-                    in OK# (C# (chr# resc)) (plusAddr# buf 3#)-                  _ -> case eqAddr# eob (plusAddr# buf 3#) of-                    1# -> Fail#-                    _  -> case indexCharOffAddr# buf 3# of-                      c4 ->-                        let resc = ((ord# c1 -# 0xF0#) `uncheckedIShiftL#` 18#) `orI#`-                                   ((ord# c2 -# 0x80#) `uncheckedIShiftL#` 12#) `orI#`-                                   ((ord# c3 -# 0x80#) `uncheckedIShiftL#`  6#) `orI#`-                                    (ord# c4 -# 0x80#)-                        in OK# (C# (chr# resc)) (plusAddr# buf 4#)-{-# inline anyChar #-}---- | Skip any UTF-8-encoded `Char`.-anyChar_ :: Parser e ()-anyChar_ = Parser \fp eob buf -> case eqAddr# eob buf of-  1# -> Fail#-  _  -> case derefChar8# buf of-    c1 -> case c1 `leChar#` '\x7F'# of-      1# -> OK# () (plusAddr# buf 1#)-      _  ->-        let buf' =-              case c1 `leChar#` '\xDF'# of-                1# -> plusAddr# buf 2#-                _  -> case c1 `leChar#` '\xEF'# of-                    1# -> plusAddr# buf 3#-                    _ ->  plusAddr# buf 4#-        in case leAddr# buf' eob of-             1# -> OK# () buf'-             _  -> Fail#-{-# inline anyChar_ #-}----- | Parse any `Char` in the ASCII range, fail if the next input character is not in the range.---   This is more efficient than `anyChar` if we are only working with ASCII.-anyCharASCII :: Parser e Char-anyCharASCII = Parser \fp eob buf -> case eqAddr# eob buf of-  1# -> Fail#-  _  -> case derefChar8# buf of-    c1 -> case c1 `leChar#` '\x7F'# of-      1# -> OK# (C# c1) (plusAddr# buf 1#)-      _  -> Fail#-{-# inline anyCharASCII #-}---- | Skip any `Char` in the ASCII range. More efficient than `anyChar_` if we're working only with---   ASCII.-anyCharASCII_ :: Parser e ()-anyCharASCII_ = () <$ anyCharASCII-{-# inline anyCharASCII_ #-}---- | Read a non-negative `Int` from the input, as a non-empty digit sequence.--- The `Int` may overflow in the result.-readInt :: Parser e Int-readInt = Parser \fp eob s -> case FlatParse.Internal.readInt eob s of-  (# (##) | #)        -> Fail#-  (# | (# n, s' #) #) -> OK# (I# n) s'-{-# inline readInt #-}---- | Read a non-negative `Integer` from the input, as a non-empty digit--- sequence.-readInteger :: Parser e Integer-readInteger = Parser \fp eob s -> case FlatParse.Internal.readInteger fp eob s of-  (# (##) | #)        -> Fail#-  (# | (# i, s' #) #) -> OK# i s'-{-# inline readInteger #-}-------------------------------------------------------------------------------------- | Choose between two parsers. If the first parser fails, try the second one, but if the first one---   throws an error, propagate the error.-infixr 6 <|>-(<|>) :: Parser e a -> Parser e a -> Parser e a-(<|>) (Parser f) (Parser g) = Parser \fp eob s ->-  case f fp eob s of-    Fail# -> g fp eob s-    x     -> x-{-# inline (<|>) #-}---- | Branch on a parser: if the first argument succeeds, continue with the second, else with the third.---   This can produce slightly more efficient code than `(<|>)`. Moreover, `ḃranch` does not---   backtrack from the true/false cases.-branch :: Parser e a -> Parser e b -> Parser e b -> Parser e b-branch pa pt pf = Parser \fp eob s -> case runParser# pa fp eob s of-  OK# _ s -> runParser# pt fp eob s-  Fail#   -> runParser# pf fp eob s-  Err# e  -> Err# e-{-# inline branch #-}---- | An analogue of the list `foldl` function: first parse a @b@, then parse zero or more @a@-s,---   and combine the results in a left-nested way by the @b -> a -> b@ function. Note: this is not---   the usual `chainl` function from the parsec libraries!-chainl :: (b -> a -> b) -> Parser e b -> Parser e a -> Parser e b-chainl f start elem = start >>= go where-  go b = do {!a <- elem; go $! f b a} <|> pure b-{-# inline chainl #-}---- | An analogue of the list `foldr` function: parse zero or more @a@-s, terminated by a @b@, and---   combine the results in a right-nested way using the @a -> b -> b@ function. Note: this is not---   the usual `chainr` function from the parsec libraries!-chainr :: (a -> b -> b) -> Parser e a -> Parser e b -> Parser e b-chainr f (Parser elem) (Parser end) = Parser go where-  go fp eob s = case elem fp eob s of-    OK# a s -> case go fp eob s of-      OK# b s -> let !b' = f a b in OK# b' s-      x       -> x-    Fail# -> end fp eob s-    Err# e -> Err# e-{-# inline chainr #-}---- | Run a parser zero or more times, collect the results in a list. Note: for optimal performance,---   try to avoid this. Often it is possible to get rid of the intermediate list by using a---   combinator or a custom parser.-many :: Parser e a -> Parser e [a]-many (Parser f) = Parser go where-  go fp eob s = case f fp eob s of-    OK# a s -> case go fp eob s of-                 OK# as s -> OK# (a:as) s-                 x        -> x-    Fail#  -> OK# [] s-    Err# e -> Err# e-{-# inline many #-}---- | Skip a parser zero or more times.-many_ :: Parser e a -> Parser e ()-many_ (Parser f) = Parser go where-  go fp eob s = case f fp eob s of-    OK# a s -> go fp eob s-    Fail#   -> OK# () s-    Err# e  -> Err# e-{-# inline many_ #-}---- | Run a parser one or more times, collect the results in a list. Note: for optimal performance,---   try to avoid this. Often it is possible to get rid of the intermediate list by using a---   combinator or a custom parser.-some :: Parser e a -> Parser e [a]-some p = (:) <$> p <*> many p-{-# inline some #-}---- | Skip a parser one or more times.-some_ :: Parser e a -> Parser e ()-some_ pa = pa >> many_ pa-{-# inline some_ #-}---- | Succeed if the first parser succeeds and the second one fails.-notFollowedBy :: Parser e a -> Parser e b -> Parser e a-notFollowedBy p1 p2 = p1 <* fails p2-{-# inline notFollowedBy #-}---- | @isolate n p@ runs the parser @p@ isolated to the next @n@ bytes. All---   isolated bytes must be consumed.------ Throws a runtime error if given a negative integer.-isolate :: Int -> Parser e a -> Parser e a-isolate (I# n#) p = Parser \fp eob s ->-  let s' = plusAddr# s n#-  in  case n# <=# minusAddr# eob s of-        1# -> case n# >=# 0# of-          1# -> case runParser# p fp s' s of-            OK# a s'' -> case eqAddr# s' s'' of-              1# -> OK# a s''-              _  -> Fail# -- isolated segment wasn't fully consumed-            Fail#     -> Fail#-            Err# e    -> Err# e-          _  -> error "FlatParse.Basic.isolate: negative integer"-        _  -> Fail# -- you tried to isolate more than we have left-{-# inline isolate #-}--------------------------------------------------------------------------------------- | Get the current position in the input.-getPos :: Parser e Pos-getPos = Parser \fp eob s -> OK# (addrToPos# eob s) s-{-# inline getPos #-}---- | Set the input position. Warning: this can result in crashes if the position points outside the---   current buffer. It is always safe to `setPos` values which came from `getPos` with the current---   input.-setPos :: Pos -> Parser e ()-setPos s = Parser \fp eob _ -> OK# () (posToAddr# eob s)-{-# inline setPos #-}---- | The end of the input.-endPos :: Pos-endPos = Pos 0-{-# inline endPos #-}---- | Return the consumed span of a parser.-spanOf :: Parser e a -> Parser e Span-spanOf (Parser f) = Parser \fp eob s -> case f fp eob s of-  OK# a s' -> OK# (Span (addrToPos# eob s) (addrToPos# eob s')) s'-  x        -> unsafeCoerce# x-{-# inline spanOf #-}---- | Bind the result together with the span of the result. CPS'd version of `spanOf`---   for better unboxing.-withSpan :: Parser e a -> (a -> Span -> Parser e b) -> Parser e b-withSpan (Parser f) g = Parser \fp eob s -> case f fp eob s of-  OK# a s' -> runParser# (g a (Span (addrToPos# eob s) (addrToPos# eob s'))) fp eob s'-  x        -> unsafeCoerce# x-{-# inline withSpan #-}---- | Return the `B.ByteString` consumed by a parser. Note: it's more efficient to use `spanOf` and---   `withSpan` instead.-byteStringOf :: Parser e a -> Parser e B.ByteString-byteStringOf (Parser f) = Parser \fp eob s -> case f fp eob s of-  OK# a s' -> OK# (B.PS (ForeignPtr s fp) 0 (I# (minusAddr# s' s))) s'-  x        -> unsafeCoerce# x-{-# inline byteStringOf #-}---- | CPS'd version of `byteStringOf`. Can be more efficient, because the result is more eagerly unboxed---   by GHC. It's more efficient to use `spanOf` or `withSpan` instead.-withByteString :: Parser e a -> (a -> B.ByteString -> Parser e b) -> Parser e b-withByteString (Parser f) g = Parser \fp eob s -> case f fp eob s of-  OK# a s' -> runParser# (g a (B.PS (ForeignPtr s fp) 0 (I# (minusAddr# s' s)))) fp eob s'-  x        -> unsafeCoerce# x-{-# inline withByteString #-}---- | Run a parser in a given input span. The input position and the `Int` state is restored after---   the parser is finished, so `inSpan` does not consume input and has no side effect.  Warning:---   this operation may crash if the given span points outside the current parsing buffer. It's---   always safe to use `inSpan` if the span comes from a previous `withSpan` or `spanOf` call on---   the current input.-inSpan :: Span -> Parser e a -> Parser e a-inSpan (Span s eob) (Parser f) = Parser \fp eob' s' ->-  case f fp (posToAddr# eob' eob) (posToAddr# eob' s) of-    OK# a _ -> OK# a s'-    x       -> unsafeCoerce# x-{-# inline inSpan #-}-------------------------------------------------------------------------------------- | Check whether a `Pos` points into a `B.ByteString`.-validPos :: B.ByteString -> Pos -> Bool-validPos str pos =-  let go = do-        start <- getPos-        pure (start <= pos && pos <= endPos)-  in case runParser go str of-    OK b _ -> b-    _      -> error "impossible"-{-# inline validPos #-}---- | Compute corresponding line and column numbers for each `Pos` in a list. Throw an error---   on invalid positions. Note: computing lines and columns may traverse the `B.ByteString`,---   but it traverses it only once regardless of the length of the position list.-posLineCols :: B.ByteString -> [Pos] -> [(Int, Int)]-posLineCols str poss =-  let go !line !col [] = pure []-      go line col ((i, pos):poss) = do-        p <- getPos-        if pos == p then-          ((i, (line, col)):) <$> go line col poss-        else do-          c <- anyChar-          if '\n' == c then-            go (line + 1) 0 ((i, pos):poss)-          else-            go line (col + 1) ((i, pos):poss)--      sorted :: [(Int, Pos)]-      sorted = sortBy (comparing snd) (zip [0..] poss)--  in case runParser (go 0 0 sorted) str of-       OK res _ -> snd <$> sortBy (comparing fst) res-       _        -> error "invalid position"---- | Create a `B.ByteString` from a `Span`. The result is invalid if the `Span` points---   outside the current buffer, or if the `Span` start is greater than the end position.-unsafeSpanToByteString :: Span -> Parser e B.ByteString-unsafeSpanToByteString (Span l r) =-  lookahead (setPos l >> byteStringOf (setPos r))-{-# inline unsafeSpanToByteString #-}---- | Create a `Pos` from a line and column number. Throws an error on out-of-bounds---   line and column numbers.-mkPos :: B.ByteString -> (Int, Int) -> Pos-mkPos str (line', col') =-  let go line col | line == line' && col == col' = getPos-      go line col = (do-        c <- anyChar-        if c == '\n' then go (line + 1) 0-                     else go line (col + 1)) <|> error "mkPos: invalid position"-  in case runParser (go 0 0) str of-    OK res _ -> res-    _        -> error "impossible"---- | Break an UTF-8-coded `B.ByteString` to lines. Throws an error on invalid input.---   This is mostly useful for grabbing specific source lines for displaying error---   messages.-lines :: B.ByteString -> [String]-lines str =-  let go = ([] <$ eof) <|> ((:) <$> takeLine <*> go)-  in case runParser go str of-    OK ls _ -> ls-    _       -> error "linesUTF8: invalid input"-------------------------------------------------------------------------------------- | Parse the rest of the current line as a `String`. Assumes UTF-8 encoding,---   throws an error if the encoding is invalid.-takeLine :: Parser e String-takeLine = branch eof (pure "") do-  c <- anyChar-  case c of-    '\n' -> pure ""-    _    -> (c:) <$> takeLine---- | Parse the rest of the current line as a `String`, but restore the parsing state.---   Assumes UTF-8 encoding. This can be used for debugging.-traceLine :: Parser e String-traceLine = lookahead takeLine---- | Take the rest of the input as a `String`. Assumes UTF-8 encoding.-takeRest :: Parser e String-takeRest = branch eof (pure "") do-  c <- anyChar-  cs <- takeRest-  pure (c:cs)---- | Get the rest of the input as a `String`, but restore the parsing state. Assumes UTF-8 encoding.---   This can be used for debugging.-traceRest :: Parser e String-traceRest = lookahead takeRest-------------------------------------------------------------------------------------- | Convert an UTF-8-coded `B.ByteString` to a `String`.-unpackUTF8 :: B.ByteString -> String-unpackUTF8 str = case runParser takeRest str of-  OK a _ -> a-  _      -> error "unpackUTF8: invalid encoding"---- | Check that the input has at least the given number of bytes.-ensureBytes# :: Int -> Parser e ()-ensureBytes# (I# len) = Parser \fp eob s ->-  case len  <=# minusAddr# eob s of-    1# -> OK# () s-    _  -> Fail#-{-# inline ensureBytes# #-}---- | Unsafely read a concrete byte from the input. It's not checked that the input has---   enough bytes.-scan8# :: Word8 -> Parser e ()-scan8# (W8# c) = Parser \fp eob s ->-  case indexWord8OffAddr# s 0# of-    c' -> case eqWord8'# c c' of-      1# -> OK# () (plusAddr# s 1#)-      _  -> Fail#-{-# inline scan8# #-}---- | Unsafely read two concrete bytes from the input. It's not checked that the input has---   enough bytes.-scan16# :: Word16 -> Parser e ()-scan16# (W16# c) = Parser \fp eob s ->-  case indexWord16OffAddr# s 0# of-    c' -> case eqWord16'# c c' of-      1# -> OK# () (plusAddr# s 2#)-      _  -> Fail#-{-# inline scan16# #-}---- | Unsafely read four concrete bytes from the input. It's not checked that the input has---   enough bytes.-scan32# :: Word32 -> Parser e ()-scan32# (W32# c) = Parser \fp eob s ->-  case indexWord32OffAddr# s 0# of-    c' -> case eqWord32'# c c' of-      1# -> OK# () (plusAddr# s 4#)-      _  -> Fail#-{-# inline scan32# #-}---- | Unsafely read eight concrete bytes from the input. It's not checked that the input has---   enough bytes.-scan64# :: Word -> Parser e ()-scan64# (W# c) = Parser \fp eob s ->-  case indexWord64OffAddr# s 0# of-    c' -> case eqWord# c c' of-      1# -> OK# () (plusAddr# s 8#)-      _  -> Fail#-{-# inline scan64# #-}---- | Unsafely read and return a byte from the input. It's not checked that the input is non-empty.-scanAny8# :: Parser e Word8-scanAny8# = Parser \fp eob s -> OK# (W8# (indexWord8OffAddr# s 0#)) (plusAddr# s 1#)-{-# inline scanAny8# #-}--scanPartial64# :: Int -> Word -> Parser e ()-scanPartial64# (I# len) (W# w) = Parser \fp eob s ->-  case indexWordOffAddr# s 0# of-    w' -> case uncheckedIShiftL# (8# -# len) 3# of-      sh -> case uncheckedShiftL# w' sh of-        w' -> case uncheckedShiftRL# w' sh of-          w' -> case eqWord# w w' of-            1# -> OK# () (plusAddr# s len)-            _  -> Fail#-{-# inline scanPartial64# #-}---- | Decrease the current input position by the given number of bytes.-setBack# :: Int -> Parser e ()-setBack# (I# i) = Parser \fp eob s ->-  OK# () (plusAddr# s (negateInt# i))-{-# inline setBack# #-}---- | Template function, creates a @Parser e ()@ which unsafely scans a given---   sequence of bytes.-scanBytes# :: [Word] -> Q Exp-scanBytes# bytes = do-  let !(leading, w8s) = splitBytes bytes-      !scanw8s        = go w8s where-                         go (w8:[] ) = [| scan64# w8 |]-                         go (w8:w8s) = [| scan64# w8 >> $(go w8s) |]-                         go []       = [| pure () |]-  case w8s of-    [] -> go leading-          where-            go (a:b:c:d:[]) = let !w = packBytes [a, b, c, d] in [| scan32# w |]-            go (a:b:c:d:ws) = let !w = packBytes [a, b, c, d] in [| scan32# w >> $(go ws) |]-            go (a:b:[])     = let !w = packBytes [a, b]       in [| scan16# w |]-            go (a:b:ws)     = let !w = packBytes [a, b]       in [| scan16# w >> $(go ws) |]-            go (a:[])       = [| scan8# a |]-            go []           = [| pure () |]-    _  -> case leading of--      []              -> scanw8s-      [a]             -> [| scan8# a >> $scanw8s |]-      ws@[a, b]       -> let !w = packBytes ws in [| scan16# w >> $scanw8s |]-      ws@[a, b, c, d] -> let !w = packBytes ws in [| scan32# w >> $scanw8s |]-      ws              -> let !w = packBytes ws-                             !l = length ws-                         in [| scanPartial64# l w >> $scanw8s |]----- Switching code generation-----------------------------------------------------------------------------------#if MIN_VERSION_base(4,15,0)-mkDoE = DoE Nothing-{-# inline mkDoE #-}-#else-mkDoE = DoE-{-# inline mkDoE #-}-#endif--genTrie :: (Map (Maybe Int) Exp, Trie' (Rule, Int, Maybe Int)) -> Q Exp-genTrie (rules, t) = do-  branches <- traverse (\e -> (,) <$> (newName "rule") <*> pure e) rules--  let ix m k = case M.lookup k m of-        Nothing -> error ("key not in map: " ++ show k)-        Just a  -> a--  let ensure :: Maybe Int -> Maybe (Q Exp)-      ensure = fmap (\n -> [| ensureBytes# n |])--      fallback :: Rule -> Int ->  Q Exp-      fallback rule 0 = pure $ VarE $ fst $ ix branches rule-      fallback rule n = [| setBack# n >> $(pure $ VarE $ fst $ ix branches rule) |]--  let go :: Trie' (Rule, Int, Maybe Int) -> Q Exp-      go = \case-        Branch' (r, n, alloc) ts-          | M.null ts -> pure $ VarE $ fst $ branches M.! r-          | otherwise -> do-              !next         <- (traverse . traverse) go (M.toList ts)-              !defaultCase  <- fallback r (n + 1)--              let cases = mkDoE $-                    [BindS (VarP (mkName "c")) (VarE 'scanAny8#),-                      NoBindS (CaseE (VarE (mkName "c"))-                         (map (\(w, t) ->-                                 Match (LitP (IntegerL (fromIntegral w)))-                                       (NormalB t)-                                       [])-                              next-                          ++ [Match WildP (NormalB defaultCase) []]))]--              case ensure alloc of-                Nothing    -> pure cases-                Just alloc -> [| branch $alloc $(pure cases) $(fallback r n) |]--        Path (r, n, alloc) ws t ->-          case ensure alloc of-            Nothing    -> [| branch $(scanBytes# ws) $(go t) $(fallback r n)|]-            Just alloc -> [| branch ($alloc >> $(scanBytes# ws)) $(go t) $(fallback r n) |]--  letE-    (map (\(x, rhs) -> valD (varP x) (normalB (pure rhs)) []) (Data.Foldable.toList branches))-    (go t)--parseSwitch :: Q Exp -> Q ([(String, Exp)], Maybe Exp)-parseSwitch exp = exp >>= \case-  CaseE (UnboundVarE _) []    -> error "switch: empty clause list"-  CaseE (UnboundVarE _) cases -> do-    (!cases, !last) <- pure (init cases, last cases)-    !cases <- forM cases \case-      Match (LitP (StringL str)) (NormalB rhs) [] -> pure (str, rhs)-      _ -> error "switch: expected a match clause on a string literal"-    (!cases, !last) <- case last of-      Match (LitP (StringL str)) (NormalB rhs) [] -> pure (cases ++ [(str, rhs)], Nothing)-      Match WildP                (NormalB rhs) [] -> pure (cases, Just rhs)-      _ -> error "switch: expected a match clause on a string literal or a wildcard"-    pure (cases, last)-  _ -> error "switch: expected a \"case _ of\" expression"--genSwitchTrie' :: Maybe Exp -> [(String, Exp)] -> Maybe Exp-              -> (Map (Maybe Int) Exp, Trie' (Rule, Int, Maybe Int))-genSwitchTrie' postAction cases fallback =--  let (!branches, !strings) = unzip do-        (!i, (!str, !rhs)) <- zip [0..] cases-        case postAction of-          Nothing    -> pure ((Just i, rhs), (i, str))-          Just !post -> pure ((Just i, (VarE '(>>)) `AppE` post `AppE` rhs), (i, str))--      !m    = M.fromList ((Nothing, maybe (VarE 'empty) id fallback) : branches)-      !trie = compileTrie strings-  in (m , trie)------------------------------------------------------------------------------------withAnyWord8# :: (Word8'# -> Parser e a) -> Parser e a-withAnyWord8# p = Parser \fp eob buf -> case eqAddr# eob buf of-  1# -> Fail#-  _  -> case indexWord8OffAddr# buf 0# of-    w# -> runParser# (p w#) fp eob (plusAddr# buf 1#)-{-# inline withAnyWord8# #-}--withAnyWord16# :: (Word16'# -> Parser e a) -> Parser e a-withAnyWord16# p = Parser \fp eob buf -> case 2# <=# minusAddr# eob buf of-  0# -> Fail#-  _  -> case indexWord16OffAddr# buf 0# of-    w# -> runParser# (p w#) fp eob (plusAddr# buf 2#)-{-# inline withAnyWord16# #-}--withAnyWord32# :: (Word32'# -> Parser e a) -> Parser e a-withAnyWord32# p = Parser \fp eob buf -> case 4# <=# minusAddr# eob buf of-  0# -> Fail#-  _  -> case indexWord32OffAddr# buf 0# of-    w# -> runParser# (p w#) fp eob (plusAddr# buf 4#)-{-# inline withAnyWord32# #-}--withAnyWord64# :: (Word# -> Parser e a) -> Parser e a-withAnyWord64# p = Parser \fp eob buf -> case 8# <=# minusAddr# eob buf of-  0# -> Fail#-  _  -> case indexWordOffAddr# buf 0# of-    w# -> runParser# (p w#) fp eob (plusAddr# buf 8#)-{-# inline withAnyWord64# #-}--withAnyInt8# :: (Int8'# -> Parser e a) -> Parser e a-withAnyInt8# p = Parser \fp eob buf -> case eqAddr# eob buf of-  1# -> Fail#-  _  -> case indexInt8OffAddr# buf 0# of-    i# -> runParser# (p i#) fp eob (plusAddr# buf 1#)-{-# inline withAnyInt8# #-}--withAnyInt16# :: (Int16'# -> Parser e a) -> Parser e a-withAnyInt16# p = Parser \fp eob buf -> case 2# <=# minusAddr# eob buf of-  0# -> Fail#-  _  -> case indexInt16OffAddr# buf 0# of-    i# -> runParser# (p i#) fp eob (plusAddr# buf 2#)-{-# inline withAnyInt16# #-}--withAnyInt32# :: (Int32'# -> Parser e a) -> Parser e a-withAnyInt32# p = Parser \fp eob buf -> case 4# <=# minusAddr# eob buf of-  0# -> Fail#-  _  -> case indexInt32OffAddr# buf 0# of-    i# -> runParser# (p i#) fp eob (plusAddr# buf 4#)-{-# inline withAnyInt32# #-}--withAnyInt64# :: (Int# -> Parser e a) -> Parser e a-withAnyInt64# p = Parser \fp eob buf -> case 8# <=# minusAddr# eob buf of-  0# -> Fail#-  _  -> case indexInt64OffAddr# buf 0# of-    i# -> runParser# (p i#) fp eob (plusAddr# buf 8#)-{-# inline withAnyInt64# #-}-------------------------------------------------------------------------------------- | Parse any 'Word8' (byte).-anyWord8 :: Parser e Word8-anyWord8 = withAnyWord8# (\w# -> pure (W8# w#))-{-# inline anyWord8 #-}---- | Skip any 'Word8' (byte).-anyWord8_ :: Parser e ()-anyWord8_ = () <$ anyWord8-{-# inline anyWord8_ #-}---- | Parse any 'Word16'.-anyWord16 :: Parser e Word16-anyWord16 = withAnyWord16# (\w# -> pure (W16# w#))-{-# inline anyWord16 #-}---- | Skip any 'Word16'.-anyWord16_ :: Parser e ()-anyWord16_ = () <$ anyWord16-{-# inline anyWord16_ #-}---- | Parse any 'Word32'.-anyWord32 :: Parser e Word32-anyWord32 = withAnyWord32# (\w# -> pure (W32# w#))-{-# inline anyWord32 #-}---- | Skip any 'Word32'.-anyWord32_ :: Parser e ()-anyWord32_ = () <$ anyWord32-{-# inline anyWord32_ #-}---- | Parse any 'Word64'.-anyWord64 :: Parser e Word64-anyWord64 = withAnyWord64# (\w# -> pure (W64# w#))-{-# inline anyWord64 #-}---- | Skip any 'Word64'.-anyWord64_ :: Parser e ()-anyWord64_ = () <$ anyWord64-{-# inline anyWord64_ #-}---- | Parse any 'Word'.-anyWord :: Parser e Word-anyWord = withAnyWord64# (\w# -> pure (W# w#))-{-# inline anyWord #-}---- | Skip any 'Word'.-anyWord_ :: Parser e ()-anyWord_ = () <$ anyWord-{-# inline anyWord_ #-}-------------------------------------------------------------------------------------- | Parse any 'Int8'.-anyInt8 :: Parser e Int8-anyInt8 = withAnyInt8# (\i# -> pure (I8# i#))-{-# inline anyInt8 #-}---- | Parse any 'Int16'.-anyInt16 :: Parser e Int16-anyInt16 = withAnyInt16# (\i# -> pure (I16# i#))-{-# inline anyInt16 #-}---- | Parse any 'Int32'.-anyInt32 :: Parser e Int32-anyInt32 = withAnyInt32# (\i# -> pure (I32# i#))-{-# inline anyInt32 #-}---- | Parse any 'Int64'.-anyInt64 :: Parser e Int64-anyInt64 = withAnyInt64# (\i# -> pure (I64# i#))-{-# inline anyInt64 #-}---- | Parse any 'Int'.-anyInt :: Parser e Int-anyInt = withAnyInt64# (\i# -> pure (I# i#))-{-# inline anyInt #-}-------------------------------------------------------------------------------------- | Parse any 'Word16' (little-endian).-anyWord16le :: Parser e Word16-anyWord16le = anyWord16-{-# inline anyWord16le #-}---- | Parse any 'Word16' (big-endian).-anyWord16be :: Parser e Word16-anyWord16be = withAnyWord16# (\w# -> pure (W16# (byteSwap16'# w#)))-{-# inline anyWord16be #-}---- | Parse any 'Word32' (little-endian).-anyWord32le :: Parser e Word32-anyWord32le = anyWord32-{-# inline anyWord32le #-}---- | Parse any 'Word32' (big-endian).-anyWord32be :: Parser e Word32-anyWord32be = withAnyWord32# (\w# -> pure (W32# (byteSwap32'# w#)))-{-# inline anyWord32be #-}---- | Parse any 'Word64' (little-endian).-anyWord64le :: Parser e Word64-anyWord64le = anyWord64-{-# inline anyWord64le #-}---- | Parse any 'Word64' (big-endian).-anyWord64be :: Parser e Word64-anyWord64be = withAnyWord64# (\w# -> pure (W64# (byteSwap# w#)))-{-# inline anyWord64be #-}-------------------------------------------------------------------------------------- | Parse any 'Int16' (little-endian).-anyInt16le :: Parser e Int16-anyInt16le = anyInt16-{-# inline anyInt16le #-}---- | Parse any 'Int16' (big-endian).-anyInt16be :: Parser e Int16-anyInt16be = withAnyWord16# (\w# -> pure (I16# (word16ToInt16# (byteSwap16'# w#))))-{-# inline anyInt16be #-}---- | Parse any 'Int32' (little-endian).-anyInt32le :: Parser e Int32-anyInt32le = anyInt32-{-# inline anyInt32le #-}---- | Parse any 'Int32' (big-endian).-anyInt32be :: Parser e Int32-anyInt32be = withAnyWord32# (\w# -> pure (I32# (word32ToInt32# (byteSwap32'# w#))))-{-# inline anyInt32be #-}---- | Parse any 'Int64' (little-endian).-anyInt64le :: Parser e Int64-anyInt64le = anyInt64-{-# inline anyInt64le #-}---- | Parse any 'Int64' (big-endian).-anyInt64be :: Parser e Int64-anyInt64be = withAnyWord64# (\w# -> pure (I64# (word2Int# (byteSwap# w#))))-{-# inline anyInt64be #-}-------------------------------------------------------------------------------------- | Skip forward @n@ bytes and run the given parser. Fails if fewer than @n@---   bytes are available.------ Throws a runtime error if given a negative integer.-atSkip# :: Int# -> Parser e a -> Parser e a-atSkip# os# (Parser p) = Parser \fp eob s -> case os# <=# minusAddr# eob s of-  1# -> case os# >=# 0# of-    1# -> p fp eob (plusAddr# s os#)-    _  -> error "FlatParse.Basic.atSkip#: negative integer"-  _  -> Fail#-{-# inline atSkip# #-}---- | Read the given number of bytes as a 'ByteString'.------ Throws a runtime error if given a negative integer.-takeBs# :: Int# -> Parser e B.ByteString-takeBs# n# = Parser \fp eob s -> case n# <=# minusAddr# eob s of-  1# -> -- have to runtime check for negative values, because they cause a hang-    case n# >=# 0# of-      1# -> OK# (B.PS (ForeignPtr s fp) 0 (I# n#)) (plusAddr# s n#)-      _  -> error "FlatParse.Basic.takeBs: negative integer"-  _  -> Fail#-{-# inline takeBs# #-}-------------------------------------------------------------------------------------- | Run a parser, passing it the current address the parser is at.------ Useful for parsing offset-based data tables. For example, you may use this to--- save the base address to use together with various 0-indexed offsets.-withAddr# :: (Addr# -> Parser e a) -> Parser e a-withAddr# p = Parser \fp eob s -> runParser# (p s) fp eob s-{-# inline withAddr# #-}---- | @takeBsOffAddr# addr# offset# len#@ moves to @addr#@, skips @offset#@---   bytes, reads @len#@ bytes into a 'ByteString', and restores the original---   address.------ The 'Addr#' should be from 'withAddr#'.------ Useful for parsing offset-based data tables. For example, you may use this--- together with 'withAddr#' to jump to an offset in your input and read some--- data.-takeBsOffAddr# :: Addr# -> Int# -> Int# -> Parser e B.ByteString-takeBsOffAddr# addr# offset# len# =-    lookaheadFromAddr# addr# $ atSkip# offset# $ takeBs# len#-{-# inline takeBsOffAddr# #-}---- | 'lookahead', but specify the address to lookahead from.------ The 'Addr#' should be from 'withAddr#'.-lookaheadFromAddr# :: Addr# -> Parser e a -> Parser e a-lookaheadFromAddr# s = lookahead . atAddr# s-{-# inline lookaheadFromAddr# #-}---- | Run a parser at the given address.------ The 'Addr#' should be from 'withAddr#'.------ This is a highly internal function -- you likely want 'lookaheadFromAddr#',--- which will reset the address after running the parser.-atAddr# :: Addr# -> Parser e a -> Parser e a-atAddr# s (Parser p) = Parser \fp eob _ -> p fp eob s-{-# inline atAddr# #-}-------------------------------------------------------------------------------------- | Read a null-terminated bytestring (a C-style string).------ Consumes the null terminator.-anyCString :: Parser e B.ByteString-anyCString = Parser \fp eob s -> go' fp eob s-  where-    go' fp eob s0 = go 0# s0-      where-        go n# s = case eqAddr# eob s of-          1# -> Fail#-          _  ->-            let s' = plusAddr# s 1#-            -- TODO below is a candidate for improving with ExtendedLiterals!-            in  case eqWord8# (indexWord8OffAddr''# s 0#) (wordToWord8''# 0##) of-                  1# -> OK# (B.PS (ForeignPtr s0 fp) 0 (I# n#)) s'-                  _  -> go (n# +# 1#) s'-{-# inline anyCString #-}---- | Read a null-terminated bytestring (a C-style string), where the bytestring---   is known to be null-terminated somewhere in the input.------ Highly unsafe. Unless you have a guarantee that the string will be null--- terminated before the input ends, use 'anyCString' instead. Honestly, I'm not--- sure if this is a good function to define. But here it is.------ Fails on GHC versions older than 9.0, since we make use of the--- 'cstringLength#' primop introduced in GHC 9.0, and we aren't very useful--- without it.------ Consumes the null terminator.-anyCStringUnsafe :: Parser e B.ByteString-{-# inline anyCStringUnsafe #-}-#if MIN_VERSION_base(4,15,0)-anyCStringUnsafe = Parser \fp eob s ->-  case eqAddr# eob s of-    1# -> Fail#-    _  -> let n#  = cstringLength# s-              s'# = plusAddr# s (n# +# 1#)-           in OK# (B.PS (ForeignPtr s fp) 0 (I# n#)) s'#-#else-anyCStringUnsafe = error "Flatparse.Basic.anyCStringUnsafe: requires GHC 9.0 / base-4.15, not available on this compiler"-#endif+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleInstances #-}++{-|+Parser supporting custom error types and embeddable `IO` or `ST` actions, but+no other bells and whistles.++If you need efficient indentation parsing, consider "FlatParse.Stateful" instead.+-}++module FlatParse.Basic (+  -- * Parser types+    FP.Parser.ParserT(..)+  , FP.Parser.Parser, FP.Parser.ParserIO, FP.Parser.ParserST++  -- * Running parsers+  , Result(..)+  , runParser+  , runParserUtf8+  , runParserIO+  , runParserST++  -- ** Primitive result types+  , type FP.Parser.Res#+  , pattern FP.Parser.OK#, pattern FP.Parser.Err#, pattern FP.Parser.Fail#+  , type FP.Parser.ResI#++  -- * Embedding `ST` operations+  , liftST++  -- * UTF conversion+  , Common.strToUtf8+  , Common.utf8ToStr++  -- * Parsers+  -- ** Bytewise+  , FP.Base.eof+  , FP.Base.take+  , FP.Base.take#+  , FP.Base.takeUnsafe#+  , FP.Base.takeRest+  , FP.Base.skip+  , FP.Base.skip#+  , FP.Base.skipBack+  , FP.Base.skipBack#+  , FP.Base.atSkip#+  , FP.Base.atSkipUnsafe#++  , FP.Bytes.bytes+  , FP.Bytes.bytesUnsafe+  , byteString+  , anyCString+  , anyVarintProtobuf++  -- ** Combinators+  , (FP.Parser.<|>)+  , FP.Base.branch+  , FP.Base.notFollowedBy+  , FP.Base.chainl+  , FP.Base.chainr+  , FP.Base.lookahead+  , FP.Base.ensure+  , FP.Base.ensure#+  , FP.Base.withEnsure+  , FP.Base.withEnsure1+  , FP.Base.withEnsure#+  , FP.Base.isolate+  , FP.Base.isolate#+  , FP.Base.isolateUnsafe#+  , FP.Switch.switch+  , FP.Switch.switchWithPost+  , FP.Switch.rawSwitchWithPost+  , Control.Applicative.many+  , FP.Base.skipMany+  , Control.Applicative.some+  , FP.Base.skipSome++  -- ** Errors and failures+  , Control.Applicative.empty+  , FP.Base.failed+  , FP.Base.try+  , FP.Base.err+  , FP.Base.fails+  , FP.Base.cut+  , FP.Base.cutting+  , FP.Base.optional+  , FP.Base.optional_+  , FP.Base.withOption++  -- ** Position+  , FlatParse.Common.Position.Pos(..)+  , FlatParse.Common.Position.endPos+  , FlatParse.Common.Position.addrToPos#+  , FlatParse.Common.Position.posToAddr#+  , FlatParse.Common.Position.Span(..)+  , FlatParse.Common.Position.unsafeSlice+  , getPos+  , setPos+  , spanOf+  , withSpan+  , byteStringOf+  , withByteString+  , inSpan+  , validPos+  , posLineCols+  , mkPos++  -- ** Text+  -- *** UTF-8+  , FP.Text.char, FP.Text.string+  , FP.Text.anyChar, FP.Text.skipAnyChar+  , FP.Text.satisfy, FP.Text.skipSatisfy+  , FP.Text.fusedSatisfy, FP.Text.skipFusedSatisfy+  , FP.Text.takeLine+  , FP.Text.takeRestString+  , linesUtf8++  -- *** ASCII+  , FP.Text.anyAsciiChar, FP.Text.skipAnyAsciiChar+  , FP.Text.satisfyAscii, FP.Text.skipSatisfyAscii++  -- *** ASCII-encoded numbers+  , FP.Text.anyAsciiDecimalWord+  , FP.Text.anyAsciiDecimalInt+  , FP.Text.anyAsciiDecimalInteger+  , FP.Text.anyAsciiHexWord+  , FP.Text.anyAsciiHexInt++  -- ** Machine integers+  , module FP.Integers++  -- ** Debugging parsers+  , FP.Text.traceLine+  , FP.Text.traceRest++  -- * Unsafe+  , unsafeSpanToByteString++  -- ** IO+  , unsafeLiftIO++  -- ** Parsers+  , module FP.Addr+  , anyCStringUnsafe++  ) where++import FlatParse.Basic.Parser+import FlatParse.Basic.Base+import FlatParse.Basic.Integers+--import FlatParse.Basic.Bytes+import FlatParse.Basic.Text+--import FlatParse.Basic.Switch+import FlatParse.Basic.Addr+import FlatParse.Common.Position+import qualified FlatParse.Common.Assorted as Common+import qualified FlatParse.Common.Numbers  as Common++-- common prefix for using/exporting parsers with their submodule+import qualified FlatParse.Basic.Parser as FP.Parser+import qualified FlatParse.Basic.Base as FP.Base+import qualified FlatParse.Basic.Integers as FP.Integers+import qualified FlatParse.Basic.Bytes as FP.Bytes+import qualified FlatParse.Basic.Text as FP.Text+import qualified FlatParse.Basic.Switch as FP.Switch+import qualified FlatParse.Basic.Addr as FP.Addr++import qualified Control.Applicative+import GHC.IO (IO(..))+import GHC.Exts+import GHC.ForeignPtr+import GHC.ST (ST(..))+import System.IO.Unsafe+import Data.Ord ( comparing )+import Data.List ( sortBy )++import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import qualified Data.ByteString.Internal as B++-- | Higher-level boxed data type for parsing results.+data Result e a =+    OK a !(B.ByteString)  -- ^ Contains return value and unconsumed input.+  | Fail                  -- ^ Recoverable-by-default failure.+  | Err !e                -- ^ Unrecoverble-by-default error.+  deriving Show++instance Functor (Result e) where+  fmap f (OK a s) = let !b = f a in OK b s+  fmap f r        = unsafeCoerce# r+  {-# inline fmap #-}+  (<$) a (OK _ s) = OK a s+  (<$) _ r        = unsafeCoerce# r+  {-# inline (<$) #-}++-- | Embed an IO action in a 'ParserT'. This is slightly safer than 'unsafePerformIO' because+-- it will sequenced correctly with respect to the surrounding actions, and its execution is guaranteed.+unsafeLiftIO :: IO a -> ParserT st e a+unsafeLiftIO io = ParserT \fp eob s st ->+                   let !a = unsafePerformIO io+                   in OK# st a s+{-# inline unsafeLiftIO #-}++--------------------------------------------------------------------------------++-- | Run a parser.+runParser :: Parser e a -> B.ByteString -> Result e a+runParser (ParserT f) b@(B.PS (ForeignPtr _ fp) _ (I# len)) = unsafePerformIO $+  B.unsafeUseAsCString b \(Ptr buf) -> do+    let end = plusAddr# buf len+    pure case f fp end buf proxy# of+      OK# _st a s -> let offset = minusAddr# s buf+                     in OK a (B.drop (I# offset) b)++      Err# _st e -> Err e+      Fail# _st  -> Fail+{-# noinline runParser #-}+-- We mark this as noinline to allow power users to safely do unsafe state token coercions.+-- Details are discussed in https://github.com/AndrasKovacs/flatparse/pull/34#issuecomment-1326999390++-- | Run a parser on a 'String', converting it to the corresponding UTF-8 bytes.+--+-- Reminder: @OverloadedStrings@ for 'B.ByteString' does not yield a valid UTF-8+-- encoding! For non-ASCII 'B.ByteString' literal input, use this wrapper or+-- properly convert your input first.+runParserUtf8 :: Parser e a -> String -> Result e a+runParserUtf8 pa s = runParser pa (Common.strToUtf8 s)++-- | Run an ST based parser.+runParserST :: (forall s. ParserST s e a) -> B.ByteString -> Result e a+runParserST pst buf = unsafeDupablePerformIO (runParserIO pst buf)+{-# inlinable runParserST #-}++-- | Run an IO based parser.+runParserIO :: ParserIO e a -> B.ByteString -> IO (Result e a)+runParserIO (ParserT f) b@(B.PS (ForeignPtr _ fp) _ (I# len)) = do+  B.unsafeUseAsCString b \(Ptr buf) -> do+    let end = plusAddr# buf len+    IO \st -> case f fp end buf st of+      OK# rw' a s ->  let offset = minusAddr# s buf+                      in (# rw', OK a (B.drop (I# offset) b) #)++      Err# rw' e ->  (# rw', Err e #)+      Fail# rw'  ->  (# rw', Fail #)+{-# inlinable runParserIO #-}++-- | Run an `ST` action in a `ParserST`.+liftST :: ST s a -> ParserST s e a+liftST (ST f) = ParserT \fp eob s st -> case f st of+  (# st, a #) -> OK# st a s+{-# inline liftST #-}++--------------------------------------------------------------------------------++-- | Parse a given 'B.ByteString'.+--+-- If the bytestring is statically known, consider using 'bytes' instead.+byteString :: B.ByteString -> ParserT st e ()+byteString (B.PS (ForeignPtr bs fcontent) _ (I# len)) =++  let go64 :: Addr# -> Addr# -> Addr# -> State# RealWorld -> Res# (State# RealWorld) e ()+      go64 bs bsend s rw =+        let bs' = plusAddr# bs 8# in+        case gtAddr# bs' bsend of+          1# -> go8 bs bsend s rw+#if MIN_VERSION_base(4,17,0)+          _  -> case eqWord64# (indexWord64OffAddr# bs 0#) (indexWord64OffAddr# s 0#) of+#else+          _  -> case eqWord# (indexWord64OffAddr# bs 0#) (indexWord64OffAddr# s 0#) of+#endif+            1# -> go64 bs' bsend (plusAddr# s 8#) rw+            _  -> Fail# rw++      go8 :: Addr# -> Addr# -> Addr# -> State# RealWorld -> Res# (State# RealWorld) e ()+      go8 bs bsend s rw = case ltAddr# bs bsend of+#if MIN_VERSION_base(4,16,0)+        1# -> case eqWord8# (indexWord8OffAddr# bs 0#) (indexWord8OffAddr# s 0#) of+#else+        1# -> case eqWord# (indexWord8OffAddr# bs 0#) (indexWord8OffAddr# s 0#) of+#endif+          1# -> go8 (plusAddr# bs 1#) bsend (plusAddr# s 1#) rw+          _  -> Fail# rw+        _  -> OK# rw () s++      go :: Addr# -> Addr# -> Addr# -> State# RealWorld -> Res# (State# RealWorld) e ()+      go bs bsend s rw = case go64 bs bsend s rw of+        (# rw', res #) -> case touch# fcontent rw' of+          rw'' -> (# rw'', res #)++  in ParserT \fp eob s st ->+      case len <=# minusAddr# eob s of+           1# -> case runRW# (go bs (plusAddr# bs len) s) of+             (# rw, a #) -> (# st, a #)+           _  -> Fail# st+{-# inline byteString #-}++--------------------------------------------------------------------------------++-- | Get the current position in the input.+getPos :: ParserT st e Pos+getPos = ParserT \fp eob s st -> OK# st (addrToPos# eob s) s+{-# inline getPos #-}++-- | Set the input position.+--+-- Warning: this can result in crashes if the position points outside the+-- current buffer. It is always safe to 'setPos' values which came from 'getPos'+-- with the current input.+setPos :: Pos -> ParserT st e ()+setPos s = ParserT \fp eob _ st -> OK# st () (posToAddr# eob s)+{-# inline setPos #-}++-- | Return the consumed span of a parser.+spanOf :: ParserT st e a -> ParserT st e Span+spanOf (ParserT f) = ParserT \fp eob s st -> case f fp eob s st of+  OK# st' a s' -> OK# st' (Span (addrToPos# eob s) (addrToPos# eob s')) s'+  x            -> unsafeCoerce# x+{-# inline spanOf #-}++-- | Bind the result together with the span of the result. CPS'd version of `spanOf`+--   for better unboxing.+withSpan :: ParserT st e a -> (a -> Span -> ParserT st e b) -> ParserT st e b+withSpan (ParserT f) g = ParserT \fp eob s st -> case f fp eob s st of+  OK# st' a s' -> runParserT# (g a (Span (addrToPos# eob s) (addrToPos# eob s'))) fp eob s' st'+  x            -> unsafeCoerce# x+{-# inline withSpan #-}++-- | Return the `B.ByteString` consumed by a parser. Note: it's more efficient to use `spanOf` and+--   `withSpan` instead.+byteStringOf :: ParserT st e a -> ParserT st e B.ByteString+byteStringOf (ParserT f) = ParserT \fp eob s st -> case f fp eob s st of+  OK# st' a s' -> OK# st' (B.PS (ForeignPtr s fp) 0 (I# (minusAddr# s' s))) s'+  x        -> unsafeCoerce# x+{-# inline byteStringOf #-}++-- | CPS'd version of `byteStringOf`. Can be more efficient, because the result is more eagerly unboxed+--   by GHC. It's more efficient to use `spanOf` or `withSpan` instead.+withByteString :: ParserT st e a -> (a -> B.ByteString -> ParserT st e b) -> ParserT st e b+withByteString (ParserT f) g = ParserT \fp eob s st -> case f fp eob s st of+  OK# st' a s' -> runParserT# (g a (B.PS (ForeignPtr s fp) 0 (I# (minusAddr# s' s)))) fp eob s' st'+  x        -> unsafeCoerce# x+{-# inline withByteString #-}++-- | Run a parser in a given input 'Span'.+--+-- The input position is restored after the parser is finished, so 'inSpan' does+-- not consume input and has no side effect.+--+-- Warning: this operation may crash if the given span points outside the+-- current parsing buffer. It's always safe to use 'inSpan' if the 'Span' comes+-- from a previous 'withSpan' or 'spanOf' call on the current input.+inSpan :: Span -> ParserT st e a -> ParserT st e a+inSpan (Span s eob) (ParserT f) = ParserT \fp eob' s' st ->+  case f fp (posToAddr# eob' eob) (posToAddr# eob' s) st of+    OK# st' a _ -> OK# st' a s'+    x           -> unsafeCoerce# x+{-# inline inSpan #-}++--------------------------------------------------------------------------------++-- | Create a 'B.ByteString' from a 'Span'.+--+-- The result is invalid if the 'Span' points outside the current buffer, or if+-- the 'Span' start is greater than the end position.+unsafeSpanToByteString :: Span -> ParserT st e B.ByteString+unsafeSpanToByteString (Span l r) =+  lookahead (setPos l >> byteStringOf (setPos r))+{-# inline unsafeSpanToByteString #-}++-- | Check whether a `Pos` points into a `B.ByteString`.+validPos :: B.ByteString -> Pos -> Bool+validPos str pos =+  let go = do+        start <- getPos+        pure (start <= pos && pos <= endPos)+  in  case runParser go str of+        OK b _ -> b+        _      -> error "FlatParse.Basic.validPos: got a non-OK result, impossible"+{-# inline validPos #-}++-- | Compute corresponding line and column numbers for each `Pos` in a list. Throw an error+--   on invalid positions. Note: computing lines and columns may traverse the `B.ByteString`,+--   but it traverses it only once regardless of the length of the position list.+posLineCols :: B.ByteString -> [Pos] -> [(Int, Int)]+posLineCols str poss =+  let go !line !col [] = pure []+      go line col ((i, pos):poss) = do+        p <- getPos+        if pos == p then+          ((i, (line, col)):) <$> go line col poss+        else do+          c <- anyChar+          if '\n' == c then+            go (line + 1) 0 ((i, pos):poss)+          else+            go line (col + 1) ((i, pos):poss)++      sorted :: [(Int, Pos)]+      sorted = sortBy (comparing snd) (zip [0..] poss)++  in case runParser (go 0 0 sorted) str of+       OK res _ -> snd <$> sortBy (comparing fst) res+       _        -> error "FlatParse.Basic.posLineCols: invalid position"++-- | Create a `Pos` from a line and column number. Throws an error on out-of-bounds+--   line and column numbers.+mkPos :: B.ByteString -> (Int, Int) -> Pos+mkPos str (line', col') =+  let go line col | line == line' && col == col' = getPos+      go line col = (do+        c <- anyChar+        if c == '\n' then go (line + 1) 0+                     else go line (col + 1)) <|> error "FlatParse.Basic.mkPos: invalid position"+  in case runParser (go 0 0) str of+    OK res _ -> res+    _        -> error "FlatParse.Basic.mkPos: got a non-OK result, impossible"++-- | Break an UTF-8-coded `B.ByteString` to lines. Throws an error on invalid input.+--   This is mostly useful for grabbing specific source lines for displaying error+--   messages.+linesUtf8 :: B.ByteString -> [String]+linesUtf8 str =+  let go = ([] <$ eof) <|> ((:) <$> takeLine <*> go)+  in case runParser go str of+    OK ls _ -> ls+    _       -> error "FlatParse.Basic.linesUtf8: invalid input"++--------------------------------------------------------------------------------++-- | Read a null-terminated bytestring (a C-style string).+--+-- Consumes the null terminator.+anyCString :: ParserT st e B.ByteString+anyCString = ParserT go'+  where+    go' fp eob s0 st = go 0# s0+      where+        go n# s = case eqAddr# eob s of+          1# -> Fail# st+          _  ->+            let s' = plusAddr# s 1#+#if MIN_VERSION_base(4,16,0)+            -- TODO below is a candidate for improving with ExtendedLiterals!+            in  case eqWord8# (indexWord8OffAddr# s 0#) (wordToWord8# 0##) of+#else+            in  case eqWord# (indexWord8OffAddr# s 0#) 0## of+#endif+                  1# -> OK# st (B.PS (ForeignPtr s0 fp) 0 (I# n#)) s'+                  _  -> go (n# +# 1#) s'+{-# inline anyCString #-}++-- | Read a null-terminated bytestring (a C-style string), where the bytestring+--   is known to be null-terminated somewhere in the input.+--+-- Highly unsafe. Unless you have a guarantee that the string will be null+-- terminated before the input ends, use 'anyCString' instead. Honestly, I'm not+-- sure if this is a good function to define. But here it is.+--+-- Fails on GHC versions older than 9.0, since we make use of the+-- 'cstringLength#' primop introduced in GHC 9.0, and we aren't very useful+-- without it.+--+-- Consumes the null terminator.+anyCStringUnsafe :: ParserT st e B.ByteString+{-# inline anyCStringUnsafe #-}+#if MIN_VERSION_base(4,15,0)+anyCStringUnsafe = ParserT \fp eob s st ->+  case eqAddr# eob s of+    1# -> Fail# st+    _  -> let n#  = cstringLength# s+              s'# = plusAddr# s (n# +# 1#)+           in OK# st (B.PS (ForeignPtr s fp) 0 (I# n#)) s'#+#else+anyCStringUnsafe = error "Flatparse.Basic.anyCStringUnsafe: requires GHC 9.0 / base-4.15, not available on this compiler"+#endif++-- | Read a protobuf-style varint into a positive 'Int'.+--+-- protobuf-style varints are byte-aligned. For each byte, the lower 7 bits are+-- data and the MSB indicates if there are further bytes. Once fully parsed, the+-- 7-bit payloads are concatenated and interpreted as a little-endian unsigned+-- integer.+--+-- Fails if the varint exceeds the positive 'Int' range.+--+-- Really, these are varnats. They also match with the LEB128 varint encoding.+--+-- protobuf encodes negatives in unsigned integers using zigzag encoding. See+-- the @fromZigzag@ family of functions for this functionality.+--+-- Further reading:+-- https://developers.google.com/protocol-buffers/docs/encoding#varints+anyVarintProtobuf :: ParserT st e Int+anyVarintProtobuf = ParserT \fp eob s st ->+    case Common.anyVarintProtobuf# eob s of+      (# (##) | #) -> Fail# st+      (# | (# w#, s#, bits# #) #) ->+        case bits# ># 63# of+          0# -> OK# st (I# w#) s#+          _  -> Fail# st -- overflow+{-# inline anyVarintProtobuf #-}

@@ -0,0 +1,91 @@+{- | Unsafe, highly dangerous parsing primitives using 'Addr#'.++Ensure to read the documentation before using any definitions from this module.++This module exports primitives useful for efficiently parsing binary files that+store data using an internal index.++Often, such indices describes records using a starting offset and a length.+Offsets are often relative to the file start, or some dynamic address in the+file. This way, individual records can be read out efficiently (much faster than+opening lots of small files!).++We may parse these in-place efficiently by adding record offsets to a base+memory address somewhere in the input. This is also extremely unsafe, and easy+to get catastrophically wrong. Thus, we provide as much utility as reasonable to+enable performing such parsing safely. (That means CPS functions.)++Note that all definitions here should be considered unsafe. Any 'Int#' is not+checked for positivity. You must perform any necessary checks when you obtain+your offsets and lengths as 'Int#'. Failure to do so may result in undefined+behaviour.+-}++module FlatParse.Basic.Addr where++import FlatParse.Basic.Parser+import FlatParse.Basic.Base ( takeUnsafe#, atSkipUnsafe#, lookahead )++import GHC.Exts++import qualified Data.ByteString as B++-- | Run a parser, passing it the current address the parser is at.+--+-- Useful for parsing offset-based data tables. For example, you may use this to+-- save the base address to use together with various relative offsets.+withAddr# :: (Addr# -> ParserT st e a) -> ParserT st e a+withAddr# p = ParserT \fp eob s st -> runParserT# (p s) fp eob s st+{-# inline withAddr# #-}++-- | @takeOffAddr# addr# offset# len#@ moves to @addr#@, skips @offset#@+--   bytes, reads @len#@ bytes into a 'ByteString', and restores the original+--   address.+--+-- The 'Addr#' should be from 'withAddr#'.+--+-- Useful for parsing offset-based data tables. Ex: Your file contains an index+-- storing @(OFFSET, LENGTH)@ entries where the offset is the byte position in+-- the file. Begin with @'withAddr#' $ \tableBase# -> ...@, then read each entry+-- like @'takeOffAddr#' tableBase# OFFSET LENGTH@.+--+-- Fails if you attempt to read outside the input.+--+-- Undefined behaviour if @offset#@ or @len#@ is negative.+--+-- Name adopted from the similar-ish @indexXOffAddr#@ primops.+takeOffAddr# :: Addr# -> Int# -> Int# -> ParserT st e B.ByteString+takeOffAddr# addr# offset# len# = withOffAddr# addr# offset# (takeUnsafe# len#)+{-# inline takeOffAddr# #-}++-- | @withOffAddr# addr# offset# p@ moves to @addr#@, skips @offset#@+--   bytes, then runs the given parser @p@.+--+-- The 'Addr#' should be from 'withAddr#'.+--+-- Fails if you attempt to read outside the input.+--+-- Undefined behaviour if @offset#@ is negative.+--+-- Name adopted from the similar-ish @indexXOffAddr#@ primops.+withOffAddr# :: Addr# -> Int# -> ParserT st e a -> ParserT st e a+withOffAddr# addr# offset# =+    lookaheadFromAddr# addr# . atSkipUnsafe# offset#+{-# inline withOffAddr# #-}++-- | 'lookahead', but specify the address to lookahead from.+--+-- The 'Addr#' should be from 'withAddr#'.+lookaheadFromAddr# :: Addr# -> ParserT st e a -> ParserT st e a+lookaheadFromAddr# s = lookahead . atAddr# s+{-# inline lookaheadFromAddr# #-}++-- | Run a parser at the given address.+--+-- The 'Addr#' should be from 'withAddr#'.+--+-- This is a highly internal function -- you likely want 'lookaheadFromAddr#',+-- which will reset the address after running the parser.+atAddr# :: Addr# -> ParserT st e a -> ParserT st e a+atAddr# s (ParserT p) = ParserT \fp eob _ st -> p fp eob s st+{-# inline atAddr# #-}

@@ -0,0 +1,356 @@+{-# LANGUAGE UnboxedTuples #-}++-- | Basic parser building blocks.++module FlatParse.Basic.Base+  (+  -- * Bytewise+    eof+  , take+  , take#+  , takeUnsafe#+  , takeRest+  , skip+  , skip#+  , skipBack+  , skipBack#+  , atSkip#+  , atSkipUnsafe#++  -- * Combinators+  , branch+  , notFollowedBy+  , chainl+  , chainr+  , lookahead+  , ensure+  , ensure#+  , withEnsure+  , withEnsure1+  , withEnsure#+  , isolate+  , isolate#+  , isolateUnsafe#++  -- ** Non-specific (TODO)+  , skipMany+  , skipSome++  -- * Errors and failures+  , failed+  , try+  , err+  , fails+  , cut+  , cutting+  , optional+  , optional_+  , withOption+  ) where++import Prelude hiding ( take )++import FlatParse.Basic.Parser+import qualified FlatParse.Common.Assorted as Common++import GHC.Exts+import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as B+import GHC.ForeignPtr ( ForeignPtr(..) )+import qualified Control.Applicative++-- | The failing parser. By default, parser choice `(<|>)` arbitrarily backtracks+--   on parser failure.+failed :: ParserT st e a+failed = Control.Applicative.empty+{-# inline failed #-}++-- | Throw a parsing error. By default, parser choice `(<|>)` can't backtrack+--   on parser error. Use `try` to convert an error to a recoverable failure.+err :: e -> ParserT st e a+err e = ParserT \_fp _eob _s st -> Err# st e+{-# inline err #-}++-- | Convert a parsing error into failure.+try :: ParserT st e a -> ParserT st e a+try (ParserT f) = ParserT \fp eob s st -> case f fp eob s st of+  Err# st' _ -> Fail# st'+  x          -> x+{-# inline try #-}++-- | Convert a parsing failure to a success.+fails :: ParserT st e a -> ParserT st e ()+fails (ParserT f) = ParserT \fp eob s st ->+  case f fp eob s st of+    OK#   st' _ _ -> Fail# st'+    Fail# st'     -> OK#   st' () s+    Err#  st' e   -> Err#  st' e+{-# inline fails #-}++-- | Convert a parsing failure to an error.+cut :: ParserT st e a -> e -> ParserT st e a+cut (ParserT f) e = ParserT \fp eob s st -> case f fp eob s st of+  Fail# st' -> Err# st' e+  x         -> x+{-# inline cut #-}++-- | Run the parser, if we get a failure, throw the given error, but if we get an error, merge the+--   inner and the newly given errors using the @e -> e -> e@ function. This can be useful for+--   implementing parsing errors which may propagate hints or accummulate contextual information.+cutting :: ParserT st e a -> e -> (e -> e -> e) -> ParserT st e a+cutting (ParserT f) e merge = ParserT \fp eob s st -> case f fp eob s st of+  Fail# st'    -> Err# st' e+  Err#  st' e' -> Err# st' $! merge e' e+  x            -> x+{-# inline cutting #-}++-- | Convert a parsing failure to a `Maybe`. If possible, use `withOption`+--   instead.+optional :: ParserT st e a -> ParserT st e (Maybe a)+optional p = (Just <$> p) <|> pure Nothing+{-# inline optional #-}++-- | Convert a parsing failure to a `()`.+optional_ :: ParserT st e a -> ParserT st e ()+optional_ p = (() <$ p) <|> pure ()+{-# inline optional_ #-}++-- | CPS'd version of `optional`. This is usually more efficient, since it gets+--   rid of the extra `Maybe` allocation.+withOption :: ParserT st e a -> (a -> ParserT st e r) -> ParserT st e r -> ParserT st e r+withOption (ParserT f) just (ParserT nothing) = ParserT \fp eob s st ->+    case f fp eob s st of+      OK#   st' a s -> runParserT# (just a) fp eob s st'+      Fail# st'     -> nothing fp eob s st'+      Err#  st' e   -> Err# st' e+{-# inline withOption #-}++--------------------------------------------------------------------------------++-- | Succeed if the input is empty.+eof :: ParserT st e ()+eof = ParserT \fp eob s st -> case eqAddr# eob s of+  1# -> OK#   st () s+  _  -> Fail# st+{-# inline eof #-}++-- | Save the parsing state, then run a parser, then restore the state.+lookahead :: ParserT st e a -> ParserT st e a+lookahead (ParserT f) = ParserT \fp eob s st ->+  case f fp eob s st of+    OK# st' a _ -> OK# st' a s+    x           -> x+{-# inline lookahead #-}++-- | @isolate n p@ runs the parser @p@ isolated to the next @n@ bytes.+--   All isolated bytes must be consumed.+--+-- Throws a runtime error if given a negative integer.+isolate :: Int -> ParserT st e a -> ParserT st e a+isolate = Common.withIntUnwrap# isolate#+{-# inline isolate #-}++-- | @isolate# n# p@ runs the parser @p@ isolated to the next @n#@ bytes.+--   All isolated bytes must be consumed.+--+-- Throws a runtime error if given a negative integer.+isolate# :: Int# -> ParserT st e a -> ParserT st e a+isolate# n# p = Common.withPosInt# n# (isolateUnsafe# n# p)+{-# inline isolate# #-}++-- | @isolateUnsafe# n# p@ runs the parser @p@ isolated to the next @n#@ bytes.+--   All isolated bytes must be consumed.+--+-- Undefined behaviour if given a negative integer.+isolateUnsafe# :: Int# -> ParserT st e a -> ParserT st e a+isolateUnsafe# n# (ParserT p) =+    withEnsure# n# $ ParserT \fp eob s st ->+        let s' = plusAddr# s n#+        in  case p fp s' s st of+              OK# st' a s'' ->+                case eqAddr# s' s'' of+                  1# -> OK#   st' a s''+                  _  -> Fail# st'+              x -> x+{-# inline isolateUnsafe# #-}++-- | An analogue of the list `foldl` function: first parse a @b@, then parse zero or more @a@-s,+--   and combine the results in a left-nested way by the @b -> a -> b@ function. Note: this is not+--   the usual `chainl` function from the parsec libraries!+chainl :: (b -> a -> b) -> ParserT st e b -> ParserT st e a -> ParserT st e b+chainl f start elem = start >>= go where+  go b = do {!a <- elem; go $! f b a} <|> pure b+{-# inline chainl #-}++-- | An analogue of the list `foldr` function: parse zero or more @a@-s, terminated by a @b@, and+--   combine the results in a right-nested way using the @a -> b -> b@ function. Note: this is not+--   the usual `chainr` function from the parsec libraries!+chainr :: (a -> b -> b) -> ParserT st e a -> ParserT st e b -> ParserT st e b+chainr f (ParserT elem) (ParserT end) = ParserT go where+  go fp eob s st = case elem fp eob s st of+    OK#   st' a s -> case go fp eob s st' of+      OK# st'' b s -> let !b' = f a b in OK# st'' b' s+      x            -> x+    Fail# st'     -> end fp eob s st'+    Err#  st' e   -> Err# st' e+{-# inline chainr #-}++-- | Branch on a parser: if the first argument succeeds, continue with the second, else with the third.+--   This can produce slightly more efficient code than `(<|>)`. Moreover, `branch` does not+--   backtrack from the true/false cases.+branch :: ParserT st e a -> ParserT st e b -> ParserT st e b -> ParserT st e b+branch pa pt pf = ParserT \fp eob s st -> case runParserT# pa fp eob s st of+  OK#   st' _ s -> runParserT# pt fp eob s st'+  Fail# st'     -> runParserT# pf fp eob s st'+  Err#  st' e   -> Err# st' e+{-# inline branch #-}++-- | Succeed if the first parser succeeds and the second one fails.+notFollowedBy :: ParserT st e a -> ParserT st e b -> ParserT st e a+notFollowedBy p1 p2 = p1 <* fails p2+{-# inline notFollowedBy #-}++--------------------------------------------------------------------------------++-- | Assert that there are at least @n@ bytes remaining.+--+-- Undefined behaviour if given a negative integer.+ensure :: Int -> ParserT st e ()+ensure = Common.withIntUnwrap# ensure#+{-# inline ensure #-}++-- | Assert that there are at least @n#@ bytes remaining.+--+-- Undefined behaviour if given a negative integer.+ensure# :: Int# -> ParserT st e ()+ensure# n# = withEnsure# n# (pure ())+{-# inline ensure# #-}++-- TODO: András: why do we need withEnsure-s?+-- There's no unboxing to be improved.++-- | Assert that there are at least @n#@ bytes remaining (CPS).+--+-- Undefined behaviour if given a negative integer.+withEnsure :: Int -> ParserT st e r -> ParserT st e r+withEnsure = Common.withIntUnwrap# withEnsure#+{-# inline withEnsure #-}++-- | Assert that there is at least 1 byte remaining (CPS).+--+-- Undefined behaviour if given a negative integer.+withEnsure1 :: ParserT st e r -> ParserT st e r+withEnsure1 (ParserT p) = ParserT \fp eob s st ->+    case eqAddr# eob s of+      0# -> p fp eob s st+      _  -> Fail# st+{-# inline withEnsure1 #-}++-- | Assert that there are at least @n#@ bytes remaining (CPS).+--+-- Undefined behaviour if given a negative integer.+withEnsure# :: Int# -> ParserT st e r -> ParserT st e r+withEnsure# n# (ParserT p) = ParserT \fp eob s st ->+    case n# <=# minusAddr# eob s of+      1# -> p fp eob s st+      _  -> Fail# st+{-# inline withEnsure# #-}++--------------------------------------------------------------------------------++-- | Read the given number of bytes as a 'ByteString'.+--+-- Throws a runtime error if given a negative integer.+take :: Int -> ParserT st e B.ByteString+take (I# n#) = take# n#+{-# inline take #-}++-- | Read @n#@ bytes as a 'ByteString'. Fails if fewer than @n#@ bytes are+--   available.+--+-- Throws a runtime error if given a negative integer.+take# :: Int# -> ParserT st e B.ByteString+take# n# = Common.withPosInt# n# (takeUnsafe# n#)+{-# inline take# #-}++-- | Read @n#@ bytes as a 'ByteString'. Fails if fewer than @n#@ bytes are+--   available.+--+-- Undefined behaviour if given a negative integer.+takeUnsafe# :: Int# -> ParserT st e B.ByteString+takeUnsafe# n# = ParserT \fp eob s st ->+    case n# <=# minusAddr# eob s of+      1# -> OK#   st (B.PS (ForeignPtr s fp) 0 (I# n#)) (plusAddr# s n#)+      _  -> Fail# st+{-# inline takeUnsafe# #-}++-- | Consume the rest of the input. May return the empty bytestring.+takeRest :: ParserT st e B.ByteString+takeRest = ParserT \fp eob s st ->+  let n# = minusAddr# eob s+  in  OK# st (B.PS (ForeignPtr s fp) 0 (I# n#)) eob+{-# inline takeRest #-}++-- | Skip forward @n@ bytes. Fails if fewer than @n@ bytes are available.+--+-- Throws a runtime error if given a negative integer.+skip :: Int -> ParserT st e ()+skip (I# n#) = skip# n#+{-# inline skip #-}++-- | Skip forward @n#@ bytes. Fails if fewer than @n#@ bytes are available.+--+-- Throws a runtime error if given a negative integer.+skip# :: Int# -> ParserT st e ()+skip# n# = atSkip# n# (pure ())+{-# inline skip# #-}++-- | Go back @i@ bytes in the input. Takes a positive integer.+--+-- Extremely unsafe. Makes no checks. Almost certainly a Bad Idea.+skipBack :: Int -> ParserT st e ()+skipBack = Common.withIntUnwrap# skipBack#+{-# inline skipBack #-}++-- | Go back @n#@ bytes. Takes a positive integer.+--+-- Extremely unsafe. Makes no checks. Almost certainly a Bad Idea.+skipBack# :: Int# -> ParserT st e ()+skipBack# n# = ParserT \fp eob s st ->+    OK# st () (plusAddr# s (negateInt# n#))+{-# inline skipBack# #-}++-- | Skip forward @n#@ bytes and run the given parser. Fails if fewer than @n#@+--   bytes are available.+--+-- Throws a runtime error if given a negative integer.+atSkip# :: Int# -> ParserT st e a -> ParserT st e a+atSkip# n# p = Common.withPosInt# n# (atSkipUnsafe# n# p)+{-# inline atSkip# #-}++-- | Skip forward @n@ bytes and run the given parser. Fails if fewer than @n@+--   bytes are available.+--+-- Undefined behaviour if given a negative integer.+atSkipUnsafe# :: Int# -> ParserT st e r -> ParserT st e r+atSkipUnsafe# n# (ParserT p) =+    withEnsure# n# $ ParserT \fp eob s st ->+        p fp eob (plusAddr# s n#) st+{-# inline atSkipUnsafe# #-}++--------------------------------------------------------------------------------++-- | Skip a parser zero or more times.+skipMany :: ParserT st e a -> ParserT st e ()+skipMany (ParserT f) = ParserT go where+  go fp eob s st = case f fp eob s st of+    OK# st a s -> go fp eob s st+    Fail# st   -> OK# st () s+    Err# st e  -> Err# st e+{-# inline skipMany #-}++-- TODO identical to one from parser-combinators+-- | Skip a parser one or more times.+skipSome :: ParserT st e a -> ParserT st e ()+skipSome p = p *> skipMany p+{-# inline skipSome #-}

@@ -0,0 +1,63 @@+{- | Bytestring parsers.++Module dependency complications prevent us from placing these in+"FlatParse.Basic.Base".+-}++module FlatParse.Basic.Bytes+  ( bytes, bytesUnsafe+  ) where++import FlatParse.Basic.Parser+import FlatParse.Basic.Base ( withEnsure )+import FlatParse.Basic.Integers ( word8Unsafe, word16Unsafe, word32Unsafe, word64Unsafe )+import qualified FlatParse.Common.Assorted as Common+import Language.Haskell.TH+import GHC.Exts++-- | Read a sequence of bytes. This is a template function, you can use it as @$(bytes [3, 4, 5])@,+--   for example, and the splice has type @Parser e ()@. For a non-TH variant see 'FlatParse.Basic.byteString'.+bytes :: [Word] -> Q Exp+bytes bs = do+  let !len = length bs+  [| withEnsure len $(bytesUnsafe bs) |]++-- | Template function, creates a @Parser e ()@ which unsafely parses a given+--   sequence of bytes.+--+-- The caller must guarantee that the input has enough bytes.+bytesUnsafe :: [Word] -> Q Exp+bytesUnsafe bytes = do+  let !(leading, w8s) = Common.splitBytes bytes+      !scanw8s        = go w8s where+                         go (w8:[] ) = [| word64Unsafe w8 |]+                         go (w8:w8s) = [| word64Unsafe w8 >> $(go w8s) |]+                         go []       = [| pure () |]+  case w8s of+    [] -> go leading+          where+            go (a:b:c:d:[]) = let !w = Common.packBytes [a, b, c, d] in [| word32Unsafe w |]+            go (a:b:c:d:ws) = let !w = Common.packBytes [a, b, c, d] in [| word32Unsafe w >> $(go ws) |]+            go (a:b:[])     = let !w = Common.packBytes [a, b]       in [| word16Unsafe w |]+            go (a:b:ws)     = let !w = Common.packBytes [a, b]       in [| word16Unsafe w >> $(go ws) |]+            go (a:[])       = [| word8Unsafe a |]+            go []           = [| pure () |]+    _  -> case leading of++      []              -> scanw8s+      [a]             -> [| word8Unsafe a >> $scanw8s |]+      ws@[a, b]       -> let !w = Common.packBytes ws in [| word16Unsafe w >> $scanw8s |]+      ws@[a, b, c, d] -> let !w = Common.packBytes ws in [| word32Unsafe w >> $scanw8s |]+      ws              -> let !w = Common.packBytes ws+                             !l = length ws+                         in [| scanPartial64# l w >> $scanw8s |]++scanPartial64# :: Int -> Word -> ParserT st e ()+scanPartial64# (I# len) (W# w) = ParserT \fp eob s st ->+  case indexWordOffAddr# s 0# of+    w' -> case uncheckedIShiftL# (8# -# len) 3# of+      sh -> case uncheckedShiftL# w' sh of+        w' -> case uncheckedShiftRL# w' sh of+          w' -> case eqWord# w w' of+            1# -> OK#   st () (plusAddr# s len)+            _  -> Fail# st

@@ -0,0 +1,391 @@+-- | Machine integer parsers.++module FlatParse.Basic.Integers+  (+  -- * Native byte order+    anyWord8, anyWord16, anyWord32, anyWord64+  , anyInt8,  anyInt16,  anyInt32,  anyInt64+  , anyWord, anyInt++  -- * Explicit endianness+  -- $explicit-endianness+  , anyWord16le, anyWord16be+  , anyWord32le, anyWord32be+  , anyWord64le, anyWord64be+  , anyInt16le,  anyInt16be+  , anyInt32le,  anyInt32be+  , anyInt64le,  anyInt64be++  -- * Value assertions+  , word8++  -- * CPS parsers+  , withAnyWord8, withAnyWord16, withAnyWord32, withAnyWord64+  , withAnyInt8,  withAnyInt16,  withAnyInt32,  withAnyInt64+  , withAnyWord, withAnyInt++  -- * Unsafe+  -- $unsafe+  , anyWord8Unsafe++  -- ** Value assertions+  , word8Unsafe, word16Unsafe, word32Unsafe, word64Unsafe++  -- * Helper definitions+  , withAnySized#, withAnySizedUnsafe#+  , sizedUnsafe#+  ) where++import FlatParse.Basic.Parser+import FlatParse.Basic.Base ( withEnsure# )++import FlatParse.Common.Assorted ( word16ToInt16, word32ToInt32, word64ToInt64 )++import FlatParse.Common.GHCExts+import GHC.Word+import GHC.Int++import Control.Applicative ( Alternative(empty) )++--------------------------------------------------------------------------------++-- | Helper for defining CPS parsers for types of a constant byte size (i.e.+--   machine integers).+--+-- Call this with an @indexXYZOffAddr@ primop (e.g.+-- 'GHC.Exts.indexWord8OffAddr') and the size in bytes of the type you're+-- parsing.+withAnySized#+    :: Int# -> (Addr# -> Int# -> a) -> (a -> ParserT st e r) -> ParserT st e r+withAnySized# size# indexOffAddr p =+    withEnsure# size# (withAnySizedUnsafe# size# indexOffAddr p)+{-# inline withAnySized# #-}++-- | Unsafe helper for defining CPS parsers for types of a constant byte size+--   (i.e. machine integers).+--+-- Is really just syntactic sugar for applying the given parser and shifting the+-- buffer along.+--+-- The caller must guarantee that the input has enough bytes.+withAnySizedUnsafe#+    :: Int# -> (Addr# -> Int# -> a) -> (a -> ParserT st e r) -> ParserT st e r+withAnySizedUnsafe# size# indexOffAddr p = ParserT \fp eob buf st ->+-- TODO force? i.e. @let !a, !buf'@ ?+  let a    = indexOffAddr buf 0#+      buf' = plusAddr# buf size#+  in  runParserT# (p a) fp eob buf' st+{-# inline withAnySizedUnsafe# #-}++-- | Parse any 'Word8' (CPS).+withAnyWord8 :: (Word8 -> ParserT st e r) -> ParserT st e r+withAnyWord8 p = ParserT \fp eob buf st -> case eqAddr# eob buf of+  1# -> Fail# st+  _  -> let w# = indexWord8OffAddr# buf 0#+        in  runParserT# (p (W8# w#)) fp eob (plusAddr# buf 1#) st+{-# inline withAnyWord8 #-}++-- | Parse any 'Word16' (native byte order) (CPS).+withAnyWord16 :: (Word16 -> ParserT st e r) -> ParserT st e r+withAnyWord16 = withAnySized# 2# (\a i -> W16# (indexWord16OffAddr# a i))+{-# inline withAnyWord16 #-}++-- | Parse any 'Word32' (native byte order) (CPS).+withAnyWord32 :: (Word32 -> ParserT st e r) -> ParserT st e r+withAnyWord32 = withAnySized# 4# (\a i -> W32# (indexWord32OffAddr# a i))+{-# inline withAnyWord32 #-}++-- | Parse any 'Word64' (native byte order) (CPS).+withAnyWord64 :: (Word64 -> ParserT st e r) -> ParserT st e r+withAnyWord64 = withAnySized# 8# (\a i -> W64# (indexWord64OffAddr# a i))+{-# inline withAnyWord64 #-}++-- | Parse any 'Int8' (CPS).+withAnyInt8 :: (Int8 -> ParserT st e r) -> ParserT st e r+withAnyInt8 p = ParserT \fp eob buf st -> case eqAddr# eob buf of+  1# -> Fail# st+  _  -> let i# = indexInt8OffAddr# buf 0#+        in  runParserT# (p (I8# i#)) fp eob (plusAddr# buf 1#) st+{-# inline withAnyInt8 #-}++-- | Parse any 'Int16' (native byte order) (CPS).+withAnyInt16 :: (Int16 -> ParserT st e r) -> ParserT st e r+withAnyInt16 = withAnySized# 2# (\a i -> I16# (indexInt16OffAddr# a i))+{-# inline withAnyInt16 #-}++-- | Parse any 'Int32' (native byte order) (CPS).+withAnyInt32 :: (Int32 -> ParserT st e r) -> ParserT st e r+withAnyInt32 = withAnySized# 4# (\a i -> I32# (indexInt32OffAddr# a i))+{-# inline withAnyInt32 #-}++-- | Parse any 'Int64' (native byte order) (CPS).+withAnyInt64 :: (Int64 -> ParserT st e r) -> ParserT st e r+withAnyInt64 = withAnySized# 8# (\a i -> I64# (indexInt64OffAddr# a i))+{-# inline withAnyInt64 #-}++-- TODO assumes 64-bit platform+-- | Parse any 'Word' (native size) (CPS).+withAnyWord :: (Word -> ParserT st e r) -> ParserT st e r+withAnyWord p = ParserT \fp eob buf st -> case 8# <=# minusAddr# eob buf of+  0# -> Fail# st+  _  -> let w# = indexWordOffAddr# buf 0#+        in  runParserT# (p (W# w#)) fp eob (plusAddr# buf 8#) st+{-# inline withAnyWord #-}++-- -- TODO assumes 64-bit platform+-- | Parse any 'Int' (native size) (CPS).+withAnyInt :: (Int -> ParserT st e r) -> ParserT st e r+withAnyInt p = ParserT \fp eob buf st -> case 8# <=# minusAddr# eob buf of+  0# -> Fail# st+  _  -> let i# = indexIntOffAddr# buf 0#+        in  runParserT# (p (I# i#)) fp eob (plusAddr# buf 8#) st+{-# inline withAnyInt #-}++--------------------------------------------------------------------------------++-- | Parse any 'Word8'.+anyWord8 :: ParserT st e Word8+anyWord8 = withAnyWord8 pure+{-# inline anyWord8 #-}++-- | Parse any 'Word16' (native byte order).+anyWord16 :: ParserT st e Word16+anyWord16 = withAnyWord16 pure+{-# inline anyWord16 #-}++-- | Parse any 'Word32' (native byte order).+anyWord32 :: ParserT st e Word32+anyWord32 = withAnyWord32 pure+{-# inline anyWord32 #-}++-- | Parse any 'Word64' (native byte order).+anyWord64 :: ParserT st e Word64+anyWord64 = withAnyWord64 pure+{-# inline anyWord64 #-}++-- | Parse any 'Int8'.+anyInt8 :: ParserT st e Int8+anyInt8 = withAnyInt8 pure+{-# inline anyInt8 #-}++-- | Parse any 'Int16' (native byte order).+anyInt16 :: ParserT st e Int16+anyInt16 = withAnyInt16 pure+{-# inline anyInt16 #-}++-- | Parse any 'Int32' (native byte order).+anyInt32 :: ParserT st e Int32+anyInt32 = withAnyInt32 pure+{-# inline anyInt32 #-}++-- | Parse any 'Int64' (native byte order).+anyInt64 :: ParserT st e Int64+anyInt64 = withAnyInt64 pure+{-# inline anyInt64 #-}++-- TODO 'withAnyWord' assumes 64-bit platform+-- | Parse any 'Word' (native size).+anyWord :: ParserT st e Word+anyWord = withAnyWord pure+{-# inline anyWord #-}++-- TODO 'withAnyInt' assumes 64-bit platform+-- | Parse any 'Int' (native size).+anyInt :: ParserT st e Int+anyInt = withAnyInt pure+{-# inline anyInt #-}++--------------------------------------------------------------------------------++{- $explicit-endianness+Native endianness parsers are used where possible. For non-native endianness+parsers, we parse then use the corresponding @byteSwapX@ function. On x86, this+is inlined as a single @BSWAP@ instruction.+-}++-- | Parse any 'Word16' (little-endian).+anyWord16le :: ParserT st e Word16+#ifdef WORDS_BIGENDIAN+anyWord16le = withAnyWord16 (pure . byteSwap16)+#else+anyWord16le = anyWord16+#endif+{-# inline anyWord16le #-}++-- | Parse any 'Word16' (big-endian).+anyWord16be :: ParserT st e Word16+#ifdef WORDS_BIGENDIAN+anyWord16be = anyWord16+#else+anyWord16be = withAnyWord16 (pure . byteSwap16)+#endif+{-# inline anyWord16be #-}++-- | Parse any 'Word32' (little-endian).+anyWord32le :: ParserT st e Word32+#ifdef WORDS_BIGENDIAN+anyWord32le = withAnyWord32 (pure . byteSwap32)+#else+anyWord32le = anyWord32+#endif+{-# inline anyWord32le #-}++-- | Parse any 'Word32' (big-endian).+anyWord32be :: ParserT st e Word32+#ifdef WORDS_BIGENDIAN+anyWord32be = anyWord32+#else+anyWord32be = withAnyWord32 (pure . byteSwap32)+#endif+{-# inline anyWord32be #-}++-- | Parse any 'Word64' (little-endian).+anyWord64le :: ParserT st e Word64+#ifdef WORDS_BIGENDIAN+anyWord64le = withAnyWord64 (pure . byteSwap64)+#else+anyWord64le = anyWord64+#endif+{-# inline anyWord64le #-}++-- | Parse any 'Word64' (big-endian).+anyWord64be :: ParserT st e Word64+#ifdef WORDS_BIGENDIAN+anyWord64be = anyWord64+#else+anyWord64be = withAnyWord64 (pure . byteSwap64)+#endif+{-# inline anyWord64be #-}++-- | Parse any 'Int16' (little-endian).+anyInt16le :: ParserT st e Int16+#ifdef WORDS_BIGENDIAN+anyInt16le = withAnyWord16 (pure . word16ToInt16 . byteSwap16)+#else+anyInt16le = anyInt16+#endif+{-# inline anyInt16le #-}++-- | Parse any 'Int16' (big-endian).+anyInt16be :: ParserT st e Int16+#ifdef WORDS_BIGENDIAN+anyInt16be = anyInt16+#else+anyInt16be = withAnyWord16 (pure . word16ToInt16 . byteSwap16)+#endif+{-# inline anyInt16be #-}++-- | Parse any 'Int32' (little-endian).+anyInt32le :: ParserT st e Int32+#ifdef WORDS_BIGENDIAN+anyInt32le = withAnyWord32 (pure . word32ToInt32 . byteSwap32)+#else+anyInt32le = anyInt32+#endif+{-# inline anyInt32le #-}++-- | Parse any 'Int32' (big-endian).+anyInt32be :: ParserT st e Int32+#ifdef WORDS_BIGENDIAN+anyInt32be = anyInt32+#else+anyInt32be = withAnyWord32 (pure . word32ToInt32 . byteSwap32)+#endif+{-# inline anyInt32be #-}++-- | Parse any 'Int64' (little-endian).+anyInt64le :: ParserT st e Int64+#ifdef WORDS_BIGENDIAN+anyInt64le = withAnyWord64 (pure . word64ToInt64 . byteSwap64)+#else+anyInt64le = anyInt64+#endif+{-# inline anyInt64le #-}++-- | Parse any 'Int64' (big-endian).+anyInt64be :: ParserT st e Int64+#ifdef WORDS_BIGENDIAN+anyInt64be = anyInt64+#else+anyInt64be = withAnyWord64 (pure . word64ToInt64 . byteSwap64)+#endif+{-# inline anyInt64be #-}++--------------------------------------------------------------------------------++-- | Read the next 1 byte and assert its value as a 'Word8'.+word8 :: Word8 -> ParserT st e ()+word8 wExpected = ParserT \fp eob buf st -> case eqAddr# eob buf of+  1# -> Fail# st+  _  -> let w# = indexWord8OffAddr# buf 0#+        in  if   W8# w# == wExpected+            then OK# st () (plusAddr# buf 1#)+            else Fail# st+{-# inline word8 #-}++--------------------------------------------------------------------------------++{- $unsafe+These unsafe parsers and helpers may be useful for efficient parsing in special+situations e.g. you already know that the input has enough bytes. You should+only use them if you can assert their necessary guarantees (see the individual+function documentation).+-}++-- | Unsafe helper for defining parsers for types of a constant byte size (i.e.+--   machine integers) which assert the parsed value's... value.+--+-- Call this with an @indexXYZOffAddr@ primop (e.g.+-- 'GHC.Exts.indexWord8OffAddr'), the size in bytes of the type you're parsing,+-- and the expected value to test the parsed value against.+--+-- The caller must guarantee that the input has enough bytes.+sizedUnsafe# :: Eq a => Int# -> (Addr# -> Int# -> a) -> a -> ParserT st e ()+sizedUnsafe# size# indexOffAddr aExpected =+    withAnySizedUnsafe# size# indexOffAddr go+  where+    go aParsed =+        if   aParsed == aExpected+        then pure ()+        else empty+{-# inline sizedUnsafe# #-}++-- | Unsafely read the next 1 byte and assert its value as a 'Word8'.+--+-- The caller must guarantee that the input has enough bytes.+word8Unsafe :: Word8 -> ParserT st e ()+word8Unsafe = sizedUnsafe# 1# (\a i -> W8# (indexWord8OffAddr# a i))+{-# inline word8Unsafe #-}++-- | Unsafely read the next 2 bytes and assert their value as a 'Word16'+--   (native byte order).+--+-- The caller must guarantee that the input has enough bytes.+word16Unsafe :: Word16 -> ParserT st e ()+word16Unsafe = sizedUnsafe# 2# (\a i -> W16# (indexWord16OffAddr# a i))+{-# inline word16Unsafe #-}++-- | Unsafely read the next 4 bytes and assert their value as a 'Word32'.+--   (native byte order).+--+-- The caller must guarantee that the input has enough bytes.+word32Unsafe :: Word32 -> ParserT st e ()+word32Unsafe = sizedUnsafe# 4# (\a i -> W32# (indexWord32OffAddr# a i))+{-# inline word32Unsafe #-}++-- | Unsafely read the next 8 bytes and assert their value as a 'Word64'.+--   (native byte order).+--+-- The caller must guarantee that the input has enough bytes.+word64Unsafe :: Word64 -> ParserT st e ()+word64Unsafe = sizedUnsafe# 8# (\a i -> W64# (indexWord64OffAddr# a i))+{-# inline word64Unsafe #-}++--------------------------------------------------------------------------------++-- | Unsafely parse any 'Word8', without asserting the input is non-empty.+--+-- The caller must guarantee that the input has enough bytes.+anyWord8Unsafe :: ParserT st e Word8+anyWord8Unsafe = withAnySizedUnsafe# 1# (\a i -> W8# (indexWord8OffAddr# a i)) pure+{-# inline anyWord8Unsafe #-}

@@ -0,0 +1,177 @@+-- | Minimal parser definition.++{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DataKinds #-} -- needed for manual ZeroBitType def (unsure why)+{-# LANGUAGE FlexibleInstances #-}++module FlatParse.Basic.Parser+  (+  -- * Parser+    ParserT(..)+  , Parser, ParserIO, ParserST++  -- * Result+  , type Res#+  , pattern OK#, pattern Err#, pattern Fail#++  -- ** Internal+  , type ResI#++  -- * Choice operator (defined with right associativity)+  , (<|>)+  ) where++import FlatParse.Common.GHCExts ( Addr#, unsafeCoerce#, ZeroBitType )+import FlatParse.Common.Parser++import GHC.ForeignPtr ( ForeignPtrContents )++import qualified Control.Applicative+import Control.Monad ( MonadPlus(..) )+import Control.Monad.IO.Class ( MonadIO(..) )+import GHC.IO ( IO(IO) )++-- | @ParserT st e a@ is a parser with a state token type @st@, an error type+--   @e@ and a return type @a@. The different state token types support+--   different embededded effects; see `Parser`, `ParserIO` and `ParserST`+--   below.+newtype ParserT (st :: ZeroBitType) e a =+    ParserT { runParserT# :: ForeignPtrContents -> Addr# -> Addr# -> st -> Res# st e a }++-- | The type of pure parsers.+type Parser     = ParserT PureMode++-- | The type of parsers which can embed `IO` actions.+type ParserIO   = ParserT IOMode++-- | The type of parsers which can embed `ST` actions.+type ParserST s = ParserT (STMode s)++-- | You may lift IO actions into a 'ParserIO' using `liftIO`.+instance MonadIO (ParserIO e) where+  liftIO (IO a) = ParserT \fp eob s rw ->+    case a rw of (# rw', a #) -> OK# rw' a s+  {-# inline liftIO #-}++instance Functor (ParserT st e) where+  fmap f (ParserT g) = ParserT \fp eob s st -> case g fp eob s st of+    OK# st' a s -> OK# st' (f $! a) s+    x           -> unsafeCoerce# x+  {-# inline fmap #-}++  (<$) a' (ParserT g) = ParserT \fp eob s st -> case g fp eob s st of+    OK# st' _a s -> OK# st' a' s+    x           -> unsafeCoerce# x+  {-# inline (<$) #-}++instance Applicative (ParserT st e) where+  pure a = ParserT \fp eob s st -> OK# st a s+  {-# inline pure #-}+  ParserT ff <*> ParserT fa = ParserT \fp eob s st -> case ff fp eob s st of+    OK# st' f s -> case fa fp eob s st' of+      OK# st'' a s -> OK# st'' (f $! a) s+      x            -> unsafeCoerce# x+    x           -> unsafeCoerce# x+  {-# inline (<*>) #-}+  ParserT fa <* ParserT fb = ParserT \fp eob s st -> case fa fp eob s st of+    OK# st' a s -> case fb fp eob s st' of+      OK# st'' _b s -> OK# st'' a s+      x             -> unsafeCoerce# x+    x           -> unsafeCoerce# x+  {-# inline (<*) #-}+  ParserT fa *> ParserT fb = ParserT \fp eob s st -> case fa fp eob s st of+    OK# st' _a s -> fb fp eob s st'+    x            -> unsafeCoerce# x+  {-# inline (*>) #-}++instance Monad (ParserT st e) where+  return = pure+  {-# inline return #-}+  ParserT fa >>= f = ParserT \fp eob s st -> case fa fp eob s st of+    OK# st' a s -> runParserT# (f a) fp eob s st'+    x           -> unsafeCoerce# x+  {-# inline (>>=) #-}+  (>>) = (*>)+  {-# inline (>>) #-}++-- | By default, parser choice `(<|>)` arbitrarily backtracks on parser failure.+instance Control.Applicative.Alternative (ParserT st e) where+  empty = ParserT \fp eob s st -> Fail# st+  {-# inline empty #-}++  (<|>) = (<|>)+  {-# inline (Control.Applicative.<|>) #-}++  many (ParserT f) = ParserT go where+    go fp eob s st = case f fp eob s st of+      OK# st a s -> case go fp eob s st of+                      OK# st as s -> OK# st (a:as) s+                      x           -> x+      Fail# st  -> OK# st [] s+      Err# st e -> Err# st e+  {-# inline many #-}++  some p = (:) <$> p <*> Control.Applicative.many p+  {-# inline some #-}++infixr 6 <|>+-- | Choose between two parsers. If the first parser fails, try the second one,+--   but if the first one throws an error, propagate the error. This operation+--   can arbitrarily backtrack.+--+-- Note: this exported operator has different fixity than the same operator in+-- `Control.Applicative`. Hide this operator if you want to use the+-- `Alternative` version.+(<|>) :: ParserT st e a -> ParserT st e a -> ParserT st e a+(<|>) (ParserT f) (ParserT g) = ParserT \fp eob s st ->+  case f fp eob s st of+    Fail# st' -> g fp eob s st'+    x         -> x+{-# inline[1] (<|>) #-}++{-# RULES++"flatparse/reassoc-alt" forall l m r. (l <|> m) <|> r = l <|> (m <|> r)++#-}++instance MonadPlus (ParserT st e) where+  mzero = Control.Applicative.empty+  {-# inline mzero #-}+  mplus = (<|>)+  {-# inline mplus #-}++--------------------------------------------------------------------------------++-- | Primitive parser result wrapped with a state token.+--+-- You should rarely need to manipulate values of this type directly. Use the+-- provided bidirectional pattern synonyms 'OK#', 'Fail#' and 'Err#'.+type Res# (st :: ZeroBitType) e a =+  (# st, ResI# e a #)++-- | Primitive parser result.+type ResI# e a =+  (#+    (# a, Addr# #)+  | (# #)+  | (# e #)+  #)++-- | 'Res#' constructor for a successful parse.+--   Contains the return value and a pointer to the rest of the input buffer,+--   plus a state token.+pattern OK# :: (st :: ZeroBitType) -> a -> Addr# -> Res# st e a+pattern OK# st a s = (# st, (# (# a, s #) | | #) #)++-- | 'Res#' constructor for recoverable failure.+--   Contains only a state token.+pattern Fail# :: (st :: ZeroBitType) -> Res# st e a+pattern Fail# st = (# st, (# | (# #) | #) #)++-- | 'Res#' constructor for errors which are by default non-recoverable.+--    Contains the error, plus a state token.+pattern Err# :: (st :: ZeroBitType) -> e -> Res# st e a+pattern Err# st e = (# st, (# | | (# e #) #) #)+{-# complete OK#, Fail#, Err# #-}

@@ -0,0 +1,167 @@+-- | Efficient literal branching using Template Haskell.++module FlatParse.Basic.Switch+  ( switch, switchWithPost, rawSwitchWithPost+  ) where++import Control.Monad+import Data.Foldable+import Data.Map (Map)+import Language.Haskell.TH++import qualified Data.Map.Strict as M++import FlatParse.Common.Switch+import FlatParse.Basic.Base ( ensure, skipBack, branch, failed )+import FlatParse.Basic.Bytes ( bytes, bytesUnsafe )+import FlatParse.Basic.Integers ( anyWord8Unsafe )++{-|+This is a template function which makes it possible to branch on a collection of string literals in+an efficient way. By using `switch`, such branching is compiled to a trie of primitive parsing+operations, which has optimized control flow, vectorized reads and grouped checking for needed input+bytes.++The syntax is slightly magical, it overloads the usual @case@ expression. An example:++@+    $(switch [| case _ of+        "foo" -> pure True+        "bar" -> pure False |])+@++The underscore is mandatory in @case _ of@. Each branch must be a string literal, but optionally+we may have a default case, like in++@+    $(switch [| case _ of+        "foo" -> pure 10+        "bar" -> pure 20+        _     -> pure 30 |])+@++All case right hand sides must be parsers with the same type. That type is also the type+of the whole `switch` expression.++A `switch` has longest match semantics, and the order of cases does not matter, except for+the default case, which may only appear as the last case.++If a `switch` does not have a default case, and no case matches the input, then it returns with+failure, \without\ having consumed any input. A fallthrough to the default case also does not+consume any input.+-}+switch :: Q Exp -> Q Exp+switch = switchWithPost Nothing++{-|+Switch expression with an optional first argument for performing a post-processing action after+every successful branch matching, not including the default branch. For example, if we have+@ws :: ParserT st e ()@ for a whitespace parser, we might want to consume whitespace after matching+on any of the switch cases. For that case, we can define a "lexeme" version of `switch` as+follows.++@+  switch' :: Q Exp -> Q Exp+  switch' = switchWithPost (Just [| ws |])+@++Note that this @switch'@ function cannot be used in the same module it's defined in, because of the+stage restriction of Template Haskell.+-}+switchWithPost :: Maybe (Q Exp) -> Q Exp -> Q Exp+switchWithPost postAction exp = do+  !postAction <- sequence postAction+  (!cases, !fallback) <- parseSwitch exp+  genTrie $! genSwitchTrie' postAction cases fallback++-- | Version of `switchWithPost` without syntactic sugar. The second argument is the+--   list of cases, the third is the default case.+rawSwitchWithPost :: Maybe (Q Exp) -> [(String, Q Exp)] -> Maybe (Q Exp) -> Q Exp+rawSwitchWithPost postAction cases fallback = do+  !postAction <- sequence postAction+  !cases <- forM cases \(str, rhs) -> (str,) <$> rhs+  !fallback <- sequence fallback+  genTrie $! genSwitchTrie' postAction cases fallback++#if MIN_VERSION_base(4,15,0)+mkDoE = DoE Nothing+{-# inline mkDoE #-}+#else+mkDoE = DoE+{-# inline mkDoE #-}+#endif++genTrie :: (Map (Maybe Int) Exp, Trie' (Rule, Int, Maybe Int)) -> Q Exp+genTrie (rules, t) = do+  branches <- traverse (\e -> (,) <$> (newName "rule") <*> pure e) rules++  let ix m k = case M.lookup k m of+        Nothing -> error ("key not in map: " ++ show k)+        Just a  -> a++  let ensure' :: Maybe Int -> Maybe (Q Exp)+      ensure' = fmap (\n -> [| ensure n |])++      fallback :: Rule -> Int ->  Q Exp+      fallback rule 0 = pure $ VarE $ fst $ ix branches rule+      fallback rule n = [| skipBack n >> $(pure $ VarE $ fst $ ix branches rule) |]++  let go :: Trie' (Rule, Int, Maybe Int) -> Q Exp+      go = \case+        Branch' (r, n, alloc) ts+          | M.null ts -> pure $ VarE $ fst $ branches M.! r+          | otherwise -> do+              !next         <- (traverse . traverse) go (M.toList ts)+              !defaultCase  <- fallback r (n + 1)++              let cases = mkDoE $+                    [BindS (VarP (mkName "c")) (VarE 'anyWord8Unsafe),+                      NoBindS (CaseE (VarE (mkName "c"))+                         (map (\(w, t) ->+                                 Match (LitP (IntegerL (fromIntegral w)))+                                       (NormalB t)+                                       [])+                              next+                          ++ [Match WildP (NormalB defaultCase) []]))]++              case ensure' alloc of+                Nothing    -> pure cases+                Just alloc -> [| branch $alloc $(pure cases) $(fallback r n) |]++        Path (r, n, alloc) ws t ->+          case ensure' alloc of+            Nothing    -> [| branch $(bytes ws) $(go t) $(fallback r n)|]+            Just alloc -> [| branch ($alloc >> $(bytesUnsafe ws)) $(go t) $(fallback r n) |]++  letE+    (map (\(x, rhs) -> valD (varP x) (normalB (pure rhs)) []) (Data.Foldable.toList branches))+    (go t)++parseSwitch :: Q Exp -> Q ([(String, Exp)], Maybe Exp)+parseSwitch exp = exp >>= \case+  CaseE (UnboundVarE _) []    -> error "switch: empty clause list"+  CaseE (UnboundVarE _) cases -> do+    (!cases, !last) <- pure (init cases, last cases)+    !cases <- forM cases \case+      Match (LitP (StringL str)) (NormalB rhs) [] -> pure (str, rhs)+      _ -> error "switch: expected a match clause on a string literal"+    (!cases, !last) <- case last of+      Match (LitP (StringL str)) (NormalB rhs) [] -> pure (cases ++ [(str, rhs)], Nothing)+      Match WildP                (NormalB rhs) [] -> pure (cases, Just rhs)+      _ -> error "switch: expected a match clause on a string literal or a wildcard"+    pure (cases, last)+  _ -> error "switch: expected a \"case _ of\" expression"++genSwitchTrie' :: Maybe Exp -> [(String, Exp)] -> Maybe Exp+              -> (Map (Maybe Int) Exp, Trie' (Rule, Int, Maybe Int))+genSwitchTrie' postAction cases fallback =++  let (!branches, !strings) = unzip do+        (!i, (!str, !rhs)) <- zip [0..] cases+        case postAction of+          Nothing    -> pure ((Just i, rhs), (i, str))+          Just !post -> pure ((Just i, (VarE '(>>)) `AppE` post `AppE` rhs), (i, str))++      !m    = M.fromList ((Nothing, maybe (VarE 'failed) id fallback) : branches)+      !trie = compileTrie strings+  in (m , trie)

@@ -0,0 +1,298 @@+{-# LANGUAGE UnboxedTuples #-}++-- | Parsers for textual data (UTF-8, ASCII).++module FlatParse.Basic.Text+  (+  -- * UTF-8+    char, string+  , anyChar, skipAnyChar+  , satisfy, skipSatisfy+  , fusedSatisfy, skipFusedSatisfy+  , takeLine+  , takeRestString++  -- * ASCII+  , anyAsciiChar, skipAnyAsciiChar+  , satisfyAscii, skipSatisfyAscii++  -- ** ASCII-encoded numbers+  , anyAsciiDecimalWord+  , anyAsciiDecimalInt+  , anyAsciiDecimalInteger+  , anyAsciiHexWord+  , anyAsciiHexInt++  -- * Debugging parsers+  , traceLine+  , traceRest+  ) where++import FlatParse.Basic.Parser+import FlatParse.Basic.Base ( withEnsure1, lookahead, eof, branch )+import FlatParse.Basic.Bytes ( bytes )++import FlatParse.Common.GHCExts++import Language.Haskell.TH+import qualified FlatParse.Common.Numbers as Common+import qualified FlatParse.Common.Assorted as Common++-- | Parse any single Unicode character encoded using UTF-8 as a 'Char'.+anyChar :: ParserT st e Char+anyChar = ParserT \fp eob buf st -> case eqAddr# eob buf of+  1# -> Fail# st+  _  -> case Common.derefChar8# buf of+    c1 -> case c1 `leChar#` '\x7F'# of+      1# -> OK# st (C# c1) (plusAddr# buf 1#)+      _  -> case eqAddr# eob (plusAddr# buf 1#) of+        1# -> Fail# st+        _ -> case indexCharOffAddr# buf 1# of+          c2 -> case c1 `leChar#` '\xDF'# of+            1# ->+              let resc = ((ord# c1 -# 0xC0#) `uncheckedIShiftL#` 6#) `orI#`+                          (ord# c2 -# 0x80#)+              in OK# st (C# (chr# resc)) (plusAddr# buf 2#)+            _ -> case eqAddr# eob (plusAddr# buf 2#) of+              1# -> Fail# st+              _  -> case indexCharOffAddr# buf 2# of+                c3 -> case c1 `leChar#` '\xEF'# of+                  1# ->+                    let resc = ((ord# c1 -# 0xE0#) `uncheckedIShiftL#` 12#) `orI#`+                               ((ord# c2 -# 0x80#) `uncheckedIShiftL#`  6#) `orI#`+                                (ord# c3 -# 0x80#)+                    in OK# st (C# (chr# resc)) (plusAddr# buf 3#)+                  _ -> case eqAddr# eob (plusAddr# buf 3#) of+                    1# -> Fail# st+                    _  -> case indexCharOffAddr# buf 3# of+                      c4 ->+                        let resc = ((ord# c1 -# 0xF0#) `uncheckedIShiftL#` 18#) `orI#`+                                   ((ord# c2 -# 0x80#) `uncheckedIShiftL#` 12#) `orI#`+                                   ((ord# c3 -# 0x80#) `uncheckedIShiftL#`  6#) `orI#`+                                    (ord# c4 -# 0x80#)+                        in OK# st (C# (chr# resc)) (plusAddr# buf 4#)+{-# inline anyChar #-}++-- | Skip any single Unicode character encoded using UTF-8.+skipAnyChar :: ParserT st e ()+skipAnyChar = ParserT \fp eob buf st -> case eqAddr# eob buf of+  1# -> Fail# st+  _  -> case Common.derefChar8# buf of+    c1 -> case c1 `leChar#` '\x7F'# of+      1# -> OK# st () (plusAddr# buf 1#)+      _  ->+        let buf' =+              case c1 `leChar#` '\xDF'# of+                1# -> plusAddr# buf 2#+                _  -> case c1 `leChar#` '\xEF'# of+                    1# -> plusAddr# buf 3#+                    _ ->  plusAddr# buf 4#+        in case leAddr# buf' eob of+             1# -> OK#   st () buf'+             _  -> Fail# st+{-# inline skipAnyChar #-}++withSatisfy+    :: (Char -> Bool) -> (Char -> ParserT st e r) -> ParserT st e r+withSatisfy f p = ParserT \fp eob s st ->+    case runParserT# anyChar fp eob s st of+      OK# st c s | f c -> runParserT# (p c) fp eob s st+      (# st, _ #)      -> Fail# st+{-# inline withSatisfy #-}++-- | Parse a UTF-8 'Char' for which a predicate holds.+satisfy :: (Char -> Bool) -> ParserT st e Char+satisfy f = withSatisfy f pure+{-# inline satisfy #-}++-- | Skip a UTF-8 `Char` for which a predicate holds.+skipSatisfy :: (Char -> Bool) -> ParserT st e ()+skipSatisfy f = withSatisfy f (\_ -> pure ())+{-# inline skipSatisfy #-}++withSatisfyAscii :: (Char -> Bool) -> (Char -> ParserT st e r) -> ParserT st e r+withSatisfyAscii f p = withEnsure1 $ ParserT \fp eob s st ->+    case Common.derefChar8# s of+      c1 | f (C# c1) -> runParserT# (p (C# c1)) fp eob (plusAddr# s 1#) st+         | otherwise -> Fail# st+{-# inline withSatisfyAscii #-}++-- | Parse an ASCII `Char` for which a predicate holds.+--+-- Assumption: the predicate must only return 'True' for ASCII-range characters.+-- Otherwise this function might read a 128-255 range byte, thereby breaking+-- UTF-8 decoding.+satisfyAscii :: (Char -> Bool) -> ParserT st e Char+satisfyAscii f = withSatisfyAscii f pure+{-# inline satisfyAscii #-}++-- | Skip an ASCII `Char` for which a predicate holds. Assumption: the predicate+--   must only return `True` for ASCII-range characters.+skipSatisfyAscii :: (Char -> Bool) -> ParserT st e ()+skipSatisfyAscii f = withSatisfyAscii f (\_ -> pure ())+{-# inline skipSatisfyAscii #-}++-- | This is a variant of `satisfy` which allows more optimization. We can pick four testing+--   functions for the four cases for the possible number of bytes in the UTF-8 character. So in+--   @fusedSatisfy f1 f2 f3 f4@, if we read a one-byte character, the result is scrutinized with+--   @f1@, for two-bytes, with @f2@, and so on. This can result in dramatic lexing speedups.+--+--   For example, if we want to accept any letter, the naive solution would be to use+--   `Data.Char.isLetter`, but this accesses a large lookup table of Unicode character classes. We+--   can do better with @fusedSatisfy isLatinLetter isLetter isLetter isLetter@, since here the+--   `isLatinLetter` is inlined into the UTF-8 decoding, and it probably handles a great majority of+--   all cases without accessing the character table.+fusedSatisfy :: (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> ParserT st e Char+fusedSatisfy f1 f2 f3 f4 = ParserT \fp eob buf st ->+    case eqAddr# eob buf of+      1# -> Fail# st+      _  -> case Common.derefChar8# buf of+        c1 -> case c1 `leChar#` '\x7F'# of+          1# | f1 (C# c1) -> OK#   st (C# c1) (plusAddr# buf 1#)+             | otherwise  -> Fail# st+          _  -> case eqAddr# eob (plusAddr# buf 1#) of+            1# -> Fail# st+            _ -> case indexCharOffAddr# buf 1# of+              c2 -> case c1 `leChar#` '\xDF'# of+                1# ->+                  let resc = C# (chr# (((ord# c1 -# 0xC0#) `uncheckedIShiftL#` 6#) `orI#`+                                       (ord# c2 -# 0x80#)))+                  in case f2 resc of+                       True -> OK#   st resc (plusAddr# buf 2#)+                       _    -> Fail# st+                _ -> case eqAddr# eob (plusAddr# buf 2#) of+                  1# -> Fail# st+                  _  -> case indexCharOffAddr# buf 2# of+                    c3 -> case c1 `leChar#` '\xEF'# of+                      1# ->+                        let resc = C# (chr# (((ord# c1 -# 0xE0#) `uncheckedIShiftL#` 12#) `orI#`+                                             ((ord# c2 -# 0x80#) `uncheckedIShiftL#`  6#) `orI#`+                                             (ord# c3 -# 0x80#)))+                        in case f3 resc of+                             True -> OK#   st resc (plusAddr# buf 3#)+                             _    -> Fail# st+                      _ -> case eqAddr# eob (plusAddr# buf 3#) of+                        1# -> Fail# st+                        _  -> case indexCharOffAddr# buf 3# of+                          c4 ->+                            let resc = C# (chr# (((ord# c1 -# 0xF0#) `uncheckedIShiftL#` 18#) `orI#`+                                                 ((ord# c2 -# 0x80#) `uncheckedIShiftL#` 12#) `orI#`+                                                 ((ord# c3 -# 0x80#) `uncheckedIShiftL#`  6#) `orI#`+                                                  (ord# c4 -# 0x80#)))+                            in case f4 resc of+                                 True -> OK#   st resc (plusAddr# buf 4#)+                                 _    -> Fail# st+{-# inline fusedSatisfy #-}++-- | Skipping variant of `fusedSatisfy`.+skipFusedSatisfy :: (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> Parser e ()+skipFusedSatisfy f1 f2 f3 f4 = () <$ fusedSatisfy f1 f2 f3 f4+{-# inline skipFusedSatisfy #-}++--------------------------------------------------------------------------------++-- | Parse a non-empty ASCII decimal digit sequence as a 'Word'.+--   Fails on overflow.+anyAsciiDecimalWord :: ParserT st e Word+anyAsciiDecimalWord = ParserT \fp eob s st ->+    case Common.anyAsciiDecimalWord# eob s of+      (# | (# w, s' #) #) -> OK#   st (W# w) s'+      (# (##) | #)        -> Fail# st+{-# inline anyAsciiDecimalWord #-}++-- | Parse a non-empty ASCII decimal digit sequence as a positive 'Int'.+--   Fails on overflow.+anyAsciiDecimalInt :: ParserT st e Int+anyAsciiDecimalInt = ParserT \fp eob s st ->+    case Common.anyAsciiDecimalInt# eob s of+      (# | (# n, s' #) #) -> OK#   st (I# n) s'+      (# (##) | #)        -> Fail# st+{-# inline anyAsciiDecimalInt #-}++-- | Parse a non-empty ASCII decimal digit sequence as a positive 'Integer'.+anyAsciiDecimalInteger :: ParserT st e Integer+anyAsciiDecimalInteger = ParserT \fp eob s st ->+    case Common.anyAsciiDecimalInteger# fp eob s of+      (# | (# i, s' #) #) -> OK#   st i s'+      (# (##) | #)        -> Fail# st+{-# inline anyAsciiDecimalInteger #-}++-- | Parse a non-empty, case-insensitive ASCII hexadecimal digit sequence as a+--   'Word'.+--   Fails on overflow.+anyAsciiHexWord :: ParserT st e Word+anyAsciiHexWord = ParserT \fp eob s st ->+    case Common.anyAsciiHexWord# eob s of+      (# | (# w, s' #) #) -> OK#   st (W# w) s'+      (# (##) | #)        -> Fail# st+{-# inline anyAsciiHexWord #-}++-- | Parse a non-empty, case-insensitive ASCII hexadecimal digit sequence as a+--   positive 'Int'.+--   Fails on overflow.+anyAsciiHexInt :: ParserT st e Int+anyAsciiHexInt = ParserT \fp eob s st ->+    case Common.anyAsciiHexInt# eob s of+      (# | (# n, s' #) #) -> OK#   st (I# n) s'+      (# (##) | #)        -> Fail# st+{-# inline anyAsciiHexInt #-}++--------------------------------------------------------------------------------++-- | Parse any single ASCII character (a single byte) as a 'Char'.+--+-- More efficient than 'anyChar' for ASCII-only input.+anyAsciiChar :: ParserT st e Char+anyAsciiChar = withEnsure1 $ ParserT \fp eob buf st ->+    case Common.derefChar8# buf of+      c1 -> case c1 `leChar#` '\x7F'# of+              1# -> OK#   st (C# c1) (plusAddr# buf 1#)+              _  -> Fail# st+{-# inline anyAsciiChar #-}++-- | Skip any single ASCII character (a single byte).+--+-- More efficient than 'skipAnyChar' for ASCII-only input.+skipAnyAsciiChar :: ParserT st e ()+skipAnyAsciiChar = () <$ anyAsciiChar+{-# inline skipAnyAsciiChar #-}++--------------------------------------------------------------------------------++-- | Parse a UTF-8 character literal. This is a template function, you can use it as+--   @$(char \'x\')@, for example, and the splice in this case has type @Parser e ()@.+char :: Char -> Q Exp+char c = string [c]++-- | Parse a UTF-8 string literal. This is a template function, you can use it as @$(string "foo")@,+--   for example, and the splice has type @Parser e ()@.+string :: String -> Q Exp+string str = bytes (Common.strToBytes str)++--------------------------------------------------------------------------------++-- | Parse the rest of the current line as a `String`. Assumes UTF-8 encoding,+--   throws an error if the encoding is invalid.+takeLine :: ParserT st e String+takeLine = branch eof (pure "") do+  c <- anyChar+  case c of+    '\n' -> pure ""+    _    -> (c:) <$> takeLine++-- | Parse the rest of the current line as a `String`, but restore the parsing state.+--   Assumes UTF-8 encoding. This can be used for debugging.+traceLine :: ParserT st e String+traceLine = lookahead takeLine++-- | Take the rest of the input as a `String`. Assumes UTF-8 encoding.+takeRestString :: ParserT st e String+takeRestString = branch eof (pure "") do+  c <- anyChar+  cs <- takeRestString+  pure (c:cs)++-- | Get the rest of the input as a `String`, but restore the parsing state. Assumes UTF-8 encoding.+--   This can be used for debugging.+traceRest :: ParserT st e String+traceRest = lookahead takeRestString

@@ -0,0 +1,168 @@+module FlatParse.Common.Assorted+  (+  -- * Compatibility+    shortInteger++  -- * 'Char' predicates+  , isDigit, isLatinLetter, isGreekLetter++  -- * Other+  , packBytes, splitBytes++  -- * UTF-8 conversions+  , charToBytes, strToBytes+  , strToUtf8, utf8ToStr++  -- * Shortcuts+  , derefChar8#++  -- * Boxed integer coercions+  -- $boxed-integer-coercion+  , word16ToInt16+  , word32ToInt32+  , word64ToInt64++  -- * Helpers+  , withPosInt#, withIntUnwrap#+  ) where++import Data.Bits+import Data.Char ( ord )+import Data.Foldable (foldl')+import GHC.Exts++import qualified Data.ByteString as B++import Data.Word+import Data.Int++#if MIN_VERSION_base(4,15,0)+import GHC.Num.Integer (Integer(..))+#else+import GHC.Integer.GMP.Internals (Integer(..))+#endif++import qualified Data.ByteString.UTF8 as UTF8+++-- Compatibility+--------------------------------------------------------------------------------++shortInteger :: Int# -> Integer+#if MIN_VERSION_base(4,15,0)+shortInteger = IS+#else+shortInteger = S#+#endif+{-# inline shortInteger #-}+++-- Char predicates+--------------------------------------------------------------------------------++-- | @isDigit c = \'0\' <= c && c <= \'9\'@+isDigit :: Char -> Bool+isDigit c = '0' <= c && c <= '9'+{-# inline isDigit #-}++-- | @isLatinLetter c = (\'A\' <= c && c <= \'Z\') || (\'a\' <= c && c <= \'z\')@+isLatinLetter :: Char -> Bool+isLatinLetter c = ('A' <= c && c <= 'Z') || ('a' <= c && c <= 'z')+{-# inline isLatinLetter #-}++-- | @isGreekLetter c = (\'Α\' <= c && c <= \'Ω\') || (\'α\' <= c && c <= \'ω\')@+isGreekLetter :: Char -> Bool+isGreekLetter c = ('Α' <= c && c <= 'Ω') || ('α' <= c && c <= 'ω')+{-# inline isGreekLetter #-}++-- UTF conversions+--------------------------------------------------------------------------------++packBytes :: [Word] -> Word+packBytes = fst . foldl' go (0, 0) where+  go (acc, shift) w | shift == 64 = error "packBytes: too many bytes"+  go (acc, shift) w = (unsafeShiftL (fromIntegral w) shift .|. acc, shift+8)++-- TODO chunks into 8-bytes for 64-bit performance+splitBytes :: [Word] -> ([Word], [Word])+splitBytes ws = case quotRem (length ws) 8 of+  (0, _) -> (ws, [])+  (_, r) -> (as, chunk8s bs) where+              (as, bs) = splitAt r ws+              chunk8s [] = []+              chunk8s ws = let (as, bs) = splitAt 8 ws in+                           packBytes as : chunk8s bs++-- | Shortcut for 'indexCharOffAddr# addr# 0#'.+derefChar8# :: Addr# -> Char#+derefChar8# addr# = indexCharOffAddr# addr# 0#+{-# inline derefChar8# #-}++--------------------------------------------------------------------------------++{- $boxed-integer-coercion++These functions should be no-ops. They correspond to the similarly-named GHC 9.4+primops which work on unboxed integers.+-}++-- | Coerce a 'Word16' to 'Int16'.+word16ToInt16 :: Word16 -> Int16+word16ToInt16 = fromIntegral+{-# inline word16ToInt16 #-}++-- | Coerce a 'Word32' to 'Int32'.+word32ToInt32 :: Word32 -> Int32+word32ToInt32 = fromIntegral+{-# inline word32ToInt32 #-}++-- | Coerce a 'Word64' to 'Int64'.+word64ToInt64 :: Word64 -> Int64+word64ToInt64 = fromIntegral+{-# inline word64ToInt64 #-}++--------------------------------------------------------------------------------++-- | Assert for the given 'Int#' that @n >= 0@.+--+-- Throws a runtime error if given a negative integer.+withPosInt# :: Int# -> r -> r+withPosInt# n# r = case n# >=# 0# of+  1# -> r+  _  -> error "FlatParse.Basic.Base.withPosInt#: negative integer"+{-# inline withPosInt# #-}++-- | Unwrap the 'Int#' from an 'Int' and apply it to the given function.+withIntUnwrap# :: (Int# -> r) -> Int -> r+withIntUnwrap# f (I# i#) = f i#+{-# inline withIntUnwrap# #-}++--------------------------------------------------------------------------------++charToBytes :: Char -> [Word]+charToBytes c'+    | c <= 0x7f     = [fromIntegral c]+    | c <= 0x7ff    = [0xc0 .|. y, 0x80 .|. z]+    | c <= 0xffff   = [0xe0 .|. x, 0x80 .|. y, 0x80 .|. z]+    | c <= 0x10ffff = [0xf0 .|. w, 0x80 .|. x, 0x80 .|. y, 0x80 .|. z]+    | otherwise = error "Not a valid Unicode code point"+  where+    c = ord c'+    z = fromIntegral (c                 .&. 0x3f)+    y = fromIntegral (unsafeShiftR c 6  .&. 0x3f)+    x = fromIntegral (unsafeShiftR c 12 .&. 0x3f)+    w = fromIntegral (unsafeShiftR c 18 .&. 0x7)++strToBytes :: String -> [Word]+strToBytes = concatMap charToBytes+{-# inline strToBytes #-}++-- | Convert an UTF8-encoded `String` to a `B.ByteString`.+strToUtf8 :: String -> B.ByteString+strToUtf8 = UTF8.fromString+{-# inline strToUtf8 #-}++-- | Convert a `B.ByteString` to an UTF8-encoded `String`.+utf8ToStr :: B.ByteString -> String+utf8ToStr = UTF8.toString+{-# inline utf8ToStr #-}

@@ -0,0 +1,23 @@+-- | 'GHC.Exts' compatibility wrapper.++{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DataKinds #-} -- needed for manual ZeroBitType def (unsure why)+{-# OPTIONS_GHC -Wno-dodgy-exports #-}++module FlatParse.Common.GHCExts+  ( module FlatParse.Common.GHCExts+  , module GHC.Exts+  ) where++import GHC.Exts++#if !MIN_VERSION_base(4,17,0)+{-+GHC 9.4 clarified the story for types without runtime representations. These+type synonyms are defined and used to simplify certain internal definitions+(e.g. 'State#'). They are nicer than using the "expanded" type, so we define+them here for older compilers.+-}+type ZeroBitRep = 'TupleRep ('[] :: [RuntimeRep])+type ZeroBitType = TYPE ZeroBitRep+#endif

@@ -0,0 +1,251 @@+{-# 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# eob s = case anyAsciiDecimalWord_# 0## eob s of+    (# | (# n, s' #) #) | 0# <- eqAddr# s s'+                        -> (# | (# n, s' #) #)+    _                   -> (# (# #) | #)+{-# inline anyAsciiDecimalWord# #-}++-- | Parse a non-empty ASCII decimal digit sequence as a positive 'Int'.+--   Fails on overflow.+anyAsciiDecimalInt# :: Addr# -> Addr# -> (# (##) | (# Int#, Addr# #) #)+anyAsciiDecimalInt# eob s = case anyAsciiDecimalWord_# 0## eob s of+    (# | (# n, s' #) #) | 0# <- eqAddr# s s'+                        , 1# <- leWord# n (int2Word# (unI# maxBound))+                        -> (# | (# word2Int# n, s' #) #)+    _                   -> (# (##) | #)+{-# inline anyAsciiDecimalInt# #-}++anyAsciiDecimalWord_# :: Word# -> Addr# -> Addr# -> (# (##) | (# Word#, Addr# #) #)+anyAsciiDecimalWord_# acc eob s = case eqAddr# s eob of+  1# -> (# | (# acc, s #) #)+  _  -> case indexWord8OffAddr# s 0# of+#if MIN_VERSION_base(4,16,0)+    w | 1# <- leWord8# (wordToWord8# 0x30##) w+      , 1# <- leWord8# w (wordToWord8# 0x39##)+      -> case timesWord2# acc 10## of+          (# 0##, r #) -> case addWordC# r (word8ToWord# w `minusWord#` 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+            (# q, 0# #) -> anyAsciiDecimalWord_# q eob (s `plusAddr#` 1#)+            _           -> (# (##) | #)+          _             -> (# (##) | #)+    _ -> (# | (# acc, s #) #)++--------------------------------------------------------------------------------++-- | Parse a non-empty ASCII decimal digit sequence as a positive 'Int'.+--   May overflow.+anyAsciiDecimalIntOverflow# :: Addr# -> Addr# -> (# (##) | (# Int#, Addr# #) #)+anyAsciiDecimalIntOverflow# eob s = case anyAsciiDecimalIntOverflow_# 0# eob s of+    (# n, s' #) | 0# <- eqAddr# s s'+                -> (# | (# n, s' #) #)++                | otherwise+                -> (# (##) | #)+{-# inline anyAsciiDecimalIntOverflow# #-}++-- | Parse a non-empty ASCII decimal digit sequence as a positive 'Integer'.+anyAsciiDecimalInteger# :: ForeignPtrContents -> Addr# -> Addr# -> (# (##) | (# Integer, Addr# #) #)+anyAsciiDecimalInteger# fp eob s = case anyAsciiDecimalIntOverflow_# 0# eob s of+  (# n, s' #)+    | 1# <- eqAddr# s s'            -> (# (##) | #)++    -- Simple heuristic, 18 digits correspond to somewhere between 2^59 and 2^60, which is+    -- well inside the 'IS' constructor.+    | 1# <- minusAddr# s' s <=# 18# -> (# | (# shortInteger n, s' #) #)+    | otherwise -> case BC8.readInteger (B.PS (ForeignPtr s fp) 0 (I# (minusAddr# s' s))) of+        Nothing     -> (# (##) | #)+        Just (i, _) -> (# | (# i, s' #) #)+{-# inline anyAsciiDecimalInteger# #-}++-- | Parse a non-empty ASCII decimal digit sequence as a positive 'Int'.+--   May overflow.+anyAsciiDecimalIntOverflow_# :: Int# -> Addr# -> Addr# -> (# Int#, Addr# #)+anyAsciiDecimalIntOverflow_# acc eob s = case eqAddr# s eob of+  1# -> (# acc, s #)+  _  -> case indexWord8OffAddr# s 0# of+#if MIN_VERSION_base(4,16,0)+    w | 1# <- leWord8# (wordToWord8# 0x30##) w, 1# <- leWord8# w (wordToWord8# 0x39##) ->+      anyAsciiDecimalIntOverflow_# (mul10# acc +# (word2Int# (word8ToWord# w) -# 0x30#)) eob (plusAddr# s 1#)+#else+    w | 1# <- leWord# 0x30## w, 1# <- leWord# w 0x39## ->+      anyAsciiDecimalIntOverflow_# (mul10# acc +# (word2Int# w -# 0x30#)) eob (plusAddr# s 1#)+#endif+    _ -> (# acc, s #)++--------------------------------------------------------------------------------++-- | Parse a non-empty, case-insensitive ASCII hexadecimal digit sequence as a+--   'Word'.+--   Fails on overflow.+anyAsciiHexWord# :: Addr# -> Addr# -> (# (##) | (# Word#, Addr# #) #)+anyAsciiHexWord# eob s = case anyAsciiHexWord_# 0## eob s of+    (# | (# n, s' #) #) | 0# <- eqAddr# s s'+                        -> (# | (# n, s' #) #)+    _                   -> (# (# #) | #)+{-# 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# eob s = case anyAsciiHexWord_# 0## eob s of+    (# | (# n, s' #) #) | 0# <- eqAddr# s s'+                        , 1# <- leWord# n (int2Word# (unI# maxBound))+                        -> (# | (# word2Int# n, s' #) #)++                        | otherwise+                        -> (# (##) | #)+    (# (##) | #)        -> (# (##) | #)+{-# inline anyAsciiHexInt# #-}++anyAsciiHexWord_# :: Word# -> Addr# -> Addr# -> (# (##) | (# Word#, Addr# #) #)+anyAsciiHexWord_# acc eob s = case eqAddr# s eob of+  1# -> (# | (# acc, s #) #)+  _  -> case indexWord8OffAddr# s 0# of+#if MIN_VERSION_base(4,16,0)+    w | 1# <- leWord8# (wordToWord8# 0x30##) w+      , 1# <- leWord8# w (wordToWord8# 0x39##)+      -> case timesWord2# acc 16## of+          (# 0##, r #) -> case addWordC# r (word8ToWord# w `minusWord#` 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+            (# q, 0# #) -> anyAsciiHexWord_# q eob (s `plusAddr#` 1#)+            _           -> (# (##) | #)+          _             -> (# (##) | #)+#if MIN_VERSION_base(4,16,0)+      | 1# <- leWord8# (wordToWord8# 0x41##) w+      , 1# <- leWord8# w (wordToWord8# 0x46##)+      -> case timesWord2# acc 16## of+          (# 0##, r #) -> case addWordC# r (word8ToWord# w `minusWord#` 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+            (# q, 0# #) -> anyAsciiHexWord_# q eob (s `plusAddr#` 1#)+            _           -> (# (##) | #)+          _             -> (# (##) | #)+#if MIN_VERSION_base(4,16,0)+      | 1# <- leWord8# (wordToWord8# 0x61##) w+      , 1# <- leWord8# w (wordToWord8# 0x66##)+      -> case timesWord2# acc 16## of++          (# 0##, r #) -> case addWordC# r (word8ToWord# w `minusWord#` 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+            (# q, 0# #) -> anyAsciiHexWord_# q eob (s `plusAddr#` 1#)+            _           -> (# (##) | #)+          _             -> (# (##) | #)+    _ -> (# | (# acc, s #) #)++--------------------------------------------------------------------------------+-- Zigzag encoding+-- See: https://hackage.haskell.org/package/zigzag-0.0.1.0/docs/src/Data.Word.Zigzag.html++fromZigzagNative :: Word -> Int+fromZigzagNative (W# w#) = I# (fromZigzagNative# w#)+{-# inline fromZigzagNative #-}++-- GHC should optimize to this, but to be sure, here it is+fromZigzagNative# :: Word# -> Int#+fromZigzagNative# w# =+    word2Int# ((w# `uncheckedShiftRL#` 1#) `xor#` (not# (w# `and#` 1##) `plusWord#` 1##))+{-# inline fromZigzagNative# #-}++toZigzagNative :: Int -> Word+toZigzagNative (I# i#) = W# (toZigzagNative# i#)+{-# inline toZigzagNative #-}++-- GHC should optimize to this, but to be sure, here it is+toZigzagNative# :: Int# -> Word#+toZigzagNative# i# = toZigzagNative'# (int2Word# i#)+{-# inline toZigzagNative# #-}++-- GHC should optimize to this, but to be sure, here it is+toZigzagNative'# :: Word# -> Word#+toZigzagNative'# w# =+    (w# `uncheckedShiftL#` 1#) `xor#` (w# `uncheckedShiftRL#` 63#)+{-# inline toZigzagNative'# #-}++--------------------------------------------------------------------------------++-- | protobuf style (LE, redundant, on continues)+anyVarintProtobuf# :: Addr# -> Addr# -> (# (##) | (# Int#, Addr#, Int# #) #)++#if MIN_VERSION_base(4,16,0)++anyVarintProtobuf# end# = go 0# 0#+  where+    word8ToInt# :: Word8# -> Int#+    word8ToInt# w8# = word2Int# (word8ToWord# w8#)+    {-# inline word8ToInt# #-}+    go :: Int# -> Int# -> Addr# -> (# (##) | (# Int#, Addr#, Int# #) #)+    go i# n# s# = case eqAddr# s# end# of+      1# -> (# (##) | #)+      _  ->+        let w8# = indexWord8OffAddr# s# 0#+            w8'# = word8ToInt# (w8# `andWord8#` (wordToWord8# 0b01111111##))+            i'# = i# `orI#` (w8'# `uncheckedIShiftL#` n#)+            s'# = s# `plusAddr#` 1#+            n'# = n# +# 7#+        in  case w8# `geWord8#` wordToWord8# 0b10000000## of+              1# -> go i'# n'# s'#+              _  -> (# | (# i'#, s'#, 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# (I# i) = i+{-# inline unI# #-}++mul10# :: Int# -> Int#+mul10# n = uncheckedIShiftL# n 3# +# uncheckedIShiftL# n 1#+{-# inline mul10# #-}

@@ -0,0 +1,24 @@+-- | Common low-level parser definitions.++module FlatParse.Common.Parser+  (+  -- * Parser state token types+  -- $parser-state-token-types+    type PureMode+  , type IOMode+  , type STMode+  ) where++import GHC.Exts+import Data.Void ( Void )++{- $parser-state-token-types+These type synonyms are used as parameters to @ParserT@. Different state tokens+support different embedded effects.+-}++-- TODO 2023-01-17 raehik: perhaps more/better explanation?++type PureMode = Proxy# Void+type IOMode   = State# RealWorld+type STMode s = State# s

@@ -0,0 +1,48 @@+{-# LANGUAGE DerivingStrategies, DerivingVia #-}++module FlatParse.Common.Position+  ( Pos(..), endPos, addrToPos#, posToAddr#+  , Span(..), unsafeSlice+  ) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as B+import GHC.Int+import GHC.ForeignPtr ( ForeignPtr(..) )+import GHC.Exts++-- | Byte offset counted backwards from the end of the buffer.+newtype Pos = Pos { unPos :: Int }+    deriving stock (Show)+    deriving (Eq, Ord) via Int++-- | A pair of positions.+data Span = Span !Pos !Pos+    deriving stock (Eq, Show)++-- | Very unsafe conversion between a primitive address and a position.  The+--   first argument points to the end of the buffer, the second argument is+--   being converted.+addrToPos# :: Addr# -> Addr# -> Pos+addrToPos# eob s = Pos (I# (minusAddr# eob s))+{-# inline addrToPos# #-}++-- | Very unsafe conversion between a primitive address and a position.  The+--   first argument points to the end of the buffer.+posToAddr# :: Addr# -> Pos -> Addr#+posToAddr# eob (Pos (I# n)) = unsafeCoerce# (minusAddr# eob (unsafeCoerce# n))+{-# inline posToAddr# #-}++-- | Slice into a `B.ByteString` using a `Span`. The result is invalid if the `Span`+--   is not a valid slice of the first argument.+unsafeSlice :: B.ByteString -> Span -> B.ByteString+unsafeSlice (B.PS (ForeignPtr addr fp) (I# start) (I# len))+            (Span (Pos (I# o1)) (Pos (I# o2))) =+  let end = addr `plusAddr#` start `plusAddr#` len+  in B.PS (ForeignPtr (plusAddr# end (negateInt# o1)) fp) (I# 0#) (I# (o1 -# o2))+{-# inline unsafeSlice #-}++-- | The end of the input.+endPos :: Pos+endPos = Pos 0+{-# inline endPos #-}

@@ -0,0 +1,69 @@+module FlatParse.Common.Strings where++import Data.Bits+import Data.Foldable (foldl')++import Data.Word+import Data.Int++import qualified Data.Char++-- | @isDigit c = \'0\' <= c && c <= \'9\'@+-- TODO exists in Data.Char, but maybe loses inlining+isDigit :: Char -> Bool+--isDigit c = '0' <= c && c <= '9'+isDigit = Data.Char.isDigit+{-# inline isDigit #-}++-- | @isAsciiLetter c = (\'A\' <= c && c <= \'Z\') || (\'a\' <= c && c <= \'z\')@+-- TODO exists in Data.Char, but maybe loses inlining+isAsciiLetter :: Char -> Bool+--isAsciiLetter c = ('A' <= c && c <= 'Z') || ('a' <= c && c <= 'z')+isAsciiLetter c = Data.Char.isAsciiUpper c || Data.Char.isAsciiLower c+{-# inline isAsciiLetter #-}++-- | @isGreekLetter c = (\'Α\' <= c && c <= \'Ω\') || (\'α\' <= c && c <= \'ω\')@+isGreekLetter :: Char -> Bool+isGreekLetter c = ('Α' <= c && c <= 'Ω') || ('α' <= c && c <= 'ω')+{-# inline isGreekLetter #-}++-- UTF conversions+--------------------------------------------------------------------------------++packBytes :: [Word] -> Word+packBytes = fst . foldl' go (0, 0) where+  go (acc, shift) w | shift == 64 = error "packWords: too many bytes"+  go (acc, shift) w = (unsafeShiftL (fromIntegral w) shift .|. acc, shift+8)++-- TODO chunks into 8-bytes for 64-bit performance+splitBytes :: [Word] -> ([Word], [Word])+splitBytes ws = case quotRem (length ws) 8 of+  (0, _) -> (ws, [])+  (_, r) -> (as, chunk8s bs) where+              (as, bs) = splitAt r ws+              chunk8s [] = []+              chunk8s ws = let (as, bs) = splitAt 8 ws in+                           packBytes as : chunk8s bs++--------------------------------------------------------------------------------++{- $boxed-integer-coercion++These functions should be no-ops. They correspond to the similarly-named GHC 9.4+primops which work on unboxed integers.+-}++-- | Coerce a 'Word16' to 'Int16'.+word16ToInt16 :: Word16 -> Int16+word16ToInt16 = fromIntegral+{-# inline word16ToInt16 #-}++-- | Coerce a 'Word32' to 'Int32'.+word32ToInt32 :: Word32 -> Int32+word32ToInt32 = fromIntegral+{-# inline word32ToInt32 #-}++-- | Coerce a 'Word64' to 'Int64'.+word64ToInt64 :: Word64 -> Int64+word64ToInt64 = fromIntegral+{-# inline word64ToInt64 #-}

@@ -0,0 +1,89 @@+module FlatParse.Common.Switch where++import Data.Foldable (foldl')+import Data.Map (Map)++import qualified Data.Map.Strict as M++import FlatParse.Common.Assorted++-- Switch trie compilation+--------------------------------------------------------------------------------++data Trie a = Branch !a !(Map Word (Trie a))+  deriving Show++type Rule = Maybe Int++nilTrie :: Trie Rule+nilTrie = Branch Nothing mempty++updRule :: Int -> Maybe Int -> Maybe Int+updRule rule = Just . maybe rule (min rule)++insert :: Int -> [Word] -> Trie Rule -> Trie Rule+insert rule = go where+  go [] (Branch rule' ts) =+    Branch (updRule rule rule') ts+  go (c:cs) (Branch rule' ts) =+    Branch rule' (M.alter (Just . maybe (go cs nilTrie) (go cs)) c ts)++listToTrie :: [(Int, String)] -> Trie Rule+listToTrie = foldl' (\t (!r, !s) -> insert r (charToBytes =<< s) t) nilTrie++-- | Decorate a trie with the minimum lengths of non-empty paths. This+--   is used later to place `ensureBytes#`.+mindepths :: Trie Rule -> Trie (Rule, Int)+mindepths (Branch rule ts) =+  if M.null ts then+    Branch (rule, 0) mempty+  else+    let !ts' = M.map mindepths ts in+    Branch (+      rule,+      minimum (M.map (\(Branch (rule,d) _) -> maybe (d + 1) (\_ -> 1) rule) ts'))+      ts'++data Trie' a+  = Branch' !a !(Map Word (Trie' a))+  | Path !a ![Word] !(Trie' a)+  deriving Show++-- | Compress linear paths.+pathify :: Trie (Rule, Int) -> Trie' (Rule, Int)+pathify (Branch a ts) = case M.toList ts of+  [] -> Branch' a mempty+  [(w, t)] -> case pathify t of+           Path (Nothing, _) ws t -> Path a (w:ws) t+           t                      -> Path a [w] t+  _   -> Branch' a (M.map pathify ts)++-- | Compute where to fall back after we exhausted a branch. If the branch is+--   empty, that means we've succeded at reading and we jump to the rhs rule.+fallbacks :: Trie' (Rule, Int) -> Trie' (Rule, Int, Int)+fallbacks = go Nothing 0  where+  go :: Rule -> Int -> Trie' (Rule, Int) -> Trie' (Rule, Int, Int)+  go !rule !n (Branch' (rule', d) ts)+    | M.null ts        = Branch' (rule', 0, d) mempty+    | Nothing <- rule' = Branch' (rule, n, d) (go rule (n + 1) <$> ts)+    | otherwise        = Branch' (rule', 0, d) (go rule' 1     <$> ts)+  go rule n (Path (rule', d) ws t)+    | Nothing <- rule' = Path (rule, n, d)  ws (go rule (n + length ws) t)+    | otherwise        = Path (rule', 0, d) ws (go rule' (length ws) t)++-- | Decorate with `ensureBytes#` invocations, represented as+--   `Maybe Int`.+ensureBytes :: Trie' (Rule, Int, Int) -> Trie' (Rule, Int, Maybe Int)+ensureBytes = go 0 where+  go :: Int -> Trie' (Rule, Int, Int) -> Trie' (Rule, Int, Maybe Int)+  go !res = \case+    Branch' (r, n, d) ts+      | M.null ts -> Branch' (r, n, Nothing) mempty+      | res < 1   -> Branch' (r, n, Just d ) (go (d   - 1) <$> ts)+      | otherwise -> Branch' (r, n, Nothing) (go (res - 1) <$> ts)+    Path (r, n, d) ws t -> case length ws of+      l | res < l   -> Path (r, n, Just $! d - res) ws (go (d - l)   t)+        | otherwise -> Path (r, n, Nothing        ) ws (go (res - l) t)++compileTrie :: [(Int, String)] -> Trie' (Rule, Int, Maybe Int)+compileTrie = ensureBytes . fallbacks . pathify . mindepths . listToTrie

@@ -9,6 +9,7 @@ module FlatParse.Examples.BasicLambda.Lexer where  import FlatParse.Basic hiding (Parser, runParser, string, char, cut)+import FlatParse.Common.Strings  import qualified FlatParse.Basic as FP import qualified Data.ByteString as B@@ -17,6 +18,8 @@ import Data.String import qualified Data.Set as S +import qualified Data.ByteString.UTF8 as UTF8+ --------------------------------------------------------------------------------  -- | An expected item which is displayed in error messages.@@ -64,8 +67,8 @@   let pos :: Pos       pos      = case e of Imprecise pos e -> pos                            Precise pos e   -> pos-      ls       = FP.lines b-      (l, c)   = head $ posLineCols b [pos]+      ls       = FP.linesUtf8 b+      (l, c)   = head $ FP.posLineCols b [pos]       line     = if l < length ls then ls !! l else ""       linum    = show l       lpad     = map (const ' ') linum@@ -108,7 +111,7 @@  -- | Run parser, print pretty error on failure. testParser :: Show a => Parser a -> String -> IO ()-testParser p str = case packUTF8 str of+testParser p str = case UTF8.fromString str of   b -> case runParser p b of     Err e  -> putStrLn $ prettyError b e     OK a _ -> print a@@ -149,12 +152,12 @@  -- | Read a starting character of an identifier. identStartChar :: Parser Char-identStartChar = satisfyASCII isLatinLetter+identStartChar = satisfyAscii isAsciiLetter {-# inline identStartChar #-}  -- | Read a non-starting character of an identifier. identChar :: Parser Char-identChar = satisfyASCII (\c -> isLatinLetter c || isDigit c)+identChar = satisfyAscii (\c -> isAsciiLetter c || isDigit c) {-# inline identChar #-}  -- | Check whether a `Span` contains exactly a keyword. Does not change parsing state.

@@ -12,6 +12,7 @@ import qualified Data.ByteString as B  import FlatParse.Basic hiding (Parser, runParser, string, char, cut)+import FlatParse.Common.Strings import FlatParse.Examples.BasicLambda.Lexer  --------------------------------------------------------------------------------@@ -49,14 +50,14 @@ --   keyword. ident :: Parser Name ident = token $ byteStringOf $-  withSpan (identStartChar *> many_ identChar) (\_ span -> fails (isKeyword span))+  withSpan (identStartChar *> skipMany identChar) (\_ span -> fails (isKeyword span))  -- | Parse an identifier, throw a precise error on failure. ident' :: Parser Name ident' = ident `cut'` (Msg "identifier")  digit :: Parser Int-digit = (\c -> ord c - ord '0') <$> satisfyASCII isDigit+digit = (\c -> ord c - ord '0') <$> satisfyAscii isDigit  int :: Parser Int int = token do

@@ -1,252 +0,0 @@-{-# language UnboxedTuples #-}--module FlatParse.Internal where--import FlatParse.Internal.UnboxedNumerics--import Data.Bits-import Data.Char-import Data.Foldable (foldl')-import Data.Map (Map)-import GHC.Exts-import GHC.ForeignPtr--import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as BC8-import qualified Data.ByteString.Internal as B-import qualified Data.Map.Strict as M--#if MIN_VERSION_base(4,15,0)-import GHC.Num.Integer (Integer(..))-#else-import GHC.Integer.GMP.Internals (Integer(..))-#endif---- Compatibility-----------------------------------------------------------------------------------shortInteger :: Int# -> Integer-#if MIN_VERSION_base(4,15,0)-shortInteger = IS-#else-shortInteger = S#-#endif-{-# inline shortInteger #-}----- Char predicates------------------------------------------------------------------------------------- | @isDigit c = \'0\' <= c && c <= \'9\'@-isDigit :: Char -> Bool-isDigit c = '0' <= c && c <= '9'-{-# inline isDigit #-}---- | @isLatinLetter c = (\'A\' <= c && c <= \'Z\') || (\'a\' <= c && c <= \'z\')@-isLatinLetter :: Char -> Bool-isLatinLetter c = ('A' <= c && c <= 'Z') || ('a' <= c && c <= 'z')-{-# inline isLatinLetter #-}---- | @isGreekLetter c = (\'Α\' <= c && c <= \'Ω\') || (\'α\' <= c && c <= \'ω\')@-isGreekLetter :: Char -> Bool-isGreekLetter c = ('Α' <= c && c <= 'Ω') || ('α' <= c && c <= 'ω')-{-# inline isGreekLetter #-}---- Int(eger) reading-----------------------------------------------------------------------------------mul10 :: Int# -> Int#-mul10 n = uncheckedIShiftL# n 3# +# uncheckedIShiftL# n 1#-{-# inline mul10 #-}--readInt' :: Int# -> Addr# -> Addr# -> (# Int#, Addr# #)-readInt' acc s end = case eqAddr# s end of-  1# -> (# acc, s #)-  _  -> case indexWord8OffAddr''# s 0# of-    w | 1# <- leWord8# (wordToWord8''# 0x30##) w, 1# <- leWord8# w (wordToWord8''# 0x39##) ->-      readInt' (mul10 acc +# (word2Int# (word8ToWord''# w) -# 0x30#)) (plusAddr# s 1#) end-    _ -> (# acc, 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 eob s = case readInt' 0# s eob of-  (# n, s' #) | 1# <- eqAddr# s s' -> (# (##) | #)-              | otherwise          -> (# | (# n, s' #) #)-{-# inline readInt #-}---- | Read an `Integer` from the input, as a non-empty digit sequence.-readInteger :: ForeignPtrContents -> Addr# -> Addr# -> (# (##) | (# Integer, Addr# #) #)-readInteger fp eob s = case readInt' 0# s eob of-  (# n, s' #)-    | 1# <- eqAddr# s s'            -> (# (##) | #)-    | 1# <- minusAddr# s' s <=# 18# -> (# | (# shortInteger n, s' #) #)-    | otherwise -> case BC8.readInteger (B.PS (ForeignPtr s fp) 0 (I# (minusAddr# s' s))) of-        Nothing     -> (# (##) | #)-        Just (i, _) -> (# | (# i, s' #) #)-{-# inline readInteger #-}----- Positions and spans------------------------------------------------------------------------------------- | Byte offset counted backwards from the end of the buffer.-newtype Pos = Pos Int deriving (Eq, Show)---- | A pair of positions.-data Span = Span !Pos !Pos deriving (Eq, Show)--instance Ord Pos where-  Pos p <= Pos p' = p' <= p-  Pos p <  Pos p' = p' <  p-  Pos p >  Pos p' = p' >  p-  Pos p >= Pos p' = p' >= p-  {-# inline (<=) #-}-  {-# inline (<) #-}-  {-# inline (>) #-}-  {-# inline (>=) #-}--addrToPos# :: Addr# -> Addr# -> Pos-addrToPos# eob s = Pos (I# (minusAddr# eob s))-{-# inline addrToPos# #-}--posToAddr# :: Addr# -> Pos -> Addr#-posToAddr# eob (Pos (I# n)) = unsafeCoerce# (minusAddr# eob (unsafeCoerce# n))-{-# inline posToAddr# #-}---- | Slice into a `B.ByteString` using a `Span`. The result is invalid if the `Span`---   is not a valid slice of the first argument.-unsafeSlice :: B.ByteString -> Span -> B.ByteString-unsafeSlice (B.PS (ForeignPtr addr fp) (I# start) (I# len))-            (Span (Pos (I# o1)) (Pos (I# o2))) =-  let end = addr `plusAddr#` start `plusAddr#` len-  in B.PS (ForeignPtr (plusAddr# end (negateInt# o1)) fp) (I# 0#) (I# (o1 -# o2))-{-# inline unsafeSlice #-}---- UTF conversions------------------------------------------------------------------------------------- | Convert a `String` to an UTF-8-coded `B.ByteString`.-packUTF8 :: String -> B.ByteString-packUTF8 str = B.pack $ do-  c <- str-  w <- charToBytes c-  pure (fromIntegral w)--charToBytes :: Char -> [Word]-charToBytes c'-    | c <= 0x7f     = [fromIntegral c]-    | c <= 0x7ff    = [0xc0 .|. y, 0x80 .|. z]-    | c <= 0xffff   = [0xe0 .|. x, 0x80 .|. y, 0x80 .|. z]-    | c <= 0x10ffff = [0xf0 .|. w, 0x80 .|. x, 0x80 .|. y, 0x80 .|. z]-    | otherwise = error "Not a valid Unicode code point"-  where-    c = ord c'-    z = fromIntegral (c                 .&. 0x3f)-    y = fromIntegral (unsafeShiftR c 6  .&. 0x3f)-    x = fromIntegral (unsafeShiftR c 12 .&. 0x3f)-    w = fromIntegral (unsafeShiftR c 18 .&. 0x7)--strToBytes :: String -> [Word]-strToBytes = concatMap charToBytes-{-# inline strToBytes #-}--packBytes :: [Word] -> Word-packBytes = fst . foldl' go (0, 0) where-  go (acc, shift) w | shift == 64 = error "packWords: too many bytes"-  go (acc, shift) w = (unsafeShiftL (fromIntegral w) shift .|. acc, shift+8)--splitBytes :: [Word] -> ([Word], [Word])-splitBytes ws = case quotRem (length ws) 8 of-  (0, _) -> (ws, [])-  (_, r) -> (as, chunk8s bs) where-              (as, bs) = splitAt r ws-              chunk8s [] = []-              chunk8s ws = let (as, bs) = splitAt 8 ws in-                           packBytes as : chunk8s bs--derefChar8# :: Addr# -> Char#-derefChar8# addr = indexCharOffAddr# addr 0#-{-# inline derefChar8# #-}---- Switch trie compilation-----------------------------------------------------------------------------------data Trie a = Branch !a !(Map Word (Trie a))-  deriving Show--type Rule = Maybe Int--nilTrie :: Trie Rule-nilTrie = Branch Nothing mempty--updRule :: Int -> Maybe Int -> Maybe Int-updRule rule = Just . maybe rule (min rule)--insert :: Int -> [Word] -> Trie Rule -> Trie Rule-insert rule = go where-  go [] (Branch rule' ts) =-    Branch (updRule rule rule') ts-  go (c:cs) (Branch rule' ts) =-    Branch rule' (M.alter (Just . maybe (go cs nilTrie) (go cs)) c ts)--listToTrie :: [(Int, String)] -> Trie Rule-listToTrie = foldl' (\t (!r, !s) -> insert r (charToBytes =<< s) t) nilTrie---- | Decorate a trie with the minimum lengths of non-empty paths. This---   is used later to place `ensureBytes#`.-mindepths :: Trie Rule -> Trie (Rule, Int)-mindepths (Branch rule ts) =-  if M.null ts then-    Branch (rule, 0) mempty-  else-    let !ts' = M.map mindepths ts in-    Branch (-      rule,-      minimum (M.map (\(Branch (rule,d) _) -> maybe (d + 1) (\_ -> 1) rule) ts'))-      ts'--data Trie' a-  = Branch' !a !(Map Word (Trie' a))-  | Path !a ![Word] !(Trie' a)-  deriving Show---- | Compress linear paths.-pathify :: Trie (Rule, Int) -> Trie' (Rule, Int)-pathify (Branch a ts) = case M.toList ts of-  [] -> Branch' a mempty-  [(w, t)] -> case pathify t of-           Path (Nothing, _) ws t -> Path a (w:ws) t-           t                      -> Path a [w] t-  _   -> Branch' a (M.map pathify ts)---- | Compute where to fall back after we exhausted a branch. If the branch is---   empty, that means we've succeded at reading and we jump to the rhs rule.-fallbacks :: Trie' (Rule, Int) -> Trie' (Rule, Int, Int)-fallbacks = go Nothing 0  where-  go :: Rule -> Int -> Trie' (Rule, Int) -> Trie' (Rule, Int, Int)-  go !rule !n (Branch' (rule', d) ts)-    | M.null ts        = Branch' (rule', 0, d) mempty-    | Nothing <- rule' = Branch' (rule, n, d) (go rule (n + 1) <$> ts)-    | otherwise        = Branch' (rule', 0, d) (go rule' 1     <$> ts)-  go rule n (Path (rule', d) ws t)-    | Nothing <- rule' = Path (rule, n, d)  ws (go rule (n + length ws) t)-    | otherwise        = Path (rule', 0, d) ws (go rule' (length ws) t)---- | Decorate with `ensureBytes#` invocations, represented as---   `Maybe Int`.-ensureBytes :: Trie' (Rule, Int, Int) -> Trie' (Rule, Int, Maybe Int)-ensureBytes = go 0 where-  go :: Int -> Trie' (Rule, Int, Int) -> Trie' (Rule, Int, Maybe Int)-  go !res = \case-    Branch' (r, n, d) ts-      | M.null ts -> Branch' (r, n, Nothing) mempty-      | res < 1   -> Branch' (r, n, Just d ) (go (d   - 1) <$> ts)-      | otherwise -> Branch' (r, n, Nothing) (go (res - 1) <$> ts)-    Path (r, n, d) ws t -> case length ws of-      l | res < l   -> Path (r, n, Just $! d - res) ws (go (d - l)   t)-        | otherwise -> Path (r, n, Nothing        ) ws (go (res - l) t)--compileTrie :: [(Int, String)] -> Trie' (Rule, Int, Maybe Int)-compileTrie = ensureBytes . fallbacks . pathify . mindepths . listToTrie

@@ -1,115 +0,0 @@-{- | Compatibility layer for numeric primops.--GHC 9.2 standardized unboxed numeric primops. Prior, it was quite asymmetric.-Many primop functions used the native unboxed numerics 'Word#' and 'Int#' even-if a sized unboxed numeric was in the name, e.g. 'indexWord8OffAddr#' returning-'Word#' pre-9.2. All boxed machine integers only stored 'Word#' internally!--We target GHC 9.2's better handling. In order to maintain compatibility with-older GHCs, we define missing primops and wrap ones that changed type. Usually,-we can write a few wrappers so that 9.2 uses sized unboxed numerics everywhere,-and pre-9.2 uses native unboxed numerics everywhere. Sometimes we really want to-work with sized unboxed numerics on both, in which case we have to do more-involved primop wrapping.--The general pattern is as follows:--  * A ticked primop means it's sized on >=9.2, native on <9.2-  * A double-ticked primop means it's sized on all-  * An unticked primop should mean the same as a ticked primop (no guarantees)--Also see: https://gitlab.haskell.org/ghc/ghc/-/wikis/Unboxed-Numerics--}--module FlatParse.Internal.UnboxedNumerics where--import GHC.Exts---- "Switch" wrappers: sized on >=9.2, native on <9.2-byteSwap16'# :: Word16'# -> Word16'#-byteSwap32'# :: Word32'# -> Word32'#-eqWord8'# :: Word8'# -> Word8'# -> Int#-eqWord16'# :: Word16'# -> Word16'# -> Int#-eqWord32'# :: Word32'# -> Word32'# -> Int#-{-# inline byteSwap16'# #-}-{-# inline byteSwap32'# #-}-{-# inline eqWord8'#    #-}-{-# inline eqWord16'#   #-}-{-# inline eqWord32'#   #-}---- "Sized" wrappers: sized on all-indexWord8OffAddr''# :: Addr# -> Int# -> Word8#-wordToWord8''# :: Word# -> Word8#-word8ToWord''# :: Word8# -> Word#-{-# inline indexWord8OffAddr''#  #-}-{-# inline wordToWord8''# #-}-{-# inline word8ToWord''# #-}--#if MIN_VERSION_base(4,16,0)--- GHC >=9.2--type Word8'#  = Word8#-type Word16'# = Word16#-type Word32'# = Word32#-type Int8'#   = Int8#-type Int16'#  = Int16#-type Int32'#  = Int32#---- "Switch" wrappers: sized on >=9.2, native on <9.2-byteSwap16'# w# = wordToWord16# (byteSwap16# (word16ToWord# w#))-byteSwap32'# w# = wordToWord32# (byteSwap32# (word32ToWord# w#))-eqWord8'# = eqWord8#-eqWord16'# = eqWord16#-eqWord32'# = eqWord32#---- "Sized" wrappers: sized on all-indexWord8OffAddr''# = indexWord8OffAddr#-wordToWord8''# = wordToWord8#-word8ToWord''# = word8ToWord#--#else--- GHC <9.2--type Word8'#  = Word#-type Word16'# = Word#-type Word32'# = Word#-type Int8'#   = Int#-type Int16'#  = Int#-type Int32'#  = Int#---- "Switch" wrappers: sized on >=9.2, native on <9.2-byteSwap16'# = byteSwap16#-byteSwap32'# = byteSwap32#-eqWord8'# = eqWord#-eqWord16'# = eqWord#-eqWord32'# = eqWord#---- No need to tick wrap these, they didn't exist <9.2-word16ToInt16# :: Word16'# -> Int#-word16ToInt16# w = narrow16Int# (word2Int# w)-word32ToInt32# :: Word32'# -> Int#-word32ToInt32# w = narrow32Int# (word2Int# w)-{-# inline word16ToInt16# #-}-{-# inline word32ToInt32# #-}---- "Sized" wrappers: sized on all-indexWord8OffAddr''# a# i# = narrowWord8# (indexWord8OffAddr# a# i#)-wordToWord8''# = narrowWord8#-word8ToWord''# = extendWord8#--#endif--#if !MIN_VERSION_base(4,13,0)--- GHC <8.8--type Word8# = Word#-narrowWord8# :: Word# -> Word8#-narrowWord8# = narrow8Word#-extendWord8# :: Word# -> Word8#-extendWord8# w# = w#-leWord8# :: Word8# -> Word8# -> Int#-leWord8# w1# w2# = leWord# w1# w2#-eqWord8# :: Word8# -> Word8# -> Int#-eqWord8# w1# w2# = eqWord# w1# w2#--#endif

@@ -1,1269 +1,483 @@-{-# language UnboxedTuples #-}--{-|-This module implements a `Parser` supporting a custom reader environment, custom-error types and an `Int` state.--}--module FlatParse.Stateful (-  -- * Parser types and constructors-    type Parser(..)-  , type Res#-  , pattern OK#-  , pattern Fail#-  , pattern Err#-  , Result(..)--  -- * Running parsers-  , runParser-  , runParserS--  -- * Actions on the state and the environment-  , get-  , put-  , modify-  , ask-  , local--  -- * Errors and failures-  , empty-  , err-  , lookahead-  , fails-  , try-  , optional-  , optional_-  , withOption-  , cut-  , cutting--  -- * Basic lexing and parsing-  , eof-  , takeBs-  , takeRestBs-  , char-  , byte-  , bytes-  , string-  , switch-  , switchWithPost-  , rawSwitchWithPost-  , satisfy-  , satisfy_-  , satisfyASCII-  , satisfyASCII_-  , fusedSatisfy-  , fusedSatisfy_-  , anyWord8-  , anyWord8_-  , anyWord16-  , anyWord16_-  , anyWord32-  , anyWord32_-  , anyWord64-  , anyWord64_-  , anyWord-  , anyWord_-  , anyInt8-  , anyInt16-  , anyInt32-  , anyInt64-  , anyInt-  , anyChar-  , anyChar_-  , anyCharASCII-  , anyCharASCII_-  , isDigit-  , isGreekLetter-  , isLatinLetter-  , FlatParse.Stateful.readInt-  , FlatParse.Stateful.readInteger--  -- ** Explicit-endianness machine integers-  , anyWord16le-  , anyWord16be-  , anyWord32le-  , anyWord32be-  , anyWord64le-  , anyWord64be-  , anyInt16le-  , anyInt16be-  , anyInt32le-  , anyInt32be-  , anyInt64le-  , anyInt64be--  -- * Combinators-  , (<|>)-  , branch-  , chainl-  , chainr-  , many-  , many_-  , some-  , some_-  , notFollowedBy-  , isolate--  -- * Positions and spans-  , Pos(..)-  , Span(..)-  , getPos-  , setPos-  , endPos-  , spanOf-  , withSpan-  , byteStringOf-  , withByteString-  , inSpan--  -- ** Position and span conversions-  , Basic.validPos-  , Basic.posLineCols-  , unsafeSpanToByteString-  , Basic.unsafeSlice-  , Basic.mkPos-  , Basic.lines--  -- * Getting the rest of the input as a 'String'-  , takeLine-  , traceLine-  , takeRest-  , traceRest--  -- * `String` conversions-  , packUTF8-  , Basic.unpackUTF8--  -- * Internal functions-  , ensureBytes#-  , scan8#-  , scan16#-  , scan32#-  , scan64#-  , scanAny8#-  , scanBytes#-  , setBack#--  , withAnyWord8#-  , withAnyWord16#-  , withAnyWord32#-  , withAnyWord64#-  , withAnyInt8#-  , withAnyInt16#-  , withAnyInt32#-  , withAnyInt64#--  ) where--import Control.Monad-import Data.Foldable-import Data.Map (Map)-import GHC.Exts-import GHC.Word-import GHC.Int-import Language.Haskell.TH-import System.IO.Unsafe-import GHC.ForeignPtr--import qualified Data.ByteString as B-import qualified Data.ByteString.Internal as B-import qualified Data.ByteString.Unsafe as B-import qualified Data.Map.Strict as M--import FlatParse.Internal-import FlatParse.Internal.UnboxedNumerics--import qualified FlatParse.Basic as Basic-------------------------------------------------------------------------------------- | Primitive result of a parser. Possible results are given by `OK#`, `Err#` and `Fail#`---   pattern synonyms.-type Res# e a =-  (#-    (# a, Addr#, Int# #)-  | (# #)-  | (# e #)-  #)---- | Contains return value, pointer to the rest of the input buffer and the nex `Int`---   state.-pattern OK# :: a -> Addr# -> Int# -> Res# e a-pattern OK# a s n = (# (# a, s, n #) | | #)---- | Constructor for errors which are by default non-recoverable.-pattern Err# :: e -> Res# e a-pattern Err# e = (# | | (# e #) #)---- | Constructor for recoverable failure.-pattern Fail# :: Res# e a-pattern Fail# = (# | (# #) | #)-{-# complete OK#, Err#, Fail# #-}---- | @Parser r e a@ has a reader environment @r@, error type @e@ and a return type @a@.-newtype Parser r e a = Parser {runParser# :: ForeignPtrContents -> r -> Addr# -> Addr# -> Int# -> Res# e a}--instance Functor (Parser r e) where-  fmap f (Parser g) = Parser \fp !r eob s n -> case g fp r eob s n of-    OK# a s n -> let !b = f a in OK# b s n-    x         -> unsafeCoerce# x-  {-# inline fmap #-}--  (<$) a' (Parser g) = Parser \fp !r eob s n -> case g fp r eob s n of-    OK# a s n -> OK# a' s n-    x         -> unsafeCoerce# x-  {-# inline (<$) #-}--instance Applicative (Parser r e) where-  pure a = Parser \fp !r eob s n -> OK# a s n-  {-# inline pure #-}-  Parser ff <*> Parser fa = Parser \fp !r eob s n -> case ff fp r eob s n of-    OK# f s n -> case fa fp r eob s n of-      OK# a s n  -> let !b = f a in OK# b s n-      x          -> unsafeCoerce# x-    x -> unsafeCoerce# x-  {-# inline (<*>) #-}-  Parser fa <* Parser fb = Parser \fp !r eob s n -> case fa fp r eob s n of-    OK# a s n   -> case fb fp r eob s n of-      OK# b s n -> OK# a s n-      x -> unsafeCoerce# x-    x -> unsafeCoerce# x-  {-# inline (<*) #-}-  Parser fa *> Parser fb = Parser \fp !r eob s n -> case fa fp r eob s n of-    OK# a s n -> fb fp r eob s n-    x         -> unsafeCoerce# x-  {-# inline (*>) #-}--instance Monad (Parser r e) where-  return = pure-  {-# inline return #-}-  Parser fa >>= f = Parser \fp !r eob s n -> case fa fp r eob s n of-    OK# a s n -> runParser# (f a) fp r eob s n-    x         -> unsafeCoerce# x-  {-# inline (>>=) #-}-  (>>) = (*>)-  {-# inline (>>) #-}---- | Higher-level boxed data type for parsing results.-data Result e a =-    OK a Int !(B.ByteString)  -- ^ Contains return value, last `Int` state, unconsumed input.-  | Fail                      -- ^ Recoverable-by-default failure.-  | Err !e                    -- ^ Unrecoverble-by-default error.-  deriving Show--instance Functor (Result e) where-  fmap f (OK a s n) = let !b = f a in OK b s n-  fmap f r          = unsafeCoerce# r-  {-# inline fmap #-}-  (<$) a (OK _ s n) = OK a s n-  (<$) _ r          = unsafeCoerce# r-  {-# inline (<$) #-}-------------------------------------------------------------------------------------- | Run a parser. The `Int` argument is the initial state.-runParser :: Parser r e a -> r -> Int -> B.ByteString -> Result e a-runParser (Parser f) !r (I# n) b@(B.PS (ForeignPtr _ fp) _ (I# len)) = unsafeDupablePerformIO do-  B.unsafeUseAsCString b \(Ptr buf) -> do-    let end = plusAddr# buf len-    case f fp r end buf n of-      Err# e ->-        pure (Err e)-      OK# a s n -> do-        let offset = minusAddr# s buf-        pure (OK a (I# n) (B.drop (I# offset) b))-      Fail# ->-        pure Fail-{-# inlinable runParser #-}---- | Run a parser on a `String` input. Reminder: @OverloadedStrings@ for `B.ByteString` does not---   yield a valid UTF-8 encoding! For non-ASCII `B.ByteString` literal input, use `runParserS` or---   `packUTF8` for testing.-runParserS :: Parser r e a -> r -> Int -> String -> Result e a-runParserS pa r !n s = runParser pa r n (packUTF8 s)-------------------------------------------------------------------------------------- | Query the `Int` state.-get :: Parser r e Int-get = Parser \fp !r eob s n -> OK# (I# n) s n-{-# inline get #-}---- | Write the `Int` state.-put :: Int -> Parser r e ()-put (I# n) = Parser \fp !r eob s _ -> OK# () s n-{-# inline put #-}---- | Modify the `Int` state.-modify :: (Int -> Int) -> Parser r e ()-modify f = Parser \fp !r eob s n ->-  case f (I# n) of-    I# n -> OK# () s n-{-# inline modify #-}---- | Query the environment.-ask :: Parser r e r-ask = Parser \fp !r eob s n -> OK# r s n-{-# inline ask #-}---- | Run a parser in a modified environment.-local :: (r -> r) -> Parser r e a -> Parser r e a-local f (Parser g) = Parser \fp !r eob s n -> let !r' = f r in g fp r' eob s n-{-# inline local #-}-------------------------------------------------------------------------------------- | The failing parser. By default, parser choice `(<|>)` arbitrarily backtracks---   on parser failure.-empty :: Parser r e a-empty = Parser \fp !r eob s n -> Fail#-{-# inline empty #-}---- | Throw a parsing error. By default, parser choice `(<|>)` can't backtrack---   on parser error. Use `try` to convert an error to a recoverable failure.-err :: e -> Parser r e a-err e = Parser \fp !r eob s n -> Err# e-{-# inline err #-}---- | Save the parsing state, then run a parser, then restore the state.-lookahead :: Parser r e a -> Parser r e a-lookahead (Parser f) = Parser \fp !r eob s n ->-  case f fp r eob s n of-    OK# a _ _ -> OK# a s n-    x         -> x-{-# inline lookahead #-}---- | Convert a parsing failure to a success.-fails :: Parser r e a -> Parser r e ()-fails (Parser f) = Parser \fp !r eob s n ->-  case f fp r eob s n of-    OK# _ _ _ -> Fail#-    Fail#     -> OK# () s n-    Err# e    -> Err# e-{-# inline fails #-}---- | Convert a parsing error into failure.-try :: Parser r e a -> Parser r e a-try (Parser f) = Parser \fp !r eob s n -> case f fp r eob s n of-  Err# _ -> Fail#-  x      -> x-{-# inline try #-}---- | Convert a parsing failure to a `Maybe`. If possible, use `withOption` instead.-optional :: Parser r e a -> Parser r e (Maybe a)-optional p = (Just <$> p) <|> pure Nothing-{-# inline optional #-}---- | Convert a parsing failure to a `()`.-optional_ :: Parser r e a -> Parser r e ()-optional_ p = (() <$ p) <|> pure ()-{-# inline optional_ #-}---- | CPS'd version of `optional`. This is usually more efficient, since it gets rid of the---   extra `Maybe` allocation.-withOption :: Parser r e a -> (a -> Parser r e b) -> Parser r e b -> Parser r e b-withOption (Parser f) just (Parser nothing) = Parser \fp !r eob s n -> case f fp r eob s n of-  OK# a s n -> runParser# (just a) fp r eob s n-  Fail#     -> nothing fp r eob s n-  Err# e    -> Err# e-{-# inline withOption #-}---- | Convert a parsing failure to an error.-cut :: Parser r e a -> e -> Parser r e a-cut (Parser f) e = Parser \fp !r eob s n -> case f fp r eob s n of-  Fail# -> Err# e-  x     -> x-{-# inline cut #-}---- | Run the parser, if we get a failure, throw the given error, but if we get an error, merge the---   inner and the newly given errors using the @e -> e -> e@ function. This can be useful for---   implementing parsing errors which may propagate hints or accummulate contextual information.-cutting :: Parser r e a -> e -> (e -> e -> e) -> Parser r e a-cutting (Parser f) e merge = Parser \fp !r eob s n -> case f fp r eob s n of-  Fail#   -> Err# e-  Err# e' -> let !e'' = merge e' e in Err# e''-  x       -> x-{-# inline cutting #-}--------------------------------------------------------------------------------------- | Succeed if the input is empty.-eof :: Parser r e ()-eof = Parser \fp !r eob s n -> case eqAddr# eob s of-  1# -> OK# () s n-  _  -> Fail#-{-# inline eof #-}---- | Read the given number of bytes as a 'ByteString'.------ Throws a runtime error if given a negative integer.-takeBs :: Int -> Parser r e B.ByteString-takeBs (I# n#) = Parser \fp !r eob s n -> case n# <=# minusAddr# eob s of-  1# -> -- have to runtime check for negative values, because they cause a hang-    case n# >=# 0# of-      1# -> OK# (B.PS (ForeignPtr s fp) 0 (I# n#)) (plusAddr# s n#) n-      _  -> error "FlatParse.Basic.take: negative integer"-  _  -> Fail#-{-# inline takeBs #-}---- | Consume the rest of the input. May return the empty bytestring.-takeRestBs :: Parser r e B.ByteString-takeRestBs = Parser \fp !r eob s n ->-  let n# = minusAddr# eob s-  in  OK# (B.PS (ForeignPtr s fp) 0 (I# n#)) eob n-{-# inline takeRestBs #-}---- | Parse a UTF-8 character literal. This is a template function, you can use it as---   @$(char \'x\')@, for example, and the splice in this case has type @Parser r e ()@.-char :: Char -> Q Exp-char c = string [c]---- | Read a byte.-byte :: Word8 -> Parser r e ()-byte w = ensureBytes# 1 >> scan8# w-{-# inline byte #-}---- | Read a sequence of bytes. This is a template function, you can use it as @$(bytes [3, 4, 5])@,---   for example, and the splice has type @Parser r e ()@.-bytes :: [Word] -> Q Exp-bytes bytes = do-  let !len = length bytes-  [| ensureBytes# len >> $(scanBytes# bytes) |]---- | Parse a UTF-8 string literal. This is a template function, you can use it as @$(string "foo")@,---   for example, and the splice has type @Parser r e ()@.-string :: String -> Q Exp-string str = bytes (strToBytes str)--{-|-This is a template function which makes it possible to branch on a collection of string literals in-an efficient way. By using `switch`, such branching is compiled to a trie of primitive parsing-operations, which has optimized control flow, vectorized reads and grouped checking for needed input-bytes.--The syntax is slightly magical, it overloads the usual @case@ expression. An example:--@-    $(switch [| case _ of-        "foo" -> pure True-        "bar" -> pure False |])-@--The underscore is mandatory in @case _ of@. Each branch must be a string literal, but optionally-we may have a default case, like in--@-    $(switch [| case _ of-        "foo" -> pure 10-        "bar" -> pure 20-        _     -> pure 30 |])-@--All case right hand sides must be parsers with the same type. That type is also the type-of the whole `switch` expression.--A `switch` has longest match semantics, and the order of cases does not matter, except for-the default case, which may only appear as the last case.--If a `switch` does not have a default case, and no case matches the input, then it returns with-failure, \without\ having consumed any input. A fallthrough to the default case also does not-consume any input.--}-switch :: Q Exp -> Q Exp-switch = switchWithPost Nothing--{-|-Switch expression with an optional first argument for performing a post-processing action after-every successful branch matching. For example, if we have @ws :: Parser r e ()@ for a-whitespace parser, we might want to consume whitespace after matching on any of the switch-cases. For that case, we can define a "lexeme" version of `switch` as follows.--@-  switch' :: Q Exp -> Q Exp-  switch' = switchWithPost (Just [| ws |])-@--Note that this @switch'@ function cannot be used in the same module it's defined in, because of the-stage restriction of Template Haskell.--}-switchWithPost :: Maybe (Q Exp) -> Q Exp -> Q Exp-switchWithPost postAction exp = do-  !postAction <- sequence postAction-  (!cases, !fallback) <- parseSwitch exp-  genTrie $! genSwitchTrie' postAction cases fallback---- | Version of `switchWithPost` without syntactic sugar. The second argument is the---   list of cases, the third is the default case.-rawSwitchWithPost :: Maybe (Q Exp) -> [(String, Q Exp)] -> Maybe (Q Exp) -> Q Exp-rawSwitchWithPost postAction cases fallback = do-  !postAction <- sequence postAction-  !cases <- forM cases \(str, rhs) -> (str,) <$> rhs-  !fallback <- sequence fallback-  genTrie $! genSwitchTrie' postAction cases fallback---- | Parse a UTF-8 `Char` for which a predicate holds.-satisfy :: (Char -> Bool) -> Parser r e Char-satisfy f = Parser \fp !r eob s n -> case runParser# anyChar fp r eob s n of-  OK# c s n | f c -> OK# c s n-  _               -> Fail#-{-#  inline satisfy #-}---- | Skip a UTF-8 `Char` for which a predicate holds.-satisfy_ :: (Char -> Bool) -> Parser r e ()-satisfy_ f = Parser \fp !r eob s n -> case runParser# anyChar fp r eob s n of-  OK# c s n | f c -> OK# () s n-  _               -> Fail#-{-#  inline satisfy_ #-}---- | Parse an ASCII `Char` for which a predicate holds. Assumption: the predicate must only return---   `True` for ASCII-range characters. Otherwise this function might read a 128-255 range byte,---   thereby breaking UTF-8 decoding.-satisfyASCII :: (Char -> Bool) -> Parser r e Char-satisfyASCII f = Parser \fp !r eob s n -> case eqAddr# eob s of-  1# -> Fail#-  _  -> case derefChar8# s of-    c1 | f (C# c1) -> OK# (C# c1) (plusAddr# s 1#) n-       | otherwise -> Fail#-{-#  inline satisfyASCII #-}---- | Skip an ASCII `Char` for which a predicate holds.  Assumption: the---   predicate must only return `True` for ASCII-range characters.-satisfyASCII_ :: (Char -> Bool) -> Parser r e ()-satisfyASCII_ f = () <$ satisfyASCII f-{-# inline satisfyASCII_ #-}---- | This is a variant of `satisfy` which allows more optimization. We can pick four testing---   functions for the four cases for the possible number of bytes in the UTF-8 character. So in---   @fusedSatisfy f1 f2 f3 f4@, if we read a one-byte character, the result is scrutinized with---   @f1@, for two-bytes, with @f2@, and so on. This can result in dramatic lexing speedups.------   For example, if we want to accept any letter, the naive solution would be to use---   `Data.Char.isLetter`, but this accesses a large lookup table of Unicode character classes. We---   can do better with @fusedSatisfy isLatinLetter isLetter isLetter isLetter@, since here the---   `isLatinLetter` is inlined into the UTF-8 decoding, and it probably handles a great majority of---   all cases without accessing the character table.-fusedSatisfy :: (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> Parser r e Char-fusedSatisfy f1 f2 f3 f4 = Parser \fp !r eob buf n -> case eqAddr# eob buf of-  1# -> Fail#-  _  -> case derefChar8# buf of-    c1 -> case c1 `leChar#` '\x7F'# of-      1# | f1 (C# c1) -> OK# (C# c1) (plusAddr# buf 1#) n-         | otherwise  -> Fail#-      _  -> case eqAddr# eob (plusAddr# buf 1#) of-        1# -> Fail#-        _ -> case indexCharOffAddr# buf 1# of-          c2 -> case c1 `leChar#` '\xDF'# of-            1# ->-              let resc = C# (chr# (((ord# c1 -# 0xC0#) `uncheckedIShiftL#` 6#) `orI#`-                                   (ord# c2 -# 0x80#)))-              in case f2 resc of-                   True -> OK# resc (plusAddr# buf 2#) n-                   _    -> Fail#-            _ -> case eqAddr# eob (plusAddr# buf 2#) of-              1# -> Fail#-              _  -> case indexCharOffAddr# buf 2# of-                c3 -> case c1 `leChar#` '\xEF'# of-                  1# ->-                    let resc = C# (chr# (((ord# c1 -# 0xE0#) `uncheckedIShiftL#` 12#) `orI#`-                                         ((ord# c2 -# 0x80#) `uncheckedIShiftL#`  6#) `orI#`-                                         (ord# c3 -# 0x80#)))-                    in case f3 resc of-                         True -> OK# resc (plusAddr# buf 3#) n-                         _    -> Fail#-                  _ -> case eqAddr# eob (plusAddr# buf 3#) of-                    1# -> Fail#-                    _  -> case indexCharOffAddr# buf 3# of-                      c4 ->-                        let resc = C# (chr# (((ord# c1 -# 0xF0#) `uncheckedIShiftL#` 18#) `orI#`-                                             ((ord# c2 -# 0x80#) `uncheckedIShiftL#` 12#) `orI#`-                                             ((ord# c3 -# 0x80#) `uncheckedIShiftL#`  6#) `orI#`-                                              (ord# c4 -# 0x80#)))-                        in case f4 resc of-                             True -> OK# resc (plusAddr# buf 4#) n-                             _    -> Fail#-{-# inline fusedSatisfy #-}---- | Skipping variant of `fusedSatisfy`.-fusedSatisfy_ :: (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> Parser r e ()-fusedSatisfy_ f1 f2 f3 f4 = () <$ fusedSatisfy f1 f2 f3 f4-{-# inline fusedSatisfy_ #-}---- | Parse any UTF-8-encoded `Char`.-anyChar :: Parser r e Char-anyChar = Parser \fp !r eob buf n -> case eqAddr# eob buf of-  1# -> Fail#-  _  -> case derefChar8# buf of-    c1 -> case c1 `leChar#` '\x7F'# of-      1# -> OK# (C# c1) (plusAddr# buf 1#) n-      _  -> case eqAddr# eob (plusAddr# buf 1#) of-        1# -> Fail#-        _ -> case indexCharOffAddr# buf 1# of-          c2 -> case c1 `leChar#` '\xDF'# of-            1# ->-              let resc = ((ord# c1 -# 0xC0#) `uncheckedIShiftL#` 6#) `orI#`-                          (ord# c2 -# 0x80#)-              in OK# (C# (chr# resc)) (plusAddr# buf 2#) n-            _ -> case eqAddr# eob (plusAddr# buf 2#) of-              1# -> Fail#-              _  -> case indexCharOffAddr# buf 2# of-                c3 -> case c1 `leChar#` '\xEF'# of-                  1# ->-                    let resc = ((ord# c1 -# 0xE0#) `uncheckedIShiftL#` 12#) `orI#`-                               ((ord# c2 -# 0x80#) `uncheckedIShiftL#`  6#) `orI#`-                                (ord# c3 -# 0x80#)-                    in OK# (C# (chr# resc)) (plusAddr# buf 3#) n-                  _ -> case eqAddr# eob (plusAddr# buf 3#) of-                    1# -> Fail#-                    _  -> case indexCharOffAddr# buf 3# of-                      c4 ->-                        let resc = ((ord# c1 -# 0xF0#) `uncheckedIShiftL#` 18#) `orI#`-                                   ((ord# c2 -# 0x80#) `uncheckedIShiftL#` 12#) `orI#`-                                   ((ord# c3 -# 0x80#) `uncheckedIShiftL#`  6#) `orI#`-                                    (ord# c4 -# 0x80#)-                        in OK# (C# (chr# resc)) (plusAddr# buf 4#) n-{-# inline anyChar #-}---- | Skip any UTF-8-encoded `Char`.-anyChar_ :: Parser r e ()-anyChar_ = Parser \fp !r eob buf n -> case eqAddr# eob buf of-  1# -> Fail#-  _  -> case derefChar8# buf of-    c1 -> case c1 `leChar#` '\x7F'# of-      1# -> OK# () (plusAddr# buf 1#) n-      _  ->-        let buf' =-              case c1 `leChar#` '\xDF'# of-                1# -> plusAddr# buf 2#-                _  -> case c1 `leChar#` '\xEF'# of-                    1# -> plusAddr# buf 3#-                    _ ->  plusAddr# buf 4#-        in case leAddr# buf' eob of-             1# -> OK# () buf' n-             _  -> Fail#-{-# inline anyChar_ #-}----- | Parse any `Char` in the ASCII range, fail if the next input character is not in the range.---   This is more efficient than `anyChar` if we are only working with ASCII.-anyCharASCII :: Parser r e Char-anyCharASCII = Parser \fp !r eob buf n -> case eqAddr# eob buf of-  1# -> Fail#-  _  -> case derefChar8# buf of-    c1 -> case c1 `leChar#` '\x7F'# of-      1# -> OK# (C# c1) (plusAddr# buf 1#) n-      _  -> Fail#-{-# inline anyCharASCII #-}---- | Skip any `Char` in the ASCII range. More efficient than `anyChar_` if we're working only with---   ASCII.-anyCharASCII_ :: Parser r e ()-anyCharASCII_ = () <$ anyCharASCII-{-# inline anyCharASCII_ #-}---- | Read an `Int` from the input, as a non-empty digit sequence. The `Int` may---   overflow in the result.-readInt :: Parser r e Int-readInt = Parser \fp r eob s n -> case FlatParse.Internal.readInt eob s of-  (# (##) | #)        -> Fail#-  (# | (# i, s' #) #) -> OK# (I# i) s' n-{-# inline readInt #-}---- | Read an `Integer` from the input, as a non-empty digit sequence.-readInteger :: Parser r e Integer-readInteger = Parser \fp r eob s n -> case FlatParse.Internal.readInteger fp eob s of-  (# (##) | #)        -> Fail#-  (# | (# i, s' #) #) -> OK# i s' n-{-# inline readInteger #-}--------------------------------------------------------------------------------------- | Choose between two parsers. If the first parser fails, try the second one, but if the first one---   throws an error, propagate the error.-infixr 6 <|>-(<|>) :: Parser r e a -> Parser r e a -> Parser r e a-(<|>) (Parser f) (Parser g) = Parser \fp !r eob s n ->-  case f fp r eob s n of-    Fail# -> g fp r eob s n-    x     -> x-{-# inline (<|>) #-}---- | Branch on a parser: if the first argument succeeds, continue with the second, else with the third.---   This can produce slightly more efficient code than `(<|>)`. Moreover, `ḃranch` does not---   backtrack from the true/false cases.-branch :: Parser r e a -> Parser r e b -> Parser r e b -> Parser r e b-branch pa pt pf = Parser \fp !r eob s n -> case runParser# pa fp r eob s n of-  OK# _ s n -> runParser# pt fp r eob s n-  Fail#     -> runParser# pf fp r eob s n-  Err# e    -> Err# e-{-# inline branch #-}---- | An analogue of the list `foldl` function: first parse a @b@, then parse zero or more @a@-s,---   and combine the results in a left-nested way by the @b -> a -> b@ function. Note: this is not---   the usual `chainl` function from the parsec libraries!-chainl :: (b -> a -> b) -> Parser r e b -> Parser r e a -> Parser r e b-chainl f start elem = start >>= go where-  go b = do {!a <- elem; go $! f b a} <|> pure b-{-# inline chainl #-}---- | An analogue of the list `foldr` function: parse zero or more @a@-s, terminated by a @b@, and---   combine the results in a right-nested way using the @a -> b -> b@ function. Note: this is not---   the usual `chainr` function from the parsec libraries!-chainr :: (a -> b -> b) -> Parser r e a -> Parser r e b -> Parser r e b-chainr f (Parser elem) (Parser end) = go where-  go = Parser \fp !r eob s n -> case elem fp r eob s n of-    OK# a s n -> case runParser# go fp r eob s n of-      OK# b s n -> let !b' = f a b in OK# b' s n-      x         -> x-    Fail# -> end fp r eob s n-    Err# e -> Err# e-{-# inline chainr #-}---- | Run a parser zero or more times, collect the results in a list. Note: for optimal performance,---   try to avoid this. Often it is possible to get rid of the intermediate list by using a---   combinator or a custom parser.-many :: Parser r e a -> Parser r e [a]-many (Parser f) = go where-  go = Parser \fp !r eob s n -> case f fp r eob s n of-    OK# a s n -> case runParser# go fp r eob s n of-                   OK# as s n -> OK# (a:as) s n-                   x          -> x-    Fail#  -> OK# [] s n-    Err# e -> Err# e-{-# inline many #-}---- | Skip a parser zero or more times.-many_ :: Parser r e a -> Parser r e ()-many_ (Parser f) = go where-  go = Parser \fp !r eob s n -> case f fp r eob s n of-    OK# a s n -> runParser# go fp r eob s n-    Fail#     -> OK# () s n-    Err# e    -> Err# e-{-# inline many_ #-}---- | Run a parser one or more times, collect the results in a list. Note: for optimal performance,---   try to avoid this. Often it is possible to get rid of the intermediate list by using a---   combinator or a custom parser.-some :: Parser r e a -> Parser r e [a]-some p = (:) <$> p <*> many p-{-# inline some #-}---- | Skip a parser one or more times.-some_ :: Parser r e a -> Parser r e ()-some_ pa = pa >> many_ pa-{-# inline some_ #-}---- | Succeed if the first parser succeeds and the second one fails. The parsing---   state is restored to the point of the first argument's success.-notFollowedBy :: Parser r e a -> Parser r e b -> Parser r e a-notFollowedBy p1 p2 = p1 <* lookahead (fails p2)-{-# inline notFollowedBy #-}---- | @isolate n p@ runs the parser @p@ isolated to the next @n@ bytes. All---   isolated bytes must be consumed.------ Throws a runtime error if given a negative integer.-isolate :: Int -> Parser r e a -> Parser r e a-isolate (I# n#) p = Parser \fp !r eob s n ->-  let s' = plusAddr# s n#-  in  case n# <=# minusAddr# eob s of-        1# -> case n# >=# 0# of-          1# -> case runParser# p fp r s' s n of-            OK# a s'' n' -> case eqAddr# s' s'' of-              1# -> OK# a s'' n'-              _  -> Fail# -- isolated segment wasn't fully consumed-            Fail#     -> Fail#-            Err# e    -> Err# e-          _  -> error "FlatParse.Basic.isolate: negative integer"-        _  -> Fail# -- you tried to isolate more than we have left-{-# inline isolate #-}-------------------------------------------------------------------------------------- | Get the current position in the input.-getPos :: Parser r e Pos-getPos = Parser \fp !r eob s n -> OK# (addrToPos# eob s) s n-{-# inline getPos #-}---- | Set the input position. Warning: this can result in crashes if the position points outside the---   current buffer. It is always safe to `setPos` values which came from `getPos` with the current---   input.-setPos :: Pos -> Parser r e ()-setPos s = Parser \fp !r eob _ n -> OK# () (posToAddr# eob s) n-{-# inline setPos #-}---- | The end of the input.-endPos :: Pos-endPos = Pos 0-{-# inline endPos #-}----- | Return the consumed span of a parser. Use `withSpan` if possible for better efficiency.-spanOf :: Parser r e a -> Parser r e Span-spanOf (Parser f) = Parser \fp !r eob s n -> case f fp r eob s n of-  OK# a s' n -> OK# (Span (addrToPos# eob s) (addrToPos# eob s')) s' n-  x          -> unsafeCoerce# x-{-# inline spanOf #-}---- | Bind the result together with the span of the result. CPS'd version of `spanOf`---   for better unboxing.-withSpan :: Parser r e a -> (a -> Span -> Parser r e b) -> Parser r e b-withSpan (Parser f) g = Parser \fp !r eob s n -> case f fp r eob s n of-  OK# a s' n -> runParser# (g a (Span (addrToPos# eob s) (addrToPos# eob s'))) fp r eob s' n-  x          -> unsafeCoerce# x-{-# inline withSpan #-}---- | Return the `B.ByteString` consumed by a parser. Note: it's more efficient to use `spanOf` and---   `withSpan` instead.-byteStringOf :: Parser r e a -> Parser r e B.ByteString-byteStringOf (Parser f) = Parser \fp !r eob s n -> case f fp r eob s n of-  OK# a s' n -> OK# (B.PS (ForeignPtr s fp) 0 (I# (minusAddr# s' s))) s' n-  x          -> unsafeCoerce# x-{-# inline byteStringOf #-}---- | CPS'd version of `byteStringOf`. Can be more efficient, because the result is more eagerly unboxed---   by GHC. It's more efficient to use `spanOf` or `withSpan` instead.-withByteString :: Parser r e a -> (a -> B.ByteString -> Parser r e b) -> Parser r e b-withByteString (Parser f) g = Parser \fp !r eob s n -> case f fp r eob s n of-  OK# a s' n -> runParser# (g a (B.PS (ForeignPtr s fp) 0 (I# (minusAddr# s' s)))) fp r eob s' n-  x          -> unsafeCoerce# x-{-# inline withByteString #-}---- | Create a `B.ByteString` from a `Span`. The result is invalid is the `Span` points---   outside the current buffer, or if the `Span` start is greater than the end position.-unsafeSpanToByteString :: Span -> Parser r e B.ByteString-unsafeSpanToByteString (Span l r) =-  lookahead (setPos l >> byteStringOf (setPos r))-{-# inline unsafeSpanToByteString #-}----- | Run a parser in a given input span. The input position and the `Int` state is restored after---   the parser is finished, so `inSpan` does not consume input and has no side effect.  Warning:---   this operation may crash if the given span points outside the current parsing buffer. It's---   always safe to use `inSpan` if the span comes from a previous `withSpan` or `spanOf` call on---   the current input.-inSpan :: Span -> Parser r e a -> Parser r e a-inSpan (Span s eob) (Parser f) = Parser \fp !r eob' s' n' ->-  case f fp r (posToAddr# eob' eob) (posToAddr# eob' s) n' of-    OK# a _ _ -> OK# a s' n'-    x         -> unsafeCoerce# x-{-# inline inSpan #-}--------------------------------------------------------------------------------------- | Parse the rest of the current line as a `String`. Assumes UTF-8 encoding,---   throws an error if the encoding is invalid.-takeLine :: Parser r e String-takeLine = branch eof (pure "") do-  c <- anyChar-  case c of-    '\n' -> pure ""-    _    -> (c:) <$> takeLine---- | Parse the rest of the current line as a `String`, but restore the parsing state.---   Assumes UTF-8 encoding. This can be used for debugging.-traceLine :: Parser r e String-traceLine = lookahead takeLine---- | Take the rest of the input as a `String`. Assumes UTF-8 encoding.-takeRest :: Parser r e String-takeRest = branch eof (pure "") do-  c <- anyChar-  cs <- takeRest-  pure (c:cs)---- | Get the rest of the input as a `String`, but restore the parsing state. Assumes UTF-8 encoding.---   This can be used for debugging.-traceRest :: Parser r e String-traceRest = lookahead takeRest-------------------------------------------------------------------------------------- | Check that the input has at least the given number of bytes.-ensureBytes# :: Int -> Parser r e ()-ensureBytes# (I# len) = Parser \fp !r eob s n ->-  case len  <=# minusAddr# eob s of-    1# -> OK# () s n-    _  -> Fail#-{-# inline ensureBytes# #-}---- | Unsafely read a concrete byte from the input. It's not checked that the input has---   enough bytes.-scan8# :: Word8 -> Parser r e ()-scan8# (W8# c) = Parser \fp !r eob s n ->-  case indexWord8OffAddr# s 0# of-    c' -> case eqWord8'# c c' of-      1# -> OK# () (plusAddr# s 1#) n-      _  -> Fail#-{-# inline scan8# #-}---- | Unsafely read two concrete bytes from the input. It's not checked that the input has---   enough bytes.-scan16# :: Word16 -> Parser r e ()-scan16# (W16# c) = Parser \fp !r eob s n ->-  case indexWord16OffAddr# s 0# of-    c' -> case eqWord16'# c c' of-      1# -> OK# () (plusAddr# s 2#) n-      _  -> Fail#-{-# inline scan16# #-}---- | Unsafely read four concrete bytes from the input. It's not checked that the input has---   enough bytes.-scan32# :: Word32 -> Parser r e ()-scan32# (W32# c) = Parser \fp !r eob s n ->-  case indexWord32OffAddr# s 0# of-    c' -> case eqWord32'# c c' of-      1# -> OK# () (plusAddr# s 4#) n-      _  -> Fail#-{-# inline scan32# #-}---- | Unsafely read eight concrete bytes from the input. It's not checked that the input has---   enough bytes.-scan64# :: Word -> Parser r e ()-scan64# (W# c) = Parser \fp !r eob s n ->-  case indexWord64OffAddr# s 0# of-    c' -> case eqWord# c c' of-      1# -> OK# () (plusAddr# s 8#) n-      _  -> Fail#-{-# inline scan64# #-}---- | Unsafely read and return a byte from the input. It's not checked that the input is non-empty.-scanAny8# :: Parser r e Word8-scanAny8# = Parser \fp !r eob s n -> OK# (W8# (indexWord8OffAddr# s 0#)) (plusAddr# s 1#) n-{-# inline scanAny8# #-}--scanPartial64# :: Int -> Word -> Parser r e ()-scanPartial64# (I# len) (W# w) = Parser \fp !r eob s n ->-  case indexWordOffAddr# s 0# of-    w' -> case uncheckedIShiftL# (8# -# len) 3# of-      sh -> case uncheckedShiftL# w' sh of-        w' -> case uncheckedShiftRL# w' sh of-          w' -> case eqWord# w w' of-            1# -> OK# () (plusAddr# s len) n-            _  -> Fail#-{-# inline scanPartial64# #-}---- | Decrease the current input position by the given number of bytes.-setBack# :: Int -> Parser r e ()-setBack# (I# i) = Parser \fp !r eob s n ->-  OK# () (plusAddr# s (negateInt# i)) n-{-# inline setBack# #-}---- | Template function, creates a @Parser r e ()@ which unsafely scans a given---   sequence of bytes.-scanBytes# :: [Word] -> Q Exp-scanBytes# bytes = do-  let !(leading, w8s) = splitBytes bytes-      !scanw8s        = go w8s where-                         go (w8:[] ) = [| scan64# w8 |]-                         go (w8:w8s) = [| scan64# w8 >> $(go w8s) |]-                         go []       = [| pure () |]-  case w8s of-    [] -> go leading-          where-            go (a:b:c:d:[]) = let !w = packBytes [a, b, c, d] in [| scan32# w |]-            go (a:b:c:d:ws) = let !w = packBytes [a, b, c, d] in [| scan32# w >> $(go ws) |]-            go (a:b:[])     = let !w = packBytes [a, b]       in [| scan16# w |]-            go (a:b:ws)     = let !w = packBytes [a, b]       in [| scan16# w >> $(go ws) |]-            go (a:[])       = [| scan8# a |]-            go []           = [| pure () |]-    _  -> case leading of--      []              -> scanw8s-      [a]             -> [| scan8# a >> $scanw8s |]-      ws@[a, b]       -> let !w = packBytes ws in [| scan16# w >> $scanw8s |]-      ws@[a, b, c, d] -> let !w = packBytes ws in [| scan32# w >> $scanw8s |]-      ws              -> let !w = packBytes ws-                             !l = length ws-                         in [| scanPartial64# l w >> $scanw8s |]----- Switching code generation-----------------------------------------------------------------------------------#if MIN_VERSION_base(4,15,0)-mkDoE = DoE Nothing-{-# inline mkDoE #-}-#else-mkDoE = DoE-{-# inline mkDoE #-}-#endif--genTrie :: (Map (Maybe Int) Exp, Trie' (Rule, Int, Maybe Int)) -> Q Exp-genTrie (rules, t) = do-  branches <- traverse (\e -> (,) <$> (newName "rule") <*> pure e) rules--  let ix m k = case M.lookup k m of-        Nothing -> error ("key not in map: " ++ show k)-        Just a  -> a--  let ensure :: Maybe Int -> Maybe (Q Exp)-      ensure = fmap (\n -> [| ensureBytes# n |])--      fallback :: Rule -> Int ->  Q Exp-      fallback rule 0 = pure $ VarE $ fst $ ix branches rule-      fallback rule n = [| setBack# n >> $(pure $ VarE $ fst $ ix branches rule) |]--  let go :: Trie' (Rule, Int, Maybe Int) -> Q Exp-      go = \case-        Branch' (r, n, alloc) ts-          | M.null ts -> pure $ VarE $ fst $ branches M.! r-          | otherwise -> do-              !next         <- (traverse . traverse) go (M.toList ts)-              !defaultCase  <- fallback r (n + 1)--              let cases = mkDoE $-                    [BindS (VarP (mkName "c")) (VarE 'scanAny8#),-                      NoBindS (CaseE (VarE (mkName "c"))-                         (map (\(w, t) ->-                                 Match (LitP (IntegerL (fromIntegral w)))-                                       (NormalB t)-                                       [])-                              next-                          ++ [Match WildP (NormalB defaultCase) []]))]--              case ensure alloc of-                Nothing    -> pure cases-                Just alloc -> [| branch $alloc $(pure cases) $(fallback r n) |]--        Path (r, n, alloc) ws t ->-          case ensure alloc of-            Nothing    -> [| branch $(scanBytes# ws) $(go t) $(fallback r n)|]-            Just alloc -> [| branch ($alloc >> $(scanBytes# ws)) $(go t) $(fallback r n) |]--  letE-    (map (\(x, rhs) -> valD (varP x) (normalB (pure rhs)) []) (Data.Foldable.toList branches))-    (go t)--parseSwitch :: Q Exp -> Q ([(String, Exp)], Maybe Exp)-parseSwitch exp = exp >>= \case-  CaseE (UnboundVarE _) []    -> error "switch: empty clause list"-  CaseE (UnboundVarE _) cases -> do-    (!cases, !last) <- pure (init cases, last cases)-    !cases <- forM cases \case-      Match (LitP (StringL str)) (NormalB rhs) [] -> pure (str, rhs)-      _ -> error "switch: expected a match clause on a string literal"-    (!cases, !last) <- case last of-      Match (LitP (StringL str)) (NormalB rhs) [] -> pure (cases ++ [(str, rhs)], Nothing)-      Match WildP                (NormalB rhs) [] -> pure (cases, Just rhs)-      _ -> error "switch: expected a match clause on a string literal or a wildcard"-    pure (cases, last)-  _ -> error "switch: expected a \"case _ of\" expression"--genSwitchTrie' :: Maybe Exp -> [(String, Exp)] -> Maybe Exp-              -> (Map (Maybe Int) Exp, Trie' (Rule, Int, Maybe Int))-genSwitchTrie' postAction cases fallback =--  let (!branches, !strings) = unzip do-        (!i, (!str, !rhs)) <- zip [0..] cases-        case postAction of-          Nothing    -> pure ((Just i, rhs), (i, str))-          Just !post -> pure ((Just i, (VarE '(>>)) `AppE` post `AppE` rhs), (i, str))--      !m    =  M.fromList ((Nothing, maybe (VarE 'empty) id fallback) : branches)-      !trie = compileTrie strings-  in (m , trie)------------------------------------------------------------------------------------withAnyWord8# :: (Word8'# -> Parser r e a) -> Parser r e a-withAnyWord8# p = Parser \fp !r eob buf n -> case eqAddr# eob buf of-  1# -> Fail#-  _  -> case indexWord8OffAddr# buf 0# of-    w# -> runParser# (p w#) fp r eob (plusAddr# buf 1#) n-{-# inline withAnyWord8# #-}--withAnyWord16# :: (Word16'# -> Parser r e a) -> Parser r e a-withAnyWord16# p = Parser \fp !r eob buf n -> case 2# <=# minusAddr# eob buf of-  0# -> Fail#-  _  -> case indexWord16OffAddr# buf 0# of-    w# -> runParser# (p w#) fp r eob (plusAddr# buf 2#) n-{-# inline withAnyWord16# #-}--withAnyWord32# :: (Word32'# -> Parser r e a) -> Parser r e a-withAnyWord32# p = Parser \fp !r eob buf n -> case 4# <=# minusAddr# eob buf of-  0# -> Fail#-  _  -> case indexWord32OffAddr# buf 0# of-    w# -> runParser# (p w#) fp r eob (plusAddr# buf 4#) n-{-# inline withAnyWord32# #-}--withAnyWord64# :: (Word# -> Parser r e a) -> Parser r e a-withAnyWord64# p = Parser \fp !r eob buf n -> case 8# <=# minusAddr# eob buf of-  0# -> Fail#-  _  -> case indexWordOffAddr# buf 0# of-    w# -> runParser# (p w#) fp r eob (plusAddr# buf 8#) n-{-# inline withAnyWord64# #-}--withAnyInt8# :: (Int8'# -> Parser r e a) -> Parser r e a-withAnyInt8# p = Parser \fp !r eob buf n -> case eqAddr# eob buf of-  1# -> Fail#-  _  -> case indexInt8OffAddr# buf 0# of-    i# -> runParser# (p i#) fp r eob (plusAddr# buf 1#) n-{-# inline withAnyInt8# #-}--withAnyInt16# :: (Int16'# -> Parser r e a) -> Parser r e a-withAnyInt16# p = Parser \fp !r eob buf n -> case 2# <=# minusAddr# eob buf of-  0# -> Fail#-  _  -> case indexInt16OffAddr# buf 0# of-    i# -> runParser# (p i#) fp r eob (plusAddr# buf 2#) n-{-# inline withAnyInt16# #-}--withAnyInt32# :: (Int32'# -> Parser r e a) -> Parser r e a-withAnyInt32# p = Parser \fp !r eob buf n -> case 4# <=# minusAddr# eob buf of-  0# -> Fail#-  _  -> case indexInt32OffAddr# buf 0# of-    i# -> runParser# (p i#) fp r eob (plusAddr# buf 4#) n-{-# inline withAnyInt32# #-}--withAnyInt64# :: (Int# -> Parser r e a) -> Parser r e a-withAnyInt64# p = Parser \fp !r eob buf n -> case 8# <=# minusAddr# eob buf of-  0# -> Fail#-  _  -> case indexInt64OffAddr# buf 0# of-    i# -> runParser# (p i#) fp r eob (plusAddr# buf 8#) n-{-# inline withAnyInt64# #-}-------------------------------------------------------------------------------------- | Parse any 'Word8' (byte).-anyWord8 :: Parser r e Word8-anyWord8 = withAnyWord8# (\w# -> pure (W8# w#))-{-# inline anyWord8 #-}---- | Skip any 'Word8' (byte).-anyWord8_ :: Parser r e ()-anyWord8_ = () <$ anyWord8-{-# inline anyWord8_ #-}---- | Parse any 'Word16'.-anyWord16 :: Parser r e Word16-anyWord16 = withAnyWord16# (\w# -> pure (W16# w#))-{-# inline anyWord16 #-}---- | Skip any 'Word16'.-anyWord16_ :: Parser r e ()-anyWord16_ = () <$ anyWord16-{-# inline anyWord16_ #-}---- | Parse any 'Word32'.-anyWord32 :: Parser r e Word32-anyWord32 = withAnyWord32# (\w# -> pure (W32# w#))-{-# inline anyWord32 #-}---- | Skip any 'Word32'.-anyWord32_ :: Parser r e ()-anyWord32_ = () <$ anyWord32-{-# inline anyWord32_ #-}---- | Parse any 'Word64'.-anyWord64 :: Parser r e Word64-anyWord64 = withAnyWord64# (\w# -> pure (W64# w#))-{-# inline anyWord64 #-}---- | Skip any 'Word64'.-anyWord64_ :: Parser r e ()-anyWord64_ = () <$ anyWord64-{-# inline anyWord64_ #-}---- | Parse any 'Word'.-anyWord :: Parser r e Word-anyWord = withAnyWord64# (\w# -> pure (W# w#))-{-# inline anyWord #-}---- | Skip any 'Word'.-anyWord_ :: Parser r e ()-anyWord_ = () <$ anyWord-{-# inline anyWord_ #-}-------------------------------------------------------------------------------------- | Parse any 'Int8'.-anyInt8 :: Parser r e Int8-anyInt8 = withAnyInt8# (\i# -> pure (I8# i#))-{-# inline anyInt8 #-}---- | Parse any 'Int16'.-anyInt16 :: Parser r e Int16-anyInt16 = withAnyInt16# (\i# -> pure (I16# i#))-{-# inline anyInt16 #-}---- | Parse any 'Int32'.-anyInt32 :: Parser r e Int32-anyInt32 = withAnyInt32# (\i# -> pure (I32# i#))-{-# inline anyInt32 #-}---- | Parse any 'Int64'.-anyInt64 :: Parser r e Int64-anyInt64 = withAnyInt64# (\i# -> pure (I64# i#))-{-# inline anyInt64 #-}---- | Parse any 'Int'.-anyInt :: Parser r e Int-anyInt = withAnyInt64# (\i# -> pure (I# i#))-{-# inline anyInt #-}-------------------------------------------------------------------------------------- | Parse any 'Word16' (little-endian).-anyWord16le :: Parser r e Word16-anyWord16le = anyWord16-{-# inline anyWord16le #-}---- | Parse any 'Word16' (big-endian).-anyWord16be :: Parser r e Word16-anyWord16be = withAnyWord16# (\w# -> pure (W16# (byteSwap16'# w#)))-{-# inline anyWord16be #-}---- | Parse any 'Word32' (little-endian).-anyWord32le :: Parser r e Word32-anyWord32le = anyWord32-{-# inline anyWord32le #-}---- | Parse any 'Word32' (big-endian).-anyWord32be :: Parser r e Word32-anyWord32be = withAnyWord32# (\w# -> pure (W32# (byteSwap32'# w#)))-{-# inline anyWord32be #-}---- | Parse any 'Word64' (little-endian).-anyWord64le :: Parser r e Word64-anyWord64le = anyWord64-{-# inline anyWord64le #-}---- | Parse any 'Word64' (big-endian).-anyWord64be :: Parser r e Word64-anyWord64be = withAnyWord64# (\w# -> pure (W64# (byteSwap# w#)))-{-# inline anyWord64be #-}-------------------------------------------------------------------------------------- | Parse any 'Int16' (little-endian).-anyInt16le :: Parser r e Int16-anyInt16le = anyInt16-{-# inline anyInt16le #-}---- | Parse any 'Int16' (big-endian).-anyInt16be :: Parser r e Int16-anyInt16be = withAnyWord16# (\w# -> pure (I16# (word16ToInt16# (byteSwap16'# w#))))-{-# inline anyInt16be #-}---- | Parse any 'Int32' (little-endian).-anyInt32le :: Parser r e Int32-anyInt32le = anyInt32-{-# inline anyInt32le #-}---- | Parse any 'Int32' (big-endian).-anyInt32be :: Parser r e Int32-anyInt32be = withAnyWord32# (\w# -> pure (I32# (word32ToInt32# (byteSwap32'# w#))))-{-# inline anyInt32be #-}---- | Parse any 'Int64' (little-endian).-anyInt64le :: Parser r e Int64-anyInt64le = anyInt64-{-# inline anyInt64le #-}---- | Parse any 'Int64' (big-endian).-anyInt64be :: Parser r e Int64-anyInt64be = withAnyWord64# (\w# -> pure (I64# (word2Int# (byteSwap# w#))))-{-# inline anyInt64be #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleInstances #-}++{-|+Parser supporting a custom reader environment, custom error types and an 'Int'+state. A common use case of the `Int` state is to keep track of column numbers+to implement indentation-sensitive parsers.+-}++module FlatParse.Stateful (++  -- * Parser types+    FP.Parser.ParserT(..)+  , FP.Parser.Parser, FP.Parser.ParserIO, FP.Parser.ParserST++  -- * Running parsers+  , Result(..)+  , runParser+  , runParserUtf8+  , runParserIO+  , runParserST++  -- ** Primitive result types+  , type FP.Parser.Res#+  , pattern FP.Parser.OK#, pattern FP.Parser.Err#, pattern FP.Parser.Fail#+  , type FP.Parser.ResI#++  -- * Embedding `ST` operations+  , liftST++  -- * Environment operations+  , ask+  , local++  -- * State operations+  , get+  , put+  , modify++  -- * UTF conversion+  , Common.strToUtf8+  , Common.utf8ToStr++  -- * Parsers+  -- ** Bytewise+  , FP.Base.eof+  , FP.Base.take+  , FP.Base.take#+  , FP.Base.takeUnsafe#+  , FP.Base.takeRest+  , FP.Base.skip+  , FP.Base.skip#+  , FP.Base.skipBack+  , FP.Base.skipBack#+  , FP.Base.atSkip#+  , FP.Base.atSkipUnsafe#++  , FP.Bytes.bytes+  , FP.Bytes.bytesUnsafe+  , byteString+  , anyCString+  , anyVarintProtobuf++  -- ** Combinators+  , (FP.Parser.<|>)+  , FP.Base.branch+  , FP.Base.notFollowedBy+  , FP.Base.chainl+  , FP.Base.chainr+  , FP.Base.lookahead+  , FP.Base.ensure+  , FP.Base.ensure#+  , FP.Base.withEnsure+  , FP.Base.withEnsure1+  , FP.Base.withEnsure#+  , FP.Base.isolate+  , FP.Base.isolate#+  , FP.Base.isolateUnsafe#+  , FP.Switch.switch+  , FP.Switch.switchWithPost+  , FP.Switch.rawSwitchWithPost+  , Control.Applicative.many+  , FP.Base.skipMany+  , Control.Applicative.some+  , FP.Base.skipSome++  -- ** Errors and failures+  , Control.Applicative.empty+  , FP.Base.failed+  , FP.Base.try+  , FP.Base.err+  , FP.Base.fails+  , FP.Base.cut+  , FP.Base.cutting+  , FP.Base.optional+  , FP.Base.optional_+  , FP.Base.withOption++  -- ** Positions+  , FlatParse.Common.Position.Pos(..)+  , FlatParse.Common.Position.endPos+  , FlatParse.Common.Position.addrToPos#+  , FlatParse.Common.Position.posToAddr#+  , FlatParse.Common.Position.Span(..)+  , FlatParse.Common.Position.unsafeSlice+  , getPos+  , setPos+  , spanOf+  , withSpan+  , byteStringOf+  , withByteString+  , inSpan+  , Basic.validPos+  , Basic.posLineCols+  , Basic.mkPos++  -- ** Text+  -- *** UTF-8+  , FP.Text.char, FP.Text.string+  , FP.Text.anyChar, FP.Text.skipAnyChar+  , FP.Text.satisfy, FP.Text.skipSatisfy+  , FP.Text.fusedSatisfy, FP.Text.skipFusedSatisfy+  , FP.Text.takeLine+  , FP.Text.takeRestString+  , Basic.linesUtf8++  -- *** ASCII+  , FP.Text.anyAsciiChar, FP.Text.skipAnyAsciiChar+  , FP.Text.satisfyAscii, FP.Text.skipSatisfyAscii++  -- *** ASCII-encoded numbers+  , FP.Text.anyAsciiDecimalWord+  , FP.Text.anyAsciiDecimalInt+  , FP.Text.anyAsciiDecimalInteger+  , FP.Text.anyAsciiHexWord+  , FP.Text.anyAsciiHexInt++  -- ** Machine integers+  , module FP.Integers++  -- ** Debugging parsers+  , FP.Text.traceLine+  , FP.Text.traceRest++  -- * Unsafe+  , unsafeSpanToByteString++  -- ** IO+  , unsafeLiftIO++  -- ** Parsers+  , module FP.Addr+  , anyCStringUnsafe++  ) where+++import qualified FlatParse.Basic as Basic+import FlatParse.Stateful.Parser+import FlatParse.Stateful.Base+import FlatParse.Stateful.Integers+import FlatParse.Stateful.Addr+import FlatParse.Common.Position+import qualified FlatParse.Common.Assorted as Common+import qualified FlatParse.Common.Numbers  as Common++import qualified FlatParse.Stateful.Parser as FP.Parser+import qualified FlatParse.Stateful.Base as FP.Base+import qualified FlatParse.Stateful.Integers as FP.Integers+import qualified FlatParse.Stateful.Bytes as FP.Bytes+import qualified FlatParse.Stateful.Text as FP.Text+import qualified FlatParse.Stateful.Switch as FP.Switch+import qualified FlatParse.Stateful.Addr as FP.Addr++import qualified Control.Applicative+import GHC.IO (IO(..))+import GHC.Exts+import GHC.ForeignPtr+import GHC.ST (ST(..))+import System.IO.Unsafe++import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as B+import qualified Data.ByteString.Unsafe as B++--------------------------------------------------------------------------------++-- | Higher-level boxed data type for parsing results.+data Result e a =+    OK a Int !(B.ByteString)  -- ^ Contains return value, last `Int` state, unconsumed input.+  | Fail                      -- ^ Recoverable-by-default failure.+  | Err !e                    -- ^ Unrecoverble-by-default error.+  deriving Show++instance Functor (Result e) where+  fmap f (OK a s n) = let !b = f a in OK b s n+  fmap f r          = unsafeCoerce# r+  {-# inline fmap #-}+  (<$) a (OK _ s n) = OK a s n+  (<$) _ r          = unsafeCoerce# r+  {-# inline (<$) #-}++-- | Embed an IO action in a 'ParserT'. This is slightly safer than 'unsafePerformIO' because+-- it will sequenced correctly with respect to the surrounding actions, and its execution is guaranteed.+unsafeLiftIO :: IO a -> ParserT st r e a+unsafeLiftIO io = ParserT \fp !r eob s n st ->+                   let !a = unsafePerformIO io+                   in OK# st a s n+{-# inline unsafeLiftIO #-}++--------------------------------------------------------------------------------++-- | Run a pure parser. The `Int` argument is the initial state.+runParser :: Parser r e a -> r -> Int -> B.ByteString -> Result e a+runParser (ParserT f) !r (I# n) b@(B.PS (ForeignPtr _ fp) _ (I# len)) = unsafeDupablePerformIO $+  B.unsafeUseAsCString b \(Ptr buf) -> do+    let end = plusAddr# buf len+    pure case f fp r end buf n proxy# of+      OK# _st a s n' -> let offset = minusAddr# s buf+                        in OK a (I# n') (B.drop (I# offset) b)++      Err# _st e ->  Err e+      Fail# _st  ->  Fail+{-# noinline runParser #-}+-- We mark this as noinline to allow power users to safely do unsafe state token coercions.+-- Details are discussed in https://github.com/AndrasKovacs/flatparse/pull/34#issuecomment-1326999390++-- | Run a parser on a 'String', converting it to the corresponding UTF-8 bytes.+--   The `Int` argument is the initial state.+--+-- Reminder: @OverloadedStrings@ for 'B.ByteString' does not yield a valid UTF-8+-- encoding! For non-ASCII 'B.ByteString' literal input, use this wrapper or+-- convert your input using `strToUtf8`.+runParserUtf8 :: Parser r e a -> r -> Int -> String -> Result e a+runParserUtf8 pa r !n s = runParser pa r n (Common.strToUtf8 s)++-- | Run an ST-based parser. The `Int` argument is the initial state.+runParserST :: (forall s. ParserST s r e a) -> r -> Int -> B.ByteString -> Result e a+runParserST pst !r i buf = unsafeDupablePerformIO (runParserIO pst r i buf)+{-# inlinable runParserST #-}++-- | Run an IO-based parser. The `Int` argument is the initial state.+runParserIO :: ParserIO r e a -> r -> Int -> B.ByteString -> IO (Result e a)+runParserIO (ParserT f) !r (I# n) b@(B.PS (ForeignPtr _ fp) _ (I# len)) = do+  B.unsafeUseAsCString b \(Ptr buf) -> do+    let end = plusAddr# buf len+    IO \st -> case f fp r end buf n st of+      OK# rw' a s n' ->  let offset = minusAddr# s buf+                         in (# rw', OK a (I# n') (B.drop (I# offset) b) #)++      Err# rw' e ->  (# rw', Err e #)+      Fail# rw'  ->  (# rw', Fail #)+{-# inlinable runParserIO #-}++--------------------------------------------------------------------------------++-- | Run an `ST` action in a `ParserST`.+liftST :: ST s a -> ParserST s r e a+liftST (ST f) = ParserT \fp !r eob s n st -> case f st of+  (# st, a #) -> OK# st a s n+{-# inline liftST #-}++--------------------------------------------------------------------------------++-- | Query the `Int` state.+get :: ParserT st r e Int+get = ParserT \fp !r eob s n st -> OK# st (I# n) s n+{-# inline get #-}++-- | Write the `Int` state.+put :: Int -> ParserT st r e ()+put (I# n) = ParserT \fp !r eob s _ st -> OK# st () s n+{-# inline put #-}++-- | Modify the `Int` state.+modify :: (Int -> Int) -> ParserT st r e ()+modify f = ParserT \fp !r eob s n st ->+  case f (I# n) of+    I# n -> OK# st () s n+{-# inline modify #-}++-- | Query the environment.+ask :: ParserT st r e r+ask = ParserT \fp !r eob s n st -> OK# st r s n+{-# inline ask #-}++-- | Run a parser in a modified environment.+local :: (r -> r) -> ParserT st r e a -> ParserT st r e a+local f (ParserT g) = ParserT \fp !r eob s n st -> let !r' = f r in g fp r' eob s n st+{-# inline local #-}++--------------------------------------------------------------------------------++-- | Parse a given `B.ByteString`. If the bytestring is statically known, consider using 'bytes' instead.+byteString :: B.ByteString -> ParserT st r e ()+byteString (B.PS (ForeignPtr bs fcontent) _ (I# len)) =++  let go64 :: Addr# -> Addr# -> Addr# -> Int# -> State# RealWorld -> Res# (State# RealWorld) e ()+      go64 bs bsend s n rw =+        let bs' = plusAddr# bs 8# in+        case gtAddr# bs' bsend of+          1# -> go8 bs bsend s n rw+#if MIN_VERSION_base(4,17,0)+          _  -> case eqWord64# (indexWord64OffAddr# bs 0#) (indexWord64OffAddr# s 0#) of+#else+          _  -> case eqWord# (indexWord64OffAddr# bs 0#) (indexWord64OffAddr# s 0#) of+#endif+            1# -> go64 bs' bsend (plusAddr# s 8#) n rw+            _  -> Fail# rw++      go8 :: Addr# -> Addr# -> Addr# -> Int# -> State# RealWorld -> Res# (State# RealWorld) e ()+      go8 bs bsend s n rw = case ltAddr# bs bsend of+#if MIN_VERSION_base(4,16,0)+        1# -> case eqWord8# (indexWord8OffAddr# bs 0#) (indexWord8OffAddr# s 0#) of+#else+        1# -> case eqWord# (indexWord8OffAddr# bs 0#) (indexWord8OffAddr# s 0#) of+#endif+          1# -> go8 (plusAddr# bs 1#) bsend (plusAddr# s 1#) n rw+          _  -> Fail# rw+        _  -> OK# rw () s n++      go :: Addr# -> Addr# -> Addr# -> Int# -> State# RealWorld -> Res# (State# RealWorld) e ()+      go bs bsend s n rw = case go64 bs bsend s n rw of+        (# rw', res #) -> case touch# fcontent rw' of+          rw'' -> (# rw'', res #)++  in ParserT \fp !r eob s n st ->+      case len <=# minusAddr# eob s of+           1# -> case runRW# (go bs (plusAddr# bs len) s n) of+             (# rw, a #) -> (# st, a #)+           _  -> Fail# st+{-# inline byteString #-}++--------------------------------------------------------------------------------++-- | Get the current position in the input.+getPos :: ParserT st r e Pos+getPos = ParserT \fp !r eob s n st -> OK# st (addrToPos# eob s) s n+{-# inline getPos #-}++-- | Set the input position.+--+-- Warning: this can result in crashes if the position points outside the+-- current buffer. It is always safe to 'setPos' values which came from 'getPos'+-- with the current input.+setPos :: Pos -> ParserT st r e ()+setPos s = ParserT \fp !r eob _ n st -> OK# st () (posToAddr# eob s) n+{-# inline setPos #-}++-- | Return the consumed span of a parser. Use `withSpan` if possible for better efficiency.+spanOf :: ParserT st r e a -> ParserT st r e Span+spanOf (ParserT f) = ParserT \fp !r eob s n st -> case f fp r eob s n st of+  OK# st' a s' n -> OK# st' (Span (addrToPos# eob s) (addrToPos# eob s')) s' n+  x              -> unsafeCoerce# x+{-# inline spanOf #-}++-- | Bind the result together with the span of the result. CPS'd version of `spanOf`+--   for better unboxing.+withSpan :: ParserT st r e a -> (a -> Span -> ParserT st r e b) -> ParserT st r e b+withSpan (ParserT f) g = ParserT \fp !r eob s n st -> case f fp r eob s n st of+  OK# st' a s' n -> runParserT# (g a (Span (addrToPos# eob s) (addrToPos# eob s'))) fp r eob s' n st'+  x              -> unsafeCoerce# x+{-# inline withSpan #-}++-- | Return the `B.ByteString` consumed by a parser. Note: it's more efficient to use `spanOf` and+--   `withSpan` instead.+byteStringOf :: ParserT st r e a -> ParserT st r e B.ByteString+byteStringOf (ParserT f) = ParserT \fp !r eob s n st -> case f fp r eob s n st of+  OK# st' a s' n -> OK# st' (B.PS (ForeignPtr s fp) 0 (I# (minusAddr# s' s))) s' n+  x              -> unsafeCoerce# x+{-# inline byteStringOf #-}++-- | CPS'd version of `byteStringOf`. Can be more efficient, because the result is more eagerly unboxed+--   by GHC. It's more efficient to use `spanOf` or `withSpan` instead.+withByteString :: ParserT st r e a -> (a -> B.ByteString -> ParserT st r e b) -> ParserT st r e b+withByteString (ParserT f) g = ParserT \fp !r eob s n st -> case f fp r eob s n st of+  OK# st' a s' n -> runParserT# (g a (B.PS (ForeignPtr s fp) 0 (I# (minusAddr# s' s)))) fp r eob s' n st'+  x              -> unsafeCoerce# x+{-# inline withByteString #-}++-- | Run a parser in a given input 'Span'.+--+-- The input position and the parser state is restored after the parser is+-- finished, so 'inSpan' does not consume input and has no side effect.+--+-- Warning: this operation may crash if the given span points outside the+-- current parsing buffer. It's always safe to use 'inSpan' if the 'Span' comes+-- from a previous 'withSpan' or 'spanOf' call on the current input.+inSpan :: Span -> ParserT st r e a -> ParserT st r e a+inSpan (Span s eob) (ParserT f) = ParserT \fp !r eob' s' n' st ->+  case f fp r (posToAddr# eob' eob) (posToAddr# eob' s) n' st of+    OK# st' a _ _ -> OK# st' a s' n'+    x             -> unsafeCoerce# x+{-# inline inSpan #-}++--------------------------------------------------------------------------------++-- | Create a 'B.ByteString' from a 'Span'.+--+-- The result is invalid if the 'Span' points outside the current buffer, or if+-- the 'Span' start is greater than the end position.+unsafeSpanToByteString :: Span -> ParserT st r e B.ByteString+unsafeSpanToByteString (Span l r) =+  lookahead (setPos l >> byteStringOf (setPos r))+{-# inline unsafeSpanToByteString #-}++--------------------------------------------------------------------------------++-- | Read a null-terminated bytestring (a C-style string).+--+-- Consumes the null terminator.+anyCString :: ParserT st r e B.ByteString+anyCString = ParserT \fp !r eob s n st -> go' fp eob s n st+  where+    go' fp eob s0 n st = go 0# s0 n+      where+        go n# s n = case eqAddr# eob s of+          1# -> Fail# st+          _  ->+            let s' = plusAddr# s 1#+#if MIN_VERSION_base(4,16,0)+            -- TODO below is a candidate for improving with ExtendedLiterals!+            in  case eqWord8# (indexWord8OffAddr# s 0#) (wordToWord8# 0##) of+#else+            in  case eqWord# (indexWord8OffAddr# s 0#) 0## of+#endif+                  1# -> OK# st (B.PS (ForeignPtr s0 fp) 0 (I# n#)) s' n+                  _  -> go (n# +# 1#) s' n+{-# inline anyCString #-}++-- | Read a null-terminated bytestring (a C-style string), where the bytestring+--   is known to be null-terminated somewhere in the input.+--+-- Highly unsafe. Unless you have a guarantee that the string will be null+-- terminated before the input ends, use 'anyCString' instead. Honestly, I'm not+-- sure if this is a good function to define. But here it is.+--+-- Fails on GHC versions older than 9.0, since we make use of the+-- 'cstringLength#' primop introduced in GHC 9.0, and we aren't very useful+-- without it.+--+-- Consumes the null terminator.+anyCStringUnsafe :: ParserT st r e B.ByteString+{-# inline anyCStringUnsafe #-}+#if MIN_VERSION_base(4,15,0)+anyCStringUnsafe = ParserT \fp !r eob s n st ->+  case eqAddr# eob s of+    1# -> Fail# st+    _  -> let n#  = cstringLength# s+              s'# = plusAddr# s (n# +# 1#)+           in OK# st (B.PS (ForeignPtr s fp) 0 (I# n#)) s'# n+#else+anyCStringUnsafe = error "Flatparse.Stateful.anyCStringUnsafe: requires GHC 9.0 / base-4.15, not available on this compiler"+#endif++-- | Read a protobuf-style varint into a positive 'Int'.+--+-- protobuf-style varints are byte-aligned. For each byte, the lower 7 bits are+-- data and the MSB indicates if there are further bytes. Once fully parsed, the+-- 7-bit payloads are concatenated and interpreted as a little-endian unsigned+-- integer.+--+-- Fails if the varint exceeds the positive 'Int' range.+--+-- Really, these are varnats. They also match with the LEB128 varint encoding.+--+-- protobuf encodes negatives in unsigned integers using zigzag encoding. See+-- the @fromZigzag@ family of functions for this functionality.+--+-- Further reading:+-- https://developers.google.com/protocol-buffers/docs/encoding#varints+anyVarintProtobuf :: ParserT st r e Int+anyVarintProtobuf = ParserT \fp !r eob s n st ->+    case Common.anyVarintProtobuf# eob s of+      (# (##) | #) -> Fail# st+      (# | (# w#, s#, bits# #) #) ->+        case bits# ># 63# of+          0# -> OK# st (I# w#) s# n+          _  -> Fail# st -- overflow+{-# inline anyVarintProtobuf #-}

@@ -0,0 +1,91 @@+{- | Unsafe, highly dangerous parsing primitives using 'Addr#'.++Ensure to read the documentation before using any definitions from this module.++This module exports primitives useful for efficiently parsing binary files that+store data using an internal index.++Often, such indices describes records using a starting offset and a length.+Offsets are often relative to the file start, or some dynamic address in the+file. This way, individual records can be read out efficiently (much faster than+opening lots of small files!).++We may parse these in-place efficiently by adding record offsets to a base+memory address somewhere in the input. This is also extremely unsafe, and easy+to get catastrophically wrong. Thus, we provide as much utility as reasonable to+enable performing such parsing safely. (That means CPS functions.)++Note that all definitions here should be considered unsafe. Any 'Int#' is not+checked for positivity. You must perform any necessary checks when you obtain+your offsets and lengths as 'Int#'. Failure to do so may result in undefined+behaviour.+-}++module FlatParse.Stateful.Addr where++import FlatParse.Stateful.Parser+import FlatParse.Stateful.Base ( takeUnsafe#, atSkipUnsafe#, lookahead )++import GHC.Exts++import qualified Data.ByteString as B++-- | Run a parser, passing it the current address the parser is at.+--+-- Useful for parsing offset-based data tables. For example, you may use this to+-- save the base address to use together with various relative offsets.+withAddr# :: (Addr# -> ParserT st r e a) -> ParserT st r e a+withAddr# p = ParserT \fp !r eob s n st -> runParserT# (p s) fp r eob s n st+{-# inline withAddr# #-}++-- | @takeOffAddr# addr# offset# len#@ moves to @addr#@, skips @offset#@+--   bytes, reads @len#@ bytes into a 'ByteString', and restores the original+--   address.+--+-- The 'Addr#' should be from 'withAddr#'.+--+-- Useful for parsing offset-based data tables. Ex: Your file contains an index+-- storing @(OFFSET, LENGTH)@ entries where the offset is the byte position in+-- the file. Begin with @'withAddr#' $ \tableBase# -> ...@, then read each entry+-- like @'takeOffAddr#' tableBase# OFFSET LENGTH@.+--+-- Fails if you attempt to read outside the input.+--+-- Undefined behaviour if @offset#@ or @len#@ is negative.+--+-- Name adopted from the similar-ish @indexXOffAddr#@ primops.+takeOffAddr# :: Addr# -> Int# -> Int# -> ParserT st r e B.ByteString+takeOffAddr# addr# offset# len# = withOffAddr# addr# offset# (takeUnsafe# len#)+{-# inline takeOffAddr# #-}++-- | @withOffAddr# addr# offset# p@ moves to @addr#@, skips @offset#@+--   bytes, then runs the given parser @p@.+--+-- The 'Addr#' should be from 'withAddr#'.+--+-- Fails if you attempt to read outside the input.+--+-- Undefined behaviour if @offset#@ is negative.+--+-- Name adopted from the similar-ish @indexXOffAddr#@ primops.+withOffAddr# :: Addr# -> Int# -> ParserT st r e a -> ParserT st r e a+withOffAddr# addr# offset# =+    lookaheadFromAddr# addr# . atSkipUnsafe# offset#+{-# inline withOffAddr# #-}++-- | 'lookahead', but specify the address to lookahead from.+--+-- The 'Addr#' should be from 'withAddr#'.+lookaheadFromAddr# :: Addr# -> ParserT st r e a -> ParserT st r e a+lookaheadFromAddr# s = lookahead . atAddr# s+{-# inline lookaheadFromAddr# #-}++-- | Run a parser at the given address.+--+-- The 'Addr#' should be from 'withAddr#'.+--+-- This is a highly internal function -- you likely want 'lookaheadFromAddr#',+-- which will reset the address after running the parser.+atAddr# :: Addr# -> ParserT st r e a -> ParserT st r e a+atAddr# s (ParserT p) = ParserT \fp !r eob _ n st -> p fp r eob s n st+{-# inline atAddr# #-}

@@ -0,0 +1,359 @@+{-# LANGUAGE UnboxedTuples #-}++-- | Basic parser building blocks.++module FlatParse.Stateful.Base+  (+  -- * Bytewise+    eof+  , take+  , take#+  , takeUnsafe#+  , takeRest+  , skip+  , skip#+  , skipBack+  , skipBack#+  , atSkip#+  , atSkipUnsafe#++  -- * Combinators+  , branch+  , notFollowedBy+  , chainl+  , chainr+  , lookahead+  , ensure+  , ensure#+  , withEnsure+  , withEnsure1+  , withEnsure#+  , isolate+  , isolate#+  , isolateUnsafe#++  -- ** Non-specific (TODO)+  , skipMany+  , skipSome++  -- * Errors and failures+  , failed+  , try+  , err+  , fails+  , cut+  , cutting+  , optional+  , optional_+  , withOption+  ) where++import Prelude hiding ( take )++import FlatParse.Stateful.Parser+import qualified FlatParse.Common.Assorted as Common++import GHC.Exts+import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as B+import GHC.ForeignPtr ( ForeignPtr(..) )+import qualified Control.Applicative++-- | The failing parser. By default, parser choice `(<|>)` arbitrarily+--   backtracks on parser failure. This is a synonym for `Control.Applicative.empty`.+failed :: ParserT st r e a+failed = Control.Applicative.empty+{-# inline failed #-}++-- | Throw a parsing error. By default, parser choice `(<|>)` can't backtrack+--   on parser error. Use `try` to convert an error to a recoverable failure.+err :: e -> ParserT st r e a+err e = ParserT \_fp !_r _eob _s _n st -> Err# st e+{-# inline err #-}++-- | Convert a parsing error into failure.+try :: ParserT st r e a -> ParserT st r e a+try (ParserT p) = ParserT \fp !r eob s n st -> case p fp r eob s n st of+  Err# st' _ -> Fail# st'+  x          -> x+{-# inline try #-}++-- | Convert a parsing failure to a success.+fails :: ParserT st r e a -> ParserT st r e ()+fails (ParserT p) = ParserT \fp !r eob s n st ->+  case p fp r eob s n st of+    OK#   st' _ _ _ -> Fail# st'+    Fail# st'       -> OK#   st' () s n+    Err#  st' e     -> Err#  st' e+{-# inline fails #-}++-- | Convert a parsing failure to an error.+cut :: ParserT st r e a -> e -> ParserT st r e a+cut (ParserT p) e = ParserT \fp !r eob s n st -> case p fp r eob s n st of+  Fail# st' -> Err# st' e+  x         -> x+{-# inline cut #-}++-- | Run the parser, if we get a failure, throw the given error, but if we get an error, merge the+--   inner and the newly given errors using the @e -> e -> e@ function. This can be useful for+--   implementing parsing errors which may propagate hints or accummulate contextual information.+cutting :: ParserT st r e a -> e -> (e -> e -> e) -> ParserT st r e a+cutting (ParserT p) e merge = ParserT \fp !r eob s n st -> case p fp r eob s n st of+  Fail# st'    -> Err# st' e+  Err#  st' e' -> Err# st' $! merge e' e+  x            -> x+{-# inline cutting #-}++-- | Convert a parsing failure to a `Maybe`. If possible, use `withOption`+--   instead.+optional :: ParserT st r e a -> ParserT st r e (Maybe a)+optional p = (Just <$> p) <|> pure Nothing+{-# inline optional #-}++-- | Convert a parsing failure to a `()`.+optional_ :: ParserT st r e a -> ParserT st r e ()+optional_ p = (() <$ p) <|> pure ()+{-# inline optional_ #-}++-- | CPS'd version of `optional`. This is usually more efficient, since it gets+--   rid of the extra `Maybe` allocation.+withOption+    :: ParserT st r e a -> (a -> ParserT st r e ret)+    -> ParserT st r e ret -> ParserT st r e ret+withOption (ParserT p) just (ParserT nothing) = ParserT \fp !r eob s n st ->+    case p fp r eob s n st of+      OK#   st' a s n' -> runParserT# (just a) fp r eob s n' st'+      Fail# st'        -> nothing fp r eob s n st'+      Err#  st' e      -> Err# st' e+{-# inline withOption #-}++--------------------------------------------------------------------------------++-- | Succeed if the input is empty.+eof :: ParserT st r e ()+eof = ParserT \fp !r eob s n st -> case eqAddr# eob s of+  1# -> OK#   st () s n+  _  -> Fail# st+{-# inline eof #-}++-- | Save the parsing state, then run a parser, then restore the state.+lookahead :: ParserT st r e a -> ParserT st r e a+lookahead (ParserT p) = ParserT \fp !r eob s n st ->+  case p fp r eob s n st of+    OK# st' a _ n -> OK# st' a s n+    x             -> x+{-# inline lookahead #-}++-- | @isolate n p@ runs the parser @p@ isolated to the next @n@ bytes.+--   All isolated bytes must be consumed.+--+-- Throws a runtime error if given a negative integer.+isolate :: Int -> ParserT st r e a -> ParserT st r e a+isolate = Common.withIntUnwrap# isolate#+{-# inline isolate #-}++-- | @isolate# n# p@ runs the parser @p@ isolated to the next @n#@ bytes.+--   All isolated bytes must be consumed.+--+-- Throws a runtime error if given a negative integer.+isolate# :: Int# -> ParserT st r e a -> ParserT st r e a+isolate# n# p = Common.withPosInt# n# (isolateUnsafe# n# p)+{-# inline isolate# #-}++-- | @isolateUnsafe# i# p@ runs the parser @p@ isolated to the next @i#@ bytes.+--   All isolated bytes must be consumed.+--+-- Undefined behaviour if given a negative integer.+isolateUnsafe# :: Int# -> ParserT st r e ret -> ParserT st r e ret+isolateUnsafe# i# (ParserT p) =+    withEnsure# i# $ ParserT \fp !r eob s n st ->+        let s' = plusAddr# s i#+        in  case p fp r s' s n st of+              OK# st' a s'' n' ->+                case eqAddr# s' s'' of+                  1# -> OK#   st' a s'' n'+                  _  -> Fail# st'+              x -> x+{-# inline isolateUnsafe# #-}++-- | An analogue of the list `foldl` function: first parse a @b@, then parse zero or more @a@-s,+--   and combine the results in a left-nested way by the @b -> a -> b@ function. Note: this is not+--   the usual `chainl` function from the parsec libraries!+chainl :: (b -> a -> b) -> ParserT st r e b -> ParserT st r e a -> ParserT st r e b+chainl f start elem = start >>= go where+  go b = do {!a <- elem; go $! f b a} <|> pure b+{-# inline chainl #-}++-- | An analogue of the list `foldr` function: parse zero or more @a@-s, terminated by a @b@, and+--   combine the results in a right-nested way using the @a -> b -> b@ function. Note: this is not+--   the usual `chainr` function from the parsec libraries!+chainr :: (a -> b -> b) -> ParserT st r e a -> ParserT st r e b -> ParserT st r e b+chainr f (ParserT elem) (ParserT end) = ParserT go where+  go fp !r eob s n st = case elem fp r eob s n st of+    OK#   st' a s' n' -> case go fp r eob s' n' st' of+      OK# st'' b s'' n'' -> let !b' = f a b in OK# st'' b' s'' n''+      x                  -> x+    Fail# st'        -> end fp r eob s n st'+    Err#  st' e      -> Err# st' e+{-# inline chainr #-}++-- | Branch on a parser: if the first argument succeeds, continue with the second, else with the third.+--   This can produce slightly more efficient code than `(<|>)`. Moreover, `ḃranch` does not+--   backtrack from the true/false cases.+branch :: ParserT st r e a -> ParserT st r e b -> ParserT st r e b -> ParserT st r e b+branch pa pt pf = ParserT \fp !r eob s n st -> case runParserT# pa fp r eob s n st of+  OK#   st' _ s n' -> runParserT# pt fp r eob s n' st'+  Fail# st'        -> runParserT# pf fp r eob s n  st'+  Err#  st' e      -> Err# st' e+{-# inline branch #-}++-- | Succeed if the first parser succeeds and the second one fails.+notFollowedBy :: ParserT st r e a -> ParserT st r e b -> ParserT st r e a+notFollowedBy p1 p2 = p1 <* fails p2+{-# inline notFollowedBy #-}++--------------------------------------------------------------------------------++-- | Assert that there are at least @n@ bytes remaining.+--+-- Undefined behaviour if given a negative integer.+ensure :: Int -> ParserT st r e ()+ensure = Common.withIntUnwrap# ensure#+{-# inline ensure #-}++-- | Assert that there are at least @n#@ bytes remaining.+--+-- Undefined behaviour if given a negative integer.+ensure# :: Int# -> ParserT st r e ()+ensure# n# = withEnsure# n# (pure ())+{-# inline ensure# #-}++-- TODO: András: withEnsure operations seem superfluous to me?+-- There's no unboxing in vanilla ensure that could be broken.++-- | Assert that there are at least @n#@ bytes remaining (CPS).+--+-- Undefined behaviour if given a negative integer.+withEnsure :: Int -> ParserT st r e ret -> ParserT st r e ret+withEnsure = Common.withIntUnwrap# withEnsure#+{-# inline withEnsure #-}++-- | Assert that there is at least 1 byte remaining (CPS).+--+-- Undefined behaviour if given a negative integer.+withEnsure1 :: ParserT st r e ret -> ParserT st r e ret+withEnsure1 (ParserT p) = ParserT \fp !r eob s n st ->+    case eqAddr# eob s of+      0# -> p fp r eob s n st+      _  -> Fail# st+{-# inline withEnsure1 #-}++-- | Assert that there are at least @n#@ bytes remaining (CPS).+--+-- Undefined behaviour if given a negative integer.+withEnsure# :: Int# -> ParserT st r e ret -> ParserT st r e ret+withEnsure# n# (ParserT p) = ParserT \fp !r eob s n st ->+    case n# <=# minusAddr# eob s of+      1# -> p fp r eob s n st+      _  -> Fail# st+{-# inline withEnsure# #-}++--------------------------------------------------------------------------------++-- | Read @n@ bytes as a 'ByteString'. Fails if fewer than @n@ bytes are+--   available.+--+-- Throws a runtime error if given a negative integer.+take :: Int -> ParserT st r e B.ByteString+take (I# n#) = take# n#+{-# inline take #-}++-- | Read @n#@ bytes as a 'ByteString'. Fails if fewer than @n#@ bytes are+--   available.+--+-- Throws a runtime error if given a negative integer.+take# :: Int# -> ParserT st r e B.ByteString+take# n# = Common.withPosInt# n# (takeUnsafe# n#)+{-# inline take# #-}++-- | Read @i#@ bytes as a 'ByteString'. Fails if newer than @i#@ bytes are+--   available.+--+--   Undefined behaviour if given a negative integer.+takeUnsafe# :: Int# -> ParserT st r e B.ByteString+takeUnsafe# i# = ParserT \fp !r eob s n st ->+    case i# <=# minusAddr# eob s of+      1# -> OK#   st (B.PS (ForeignPtr s fp) 0 (I# i#)) (plusAddr# s i#) n+      _  -> Fail# st+{-# inline takeUnsafe# #-}++-- | Consume the rest of the input. May return the empty bytestring.+takeRest :: ParserT st r e B.ByteString+takeRest = ParserT \fp !r eob s n st ->+  let i# = minusAddr# eob s+  in  OK# st (B.PS (ForeignPtr s fp) 0 (I# i#)) eob n+{-# inline takeRest #-}++-- | Skip forward @n@ bytes. Fails if fewer than @n@ bytes are available.+--+-- Throws a runtime error if given a negative integer.+skip :: Int -> ParserT st r e ()+skip (I# n#) = skip# n#+{-# inline skip #-}++-- | Skip forward @n@ bytes. Fails if fewer than @n@ bytes are available.+--+-- Throws a runtime error if given a negative integer.+skip# :: Int# -> ParserT st r e ()+skip# n# = atSkip# n# (pure ())+{-# inline skip# #-}++-- | Go back @i@ bytes in the input. Takes a positive integer.+--+-- Extremely unsafe. Makes no checks. Almost certainly a Bad Idea.+skipBack :: Int -> ParserT st r e ()+skipBack = Common.withIntUnwrap# skipBack#+{-# inline skipBack #-}++-- | Go back @i#@ bytes in the input. Takes a positive integer.+--+-- Extremely unsafe. Makes no checks. Almost certainly a Bad Idea.+skipBack# :: Int# -> ParserT st r e ()+skipBack# i# = ParserT \fp !r eob s n st ->+    OK# st () (plusAddr# s (negateInt# i#)) n+{-# inline skipBack# #-}++-- | Skip forward @n#@ bytes and run the given parser. Fails if fewer than @n#@+--   bytes are available.+--+-- Throws a runtime error if given a negative integer.+atSkip# :: Int# -> ParserT st r e ret -> ParserT st r e ret+atSkip# n# p = Common.withPosInt# n# (atSkipUnsafe# n# p)+{-# inline atSkip# #-}++-- | Skip forward @i#@ bytes and run the given parser. Fails if fewer than @i@+--   bytes are available.+--+-- Undefined behaviour if given a negative integer.+atSkipUnsafe# :: Int# -> ParserT st r e ret -> ParserT st r e ret+atSkipUnsafe# i# (ParserT p) =+    withEnsure# i# $ ParserT \fp !r eob s n st ->+        p fp r eob (plusAddr# s i#) n st+{-# inline atSkipUnsafe# #-}++--------------------------------------------------------------------------------++-- | Skip a parser zero or more times.+skipMany :: ParserT st r e a -> ParserT st r e ()+skipMany (ParserT f) = ParserT go where+  go fp !r eob s n st = case f fp r eob s n st of+    OK# st a s n -> go fp r eob s n st+    Fail# st     -> OK# st () s n+    Err# st e    -> Err# st e+{-# inline skipMany #-}++-- TODO identical to one from parser-combinators+-- | Skip a parser one or more times.+skipSome :: ParserT st r e a -> ParserT st r e ()+skipSome p = p *> skipMany p+{-# inline skipSome #-}