packages feed

flatparse 0.2.2.0 → 0.3.0.0

raw patch · 8 files changed

+625/−506 lines, 8 filesdep +HUnitdep +hspecdep −bytesmith

Dependencies added: HUnit, hspec

Dependencies removed: bytesmith

Files

bench/Bench.hs view
@@ -12,7 +12,7 @@ import qualified Parsec import qualified FPStateful import qualified FPBasic-import qualified Bytesmith+-- import qualified Bytesmith import qualified ReadInteger  sexpInp :: B.ByteString@@ -25,14 +25,14 @@ numcsvInp :: B.ByteString numcsvInp = B.concat ("0" : [B.pack (",  " ++ show n) | n <- [1..100000::Int]]) -sexpInp' :: ByteArray-sexpInp' = Bytesmith.strToByteArray $ B.unpack sexpInp+-- sexpInp' :: ByteArray+-- sexpInp' = Bytesmith.strToByteArray $ B.unpack sexpInp -longwsInp' :: ByteArray-longwsInp' = Bytesmith.strToByteArray $ B.unpack longwsInp+-- longwsInp' :: ByteArray+-- longwsInp' = Bytesmith.strToByteArray $ B.unpack longwsInp -numcsvInp' :: ByteArray-numcsvInp' = Bytesmith.strToByteArray $ B.unpack numcsvInp+-- numcsvInp' :: ByteArray+-- numcsvInp' = Bytesmith.strToByteArray $ B.unpack numcsvInp  readIntInp :: B.ByteString readIntInp = "12345678910"@@ -42,7 +42,7 @@   bgroup "sexp" [     bench "fpbasic"     $ whnf FPBasic.runSexp    sexpInp,     bench "fpstateful"  $ whnf FPStateful.runSexp sexpInp,-    bench "bytesmith"   $ whnf Bytesmith.runSexp  sexpInp',+    -- bench "bytesmith"   $ whnf Bytesmith.runSexp  sexpInp',     bench "attoparsec"  $ whnf Attoparsec.runSexp sexpInp,     bench "megaparsec"  $ whnf Megaparsec.runSexp sexpInp,     bench "parsec"      $ whnf Parsec.runSexp     sexpInp@@ -51,7 +51,7 @@   bgroup "long keyword" [     bench "fpbasic"    $ whnf FPBasic.runLongws    longwsInp,     bench "fpstateful" $ whnf FPStateful.runLongws longwsInp,-    bench "bytesmith"  $ whnf Bytesmith.runLongws  longwsInp',+    -- bench "bytesmith"  $ whnf Bytesmith.runLongws  longwsInp',     bench "attoparsec" $ whnf Attoparsec.runLongws longwsInp,     bench "megaparsec" $ whnf Megaparsec.runLongws longwsInp,     bench "parsec"     $ whnf Parsec.runLongws     longwsInp@@ -60,7 +60,7 @@   bgroup "numeral csv" [     bench "fpbasic"    $ whnf FPBasic.runNumcsv    numcsvInp,     bench "fpstateful" $ whnf FPStateful.runNumcsv numcsvInp,-    bench "bytesmith"  $ whnf Bytesmith.runNumcsv  numcsvInp',+    -- bench "bytesmith"  $ whnf Bytesmith.runNumcsv  numcsvInp',     bench "attoparsec" $ whnf Attoparsec.runNumcsv numcsvInp,     bench "megaparsec" $ whnf Megaparsec.runNumcsv numcsvInp,     bench "parsec"     $ whnf Parsec.runNumcsv     numcsvInp
bench/Bytesmith.hs view
@@ -1,63 +1,65 @@ {-# language RankNTypes #-} -module Bytesmith (runSexp, runLongws, runNumcsv, strToByteArray) where+module Bytesmith where -import Control.Applicative+-- module Bytesmith (runSexp, runLongws, runNumcsv, strToByteArray) where -import GHC.Exts+-- import Control.Applicative -import qualified Data.Bytes.Parser       as P-import qualified Data.Bytes.Parser.Ascii as A+-- import GHC.Exts -import Data.Primitive.ByteArray-import Data.Char+-- import qualified Data.Bytes.Parser       as P+-- import qualified Data.Bytes.Parser.Ascii as A -strToByteArray :: String -> ByteArray-strToByteArray = fromList . map (fromIntegral . ord)+-- import Data.Primitive.ByteArray+-- import Data.Char -byteArrayToStr :: ByteArray -> String-byteArrayToStr = map (chr . fromIntegral) . toList+-- strToByteArray :: String -> ByteArray+-- strToByteArray = fromList . map (fromIntegral . ord) -parseByteArray :: (forall s. Parser s) -> ByteArray -> Bool-parseByteArray p b = case P.parseByteArray p b of-  P.Failure{} -> False-  _           -> True-{-# inline parseByteArray #-}+-- byteArrayToStr :: ByteArray -> String+-- byteArrayToStr = map (chr . fromIntegral) . toList -data U = U-instance Semigroup U where (<>) _ _ = U-instance Monoid U    where mempty   = U+-- parseByteArray :: (forall s. Parser s) -> ByteArray -> Bool+-- parseByteArray p b = case P.parseByteArray p b of+--   P.Failure{} -> False+--   _           -> True+-- {-# inline parseByteArray #-} -type Parser s = P.Parser U s ()+-- data U = U+-- instance Semigroup U where (<>) _ _ = U+-- instance Monoid U    where mempty   = U -many_ :: Parser s -> Parser s-many_ p = go where-  go = (p >> go) <|> pure ()-{-# inline many_ #-}+-- type Parser s = P.Parser U s () -some_ :: Parser s -> Parser s-some_ p = p >> many_ p-{-# inline some_ #-}+-- many_ :: Parser s -> Parser s+-- many_ p = go where+--   go = (p >> go) <|> pure ()+-- {-# inline many_ #-} -ws :: Parser s-ws = many_ do-  P.any U >>= \case-    32 -> pure ()      -- ' '-    10 -> pure ()      -- '\n'-    _  -> P.fail U+-- some_ :: Parser s -> Parser s+-- some_ p = p >> many_ p+-- {-# inline some_ #-} -open    = A.char U '(' >> ws-close   = A.char U ')' >> ws-ident   = A.skipAlpha1 U >> ws-sexp    = (open >> some_ sexp >> close) <|> ident-src     = sexp >> P.endOfInput U-runSexp = parseByteArray src+-- ws :: Parser s+-- ws = many_ do+--   P.any U >>= \case+--     32 -> pure ()      -- ' '+--     10 -> pure ()      -- '\n'+--     _  -> P.fail U -longw     = P.cstring U (Ptr "thisisalongkeyword\NUL"#)-longws    = some_ (longw >> ws) >> P.endOfInput U-runLongws = parseByteArray longws+-- open    = A.char U '(' >> ws+-- close   = A.char U ')' >> ws+-- ident   = A.skipAlpha1 U >> ws+-- sexp    = (open >> some_ sexp >> close) <|> ident+-- src     = sexp >> P.endOfInput U+-- runSexp = parseByteArray src -numeral   = A.skipDigits1 U >> ws-comma     = A.char U ',' >> ws-numcsv    = numeral >> many_ (comma >> numeral) >> P.endOfInput U-runNumcsv = parseByteArray numcsv+-- longw     = P.cstring U (Ptr "thisisalongkeyword\NUL"#)+-- longws    = some_ (longw >> ws) >> P.endOfInput U+-- runLongws = parseByteArray longws++-- numeral   = A.skipDigits1 U >> ws+-- comma     = A.char U ',' >> ws+-- numcsv    = numeral >> many_ (comma >> numeral) >> P.endOfInput U+-- runNumcsv = parseByteArray numcsv
flatparse.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           flatparse-version:        0.2.2.0+version:        0.3.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:@@ -20,7 +20,7 @@ license-file:   LICENSE build-type:     Simple tested-with:-    GHC == 8.8.4+    GHC == 9.0.1 extra-source-files:     README.md @@ -49,8 +49,7 @@       PatternSynonyms       TemplateHaskell       TupleSections-      UnboxedTuples-  ghc-options: -Wall -Wno-name-shadowing -Wno-unused-binds -Wno-unused-matches -Wno-missing-signatures -O2+  ghc-options: -Wall -Wno-name-shadowing -Wno-unused-binds -Wno-unused-matches -Wno-missing-signatures -O2 -fllvm   build-depends:       base >=4.7 && <5     , bytestring@@ -59,6 +58,33 @@     , template-haskell   default-language: Haskell2010 +test-suite spec+  type: exitcode-stdio-1.0+  main-is: Test.hs+  other-modules:+      Paths_flatparse+  hs-source-dirs:+      test+  default-extensions:+      BangPatterns+      BlockArguments+      ExplicitNamespaces+      LambdaCase+      MagicHash+      OverloadedStrings+      PatternSynonyms+      TemplateHaskell+      TupleSections+      ExtendedDefaultRules+  ghc-options: -Wall -Wno-name-shadowing -Wno-unused-binds -Wno-unused-matches -Wno-missing-signatures -O2 -fllvm -Wno-type-defaults+  build-depends:+      HUnit+    , base >=4.7 && <5+    , bytestring+    , flatparse+    , hspec+  default-language: Haskell2010+ benchmark bench   type: exitcode-stdio-1.0   main-is: Bench.hs@@ -83,12 +109,10 @@       PatternSynonyms       TemplateHaskell       TupleSections-      UnboxedTuples-  ghc-options: -Wall -Wno-name-shadowing -Wno-unused-binds -Wno-unused-matches -Wno-missing-signatures -O2+  ghc-options: -Wall -Wno-name-shadowing -Wno-unused-binds -Wno-unused-matches -Wno-missing-signatures -O2 -fllvm   build-depends:       attoparsec     , base >=4.7 && <5-    , bytesmith     , bytestring     , flatparse     , gauge
src/FlatParse/Basic.hs view
@@ -1,3 +1,4 @@+{-# language UnboxedTuples #-}  {-| This module implements a `Parser` supporting custom error types.  If you need efficient indentation@@ -51,11 +52,11 @@   , anyChar_   , anyCharASCII   , anyCharASCII_-  , isDigit-  , isGreekLetter-  , isLatinLetter-  , readInt-  , readInteger+  , FlatParse.Internal.isDigit+  , FlatParse.Internal.isGreekLetter+  , FlatParse.Internal.isLatinLetter+  , FlatParse.Basic.readInt+  , FlatParse.Basic.readInteger    -- * Combinators   , (<|>)@@ -111,8 +112,6 @@   ) where  import Control.Monad-import Data.Bits-import Data.Char (ord) import Data.Foldable import Data.List (sortBy) import Data.Map (Map)@@ -129,7 +128,7 @@ import qualified Data.ByteString.Internal as B import qualified Data.Map.Strict as M -import qualified FlatParse.Internal as Internal+import FlatParse.Internal  -------------------------------------------------------------------------------- @@ -497,24 +496,24 @@  -- | Parse any `Word16`. anyWord16 :: Parser e Word16-anyWord16 = Parser \fp eob buf -> case eqAddr# eob buf of-  1# -> Fail#+anyWord16 = Parser \fp eob buf -> case 2# <=# minusAddr# eob buf of+  0# -> Fail#   _  -> case indexWord16OffAddr# buf 0# of     w -> OK# (W16# w) (plusAddr# buf 2#) {-# inline anyWord16 #-}  -- | Parse any `Word32`. anyWord32 :: Parser e Word32-anyWord32 = Parser \fp eob buf -> case eqAddr# eob buf of-  1# -> Fail#+anyWord32 = Parser \fp eob buf -> case 4# <=# minusAddr# eob buf of+  0# -> Fail#   _  -> case indexWord32OffAddr# buf 0# of     w -> OK# (W32# w) (plusAddr# buf 4#) {-# inline anyWord32 #-}  -- | Parse any `Word`. anyWord :: Parser e Word-anyWord = Parser \fp eob buf -> case eqAddr# eob buf of-  1# -> Fail#+anyWord = Parser \fp eob buf -> case 8# <=# minusAddr# eob buf of+  0# -> Fail#   _  -> case indexWordOffAddr# buf 0# of     w -> OK# (W# w) (plusAddr# buf 8#) {-# inline anyWord #-}@@ -591,32 +590,17 @@ anyCharASCII_ = () <$ anyCharASCII {-# inline anyCharASCII_ #-} --- | @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 #-}- -- | Read an `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 Internal.readInt eob s of+readInt = Parser \fp eob s -> case FlatParse.Internal.readInt eob s of   (# (##) | #)        -> Fail#   (# | (# n, s' #) #) -> OK# (I# n) s' {-# inline readInt #-}  -- | Read an `Integer` from the input, as a non-empty digit sequence. readInteger :: Parser e Integer-readInteger = Parser \fp eob s -> case Internal.readInteger fp eob s of+readInteger = Parser \fp eob s -> case FlatParse.Internal.readInteger fp eob s of   (# (##) | #)        -> Fail#   (# | (# i, s' #) #) -> OK# i s' {-# inline readInteger #-}@@ -633,7 +617,7 @@     x     -> x {-# inline (<|>) #-} --- | Branch on a parser: if the first argument fails, continue with the second, else with the third.+-- | 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@@ -706,22 +690,6 @@  -------------------------------------------------------------------------------- --- | 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 (>=) #-}- -- | Get the current position in the input. getPos :: Parser e Pos getPos = Parser \fp eob s -> OK# (addrToPos# eob s) s@@ -739,7 +707,6 @@ 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@@ -827,15 +794,6 @@   lookahead (setPos l >> byteStringOf (setPos r)) {-# inline unsafeSpanToByteString #-} --- | 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 #-}- -- | 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@@ -859,7 +817,6 @@     OK ls _ -> ls     _       -> error "linesUTF8: invalid input" - --------------------------------------------------------------------------------  -- | Parse the rest of the current line as a `String`. Assumes UTF-8 encoding,@@ -888,60 +845,12 @@  -------------------------------------------------------------------------------- -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# #-}---- | Convert a `String` to an UTF-8-coded `B.ByteString`.-packUTF8 :: String -> B.ByteString-packUTF8 = B.pack . concatMap charToBytes- -- | 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" -charToBytes :: Char -> [Word8]-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 -> [Word8]-strToBytes = concatMap charToBytes-{-# inline strToBytes #-}--packBytes :: [Word8] -> 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 :: [Word8] -> ([Word8], [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# #-}- -- | Check that the input has at least the given number of bytes. ensureBytes# :: Int -> Parser e () ensureBytes# (I# len) = Parser \fp eob s ->@@ -1041,83 +950,9 @@                          in [| scanPartial64# l w >> $scanw8s |]  --- Trie switching+-- Switching code generation -------------------------------------------------------------------------------- -data Trie a = Branch !a !(Map Word8 (Trie a))--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 -> [Word8] -> 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)--fromList :: [(Int, String)] -> Trie Rule-fromList = 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 Word8 (Trie' a))-  | Path !a ![Word8] !(Trie' a)---- | 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)--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, n, d) (go rule' 1      <$> ts)-  go rule n (Path (rule', d) ws t)-    | Nothing <- rule' = Path (rule, n, d)  ws (go rule (n + 1) 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 . FlatParse.Basic.fromList- genTrie :: (Map (Maybe Int) Exp, Trie' (Rule, Int, Maybe Int)) -> Q Exp genTrie (rules, t) = do   branches <- traverse (\e -> (,) <$> (newName "rule") <*> pure e) rules@@ -1141,7 +976,7 @@               !next         <- (traverse . traverse) go (M.toList ts)               !defaultCase  <- fallback r (n + 1) -              let cases = DoE $+              let cases = DoE Nothing $                     [BindS (VarP (mkName "c")) (VarE 'scanAny8#),                       NoBindS (CaseE (VarE (mkName "c"))                          (map (\(w, t) ->@@ -1189,6 +1024,6 @@           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)+      !m    = M.fromList ((Nothing, maybe (VarE 'empty) id fallback) : branches)       !trie = compileTrie strings   in (m , trie)
src/FlatParse/Examples/BasicLambda/Parser.hs view
@@ -141,8 +141,7 @@ -- Examples -------------------------------------------------------------------------------- ---- testParser src p1+-- testParser src' p1 p1 = unlines [   "let f = lam x. lam y. x (x (x y)) in",   "let g = if f true then false else true in",
src/FlatParse/Internal.hs view
@@ -1,14 +1,42 @@+{-# language UnboxedTuples #-} +module FlatParse.Internal where -module FlatParse.Internal (readInt, readInteger) where+import Data.Bits+import Data.Char+import Data.Foldable (foldl')+import Data.Map (Map)+import Data.Word+import GHC.Exts+import GHC.ForeignPtr+import GHC.Num.Integer (Integer(..)) -import qualified Data.ByteString.Char8 as B+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 -import GHC.Exts-import GHC.ForeignPtr-import GHC.Integer.GMP.Internals (Integer(..))+-- 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 #-}@@ -35,8 +63,169 @@ readInteger fp eob s = case readInt' 0# s eob of   (# n, s' #)     | 1# <- eqAddr# s s'            -> (# (##) | #)-    | 1# <- minusAddr# s' s <=# 18# -> (# | (# S# n, s' #) #)-    | otherwise -> case B.readInteger (B.PS (ForeignPtr s fp) 0 (I# (minusAddr# s' s))) of+    | 1# <- minusAddr# s' s <=# 18# -> (# | (# IS 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 = B.pack . concatMap charToBytes++charToBytes :: Char -> [Word8]+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 -> [Word8]+strToBytes = concatMap charToBytes+{-# inline strToBytes #-}++packBytes :: [Word8] -> 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 :: [Word8] -> ([Word8], [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 Word8 (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 -> [Word8] -> 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 Word8 (Trie' a))+  | Path !a ![Word8] !(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
src/FlatParse/Stateful.hs view
@@ -1,3 +1,4 @@+{-# language UnboxedTuples #-}  {-| This module implements a `Parser` supporting an `Int` reader environment, custom error types, and an@@ -60,8 +61,8 @@   , isDigit   , isGreekLetter   , isLatinLetter-  , readInt-  , readInteger+  , FlatParse.Stateful.readInt+  , FlatParse.Stateful.readInteger    -- * Combinators   , (<|>)@@ -87,12 +88,12 @@   , inSpan    -- ** Position and span conversions-  , validPos-  , posLineCols-  , unsafeSpanToByteString-  , unsafeSlice-  , mkPos-  , FlatParse.Stateful.lines+  , Basic.validPos+  , Basic.posLineCols+  , Basic.unsafeSpanToByteString+  , Basic.unsafeSlice+  , Basic.mkPos+  , Basic.lines    -- * Getting the rest of the input   , takeLine@@ -114,16 +115,11 @@   , scanBytes#   , setBack# -   ) where  import Control.Monad-import Data.Bits-import Data.Char (ord) import Data.Foldable-import Data.List (sortBy) import Data.Map (Map)-import Data.Ord (comparing) import Data.Word import GHC.Exts import GHC.Word@@ -136,8 +132,10 @@ import qualified Data.ByteString.Unsafe as B import qualified Data.Map.Strict as M -import qualified FlatParse.Internal as Internal+import FlatParse.Internal +import qualified FlatParse.Basic as Basic+ --------------------------------------------------------------------------------  -- | Primitive result of a parser. Possible results are given by `OK#`, `Err#` and `Fail#`@@ -533,24 +531,24 @@  -- | Parse any `Word16`. anyWord16 :: Parser e Word16-anyWord16 = Parser \fp !r eob buf n -> case eqAddr# eob buf of-  1# -> Fail#+anyWord16 = Parser \fp !r eob buf n -> case 2# <=# minusAddr# eob buf of+  0# -> Fail#   _  -> case indexWord16OffAddr# buf 0# of     w -> OK# (W16# w) (plusAddr# buf 2#) n {-# inline anyWord16 #-}  -- | Parse any `Word32`. anyWord32 :: Parser e Word32-anyWord32 = Parser \fp !r eob buf n -> case eqAddr# eob buf of-  1# -> Fail#+anyWord32 = Parser \fp !r eob buf n -> case 4# <=# minusAddr# eob buf of+  0# -> Fail#   _  -> case indexWord32OffAddr# buf 0# of     w -> OK# (W32# w) (plusAddr# buf 4#) n {-# inline anyWord32 #-}  -- | Parse any `Word`. anyWord :: Parser e Word-anyWord = Parser \fp !r eob buf n -> case eqAddr# eob buf of-  1# -> Fail#+anyWord = Parser \fp !r eob buf n -> case 8# <=# minusAddr# eob buf of+  0# -> Fail#   _  -> case indexWordOffAddr# buf 0# of     w -> OK# (W# w) (plusAddr# buf 8#) n {-# inline anyWord #-}@@ -627,32 +625,17 @@ anyCharASCII_ = () <$ anyCharASCII {-# inline anyCharASCII_ #-} --- | @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 #-}- -- | Read an `Int` from the input, as a non-empty digit sequence. The `Int` may --   overflow in the result. readInt :: Parser e Int-readInt = Parser \fp r eob s n -> case Internal.readInt eob s of+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 e Integer-readInteger = Parser \fp r eob s n -> case Internal.readInteger fp eob s of+readInteger = Parser \fp r eob s n -> case FlatParse.Internal.readInteger fp eob s of   (# (##) | #)        -> Fail#   (# | (# i, s' #) #) -> OK# i s' n {-# inline readInteger #-}@@ -670,7 +653,7 @@     x     -> x {-# inline (<|>) #-} --- | Branch on a parser: if the first argument fails, continue with the second, else with the third.+-- | 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@@ -744,22 +727,6 @@  -------------------------------------------------------------------------------- --- | 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 (>=) #-}- -- | Get the current position in the input. getPos :: Parser e Pos getPos = Parser \fp !r eob s n -> OK# (addrToPos# eob s) s n@@ -823,42 +790,6 @@  -------------------------------------------------------------------------------- --- | 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 0 0 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) 0 0 str of-       OK res _ _ -> snd <$> sortBy (comparing fst) res-       _          -> error "invalid position"-- -- | 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 e B.ByteString@@ -866,42 +797,6 @@   lookahead (setPos l >> byteStringOf (setPos r)) {-# inline unsafeSpanToByteString #-} --- | 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 #-}----- | 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) 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 0 0 str of-    OK ls _ _ -> ls-    _         -> error "linesUTF8: invalid input"--- --------------------------------------------------------------------------------  -- | Parse the rest of the current line as a `String`. Assumes UTF-8 encoding,@@ -930,60 +825,12 @@  -------------------------------------------------------------------------------- -addrToPos# :: Addr# -> Addr# -> Pos-addrToPos# eob s = Pos (I# (minusAddr# eob s))-{-# inline addrToPos# #-}--posToAddr# :: Addr# -> Pos -> Addr#-posToAddr# eob (Pos (I# s)) = unsafeCoerce# (minusAddr# eob (unsafeCoerce# s))-{-# inline posToAddr# #-}---- | Convert a `String` to an UTF-8-coded `B.ByteString`.-packUTF8 :: String -> B.ByteString-packUTF8 = B.pack . concatMap charToBytes- -- | Convert an UTF-8-coded `B.ByteString` to a `String`. unpackUTF8 :: B.ByteString -> String unpackUTF8 str = case runParser takeRest 0 0 str of   OK a _ _ -> a   _        -> error "unpackUTF8: invalid encoding" -charToBytes :: Char -> [Word8]-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 -> [Word8]-strToBytes = concatMap charToBytes-{-# inline strToBytes #-}--packBytes :: [Word8] -> 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 :: [Word8] -> ([Word8], [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# #-}- -- | Check that the input has at least the given number of bytes. ensureBytes# :: Int -> Parser e () ensureBytes# (I# len) = Parser \fp !r eob s n ->@@ -1083,83 +930,9 @@                          in [| scanPartial64# l w >> $scanw8s |]  --- Trie switching+-- Switching code generation -------------------------------------------------------------------------------- -data Trie a = Branch !a !(Map Word8 (Trie a))--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 -> [Word8] -> 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)--fromList :: [(Int, String)] -> Trie Rule-fromList = 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 Word8 (Trie' a))-  | Path !a ![Word8] !(Trie' a)---- | 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)--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, n, d) (go rule' 1      <$> ts)-  go rule n (Path (rule', d) ws t)-    | Nothing <- rule' = Path (rule, n, d)  ws (go rule (n + 1) 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 . FlatParse.Stateful.fromList- genTrie :: (Map (Maybe Int) Exp, Trie' (Rule, Int, Maybe Int)) -> Q Exp genTrie (rules, t) = do   branches <- traverse (\e -> (,) <$> (newName "rule") <*> pure e) rules@@ -1183,7 +956,7 @@               !next         <- (traverse . traverse) go (M.toList ts)               !defaultCase  <- fallback r (n + 1) -              let cases = DoE $+              let cases = DoE Nothing $                     [BindS (VarP (mkName "c")) (VarE 'scanAny8#),                       NoBindS (CaseE (VarE (mkName "c"))                          (map (\(w, t) ->
+ test/Test.hs view
@@ -0,0 +1,297 @@+module Main where++import Data.ByteString (ByteString)+import FlatParse.Basic+import Test.HUnit+import Test.Hspec++main :: IO ()+main = hspec $ do+  basicSpec++--------------------------------------------------------------------------------+-- Some combinators that make it easier to assert the results of a parser.++-- | The parser should parse this string, consuming it entirely, and succeed.+shouldParse :: Show e => Parser e a -> ByteString -> Expectation+p `shouldParse` s = case runParser p s of+  OK _ "" -> pure ()+  OK _ lo -> assertFailure $ "Unexpected leftover: " ++ show lo+  Fail -> assertFailure "Parse failed unexpectedly"+  Err e -> assertFailure $ "Parse threw unexpected error: " ++ show e++-- | The parser should parse this string, consuming it entirely, and succeed+-- yielding the matching value.+shouldParseWith ::+  (Show a, Eq a, Show e) => Parser e a -> (ByteString, a) -> Expectation+p `shouldParseWith` (s, r) = case runParser p s of+  OK r' "" -> r' `shouldBe` r+  OK _ lo -> assertFailure $ "Unexpected leftover: " ++ show lo+  Fail -> assertFailure "Parse failed unexpectedly"+  Err e -> assertFailure $ "Parse threw unexpected error: " ++ show e++-- | The parser should fail when given this string.+shouldParseFail :: Show e => Parser e a -> ByteString -> Expectation+p `shouldParseFail` s = case runParser p s of+  Fail -> pure ()+  OK _ _ -> assertFailure "Parse succeeded unexpectedly"+  Err e -> assertFailure $ "Parse threw unexpected error: " ++ show e++-- | The parser should throw an error when given this string.+shouldParseErr :: Parser e a -> ByteString -> Expectation+p `shouldParseErr` s = case runParser p s of+  Err e -> pure ()+  Fail -> assertFailure "Parse failed unexpectedly"+  OK _ _ -> assertFailure "Parse succeeded unexpectedly"++-- | The parser should throw an error when given this string, and the error+-- should be the one given.+shouldParseErrWith ::+  (Show e, Eq e) => Parser e a -> (ByteString, e) -> Expectation+p `shouldParseErrWith` (s, e) = case runParser p s of+  Err e' -> e' `shouldBe` e+  Fail -> assertFailure "Parse failed unexpectedly"+  OK _ _ -> assertFailure "Parse succeeded unexpectedly"++-- | The spec for FlatParse.Basic.+basicSpec :: SpecWith ()+basicSpec = describe "FlatParse.Basic" $ do+  describe "Errors and failures" $ do+    describe "empty" $+      it "always fails" $ empty `shouldParseFail` ""++    describe "err" $+      it "throws an error" $ err "nope" `shouldParseErr` ""++    describe "lookahead" $+      it "restores state" $ do+        let p = lookahead $(string "fun") *> $(string "function")+        p `shouldParse` "function"++    describe "fails" $ do+      it "expects child to fail" $ fails empty `shouldParse` ""+      it "fails when child succeeds" $ fails (pure ()) `shouldParseFail` ""+      it "propagates errors" $ fails (err "nope") `shouldParseErr` ""++    describe "try" $+      it "turns error into failure" $ try (err "nope") `shouldParseFail` ""++    describe "optional" $ do+      it "can succeed" $ optional (pure ()) `shouldParseWith` ("", Just ())+      it "can succeed when argument missing" $+        optional empty `shouldParseWith` ("", Nothing)+      it "propagates errors" $ optional (err "nope") `shouldParseErr` ""++    describe "optional_" $ do+      it "can succeed" $ optional (pure ()) `shouldParse` ""+      it "can succeed when argument missing" $ optional empty `shouldParse` ""+      it "propagates errors" $ optional (err "nope") `shouldParseErr` ""++    describe "optioned" $ do+      let opt p = optioned p (pure . reverse) (pure "bar")+      it "handles success" $ opt (pure "foo") `shouldParseWith` ("", "oof")+      it "handles failure" $ opt empty `shouldParseWith` ("", "bar")+      it "handles error" $ opt (err "nope") `shouldParseErr` ""++    describe "cut" $ do+      it "turns failure into error" $ empty `cut` "nope" `shouldParseErr` ""+      it "leaves success alone" $ pure () `cut` "nope" `shouldParse` ""+      it "propagates error" $+        err "inner" `cut` "outer" `shouldParseErrWith` ("", "inner")++    describe "cutting" $ do+      it "turns failure into error" $+        cutting empty "nope" (++) `shouldParseErrWith` ("", "nope")+      it "leaves success alone" $ do+        cutting (pure ()) "nope" (++) `shouldParse` ""+      it "combines errors" $+        cutting (err "!!!") "nope" (++) `shouldParseErrWith` ("", "!!!nope")++  describe "Basic lexing and parsing" $ do+    describe "eof" $ do+      it "succeeds at end of file" $ eof `shouldParse` ""+      it "fails with more input" $ eof `shouldParseFail` "more"++    describe "char" $ do+      it "succeeds on that char" $ $(char 'a') `shouldParse` "a"+      it "succeeds on multibyte char" $ $(char 'ȩ') `shouldParse` packUTF8 "ȩ"+      it "fails on the wrong char" $ $(char 'a') `shouldParseFail` "b"+      it "fails at end of file" $ $(char 'a') `shouldParseFail` ""++    describe "byte" $ do+      it "succeeds on that byte" $ byte 0x61 `shouldParse` "\x61"+      it "succeeds on high bytes" $ byte 0xfe `shouldParse` "\xfe"+      it "fails on the wrong byte" $ byte 0x61 `shouldParseFail` "\x62"+      it "fails on end of file" $ byte 0x61 `shouldParseFail` ""++    describe "bytes" $ do+      it "succeeds on those bytes" $+        $(bytes [1, 2, 3, 4]) `shouldParse` "\x01\x02\x03\x04"+      it "succeeds on high bytes" $+        $(bytes [0xf1, 0xf2, 0xf3, 0xf4]) `shouldParse` "\xf1\xf2\xf3\xf4"+      it "fails on wrong bytes" $+        $(bytes [1, 2, 5, 4]) `shouldParseFail` "\x01\x02\x03\x04"+      it "fails when out of space" $+        $(bytes [1, 2, 3, 4]) `shouldParseFail` "\x01\x02\x03"++    describe "string" $ do+      it "succeeds on the right string" $ $(string "foo") `shouldParse` "foo"+      it "succeeds with multibyte chars" $+        $(string "foȩ") `shouldParse` packUTF8 "foȩ"+      it "fails on the wrong string" $ $(string "foo") `shouldParseFail` "bar"+      it "fails when out of space" $ $(string "foo") `shouldParseFail` "fo"++    describe "switch" $ do+      pure ()++    describe "switchWithPost" $ do+      pure ()++    describe "rawSwitchWithPost" $ do+      pure ()++    describe "satisfy" $ do+      pure ()++    describe "satisfyASCII" $ do+      pure ()++    describe "satisfyASCII_" $ do+      pure ()++    describe "fusedSatisfy" $ do+      pure ()++    describe "anyWord8" $ do+      pure ()++    describe "anyWord16" $ do+      pure ()++    describe "anyWord32" $ do+      pure ()++    describe "anyWord" $ do+      pure ()++    describe "anyChar" $ do+      pure ()++    describe "anyChar_" $ do+      pure ()++    describe "anyCharASCII" $ do+      pure ()++    describe "anyCharASCII_" $ do+      pure ()++    describe "isDigit" $ do+      pure ()++    describe "isGreekLetter" $ do+      pure ()++    describe "isLatinLetter" $ do+      pure ()++    describe "readInt" $ do+      pure ()++    describe "readInteger" $ do+      pure ()++  describe "Combinators" $ do+    describe "(<|>)" $ do+      pure ()++    describe "branch" $ do+      pure ()++    describe "chainl" $ do+      pure ()++    describe "chainr" $ do+      pure ()++    describe "many" $ do+      pure ()++    describe "many_" $ do+      pure ()++    describe "some" $ do+      pure ()++    describe "some_" $ do+      pure ()++    describe "notFollowedBy" $ do+      pure ()++  describe "Positions and spans" $ do+    describe "Pos Ord instance" $ do+      pure ()++    describe "getPos" $ do+      pure ()++    describe "setPos" $ do+      pure ()++    describe "endPos" $ do+      pure ()++    describe "spanOf" $ do+      pure ()++    describe "spanned" $ do+      pure ()++    describe "byteStringOf" $ do+      pure ()++    describe "byteStringed" $ do+      pure ()++    describe "inSpan" $ do+      pure ()++  describe "Positions and span conversions" $ do+    describe "validPos" $ do+      pure ()++    describe "posLineCols" $ do+      pure ()++    describe "unsafeSpanToByteString" $ do+      pure ()++    describe "unsafeSlice" $ do+      pure ()++    describe "mkPos" $ do+      pure ()++    describe "lines" $ do+      pure ()++  describe "Getting the rest of the input" $ do+    describe "takeLine" $ do+      pure ()++    describe "traceLine" $ do+      pure ()++    describe "takeRest" $ do+      pure ()++    describe "traceRest" $ do+      pure ()++  describe "String conversions" $ do+    describe "packUTF8" $ do+      pure ()++    describe "unpackUTF8" $ do+      pure ()