grammatical-parsers 0.6 → 0.7

raw patch · 36 files changed

+1695/−1186 lines, 36 filesdep ~input-parsersdep ~monoid-subclassesdep ~rank2classesPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: input-parsers, monoid-subclasses, rank2classes

API changes (from Hackage documentation)

Files

• CHANGELOG.md +18/−0
• README.md +6/−5
• examples/Arithmetic.hs +1/−1
• examples/BooleanTransformations.hs +1/−1
• examples/Combined.hs +5/−4
• examples/Conditionals.hs +3/−3
• examples/Lambda.hs +4/−2
• examples/Main.hs +1/−1
• examples/Utilities.hs +1/−1
• grammatical-parsers.cabal +14/−10
• src/Text/Grampa.hs +6/−6
• src/Text/Grampa/Class.hs +57/−17
• src/Text/Grampa/Combinators.hs +3/−3
• src/Text/Grampa/ContextFree/Continued.hs +11/−15
• src/Text/Grampa/ContextFree/Continued/Measured.hs +10/−12
• src/Text/Grampa/ContextFree/LeftRecursive.hs +4/−878
• src/Text/Grampa/ContextFree/LeftRecursive/Transformer.hs +4/−22
• src/Text/Grampa/ContextFree/Memoizing.hs +77/−25
• src/Text/Grampa/ContextFree/Memoizing/LeftRecursive.hs +69/−0
• src/Text/Grampa/ContextFree/Parallel.hs +19/−20
• src/Text/Grampa/ContextFree/SortedMemoizing.hs +40/−23
• src/Text/Grampa/ContextFree/SortedMemoizing/LeftRecursive.hs +70/−0
• src/Text/Grampa/ContextFree/SortedMemoizing/Transformer.hs +45/−25
• src/Text/Grampa/ContextFree/SortedMemoizing/Transformer/LeftRecursive.hs +29/−0
• src/Text/Grampa/Internal.hs +36/−7
• src/Text/Grampa/Internal/LeftRecursive.hs +982/−0
• src/Text/Grampa/Internal/Storable.hs +80/−0
• src/Text/Grampa/PEG/Backtrack.hs +12/−15
• src/Text/Grampa/PEG/Backtrack/Measured.hs +12/−17
• src/Text/Grampa/PEG/Continued.hs +16/−24
• src/Text/Grampa/PEG/Continued/Measured.hs +9/−12
• src/Text/Grampa/PEG/Packrat.hs +33/−21
• test/README.lhs +6/−5
• test/Test.hs +7/−7
• test/Test/Ambiguous.hs +3/−3
• test/Test/Examples.hs +1/−1

@@ -1,3 +1,21 @@+Version 0.7+---------------++* Reorganized the `LeftRecursive` modules and deprecated the old module names+* Re-exposed the `Text.Grampa.ContextFree.Memoizing` module+* Floated the `Rank2.Apply` constraint, which now may be necessary in calling contexts+* Turned `FailureDescription` from sum to product+* Added the `chainRecursive` & `chainLongestRecursive` methods+* Added `autochain`+* Improved performance by making `instance Semigroup ParseFailure` lazier+* Improved performance by shortcutting non-left-recursive grammars+* Improved the output of `TraceableParsing` instances+* Fixed comments+* Incremented dependency bounds+* Factored out several internal utility functions+* Updated code to compile with GHC 9.4.2+* Updated GitHub actions+ Version 0.6 --------------- * Updated code to compile with GHC 9.2.2

@@ -17,7 +17,8 @@ import Data.Char (isDigit) import Data.Functor.Classes (Show1, showsPrec1) import Text.Grampa-import Text.Grampa.ContextFree.LeftRecursive (Parser)+import Text.Grampa.ContextFree.Memoizing.LeftRecursive (Parser)+import qualified Rank2 import qualified Rank2.TH ~~~ @@ -26,7 +27,7 @@ like this:  ~~~ {.haskell}-arithmetic :: GrammarBuilder Arithmetic g Parser String+arithmetic :: Rank2.Apply g => GrammarBuilder Arithmetic g Parser String arithmetic Arithmetic{..} = Arithmetic{    sum= product          <|> string "-" *> (negate <$> product)@@ -89,9 +90,9 @@ -- >>> parseComplete grammar "1+2*3" -- Arithmetic{ --   sum=Compose (Right [7]),---   product=Compose (Left (ParseFailure {failurePosition = Down 4, expectedAlternatives = [StaticDescription "end of input"], errorAlternatives = []})),---   factor=Compose (Left (ParseFailure {failurePosition = Down 4, expectedAlternatives = [StaticDescription "end of input"], errorAlternatives = []})),---   number=Compose (Left (ParseFailure {failurePosition = Down 4, expectedAlternatives = [StaticDescription "end of input"], errorAlternatives = []}))}+--   product=Compose (Left (ParseFailure {failurePosition = Down 4, expectedAlternatives = FailureDescription {staticDescriptions = ["end of input"], literalDescriptions = []}, errorAlternatives = []})),+--   factor=Compose (Left (ParseFailure {failurePosition = Down 4, expectedAlternatives = FailureDescription {staticDescriptions = ["end of input"], literalDescriptions = []}, errorAlternatives = []})),+--   number=Compose (Left (ParseFailure {failurePosition = Down 4, expectedAlternatives = FailureDescription {staticDescriptions = ["end of input"], literalDescriptions = []}, errorAlternatives = []}))} -- >>> parsePrefix grammar "1+2*3 apples" -- Arithmetic{ --   sum=Compose (Compose (Right [("+2*3 apples",1),("*3 apples",3),(" apples",7)])),

@@ -8,7 +8,7 @@ import Text.Parser.Token (symbol)  import Text.Grampa-import Text.Grampa.ContextFree.LeftRecursive (Parser)+import Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive (Parser) import Utilities (infixJoin)  import qualified Rank2

@@ -18,7 +18,7 @@                     GrammarBuilder, ParseResults,                     fixGrammar, parseComplete,                     char, identifier, keyword, takeCharsWhile)-import Text.Grampa.ContextFree.LeftRecursive.Transformer (ParserT, lift, tmap)+import Text.Grampa.ContextFree.SortedMemoizing.Transformer.LeftRecursive (ParserT, lift, tmap) import qualified Boolean import Boolean(Boolean(..)) 

@@ -8,9 +8,10 @@ import qualified Data.Bool import Data.Map (Map) import qualified Data.Map as Map+import qualified Rank2 import qualified Rank2.TH import Text.Grampa (TokenParsing, LexicalParsing, GrammarBuilder)-import Text.Grampa.ContextFree.LeftRecursive (Parser)+import Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive (Parser) import qualified Arithmetic import qualified Boolean import qualified Comparisons@@ -119,11 +120,11 @@                            (", conditionalGrammar=" ++ showsPrec prec (conditionalGrammar g)                            (", lambdaGrammar=" ++ showsPrec prec (lambdaGrammar g) ("}" ++ rest)))))) +$(Rank2.TH.deriveAll ''Expression)+ instance TokenParsing (Parser Expression String) instance LexicalParsing (Parser Expression String) -$(Rank2.TH.deriveAll ''Expression)- {- instance Rank2.Functor Expression where    f <$> g = g{expr= f (expr g),@@ -191,7 +192,7 @@                   <*> Rank2.traverse f (lambdaGrammar g) -} -expression :: (LexicalParsing (Parser g String)) => GrammarBuilder Expression g Parser String+expression :: (Rank2.Apply g, LexicalParsing (Parser g String)) => GrammarBuilder Expression g Parser String expression Expression{..} =    let combinedExpr = Arithmetic.expr arithmeticGrammar                       <|> Boolean.expr booleanGrammar

@@ -8,7 +8,7 @@ import qualified Rank2.TH  import Text.Grampa-import Text.Grampa.ContextFree.LeftRecursive (Parser)+import Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive (Parser)  class ConditionalDomain c e where    ifThenElse :: c -> e -> e -> e@@ -29,10 +29,10 @@                            (", test= " ++ showsPrec prec (test a)                             (", term= " ++ showsPrec prec (term a) ("}" ++ rest))) +$(Rank2.TH.deriveAll ''Conditionals)+ instance TokenParsing (Parser (Conditionals t e) String) instance LexicalParsing (Parser (Conditionals t e) String)--$(Rank2.TH.deriveAll ''Conditionals)  conditionals :: (ConditionalDomain t e, LexicalParsing (Parser g String))              => GrammarBuilder (Conditionals t e) g Parser String

@@ -8,10 +8,11 @@ import Data.Monoid ((<>)) import Text.Parser.Token (symbol, whiteSpace) +import qualified Rank2 import qualified Rank2.TH  import Text.Grampa-import Text.Grampa.ContextFree.LeftRecursive (Parser)+import Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive (Parser)  class LambdaDomain e where    apply :: e -> e -> e@@ -95,7 +96,8 @@  $(Rank2.TH.deriveAll ''Lambda) -lambdaCalculus :: (LexicalParsing (Parser g String), LambdaDomain e) => GrammarBuilder (Lambda e) g Parser String+lambdaCalculus :: (Rank2.Apply g, LexicalParsing (Parser g String), LambdaDomain e) =>+                  GrammarBuilder (Lambda e) g Parser String lambdaCalculus Lambda{..} = Lambda{    expr= abstraction,    abstraction= lambda <$> (symbol "\\" *> varName <* symbol "->") <*> abstraction

@@ -6,7 +6,7 @@ import Data.Map (Map) import qualified Rank2 import Text.Grampa (TokenParsing, LexicalParsing, GrammarBuilder, ParseResults, fixGrammar, parseComplete)-import Text.Grampa.ContextFree.LeftRecursive (Parser)+import Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive (Parser) import Arithmetic (Arithmetic, arithmetic) import qualified Arithmetic import qualified Boolean

@@ -6,7 +6,7 @@ import Data.Monoid.Textual (TextualMonoid, toString)  import Text.Grampa-import Text.Grampa.ContextFree.LeftRecursive+import Text.Grampa.ContextFree.Memoizing.LeftRecursive import qualified Rank2  parseUnique :: (Ord s, TextualMonoid s, Rank2.Traversable g, Rank2.Distributive g, Rank2.Apply g) =>

@@ -1,5 +1,5 @@ name:                grammatical-parsers-version:             0.6+version:             0.7 synopsis:            parsers that combine into grammars description:   /Gram/matical-/pa/rsers, or Grampa for short, is a library of parser types whose values are meant to be assigned@@ -33,26 +33,30 @@                        Text.Grampa.Combinators,                        Text.Grampa.PEG.Backtrack, Text.Grampa.PEG.Packrat,                        Text.Grampa.ContextFree.Continued, Text.Grampa.ContextFree.Parallel,+                       Text.Grampa.ContextFree.Memoizing,+                       Text.Grampa.ContextFree.Memoizing.LeftRecursive,                        Text.Grampa.ContextFree.SortedMemoizing,+                       Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive,                        Text.Grampa.ContextFree.SortedMemoizing.Transformer,+                       Text.Grampa.ContextFree.SortedMemoizing.Transformer.LeftRecursive,                        Text.Grampa.ContextFree.LeftRecursive,                        Text.Grampa.ContextFree.LeftRecursive.Transformer-  other-modules:       Text.Grampa.Class, Text.Grampa.Internal,+  other-modules:       Text.Grampa.Class,+                       Text.Grampa.Internal, Text.Grampa.Internal.LeftRecursive, Text.Grampa.Internal.Storable,                        Text.Grampa.PEG.Backtrack.Measured,                        Text.Grampa.PEG.Continued, Text.Grampa.PEG.Continued.Measured,-                       Text.Grampa.ContextFree.Memoizing,                        Text.Grampa.ContextFree.Continued.Measured   default-language:    Haskell2010   ghc-options:         -Wall   build-depends:       base >=4.9 && <5,                        containers >= 0.4 && < 0.7,                        transformers >= 0.5 && < 0.6,-                       monoid-subclasses >=1.0 && <1.2,+                       monoid-subclasses >=1.0 && <1.3,                        parsers < 0.13,-                       input-parsers < 0.3,+                       input-parsers < 0.4,                        attoparsec >= 0.13 && < 0.15,                        witherable == 0.4.*,-                       rank2classes >= 1.0.2 && < 1.5+                       rank2classes >= 1.4.6 && < 1.5  executable             arithmetic   hs-source-dirs:      examples@@ -62,7 +66,7 @@   build-depends:       base >=4.9 && <5, containers >= 0.5.7.0 && < 0.7,                        parsers < 0.13,                        rank2classes >= 1.0.2 && < 1.5, grammatical-parsers,-                       monoid-subclasses >=1.0 && <1.2+                       monoid-subclasses  executable             boolean-transformations   hs-source-dirs:      examples@@ -72,14 +76,14 @@   build-depends:       base >=4.9 && <5, containers >= 0.5.7.0 && < 0.7,                        parsers < 0.13,                        rank2classes >= 1.0.2 && < 1.5, grammatical-parsers,-                       monoid-subclasses >=1.0 && <1.2+                       monoid-subclasses  test-suite           quicktests   type:              exitcode-stdio-1.0   hs-source-dirs:    test, examples   x-uses-tf:         true   build-depends:     base >=4.9 && < 5, containers >= 0.5.7.0 && < 0.7,-                     monoid-subclasses < 1.2, parsers < 0.13,+                     monoid-subclasses, parsers < 0.13,                      witherable == 0.4.*,                      rank2classes >= 1.0.2 && < 1.5, grammatical-parsers,                      QuickCheck >= 2 && < 3, checkers >= 0.4.6 && < 0.6,@@ -104,7 +108,7 @@   hs-source-dirs:    test, examples   ghc-options:       -O2 -Wall -rtsopts -main-is Benchmark.main   Build-Depends:     base >=4.9 && < 5, rank2classes >= 1.0.2 && < 1.5, grammatical-parsers,-                     monoid-subclasses >=1.0 && <1.2, parsers < 0.13,+                     monoid-subclasses, parsers < 0.13,                      criterion >= 1.0, deepseq >= 1.1, containers >= 0.5.7.0 && < 0.7, text >= 1.1   main-is:           Benchmark.hs   other-modules:     Main, Arithmetic, Boolean, Combined, Comparisons, Conditionals, Lambda, Utilities

@@ -1,6 +1,7 @@ -- | A collection of parsing algorithms with a common interface, operating on grammars represented as records with -- rank-2 field types.-{-# LANGUAGE FlexibleContexts, KindSignatures, OverloadedStrings, RankNTypes, ScopedTypeVariables, TypeFamilies #-}+{-# LANGUAGE FlexibleContexts, KindSignatures, OverloadedStrings, RankNTypes, ScopedTypeVariables,+             TypeFamilies, TypeOperators #-} module Text.Grampa (    -- * Applying parsers    failureDescription, simply,@@ -83,12 +84,12 @@ -- | Given the textual parse input, the parse failure on the input, and the number of lines preceding the failure to -- show, produce a human-readable failure description. failureDescription :: forall s pos. (Ord s, TextualMonoid s, Position pos) => s -> ParseFailure pos s -> Int -> s-failureDescription input (ParseFailure pos expected erroneous) contextLineCount =+failureDescription input (ParseFailure pos (FailureDescription expected inputs) erroneous) contextLineCount =    Position.context input pos contextLineCount    <> mconcat       (intersperse ", but " $ filter (not . null)-       [onNonEmpty ("expected " <>) $ oxfordComma " or " (fromDescription <$> expected),-        oxfordComma " and " (fromDescription <$> erroneous)])+       [onNonEmpty ("expected " <>) $ oxfordComma " or " ((fromString <$> expected) <> (fromLiteral <$> inputs)),+        oxfordComma " and " (fromString <$> erroneous)])    where oxfordComma :: s -> [s] -> s          oxfordComma _ [] = ""          oxfordComma _ [x] = x@@ -98,5 +99,4 @@          onLast _ [] = []          onLast f [x] = [f x]          onLast f (x:xs) = x : onLast f xs-         fromDescription (StaticDescription s) = fromString s-         fromDescription (LiteralDescription s) = "string \"" <> s <> "\""+         fromLiteral s = "string \"" <> s <> "\""

@@ -1,6 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor,              FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, OverloadedStrings,-             RankNTypes, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeSynonymInstances,+             RankNTypes, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, TypeSynonymInstances,              UndecidableInstances #-} -- | The core classes supported by all the parsers in this library. module Text.Grampa.Class (MultiParsing(..), GrammarParsing(..),@@ -40,8 +40,8 @@ -- | A 'ParseFailure' contains the offset of the parse failure and the list of things expected at that offset. data ParseFailure pos s =    ParseFailure {failurePosition :: pos,-                 expectedAlternatives :: [FailureDescription s],  -- ^ expected input alternatives-                 errorAlternatives ::    [FailureDescription s]   -- ^ erroneous input descriptions+                 expectedAlternatives :: FailureDescription s,  -- ^ expected input alternatives+                 errorAlternatives ::    [String]               -- ^ erroneous alternatives                 }    deriving (Eq, Functor, Show) @@ -49,26 +49,38 @@ type Pos = Down Int  -- | An expected or erroneous input can be described using 'String' or using the input type-data FailureDescription s = StaticDescription String   -- ^ a readable description of the expected input-                          | LiteralDescription s       -- ^ a literal piece of expected input+data FailureDescription s = FailureDescription {staticDescriptions  :: [String],+                                                literalDescriptions :: [s]}                             deriving (Functor, Eq, Ord, Read, Show)  instance (Ord pos, Ord s) => Semigroup (ParseFailure pos s) where-   ParseFailure pos1 exp1 err1 <> ParseFailure pos2 exp2 err2 = ParseFailure pos' exp' err'-      where (pos', exp', err') | pos1 > pos2 = (pos1, exp1, err1)-                               | pos1 < pos2 = (pos2, exp2, err2)-                               | otherwise = (pos1, merge exp1 exp2, merge err1 err2)-            merge [] xs = xs-            merge xs [] = xs-            merge xs@(x:xs') ys@(y:ys')-               | x < y = x : merge xs' ys-               | x > y = y : merge xs ys'-               | otherwise = x : merge xs' ys'+   f1@(ParseFailure pos1 exp1 err1) <> f2@(ParseFailure pos2 exp2 err2) = ParseFailure pos' exp' err'+      where ParseFailure pos' exp' err'+               | pos1 > pos2 = f1+               | pos1 < pos2 = f2+               | otherwise = ParseFailure pos1 (exp1 <> exp2) (mergeSorted err1 err2) +instance Ord s => Semigroup (FailureDescription s) where+   exp1 <> exp2 =+      FailureDescription+         (mergeSorted (staticDescriptions exp1) (staticDescriptions exp2))+         (mergeSorted (literalDescriptions exp1) (literalDescriptions exp2))++mergeSorted :: Ord a => [a] -> [a] -> [a]+mergeSorted [] xs = xs+mergeSorted xs [] = xs+mergeSorted xs@(x:xs') ys@(y:ys')+   | x < y = x : mergeSorted xs' ys+   | x > y = y : mergeSorted xs ys'+   | otherwise = x : mergeSorted xs' ys'+ instance Ord s => Monoid (ParseFailure Pos s) where-   mempty = ParseFailure (Down maxBound) [] []+   mempty = ParseFailure (Down maxBound) mempty []    mappend = (<>) +instance Ord s => Monoid (FailureDescription s) where+   mempty = FailureDescription mempty mempty+ -- | An 'Ambiguous' parse result, produced by the 'ambiguous' combinator, contains a 'NonEmpty' list of -- alternative results. newtype Ambiguous a = Ambiguous{getAmbiguous :: NonEmpty a} deriving (Data, Eq, Ord, Show, Typeable)@@ -106,7 +118,7 @@ completeParser (Compose (Left failure)) = Compose (Left failure) completeParser (Compose (Right (Compose results))) =    case filter (Null.null . fst) results-   of [] -> Compose (Left $ ParseFailure 0 [StaticDescription "a complete parse"] [])+   of [] -> Compose (Left $ ParseFailure 0 (FailureDescription ["a complete parse"] []) [])       completeResults -> Compose (Right $ snd <$> completeResults)  -- | Choose one of the instances of this class to parse with.@@ -139,6 +151,34 @@    fixGrammar :: (g ~ ParserGrammar m, GrammarConstraint m g, Rank2.Distributive g) => (g m -> g m) -> g m    -- | Mark a parser that relies on primitive recursion to prevent an infinite loop in 'fixGrammar'.    recursive :: m a -> m a+   -- | Convert a left-recursive parser to a non-left-recursive one. For example, you can replace the left-recursive+   -- production+   --+   -- > foo = BinOp <$> foo <*> bar <|> baz+   --+   -- in the field @foo@ of grammar @g@ with+   --+   -- > foo = chainRecursive (\x g-> g{foo = x}) baz (BinOp <$> foo <*> bar)+   --+   -- This method works on individual parsers left-recursive on themselves, not on grammars with mutually+   -- left-recursive productions. Use "Text.Grampa.ContextFree.Memoizing.LeftRecursive" for the latter.+   chainRecursive :: (g ~ ParserGrammar m, f ~ GrammarFunctor m, GrammarConstraint m g)+                  => (f a -> g f -> g f) -- ^ setter for the parsed results of each iteration+                  -> m a -- ^ the non-recursive base case+                  -> m a -- ^ the recursive case to iterate+                  -> m a+   -- | Line 'chainRecursive' but produces only the longest possible parse. The modified example+   --+   -- > foo = chainLongestRecursive (\x g-> g{foo = x}) baz (BinOp <$> foo <*> bar)+   --+   -- would be equivalent to the left-recursive production with biased choice+   --+   -- > foo = BinOp <$> foo <*> bar <<|> baz+   chainLongestRecursive :: (g ~ ParserGrammar m, f ~ GrammarFunctor m, GrammarConstraint m g)+                         => (f a -> g f -> g f) -- ^ setter for the parsed results of each iteration+                         -> m a -- ^ the non-recursive base case+                         -> m a -- ^ the recursive case to iterate+                         -> m a     selfReferring = Rank2.cotraverse nonTerminal id    {-# INLINE selfReferring #-}

@@ -1,11 +1,11 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, TypeOperators #-} -- | A collection of useful parsing combinators not found in dependent libraries. module Text.Grampa.Combinators (moptional, concatMany, concatSome, someNonEmpty,                                 flag, count, upto,                                 delimiter, operator, keyword) where -import Control.Applicative(Applicative(..), Alternative(..))-import Data.List.NonEmpty (NonEmpty((:|)), fromList)+import Control.Applicative(Alternative(..))+import Data.List.NonEmpty (NonEmpty((:|))) import Data.Monoid (Monoid, (<>)) import Data.Monoid.Factorial (FactorialMonoid) import Data.Semigroup (Semigroup(sconcat))

@@ -34,12 +34,12 @@ import Text.Grampa.Class (CommittedParsing(..), DeterministicParsing(..),                           InputParsing(..), InputCharParsing(..), MultiParsing(..),                           ParseResults, ParseFailure(..), FailureDescription(..), Pos)-import Text.Grampa.Internal (expected, TraceableParsing(..))+import Text.Grampa.Internal (emptyFailure, erroneous, expected, expectedInput, replaceExpected, TraceableParsing(..))  data Result (g :: (Type -> Type) -> Type) s v =      Parsed{parsedPrefix :: !v,             parsedSuffix :: !s}-   | NoParse (ParseFailure Pos s)+   | NoParse {-# UNPACK #-} !(ParseFailure Pos s)  -- | Parser type for context-free grammars that uses a continuation-passing algorithm, fast for grammars in LL(1) -- class but with potentially exponential performance for longer ambiguous prefixes.@@ -67,7 +67,7 @@    {-# INLINABLE (<*>) #-}  instance (Factorial.FactorialMonoid s, Ord s) => Alternative (Parser g s) where-   empty = Parser (\rest _ failure-> failure $ ParseFailure (fromEnd $ Factorial.length rest) [] [])+   empty = Parser (\rest _ failure-> failure $ emptyFailure $ fromEnd $ Factorial.length rest)    (<|>) = alt  -- | A named and unconstrained version of the '<|>' operator@@ -105,8 +105,7 @@ #if MIN_VERSION_base(4,13,0) instance Factorial.FactorialMonoid s => MonadFail (Parser g s) where #endif-   fail msg = Parser (\rest _ failure->-                       failure $ ParseFailure (fromEnd $ Factorial.length rest) [] [StaticDescription msg])+   fail msg = Parser (\rest _ failure-> failure $ erroneous (fromEnd $ Factorial.length rest) msg)  instance (Factorial.FactorialMonoid s, Ord s) => MonadPlus (Parser g s) where    mzero = empty@@ -124,21 +123,17 @@    try (Parser p) = Parser q       where q :: forall x. s -> (a -> s -> (ParseFailure Pos s -> x) -> x) -> (ParseFailure Pos s -> x) -> x             q input success failure = p input success (failure . rewindFailure)-               where rewindFailure ParseFailure{} = ParseFailure (fromEnd $ Factorial.length input) [] []+               where rewindFailure ParseFailure{} = emptyFailure (fromEnd $ Factorial.length input)    (<?>) :: forall a. Parser g s a -> String -> Parser g s a    Parser p <?> msg  = Parser q       where q :: forall x. s -> (a -> s -> (ParseFailure Pos s -> x) -> x) -> (ParseFailure Pos s -> x) -> x-            q input success failure = p input success (failure . replaceFailure)-               where replaceFailure (ParseFailure pos msgs erroneous) =-                        ParseFailure pos (if pos == fromEnd (Factorial.length input) then [StaticDescription msg]-                                          else msgs) erroneous+            q input success failure = p input success (failure . replaceExpected (fromEnd $ Factorial.length input) msg)     eof = Parser p       where p rest success failure                | Null.null rest = success () rest failure                | otherwise = failure (expected (fromEnd $ Factorial.length rest) "end of input")-   unexpected msg = Parser (\t _ failure ->-                             failure $ ParseFailure (fromEnd $ Factorial.length t) [] [StaticDescription msg])+   unexpected msg = Parser (\t _ failure -> failure $ erroneous (fromEnd $ Factorial.length t) msg)    notFollowedBy (Parser p) = Parser q       where q :: forall x. s -> (() -> s -> (ParseFailure Pos s -> x) -> x) -> (ParseFailure Pos s -> x) -> x             q input success failure = p input success' failure'@@ -234,17 +229,18 @@       p :: forall x. s -> (s -> s -> (ParseFailure Pos s -> x) -> x) -> (ParseFailure Pos s -> x) -> x       p s' success failure          | Just suffix <- Cancellative.stripPrefix s s' = success s suffix failure-         | otherwise = failure (ParseFailure (fromEnd $ Factorial.length s') [LiteralDescription s] [])+         | otherwise = failure (expectedInput (fromEnd $ Factorial.length s') s)    {-# INLINABLE string #-} -instance InputParsing (Parser g s)  => TraceableParsing (Parser g s) where+instance (InputParsing (Parser g s), FactorialMonoid s)  => TraceableParsing (Parser g s) where    traceInput :: forall a. (s -> String) -> Parser g s a -> Parser g s a    traceInput description (Parser p) = Parser q       where q :: forall x. s -> (a -> s -> (ParseFailure Pos s -> x) -> x) -> (ParseFailure Pos s -> x) -> x             q rest success failure = traceWith "Parsing " (p rest success' failure')                where traceWith prefix = trace (prefix <> description rest)                      failure' f = traceWith "Failed " (failure f)-                     success' r suffix failure'' = traceWith "Parsed " (success r suffix failure'')+                     success' r suffix failure'' = trace ("Parsed " <> description prefix) (success r suffix failure'')+                        where prefix = Factorial.take (Factorial.length rest - Factorial.length suffix) rest  instance (Ord s, Show s, TextualMonoid s) => InputCharParsing (Parser g s) where    satisfyCharInput predicate = Parser p

@@ -33,13 +33,13 @@ import Text.Parser.Input.Position (fromEnd) import Text.Grampa.Class (CommittedParsing(..), DeterministicParsing(..),                           InputParsing(..), InputCharParsing(..), ConsumedInputParsing(..),-                          MultiParsing(..), ParseResults, ParseFailure(..), FailureDescription(..), Pos)-import Text.Grampa.Internal (expected, erroneous, TraceableParsing(..))+                          MultiParsing(..), ParseResults, ParseFailure(..), Pos)+import Text.Grampa.Internal (emptyFailure, erroneous, expected, expectedInput, replaceExpected, TraceableParsing(..))  data Result (g :: (Type -> Type) -> Type) s v =      Parsed{parsedPrefix :: !v,             parsedSuffix :: !s}-   | NoParse (ParseFailure Pos s)+   | NoParse {-# UNPACK #-} !(ParseFailure Pos s)  -- | Parser type for context-free grammars that uses a continuation-passing algorithm, fast for grammars in LL(1) -- class but with potentially exponential performance for longer ambiguous prefixes.@@ -67,7 +67,7 @@    {-# INLINABLE (<*>) #-}  instance (Factorial.FactorialMonoid s, Ord s) => Alternative (Parser g s) where-   empty = Parser (\rest _ failure-> failure $ ParseFailure (fromEnd $ Factorial.length rest) [] [])+   empty = Parser (\rest _ failure-> failure $ emptyFailure $ fromEnd $ Factorial.length rest)    (<|>) = alt  -- | A named and unconstrained version of the '<|>' operator@@ -120,14 +120,11 @@    try (Parser p) = Parser q       where q :: forall x. s -> (a -> Int -> s -> (ParseFailure Pos s -> x) -> x) -> (ParseFailure Pos s -> x) -> x             q input success failure = p input success (failure . rewindFailure)-               where rewindFailure ParseFailure{} = ParseFailure (fromEnd $ Factorial.length input) [] []+               where rewindFailure ParseFailure{} = emptyFailure (fromEnd $ Factorial.length input)    (<?>) :: forall a. Parser g s a -> String -> Parser g s a    Parser p <?> msg  = Parser q       where q :: forall x. s -> (a -> Int -> s -> (ParseFailure Pos s -> x) -> x) -> (ParseFailure Pos s -> x) -> x-            q input success failure = p input success (failure . replaceFailure)-               where replaceFailure (ParseFailure pos msgs erroneous') =-                        ParseFailure pos (if pos == fromEnd (Factorial.length input) then [StaticDescription msg]-                                          else msgs) erroneous'+            q input success failure = p input success (failure . replaceExpected (fromEnd $ Factorial.length input) msg)    eof = Parser p       where p rest success failure                | Null.null rest = success () 0 rest failure@@ -234,7 +231,7 @@       p :: forall x. s -> (s -> Int -> s -> (ParseFailure Pos s -> x) -> x) -> (ParseFailure Pos s -> x) -> x       p s' success failure          | Just suffix <- Cancellative.stripPrefix s s', !len <- Factorial.length s = success s len suffix failure-         | otherwise = failure (ParseFailure (fromEnd $ Factorial.length s') [LiteralDescription s] [])+         | otherwise = failure (expectedInput (fromEnd $ Factorial.length s') s)    {-# INLINABLE string #-}  instance (Cancellative.LeftReductive s, FactorialMonoid s, Ord s) => ConsumedInputParsing (Parser g s) where@@ -244,14 +241,15 @@             q rest success failure = p rest success' failure                where success' r !len suffix failure' = success (Factorial.take len rest, r) len suffix failure' -instance InputParsing (Parser g s)  => TraceableParsing (Parser g s) where+instance (InputParsing (Parser g s), FactorialMonoid s)  => TraceableParsing (Parser g s) where    traceInput :: forall a. (s -> String) -> Parser g s a -> Parser g s a    traceInput description (Parser p) = Parser q       where q :: forall x. s -> (a -> Int -> s -> (ParseFailure Pos s -> x) -> x) -> (ParseFailure Pos s -> x) -> x             q rest success failure = traceWith "Parsing " (p rest success' failure')                where traceWith prefix = trace (prefix <> description rest)                      failure' f = traceWith "Failed " (failure f)-                     success' r !len suffix failure'' = traceWith "Parsed " (success r len suffix failure'')+                     success' r !len suffix failure'' =+                        trace ("Parsed " <> description (Factorial.take len rest)) (success r len suffix failure'')  instance (Ord s, Show s, TextualMonoid s) => InputCharParsing (Parser g s) where    satisfyCharInput predicate = Parser p

@@ -1,881 +1,7 @@-{-# LANGUAGE ConstraintKinds, CPP, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, InstanceSigs,-             RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeFamilies, TypeOperators,-             UndecidableInstances #-}-{-# OPTIONS -fno-full-laziness #-} -- | A context-free memoizing parser that can handle left-recursive grammars.-module Text.Grampa.ContextFree.LeftRecursive (Fixed, Parser, SeparatedParser(..),-                                              longest, peg, terminalPEG,-                                              liftPositive, liftPure, mapPrimitive,-                                              parseSeparated, separated)+module Text.Grampa.ContextFree.LeftRecursive+       {-# DEPRECATED "Use Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive instead" #-}+       (module Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive) where -import Control.Applicative-import Control.Monad (Monad(..), MonadPlus(..), void)-#if MIN_VERSION_base(4,13,0)-import Control.Monad (MonadFail(fail))-#endif-import Control.Monad.Trans.State.Lazy (State, evalState, get, put)--import Data.Functor.Compose (Compose(..))-import Data.Kind (Type)-import Data.Maybe (isJust)--import Data.Semigroup (Semigroup(..))-import Data.Monoid (Monoid(mempty), All(..), Any(..))-import Data.Monoid.Null (MonoidNull(null))-import Data.Monoid.Factorial (FactorialMonoid)-import Data.Monoid.Textual (TextualMonoid)-import Data.Semigroup.Cancellative (LeftReductive)-import qualified Data.Monoid.Factorial as Factorial-import qualified Data.Monoid.Textual as Textual-import Data.String (fromString)-import Data.Type.Equality ((:~:)(Refl))-import Witherable (Filterable(mapMaybe))--import qualified Text.Parser.Char as Char-import Text.Parser.Char (CharParsing)-import Text.Parser.Combinators (Parsing(..))-import Text.Parser.LookAhead (LookAheadParsing(..))--import qualified Rank2-import Text.Grampa.Class (GrammarParsing(..), InputParsing(..), InputCharParsing(..), MultiParsing(..),-                          AmbiguousParsing(..), CommittedParsing(..), ConsumedInputParsing(..),-                          DeterministicParsing(..),-                          TailsParsing(parseTails, parseAllTails), ParseResults, ParseFailure(..), Pos)-import Text.Grampa.Internal (ResultList(..), FallibleResults(..),-                             AmbiguousAlternative(ambiguousOr), AmbiguityDecidable(..), AmbiguityWitness(..),-                             TraceableParsing(..))-import qualified Text.Grampa.ContextFree.SortedMemoizing as Memoizing-import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack--import Prelude hiding (cycle, null, span, take, takeWhile)---- | A parser for left-recursive grammars-type Parser = Fixed Memoizing.Parser--type ResultAppend p (g :: (Type -> Type) -> Type) s =-   GrammarFunctor (p g s) Rank2.~> GrammarFunctor (p g s) Rank2.~> GrammarFunctor (p g s)---- | A transformer that adds left-recursive powers to a memoizing parser @p@ over grammar @g@-data Fixed p g s a =-   -- | a fully general parser-   Parser {-      complete, direct, direct0, direct1, indirect :: p g s a,-      isAmbiguous :: Maybe (AmbiguityWitness a),-      cyclicDescendants :: Rank2.Apply g => g (Const (ParserFlags g)) -> ParserFlags g}-   -- | a parser that doesn't start with a 'nonTerminal'-   | DirectParser {-      complete, direct0, direct1 :: p g s a}-   -- | a parser that doesn't start with a 'nonTerminal' and always consumes some input-   | PositiveDirectParser {-      complete :: p g s a}---- | A type of parsers analyzed for their left-recursion class-data SeparatedParser p (g :: (Type -> Type) -> Type) s a =-   -- | a parser that doesn't start with any 'nonTerminal' so it can run first-   FrontParser (p g s a)-   -- | a left-recursive parser that may add to the set of parse results every time it's run-   | CycleParser {-        cycleParser  :: p g s a,-        backParser   :: p g s a,-        appendResultsArrow :: ResultAppend p g s a,-        dependencies :: Dependencies g}-   -- | a parser that depends on other non-terminals but is not left-recursive-   | BackParser {-        backParser :: p g s a}--data ParserFlags g = ParserFlags {-   nullable :: Bool,-   dependsOn :: Dependencies g}--deriving instance Show (Dependencies g) => Show (ParserFlags g)--data Dependencies g = DynamicDependencies-                    | StaticDependencies (g (Const Bool))--deriving instance Show (g (Const Bool)) => Show (Dependencies g)--data ParserFunctor p g s a = ParserResultsFunctor {parserResults :: GrammarFunctor (p g s) a}-                           | ParserFlagsFunctor {parserFlags :: ParserFlags g}--newtype Union (g :: (Type -> Type) -> Type) = Union{getUnion :: g (Const Bool)}----instance Rank2.Applicative g => Monoid (Union g) where---   mempty = Union (Rank2.pure $ Const False)--instance (Rank2.Apply g, Rank2.Distributive g) => Semigroup (Union g) where-   Union g1 <> Union g2 = Union (Rank2.liftA2 union g1 g2)--instance (Rank2.Apply g, Rank2.Distributive g) => Monoid (Union g) where-   mempty = Union (Rank2.cotraverse (Const . getConst) (Const False))-   mappend = (<>)--mapPrimitive :: forall p g s a b. AmbiguityDecidable b => (p g s a -> p g s b) -> Fixed p g s a -> Fixed p g s b-mapPrimitive f p@PositiveDirectParser{} = PositiveDirectParser{complete= f (complete p)}-mapPrimitive f p@DirectParser{} = DirectParser{complete= f (complete p),-                                               direct0= f (direct0 p),-                                               direct1= f (direct1 p)}-mapPrimitive f p@Parser{} = Parser{complete= f (complete p),-                                   isAmbiguous= ambiguityWitness @b,-                                   cyclicDescendants= cyclicDescendants p,-                                   indirect= f (indirect p),-                                   direct= f (direct p),-                                   direct0= f (direct0 p),-                                   direct1= f (direct1 p)}--general, general' :: Alternative (p g s) => Fixed p g s a -> Fixed p g s a--general p = Parser{-   complete= complete p,-   direct = direct p',-   direct0= direct0 p',-   direct1= direct1 p',-   indirect= indirect p',-   isAmbiguous= case p-                of Parser{isAmbiguous= a} -> a-                   _ -> Nothing,-   cyclicDescendants= cyclicDescendants p'}-   where p' = general' p--general' p@PositiveDirectParser{} = Parser{-   complete= complete p,-   direct = complete p,-   direct0= empty,-   direct1= complete p,-   indirect= empty,-   isAmbiguous= Nothing,-   cyclicDescendants= \cd-> ParserFlags False (StaticDependencies $ const (Const False) Rank2.<$> cd)}-general' p@DirectParser{} = Parser{-   complete= complete p,-   direct = complete p,-   direct0= direct0 p,-   direct1= direct1 p,-   indirect= empty,-   isAmbiguous= Nothing,-   cyclicDescendants= \cd-> ParserFlags True (StaticDependencies $ const (Const False) Rank2.<$> cd)}-general' p@Parser{} = p--type LeftRecParsing p g s f = (Eq s, LeftReductive s, FactorialMonoid s, Alternative (p g s),-                               TailsParsing (p g s), GrammarConstraint (p g s) g, ParserGrammar (p g s) ~ g,-                               Functor (ResultFunctor (p g s)), s ~ ParserInput (p g s), FallibleResults f,-                               AmbiguousAlternative (GrammarFunctor (p g s)))---- | Parser transformer for left-recursive grammars.------ @--- 'parseComplete' :: ("Rank2".'Rank2.Apply' g, "Rank2".'Rank2.Traversable' g, 'FactorialMonoid' s) =>---                  g (LeftRecursive.'Parser' g s) -> s -> g ('Compose' ('ParseResults' s) [])--- @-instance (GrammarFunctor (p g s) ~ f s, LeftRecParsing p g s f) => MultiParsing (Fixed p g s) where-   type GrammarConstraint (Fixed p g s) g' = (GrammarConstraint (p g s) g', g ~ g',-                                              Rank2.Apply g, Rank2.Distributive g, Rank2.Traversable g)-   type ResultFunctor (Fixed p g s) = ResultFunctor (p g s)-   -- parsePrefix :: (Rank2.Apply g, Rank2.Distributive g, Rank2.Traversable g, Eq s, FactorialMonoid s) =>-   --                g (Fixed p g s) -> s -> g (Compose (ResultFunctor (p g s)) ((,) s))-   parsePrefix g input = Rank2.fmap (Compose . parsingResult @(p g s) input)-                                    (snd $ head $ parseRecursive g input)-   {-# INLINE parsePrefix #-}-   -- parseComplete :: (Rank2.Apply g, Rank2.Distributive g, Rank2.Traversable g, Eq s, FactorialMonoid s) =>-   --                  g (Fixed p g s) -> s -> g (ResultFunctor (p g s))-   parseComplete g = \input-> let close :: g (p g s)-                                  close = Rank2.fmap (<* eof) selfReferring-                              in Rank2.fmap ((snd <$>) . parsingResult @(p g s) input)-                                            (snd $ head $ parseAllTails close $ parseSeparated g' input)-      where g' = separated g-   {-# INLINE parseComplete #-}---- | Parser transformer for left-recursive grammars.-instance (GrammarFunctor (p g s) ~ f s, LeftRecParsing p g s f) => GrammarParsing (Fixed p g s) where-   type ParserGrammar (Fixed p g s) = g-   type GrammarFunctor (Fixed p g s) = ParserFunctor p g s-   parsingResult :: s -> ParserFunctor p g s a -> ResultFunctor (p g s) (s, a)-   parsingResult s = parsingResult @(p g s) s . parserResults-   nonTerminal :: (Rank2.Apply g, Rank2.Distributive g, Rank2.Traversable g) =>-                  (g (ParserFunctor p g s) -> ParserFunctor p g s a) -> Fixed p g s a-   nonTerminal f = Parser{-      complete= ind,-      direct= empty,-      direct0= empty,-      direct1= empty,-      indirect= ind,-      isAmbiguous= Nothing,-      cyclicDescendants= parserFlags . f . Rank2.fmap (ParserFlagsFunctor . getConst) . addSelf}-      where ind = nonTerminal (parserResults . f . Rank2.fmap ParserResultsFunctor)-            addSelf g = Rank2.liftA2 adjust bits g-            adjust :: forall b. Const (g (Const Bool)) b -> Const (ParserFlags g) b -> Const (ParserFlags g) b-            adjust (Const bit) (Const (ParserFlags n (StaticDependencies d))) =-               Const ParserFlags{-                  nullable= n, -                  dependsOn= StaticDependencies (Rank2.liftA2 union bit d)}-            adjust _ flags@(Const (ParserFlags _ DynamicDependencies)) = flags-   {-# INLINE nonTerminal #-}-   recursive = general--bits :: forall (g :: (Type -> Type) -> Type). (Rank2.Distributive g, Rank2.Traversable g) => g (Const (g (Const Bool)))-bits = start `seq` Rank2.fmap oneBit start-   where start = evalState (Rank2.traverse next (Rank2.distributeJoin Nothing)) 0-         oneBit :: Const Int a -> Const (g (Const Bool)) a-         next :: f a -> State Int (Const Int a)-         oneBit (Const i) = Const (Rank2.fmap (Const . (i ==) . getConst) start)-         next _ = do {i <- get; let {i' = succ i}; seq i' (put i'); return (Const i)}--instance Functor (p g s) => Functor (Fixed p g s) where-   fmap f (PositiveDirectParser p) = PositiveDirectParser (fmap f p)-   fmap f p@DirectParser{} = DirectParser{-      complete= fmap f (complete p),-      direct0= fmap f (direct0 p),-      direct1= fmap f (direct1 p)}-   fmap f p@Parser{} = p{-      complete= fmap f (complete p),-      direct= fmap f (direct p),-      direct0= fmap f (direct0 p),-      direct1= fmap f (direct1 p),-      indirect= fmap f (indirect p),-      isAmbiguous= Nothing}-   {-# INLINABLE fmap #-}--instance Alternative (p g s) => Applicative (Fixed p g s) where-   pure a = DirectParser{complete= pure a,-                         direct0= pure a,-                         direct1= empty}-   p@PositiveDirectParser{} <*> q = PositiveDirectParser{-      complete= complete p <*> complete q}-   p@DirectParser{} <*> q@PositiveDirectParser{} = PositiveDirectParser{-      complete= complete p <*> complete q}-   p@DirectParser{} <*> q@DirectParser{} = DirectParser{-      complete= complete p <*> complete q,-      direct0= direct0 p <*> direct0 q,-      direct1= direct0 p <*> direct1 q <|> direct1 p <*> complete q}-   p <*> q@Parser{} = Parser{-      complete= complete p' <*> complete q,-      direct= direct0 p' <*> direct q <|> direct1 p' <*> complete q,-      direct0= direct0 p' <*> direct0 q,-      direct1= direct0 p' <*> direct1 q <|> direct1 p' <*> complete q,-      indirect= direct0 p' <*> indirect q <|> indirect p' <*> complete q,-      isAmbiguous= Nothing,-      cyclicDescendants= \deps-> let-           pcd@(ParserFlags pn pd) = cyclicDescendants p' deps-           ParserFlags qn qd = cyclicDescendants q deps-        in if pn-           then ParserFlags qn (depUnion pd qd)-           else pcd}-      where p'@Parser{} = general' p-   p <*> q = Parser{-      complete= complete p' <*> complete q',-      direct= direct p' <*> complete q',-      direct0= direct0 p' <*> direct0 q',-      direct1= direct0 p' <*> direct1 q' <|> direct1 p' <*> complete q',-      indirect= indirect p' <*> complete q',-      isAmbiguous= Nothing,-      cyclicDescendants= \deps-> let-           pcd@(ParserFlags pn pd) = cyclicDescendants p' deps-           ParserFlags qn qd = cyclicDescendants q' deps-        in if pn-           then ParserFlags qn (depUnion pd qd)-           else pcd}-      where p'@Parser{} = general' p-            q'@Parser{} = general' q-   {-# INLINABLE pure #-}-   {-# INLINABLE (<*>) #-}--instance Alternative (p g s) => Alternative (Fixed p g s) where-   empty = PositiveDirectParser{complete= empty}-   p@PositiveDirectParser{} <|> q@PositiveDirectParser{} = PositiveDirectParser{complete= complete p <|> complete q}-   p@PositiveDirectParser{} <|> q@DirectParser{} = DirectParser{-      complete= complete p <|> complete q,-      direct0 = direct0 q,-      direct1= complete p <|> direct1 q}-   p@DirectParser{} <|> q@PositiveDirectParser{} = DirectParser{-      complete= complete p <|> complete q,-      direct0 = direct0 p,-      direct1= direct1 p <|> complete q}-   p@DirectParser{} <|> q@DirectParser{} = DirectParser{-      complete= complete p <|> complete q,-      direct0 = direct0 p <|> direct0 q,-      direct1= direct1 p <|> direct1 q}-   p <|> q = Parser{complete= complete p' <|> complete q',-                    direct= direct p' <|> direct q',-                    direct0= direct0 p' <|> direct0 q',-                    direct1= direct1 p' <|> direct1 q',-                    indirect= indirect p' <|> indirect q',-                    isAmbiguous= Nothing,-                    cyclicDescendants= \deps-> let-                         ParserFlags pn pd = cyclicDescendants p' deps-                         ParserFlags qn qd = cyclicDescendants q' deps-                      in ParserFlags (pn || qn) (depUnion pd qd)}-      where p'@Parser{} = general p-            q'@Parser{} = general q-   many (PositiveDirectParser p) = DirectParser{-      complete= many p,-      direct0= pure [],-      direct1= some p}-   many p@DirectParser{} = DirectParser{-      complete= many (complete p),-      direct0= pure [] <|> (:[]) <$> direct0 p,-      direct1= (:) <$> direct1 p <*> many (complete p)}-   many p@Parser{} = Parser{-      complete= mcp,-      direct= d0 <|> d1,-      direct0= d0,-      direct1= d1,-      indirect= (:) <$> indirect p <*> mcp,-      isAmbiguous= Nothing,-      cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}-      where d0 = pure [] <|> (:[]) <$> direct0 p-            d1 = (:) <$> direct1 p <*> mcp-            mcp = many (complete p)-   some (PositiveDirectParser p) = PositiveDirectParser{complete= some p}-   some p@DirectParser{} = DirectParser{-      complete= some (complete p),-      direct0= (:[]) <$> direct0 p,-      direct1= (:) <$> direct1 p <*> many (complete p)}-   some p@Parser{} = Parser{-      complete= some (complete p),-      direct= d0 <|> d1,-      direct0= d0,-      direct1= d1,-      indirect= (:) <$> indirect p <*> many (complete p),-      isAmbiguous= Nothing,-      cyclicDescendants= cyclicDescendants p}-      where d0 = (:[]) <$> direct0 p-            d1= (:) <$> direct1 p <*> many (complete p)-   {-# INLINABLE (<|>) #-}-   {-# INLINABLE many #-}-   {-# INLINABLE some #-}--instance Filterable (p g s) => Filterable (Fixed p g s) where-   mapMaybe f (PositiveDirectParser p) = PositiveDirectParser (mapMaybe f p)-   mapMaybe f p@DirectParser{} = DirectParser{-      complete= mapMaybe f (complete p),-      direct0= mapMaybe f (direct0 p),-      direct1= mapMaybe f (direct1 p)}-   mapMaybe f p@Parser{} = p{-      complete= mapMaybe f (complete p),-      direct= mapMaybe f (direct p),-      direct0= mapMaybe f (direct0 p),-      direct1= mapMaybe f (direct1 p),-      indirect= mapMaybe f (indirect p),-      isAmbiguous= Nothing}-   {-# INLINABLE mapMaybe #-}--union :: Const Bool x -> Const Bool x -> Const Bool x-union (Const False) d = d-union (Const True) _ = Const True--depUnion :: Rank2.Apply g => Dependencies g -> Dependencies g -> Dependencies g-depUnion (StaticDependencies d1) (StaticDependencies d2) = StaticDependencies (Rank2.liftA2 union d1 d2)-depUnion _ _ = DynamicDependencies--instance (Alternative (p g s), Monad (p g s)) => Monad (Fixed p g s) where-   return = pure-   (>>) = (*>)-   PositiveDirectParser p >>= cont = PositiveDirectParser (p >>= complete . cont)-   p@DirectParser{} >>= cont = Parser{-      complete= complete p >>= complete . cont,-      direct= d0 <|> d1,-      direct0= d0,-      direct1= d1,-      indirect= direct0 p >>= indirect . general' . cont,-      isAmbiguous= Nothing,-      cyclicDescendants= const (ParserFlags True DynamicDependencies)}-      where d0 = direct0 p >>= direct0 . general' . cont-            d1 = (direct0 p >>= direct1 . general' . cont) <|> (direct1 p >>= complete . cont)-   p >>= cont = Parser{-      complete= complete p >>= complete . cont,-      direct= d0 <|> d1,-      direct0= d0,-      direct1= d1,-      indirect= (indirect p >>= complete . cont) <|> (direct0 p >>= indirect . general' . cont),-      isAmbiguous= Nothing,-      cyclicDescendants= \cd->-         let pcd@(ParserFlags pn _) = cyclicDescendants p' cd-         in if pn-            then ParserFlags True DynamicDependencies-            else pcd}-      where d0 = direct0 p >>= direct0 . general' . cont-            d1 = (direct0 p >>= direct1 . general' . cont) <|> (direct1 p >>= complete . cont)-            p'@Parser{} = general' p--#if MIN_VERSION_base(4,13,0)-instance (Alternative (p g s), MonadFail (p g s)) => MonadFail (Fixed p g s) where-#endif-   fail msg = PositiveDirectParser{complete= fail msg}--instance MonadPlus (p g s) => MonadPlus (Fixed p g s) where-   mzero = empty-   mplus = (<|>)--instance (Alternative (p g s), Semigroup x) => Semigroup (Fixed p g s x) where-   (<>) = liftA2 (<>)--instance (Alternative (p g s), Monoid x) => Monoid (Fixed p g s x) where-   mempty = pure mempty-   mappend = (<>)--primitive :: p g s a -> p g s a -> p g s a -> Fixed p g s a-primitive d0 d1 d = DirectParser{complete= d,-                                 direct0= d0,-                                 direct1= d1}-{-# INLINE primitive #-}---- | Lifts a primitive positive parser (/i.e./, one that always consumes some input) into a left-recursive one-liftPositive :: p g s a -> Fixed p g s a-liftPositive p = PositiveDirectParser{complete= p}-{-# INLINE liftPositive #-}---- | Lifts a primitive pure parser (/i.e./, one that consumes no input) into a left-recursive one-liftPure :: Alternative (p g s) => p g s a -> Fixed p g s a-liftPure p = DirectParser{complete= p,-                          direct0= p,-                          direct1= empty}-{-# INLINE liftPure #-}--instance (Parsing (p g s), InputParsing (Fixed p g s)) => Parsing (Fixed p g s) where-   eof = primitive eof empty eof-   try (PositiveDirectParser p) = PositiveDirectParser (try p)-   try p@DirectParser{} = DirectParser{-      complete= try (complete p),-      direct0= try (direct0 p),-      direct1= try (direct1 p)}-   try p@Parser{} = p{-      complete= try (complete p),-      direct= try (direct p),-      direct0= try (direct0 p),-      direct1= try (direct1 p),-      indirect= try (indirect p)}-   PositiveDirectParser p <?> msg = PositiveDirectParser (p <?> msg)-   p@DirectParser{} <?> msg = DirectParser{-      complete= complete p <?> msg,-      direct0= direct0 p <?> msg,-      direct1= direct1 p <?> msg}-   p@Parser{} <?> msg = p{-      complete= complete p <?> msg,-      direct= direct p <?> msg,-      direct0= direct0 p <?> msg,-      direct1= direct1 p <?> msg,-      indirect= indirect p <?> msg}-   notFollowedBy p@PositiveDirectParser{} = DirectParser{-      complete= notFollowedBy (complete p),-      direct0= notFollowedBy (complete p),-      direct1= empty}-   notFollowedBy p@DirectParser{} = DirectParser{-      complete= notFollowedBy (complete p),-      direct0= notFollowedBy (complete p),-      direct1= empty}-   notFollowedBy p@Parser{} = Parser{-      complete= notFollowedBy (complete p),-      direct= notFollowedBy (direct p),-      direct0= notFollowedBy (direct p),-      direct1= empty,-      isAmbiguous= Nothing,-      indirect= notFollowedBy (indirect p),-      cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}-   unexpected msg = liftPositive (unexpected msg)--instance (InputParsing (Fixed p g s), DeterministicParsing (p g s)) => DeterministicParsing (Fixed p g s) where-   p@DirectParser{} <<|> q@PositiveDirectParser{} = DirectParser{-      complete= complete p <<|> complete q,-      direct0 = direct0 p,-      direct1= direct1 p <<|> complete q}-   p@DirectParser{} <<|> q@DirectParser{} = DirectParser{-      complete= complete p <<|> complete q,-      direct0 = direct0 p <<|> direct0 q,-      direct1= direct1 p <<|> direct1 q}-   p <<|> q = Parser{complete= complete p' <<|> complete q',-                     direct= direct p' <<|> notFollowedBy (void $ complete p') *> direct q',-                     direct0= direct0 p' <<|> notFollowedBy (void $ complete p') *> direct0 q',-                     direct1= direct1 p' <<|> notFollowedBy (void $ complete p') *> direct1 q',-                     indirect= indirect p' <<|> notFollowedBy (void $ complete p') *> indirect q',-                     isAmbiguous= Nothing,-                     cyclicDescendants= \deps-> let-                           ParserFlags pn pd = cyclicDescendants p' deps-                           ParserFlags qn qd = cyclicDescendants q' deps-                        in ParserFlags (pn || qn) (depUnion pd qd)}-      where p'@Parser{} = general p-            q'@Parser{} = general q-   takeSome p = (:) <$> p <*> takeMany p-   takeMany (PositiveDirectParser p) = DirectParser{-      complete = takeMany p,-      direct0= [] <$ notFollowedBy (void p),-      direct1= takeSome p}-   takeMany p@DirectParser{} = DirectParser{-      complete = takeMany (complete p),-      direct0= (:[]) <$> direct0 p <<|> [] <$ notFollowedBy (void $ complete p),-      direct1= (:) <$> direct1 p <*> takeMany (complete p)}-   takeMany p@Parser{} = Parser{-      complete= mcp,-      direct= d1 <<|> d0,-      direct0= d0,-      direct1= d1,-      indirect= (:) <$> indirect p <*> mcp,-      isAmbiguous= Nothing,-      cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}-      where d0 = (:[]) <$> direct0 p <<|> [] <$ notFollowedBy (void $ direct p)-            d1 = (:) <$> direct1 p <*> mcp-            mcp = takeMany (complete p)-   skipAll (PositiveDirectParser p) = DirectParser{-      complete = skipAll p,-      direct0= () <$ notFollowedBy (void p),-      direct1= p *> skipAll p}-   skipAll p@DirectParser{} = DirectParser{-      complete = skipAll (complete p),-      direct0= void (direct0 p) <<|> notFollowedBy (void $ complete p),-      direct1= direct1 p *> skipAll (complete p)}-   skipAll p@Parser{} = Parser{-      complete= mcp,-      direct= d1 <<|> d0,-      direct0= d0,-      direct1= d1,-      indirect= indirect p *> mcp,-      isAmbiguous= Nothing,-      cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}-      where d0 = () <$ direct0 p <<|> notFollowedBy (void $ direct p)-            d1 = direct1 p *> mcp-            mcp = skipAll (complete p)--instance (CommittedParsing (p g s), CommittedResults (p g s) ~ ParseResults s) => CommittedParsing (Fixed p g s) where-   type CommittedResults (Fixed p g s) = ParseResults s-   commit (PositiveDirectParser p) = PositiveDirectParser (commit p)-   commit p@DirectParser{} = DirectParser{-      complete = commit (complete p),-      direct0= commit (direct0 p),-      direct1= commit (direct1 p)}-   commit p@Parser{} = Parser{-      complete= commit (complete p),-      direct= commit (direct p),-      direct0= commit (direct0 p),-      direct1= commit (direct1 p),-      indirect= commit (indirect p),-      isAmbiguous= Nothing,-      cyclicDescendants= cyclicDescendants p}-   admit :: Fixed p g s (CommittedResults (Fixed p g s) a) -> Fixed p g s a-   admit (PositiveDirectParser p) = PositiveDirectParser (admit p)-   admit p@DirectParser{} = DirectParser{-      complete = admit (complete p),-      direct0= admit (direct0 p),-      direct1= admit (direct1 p)}-   admit p@Parser{} = Parser{-      complete= admit (complete p),-      direct= admit (direct p),-      direct0= admit (direct0 p),-      direct1= admit (direct1 p),-      indirect= admit (indirect p),-      isAmbiguous= Nothing,-      cyclicDescendants= cyclicDescendants p}--instance (LookAheadParsing (p g s), InputParsing (Fixed p g s)) => LookAheadParsing (Fixed p g s) where-   lookAhead p@PositiveDirectParser{} = DirectParser{-      complete= lookAhead (complete p),-      direct0= lookAhead (complete p),-      direct1= empty}-   lookAhead p@DirectParser{} = DirectParser{-      complete= lookAhead (complete p),-      direct0= lookAhead (complete p),-      direct1= empty}-   lookAhead p@Parser{} = Parser{-      complete= lookAhead (complete p),-      direct= lookAhead (direct p),-      direct0= lookAhead (direct p),-      direct1= empty,-      isAmbiguous= isAmbiguous p,-      indirect= lookAhead (indirect p),-      cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}--instance (LeftReductive s, FactorialMonoid s, InputParsing (p g s), ParserInput (p g s) ~ s) =>-         InputParsing (Fixed p g s) where-   type ParserInput (Fixed p g s) = s-   getInput = primitive getInput empty getInput-   anyToken = liftPositive anyToken-   satisfy predicate = liftPositive (satisfy predicate)-   notSatisfy predicate = primitive (notSatisfy predicate) empty (notSatisfy predicate)-   scan s0 f = primitive (mempty <$ notSatisfy test) (lookAhead (satisfy test) *> p) p-      where p = scan s0 f-            test = isJust . f s0-   string s-      | null s = primitive (string s) empty (string s)-      | otherwise = liftPositive (string s)-   take 0 = mempty-   take n = liftPositive (take n)-   takeWhile predicate = primitive (mempty <$ notSatisfy predicate)-                                               (takeWhile1 predicate) (takeWhile predicate)-   takeWhile1 predicate = liftPositive (takeWhile1 predicate)--   {-# INLINABLE string #-}--instance (LeftReductive s, FactorialMonoid s, Show s, TraceableParsing (p g s), ParserInput (p g s) ~ s) =>-         TraceableParsing (Fixed p g s) where-   traceInput description p@PositiveDirectParser{} = p{-      complete= traceInput (\s-> "direct+ " <> description s) (complete p)}-   traceInput description p@DirectParser{} = p{-      complete= traceInput (\s-> "direct " <> description s) (complete p),-      direct0= traceInput (\s-> "direct0 " <> description s) (direct0 p),-      direct1= traceInput (\s-> "direct1 " <> description s) (direct1 p)}-   traceInput description p@Parser{} = p{-      complete= traceBy "complete" (complete p),-      direct= traceBy "direct" (direct p),-      direct0= traceBy "direct0" (direct0 p),-      direct1= traceBy "direct1" (direct1 p),-      indirect= traceBy "indirect" (indirect p)}-      where traceBy mode = traceInput (\s-> "(" <> mode <> ") " <> description s)--instance (LeftReductive s, FactorialMonoid s,-          ConsumedInputParsing (p g s), ParserInput (p g s) ~ s) => ConsumedInputParsing (Fixed p g s) where-   match (PositiveDirectParser p) = PositiveDirectParser (match p)-   match p@DirectParser{} = DirectParser{-      complete= match (complete p),-      direct0 = match (direct0 p),-      direct1 = match (direct1 p)}-   match p@Parser{} = Parser{-      complete= match (complete p),-      direct =  match (direct p),-      direct0 = match (direct0 p),-      direct1 = match (direct1 p),-      indirect= match (indirect p),-      isAmbiguous= Nothing,-      cyclicDescendants= cyclicDescendants p}--instance (Show s, TextualMonoid s, InputCharParsing (p g s), ParserInput (p g s) ~ s) =>-         InputCharParsing (Fixed p g s) where-   satisfyCharInput predicate = liftPositive (satisfyCharInput predicate)-   notSatisfyChar predicate = primitive (notSatisfyChar predicate) empty (notSatisfyChar predicate)-   scanChars s0 f = primitive (mempty <$ notSatisfyChar test) (lookAhead (Char.satisfy test) *> p) p-      where p = scanChars s0 f-            test = isJust . f s0-   takeCharsWhile predicate = primitive (mempty <$ notSatisfyChar predicate)-                                        (takeCharsWhile1 predicate) (takeCharsWhile predicate)-   takeCharsWhile1 predicate = liftPositive (takeCharsWhile1 predicate)--instance (CharParsing (p g s), InputCharParsing (Fixed p g s), TextualMonoid s,-          s ~ ParserInput (Fixed p g s), Show s) => CharParsing (Fixed p g s) where-   satisfy predicate = liftPositive (Char.satisfy predicate)-   string s = Textual.toString (error "unexpected non-character") <$> string (fromString s)-   text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)--instance AmbiguousParsing (p g s) => AmbiguousParsing (Fixed p g s) where-   ambiguous (PositiveDirectParser p) = PositiveDirectParser (ambiguous p)-   ambiguous p@DirectParser{} = DirectParser{complete= ambiguous (complete p),-                                             direct0=  ambiguous (direct0 p),-                                             direct1=  ambiguous (direct1 p)}-   ambiguous p@Parser{} = Parser{complete= ambiguous (complete p),-                                 direct=   ambiguous (direct p),-                                 direct0=  ambiguous (direct0 p),-                                 direct1=  ambiguous (direct1 p),-                                 indirect= ambiguous (indirect p),-                                 isAmbiguous= Just (AmbiguityWitness Refl),-                                 cyclicDescendants= cyclicDescendants p}-   {-# INLINABLE ambiguous #-}---- | Turns a context-free parser into a backtracking PEG parser that consumes the longest possible prefix of the list--- of input tails, opposite of 'peg'-longest :: Fixed Memoizing.Parser g s a -> Fixed Backtrack.Parser g [(s, g (ResultList g s))] a-longest (PositiveDirectParser p) = PositiveDirectParser (Memoizing.longest p)-longest p@DirectParser{} = DirectParser{complete= Memoizing.longest (complete p),-                                        direct0=  Memoizing.longest (direct0 p),-                                        direct1=  Memoizing.longest (direct1 p)}-longest p@Parser{} = Parser{complete= Memoizing.longest (complete p),-                            direct=  Memoizing.longest (direct p),-                            direct0=  Memoizing.longest (direct0 p),-                            direct1=  Memoizing.longest (direct1 p),-                            indirect=  Memoizing.longest (indirect p),-                            isAmbiguous= Nothing,-                            cyclicDescendants= cyclicDescendants p}---- | Turns a backtracking PEG parser of the list of input tails into a context-free parser, opposite of 'longest'-peg :: Ord s => Fixed Backtrack.Parser g [(s, g (ResultList g s))] a -> Fixed Memoizing.Parser g s a-peg (PositiveDirectParser p) = PositiveDirectParser (Memoizing.peg p)-peg p@DirectParser{} = DirectParser{complete= Memoizing.peg (complete p),-                                        direct0=  Memoizing.peg (direct0 p),-                                        direct1=  Memoizing.peg (direct1 p)}-peg p@Parser{} = Parser{complete= Memoizing.peg (complete p),-                        direct=  Memoizing.peg (direct p),-                        direct0=  Memoizing.peg (direct0 p),-                        direct1=  Memoizing.peg (direct1 p),-                        indirect=  Memoizing.peg (indirect p),-                        isAmbiguous= Nothing,-                        cyclicDescendants= cyclicDescendants p}---- | Turns a backtracking PEG parser into a context-free parser-terminalPEG :: (Monoid s, Ord s) => Fixed Backtrack.Parser g s a -> Fixed Memoizing.Parser g s a-terminalPEG (PositiveDirectParser p) = PositiveDirectParser (Memoizing.terminalPEG p)-terminalPEG p@DirectParser{} = DirectParser{complete= Memoizing.terminalPEG (complete p),-                                            direct0=  Memoizing.terminalPEG (direct0 p),-                                            direct1=  Memoizing.terminalPEG (direct1 p)}-terminalPEG p@Parser{} = Parser{complete= Memoizing.terminalPEG (complete p),-                                direct=  Memoizing.terminalPEG (direct p),-                                direct0=  Memoizing.terminalPEG (direct0 p),-                                direct1=  Memoizing.terminalPEG (direct1 p),-                                indirect=  Memoizing.terminalPEG (indirect p),-                                isAmbiguous= Nothing,-                                cyclicDescendants= cyclicDescendants p}--parseRecursive :: forall p g s rl. (Rank2.Apply g, Rank2.Distributive g, Rank2.Traversable g,-                                    Eq s, FactorialMonoid s, LeftReductive s, Alternative (p g s),-                                    TailsParsing (p g s), GrammarConstraint (p g s) g,-                                    s ~ ParserInput (p g s), GrammarFunctor (p g s) ~ rl s, FallibleResults rl,-                                    AmbiguousAlternative (GrammarFunctor (p g s))) =>-                  g (Fixed p g s) -> s -> [(s, g (GrammarFunctor (p g s)))]-parseRecursive = parseSeparated . separated-{-# INLINE parseRecursive #-}---- | Analyze the grammar's production interdependencies and produce a 'SeparatedParser' from each production's parser.-separated :: forall p g s. (Alternative (p g s), Rank2.Apply g, Rank2.Distributive g, Rank2.Traversable g,-                            AmbiguousAlternative (GrammarFunctor (p g s))) =>-             g (Fixed p g s) -> g (SeparatedParser p g s)-separated g = Rank2.liftA4 reseparate circulars cycleFollowers descendants g-   where descendants :: g (Const (Dependencies g))-         cycleFollowers, circulars :: g (Const Bool)-         cyclicDescendantses :: g (Const (ParserFlags g))-         appendResults :: forall a. Maybe (AmbiguityWitness a)-                       -> GrammarFunctor (p g s) a -> GrammarFunctor (p g s) a -> GrammarFunctor (p g s) a-         leftRecursive :: forall a. Const (g (Const Bool)) a -> Const (ParserFlags g) a -> Const Bool a-         leftRecursiveDeps :: forall a. Const Bool a -> Const (ParserFlags g) a -> Const (g (Const Bool)) a-         reseparate :: forall a. Const Bool a -> Const Bool a -> Const (Dependencies g) a -> Fixed p g s a-                    -> SeparatedParser p g s a-         reseparate (Const circular) (Const follower) (Const d@(StaticDependencies deps)) p-            | circular || leader && follower =-              CycleParser (indirect p) (direct p) (Rank2.Arrow (Rank2.Arrow . appendResults (isAmbiguous p))) d-            | follower = BackParser (complete p)-            | otherwise = FrontParser (complete p)-            where leader = getAny (Rank2.foldMap (Any . getConst) $ Rank2.liftA2 intersection circulars deps)-         reseparate _ _ (Const d@DynamicDependencies) p =-              CycleParser (indirect p) (direct p) (Rank2.Arrow (Rank2.Arrow . appendResults (isAmbiguous p))) d-         appendResults (Just (AmbiguityWitness Refl)) = ambiguousOr-         appendResults Nothing = (<|>)-         descendants = Rank2.fmap (Const . dependsOn . getConst) cyclicDescendantses-         cyclicDescendantses = fixDescendants (Rank2.fmap (\p-> Const $ cyclicDescendants $ general p) g)-         circulars = Rank2.liftA2 leftRecursive bits cyclicDescendantses-         cycleFollowers = getUnion (Rank2.foldMap (Union . getConst) $-                                    Rank2.liftA2 leftRecursiveDeps circulars cyclicDescendantses)-         leftRecursive (Const bit) (Const ParserFlags{dependsOn= StaticDependencies deps}) =-            Const (getAny $ Rank2.foldMap (Any . getConst) $ Rank2.liftA2 intersection bit deps)-         leftRecursive _ (Const ParserFlags{dependsOn= DynamicDependencies}) = Const True-         leftRecursiveDeps (Const True) (Const ParserFlags{dependsOn= StaticDependencies deps}) = Const deps-         leftRecursiveDeps (Const False) (Const ParserFlags{dependsOn= StaticDependencies deps}) =-            Const (Rank2.fmap (const $ Const False) deps)-         leftRecursiveDeps _ (Const ParserFlags{dependsOn= DynamicDependencies}) =-            Const (Rank2.fmap (const $ Const True) g)-         intersection (Const a) (Const b) = Const (a && b)-{-# INLINABLE separated #-}--fixDescendants :: forall g. (Rank2.Apply g, Rank2.Traversable g)-                     => g (Const (g (Const (ParserFlags g)) -> (ParserFlags g))) -> g (Const (ParserFlags g))-fixDescendants gf = go initial-   where go :: g (Const (ParserFlags g)) -> g (Const (ParserFlags g))-         go cd-            | getAll (Rank2.foldMap (All . getConst) $ Rank2.liftA2 agree cd cd') = cd-            | otherwise = go cd'-            where cd' = Rank2.liftA2 flagUnion cd (Rank2.fmap (\(Const f)-> Const (f cd)) gf)-         agree (Const (ParserFlags _xn (StaticDependencies xd))) (Const (ParserFlags _yn (StaticDependencies yd))) =-            Const (getAll (Rank2.foldMap (All . getConst) (Rank2.liftA2 agree' xd yd)))-         agree (Const (ParserFlags _xn DynamicDependencies)) (Const (ParserFlags _yn DynamicDependencies)) = Const True-         agree _ _ = Const False-         agree' (Const x) (Const y) = Const (x == y)-         flagUnion (Const ParserFlags{dependsOn= old}) (Const (ParserFlags n new)) = -            Const (ParserFlags n $ depUnion old new)-         initial = Rank2.liftA2 (\_ (Const n)-> Const (ParserFlags n deps)) gf nullabilities-         deps = StaticDependencies (const (Const False) Rank2.<$> gf)-         nullabilities = fixNullabilities gf-{-# INLINABLE fixDescendants #-}--fixNullabilities :: forall g. (Rank2.Apply g, Rank2.Traversable g)-                    => g (Const (g (Const (ParserFlags g)) -> (ParserFlags g))) -> g (Const Bool)-fixNullabilities gf = Const . nullable . getConst Rank2.<$> go initial-   where go :: g (Const (ParserFlags g)) -> g (Const (ParserFlags g))-         go cd-            | getAll (Rank2.foldMap (All . getConst) $ Rank2.liftA2 agree cd cd') = cd-            | otherwise = go cd'-            where cd' = Rank2.fmap (\(Const f)-> Const (f cd)) gf-         agree (Const flags1) (Const flags2) = Const (nullable flags1 == nullable flags2)-         initial = const (Const (ParserFlags True (StaticDependencies $ const (Const False) Rank2.<$> gf))) Rank2.<$> gf-{-# INLINABLE fixNullabilities #-}---- | Parse the given input using a context-free grammar 'separated' into left-recursive and other productions.-parseSeparated :: forall p g rl s. (Rank2.Apply g, Rank2.Foldable g, Eq s, FactorialMonoid s, LeftReductive s,-                                    TailsParsing (p g s), GrammarConstraint (p g s) g,-                                    GrammarFunctor (p g s) ~ rl s, FallibleResults rl,-                                    s ~ ParserInput (p g s)) =>-                  g (SeparatedParser p g s) -> s -> [(s, g (GrammarFunctor (p g s)))]-parseSeparated parsers input = foldr parseTail [] (Factorial.tails input)-   where parseTail s parsedTail = parsed-            where parsed = (s,d''):parsedTail-                  d      = Rank2.fmap (($ (s,d):parsedTail) . parseTails) directs-                  d'     = fixRecursive s parsedTail d-                  d''    = Rank2.liftA2 f parsers d'-                  f :: forall a. SeparatedParser p g s a -> GrammarFunctor (p g s) a -> GrammarFunctor (p g s) a-                  f (FrontParser p) _ = parseTails p ((s,d''):parsedTail)-                  f _ result = result-         fixRecursive :: s -> [(s, g (GrammarFunctor (p g s)))]-                      -> g (GrammarFunctor (p g s)) -> g (GrammarFunctor (p g s))-         whileAnyContinues :: (g (GrammarFunctor (p g s)) -> g (GrammarFunctor (p g s)))-                           -> (g (GrammarFunctor (p g s)) -> g (GrammarFunctor (p g s)))-                           -> g (GrammarFunctor (p g s)) -> g (GrammarFunctor (p g s)) -> g (GrammarFunctor (p g s))-         recurseTotal :: s -> g (GrammarFunctor (p g s) Rank2.~> GrammarFunctor (p g s))-                      -> [(s, g (GrammarFunctor (p g s)))]-                      -> g (GrammarFunctor (p g s))-                      -> g (GrammarFunctor (p g s))-         recurseMarginal :: s -> [(s, g (GrammarFunctor (p g s)))]-                      -> g (GrammarFunctor (p g s))-                      -> g (GrammarFunctor (p g s))-         maybeDependencies :: g (Const (Maybe (Dependencies g)))-         maybeDependency :: SeparatedParser p g s r -> Const (Maybe (Dependencies g)) r-         appends :: g (ResultAppend p g s)-         parserAppend :: SeparatedParser p g s r -> ResultAppend p g s r--         directs = Rank2.fmap backParser parsers-         indirects = Rank2.fmap (\p-> case p of {CycleParser{}-> cycleParser p; _ -> empty}) parsers-         appends = Rank2.fmap parserAppend parsers-         parserAppend p@CycleParser{} = appendResultsArrow p-         parserAppend _ = Rank2.Arrow (Rank2.Arrow . const)-         maybeDependencies = Rank2.fmap maybeDependency parsers-         maybeDependency p@CycleParser{} = Const (Just $ dependencies p)-         maybeDependency _ = Const Nothing--         -- Fix the recursive knot on the head of the input, given its already-fixed tail and the initial record of-         -- directly parsed results.-         fixRecursive s parsedTail initial =-            whileAnyContinues (recurseTotal s (appends Rank2.<*> initial) parsedTail)-                              (recurseMarginal s parsedTail)-                              initial initial--         -- Loop accumulating the total parsing results from marginal results as long as there is any new marginal-         -- result to expand a total one or a new failure expactation to augment an existing failure.-         whileAnyContinues ft fm total marginal =-            Rank2.liftA3 choiceWhile maybeDependencies total (whileAnyContinues ft fm (ft total) (fm marginal))-            where choiceWhile :: Const (Maybe (Dependencies g)) x-                              -> GrammarFunctor (p g s) x -> GrammarFunctor (p g s) x-                              -> GrammarFunctor (p g s) x-                  choiceWhile (Const Nothing) t _ = t-                  choiceWhile (Const (Just (StaticDependencies deps))) t t'-                     | getAny (Rank2.foldMap (Any . getConst) (Rank2.liftA2 combine deps marginal)) = t'-                     | hasSuccess t = t-                     | otherwise =-                        failWith (failureOf $-                                  if getAny (Rank2.foldMap (Any . getConst) $-                                             Rank2.liftA2 (combineFailures $ failureOf t) deps marginal)-                                  then t' else t)-                     where combine :: Const Bool x -> GrammarFunctor (p g s) x -> Const Bool x-                           combineFailures :: ParseFailure Pos s -> Const Bool x -> GrammarFunctor (p g s) x-                                           -> Const Bool x-                           combine (Const False) _ = Const False-                           combine (Const True) results = Const (hasSuccess results)-                           combineFailures _ (Const False) _ = Const False-                           combineFailures (ParseFailure pos expected erroneous) (Const True) rl =-                              Const (pos < pos'-                                     || pos == pos' && (any (`notElem` expected) expected'-                                                        || any (`notElem` erroneous) erroneous'))-                              where ParseFailure pos' expected' erroneous' = failureOf rl-                  choiceWhile (Const (Just DynamicDependencies)) t t'-                     | getAny (Rank2.foldMap (Any . hasSuccess) marginal) = t'-                     | hasSuccess t = t-                     | ParseFailure _ [] [] <- failureOf t = t'-                     | otherwise = t--         -- Adds another round of indirect parsing results to the total results accumulated so far.-         recurseTotal s initialAppends parsedTail total = Rank2.liftA2 reparse initialAppends indirects-            where reparse :: (GrammarFunctor (p g s) Rank2.~> GrammarFunctor (p g s)) a -> p g s a-                          -> GrammarFunctor (p g s) a-                  reparse append p = Rank2.apply append (parseTails p $ (s, total) : parsedTail)-         -- Calculates the next round of indirect parsing results from the previous marginal round.-         recurseMarginal s parsedTail marginal =-            flip parseTails ((s, marginal) : parsedTail) Rank2.<$> indirects-{-# NOINLINE parseSeparated #-}+import Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive

@@ -1,26 +1,8 @@-{-# Language GADTs #-} -- | A context-free parser that can handle left-recursive grammars and carry a -- monadic computation with each parsing result.-module Text.Grampa.ContextFree.LeftRecursive.Transformer (ParserT, SeparatedParser(..), AmbiguityDecidable,-                                                          lift, liftPositive, tbind, tmap,-                                                          parseSeparated, separated)+module Text.Grampa.ContextFree.LeftRecursive.Transformer+       {-# DEPRECATED "Use Text.Grampa.ContextFree.SortedMemoizing.Transformer.LeftRecursive instead" #-}+       (module Text.Grampa.ContextFree.SortedMemoizing.Transformer.LeftRecursive) where -import Text.Grampa.ContextFree.LeftRecursive (Fixed, SeparatedParser(..),-                                              liftPositive, liftPure, mapPrimitive, parseSeparated, separated)-import qualified Text.Grampa.ContextFree.SortedMemoizing.Transformer as Transformer-import Text.Grampa.Internal (AmbiguityDecidable)--type ParserT m = Fixed (Transformer.ParserT m)---- | Lift a parse-free computation into the parser.-lift :: (Applicative m, Ord s) => m a -> ParserT m g s a-lift = liftPure . Transformer.lift---- | Transform the computation carried by the parser using the monadic bind ('>>=').-tbind :: (Monad m, AmbiguityDecidable b) => ParserT m g s a -> (a -> m b) -> ParserT m g s b-tbind p f = mapPrimitive (`Transformer.tbind` f) p---- | Transform the computation carried by the parser.-tmap :: AmbiguityDecidable b => (m a -> m b) -> ParserT m g s a -> ParserT m g s b-tmap = mapPrimitive . Transformer.tmap+import Text.Grampa.ContextFree.SortedMemoizing.Transformer.LeftRecursive

@@ -1,10 +1,8 @@-{-# LANGUAGE CPP, FlexibleContexts, GeneralizedNewtypeDeriving, InstanceSigs,-             RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}+{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, InstanceSigs, MultiParamTypeClasses,+             RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} -- | A context-free parser with packrat-like memoization of parse results. module Text.Grampa.ContextFree.Memoizing-       {-# DEPRECATED "Use Text.Grampa.ContextFree.SortedMemoizing instead" #-}-       (ResultList(..), Parser(..), BinTree(..),-        reparseTails, longest, peg, terminalPEG)+       (ResultList(..), Parser(..), BinTree(..), reparseTails, longest, peg, terminalPEG) where  import Control.Applicative@@ -33,6 +31,7 @@ import qualified Text.Parser.Char import Text.Parser.Char (CharParsing) import Text.Parser.Combinators (Parsing(..))+import Text.Parser.Input.Position (fromEnd) import Text.Parser.LookAhead (LookAheadParsing(..))  import qualified Rank2@@ -40,7 +39,10 @@ import Text.Grampa.Class (GrammarParsing(..), MultiParsing(..),                           DeterministicParsing(..), InputParsing(..), InputCharParsing(..),                           TailsParsing(parseTails), ParseResults, ParseFailure(..), FailureDescription(..), Pos)-import Text.Grampa.Internal (BinTree(..), TraceableParsing(..), expected, erroneous)+import Text.Grampa.Internal (BinTree(..), AmbiguousAlternative (..), FallibleResults (..), TraceableParsing(..),+                             Dependencies (..), ParserFlags (..),+                             emptyFailure, erroneous, expected, expectedInput, replaceExpected)+import Text.Grampa.Internal.Storable (Storable(..), Storable1(..)) import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack  import Prelude hiding (iterate, length, null, showList, span, takeWhile)@@ -49,8 +51,8 @@ -- grammars. newtype Parser g s r = Parser{applyParser :: [(s, g (ResultList g s))] -> ResultList g s r} -data ResultList g s r = ResultList !(BinTree (ResultInfo g s r)) {-# UNPACK #-} !(ParseFailure Pos s)-data ResultInfo g s r = ResultInfo !Int ![(s, g (ResultList g s))] !r+data ResultList g s r = ResultList !(BinTree (ResultInfo g s r)) (ParseFailure Pos s)+data ResultInfo g s r = ResultInfo !Int ![(s, g (ResultList g s))] r  instance (Show s, Show r) => Show (ResultList g s r) where    show (ResultList l f) = "ResultList (" ++ shows l (") (" ++ shows f ")")@@ -65,6 +67,10 @@ instance Functor (ResultInfo g s) where    fmap f (ResultInfo l t r) = ResultInfo l t (f r) +instance Ord s => Applicative (ResultInfo g s) where+   pure = ResultInfo 0 mempty+   ResultInfo l1 _ f <*> ResultInfo l2 t2 x = ResultInfo (l1 + l2) t2 (f x)+ instance Foldable (ResultInfo g s) where    foldMap f (ResultInfo _ _ r) = f r @@ -84,6 +90,41 @@    mempty = ResultList mempty mempty    mappend = (<>) +instance FallibleResults (ResultList g) where+   hasSuccess (ResultList EmptyTree _) = False+   hasSuccess _ = True+   failureOf (ResultList _ failure) = failure+   failWith = ResultList EmptyTree++instance Ord s => Applicative (ResultList g s) where+   pure a = ResultList (Leaf $ pure a) mempty+   ResultList rl1 f1 <*> ResultList rl2 f2 = ResultList ((<*>) <$> rl1 <*> rl2) (f1 <> f2)++instance Ord s => Alternative (ResultList g s) where+   empty = mempty+   (<|>) = (<>)++instance Ord s => AmbiguousAlternative (ResultList g s) where+   ambiguousOr (ResultList rl1 f1) (ResultList rl2 f2) = ResultList (Fork rl1 rl2) (f1 <> f2)++instance Storable1 (ResultList g s) Bool where+   store1 bit = ResultList EmptyTree (emptyFailure $ if bit then 1 else 0)+   reuse1 (ResultList _ (ParseFailure pos _ _)) = pos /= 0++instance (Rank2.Functor g, Monoid s, Ord s) => Storable1 (ResultList g s) (ParserFlags g) where+   store1 a = ResultList (Leaf $ store a) mempty+   reuse1 (ResultList (Leaf s) _) = reuse s++instance (Rank2.Functor g, Monoid s) => Storable (ResultInfo g s r) (ParserFlags g) where+   store (ParserFlags n d) = ResultInfo (if n then 1 else 0) (store d) (error "unused")+   reuse (ResultInfo n d _) = ParserFlags (n /= 0) (reuse d)++instance (Rank2.Functor g, Monoid s) => Storable [(s, g (ResultList g s))] (Dependencies g) where+   store DynamicDependencies = []+   store (StaticDependencies deps) = [(mempty, store deps)]+   reuse [] = DynamicDependencies+   reuse [(_, deps)] = StaticDependencies (reuse deps)+ instance Functor (Parser g i) where    fmap f (Parser p) = Parser (fmap f . p)    {-# INLINABLE fmap #-}@@ -100,7 +141,7 @@    {-# INLINABLE (<*>) #-}  instance Ord s => Alternative (Parser g s) where-   empty = Parser (\rest-> ResultList mempty $ ParseFailure (Down $ length rest) [] [])+   empty = Parser (ResultList mempty . emptyFailure . Down . length)    Parser p <|> Parser q = Parser r where       r rest = p rest <> q rest    {-# INLINABLE (<|>) #-}@@ -143,6 +184,22 @@       p ((_, d) : _) = f d       p _ = ResultList mempty (expected 0 "NonTerminal at endOfInput")    {-# INLINE nonTerminal #-}+   chainRecursive assign (Parser base) (Parser recurse) = Parser q+      where q [] = base []+            q ((s, d):t) = case base ((s, assign mempty d) : t)+                           of r@(ResultList EmptyTree _) -> r+                              r -> iter r r+               where iter marginal total = case recurse ((s, assign marginal d) : t)+                                           of ResultList EmptyTree _ -> total+                                              r -> iter r (total <> r)+   chainLongestRecursive assign (Parser base) (Parser recurse) = Parser q+      where q [] = base []+            q ((s, d):t) = case base ((s, assign mempty d) : t)+                           of r@(ResultList EmptyTree _) -> r+                              r -> iter r+               where iter r = case recurse ((s, assign r d) : t)+                              of ResultList EmptyTree _ -> r+                                 r' -> iter r'  instance (Ord s, LeftReductive s, FactorialMonoid s) => TailsParsing (Parser g s) where    parseTails = applyParser@@ -216,7 +273,7 @@    string s = Parser p where       p rest@((s', _) : _)          | s `isPrefixOf` s' = ResultList (Leaf $ ResultInfo l (Factorial.drop l rest) s) mempty-      p rest = ResultList mempty (ParseFailure (Down $ length rest) [LiteralDescription s] [])+      p rest = ResultList mempty (expectedInput (fromEnd $ length rest) s)       l = Factorial.length s    notSatisfy predicate = Parser p       where p rest@((s, _):_)@@ -264,25 +321,22 @@ instance (MonoidNull s, Ord s) => Parsing (Parser g s) where    try (Parser p) = Parser q       where q rest = rewindFailure (p rest)-               where rewindFailure (ResultList rl _) = ResultList rl (ParseFailure (Down $ length rest) [] [])+               where rewindFailure (ResultList rl _) = ResultList rl (emptyFailure $ fromEnd $ length rest)    Parser p <?> msg  = Parser q       where q rest = replaceFailure (p rest)-               where replaceFailure (ResultList EmptyTree (ParseFailure pos msgs erroneous')) =-                        ResultList EmptyTree (ParseFailure pos-                                                 (if pos == Down (length rest) then [StaticDescription msg]-                                                  else msgs)-                                                 erroneous')+               where replaceFailure (ResultList EmptyTree f) =+                        ResultList EmptyTree (replaceExpected (fromEnd $ length rest) msg f)                      replaceFailure rl = rl    notFollowedBy (Parser p) = Parser (\input-> rewind input (p input))       where rewind t (ResultList EmptyTree _) = ResultList (Leaf $ ResultInfo 0 t ()) mempty             rewind t ResultList{} = ResultList mempty (expected (Down $ length t) "notFollowedBy")    skipMany p = go       where go = pure () <|> p *> go-   unexpected msg = Parser (\t-> ResultList mempty $ expected (Down $ length t) msg)+   unexpected msg = Parser (\t-> ResultList mempty $ erroneous (Down $ length t) msg)    eof = Parser f       where f rest@((s, _):_)                | null s = ResultList (Leaf $ ResultInfo 0 rest ()) mempty-               | otherwise = ResultList mempty (expected (Down $ length rest) "endOfInput")+               | otherwise = ResultList mempty (expected (Down $ length rest) "end of input")             f [] = ResultList (Leaf $ ResultInfo 0 [] ()) mempty  instance (MonoidNull s, Ord s) => DeterministicParsing (Parser g s) where@@ -329,22 +383,20 @@ longest :: Parser g s a -> Backtrack.Parser g [(s, g (ResultList g s))] a longest p = Backtrack.Parser q where    q rest = case applyParser p rest-            of ResultList EmptyTree (ParseFailure pos positive negative)-                  -> Backtrack.NoParse (ParseFailure pos (map message positive) (map message negative))+            of ResultList EmptyTree (ParseFailure pos (FailureDescription expected inputs) errors)+                  -> Backtrack.NoParse (ParseFailure pos (FailureDescription expected $ map wrap inputs) errors)                ResultList rs _ -> parsed (maximumBy (compare `on` resultLength) rs)    resultLength (ResultInfo l _ _) = l    parsed (ResultInfo l s r) = Backtrack.Parsed l r s-   message (StaticDescription msg) = StaticDescription msg-   message (LiteralDescription s) = LiteralDescription [(s, error "longest")]+   wrap s = [(s, error "longest")]  -- | Turns a backtracking PEG parser of the list of input tails into a context-free parser, opposite of 'longest' peg :: Ord s => Backtrack.Parser g [(s, g (ResultList g s))] a -> Parser g s a peg p = Parser q where    q rest = case Backtrack.applyParser p rest             of Backtrack.Parsed l result suffix -> ResultList (Leaf $ ResultInfo l suffix result) mempty-               Backtrack.NoParse (ParseFailure pos positive negative)-                  -> ResultList mempty (ParseFailure pos (original <$> positive) (original <$> negative))-      where original = (fst . head <$>)+               Backtrack.NoParse (ParseFailure pos (FailureDescription expected inputs) errors)+                  -> ResultList mempty (ParseFailure pos (FailureDescription expected (fst . head <$> inputs)) errors)  -- | Turns a backtracking PEG parser into a context-free parser terminalPEG :: (Monoid s, Ord s) => Backtrack.Parser g s a -> Parser g s a

@@ -0,0 +1,69 @@+{-# LANGUAGE ConstraintKinds, CPP, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, InstanceSigs,+             RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeFamilies, TypeOperators,+             UndecidableInstances #-}+-- | A context-free memoizing parser that can handle left-recursive grammars.+module Text.Grampa.ContextFree.Memoizing.LeftRecursive (+   Fixed, Parser, SeparatedParser(..),+   autochain, liftPositive, liftPure, mapPrimitive,+   longest, peg, terminalPEG,+   parseSeparated, separated)+where++import Text.Grampa.Internal.LeftRecursive (Fixed(..), SeparatedParser(..),+                                           autochain, asLeaf, liftPositive, liftPure, mapPrimitive,+                                           parseSeparated, separated)+import Text.Grampa.ContextFree.Memoizing (ResultList (..))+import qualified Text.Grampa.ContextFree.Memoizing as Memoizing+import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack++-- | A parser for left-recursive grammars on top of the memoizing 'Memoizing.Parser'+type Parser = Fixed Memoizing.Parser++-- | Turns a context-free parser into a backtracking PEG parser that consumes the longest possible prefix of the list+-- of input tails, opposite of 'peg'+longest :: Fixed Memoizing.Parser g s a -> Fixed Backtrack.Parser g [(s, g (ResultList g s))] a+longest (PositiveDirectParser p) = PositiveDirectParser (Memoizing.longest p)+longest p@DirectParser{} = DirectParser{complete= Memoizing.longest (complete p),+                                        direct0=  Memoizing.longest (direct0 p),+                                        direct1=  Memoizing.longest (direct1 p)}+longest p@Parser{} = asLeaf Parser{+   complete= Memoizing.longest (complete p),+   direct=  Memoizing.longest (direct p),+   direct0=  Memoizing.longest (direct0 p),+   direct1=  Memoizing.longest (direct1 p),+   indirect=  Memoizing.longest (indirect p),+   choices= undefined,+   isAmbiguous= Nothing,+   cyclicDescendants= cyclicDescendants p}++-- | Turns a backtracking PEG parser of the list of input tails into a context-free parser, opposite of 'longest'+peg :: Ord s => Fixed Backtrack.Parser g [(s, g (ResultList g s))] a -> Fixed Memoizing.Parser g s a+peg (PositiveDirectParser p) = PositiveDirectParser (Memoizing.peg p)+peg p@DirectParser{} = DirectParser{complete= Memoizing.peg (complete p),+                                        direct0=  Memoizing.peg (direct0 p),+                                        direct1=  Memoizing.peg (direct1 p)}+peg p@Parser{} = asLeaf Parser{+   complete= Memoizing.peg (complete p),+   direct=  Memoizing.peg (direct p),+   direct0=  Memoizing.peg (direct0 p),+   direct1=  Memoizing.peg (direct1 p),+   indirect=  Memoizing.peg (indirect p),+   choices= undefined,+   isAmbiguous= Nothing,+   cyclicDescendants= cyclicDescendants p}++-- | Turns a backtracking PEG parser into a context-free parser+terminalPEG :: (Monoid s, Ord s) => Fixed Backtrack.Parser g s a -> Fixed Memoizing.Parser g s a+terminalPEG (PositiveDirectParser p) = PositiveDirectParser (Memoizing.terminalPEG p)+terminalPEG p@DirectParser{} = DirectParser{complete= Memoizing.terminalPEG (complete p),+                                            direct0=  Memoizing.terminalPEG (direct0 p),+                                            direct1=  Memoizing.terminalPEG (direct1 p)}+terminalPEG p@Parser{} = asLeaf Parser{+   complete= Memoizing.terminalPEG (complete p),+   direct=  Memoizing.terminalPEG (direct p),+   direct0=  Memoizing.terminalPEG (direct0 p),+   direct1=  Memoizing.terminalPEG (direct1 p),+   indirect=  Memoizing.terminalPEG (indirect p),+   choices= undefined,+   isAmbiguous= Nothing,+   cyclicDescendants= cyclicDescendants p}

@@ -13,6 +13,7 @@ import Data.Functor.Classes (Show1(..)) import Data.Functor.Compose (Compose(..)) import Data.Kind (Type)+import Data.List (intercalate) import Data.Semigroup (Semigroup(..)) import qualified Data.Semigroup.Cancellative as Cancellative import Data.Monoid (Monoid(mappend, mempty))@@ -36,8 +37,9 @@  import Text.Grampa.Class (CommittedParsing(..), DeterministicParsing(..),                           InputParsing(..), InputCharParsing(..), MultiParsing(..),-                          ParseResults, ParseFailure(..), FailureDescription(..), Pos)-import Text.Grampa.Internal (BinTree(..), expected, noFailure, TraceableParsing(..))+                          ParseResults, ParseFailure(..), Pos)+import Text.Grampa.Internal (BinTree(..), emptyFailure, erroneous, expected, expectedInput, replaceExpected, noFailure,+                             TraceableParsing(..))  import Prelude hiding (iterate, null, showList, span, takeWhile) @@ -45,7 +47,7 @@ -- support. newtype Parser (g :: (Type -> Type) -> Type) s r = Parser{applyParser :: s -> ResultList s r} -data ResultList s r = ResultList !(BinTree (ResultInfo s r)) {-# UNPACK #-} !(ParseFailure Pos s)+data ResultList s r = ResultList !(BinTree (ResultInfo s r)) (ParseFailure Pos s) data ResultInfo s r = ResultInfo !s !r  instance (Show s, Show r) => Show (ResultList s r) where@@ -92,7 +94,7 @@   instance (FactorialMonoid s, Ord s) => Alternative (Parser g s) where-   empty = Parser (\s-> ResultList mempty $ ParseFailure (fromEnd $ Factorial.length s) [] [])+   empty = Parser (ResultList mempty . emptyFailure . fromEnd . Factorial.length)    Parser p <|> Parser q = Parser r where       r rest = p rest <> q rest @@ -113,7 +115,7 @@ #if MIN_VERSION_base(4,13,0) instance (FactorialMonoid s, Ord s) => MonadFail (Parser g s) where #endif-   fail msg = Parser (\s-> ResultList mempty $ ParseFailure (fromEnd $ Factorial.length s) [] [StaticDescription msg])+   fail msg = Parser (\s-> ResultList mempty $ erroneous (fromEnd $ Factorial.length s) msg)  instance (FactorialMonoid s, Ord s) => MonadPlus (Parser g s) where    mzero = empty@@ -176,14 +178,16 @@                else ResultList (Leaf $ ResultInfo suffix prefix) noFailure    string s = Parser p where       p s' | Just suffix <- Cancellative.stripPrefix s s' = ResultList (Leaf $ ResultInfo suffix s) noFailure-           | otherwise = ResultList mempty (ParseFailure (fromEnd $ Factorial.length s') [LiteralDescription s] [])+           | otherwise = ResultList mempty (expectedInput (fromEnd $ Factorial.length s') s) -instance InputParsing (Parser g s)  => TraceableParsing (Parser g s) where+instance (FactorialMonoid s, InputParsing (Parser g s))  => TraceableParsing (Parser g s) where    traceInput description (Parser p) = Parser q-      where q s = case traceWith "Parsing " (p s)-                  of rl@(ResultList EmptyTree _) -> traceWith "Failed " rl-                     rl -> traceWith "Parsed " rl-               where traceWith prefix = trace (prefix <> description s)+      where q s = case trace ("Parsing " <> description s) (p s)+                  of rl@(ResultList EmptyTree _) -> trace ("Failed " <> description s) rl+                     rl@(ResultList rs _) ->+                        trace ("Parsed [" <> intercalate ", " (describeResult <$> toList rs) <> "]") rl+               where describeResult (ResultInfo s' _) =+                        description (Factorial.take (Factorial.length s - Factorial.length s') s)  instance (Ord s, TextualMonoid s) => InputCharParsing (Parser g s) where    satisfyCharInput predicate = Parser p@@ -212,23 +216,18 @@ instance (FactorialMonoid s, Ord s) => Parsing (Parser g s) where    try (Parser p) = Parser q       where q rest = rewindFailure (p rest)-               where rewindFailure (ResultList rl _) =-                        ResultList rl (ParseFailure (fromEnd $ Factorial.length rest) [] [])+               where rewindFailure (ResultList rl _) = ResultList rl (emptyFailure $ fromEnd $ Factorial.length rest)    Parser p <?> msg  = Parser q       where q rest = replaceFailure (p rest)-               where replaceFailure (ResultList EmptyTree (ParseFailure pos msgs erroneous)) =-                        ResultList EmptyTree (ParseFailure pos-                                                           (if pos == fromEnd (Factorial.length rest)-                                                            then [StaticDescription msg] else msgs)-                                                           erroneous)+               where replaceFailure (ResultList EmptyTree f) =+                        ResultList EmptyTree (replaceExpected (fromEnd $ Factorial.length rest) msg f)                      replaceFailure rl = rl    notFollowedBy (Parser p) = Parser (\input-> rewind input (p input))       where rewind t (ResultList EmptyTree _) = ResultList (Leaf $ ResultInfo t ()) noFailure             rewind t ResultList{} = ResultList mempty (expected (fromEnd $ Factorial.length t) "notFollowedBy")    skipMany p = go       where go = pure () <|> try p *> go-   unexpected msg = Parser (\t-> ResultList mempty-                                 $ ParseFailure (fromEnd $ Factorial.length t) [] [StaticDescription msg])+   unexpected msg = Parser (\t-> ResultList mempty $ erroneous (fromEnd $ Factorial.length t) msg)    eof = Parser f       where f s | null s = ResultList (Leaf $ ResultInfo s ()) noFailure                 | otherwise = ResultList mempty (expected (fromEnd $ Factorial.length s) "end of input")

@@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns, CPP, FlexibleContexts, GeneralizedNewtypeDeriving, InstanceSigs,-             RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}+             RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} -- | A context-free memoizing parser that handles all alternatives in parallel. module Text.Grampa.ContextFree.SortedMemoizing         (ParseFailure(..), ResultList(..), Parser(..),@@ -13,6 +13,7 @@ #endif import Data.Either (partitionEithers) import Data.Functor.Compose (Compose(..))+import Data.List (intercalate) import Data.List.NonEmpty (NonEmpty((:|)), nonEmpty, toList) import Data.Monoid (Monoid(mappend, mempty)) import Data.Monoid.Null (MonoidNull(null))@@ -30,6 +31,7 @@ import qualified Text.Parser.Char import Text.Parser.Char (CharParsing) import Text.Parser.Combinators (Parsing(..))+import Text.Parser.Input.Position (fromEnd) import Text.Parser.LookAhead (LookAheadParsing(..))  import qualified Rank2@@ -39,7 +41,8 @@                           ConsumedInputParsing(..), DeterministicParsing(..),                           TailsParsing(parseTails, parseAllTails), ParseResults, ParseFailure(..),                           FailureDescription(..))-import Text.Grampa.Internal (ResultList(..), ResultsOfLength(..), TraceableParsing(..), expected, erroneous)+import Text.Grampa.Internal (ResultList(..), ResultsOfLength(..), TraceableParsing(..),+                             emptyFailure, expected, expectedInput, replaceExpected, erroneous) import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack  import Prelude hiding (iterate, null, showList, span, takeWhile)@@ -64,7 +67,7 @@    {-# INLINABLE (<*>) #-}  instance Ord s => Alternative (Parser g s) where-   empty = Parser (\rest-> ResultList mempty $ ParseFailure (Down $ length rest) [] [])+   empty = Parser (ResultList mempty . emptyFailure . Down . length)    Parser p <|> Parser q = Parser r where       r rest = p rest <> q rest    {-# INLINE (<|>) #-}@@ -101,7 +104,7 @@    mappend = (<>)  -- | Memoizing parser guarantees O(n²) performance for grammars with unambiguous productions. Can be wrapped with--- 'Text.Grampa.ContextFree.LeftRecursive.Fixed' to provide left recursion support.+-- 'Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive.Fixed' to provide left recursion support. instance (Ord s, LeftReductive s, FactorialMonoid s) => GrammarParsing (Parser g s) where    type ParserGrammar (Parser g s) = g    type GrammarFunctor (Parser g s) = ResultList g s@@ -111,17 +114,33 @@       p input@((_, d) : _) = ResultList rs' failure          where ResultList rs failure = f d                rs' = sync <$> rs-               -- in left-recursive grammars the stored input remainder may be wrong, so revert to the complete input+               -- in left-recursive grammars the stored input remainder may be wrong, so revert to the current input                sync (ResultsOfLength 0 _remainder r) = ResultsOfLength 0 input r                sync rol = rol       p _ = ResultList mempty (expected 0 "NonTerminal at endOfInput")    {-# INLINE nonTerminal #-}+   chainRecursive assign (Parser base) (Parser recurse) = Parser q+      where q [] = base []+            q ((s, d):t) = case base ((s, assign mempty d) : t)+                           of r@(ResultList [] _) -> r+                              r -> iter r r+               where iter marginal total = case recurse ((s, assign marginal d) : t)+                                           of ResultList [] _ -> total+                                              r -> iter r (total <> r)+   chainLongestRecursive assign (Parser base) (Parser recurse) = Parser q+      where q [] = base []+            q ((s, d):t) = case base ((s, assign mempty d) : t)+                           of r@(ResultList [] _) -> r+                              r -> iter r+               where iter r = case recurse ((s, assign r d) : t)+                              of ResultList [] _ -> r+                                 r' -> iter r'  instance (Ord s, LeftReductive s, FactorialMonoid s) => TailsParsing (Parser g s) where    parseTails = applyParser  -- | Memoizing parser guarantees O(n²) performance for grammars with unambiguous productions. Can be wrapped with--- 'Text.Grampa.ContextFree.LeftRecursive.Fixed' to provide left recursion support.+-- 'Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive.Fixed' to provide left recursion support. -- -- @ -- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>@@ -191,7 +210,7 @@    string s = Parser p where       p rest@((s', _) : _)          | s `isPrefixOf` s' = ResultList [ResultsOfLength l (Factorial.drop l rest) (s:|[])] mempty-      p rest = ResultList mempty (ParseFailure (Down $ length rest) [LiteralDescription s] [])+      p rest = ResultList mempty (expectedInput (fromEnd $ length rest) s)       l = Factorial.length s    notSatisfy predicate = Parser p       where p rest@((s, _):_)@@ -200,12 +219,13 @@             p rest = ResultList [ResultsOfLength 0 rest (():|[])] mempty    {-# INLINABLE string #-} -instance InputParsing (Parser g s)  => TraceableParsing (Parser g s) where+instance (InputParsing (Parser g s), FactorialMonoid s) => TraceableParsing (Parser g s) where    traceInput description (Parser p) = Parser q-      where q rest@((s, _):_) = case traceWith "Parsing " (p rest)-                                of rl@(ResultList [] _) -> traceWith "Failed " rl-                                   rl -> traceWith "Parsed " rl-               where traceWith prefix = trace (prefix <> description s)+      where q rest@((s, _):_) = case trace ("Parsing " <> description s) (p rest) of+               rl@(ResultList [] _) -> trace ("Failed " <> descriptionWith id) rl+               rl@(ResultList rs _) -> trace ("Parsed [" <> intercalate ", " (describeResult <$> rs) <> "]") rl+               where describeResult (ResultsOfLength len _ _) = descriptionWith (Factorial.take len)+                     descriptionWith f = description (f s)             q [] = p []  instance (Ord s, Show s, TextualMonoid s) => InputCharParsing (Parser g s) where@@ -246,19 +266,17 @@ instance (MonoidNull s, Ord s) => Parsing (Parser g s) where    try (Parser p) = Parser q       where q rest = rewindFailure (p rest)-               where rewindFailure (ResultList rl _) = ResultList rl (ParseFailure (Down $ length rest) [] [])+               where rewindFailure (ResultList rl _) = ResultList rl (emptyFailure $ fromEnd $ length rest)    Parser p <?> msg  = Parser q       where q rest = replaceFailure (p rest)-               where replaceFailure (ResultList [] (ParseFailure pos msgs erroneous')) =-                        ResultList [] (ParseFailure pos (if pos == Down (length rest) then [StaticDescription msg]-                                                         else msgs) erroneous')+               where replaceFailure (ResultList [] f) = ResultList [] (replaceExpected (fromEnd $ length rest) msg f)                      replaceFailure rl = rl    notFollowedBy (Parser p) = Parser (\input-> rewind input (p input))       where rewind t (ResultList [] _) = ResultList [ResultsOfLength 0 t (():|[])] mempty             rewind t ResultList{} = ResultList mempty (expected (Down $ length t) "notFollowedBy")    skipMany p = go       where go = pure () <|> try p *> go-   unexpected msg = Parser (\t-> ResultList mempty $ expected (Down $ length t) msg)+   unexpected msg = Parser (\t-> ResultList mempty $ erroneous (Down $ length t) msg)    eof = Parser f       where f rest@((s, _):_)                | null s = ResultList [ResultsOfLength 0 rest (():|[])] mempty@@ -323,20 +341,19 @@ longest :: Parser g s a -> Backtrack.Parser g [(s, g (ResultList g s))] a longest p = Backtrack.Parser q where    q rest = case applyParser p rest-            of ResultList [] (ParseFailure pos positive negative)-                  -> Backtrack.NoParse (ParseFailure pos (map message positive) (map message negative))+            of ResultList [] (ParseFailure pos (FailureDescription expected inputs) errors)+                  -> Backtrack.NoParse (ParseFailure pos (FailureDescription expected $ map wrap inputs) errors)                ResultList rs _ -> parsed (last rs)    parsed (ResultsOfLength l s (r:|_)) = Backtrack.Parsed l r s-   message (StaticDescription msg) = StaticDescription msg-   message (LiteralDescription s) = LiteralDescription [(s, error "longest")]+   wrap s = [(s, error "longest")]  -- | Turns a backtracking PEG parser of the list of input tails into a context-free parser, opposite of 'longest' peg :: Ord s => Backtrack.Parser g [(s, g (ResultList g s))] a -> Parser g s a peg p = Parser q where    q rest = case Backtrack.applyParser p rest             of Backtrack.Parsed l result suffix -> ResultList [ResultsOfLength l suffix (result:|[])] mempty-               Backtrack.NoParse (ParseFailure pos positive negative)-                 -> ResultList mempty (ParseFailure pos ((fst . head <$>) <$> positive) ((fst . head <$>) <$> negative))+               Backtrack.NoParse (ParseFailure pos (FailureDescription expected inputs) errors)+                  -> ResultList mempty (ParseFailure pos (FailureDescription expected (fst . head <$> inputs)) errors)  -- | Turns a backtracking PEG parser into a context-free parser terminalPEG :: Monoid s => Ord s => Backtrack.Parser g s a -> Parser g s a

@@ -0,0 +1,70 @@+{-# LANGUAGE ConstraintKinds, CPP, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, InstanceSigs,+             RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeFamilies, TypeOperators,+             UndecidableInstances #-}+-- | A context-free memoizing parser that can handle ambiguous left-recursive grammars.+module Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive (+   Fixed, Parser, SeparatedParser(..),+   autochain, liftPositive, liftPure, mapPrimitive,+   longest, peg, terminalPEG,+   parseSeparated, separated)+where++import Text.Grampa.Internal.LeftRecursive (Fixed(..), SeparatedParser(..),+                                           autochain, asLeaf, liftPositive, liftPure, mapPrimitive,+                                           parseSeparated, separated)+import Text.Grampa.ContextFree.SortedMemoizing (ResultList (..))+import qualified Text.Grampa.ContextFree.SortedMemoizing as Memoizing+import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack++-- | A parser for left-recursive grammars on top of the sorted memoizing 'Memoizing.Parser'. It's slightly slower than+-- the parser from "Text.Grampa.ContextFree.Memoizing.LeftRecursive" but provides more features.+type Parser = Fixed Memoizing.Parser++-- | Turns a context-free parser into a backtracking PEG parser that consumes the longest possible prefix of the list+-- of input tails, opposite of 'peg'+longest :: Fixed Memoizing.Parser g s a -> Fixed Backtrack.Parser g [(s, g (ResultList g s))] a+longest (PositiveDirectParser p) = PositiveDirectParser (Memoizing.longest p)+longest p@DirectParser{} = DirectParser{complete= Memoizing.longest (complete p),+                                        direct0=  Memoizing.longest (direct0 p),+                                        direct1=  Memoizing.longest (direct1 p)}+longest p@Parser{} = asLeaf Parser{+   complete= Memoizing.longest (complete p),+   direct=  Memoizing.longest (direct p),+   direct0=  Memoizing.longest (direct0 p),+   direct1=  Memoizing.longest (direct1 p),+   indirect=  Memoizing.longest (indirect p),+   choices= undefined,+   isAmbiguous= Nothing,+   cyclicDescendants= cyclicDescendants p}++-- | Turns a backtracking PEG parser of the list of input tails into a context-free parser, opposite of 'longest'+peg :: Ord s => Fixed Backtrack.Parser g [(s, g (ResultList g s))] a -> Fixed Memoizing.Parser g s a+peg (PositiveDirectParser p) = PositiveDirectParser (Memoizing.peg p)+peg p@DirectParser{} = DirectParser{complete= Memoizing.peg (complete p),+                                        direct0=  Memoizing.peg (direct0 p),+                                        direct1=  Memoizing.peg (direct1 p)}+peg p@Parser{} = asLeaf Parser{+   complete= Memoizing.peg (complete p),+   direct=  Memoizing.peg (direct p),+   direct0=  Memoizing.peg (direct0 p),+   direct1=  Memoizing.peg (direct1 p),+   indirect=  Memoizing.peg (indirect p),+   choices= undefined,+   isAmbiguous= Nothing,+   cyclicDescendants= cyclicDescendants p}++-- | Turns a backtracking PEG parser into a context-free parser+terminalPEG :: (Monoid s, Ord s) => Fixed Backtrack.Parser g s a -> Fixed Memoizing.Parser g s a+terminalPEG (PositiveDirectParser p) = PositiveDirectParser (Memoizing.terminalPEG p)+terminalPEG p@DirectParser{} = DirectParser{complete= Memoizing.terminalPEG (complete p),+                                            direct0=  Memoizing.terminalPEG (direct0 p),+                                            direct1=  Memoizing.terminalPEG (direct1 p)}+terminalPEG p@Parser{} = asLeaf Parser{+   complete= Memoizing.terminalPEG (complete p),+   direct=  Memoizing.terminalPEG (direct p),+   direct0=  Memoizing.terminalPEG (direct0 p),+   direct1=  Memoizing.terminalPEG (direct1 p),+   indirect=  Memoizing.terminalPEG (indirect p),+   choices= undefined,+   isAmbiguous= Nothing,+   cyclicDescendants= cyclicDescendants p}

@@ -1,8 +1,10 @@ {-# LANGUAGE BangPatterns, CPP, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, InstanceSigs,-             RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}+             RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} -- | A context-free memoizing parser that handles all alternatives in parallel -- and carries a monadic computation with each parsing result.-module Text.Grampa.ContextFree.SortedMemoizing.Transformer (ResultListT(..), ParserT(..), (<<|>),+module Text.Grampa.ContextFree.SortedMemoizing.Transformer (ParserT(Parser, applyParser), ResultListT(ResultList),+                                                            ResultsOfLengthT(ResultsOfLengthT, getResultsOfLength),+                                                            ResultsOfLength(ROL),                                                             tbind, lift, tmap, longest, peg, terminalPEG) where @@ -17,6 +19,7 @@ import Data.Function (on) import Data.Functor.Compose (Compose(..)) import Data.Functor.Identity (Identity(..))+import Data.List (intercalate) import Data.List.NonEmpty (NonEmpty((:|)), groupBy, nonEmpty, fromList, toList) import Data.Monoid.Null (MonoidNull(null)) import Data.Monoid.Factorial (FactorialMonoid, splitPrimePrefix)@@ -33,6 +36,7 @@ import qualified Text.Parser.Char import Text.Parser.Char (CharParsing) import Text.Parser.Combinators (Parsing(..))+import Text.Parser.Input.Position (fromEnd) import Text.Parser.LookAhead (LookAheadParsing(..))  import qualified Rank2@@ -41,7 +45,8 @@                           ConsumedInputParsing(..), CommittedParsing(..), DeterministicParsing(..),                           AmbiguousParsing(..), Ambiguous(Ambiguous),                           TailsParsing(..), ParseResults, ParseFailure(..), FailureDescription(..), Pos)-import Text.Grampa.Internal (expected, FallibleResults(..), AmbiguousAlternative(..), TraceableParsing(..))+import Text.Grampa.Internal (emptyFailure, erroneous, expected, expectedInput, replaceExpected,+                             FallibleResults(..), AmbiguousAlternative(..), TraceableParsing(..)) import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack  import Prelude hiding (iterate, null, showList, span, takeWhile)@@ -53,7 +58,7 @@ newtype ResultsOfLengthT m g s r = ResultsOfLengthT{getResultsOfLength :: ResultsOfLength m g s (m r)} data ResultsOfLength m g s a = ROL !Int ![(s, g (ResultListT m g s))] !(NonEmpty a) data ResultListT m g s r = ResultList{resultSuccesses :: ![ResultsOfLengthT m g s r],-                                      resultFailures  :: !(ParseFailure Pos s)}+                                      resultFailures  :: (ParseFailure Pos s)}  singleResult :: (Applicative m, Ord s) => Int -> [(s, g (ResultListT m g s))] -> r -> ResultListT m g s r singleResult len rest a = ResultList [ResultsOfLengthT $ ROL len rest (pure a:|[])] mempty@@ -74,7 +79,7 @@    {-# INLINABLE (<*>) #-}  instance (Applicative m, Ord s) => Alternative (ParserT m g s) where-   empty = Parser (\rest-> ResultList mempty $ ParseFailure (Down $ length rest) [] [])+   empty = Parser (ResultList mempty . emptyFailure . Down . length)    Parser p <|> Parser q = Parser r where       r rest = p rest <> q rest    {-# INLINE (<|>) #-}@@ -107,7 +112,7 @@ instance (Monad m, Traversable m, Ord s) => MonadFail (ParserT m g s) where #endif    fail msg = Parser p-      where p rest = ResultList mempty (ParseFailure (Down $ length rest) [] [StaticDescription msg])+      where p rest = ResultList mempty (erroneous (Down $ length rest) msg)  instance (Foldable m, Monad m, Traversable m, Ord s) => MonadPlus (ParserT m g s) where    mzero = empty@@ -145,7 +150,7 @@    mappend = (<>)  -- | Memoizing parser that carries an applicative computation. Can be wrapped with--- 'Text.Grampa.ContextFree.LeftRecursive.Fixed' to provide left recursion support.+-- 'Text.Grampa.ContextFree.SortedMemoizing.Transformer.LeftRecursive.Fixed' to provide left recursion support. -- -- @ -- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>@@ -164,7 +169,7 @@       where close = Rank2.fmap (<* eof) g  -- | Memoizing parser that carries an applicative computation. Can be wrapped with--- 'Text.Grampa.ContextFree.LeftRecursive.Fixed' to provide left recursion support.+-- 'Text.Grampa.ContextFree.SortedMemoizing.Transformer.LeftRecursive.Fixed' to provide left recursion support. instance (Applicative m, Ord s, LeftReductive s, FactorialMonoid s) => GrammarParsing (ParserT m g s) where    type ParserGrammar (ParserT m g s) = g    type GrammarFunctor (ParserT m g s) = ResultListT m g s@@ -179,6 +184,22 @@                sync rols = rols       p _ = ResultList mempty (expected 0 "NonTerminal at endOfInput")    {-# INLINE nonTerminal #-}+   chainRecursive assign (Parser base) (Parser recurse) = Parser q+      where q [] = base []+            q ((s, d):t) = case base ((s, assign mempty d) : t)+                           of r@(ResultList [] _) -> r+                              r -> iter r r+               where iter marginal total = case recurse ((s, assign marginal d) : t)+                                           of ResultList [] _ -> total+                                              r -> iter r (total <> r)+   chainLongestRecursive assign (Parser base) (Parser recurse) = Parser q+      where q [] = base []+            q ((s, d):t) = case base ((s, assign mempty d) : t)+                           of r@(ResultList [] _) -> r+                              r -> iter r+               where iter r = case recurse ((s, assign r d) : t)+                              of ResultList [] _ -> r+                                 r' -> iter r'  instance (Applicative m, Ord s, LeftReductive s, FactorialMonoid s, Rank2.Functor g) =>          TailsParsing (ParserT m g s) where@@ -230,7 +251,7 @@    string s = Parser p where       p rest@((s', _) : _)          | s `isPrefixOf` s' = singleResult l (drop l rest) s-      p rest = ResultList mempty (ParseFailure (Down $ length rest) [LiteralDescription s] [])+      p rest = ResultList mempty (expectedInput (fromEnd $ length rest) s)       l = Factorial.length s    notSatisfy predicate = Parser p       where p rest@((s, _):_)@@ -239,12 +260,14 @@             p rest = singleResult 0 rest ()    {-# INLINABLE string #-} -instance InputParsing (ParserT m g s) => TraceableParsing (ParserT m g s) where+instance (InputParsing (ParserT m g s), FactorialMonoid s) => TraceableParsing (ParserT m g s) where    traceInput description (Parser p) = Parser q-      where q rest = case traceWith "Parsing " (p rest)-                     of rl@(ResultList [] _) -> traceWith "Failed " rl-                        rl -> traceWith "Parsed " rl-               where traceWith prefix = trace (prefix <> case rest of ((s, _):_) -> description s; [] -> "EOF")+      where q rest@((s, _):_) = case trace ("Parsing " <> description s) (p rest) of+               rl@(ResultList [] _) -> trace ("Failed " <> descriptionWith id) rl+               rl@(ResultList rs _) -> trace ("Parsed [" <> intercalate ", " (describeResult <$> rs) <> "]") rl+               where describeResult (ResultsOfLengthT (ROL len _ _)) = descriptionWith (Factorial.take len)+                     descriptionWith f = description (f s)+            q [] = p []  instance (Applicative m, Ord s, Show s, TextualMonoid s) => InputCharParsing (ParserT m g s) where    satisfyCharInput predicate = Parser p@@ -286,19 +309,17 @@ instance (Applicative m, MonoidNull s, Ord s) => Parsing (ParserT m g s) where    try (Parser p) = Parser q       where q rest = rewindFailure (p rest)-               where rewindFailure (ResultList rl _) = ResultList rl (ParseFailure (Down $ length rest) [] [])+               where rewindFailure (ResultList rl _) = ResultList rl (emptyFailure $ fromEnd $ length rest)    Parser p <?> msg  = Parser q       where q rest = replaceFailure (p rest)-               where replaceFailure (ResultList [] (ParseFailure pos msgs erroneous)) =-                        ResultList [] (ParseFailure pos (if pos == Down (length rest) then [StaticDescription msg]-                                                         else msgs) erroneous)+               where replaceFailure (ResultList [] f) = ResultList [] (replaceExpected (fromEnd $ length rest) msg f)                      replaceFailure rl = rl    notFollowedBy (Parser p) = Parser (\input-> rewind input (p input))       where rewind t (ResultList [] _) = singleResult 0 t ()             rewind t ResultList{} = ResultList mempty (expected (Down $ length t) "notFollowedBy")    skipMany p = go       where go = pure () <|> try p *> go-   unexpected msg = Parser (\t-> ResultList mempty $ expected (Down $ length t) msg)+   unexpected msg = Parser (\t-> ResultList mempty $ erroneous (Down $ length t) msg)    eof = Parser f       where f rest@((s, _):_)                | null s = singleResult 0 rest ()@@ -370,20 +391,19 @@ longest :: ParserT Identity g s a -> Backtrack.Parser g [(s, g (ResultListT Identity g s))] a longest p = Backtrack.Parser q where    q rest = case applyParser p rest-            of ResultList [] (ParseFailure pos positive negative)-                  -> Backtrack.NoParse (ParseFailure pos (map message positive) (map message negative))+            of ResultList [] (ParseFailure pos (FailureDescription expected inputs) errors)+                  -> Backtrack.NoParse (ParseFailure pos (FailureDescription expected $ map wrap inputs) errors)                ResultList rs _ -> parsed (last rs)    parsed (ResultsOfLengthT (ROL l s (Identity r:|_))) = Backtrack.Parsed l r s-   message (StaticDescription msg) = StaticDescription msg-   message (LiteralDescription s) = LiteralDescription [(s, error "longest")]+   wrap s = [(s, error "longest")]  -- | Turns a backtracking PEG parser of the list of input tails into a context-free parser, opposite of 'longest' peg :: (Applicative m, Ord s) => Backtrack.Parser g [(s, g (ResultListT m g s))] a -> ParserT m g s a peg p = Parser q where    q rest = case Backtrack.applyParser p rest             of Backtrack.Parsed l result suffix -> singleResult l suffix result-               Backtrack.NoParse (ParseFailure pos positive negative) ->-                  ResultList mempty (ParseFailure pos ((fst . head <$>) <$> positive) ((fst . head <$>) <$> negative))+               Backtrack.NoParse (ParseFailure pos (FailureDescription expected inputs) errors)+                  -> ResultList mempty (ParseFailure pos (FailureDescription expected (fst . head <$> inputs)) errors)  -- | Turns a backtracking PEG parser into a context-free parser terminalPEG :: (Applicative m, Monoid s, Ord s) => Backtrack.Parser g s a -> ParserT m g s a

@@ -0,0 +1,29 @@+{-# Language GADTs #-}+-- | A context-free parser that can handle ambiguous left-recursive grammars and carry a monadic computation with each+-- parsing result.+module Text.Grampa.ContextFree.SortedMemoizing.Transformer.LeftRecursive (+   ParserT, SeparatedParser(..), AmbiguityDecidable,+   lift, liftPositive, tbind, tmap,+   autochain, parseSeparated, separated)+where++import Text.Grampa.Internal.LeftRecursive (Fixed, SeparatedParser(..),+                                           liftPositive, liftPure, mapPrimitive,+                                           autochain, parseSeparated, separated)+import qualified Text.Grampa.ContextFree.SortedMemoizing.Transformer as Transformer+import Text.Grampa.Internal (AmbiguityDecidable)++-- | Parser transformer for left-recursive grammars on top of 'Transformer.ParserT'.+type ParserT m = Fixed (Transformer.ParserT m)++-- | Lift a parse-free computation into the parser.+lift :: (Applicative m, Ord s) => m a -> ParserT m g s a+lift = liftPure . Transformer.lift++-- | Transform the computation carried by the parser using the monadic bind ('>>=').+tbind :: (Monad m, AmbiguityDecidable b) => ParserT m g s a -> (a -> m b) -> ParserT m g s b+tbind p f = mapPrimitive (`Transformer.tbind` f) p++-- | Transform the computation carried by the parser.+tmap :: AmbiguityDecidable b => (m a -> m b) -> ParserT m g s a -> ParserT m g s b+tmap = mapPrimitive . Transformer.tmap

@@ -1,14 +1,17 @@ {-# LANGUAGE ConstrainedClassMethods, FlexibleContexts, FlexibleInstances, GADTs,-             RankNTypes, TypeOperators #-}+             RankNTypes, StandaloneDeriving, TypeOperators, UndecidableInstances #-}  module Text.Grampa.Internal (BinTree(..), ResultList(..), ResultsOfLength(..), FallibleResults(..),                              AmbiguousAlternative(..), AmbiguityDecidable(..), AmbiguityWitness(..),+                             ParserFlags (ParserFlags, nullable, dependsOn),+                             Dependencies (DynamicDependencies, StaticDependencies),                              TraceableParsing(..),-                             noFailure, expected, erroneous) where+                             emptyFailure, erroneous, expected, expectedInput, replaceExpected, noFailure) where  import Control.Applicative (Applicative(..), Alternative(..)) import Data.Foldable (toList) import Data.Functor.Classes (Show1(..))+import Data.Functor.Const (Const) import Data.List.NonEmpty (NonEmpty, nonEmpty) import Data.Monoid (Monoid(mappend, mempty)) import Data.Ord (Down(Down))@@ -20,15 +23,24 @@  import Prelude hiding (length, showList) -data ResultsOfLength g s r = ResultsOfLength !Int ![(s, g (ResultList g s))] !(NonEmpty r)+data ResultsOfLength g s r = ResultsOfLength !Int ![(s, g (ResultList g s))] {-# UNPACK #-} !(NonEmpty r) -data ResultList g s r = ResultList ![ResultsOfLength g s r] !(ParseFailure Pos s)+data ResultList g s r = ResultList ![ResultsOfLength g s r] (ParseFailure Pos s)  data BinTree a = Fork !(BinTree a) !(BinTree a)                | Leaf !a                | EmptyTree                deriving (Show) +data ParserFlags g = ParserFlags {+   nullable :: Bool,+   dependsOn :: Dependencies g}++data Dependencies g = DynamicDependencies+                    | StaticDependencies (g (Const Bool))++deriving instance Show (g (Const Bool)) => Show (Dependencies g)+ data AmbiguityWitness a where    AmbiguityWitness :: (a :~: Ambiguous b) -> AmbiguityWitness a @@ -42,14 +54,25 @@    ambiguityWitness = Just (AmbiguityWitness Refl)  noFailure :: ParseFailure Pos s-noFailure = ParseFailure (Down maxBound) [] []+noFailure = emptyFailure (Down maxBound) +emptyFailure :: Pos -> ParseFailure Pos s+emptyFailure pos = ParseFailure pos (FailureDescription [] []) []+ expected :: Pos -> String -> ParseFailure Pos s-expected pos msg = ParseFailure pos [StaticDescription msg] []+expected pos msg = ParseFailure pos (FailureDescription [msg] []) [] +expectedInput :: Pos -> s -> ParseFailure Pos s+expectedInput pos s = ParseFailure pos (FailureDescription [] [s]) []+ erroneous :: Pos -> String -> ParseFailure Pos s-erroneous pos msg = ParseFailure pos [] [StaticDescription msg]+erroneous pos msg = ParseFailure pos (FailureDescription [] []) [msg] +replaceExpected :: Pos -> String -> ParseFailure Pos s -> ParseFailure Pos s+replaceExpected pos msg f@(ParseFailure pos' msgs errs) = ParseFailure pos' msgs' errs+   where msgs' | pos == pos' = FailureDescription [msg] []+               | otherwise = msgs+ instance (Show s, Show r) => Show (ResultList g s r) where    show (ResultList l f) = "ResultList (" ++ shows l (") (" ++ shows f ")") @@ -116,6 +139,12 @@    fmap f (Fork left right) = Fork (fmap f left) (fmap f right)    fmap f (Leaf a) = Leaf (f a)    fmap _ EmptyTree = EmptyTree++instance Applicative BinTree where+  pure = Leaf+  EmptyTree <*> _ = EmptyTree+  Leaf f <*> t = f <$> t+  Fork f1 f2 <*> t = Fork (f1 <*> t) (f2 <*> t)  instance Foldable BinTree where    foldMap f (Fork left right) = foldMap f left `mappend` foldMap f right

@@ -0,0 +1,982 @@+{-# LANGUAGE ConstraintKinds, CPP, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, InstanceSigs,+             RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeFamilies, TypeOperators,+             UndecidableInstances #-}+-- | A context-free memoizing parser that can handle left-recursive grammars.+module Text.Grampa.Internal.LeftRecursive (Fixed(..), SeparatedParser(..),+                                           autochain, asLeaf, liftPositive, liftPure, mapPrimitive,+                                           parseSeparated, separated)+where++import Control.Applicative+import Control.Monad (Monad(..), MonadPlus(..), void)+#if MIN_VERSION_base(4,13,0)+import Control.Monad (MonadFail(fail))+#endif+import Control.Monad.Trans.State.Lazy (State, evalState)+import qualified Control.Monad.Trans.State.Lazy as State++import Data.Functor.Compose (Compose(..))+import Data.Kind (Type)+import Data.Maybe (isJust)++import Data.Semigroup (Semigroup(..))+import Data.Monoid (Monoid(mempty), All(..), Any(..))+import Data.Monoid.Null (MonoidNull(null))+import Data.Monoid.Factorial (FactorialMonoid)+import Data.Monoid.Textual (TextualMonoid)+import Data.Semigroup.Cancellative (LeftReductive)+import qualified Data.Monoid.Factorial as Factorial+import qualified Data.Monoid.Textual as Textual+import Data.String (fromString)+import Data.Type.Equality ((:~:)(Refl))+import Witherable (Filterable(mapMaybe))++import qualified Text.Parser.Char as Char+import Text.Parser.Char (CharParsing)+import Text.Parser.Combinators (Parsing(..))+import Text.Parser.LookAhead (LookAheadParsing(..))++import qualified Rank2+import Text.Grampa.Class (GrammarParsing(..), InputParsing(..), InputCharParsing(..), MultiParsing(..),+                          AmbiguousParsing(..), CommittedParsing(..), ConsumedInputParsing(..),+                          DeterministicParsing(..),+                          TailsParsing(parseTails, parseAllTails),+                          ParseResults, ParseFailure(..), FailureDescription(..), Pos)+import Text.Grampa.Internal (FallibleResults(..),+                             AmbiguousAlternative(ambiguousOr), AmbiguityDecidable(..), AmbiguityWitness(..),+                             ParserFlags (ParserFlags, nullable, dependsOn),+                             Dependencies (DynamicDependencies, StaticDependencies),+                             TraceableParsing(..))+import Text.Grampa.Internal.Storable (Storable1(reuse1), Storable11(reuse11, store11))++import Prelude hiding (cycle, null, span, take, takeWhile)++type ResultAppend p (g :: (Type -> Type) -> Type) s =+   GrammarFunctor (p g s) Rank2.~> GrammarFunctor (p g s) Rank2.~> GrammarFunctor (p g s)++-- | A transformer that adds left-recursive powers to a memoizing parser @p@ over grammar @g@+data Fixed p g s a =+   -- | a fully general parser+   Parser {+      complete, direct, direct0, direct1, indirect :: p g s a,+      choices :: ChoiceTree (Fixed p g s a),+      isAmbiguous :: Maybe (AmbiguityWitness a),+      cyclicDescendants :: g (Const (ParserFlags g)) -> ParserFlags g}+   -- | a parser that doesn't start with a 'nonTerminal'+   | DirectParser {+      complete, direct0, direct1 :: p g s a}+   -- | a parser that doesn't start with a 'nonTerminal' and always consumes some input+   | PositiveDirectParser {+      complete :: p g s a}++-- | Binary tree with two different choice nodes+data ChoiceTree a =+   Leaf a+   | SymmetricChoice (ChoiceTree a) (ChoiceTree a)+   | LeftBiasedChoice (ChoiceTree a) (ChoiceTree a)+   deriving Show++instance Functor ChoiceTree where+  fmap f (Leaf a) = Leaf (f a)+  fmap f (SymmetricChoice a b) = SymmetricChoice (fmap f a) (fmap f b)+  fmap f (LeftBiasedChoice a b) = LeftBiasedChoice (fmap f a) (fmap f b)++instance Foldable ChoiceTree where+  foldMap f (Leaf a) = f a+  foldMap f (SymmetricChoice a b) = foldMap f a <> foldMap f b+  foldMap f (LeftBiasedChoice a b) = foldMap f a <> foldMap f b++collapseChoices :: (Alternative p,  DeterministicParsing p) => ChoiceTree (p a) -> p a+collapseChoices (SymmetricChoice p q) = collapseChoices p <|> collapseChoices q+collapseChoices (LeftBiasedChoice p q) = collapseChoices p <<|> collapseChoices q+collapseChoices (Leaf p) = p++-- | A type of parsers analyzed for their left-recursion class+data SeparatedParser p (g :: (Type -> Type) -> Type) s a =+   -- | a parser that no left-recursive nonterminal depends on+   FrontParser (p g s a)+   -- | a left-recursive parser that may add to the set of parse results every time it's run+   | CycleParser {+        cycleParser  :: p g s a,+        backParser   :: p g s a,+        appendResultsArrow :: ResultAppend p g s a,+        dependencies :: Dependencies g}+   -- | a parser that doesn't start with any 'nonTerminal' so it can run first+   | BackParser {+        backParser :: p g s a}++newtype Union (g :: (Type -> Type) -> Type) = Union{getUnion :: g (Const Bool)}++--instance Rank2.Applicative g => Monoid (Union g) where+--   mempty = Union (Rank2.pure $ Const False)++instance (Rank2.Apply g, Rank2.Distributive g) => Semigroup (Union g) where+   Union g1 <> Union g2 = Union (Rank2.liftA2 union g1 g2)++instance (Rank2.Apply g, Rank2.Distributive g) => Monoid (Union g) where+   mempty = Union (Rank2.cotraverse (Const . getConst) (Const False))+   mappend = (<>)++asLeaf :: Fixed p g s a -> Fixed p g s a+asLeaf p@Parser{} = p'+   where p' = p{choices= Leaf p'}+asLeaf p = p++mapPrimitive :: forall p g s a b. AmbiguityDecidable b => (p g s a -> p g s b) -> Fixed p g s a -> Fixed p g s b+mapPrimitive f p@PositiveDirectParser{} = PositiveDirectParser{complete= f (complete p)}+mapPrimitive f p@DirectParser{} = DirectParser{complete= f (complete p),+                                               direct0= f (direct0 p),+                                               direct1= f (direct1 p)}+mapPrimitive f p@Parser{} = asLeaf Parser{+   complete= f (complete p),+   choices= undefined,+   isAmbiguous= ambiguityWitness @b,+   cyclicDescendants= cyclicDescendants p,+   indirect= f (indirect p),+   direct= f (direct p),+   direct0= f (direct0 p),+   direct1= f (direct1 p)}++general, general' :: (Rank2.Apply g, Alternative (p g s)) => Fixed p g s a -> Fixed p g s a+general p = Parser{+   complete= complete p,+   direct = direct p',+   direct0= direct0 p',+   direct1= direct1 p',+   indirect= indirect p',+   choices= choices p',+   isAmbiguous= case p+                of Parser{isAmbiguous= a} -> a+                   _ -> Nothing,+   cyclicDescendants= cyclicDescendants p'}+   where p' = general' p+general' p@PositiveDirectParser{} = asLeaf Parser{+   complete= complete p,+   direct = complete p,+   direct0= empty,+   direct1= complete p,+   indirect= empty,+   choices= undefined,+   isAmbiguous= Nothing,+   cyclicDescendants= \cd-> ParserFlags False (StaticDependencies $ const (Const False) Rank2.<$> cd)}+general' p@DirectParser{} = asLeaf Parser{+   complete= complete p,+   direct = complete p,+   direct0= direct0 p,+   direct1= direct1 p,+   indirect= empty,+   choices= undefined,+   isAmbiguous= Nothing,+   cyclicDescendants= \cd-> ParserFlags True (StaticDependencies $ const (Const False) Rank2.<$> cd)}+general' p@Parser{} = p++type LeftRecParsing p g s f = (Eq s, LeftReductive s, FactorialMonoid s, Alternative (p g s),+                               TailsParsing (p g s), GrammarConstraint (p g s) g, ParserGrammar (p g s) ~ g,+                               Functor (ResultFunctor (p g s)), s ~ ParserInput (p g s), FallibleResults f,+                               Storable1 (GrammarFunctor (p g s)) (ParserFlags g),+                               Storable1 (GrammarFunctor (p g s)) Bool,+                               AmbiguousAlternative (GrammarFunctor (p g s)))++-- | Parser transformer for left-recursive grammars.+--+-- @+-- 'parseComplete' :: ("Rank2".'Rank2.Apply' g, "Rank2".'Rank2.Traversable' g, 'FactorialMonoid' s) =>+--                  g (LeftRecursive.'Parser' g s) -> s -> g ('Compose' ('ParseResults' s) [])+-- @+instance (Rank2.Apply g, GrammarFunctor (p g s) ~ f s, LeftRecParsing p g s f) => MultiParsing (Fixed p g s) where+   type GrammarConstraint (Fixed p g s) g' = (GrammarConstraint (p g s) g', g ~ g',+                                              Rank2.Apply g, Rank2.Distributive g, Rank2.Traversable g)+   type ResultFunctor (Fixed p g s) = ResultFunctor (p g s)+   -- parsePrefix :: (Rank2.Apply g, Rank2.Distributive g, Rank2.Traversable g, Eq s, FactorialMonoid s) =>+   --                g (Fixed p g s) -> s -> g (Compose (ResultFunctor (p g s)) ((,) s))+   parsePrefix g input+      | Just directs <- Rank2.traverse getDirect g' = parsePrefix directs input+      | otherwise = Rank2.fmap (Compose . parsingResult @(p g s) input) (snd $ head $ parseSeparated g' input)+      where g' = separated g+            getDirect (FrontParser p) = Just p+            getDirect (BackParser p) = Just p+            getDirect CycleParser{} = Nothing+   {-# INLINE parsePrefix #-}+   -- parseComplete :: (Rank2.Apply g, Rank2.Distributive g, Rank2.Traversable g, Eq s, FactorialMonoid s) =>+   --                  g (Fixed p g s) -> s -> g (ResultFunctor (p g s))+   parseComplete g input+      | Just directs <- Rank2.traverse getDirect g' = parseComplete directs input+      | otherwise = Rank2.fmap ((snd <$>) . parsingResult @(p g s) input)+                    $ snd $ head $ parseAllTails close $ parseSeparated g' input+      where g' = separated g+            getDirect (FrontParser p) = Just p+            getDirect (BackParser p) = Just p+            getDirect CycleParser{} = Nothing+            close :: g (p g s)+            close = Rank2.fmap (<* eof) selfReferring+   {-# INLINE parseComplete #-}++-- | Parser transformer for left-recursive grammars.+instance (Rank2.Apply g, GrammarFunctor (p g s) ~ f s, LeftRecParsing p g s f) => GrammarParsing (Fixed p g s) where+   type ParserGrammar (Fixed p g s) = g+   type GrammarFunctor (Fixed p g s) = GrammarFunctor (p g s)+   parsingResult :: s -> GrammarFunctor (p g s) a -> ResultFunctor (p g s) (s, a)+   parsingResult s = parsingResult @(p g s) s+   nonTerminal :: (Rank2.Apply g, Rank2.Distributive g, Rank2.Traversable g) =>+                  (g (GrammarFunctor (p g s)) -> GrammarFunctor (p g s) a) -> Fixed p g s a+   nonTerminal f = asLeaf Parser{+      complete= ind,+      direct= empty,+      direct0= empty,+      direct1= empty,+      indirect= ind,+      choices= undefined,+      isAmbiguous= Nothing,+      cyclicDescendants= reuse1 . f . Rank2.fmap store11 . addSelf}+      where ind = nonTerminal f+            addSelf g = Rank2.liftA2 adjust bits g+            adjust :: forall b. Const (g (Const Bool)) b -> Const (ParserFlags g) b -> Const (ParserFlags g) b+            adjust (Const bit) (Const (ParserFlags n (StaticDependencies d))) =+               Const ParserFlags{+                  nullable= n, +                  dependsOn= StaticDependencies (Rank2.liftA2 union bit d)}+            adjust _ flags@(Const (ParserFlags _ DynamicDependencies)) = flags+   {-# INLINE nonTerminal #-}+   recursive = general+   chainRecursive = chainWith chainRecursive+   {-# INLINABLE chainRecursive #-}+   chainLongestRecursive = chainWith chainLongestRecursive+   {-# INLINABLE chainLongestRecursive #-}++chainWith :: (Rank2.Apply g, GrammarFunctor (p g s) ~ f, f ~ rl s, LeftRecParsing p g s rl)+          => ((f a -> g f -> g f) -> p g s a -> p g s a -> p g s a)+          -> ((f a -> g f -> g f) -> Fixed p g s a -> Fixed p g s a -> Fixed p g s a)+chainWith f assign = chain+  where chain base recurse@Parser{} = asLeaf Parser{+           complete= f assign (complete base) (complete recurse),+           direct= f assign (direct base) (complete recurse),+           direct0= f assign (direct0 base) (complete recurse),+           direct1= f assign (direct1 base) (complete recurse),+           indirect= f assign (indirect base) (complete recurse),+           choices= undefined,+           isAmbiguous= isAmbiguous base <|> isAmbiguous recurse,+           cyclicDescendants= \deps-> let ParserFlags pn pd = cyclicDescendants base deps+                                          ParserFlags qn qd = cyclicDescendants recurse deps+                                          qd' = case qd+                                                of DynamicDependencies -> DynamicDependencies+                                                   StaticDependencies g -> StaticDependencies (clearOwnDep g)+                                      in ParserFlags (pn && qn) (depUnion pd qd')}+        chain base recurse = recurse <|> base+        clearOwnDep = Rank2.fmap reuse11 . assign (store11 $ Const False) . Rank2.fmap store11+{-# INLINE chainWith #-}++bits :: forall (g :: (Type -> Type) -> Type). (Rank2.Distributive g, Rank2.Traversable g) => g (Const (g (Const Bool)))+bits = start `seq` Rank2.fmap oneBit start+   where start = evalState (Rank2.traverse next (Rank2.distributeJoin Nothing)) 0+         oneBit :: Const Int a -> Const (g (Const Bool)) a+         next :: f a -> State Int (Const Int a)+         oneBit (Const i) = Const (Rank2.fmap (Const . (i ==) . getConst) start)+         next _ = do {i <- State.get; let {i' = succ i}; seq i' (State.put i'); return (Const i)}++instance Functor (p g s) => Functor (Fixed p g s) where+   fmap f (PositiveDirectParser p) = PositiveDirectParser (fmap f p)+   fmap f p@DirectParser{} = DirectParser{+      complete= fmap f (complete p),+      direct0= fmap f (direct0 p),+      direct1= fmap f (direct1 p)}+   fmap f p@Parser{} = p{+      complete= fmap f (complete p),+      direct= fmap f (direct p),+      direct0= fmap f (direct0 p),+      direct1= fmap f (direct1 p),+      indirect= fmap f (indirect p),+      choices= fmap f <$> choices p,+      isAmbiguous= Nothing}+   {-# INLINABLE fmap #-}++instance (Rank2.Apply g, Alternative (p g s)) => Applicative (Fixed p g s) where+   pure a = DirectParser{complete= pure a,+                         direct0= pure a,+                         direct1= empty}+   p@PositiveDirectParser{} <*> q = PositiveDirectParser{+      complete= complete p <*> complete q}+   p@DirectParser{} <*> q@PositiveDirectParser{} = PositiveDirectParser{+      complete= complete p <*> complete q}+   p@DirectParser{} <*> q@DirectParser{} = DirectParser{+      complete= complete p <*> complete q,+      direct0= direct0 p <*> direct0 q,+      direct1= direct0 p <*> direct1 q <|> direct1 p <*> complete q}+   p <*> q@Parser{} = asLeaf Parser{+      complete= complete p' <*> complete q,+      direct= direct0 p' <*> direct q <|> direct1 p' <*> complete q,+      direct0= direct0 p' <*> direct0 q,+      direct1= direct0 p' <*> direct1 q <|> direct1 p' <*> complete q,+      indirect= direct0 p' <*> indirect q <|> indirect p' <*> complete q,+      choices= undefined,+      isAmbiguous= Nothing,+      cyclicDescendants= \deps-> let+           pcd@(ParserFlags pn pd) = cyclicDescendants p' deps+           ParserFlags qn qd = cyclicDescendants q deps+        in if pn+           then ParserFlags qn (depUnion pd qd)+           else pcd}+      where p'@Parser{} = general' p+   p <*> q = asLeaf Parser{+      complete= complete p' <*> complete q',+      direct= direct p' <*> complete q',+      direct0= direct0 p' <*> direct0 q',+      direct1= direct0 p' <*> direct1 q' <|> direct1 p' <*> complete q',+      indirect= indirect p' <*> complete q',+      choices= undefined,+      isAmbiguous= Nothing,+      cyclicDescendants= \deps-> let+           pcd@(ParserFlags pn pd) = cyclicDescendants p' deps+           ParserFlags qn qd = cyclicDescendants q' deps+        in if pn+           then ParserFlags qn (depUnion pd qd)+           else pcd}+      where p'@Parser{} = general' p+            q'@Parser{} = general' q+   {-# INLINABLE pure #-}+   {-# INLINABLE (<*>) #-}++instance (Rank2.Apply g, Alternative (p g s)) => Alternative (Fixed p g s) where+   empty = PositiveDirectParser{complete= empty}+   p@PositiveDirectParser{} <|> q@PositiveDirectParser{} = PositiveDirectParser{complete= complete p <|> complete q}+   p@PositiveDirectParser{} <|> q@DirectParser{} = DirectParser{+      complete= complete p <|> complete q,+      direct0 = direct0 q,+      direct1= complete p <|> direct1 q}+   p@DirectParser{} <|> q@PositiveDirectParser{} = DirectParser{+      complete= complete p <|> complete q,+      direct0 = direct0 p,+      direct1= direct1 p <|> complete q}+   p@DirectParser{} <|> q@DirectParser{} = DirectParser{+      complete= complete p <|> complete q,+      direct0 = direct0 p <|> direct0 q,+      direct1= direct1 p <|> direct1 q}+   p <|> q = Parser{complete= complete p' <|> complete q',+                    direct= direct p' <|> direct q',+                    direct0= direct0 p' <|> direct0 q',+                    direct1= direct1 p' <|> direct1 q',+                    indirect= indirect p' <|> indirect q',+                    choices= choices p' `SymmetricChoice` choices q',+                    isAmbiguous= Nothing,+                    cyclicDescendants= \deps-> let+                         ParserFlags pn pd = cyclicDescendants p' deps+                         ParserFlags qn qd = cyclicDescendants q' deps+                      in ParserFlags (pn || qn) (depUnion pd qd)}+      where p'@Parser{} = general p+            q'@Parser{} = general q+   many (PositiveDirectParser p) = DirectParser{+      complete= many p,+      direct0= pure [],+      direct1= some p}+   many p@DirectParser{} = DirectParser{+      complete= many (complete p),+      direct0= pure [] <|> (:[]) <$> direct0 p,+      direct1= (:) <$> direct1 p <*> many (complete p)}+   many p@Parser{} = asLeaf Parser{+      complete= mcp,+      direct= d0 <|> d1,+      direct0= d0,+      direct1= d1,+      indirect= (:) <$> indirect p <*> mcp,+      choices= undefined,+      isAmbiguous= Nothing,+      cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}+      where d0 = pure [] <|> (:[]) <$> direct0 p+            d1 = (:) <$> direct1 p <*> mcp+            mcp = many (complete p)+   some (PositiveDirectParser p) = PositiveDirectParser{complete= some p}+   some p@DirectParser{} = DirectParser{+      complete= some (complete p),+      direct0= (:[]) <$> direct0 p,+      direct1= (:) <$> direct1 p <*> many (complete p)}+   some p@Parser{} = asLeaf Parser{+      complete= some (complete p),+      direct= d0 <|> d1,+      direct0= d0,+      direct1= d1,+      indirect= (:) <$> indirect p <*> many (complete p),+      choices= undefined,+      isAmbiguous= Nothing,+      cyclicDescendants= cyclicDescendants p}+      where d0 = (:[]) <$> direct0 p+            d1= (:) <$> direct1 p <*> many (complete p)+   {-# INLINABLE (<|>) #-}+   {-# INLINABLE many #-}+   {-# INLINABLE some #-}++instance Filterable (p g s) => Filterable (Fixed p g s) where+   mapMaybe f (PositiveDirectParser p) = PositiveDirectParser (mapMaybe f p)+   mapMaybe f p@DirectParser{} = DirectParser{+      complete= mapMaybe f (complete p),+      direct0= mapMaybe f (direct0 p),+      direct1= mapMaybe f (direct1 p)}+   mapMaybe f p@Parser{} = p{+      complete= mapMaybe f (complete p),+      direct= mapMaybe f (direct p),+      direct0= mapMaybe f (direct0 p),+      direct1= mapMaybe f (direct1 p),+      indirect= mapMaybe f (indirect p),+      choices= mapMaybe f <$> choices p,+      isAmbiguous= Nothing}+   {-# INLINABLE mapMaybe #-}++complement :: Const Bool x -> Const Bool x+complement (Const a) = Const (not a)++intersection :: Const Bool x -> Const Bool x -> Const Bool x+intersection (Const True) x = x+intersection (Const False) _ = Const False++union :: Const Bool x -> Const Bool x -> Const Bool x+union (Const False) x = x+union (Const True) _ = Const True++depUnion :: Rank2.Apply g => Dependencies g -> Dependencies g -> Dependencies g+depUnion (StaticDependencies d1) (StaticDependencies d2) = StaticDependencies (Rank2.liftA2 union d1 d2)+depUnion _ _ = DynamicDependencies++instance (Rank2.Apply g, Alternative (p g s), Monad (p g s)) => Monad (Fixed p g s) where+   return = pure+   (>>) = (*>)+   PositiveDirectParser p >>= cont = PositiveDirectParser (p >>= complete . cont)+   p@DirectParser{} >>= cont = asLeaf Parser{+      complete= complete p >>= complete . cont,+      direct= d0 <|> d1,+      direct0= d0,+      direct1= d1,+      indirect= direct0 p >>= indirect . general' . cont,+      choices= undefined,+      isAmbiguous= Nothing,+      cyclicDescendants= const (ParserFlags True DynamicDependencies)}+      where d0 = direct0 p >>= direct0 . general' . cont+            d1 = (direct0 p >>= direct1 . general' . cont) <|> (direct1 p >>= complete . cont)+   p >>= cont = asLeaf Parser{+      complete= complete p >>= complete . cont,+      direct= d0 <|> d1,+      direct0= d0,+      direct1= d1,+      indirect= (indirect p >>= complete . cont) <|> (direct0 p >>= indirect . general' . cont),+      choices= undefined,+      isAmbiguous= Nothing,+      cyclicDescendants= \cd->+         let pcd@(ParserFlags pn _) = cyclicDescendants p' cd+         in if pn+            then ParserFlags True DynamicDependencies+            else pcd}+      where d0 = direct0 p >>= direct0 . general' . cont+            d1 = (direct0 p >>= direct1 . general' . cont) <|> (direct1 p >>= complete . cont)+            p'@Parser{} = general' p++#if MIN_VERSION_base(4,13,0)+instance (Rank2.Apply g, Alternative (p g s), MonadFail (p g s)) => MonadFail (Fixed p g s) where+#endif+   fail msg = PositiveDirectParser{complete= fail msg}++instance (Rank2.Apply g, MonadPlus (p g s)) => MonadPlus (Fixed p g s) where+   mzero = empty+   mplus = (<|>)++instance (Rank2.Apply g, Alternative (p g s), Semigroup x) => Semigroup (Fixed p g s x) where+   (<>) = liftA2 (<>)++instance (Rank2.Apply g, Alternative (p g s), Monoid x) => Monoid (Fixed p g s x) where+   mempty = pure mempty+   mappend = (<>)++primitive :: p g s a -> p g s a -> p g s a -> Fixed p g s a+primitive d0 d1 d = DirectParser{complete= d,+                                 direct0= d0,+                                 direct1= d1}+{-# INLINE primitive #-}++-- | Lifts a primitive positive parser (/i.e./, one that always consumes some input) into a left-recursive one+liftPositive :: p g s a -> Fixed p g s a+liftPositive p = PositiveDirectParser{complete= p}+{-# INLINE liftPositive #-}++-- | Lifts a primitive pure parser (/i.e./, one that consumes no input) into a left-recursive one+liftPure :: Alternative (p g s) => p g s a -> Fixed p g s a+liftPure p = DirectParser{complete= p,+                          direct0= p,+                          direct1= empty}+{-# INLINE liftPure #-}++instance (Rank2.Apply g, Parsing (p g s), InputParsing (Fixed p g s)) => Parsing (Fixed p g s) where+   eof = primitive eof empty eof+   try (PositiveDirectParser p) = PositiveDirectParser (try p)+   try p@DirectParser{} = DirectParser{+      complete= try (complete p),+      direct0= try (direct0 p),+      direct1= try (direct1 p)}+   try p@Parser{} = asLeaf p{+      complete= try (complete p),+      direct= try (direct p),+      direct0= try (direct0 p),+      direct1= try (direct1 p),+      indirect= try (indirect p)}+   PositiveDirectParser p <?> msg = PositiveDirectParser (p <?> msg)+   p@DirectParser{} <?> msg = DirectParser{+      complete= complete p <?> msg,+      direct0= direct0 p <?> msg,+      direct1= direct1 p <?> msg}+   p@Parser{} <?> msg = asLeaf p{+      complete= complete p <?> msg,+      direct= direct p <?> msg,+      direct0= direct0 p <?> msg,+      direct1= direct1 p <?> msg,+      indirect= indirect p <?> msg}+   notFollowedBy p@PositiveDirectParser{} = DirectParser{+      complete= notFollowedBy (complete p),+      direct0= notFollowedBy (complete p),+      direct1= empty}+   notFollowedBy p@DirectParser{} = DirectParser{+      complete= notFollowedBy (complete p),+      direct0= notFollowedBy (complete p),+      direct1= empty}+   notFollowedBy p@Parser{} = asLeaf Parser{+      complete= notFollowedBy (complete p),+      direct= notFollowedBy (direct p),+      direct0= notFollowedBy (direct p),+      direct1= empty,+      indirect= notFollowedBy (indirect p),+      choices= undefined,+      isAmbiguous= Nothing,+      cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}+   unexpected msg = liftPositive (unexpected msg)++instance (Rank2.Apply g, InputParsing (Fixed p g s), DeterministicParsing (p g s)) =>+         DeterministicParsing (Fixed p g s) where+   p@DirectParser{} <<|> q@PositiveDirectParser{} = DirectParser{+      complete= complete p <<|> complete q,+      direct0 = direct0 p,+      direct1= direct1 p <<|> complete q}+   p@DirectParser{} <<|> q@DirectParser{} = DirectParser{+      complete= complete p <<|> complete q,+      direct0 = direct0 p <<|> direct0 q,+      direct1= direct1 p <<|> direct1 q}+   p <<|> q = Parser{complete= complete p' <<|> complete q',+                     direct= direct p' <<|> notFollowedBy (void $ complete p') *> direct q',+                     direct0= direct0 p' <<|> notFollowedBy (void $ complete p') *> direct0 q',+                     direct1= direct1 p' <<|> notFollowedBy (void $ complete p') *> direct1 q',+                     indirect= indirect p' <<|> notFollowedBy (void $ complete p') *> indirect q',+                     choices= choices p' `LeftBiasedChoice` choices q',+                     isAmbiguous= Nothing,+                     cyclicDescendants= \deps-> let+                           ParserFlags pn pd = cyclicDescendants p' deps+                           ParserFlags qn qd = cyclicDescendants q' deps+                        in ParserFlags (pn || qn) (depUnion pd qd)}+      where p'@Parser{} = general p+            q'@Parser{} = general q+   takeSome p = (:) <$> p <*> takeMany p+   takeMany (PositiveDirectParser p) = DirectParser{+      complete = takeMany p,+      direct0= [] <$ notFollowedBy (void p),+      direct1= takeSome p}+   takeMany p@DirectParser{} = DirectParser{+      complete = takeMany (complete p),+      direct0= (:[]) <$> direct0 p <<|> [] <$ notFollowedBy (void $ complete p),+      direct1= (:) <$> direct1 p <*> takeMany (complete p)}+   takeMany p@Parser{} = asLeaf Parser{+      complete= mcp,+      direct= d1 <<|> d0,+      direct0= d0,+      direct1= d1,+      indirect= (:) <$> indirect p <*> mcp,+      choices= undefined,+      isAmbiguous= Nothing,+      cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}+      where d0 = (:[]) <$> direct0 p <<|> [] <$ notFollowedBy (void $ direct p)+            d1 = (:) <$> direct1 p <*> mcp+            mcp = takeMany (complete p)+   skipAll (PositiveDirectParser p) = DirectParser{+      complete = skipAll p,+      direct0= () <$ notFollowedBy (void p),+      direct1= p *> skipAll p}+   skipAll p@DirectParser{} = DirectParser{+      complete = skipAll (complete p),+      direct0= void (direct0 p) <<|> notFollowedBy (void $ complete p),+      direct1= direct1 p *> skipAll (complete p)}+   skipAll p@Parser{} = asLeaf Parser{+      complete= mcp,+      direct= d1 <<|> d0,+      direct0= d0,+      direct1= d1,+      indirect= indirect p *> mcp,+      choices= undefined,+      isAmbiguous= Nothing,+      cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}+      where d0 = () <$ direct0 p <<|> notFollowedBy (void $ direct p)+            d1 = direct1 p *> mcp+            mcp = skipAll (complete p)++instance (Rank2.Apply g, CommittedParsing (p g s), CommittedResults (p g s) ~ ParseResults s) =>+         CommittedParsing (Fixed p g s) where+   type CommittedResults (Fixed p g s) = ParseResults s+   commit (PositiveDirectParser p) = PositiveDirectParser (commit p)+   commit p@DirectParser{} = DirectParser{+      complete = commit (complete p),+      direct0= commit (direct0 p),+      direct1= commit (direct1 p)}+   commit p@Parser{} = asLeaf Parser{+      complete= commit (complete p),+      direct= commit (direct p),+      direct0= commit (direct0 p),+      direct1= commit (direct1 p),+      indirect= commit (indirect p),+      choices= undefined,+      isAmbiguous= Nothing,+      cyclicDescendants= cyclicDescendants p}+   admit :: Fixed p g s (CommittedResults (Fixed p g s) a) -> Fixed p g s a+   admit (PositiveDirectParser p) = PositiveDirectParser (admit p)+   admit p@DirectParser{} = DirectParser{+      complete = admit (complete p),+      direct0= admit (direct0 p),+      direct1= admit (direct1 p)}+   admit p@Parser{} = asLeaf Parser{+      complete= admit (complete p),+      direct= admit (direct p),+      direct0= admit (direct0 p),+      direct1= admit (direct1 p),+      indirect= admit (indirect p),+      choices= undefined,+      isAmbiguous= Nothing,+      cyclicDescendants= cyclicDescendants p}++instance (Rank2.Apply g, LookAheadParsing (p g s), InputParsing (Fixed p g s)) => LookAheadParsing (Fixed p g s) where+   lookAhead p@PositiveDirectParser{} = DirectParser{+      complete= lookAhead (complete p),+      direct0= lookAhead (complete p),+      direct1= empty}+   lookAhead p@DirectParser{} = DirectParser{+      complete= lookAhead (complete p),+      direct0= lookAhead (complete p),+      direct1= empty}+   lookAhead p@Parser{} = asLeaf Parser{+      complete= lookAhead (complete p),+      direct= lookAhead (direct p),+      direct0= lookAhead (direct p),+      direct1= empty,+      isAmbiguous= isAmbiguous p,+      indirect= lookAhead (indirect p),+      choices= undefined,+      cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}++instance (Rank2.Apply g, LeftReductive s, FactorialMonoid s, InputParsing (p g s), ParserInput (p g s) ~ s) =>+         InputParsing (Fixed p g s) where+   type ParserInput (Fixed p g s) = s+   getInput = primitive getInput empty getInput+   anyToken = liftPositive anyToken+   satisfy predicate = liftPositive (satisfy predicate)+   notSatisfy predicate = primitive (notSatisfy predicate) empty (notSatisfy predicate)+   scan s0 f = primitive (mempty <$ notSatisfy test) (lookAhead (satisfy test) *> p) p+      where p = scan s0 f+            test = isJust . f s0+   string s+      | null s = primitive (string s) empty (string s)+      | otherwise = liftPositive (string s)+   take 0 = mempty+   take n = liftPositive (take n)+   takeWhile predicate = primitive (mempty <$ notSatisfy predicate)+                                               (takeWhile1 predicate) (takeWhile predicate)+   takeWhile1 predicate = liftPositive (takeWhile1 predicate)++   {-# INLINABLE string #-}++instance (Rank2.Apply g, LeftReductive s, FactorialMonoid s, Show s,+          TraceableParsing (p g s), ParserInput (p g s) ~ s) =>+         TraceableParsing (Fixed p g s) where+   traceInput description p@PositiveDirectParser{} = p{+      complete= traceInput (\s-> "direct+ " <> description s) (complete p)}+   traceInput description p@DirectParser{} = p{+      complete= traceInput (\s-> "direct " <> description s) (complete p),+      direct0= traceInput (\s-> "direct0 " <> description s) (direct0 p),+      direct1= traceInput (\s-> "direct1 " <> description s) (direct1 p)}+   traceInput description p@Parser{} = asLeaf p{+      complete= traceBy "complete" (complete p),+      direct= traceBy "direct" (direct p),+      direct0= traceBy "direct0" (direct0 p),+      direct1= traceBy "direct1" (direct1 p),+      indirect= traceBy "indirect" (indirect p)}+      where traceBy mode = traceInput (\s-> "(" <> mode <> ") " <> description s)++instance (Rank2.Apply g, LeftReductive s, FactorialMonoid s,+          ConsumedInputParsing (p g s), ParserInput (p g s) ~ s) => ConsumedInputParsing (Fixed p g s) where+   match (PositiveDirectParser p) = PositiveDirectParser (match p)+   match p@DirectParser{} = DirectParser{+      complete= match (complete p),+      direct0 = match (direct0 p),+      direct1 = match (direct1 p)}+   match p@Parser{} = asLeaf Parser{+      complete= match (complete p),+      direct =  match (direct p),+      direct0 = match (direct0 p),+      direct1 = match (direct1 p),+      indirect= match (indirect p),+      choices= undefined,+      isAmbiguous= Nothing,+      cyclicDescendants= cyclicDescendants p}++instance (Rank2.Apply g, Show s, TextualMonoid s, InputCharParsing (p g s), ParserInput (p g s) ~ s) =>+         InputCharParsing (Fixed p g s) where+   satisfyCharInput predicate = liftPositive (satisfyCharInput predicate)+   notSatisfyChar predicate = primitive (notSatisfyChar predicate) empty (notSatisfyChar predicate)+   scanChars s0 f = primitive (mempty <$ notSatisfyChar test) (lookAhead (Char.satisfy test) *> p) p+      where p = scanChars s0 f+            test = isJust . f s0+   takeCharsWhile predicate = primitive (mempty <$ notSatisfyChar predicate)+                                        (takeCharsWhile1 predicate) (takeCharsWhile predicate)+   takeCharsWhile1 predicate = liftPositive (takeCharsWhile1 predicate)++instance (Rank2.Apply g, CharParsing (p g s), InputCharParsing (Fixed p g s), TextualMonoid s,+          s ~ ParserInput (Fixed p g s), Show s) => CharParsing (Fixed p g s) where+   satisfy predicate = liftPositive (Char.satisfy predicate)+   string s = Textual.toString (error "unexpected non-character") <$> string (fromString s)+   text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)++instance (AmbiguousParsing (p g s), Rank2.Apply g) => AmbiguousParsing (Fixed p g s) where+   ambiguous (PositiveDirectParser p) = PositiveDirectParser (ambiguous p)+   ambiguous p@DirectParser{} = DirectParser{complete= ambiguous (complete p),+                                             direct0=  ambiguous (direct0 p),+                                             direct1=  ambiguous (direct1 p)}+   ambiguous p@Parser{} = asLeaf Parser{+      complete= ambiguous (complete p),+      direct=   ambiguous (direct p),+      direct0=  ambiguous (direct0 p),+      direct1=  ambiguous (direct1 p),+      indirect= ambiguous (indirect p),+      choices= undefined,+      isAmbiguous= Just (AmbiguityWitness Refl),+      cyclicDescendants= cyclicDescendants p}+   {-# INLINABLE ambiguous #-}++-- | Automatically apply 'chainRecursive' and 'chainLongestRecursive' to left-recursive grammar productions where+-- possible.+autochain :: forall p g s f rl (cb :: Type -> Type).+             (cb ~ Const (g (Const Bool)), f ~ GrammarFunctor (p g s), f ~ rl s,+              LeftRecParsing p g s rl, DeterministicParsing (p g s),+              Rank2.Apply g, Rank2.Traversable g, Rank2.Distributive g, Rank2.Logistic g)+          => g (Fixed p g s) -> g (Fixed p g s)+autochain g = Rank2.liftA4 optimize Rank2.getters Rank2.setters candidates g+   where candidates :: g (Const Bool)+         optimize :: forall a. (Compose ((->) (g cb)) cb a)+                  -> (Rank2.Arrow (f Rank2.~> f) (Const (g f -> g f)) a)+                  -> Const Bool a+                  -> Fixed p g s a+                  -> Fixed p g s a+         optimize getter setter (Const True) p@Parser{choices= cs} =+            optimizeChoice (getCompose getter) (getConst . Rank2.apply setter . Rank2.Arrow . const) p cs+         optimize _ _ _ p = p+         optimizeChoice :: (g cb -> cb a)+                        -> (f a -> g f -> g f)+                        -- > (forall f. (f a -> f a) -> g f -> g f)+                        -- > (forall f. Rank2.Arrow f f a -> Const (g f -> g f) a)+                        -> Fixed p g s a+                        -> ChoiceTree (Fixed p g s a)+                        -> Fixed p g s a+         splitSymmetric :: (g cb -> cb a) -> ChoiceTree (Fixed p g s a) -> ([Fixed p g s a], [Fixed p g s a])+         isLeftRecursive :: (g cb -> cb a) -> ChoiceTree (Fixed p g s a) -> Bool+         leftRecursiveParser :: (g cb -> cb a) -> Fixed p g s a -> Bool+         optimizeChoice _ _ fallback Leaf{} = fallback+         optimizeChoice get set fallback (LeftBiasedChoice p q)+            | isLeftRecursive get q = fallback+            | not (isLeftRecursive get p) = fallback+            | LeftBiasedChoice p1 p2 <- p, not (isLeftRecursive get p2)+            = optimizeChoice get set fallback $ LeftBiasedChoice p1 (LeftBiasedChoice p2 q)+            | otherwise = chainLongestRecursive set (collapseChoices q) (collapseChoices p)+         optimizeChoice get set fallback c@SymmetricChoice{}+            | null base = fallback+            | null recursives = fallback+            | otherwise = chainRecursive set (foldr1 (<|>) base) (foldr1 (<|>) recursives)+            where (base, recursives) = splitSymmetric get c+         splitSymmetric get (SymmetricChoice p q) = splitSymmetric get p <> splitSymmetric get q+         splitSymmetric get c+            | isLeftRecursive get c = ([], [collapseChoices c])+            | otherwise = ([collapseChoices c], [])+         isLeftRecursive get = leftRecursiveParser get . collapseChoices+         leftRecursiveParser get Parser{cyclicDescendants= cds} =+            getAny $ Rank2.foldMap (Any . getConst) $ Rank2.liftA2 intersection (getConst $ get bits) (deps bits)+            where deps :: g cb -> g (Const Bool)+                  deps = getDependencies . dependsOn . cds+                         . Rank2.fmap (Const . ParserFlags False . StaticDependencies . getConst)+         leftRecursiveParser _ _ = False+         candidates = Rank2.liftA2 intersection (cyclicDependencies g) (complement Rank2.<$> cyclicDependencies g')+         g' = Rank2.liftA2 noDirectLeftRecursion bits g+         noDirectLeftRecursion (Const bit) p@Parser{cyclicDescendants= cd} = p{cyclicDescendants= excludeSelf . cd}+            where excludeSelf (ParserFlags n DynamicDependencies) = ParserFlags n DynamicDependencies+                  excludeSelf (ParserFlags n (StaticDependencies deps)) =+                     ParserFlags n $ StaticDependencies $ Rank2.liftA2 intersection (complement Rank2.<$> bit) deps+         noDirectLeftRecursion _ p = p++-- | Analyze the grammar's production interdependencies and produce a 'SeparatedParser' from each production's parser.+separated :: forall p g s. (Alternative (p g s), Rank2.Apply g, Rank2.Distributive g, Rank2.Traversable g,+                            AmbiguousAlternative (GrammarFunctor (p g s))) =>+             g (Fixed p g s) -> g (SeparatedParser p g s)+separated g = Rank2.liftA4 reseparate circulars cycleFollowers descendants g+   where descendants :: g (Const (Dependencies g))+         cycleFollowers, circulars :: g (Const Bool)+         appendResults :: forall a. Maybe (AmbiguityWitness a)+                       -> GrammarFunctor (p g s) a -> GrammarFunctor (p g s) a -> GrammarFunctor (p g s) a+         leftRecursiveDeps :: forall a. Const Bool a -> Const (Dependencies g) a -> Const (g (Const Bool)) a+         reseparate :: forall a. Const Bool a -> Const Bool a -> Const (Dependencies g) a -> Fixed p g s a+                    -> SeparatedParser p g s a+         reseparate (Const circular) (Const follower) (Const d@(StaticDependencies deps)) p+            | circular || leader && follower =+              CycleParser (indirect p) (direct p) (Rank2.Arrow (Rank2.Arrow . appendResults (isAmbiguous p))) d+            | follower = BackParser (complete p)+            | otherwise = FrontParser (complete p)+            where leader = getAny (Rank2.foldMap (Any . getConst) $ Rank2.liftA2 intersection circulars deps)+         reseparate _ _ (Const d@DynamicDependencies) p =+              CycleParser (indirect p) (direct p) (Rank2.Arrow (Rank2.Arrow . appendResults (isAmbiguous p))) d+         appendResults (Just (AmbiguityWitness Refl)) = ambiguousOr+         appendResults Nothing = (<|>)+         descendants = transitiveDescendants g+         circulars = Rank2.liftA2 leftRecursive bits descendants+         cycleFollowers = getUnion (Rank2.foldMap (Union . getConst) $+                                    Rank2.liftA2 leftRecursiveDeps circulars descendants)+         leftRecursiveDeps (Const True) (Const (StaticDependencies deps)) = Const deps+         leftRecursiveDeps (Const False) (Const (StaticDependencies deps)) =+            Const (Rank2.fmap (const $ Const False) deps)+         leftRecursiveDeps _ (Const DynamicDependencies) = Const (Rank2.fmap (const $ Const True) g)+{-# INLINABLE separated #-}++getDependencies :: Rank2.Distributive g => Dependencies g -> g (Const Bool)+getDependencies (StaticDependencies deps) = deps+getDependencies DynamicDependencies = Rank2.cotraverse (const $ Const True) Nothing++cyclicDependencies :: (Alternative (p g s), Rank2.Apply g, Rank2.Distributive g, Rank2.Traversable g)+                   => g (Fixed p g s) -> g (Const Bool)+cyclicDependencies = Rank2.liftA2 leftRecursive bits . transitiveDescendants++leftRecursive :: forall g a. (Rank2.Apply g, Rank2.Foldable g)+              => Const (g (Const Bool)) a -> Const (Dependencies g) a -> Const Bool a+leftRecursive (Const bit) (Const (StaticDependencies deps)) =+   Const (getAny $ Rank2.foldMap (Any . getConst) $ Rank2.liftA2 intersection bit deps)+leftRecursive _ (Const DynamicDependencies) = Const True++transitiveDescendants :: (Alternative (p g s), Rank2.Apply g, Rank2.Traversable g)+                      => g (Fixed p g s) -> g (Const (Dependencies g))+transitiveDescendants =+   Rank2.fmap (Const . dependsOn . getConst) . fixDescendants . Rank2.fmap (Const . cyclicDescendants . general)++fixDescendants :: forall g. (Rank2.Apply g, Rank2.Traversable g)+               => g (Const (g (Const (ParserFlags g)) -> (ParserFlags g))) -> g (Const (ParserFlags g))+fixDescendants gf = go initial+   where go :: g (Const (ParserFlags g)) -> g (Const (ParserFlags g))+         go cd+            | getAll (Rank2.foldMap (All . getConst) $ Rank2.liftA2 agree cd cd') = cd+            | otherwise = go cd'+            where cd' = Rank2.liftA2 flagUnion cd (Rank2.fmap (\(Const f)-> Const (f cd)) gf)+         agree (Const (ParserFlags _xn (StaticDependencies xd))) (Const (ParserFlags _yn (StaticDependencies yd))) =+            Const (getAll (Rank2.foldMap (All . getConst) (Rank2.liftA2 agree' xd yd)))+         agree (Const (ParserFlags _xn DynamicDependencies)) (Const (ParserFlags _yn DynamicDependencies)) = Const True+         agree _ _ = Const False+         agree' (Const x) (Const y) = Const (x == y)+         flagUnion (Const ParserFlags{dependsOn= old}) (Const (ParserFlags n new)) = +            Const (ParserFlags n $ depUnion old new)+         initial = Rank2.liftA2 (\_ (Const n)-> Const (ParserFlags n deps)) gf nullabilities+         deps = StaticDependencies (const (Const False) Rank2.<$> gf)+         nullabilities = fixNullabilities gf+{-# INLINABLE fixDescendants #-}++fixNullabilities :: forall g. (Rank2.Apply g, Rank2.Traversable g)+                    => g (Const (g (Const (ParserFlags g)) -> (ParserFlags g))) -> g (Const Bool)+fixNullabilities gf = Const . nullable . getConst Rank2.<$> go initial+   where go :: g (Const (ParserFlags g)) -> g (Const (ParserFlags g))+         go cd+            | getAll (Rank2.foldMap (All . getConst) $ Rank2.liftA2 agree cd cd') = cd+            | otherwise = go cd'+            where cd' = Rank2.fmap (\(Const f)-> Const (f cd)) gf+         agree (Const flags1) (Const flags2) = Const (nullable flags1 == nullable flags2)+         initial = const (Const (ParserFlags True (StaticDependencies $ const (Const False) Rank2.<$> gf))) Rank2.<$> gf+{-# INLINABLE fixNullabilities #-}++-- | Parse the given input using a context-free grammar 'separated' into left-recursive and other productions.+parseSeparated :: forall p g rl s. (Rank2.Apply g, Rank2.Foldable g, Eq s, FactorialMonoid s, LeftReductive s,+                                    TailsParsing (p g s), GrammarConstraint (p g s) g,+                                    GrammarFunctor (p g s) ~ rl s, FallibleResults rl,+                                    s ~ ParserInput (p g s)) =>+                  g (SeparatedParser p g s) -> s -> [(s, g (GrammarFunctor (p g s)))]+parseSeparated parsers input = foldr parseTail [] (Factorial.tails input)+   where parseTail s parsedTail = parsed+            where parsed = (s,d''):parsedTail+                  d      = Rank2.fmap (($ (s,d):parsedTail) . parseTails) directs+                  d'     = fixRecursive s parsedTail d+                  d''    = Rank2.liftA2 f parsers d'+                  f :: forall a. SeparatedParser p g s a -> GrammarFunctor (p g s) a -> GrammarFunctor (p g s) a+                  f (FrontParser p) _ = parseTails p ((s,d''):parsedTail)+                  f _ result = result+         fixRecursive :: s -> [(s, g (GrammarFunctor (p g s)))]+                      -> g (GrammarFunctor (p g s)) -> g (GrammarFunctor (p g s))+         whileAnyContinues :: (g (GrammarFunctor (p g s)) -> g (GrammarFunctor (p g s)))+                           -> (g (GrammarFunctor (p g s)) -> g (GrammarFunctor (p g s)))+                           -> g (GrammarFunctor (p g s)) -> g (GrammarFunctor (p g s)) -> g (GrammarFunctor (p g s))+         recurseTotal :: s -> g (GrammarFunctor (p g s) Rank2.~> GrammarFunctor (p g s))+                      -> [(s, g (GrammarFunctor (p g s)))]+                      -> g (GrammarFunctor (p g s))+                      -> g (GrammarFunctor (p g s))+         recurseMarginal :: s -> [(s, g (GrammarFunctor (p g s)))]+                      -> g (GrammarFunctor (p g s))+                      -> g (GrammarFunctor (p g s))+         maybeDependencies :: g (Const (Maybe (Dependencies g)))+         maybeDependency :: SeparatedParser p g s r -> Const (Maybe (Dependencies g)) r+         appends :: g (ResultAppend p g s)+         parserAppend :: SeparatedParser p g s r -> ResultAppend p g s r++         directs = Rank2.fmap backParser parsers+         indirects = Rank2.fmap (\p-> case p of {CycleParser{}-> cycleParser p; _ -> empty}) parsers+         appends = Rank2.fmap parserAppend parsers+         parserAppend p@CycleParser{} = appendResultsArrow p+         parserAppend _ = Rank2.Arrow (Rank2.Arrow . const)+         maybeDependencies = Rank2.fmap maybeDependency parsers+         maybeDependency p@CycleParser{} = Const (Just $ dependencies p)+         maybeDependency _ = Const Nothing++         -- Fix the recursive knot on the head of the input, given its already-fixed tail and the initial record of+         -- directly parsed results.+         fixRecursive s parsedTail initial =+            whileAnyContinues (recurseTotal s (appends Rank2.<*> initial) parsedTail)+                              (recurseMarginal s parsedTail)+                              initial initial++         -- Loop accumulating the total parsing results from marginal results as long as there is any new marginal+         -- result to expand a total one or a new failure expactation to augment an existing failure.+         whileAnyContinues ft fm total marginal =+            Rank2.liftA3 choiceWhile maybeDependencies total (whileAnyContinues ft fm (ft total) (fm marginal))+            where choiceWhile :: Const (Maybe (Dependencies g)) x+                              -> GrammarFunctor (p g s) x -> GrammarFunctor (p g s) x+                              -> GrammarFunctor (p g s) x+                  choiceWhile (Const Nothing) t _ = t+                  choiceWhile (Const (Just (StaticDependencies deps))) t t'+                     | getAny (Rank2.foldMap (Any . getConst) (Rank2.liftA2 combine deps marginal)) = t'+                     | hasSuccess t = t+                     | otherwise =+                        failWith (failureOf $+                                  if getAny (Rank2.foldMap (Any . getConst) $+                                             Rank2.liftA2 (combineFailures $ failureOf t) deps marginal)+                                  then t' else t)+                     where combine :: Const Bool x -> GrammarFunctor (p g s) x -> Const Bool x+                           combineFailures :: ParseFailure Pos s -> Const Bool x -> GrammarFunctor (p g s) x+                                           -> Const Bool x+                           combine (Const False) _ = Const False+                           combine (Const True) results = Const (hasSuccess results)+                           combineFailures _ (Const False) _ = Const False+                           combineFailures (ParseFailure pos (FailureDescription expected inputs) errors) (Const True) rl =+                              Const (pos < pos'+                                     || pos == pos' && (any (`notElem` expected) expected'+                                                        || any (`notElem` expected) expected')+                                                        || any (`notElem` errors) errors')+                              where ParseFailure pos' (FailureDescription expected' inputs') errors' = failureOf rl+                  choiceWhile (Const (Just DynamicDependencies)) t t'+                     | getAny (Rank2.foldMap (Any . hasSuccess) marginal) = t'+                     | hasSuccess t = t+                     | ParseFailure _ (FailureDescription [] []) [] <- failureOf t = t'+                     | otherwise = t++         -- Adds another round of indirect parsing results to the total results accumulated so far.+         recurseTotal s initialAppends parsedTail total = Rank2.liftA2 reparse initialAppends indirects+            where reparse :: (GrammarFunctor (p g s) Rank2.~> GrammarFunctor (p g s)) a -> p g s a+                          -> GrammarFunctor (p g s) a+                  reparse append p = Rank2.apply append (parseTails p $ (s, total) : parsedTail)+         -- Calculates the next round of indirect parsing results from the previous marginal round.+         recurseMarginal s parsedTail marginal =+            flip parseTails ((s, marginal) : parsedTail) Rank2.<$> indirects+{-# NOINLINE parseSeparated #-}

@@ -0,0 +1,80 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++module Text.Grampa.Internal.Storable (Storable(..), Storable1(..), Storable11(..),+                                      Dependencies(..), ParserFlags(..)) where++import Data.Functor.Const (Const(Const, getConst))+import qualified Rank2+import Text.Grampa.Class (ParseFailure(ParseFailure))+import Text.Grampa.Internal (ResultList(ResultList), ResultsOfLength(ResultsOfLength),+                             ParserFlags (ParserFlags, nullable, dependsOn),+                             Dependencies (DynamicDependencies, StaticDependencies))+import qualified Text.Grampa.ContextFree.SortedMemoizing.Transformer as Transformer++class Storable s a where+   store :: a -> s+   reuse :: s -> a++class Storable1 s a where+   store1 :: a -> s b+   reuse1 :: s b -> a++class Storable11 s t where+   store11 :: t a -> s b+   reuse11 :: s b -> t a++instance Storable a a where+   store = id+   reuse = id++instance Storable1 (Const a) a where+   store1 = Const+   reuse1 = getConst++instance Storable1 s a => Storable11 s (Const a) where+   store11 = store1 . getConst+   reuse11 = Const . reuse1++instance (Storable1 f a, Rank2.Functor g) => Storable (g f) (g (Const a)) where+   store = Rank2.fmap (store1 . getConst)+   reuse = Rank2.fmap (Const . reuse1)++instance Ord s => Storable1 (ResultList g s) Bool where+   store1 bit = ResultList [] (ParseFailure (if bit then 1 else 0) mempty [])+   reuse1 (ResultList _ (ParseFailure pos _ _)) = pos /= 0++instance (Rank2.Functor g, Monoid s, Ord s) => Storable1 (ResultList g s) (ParserFlags g) where+   store1 a = ResultList [store a] mempty+   reuse1 (ResultList [s] _) = reuse s++instance (Rank2.Functor g, Monoid s, Ord s) => Storable (ResultsOfLength g s r) (ParserFlags g) where+   store (ParserFlags n d) = ResultsOfLength (if n then 1 else 0) (store d) (pure $ error "unused")+   reuse (ResultsOfLength n d _) = ParserFlags (n /= 0) (reuse d)++instance (Rank2.Functor g, Monoid s, Ord s) => Storable [(s, g (ResultList g s))] (Dependencies g) where+   store DynamicDependencies = []+   store (StaticDependencies deps) = [(mempty, store deps)]+   reuse [] = DynamicDependencies+   reuse [(_, deps)] = StaticDependencies (reuse deps)++instance Ord s => Storable1 (Transformer.ResultListT m g s) Bool where+   store1 bit = Transformer.ResultList [] (ParseFailure (if bit then 1 else 0) mempty [])+   reuse1 (Transformer.ResultList _ (ParseFailure pos _ _)) = pos /= 0++instance (Rank2.Functor g, Monoid s, Ord s) => Storable1 (Transformer.ResultListT m g s) (ParserFlags g) where+   store1 a = Transformer.ResultList [store a] mempty+   reuse1 (Transformer.ResultList [s] _) = reuse s++instance (Rank2.Functor g, Monoid s, Ord s) => Storable (Transformer.ResultsOfLengthT m g s r) (ParserFlags g) where+   store = Transformer.ResultsOfLengthT . store+   reuse = reuse . Transformer.getResultsOfLength++instance (Rank2.Functor g, Monoid s, Ord s) => Storable (Transformer.ResultsOfLength m g s r) (ParserFlags g) where+   store (ParserFlags n d) = Transformer.ROL (if n then 1 else 0) (store d) (pure $ error "unused")+   reuse (Transformer.ROL n d _) = ParserFlags (n /= 0) (reuse d)++instance (Rank2.Functor g, Monoid s, Ord s) => Storable [(s, g (Transformer.ResultListT m g s))] (Dependencies g) where+   store DynamicDependencies = []+   store (StaticDependencies deps) = [(mempty, store deps)]+   reuse [] = DynamicDependencies+   reuse [(_, deps)] = StaticDependencies (reuse deps)

@@ -34,7 +34,7 @@ import Text.Grampa.Class (CommittedParsing(..), DeterministicParsing(..),                           InputParsing(..), InputCharParsing(..), MultiParsing(..),                           ParseResults, ParseFailure(..), FailureDescription(..), Pos)-import Text.Grampa.Internal (expected, TraceableParsing(..))+import Text.Grampa.Internal (emptyFailure, erroneous, expected, expectedInput, replaceExpected, TraceableParsing(..))  data Result (g :: (Type -> Type) -> Type) s v =      Parsed{parsedPrefix :: !v,@@ -71,7 +71,7 @@    {-# INLINABLE (<*>) #-}  instance Factorial.FactorialMonoid s => Alternative (Parser g s) where-   empty = Parser (\rest-> NoParse $ ParseFailure (fromEnd $ Factorial.length rest) [] [])+   empty = Parser (NoParse . emptyFailure . fromEnd . Factorial.length)    (<|>) = alt  -- | A named and unconstrained version of the '<|>' operator@@ -94,7 +94,7 @@  #if MIN_VERSION_base(4,13,0) instance Factorial.FactorialMonoid s => MonadFail (Parser g s) where-   fail msg = Parser (\rest-> NoParse $ ParseFailure (fromEnd $ Factorial.length rest) [] [StaticDescription msg])+   fail msg = Parser (\rest-> NoParse $ erroneous (fromEnd $ Factorial.length rest) msg) #endif  instance Factorial.FactorialMonoid s => MonadPlus (Parser g s) where@@ -111,22 +111,17 @@ instance Factorial.FactorialMonoid s => Parsing (Parser g s) where    try (Parser p) = Parser q       where q rest = rewindFailure (p rest)-               where rewindFailure NoParse{} = NoParse (ParseFailure (fromEnd $ Factorial.length rest) [] [])+               where rewindFailure NoParse{} = NoParse (emptyFailure $ fromEnd $ Factorial.length rest)                      rewindFailure parsed = parsed    Parser p <?> msg  = Parser q       where q rest = replaceFailure (p rest)-               where replaceFailure (NoParse (ParseFailure pos msgs _)) =-                        NoParse (ParseFailure pos-                                              (if pos == fromEnd (Factorial.length rest) then [StaticDescription msg]-                                               else msgs)-                                              [])+               where replaceFailure (NoParse f) = NoParse (replaceExpected (fromEnd $ Factorial.length rest) msg f)                      replaceFailure parsed = parsed    eof = Parser p       where p rest                | Null.null rest = Parsed () rest-               | otherwise = NoParse (ParseFailure (fromEnd $ Factorial.length rest)-                                                   [StaticDescription "end of input"] [])-   unexpected msg = Parser (\t-> NoParse $ ParseFailure (fromEnd $ Factorial.length t) [] [StaticDescription msg])+               | otherwise = NoParse (expected (fromEnd $ Factorial.length rest) "end of input")+   unexpected msg = Parser (\t-> NoParse $ erroneous (fromEnd $ Factorial.length t) msg)    notFollowedBy (Parser p) = Parser (\input-> rewind input (p input))       where rewind t Parsed{} = NoParse (expected (fromEnd $ Factorial.length t) "notFollowedBy")             rewind t NoParse{} = Parsed () t@@ -198,13 +193,15 @@                         else Parsed prefix suffix    string s = Parser p where       p s' | Just suffix <- Cancellative.stripPrefix s s' = Parsed s suffix-           | otherwise = NoParse (ParseFailure (fromEnd $ Factorial.length s') [LiteralDescription s] [])+           | otherwise = NoParse (expectedInput (fromEnd $ Factorial.length s') s)    {-# INLINABLE string #-} -instance InputParsing (Parser g s)  => TraceableParsing (Parser g s) where+instance (InputParsing (Parser g s), FactorialMonoid s)  => TraceableParsing (Parser g s) where    traceInput description (Parser p) = Parser q       where q s = case traceWith "Parsing " (p s)-                  of r@Parsed{} -> traceWith "Parsed " r+                  of r@Parsed{}+                        | let prefix = Factorial.take (Factorial.length s - Factorial.length (parsedSuffix r)) s+                          -> trace ("Parsed " <> description prefix) r                      r@NoParse{} -> traceWith "Failed " r                where traceWith prefix = trace (prefix <> description s) 

@@ -33,8 +33,8 @@ import Text.Parser.Input.Position (fromEnd) import Text.Grampa.Class (CommittedParsing(..), DeterministicParsing(..),                           InputParsing(..), InputCharParsing(..), ConsumedInputParsing(..),-                          MultiParsing(..), ParseResults, ParseFailure(..), FailureDescription(..), Pos)-import Text.Grampa.Internal (expected, TraceableParsing(..))+                          MultiParsing(..), ParseResults, ParseFailure(..), Pos)+import Text.Grampa.Internal (emptyFailure, erroneous, expected, expectedInput, replaceExpected, TraceableParsing(..))  data Result (g :: (Type -> Type) -> Type) s v =      Parsed{parsedLength :: !Int,@@ -74,7 +74,7 @@    {-# INLINABLE (<*>) #-}  instance FactorialMonoid s => Alternative (Parser g s) where-   empty = Parser (\rest-> NoParse $ ParseFailure (fromEnd $ Factorial.length rest) [] [])+   empty = Parser (NoParse . emptyFailure . fromEnd . Factorial.length)    (<|>) = alt  -- | A named and unconstrained version of the '<|>' operator@@ -104,7 +104,7 @@ #if MIN_VERSION_base(4,13,0) instance FactorialMonoid s => MonadFail (Parser g s) where #endif-   fail msg = Parser (\rest-> NoParse $ ParseFailure (fromEnd $ Factorial.length rest) [] [StaticDescription msg])+   fail msg = Parser (\rest-> NoParse $ erroneous (fromEnd $ Factorial.length rest) msg)  instance FactorialMonoid s => MonadPlus (Parser g s) where    mzero = empty@@ -120,24 +120,19 @@ instance FactorialMonoid s => Parsing (Parser g s) where    try (Parser p) = Parser q       where q rest = rewindFailure (p rest)-               where rewindFailure NoParse{} = NoParse (ParseFailure (fromEnd $ Factorial.length rest) [] [])+               where rewindFailure NoParse{} = NoParse (emptyFailure $ fromEnd $ Factorial.length rest)                      rewindFailure parsed = parsed    Parser p <?> msg  = Parser q       where q rest = replaceFailure (p rest)-               where replaceFailure (NoParse (ParseFailure pos msgs erroneous)) =-                        NoParse (ParseFailure pos-                                    (if pos == fromEnd (Factorial.length rest) then [StaticDescription msg] else msgs)-                                    erroneous)+               where replaceFailure (NoParse f) = NoParse (replaceExpected (fromEnd $ Factorial.length rest) msg f)                      replaceFailure parsed = parsed    eof = Parser p       where p rest                | Null.null rest = Parsed 0 () rest-               | otherwise = NoParse (ParseFailure (fromEnd $ Factorial.length rest)-                                                   [StaticDescription "end of input"] [])-   unexpected msg = Parser (\t-> NoParse $ ParseFailure (fromEnd $ Factorial.length t) [] [StaticDescription msg])+               | otherwise = NoParse (expected (fromEnd $ Factorial.length rest) "end of input")+   unexpected msg = Parser (\t-> NoParse $ erroneous (fromEnd $ Factorial.length t) msg)    notFollowedBy (Parser p) = Parser (\input-> rewind input (p input))-      where rewind t Parsed{} = NoParse (ParseFailure (fromEnd $ Factorial.length t)-                                                      [StaticDescription "notFollowedBy"] [])+      where rewind t Parsed{} = NoParse (expected (fromEnd $ Factorial.length t) "notFollowedBy")             rewind t NoParse{} = Parsed 0 () t  instance FactorialMonoid s => CommittedParsing (Parser g s) where@@ -208,7 +203,7 @@                         else Parsed (Factorial.length prefix) prefix suffix    string s = Parser p where       p s' | Just suffix <- Cancellative.stripPrefix s s' = Parsed l s suffix-           | otherwise = NoParse (ParseFailure (fromEnd $ Factorial.length s') [LiteralDescription s] [])+           | otherwise = NoParse (expectedInput (fromEnd $ Factorial.length s') s)       l = Factorial.length s    {-# INLINABLE string #-} @@ -218,10 +213,10 @@                      of Parsed l prefix suffix -> Parsed l (Factorial.take l rest, prefix) suffix                         NoParse failure -> NoParse failure -instance InputParsing (Parser g s)  => TraceableParsing (Parser g s) where+instance (InputParsing (Parser g s), FactorialMonoid s)  => TraceableParsing (Parser g s) where    traceInput description (Parser p) = Parser q       where q s = case traceWith "Parsing " (p s)-                  of r@Parsed{} -> traceWith "Parsed " r+                  of r@Parsed{} -> trace ("Parsed " <> description (Factorial.take (parsedLength r) s)) r                      r@NoParse{} -> traceWith "Failed " r                where traceWith prefix = trace (prefix <> description s) 

@@ -33,12 +33,12 @@ import Text.Parser.Input.Position (fromEnd) import Text.Grampa.Class (CommittedParsing(..), DeterministicParsing(..),                           InputParsing(..), InputCharParsing(..), MultiParsing(..),-                          ParseResults, ParseFailure(..), FailureDescription(..), Pos)-import Text.Grampa.Internal (expected, TraceableParsing(..))+                          ParseResults, ParseFailure(..), Pos)+import Text.Grampa.Internal (emptyFailure, erroneous, expected, expectedInput, replaceExpected, TraceableParsing(..))  data Result (g :: (Type -> Type) -> Type) s v = Parsed{parsedPrefix :: !v,-                                              parsedSuffix :: !s}-                                     | NoParse (ParseFailure Pos s)+                                                       parsedSuffix :: !s}+                                              | NoParse (ParseFailure Pos s)  -- | Parser type for Parsing Expression Grammars that uses a continuation-passing algorithm, fast for grammars in -- LL(1) class but with potentially exponential performance for longer ambiguous prefixes.@@ -55,8 +55,7 @@  instance Factorial.FactorialMonoid s => Filterable (Result g s) where    mapMaybe f (Parsed a rest) =-      maybe (NoParse $ ParseFailure (fromEnd $ Factorial.length rest) [StaticDescription "filter"] [])-            (`Parsed` rest) (f a)+      maybe (NoParse $ expected (fromEnd $ Factorial.length rest) "filter") (`Parsed` rest) (f a)    mapMaybe _ (NoParse failure) = NoParse failure     instance Functor (Parser g s) where@@ -72,7 +71,7 @@    {-# INLINABLE (<*>) #-}  instance (FactorialMonoid s, Ord s) => Alternative (Parser g s) where-   empty = Parser (\rest _ failure-> failure $ ParseFailure (fromEnd $ Factorial.length rest) [] [])+   empty = Parser (\rest _ failure-> failure $ emptyFailure $ fromEnd $ Factorial.length rest)    (<|>) = alt  -- | A named and unconstrained version of the '<|>' operator@@ -103,8 +102,7 @@ #if MIN_VERSION_base(4,13,0) instance (FactorialMonoid s, Ord s) => MonadFail (Parser g s) where #endif-   fail msg = Parser (\rest _ failure-> failure $-                       ParseFailure (fromEnd $ Factorial.length rest) [StaticDescription msg] [])+   fail msg = Parser (\rest _ failure-> failure $ erroneous (fromEnd $ Factorial.length rest) msg)  instance (FactorialMonoid s, Ord s) => MonadPlus (Parser g s) where    mzero = empty@@ -121,27 +119,20 @@    try :: forall a. Parser g s a -> Parser g s a    try (Parser p) = Parser q       where q :: forall x. s -> (a -> s -> x) -> (ParseFailure Pos s -> x) -> x-            q input success failure = p input success (const $ failure-                                                       $ ParseFailure (fromEnd $ Factorial.length input) [] [])+            q input success failure = p input success (const $ failure $ emptyFailure $ fromEnd $ Factorial.length input)    (<?>) :: forall a. Parser g s a -> String -> Parser g s a    Parser p <?> msg  = Parser q       where q :: forall x. s -> (a -> s -> x) -> (ParseFailure Pos s -> x) -> x-            q input success failure = p input success (failure . replaceFailure)-               where replaceFailure (ParseFailure pos msgs erroneous) =-                        ParseFailure pos (if pos == fromEnd (Factorial.length input) then [StaticDescription msg]-                                          else msgs) erroneous+            q input success failure = p input success (failure . replaceExpected (fromEnd $ Factorial.length input) msg)    eof = Parser p       where p rest success failure                | Null.null rest = success () rest-               | otherwise = failure (ParseFailure (fromEnd $ Factorial.length rest)-                                                   [StaticDescription "end of input"] [])-   unexpected msg = Parser (\t _ failure ->-                             failure $ ParseFailure (fromEnd $ Factorial.length t) [] [StaticDescription msg])+               | otherwise = failure (expected (fromEnd $ Factorial.length rest) "end of input")+   unexpected msg = Parser (\t _ failure -> failure $ erroneous (fromEnd $ Factorial.length t) msg)    notFollowedBy (Parser p) = Parser q       where q :: forall x. s -> (() -> s -> x) -> (ParseFailure Pos s -> x) -> x             q input success failure = p input success' failure'-               where success' _ _ =-                        failure (ParseFailure (fromEnd $ Factorial.length input) [StaticDescription "notFollowedBy"] [])+               where success' _ _ = failure (expected (fromEnd $ Factorial.length input)  "notFollowedBy")                      failure' _ = success () input  instance (FactorialMonoid s, Ord s) => CommittedParsing (Parser g s) where@@ -229,17 +220,18 @@       p :: forall x. s -> (s -> s -> x) -> (ParseFailure Pos s -> x) -> x       p s' success failure          | Just suffix <- stripPrefix s s' = success s suffix-         | otherwise = failure (ParseFailure (fromEnd $ Factorial.length s') [LiteralDescription s] [])+         | otherwise = failure (expectedInput (fromEnd $ Factorial.length s') s)    {-# INLINABLE string #-} -instance InputParsing (Parser g s)  => TraceableParsing (Parser g s) where+instance (InputParsing (Parser g s), FactorialMonoid s)  => TraceableParsing (Parser g s) where    traceInput :: forall a. (s -> String) -> Parser g s a -> Parser g s a    traceInput description (Parser p) = Parser q       where q :: forall x. s -> (a -> s -> x) -> (ParseFailure Pos s -> x) -> x             q rest success failure = traceWith "Parsing " (p rest success' failure')                where traceWith prefix = trace (prefix <> description rest)                      failure' f = traceWith "Failed " (failure f)-                     success' r suffix = traceWith "Parsed " (success r suffix)+                     success' r suffix = trace ("Parsed " <> description prefix) (success r suffix)+                        where prefix = Factorial.take (Factorial.length rest - Factorial.length prefix) rest  instance (Ord s, Show s, TextualMonoid s) => InputCharParsing (Parser g s) where    satisfyCharInput predicate = Parser p

@@ -33,7 +33,7 @@ import Text.Grampa.Class (CommittedParsing(..), DeterministicParsing(..),                           InputParsing(..), InputCharParsing(..), ConsumedInputParsing(..),                           MultiParsing(..), ParseResults, ParseFailure(..), FailureDescription(..), Pos)-import Text.Grampa.Internal (TraceableParsing(..), expected)+import Text.Grampa.Internal (TraceableParsing(..), emptyFailure, erroneous, expected, expectedInput, replaceExpected) import Text.Grampa.PEG.Continued (Result(..))  -- | Parser type for Parsing Expression Grammars that uses a continuation-passing algorithm and keeps track of the@@ -55,7 +55,7 @@    {-# INLINABLE (<*>) #-}  instance (FactorialMonoid s, Ord s) => Alternative (Parser g s) where-   empty = Parser (\rest _ failure-> failure $ ParseFailure (fromEnd $ Factorial.length rest) [] [])+   empty = Parser (\rest _ failure-> failure $ emptyFailure $ fromEnd $ Factorial.length rest)    (<|>) = alt  -- | A named and unconstrained version of the '<|>' operator@@ -105,20 +105,16 @@    try :: forall a. Parser g s a -> Parser g s a    try (Parser p) = Parser q       where q :: forall x. s -> (a -> Int -> s -> x) -> (ParseFailure Pos s -> x) -> x-            q input success failure =-               p input success (const $ failure $ ParseFailure (fromEnd $ Factorial.length input) [] [])+            q input success failure = p input success (const $ failure $ emptyFailure $ fromEnd $ Factorial.length input)    (<?>) :: forall a. Parser g s a -> String -> Parser g s a    Parser p <?> msg  = Parser q       where q :: forall x. s -> (a -> Int -> s -> x) -> (ParseFailure Pos s -> x) -> x-            q input success failure = p input success (failure . replaceFailure)-               where replaceFailure (ParseFailure pos msgs erroneous) =-                        ParseFailure pos (if pos == fromEnd (Factorial.length input) then [StaticDescription msg]-                                          else msgs) erroneous+            q input success failure = p input success (failure . replaceExpected (fromEnd $ Factorial.length input) msg)    eof = Parser p       where p rest success failure                | Null.null rest = success () 0 rest                | otherwise = failure (expected (fromEnd $ Factorial.length rest) "end of input")-   unexpected msg = Parser (\t _ failure -> failure $ expected (fromEnd $ Factorial.length t) msg)+   unexpected msg = Parser (\t _ failure -> failure $ erroneous (fromEnd $ Factorial.length t) msg)    notFollowedBy (Parser p) = Parser q       where q :: forall x. s -> (() -> Int -> s -> x) -> (ParseFailure Pos s -> x) -> x             q input success failure = p input success' failure'@@ -215,7 +211,7 @@       p :: forall x. s -> (s -> Int -> s -> x) -> (ParseFailure Pos s -> x) -> x       p s' success failure          | Just suffix <- stripPrefix s s', !len <- Factorial.length s = success s len suffix-         | otherwise = failure (ParseFailure (fromEnd $ Factorial.length s') [LiteralDescription s] [])+         | otherwise = failure (expectedInput (fromEnd $ Factorial.length s') s)    {-# INLINABLE string #-}  instance (LeftReductive s, FactorialMonoid s, Ord s) => ConsumedInputParsing (Parser g s) where@@ -225,14 +221,15 @@             q rest success failure = p rest success' failure                where success' r !len suffix = success (Factorial.take len rest, r) len suffix -instance InputParsing (Parser g s)  => TraceableParsing (Parser g s) where+instance (InputParsing (Parser g s), FactorialMonoid s)  => TraceableParsing (Parser g s) where    traceInput :: forall a. (s -> String) -> Parser g s a -> Parser g s a    traceInput description (Parser p) = Parser q       where q :: forall x. s -> (a -> Int -> s -> x) -> (ParseFailure Pos s -> x) -> x             q rest success failure = traceWith "Parsing " (p rest success' failure')                where traceWith prefix = trace (prefix <> description rest)                      failure' f = traceWith "Failed " (failure f)-                     success' r !len suffix = traceWith "Parsed " (success r len suffix)+                     success' r !len suffix =+                        trace ("Parsed " <> description (Factorial.take len rest)) (success r len suffix)  instance (Ord s, Show s, TextualMonoid s) => InputCharParsing (Parser g s) where    satisfyCharInput predicate = Parser p

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, FlexibleContexts, TypeFamilies, UndecidableInstances #-}+{-# LANGUAGE CPP, FlexibleContexts, TypeFamilies, TypeOperators, UndecidableInstances #-} -- | Packrat parser module Text.Grampa.PEG.Packrat (Parser(..), Result(..)) where @@ -34,12 +34,13 @@ import Text.Grampa.Class (CommittedParsing(..), DeterministicParsing(..),                           InputParsing(..), InputCharParsing(..),                           GrammarParsing(..), MultiParsing(..),-                          TailsParsing(parseTails), ParseResults, ParseFailure(..), FailureDescription(..), Pos)-import Text.Grampa.Internal (expected, TraceableParsing(..))+                          TailsParsing(parseTails), ParseResults, ParseFailure(..), Pos)+import Text.Grampa.Internal (emptyFailure, erroneous, expected, expectedInput, replaceExpected, noFailure,+                             TraceableParsing(..))  data Result g s v = Parsed{parsedPrefix :: !v,                             parsedSuffix :: ![(s, g (Result g s))]}-                  | NoParse (ParseFailure Pos s)+                  | NoParse {-# UNPACK #-} !(ParseFailure Pos s)  -- | Parser type for Parsing Expression Grammars that uses an improved packrat algorithm, with O(1) performance bounds -- but with worse constants and more memory consumption than the backtracking 'Text.Grampa.PEG.Backtrack.Parser'. The@@ -70,7 +71,7 @@                   NoParse failure -> NoParse failure  instance Alternative (Parser g s) where-   empty = Parser (\rest-> NoParse $ ParseFailure (Down $ length rest) [] [])+   empty = Parser (NoParse . emptyFailure . Down . length)    Parser p <|> Parser q = Parser r where       r rest = case p rest                of x@Parsed{} -> x@@ -90,7 +91,7 @@ #if MIN_VERSION_base(4,13,0) instance MonadFail (Parser g s) where #endif-   fail msg = Parser (\rest-> NoParse $ ParseFailure (Down $ length rest) [] [StaticDescription msg])+   fail msg = Parser (\rest-> NoParse $ erroneous (Down $ length rest) msg)  instance MonadPlus (Parser g s) where    mzero = empty@@ -106,22 +107,19 @@ instance FactorialMonoid s => Parsing (Parser g s) where    try (Parser p) = Parser q       where q rest = rewindFailure (p rest)-               where rewindFailure NoParse{} = NoParse (ParseFailure (Down $ length rest) [] [])+               where rewindFailure NoParse{} = NoParse (emptyFailure $ fromEnd $ length rest)                      rewindFailure parsed = parsed    Parser p <?> msg  = Parser q       where q rest = replaceFailure (p rest)-               where replaceFailure (NoParse (ParseFailure pos msgs erroneous)) =-                        NoParse (ParseFailure pos-                                              (if pos == Down (length rest) then [StaticDescription msg] else msgs)-                                              erroneous)+               where replaceFailure (NoParse f) = NoParse (replaceExpected (fromEnd $ Factorial.length rest) msg f)                      replaceFailure parsed = parsed    eof = Parser p       where p rest@((s, _) : _)-               | not (Null.null s) = NoParse (ParseFailure (Down $ length rest) [StaticDescription "end of input"] [])+               | not (Null.null s) = NoParse (expected (Down $ length rest) "end of input")             p rest = Parsed () rest-   unexpected msg = Parser (\t-> NoParse $ ParseFailure (Down $ length t) [] [StaticDescription msg])+   unexpected msg = Parser (\t-> NoParse $ erroneous (Down $ length t) msg)    notFollowedBy (Parser p) = Parser (\input-> rewind input (p input))-      where rewind t Parsed{} = NoParse (ParseFailure (Down $ length t) [StaticDescription "notFollowedBy"] [])+      where rewind t Parsed{} = NoParse (expected (Down $ length t) "notFollowedBy")             rewind t NoParse{} = Parsed () t  instance FactorialMonoid s => CommittedParsing (Parser g s) where@@ -166,6 +164,16 @@    nonTerminal f = Parser p where       p ((_, d) : _) = f d       p _ = NoParse (expected 0 "NonTerminal at endOfInput")+   chainRecursive = chainLongestRecursive+   chainLongestRecursive assign (Parser base) (Parser recurse) = Parser q+      where q [] = base []+            q ((s, d):t) = case base initialInput+                           of r@NoParse{} -> r+                              r -> iter r+               where iter r = case recurse ((s, assign r d) : t)+                              of NoParse{} -> r+                                 r'@Parsed{} -> iter r'+                     initialInput = (s, assign (NoParse noFailure) d) : t  instance (Eq s, LeftReductive s, FactorialMonoid s) => TailsParsing (Parser g s) where    parseTails = applyParser@@ -212,16 +220,20 @@    string s = Parser p where       p rest@((s', _) : _)          | s `isPrefixOf` s' = Parsed s (Factorial.drop (Factorial.length s) rest)-      p rest = NoParse (ParseFailure (Down $ length rest) [LiteralDescription s] [])+      p rest = NoParse (expectedInput (fromEnd $ length rest) s) -instance (InputParsing (Parser g s), Monoid s)  => TraceableParsing (Parser g s) where+instance (InputParsing (Parser g s), FactorialMonoid s)  => TraceableParsing (Parser g s) where    traceInput description (Parser p) = Parser q-      where q rest = case traceWith "Parsing " (p rest)-                  of r@Parsed{} -> traceWith "Parsed " r+      where q rest+              | let input = case rest+                            of ((s, _):_) -> s+                               [] -> mempty+                    traceWith prefix = trace (prefix <> description input)+              = case traceWith "Parsing " (p rest)+                  of r@Parsed{}+                        | let prefix = Factorial.take (Factorial.length input - Factorial.length (parsedSuffix r)) input+                        -> trace ("Parsed " <> description prefix) r                      r@NoParse{} -> traceWith "Failed " r-               where traceWith prefix = trace (prefix <> description (case rest-                                                                      of ((s, _):_) -> s-                                                                         [] -> mempty))  instance (Show s, TextualMonoid s) => InputCharParsing (Parser g s) where    satisfyCharInput predicate = Parser p

@@ -17,7 +17,8 @@ import Data.Char (isDigit) import Data.Functor.Classes (Show1, showsPrec1) import Text.Grampa-import Text.Grampa.ContextFree.LeftRecursive (Parser)+import Text.Grampa.ContextFree.Memoizing.LeftRecursive (Parser)+import qualified Rank2 import qualified Rank2.TH ~~~ @@ -26,7 +27,7 @@ like this:  ~~~ {.haskell}-arithmetic :: GrammarBuilder Arithmetic g Parser String+arithmetic :: Rank2.Apply g => GrammarBuilder Arithmetic g Parser String arithmetic Arithmetic{..} = Arithmetic{    sum= product          <|> string "-" *> (negate <$> product)@@ -89,9 +90,9 @@ -- >>> parseComplete grammar "1+2*3" -- Arithmetic{ --   sum=Compose (Right [7]),---   product=Compose (Left (ParseFailure {failurePosition = Down 4, expectedAlternatives = [StaticDescription "end of input"], errorAlternatives = []})),---   factor=Compose (Left (ParseFailure {failurePosition = Down 4, expectedAlternatives = [StaticDescription "end of input"], errorAlternatives = []})),---   number=Compose (Left (ParseFailure {failurePosition = Down 4, expectedAlternatives = [StaticDescription "end of input"], errorAlternatives = []}))}+--   product=Compose (Left (ParseFailure {failurePosition = Down 4, expectedAlternatives = FailureDescription {staticDescriptions = ["end of input"], literalDescriptions = []}, errorAlternatives = []})),+--   factor=Compose (Left (ParseFailure {failurePosition = Down 4, expectedAlternatives = FailureDescription {staticDescriptions = ["end of input"], literalDescriptions = []}, errorAlternatives = []})),+--   number=Compose (Left (ParseFailure {failurePosition = Down 4, expectedAlternatives = FailureDescription {staticDescriptions = ["end of input"], literalDescriptions = []}, errorAlternatives = []}))} -- >>> parsePrefix grammar "1+2*3 apples" -- Arithmetic{ --   sum=Compose (Compose (Right [("+2*3 apples",1),("*3 apples",3),(" apples",7)])),

@@ -36,7 +36,7 @@ import Text.Grampa hiding (symbol) import qualified Text.Grampa.ContextFree.Parallel as Parallel import qualified Text.Grampa.ContextFree.SortedMemoizing as Memoizing-import qualified Text.Grampa.ContextFree.LeftRecursive as LeftRecursive+import qualified Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive as LeftRecursive  import qualified Test.Ambiguous import qualified Test.Examples@@ -49,11 +49,11 @@                              next :: f String} deriving instance (Show (f String), Show (f [String])) => Show (Recursive f) +$(Rank2.TH.deriveAll ''Recursive)+ instance TokenParsing (LeftRecursive.Parser Recursive String) instance LexicalParsing (LeftRecursive.Parser Recursive String) -$(Rank2.TH.deriveAll ''Recursive)- recursiveManyGrammar Recursive{..} = Recursive{    start= optional (string "[") *> (concat <$> rec) <* optional next,    rec= (:) <$> one <*> rec <|> pure [],@@ -142,9 +142,9 @@                testProperty "name list" $                  start (parseComplete nameListGrammar "foo, bar") == Compose (Right ["foo bar"]),                testProperty "filtered" $-                 start (parseComplete gf "") === Compose (Left (ParseFailure 0 [LiteralDescription "1"] [])),+                 start (parseComplete gf "") === Compose (Left (ParseFailure 0 (FailureDescription [] ["1"]) [])),                testProperty "monadic" $-                 start (parseComplete gm "") === Compose (Left (ParseFailure 0 [] [StaticDescription "empty"])),+                 start (parseComplete gm "") === Compose (Left (ParseFailure 0 mempty ["empty"])),                testProperty "null monadic" $                  start (parseComplete gn "23") === Compose (Right ["23"])               ],@@ -195,7 +195,7 @@                    simpleParse (string xs) (xs <> ys) == Right [(ys, xs)],               testProperty "string" $ \(xs::[Word8]) ys-> not (xs `isPrefixOf` ys)                 ==> simpleParse (string xs) ys-                    === Left (ParseFailure (fromIntegral $ length ys) [LiteralDescription xs] []),+                    === Left (ParseFailure (fromIntegral $ length ys) (FailureDescription [] [xs]) []),               testProperty "eof mempty" $ simpleParse eof "" === Right [("", ())],               testProperty "eof failure" $ \s->                    s /= "" ==> simpleParse eof s === Left (expected (fromIntegral $ length s) "end of input")],@@ -374,7 +374,7 @@ binary nm op = liftA2 (\(DescribedParser d1 p1) (DescribedParser d2 p2)-> DescribedParser (d1 <> nm <> d2) (op p1 p2))  expected :: Pos -> String -> ParseFailure Pos s-expected pos msg = ParseFailure pos [StaticDescription msg] []+expected pos msg = ParseFailure pos (FailureDescription [msg] []) []  --instance {-# OVERLAPS #-} (Ord s, Arbitrary s) => Arbitrary (s -> Bool) where --   arbitrary = elements [(<=), const False]

@@ -8,7 +8,7 @@ import qualified Rank2.TH import Text.Grampa import Text.Grampa.Combinators-import Text.Grampa.ContextFree.LeftRecursive (Parser)+import Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive (Parser)  import Debug.Trace @@ -22,6 +22,8 @@    amb :: p (Ambiguous Amb)    } +$(Rank2.TH.deriveAll ''Test)+ grammar :: Test (Parser Test String) -> Test (Parser Test String) grammar Test{..} = Test{    amb = ambiguous (Xy1 <$> string "x" <*> moptional (string "y")@@ -29,5 +31,3 @@                     <|> Xyz <$> amb <*> string "z"                     <|> Xyzw <$> amb <*> string "w")    }--$(Rank2.TH.deriveAll ''Test)

@@ -13,7 +13,7 @@  import qualified Rank2 import Text.Grampa-import Text.Grampa.ContextFree.LeftRecursive (Parser)+import Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive (Parser) import qualified Arithmetic import qualified Comparisons import qualified Boolean