typed-peg 0.4.0.0 → 0.5.0.0
raw patch · 17 files changed
+384/−31 lines, 17 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- PEG.Analysis: instance GHC.Internal.Show.Show PEG.Analysis.Diagnostic
- PEG.Analysis: instance GHC.Internal.Show.Show PEG.Analysis.Ty
- PEG.Analysis: instance GHC.Internal.Show.Show PEG.Analysis.World
- PEG.CharSet: instance GHC.Internal.Show.Show PEG.CharSet.CharSet
- PEG.Indent: instance GHC.Internal.Show.Show (PEG.Indent.Rel n)
- PEG.Indent: instance GHC.Internal.Show.Show PEG.Indent.Bound
- PEG.Indent: instance GHC.Internal.Show.Show PEG.Indent.Interval
- PEG.Member: instance PEG.Member.KnownMemberStep (GHC.Internal.TypeLits.Internal.CmpSymbol s t) s ('(t, e) : rest) a => PEG.Member.KnownMember s ('(t, e) : rest) a
- PEG.Parse: instance (GHC.Internal.Show.Show a, GHC.Internal.Show.Show s) => GHC.Internal.Show.Show (PEG.Parse.Result s a)
- PEG.QQ.HsExp: instance GHC.Internal.Show.Show PEG.QQ.HsExp.Tok
- PEG.QQ.Syntax: instance GHC.Internal.Show.Show PEG.QQ.Syntax.Def
- PEG.QQ.Syntax: instance GHC.Internal.Show.Show PEG.QQ.Syntax.Directive
- PEG.QQ.Syntax: instance GHC.Internal.Show.Show PEG.QQ.Syntax.Item
- PEG.QQ.Syntax: instance GHC.Internal.Show.Show PEG.QQ.Syntax.PExpr
- PEG.QQ.Syntax: instance GHC.Internal.Show.Show PEG.QQ.Syntax.RelS
- PEG.Semantics.Simple: instance GHC.Internal.Base.Alternative (PEG.Semantics.Simple.PExp d)
- PEG.Semantics.Simple: instance GHC.Internal.Base.Applicative (PEG.Semantics.Simple.PExp d)
- PEG.Semantics.Simple: instance GHC.Internal.Base.Functor (PEG.Semantics.Simple.PExp d)
- PEG.Semantics.Simple: instance GHC.Internal.Base.Functor (PEG.Semantics.Simple.Result d)
- PEG.Semantics.Simple: instance GHC.Internal.Base.Monad (PEG.Semantics.Simple.PExp d)
- PEG.Semantics.Simple: instance GHC.Internal.Base.MonadPlus (PEG.Semantics.Simple.PExp d)
- PEG.Syntax: instance GHC.Internal.Base.Functor (PEG.Syntax.PExp s nt)
+ PEG.Analysis: instance GHC.Show.Show PEG.Analysis.Diagnostic
+ PEG.Analysis: instance GHC.Show.Show PEG.Analysis.Ty
+ PEG.Analysis: instance GHC.Show.Show PEG.Analysis.World
+ PEG.CharSet: instance GHC.Show.Show PEG.CharSet.CharSet
+ PEG.Indent: instance GHC.Show.Show (PEG.Indent.Rel n)
+ PEG.Indent: instance GHC.Show.Show PEG.Indent.Bound
+ PEG.Indent: instance GHC.Show.Show PEG.Indent.Interval
+ PEG.Location: data LineIndex
+ PEG.Location: lineCol :: LineIndex -> Int -> (Int, Int)
+ PEG.Location: lineIndex :: Stream s => s -> LineIndex
+ PEG.Location: offsetToLineCol :: Stream s => s -> Int -> (Int, Int)
+ PEG.Member: instance PEG.Member.KnownMemberStep (GHC.TypeLits.Internal.CmpSymbol s t) s ('(t, e) : rest) a => PEG.Member.KnownMember s ('(t, e) : rest) a
+ PEG.Parse: instance (GHC.Show.Show a, GHC.Show.Show s) => GHC.Show.Show (PEG.Parse.Result s a)
+ PEG.QQ.HsExp: instance GHC.Show.Show PEG.QQ.HsExp.Tok
+ PEG.QQ.Syntax: EOffset :: PExpr
+ PEG.QQ.Syntax: instance GHC.Show.Show PEG.QQ.Syntax.Def
+ PEG.QQ.Syntax: instance GHC.Show.Show PEG.QQ.Syntax.Directive
+ PEG.QQ.Syntax: instance GHC.Show.Show PEG.QQ.Syntax.Item
+ PEG.QQ.Syntax: instance GHC.Show.Show PEG.QQ.Syntax.PExpr
+ PEG.QQ.Syntax: instance GHC.Show.Show PEG.QQ.Syntax.RelS
+ PEG.Semantics.Simple: instance GHC.Base.Alternative (PEG.Semantics.Simple.PExp d)
+ PEG.Semantics.Simple: instance GHC.Base.Applicative (PEG.Semantics.Simple.PExp d)
+ PEG.Semantics.Simple: instance GHC.Base.Functor (PEG.Semantics.Simple.PExp d)
+ PEG.Semantics.Simple: instance GHC.Base.Functor (PEG.Semantics.Simple.Result d)
+ PEG.Semantics.Simple: instance GHC.Base.Monad (PEG.Semantics.Simple.PExp d)
+ PEG.Semantics.Simple: instance GHC.Base.MonadPlus (PEG.Semantics.Simple.PExp d)
+ PEG.Syntax: [GetOffset] :: forall s (nt :: Type -> Type). PExp s nt Int
+ PEG.Syntax: getOffset :: forall s (nt :: Type -> Type). PExp s nt Int
+ PEG.Syntax: instance GHC.Base.Functor (PEG.Syntax.PExp s nt)
Files
- CHANGELOG.md +18/−0
- README.md +24/−0
- bench/Bench/Inputs.hs +1/−0
- bench/Bench/Mega.hs +1/−0
- bench/Bench/Peg.hs +1/−0
- bench/Main.hs +1/−0
- examples/Patterns.hs +75/−1
- peg-patterns.md +148/−26
- src/PEG.hs +2/−0
- src/PEG/Analysis.hs +1/−0
- src/PEG/Location.hs +63/−0
- src/PEG/Parse.hs +3/−0
- src/PEG/QQ.hs +8/−0
- src/PEG/QQ/Syntax.hs +4/−1
- src/PEG/Syntax.hs +12/−0
- tests/Analysis.hs +17/−1
- typed-peg.cabal +5/−2
CHANGELOG.md view
@@ -2,6 +2,24 @@ ## Unreleased +### Source positions in semantic actions: `@` and `PEG.Location`++A new `PExp` constructor, `GetOffset :: PExp s nt Int` (`getOffset`), consumes+nothing and returns the number of characters consumed so far. The+quasi-quoter writes it `@`; labelled, it hands an action the position of+whatever follows:++```+stmt :: Stmt <- p:@ "print" ws e:expr ';' { Print (at idx p) e }+```++The parser still tracks only the offset, so a grammar that does not use `@`+runs exactly as before. The new module `PEG.Location` (re-exported by `PEG`)+turns offsets into lines and columns against the original input: `lineIndex`+indexes an input once, `lineCol` looks an offset up in O(log lines), and+`offsetToLineCol` does both for a single lookup. Pass the index to the+grammar with `%param`. `peg-patterns.md` §3.2 has a worked example.+ ### Breaking. A non-terminal is a key, and `pegGrammar` declares the key type `PExp` and `Grammar` are indexed by the type of the grammar's non-terminal
README.md view
@@ -15,8 +15,32 @@ non-terminal and a duplicate rule reported at the splice, naming the rule - Indentation-sensitive parsing (`PEG.Indent`) - Quasi-quoter for concrete grammar syntax (`PEG.QQ`)+- Source positions in semantic actions (`@`, `PEG.Location`) - Parses any `PEG.Stream`: `String`, strict/lazy `Text`, strict/lazy `ByteString`++## Source positions++`@` consumes nothing and returns the current offset, the number of characters+consumed so far. Label it to give an action the position of what follows,+and turn offsets into lines and columns with `PEG.Location`:++```haskell+[pegGrammar|+ %name lang+ %stream String+ %param idx :: LineIndex+ %start stmt++ stmt :: Stmt <- p:@ v:name ":=" ws e:expr { Assign (lineCol idx p) v e }+ ...+|]++parse (lang (lineIndex src)) src+```++Lines and columns count from 1. The parser tracks only the offset, so a+grammar that does not use `@` pays nothing for it. ## Input streams
bench/Bench/Inputs.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -O2 #-} -- | Deterministic input generators shared by the typed-peg and megaparsec -- benchmark groups. Everything is pure and reproducible (a small LCG), so -- both libraries are always measured on byte-identical inputs.
bench/Bench/Mega.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -O2 #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}
bench/Bench/Peg.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -O2 #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeApplications #-}
bench/Main.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -O2 #-} {-# LANGUAGE OverloadedStrings #-} -- | criterion driver comparing typed-peg against megaparsec.
examples/Patterns.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-}@@ -17,11 +18,14 @@ , addOp , kwG , prog+ , Loc (..), Stmt (..), LExpr (..)+ , located+ , undefinedVars , patternsMain ) where import PEG-import PEG.QQ (pegExpr, pegRules)+import PEG.QQ (pegExpr, pegGrammar, pegRules) -------------------------------------------------------------------------------- -- Pattern 2a/2bi: whitespace and token combinators, at the PExp level@@ -176,6 +180,69 @@ addOp = Grammar [pegRules| op <- '+' { Add } / '-' { Sub } |] (nt @"op") --------------------------------------------------------------------------------+-- Pattern 3b, continued: source positions+--+-- @\@@ consumes nothing and returns the offset of the current position. A+-- label on it hands that offset to the action, and the 'LineIndex' passed in+-- as a parameter turns it into a line and a column.+--------------------------------------------------------------------------------++-- | A line and a column, both from 1.+data Loc = Loc Int Int+ deriving Eq++instance Show Loc where+ show (Loc l c) = show l ++ ":" ++ show c++data Stmt+ = Assign Loc Loc String LExpr -- ^ where the statement starts and ends+ | Print Loc LExpr+ deriving (Eq, Show)++data LExpr+ = LNum Loc Int+ | LVar Loc String+ | LAdd LExpr LExpr+ deriving (Eq, Show)++-- | The lifted constructor of §3.1, for positions: an offset becomes a 'Loc'+-- here, not in the action.+at :: LineIndex -> Int -> Loc+at idx = uncurry Loc . lineCol idx++-- | Each @p:\@@ sits /before/ the token it locates and after the whitespace+-- the previous token consumed (§2.1), so it is the token's first character.+-- An @\@@ after the last token of a statement gives where it ends.+[pegGrammar|+ %name located+ %stream String+ %param idx :: LineIndex+ %start prog++ prog :: [Stmt] <- ws ss:stmt* !. { ss }+ stmt :: Stmt <- p:@ "print" ![a-z] ws e:expr ';' ws { Print (at idx p) e }+ / p:@ v:name ":=" ws e:expr ';' r:@ ws+ { Assign (at idx p) (at idx r) v e }+ expr :: LExpr <- t:atom ts:('+' ws u:atom)* { foldl LAdd t ts }+ atom :: LExpr <- p:@ ds:[0-9]+ ws { LNum (at idx p) (read ds) }+ / p:@ v:name { LVar (at idx p) v }+ name :: String <- cs:[a-z]+ ws { cs }+ ws :: () <- [ \t\n]* { () }+|]++-- | Every use of a variable before it is assigned, reported where it occurs.+undefinedVars :: [Stmt] -> [String]+undefinedVars = go []+ where+ go _ [] = []+ go env (Assign _ _ v e : ss) = uses env e ++ go (v : env) ss+ go env (Print _ e : ss) = uses env e ++ go env ss++ uses env (LVar l v) | v `notElem` env = [show l ++ ": " ++ v ++ " is not defined"]+ uses env (LAdd a b) = uses env a ++ uses env b+ uses _ _ = []++-------------------------------------------------------------------------------- -- Statements, to show ordered choice and the lexeme discipline -------------------------------------------------------------------------------- @@ -249,6 +316,13 @@ OK f _ _ -> show (f (Num 1) (Num 2)) Fail -> "Fail")) [ "+", "-", "*" ]++ putStrLn "### source positions"+ let src = "x := 1;\nprint x + y;\n y := x+\n 2;\nprint z;\n"+ case parse (located (lineIndex src)) src of+ OK ss _ _ -> do mapM_ print ss+ mapM_ putStrLn (undefinedVars ss)+ Fail -> putStrLn "Fail" putStrLn "### lexeme discipline: fully (lexeme p)" let toks = parse (Grammar RNil (fully (lexeme [pegExpr| ds:[0-9]+ |])))
peg-patterns.md view
@@ -35,7 +35,7 @@ | 2bii Keyword Combinators | [§2.3](#23-keywords-are-negative-lookahead) — **simpler**: `!` instead of `try` | | 2c Overloaded Strings | [§2.4](#24-the-quasi-quoter-is-the-facade) — subsumed by the quasi-quoter | | 3a Lifted Constructors | [§3.1](#31-lifted-constructors) — same |-| 3b Deferred Constructors | [§3.2](#32-deferred-constructors-and-the-position-gap) — **partly**; no source positions |+| 3b Deferred Constructors | [§3.2](#32-deferred-constructors-and-source-positions) — **simpler**: `p:@` instead of deferring | | 4a Verified Errors | [§4](#4-errors-the-shape-without-the-message) — shape only; no messages | | 4b Preventative Errors | [§4](#4-errors-the-shape-without-the-message) — shape only; no messages | @@ -358,24 +358,143 @@ syntax and hard to debug when it fails to typecheck, because the error points at the quasi-quote. -### 3.2 Deferred constructors, and the position gap+### 3.2 Deferred constructors, and source positions *(Willis & Wu, Pattern 3b: Deferred Constructors.)* Their motivating example is source positions: a node needs the position from-*before* its first token, so the constructor is returned by a parser and-applied later.+*before* its first token, so the constructor is returned by a parser that+reads the position, and applied later to the operands. -**typed-peg cannot do this**, because no combinator exposes the current-position to a semantic action. `PState` tracks `stCol` and `stOff`, and-`PEG.Indent` uses columns for layout, but neither is reachable from `{ ... }`.-A grammar cannot annotate its AST with source locations.+typed-peg does not need the deferral. The quasi-quoter has an atom `@` that+consumes nothing and returns the **offset** of the current position — the+number of characters consumed so far, an `Int`. Labelled like any other item,+it reaches the semantic action together with everything else in the sequence: -What does transfer is the general form — returning a function to be applied-later, so that bookkeeping is decoupled from the parser. In typed-peg this is-just a rule whose result type is a function:+```+stmt <- p:@ v:name ":=" ws e:expr { Assign (at idx p) v e }+``` +The action sees `p`, `v` and `e` at once, so there is nothing to defer. In+`PExp` terms `@` is the constructor `GetOffset :: PExp s nt Int`, also+available as `getOffset` for grammars written with combinators.++**Offsets, not lines.** The parser tracks only the offset, so a grammar that+never writes `@` runs exactly as fast as before. Lines and columns are+computed afterwards, against the original input, by `PEG.Location`:+ ```haskell+lineIndex :: Stream s => s -> LineIndex -- one pass over the input+lineCol :: LineIndex -> Int -> (Int, Int) -- O(log lines); both from 1+```++The index is built once per input and handed to the grammar as a `%param`.+Together with a lifted constructor (§3.1) that does the conversion, the+actions stay one application wide:++```haskell+data Loc = Loc Int Int -- line, column++at :: LineIndex -> Int -> Loc+at idx = uncurry Loc . lineCol idx+```++```haskell+[pegGrammar|+ %name located+ %stream String+ %param idx :: LineIndex+ %start prog++ prog :: [Stmt] <- ws ss:stmt* !. { ss }+ stmt :: Stmt <- p:@ "print" ![a-z] ws e:expr ';' ws { Print (at idx p) e }+ / p:@ v:name ":=" ws e:expr ';' r:@ ws+ { Assign (at idx p) (at idx r) v e }+ expr :: LExpr <- t:atom ts:('+' ws u:atom)* { foldl LAdd t ts }+ atom :: LExpr <- p:@ ds:[0-9]+ ws { LNum (at idx p) (read ds) }+ / p:@ v:name { LVar (at idx p) v }+ name :: String <- cs:[a-z]+ ws { cs }+ ws :: () <- [ \t\n]* { () }+|]+```++The grammar becomes a function of the index, so it is run as++```haskell+parse (located (lineIndex src)) src+```++Three things are worth noticing.++- **Where `@` goes follows from the lexeme discipline.** Every token consumes+ the whitespace *after* it (§2.1), so an `@` written just before a token sits+ on that token's first character. An `@` placed after a `ws` would point past+ the whitespace; one placed before it, at the end of the previous token. In+ `Assign`, `r:@` comes after the `';'` and before the trailing `ws`, so it+ marks where the statement ends.+- **A span is two offsets.** `p:@ ... r:@` brackets a construct; the second+ offset is one past its last character, the usual half-open convention.+- **`@` is invisible to the analysis.** It is nullable with an empty FIRST+ set, like `pureP`. `p:@ x:a 'x'` inside `a` is still left recursion and is+ still reported, and `ps:@*` is reported as a repetition that consumes+ nothing. Both alternatives of `stmt` start with `p:@`, and prefix factoring+ shares it: the offset is read once.++On the input++```+x := 1;+print x + y;+ y := x++ 2;+print z;+```++the grammar produces++```+Assign 1:1 1:8 "x" (LNum 1:6 1)+Print 2:1 (LAdd (LVar 2:7 "x") (LVar 2:11 "y"))+Assign 3:3 4:7 "y" (LAdd (LVar 3:8 "x") (LNum 4:5 2))+Print 5:1 (LVar 5:7 "z")+```++and a scope check over that AST can say where each problem is:++```haskell+undefinedVars :: [Stmt] -> [String]+undefinedVars = go []+ where+ go _ [] = []+ go env (Assign _ _ v e : ss) = uses env e ++ go (v : env) ss+ go env (Print _ e : ss) = uses env e ++ go env ss++ uses env (LVar l v) | v `notElem` env = [show l ++ ": " ++ v ++ " is not defined"]+ uses env (LAdd a b) = uses env a ++ uses env b+ uses _ _ = []+```++```+2:11: y is not defined+5:7: z is not defined+```++Columns count characters, a tab included, as one each — the convention of an+editor's "go to column". This is not the tab-stop column `PEG.Indent` uses+for layout. On a `ByteString` an offset counts bytes (see `PEG.Stream`).++**Exercise.** Give `LAdd` the span of both operands, from the first+character of the left one to just past the last character of the right one.+The start is easy: it is where `t` starts. The end is not, because `atom`+consumes its trailing whitespace, so an `r:@` written after `u:atom` points+past it. Move that `ws` out of `atom` and into `expr`, where an `@` can be+placed between the operand and its whitespace.++What also transfers is the general form of the pattern — returning a function+to be applied later, so that bookkeeping is decoupled from the parser. In+typed-peg this is just a rule whose result type is a function:++```haskell type OpEnv = '[ '("op", 'EnvEntry (Expr -> Expr -> Expr)) ] addOp :: Stream s => Grammar s (InEnv OpEnv) (Expr -> Expr -> Expr)@@ -388,11 +507,9 @@ "*" => Fail ``` -The rule's result type is a function, and the chain rule applies it. This is the same defunctionalisation the paper describes, and it-removes the partial `error` case from §1.2's `chainl`.--See §6: exposing position is the single change that would unlock the most of-this paper.+The rule's result type is a function, and the chain rule applies it. This is+the same defunctionalisation the paper describes, and it removes the partial+`error` case from §1.2's `chainl`. --- @@ -413,6 +530,10 @@ There is no position, no expected set, no label. Both patterns are therefore unavailable in their stated form. +This is about errors found *while parsing*. Errors found afterwards — an+undefined variable, a type mismatch — can be reported where they occur,+because the AST can record positions with `@` (§3.2).+ The *rejection* half still works, and is worth using. Preventative errors become preventative failures: @@ -556,24 +677,25 @@ Collected from above, in the order that would most help a user of this library: -1. **Source positions in semantic actions.** Blocks Pattern 3b's motivating- use and any AST that records where its nodes came from. `PState` already- carries `stOff` and `stCol`; what is missing is a `PExp` constructor that- hands them to an action.-2. **Error messages.** `Result` is `OK` or `Fail`. Patterns 4a and 4b are+1. **Error messages.** `Result` is `OK` or `Fail`. Patterns 4a and 4b are about phrasing good errors, and neither can be expressed. This is the- largest single gap between typed-peg and the paper.-3. **A `precedence` combinator.** Needs a `Ty`-indexed `Prec` GADT and+ largest single gap between typed-peg and the paper. The offset that `@`+ exposes (§3.2) is the first ingredient: a failure could report the+ furthest offset reached.+2. **A `precedence` combinator.** Needs a `Ty`-indexed `Prec` GADT and `infixl1`/`infixr1`/`prefix`/`postfix` at the `PExp` level (§1.4). Real work, but the index arithmetic is tractable.-4. **Chain combinators.** `chainl1`/`chainr1` are a small, unblocked+3. **Chain combinators.** `chainl1`/`chainr1` are a small, unblocked convenience: they would remove the hand-written `foldl` from every expression grammar.-5. **A token/lexeme vocabulary in the quasi-quoter.** `lexeme`, `keyword` and+4. **A token/lexeme vocabulary in the quasi-quoter.** `lexeme`, `keyword` and `fully` are ten lines each (§2.1, §2.3) but every user writes them again. -None of 1, 2, 4 or 5 is blocked by the type-level design; they are absent+None of 1, 3 or 4 is blocked by the type-level design; they are absent rather than impossible.++Source positions in semantic actions, once first on this list, are now+available: see §3.2. ---
src/PEG.hs view
@@ -38,6 +38,7 @@ , module PEG.Syntax , module PEG.Grammar , module PEG.Parse+ , module PEG.Location ) where import PEG.CharSet@@ -45,6 +46,7 @@ import PEG.Stream import PEG.Indent import PEG.Key+import PEG.Location import PEG.Member import PEG.Parse import PEG.Syntax
src/PEG/Analysis.hs view
@@ -158,6 +158,7 @@ where go (EChar _) = termTy go EDot = termTy+ go EOffset = nullTy -- GetOffset consumes nothing go (EClass _ _) = termTy go (EString s) | null s = nullTy -- pureP ""
+ src/PEG/Location.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE BangPatterns #-}++-- | Lines and columns, computed from offsets.+--+-- The parser tracks only an offset — the number of characters consumed — and+-- 'PEG.Syntax.GetOffset' (@\@@ in the quasi-quoter) hands it to a semantic+-- action. Lines are not tracked while parsing, so a grammar that never asks+-- for a position pays nothing for them. Turning an offset into a line and a+-- column is done here, against the original input:+--+-- @+-- let idx = 'lineIndex' input -- once per input+-- 'lineCol' idx off -- O(log lines) per lookup+-- @+--+-- Lines and columns are both counted from 1. Every character, a tab+-- included, advances the column by one; this is the convention of most+-- editors' \"go to column\", not the tab-stop column "PEG.Indent" uses for+-- layout. On a 'Data.ByteString.ByteString' an offset counts bytes, as+-- everything else does; see "PEG.Stream".+module PEG.Location+ ( LineIndex+ , lineIndex+ , lineCol+ , offsetToLineCol+ ) where++import qualified Data.IntMap.Strict as IM++import PEG.Stream (Stream (..))++-- | Where each line of an input starts: the offset of its first character,+-- mapped to its line number.+newtype LineIndex = LineIndex (IM.IntMap Int)++-- | Index the lines of an input. One pass over it.+lineIndex :: Stream s => s -> LineIndex+lineIndex s = LineIndex (IM.fromList ((0, 1) : starts))+ where+ -- The fold keeps the offset and line of the next character; a newline+ -- starts a line at the offset after it.+ (_, _, starts) = foldlS' step (0 :: Int, 1 :: Int, []) s+ step (!off, !ln, acc) c+ | c == '\n' = (off + 1, ln + 1, (off + 1, ln + 1) : acc)+ | otherwise = (off + 1, ln, acc)++ -- 'IM.fromList' rather than 'IM.fromDistinctAscList': the fold collects+ -- the starts last first.++-- | The line and column, both from 1, of the character at an offset.+--+-- An offset past the end of the input is placed on the last line, as if that+-- line went on.+lineCol :: LineIndex -> Int -> (Int, Int)+lineCol (LineIndex m) off = case IM.lookupLE off m of+ Just (start, ln) -> (ln, off - start + 1)+ Nothing -> (1, off + 1) -- a negative offset; not produced by 'parse'++-- | @'lineCol' . 'lineIndex'@, for a single lookup. Indexing costs a pass+-- over the input, so build a 'LineIndex' once when there are many offsets to+-- convert.+offsetToLineCol :: Stream s => s -> Int -> (Int, Int)+offsetToLineCol s = lineCol (lineIndex s)
src/PEG/Parse.hs view
@@ -287,6 +287,9 @@ comp (Str lit) = litStep lit + -- Consumes nothing: the offset is already in the state.+ comp GetOffset = \_ st -> (# | (# stOff st, st #) #)+ -- A run of a character class, returned as a chunk of the stream. On -- 'Data.Text.Text' this is a slice: no copy, no cons cells. comp (Span cs) = spanChunk (\c -> memberCS c cs) (simpleCS cs) False
src/PEG/QQ.hs view
@@ -16,6 +16,11 @@ -- Ordered choice is written with @\/@; Kleene star with @*@; plus with @+@; -- optional with @?@; negation with @!@. --+-- @\@@ consumes nothing and returns the current offset, an 'Int': label it to+-- give a semantic action the position of what follows, as in+-- @p:\@ k:"while" c:expr { While p c }@. "PEG.Location" turns an offset+-- into a line and a column.+-- -- Character classes use @[...]@ syntax and may contain ranges: @[a-zA-Z0-9_]@. -- A leading @^@ negates the class, so @[^\"]@ matches any character other than -- a double quote; write @[\\^]@ for a class containing a caret. Prefer a@@ -63,6 +68,8 @@ [| Term c |] go EDot = [| AnyChar |]+ go EOffset =+ [| GetOffset |] go (ENT name) = ntRef name go (EString str) | null str = [| pureP "" |]@@ -717,6 +724,7 @@ go (ENT n) = lookup n anns go (EChar _) = Just (TH.ConT ''Char) go EDot = Just (TH.ConT ''Char)+ go EOffset = Just (TH.ConT ''Int) go (EClass _ _) = Just (TH.ConT ''Char) go (EString _) = Just (TH.ConT ''String) go (EAnd _) = Just (TH.TupleT 0)
src/PEG/QQ/Syntax.hs view
@@ -48,6 +48,7 @@ | EString String | EClass Bool [(Char,Char)] -- ^ 'True' when the class is negated. | EDot+ | EOffset -- ^ @\@@: the current offset; consumes nothing. | ENT String | EIndent RelS PExpr | EPos RelS PExpr@@ -303,7 +304,9 @@ Right r -> Right r Left _ -> case tok "." s of Right (_, s1) -> Right (EDot, s1)- Left _ -> case charLit s of+ Left _ -> case tok "@" s of+ Right (_, s1) -> Right (EOffset, s1)+ Left _ -> case charLit s of Right (c, s1) -> Right (EChar c, s1) Left _ -> case strLit s of Right (cs, s1) -> Right (EString cs, s1)
src/PEG/Syntax.hs view
@@ -66,6 +66,7 @@ , indent , position , align+ , getOffset , (<$>.) , (<*>.) , (.>>.)@@ -110,6 +111,7 @@ -- * 'Indent' — require the next token to satisfy an indentation relation -- * 'Position'— set the column relation for tokens inside the sub-expression -- * 'Align' — require the next token to be aligned with the current position+-- * 'GetOffset' — consume nothing, return the offset of the current position data PExp (s :: Type) (nt :: Type -> Type) (a :: Type) where Pure :: a -> PExp s nt a Term :: Char -> PExp s nt Char@@ -157,6 +159,11 @@ -> PExp s nt a Align :: PExp s nt a -> PExp s nt a+ -- | Consume nothing and return how many characters of the input have been+ -- consumed so far: the offset of the next character. This is how a+ -- semantic action learns where a node starts or ends; "PEG.Location" turns+ -- an offset into a line and a column. Written @\@@ in the quasi-quoter.+ GetOffset :: PExp s nt Int instance Functor (PExp s nt) where fmap = Map@@ -213,6 +220,11 @@ -- | Require the sub-expression to start at the current alignment column. align :: PExp s nt a -> PExp s nt a align = Align++-- | The offset of the current position: the number of characters consumed+-- so far. Consumes nothing and never fails.+getOffset :: PExp s nt Int+getOffset = GetOffset -- | Infix synonym for 'fmapP'. (<$>.) :: (a -> b) -> PExp s nt a -> PExp s nt b
tests/Analysis.hs view
@@ -137,6 +137,7 @@ where go (EChar _) = False go EDot = False+ go EOffset = True go (EClass _ _) = False go (EString s) = null s go (ENT n) = maybe False id (lookup n m)@@ -164,6 +165,7 @@ go (EChar _) = [] go EDot = []+ go EOffset = [] go (EClass _ _) = [] go (EString _) = [] go (ENT n) = [n]@@ -188,6 +190,7 @@ where go (EChar _) = False go EDot = False+ go EOffset = True go (EClass _ _) = False go (EString s) = null s go (ENT n) = maybe False id (lookup n nulls)@@ -318,7 +321,8 @@ expr seed depth = let (k, seed') = next seed in case (if depth <= (0 :: Int) then k `mod` 3 else k `mod` 9) of- 0 -> (EChar 'x', seed')+ 0 | even (k `div` 9) -> (EChar 'x', seed')+ | otherwise -> (EOffset, seed') 1 -> (EClass False [('a', 'z')], seed') 2 -> (ENT (names !! (k `mod` n)), seed') 3 -> let (e, s') = expr seed' (depth - 1) in (EOpt e, s')@@ -356,6 +360,18 @@ case run "a <- xs:b*\nb <- c:'x'?" of Left [NullableStar "a"] -> True _ -> False)+ , ("a repetition of @ is reported: it consumes nothing",+ case run "a <- ps:@*" of+ Left [NullableStar "a"] -> True+ _ -> False)+ , ("@ does not hide left recursion behind it",+ case run "a <- p:@ x:a 'x' / 'y'" of+ Left [LeftRecursive "a" _] -> True+ _ -> False)+ , ("@ is parsed as an item that consumes nothing",+ case run "a <- p:@ 'x' q:@" of+ Right env -> lookup "a" env == Just (Ty False [])+ _ -> False) , ("an undefined non-terminal is reported", case run "a <- x:missing" of Left [UndefinedNT "missing" ["a"]] -> True
typed-peg.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: typed-peg-version: 0.4.0.0+version: 0.5.0.0 synopsis: Type-safe PEG parser combinators description: A library for building Parsing Expression Grammars parsers@@ -67,6 +67,7 @@ PEG.Grammar PEG.Indent PEG.Key+ PEG.Location PEG.Member PEG.Parse PEG.QQ@@ -117,7 +118,9 @@ Bench.Inputs Bench.Peg Bench.Mega- ghc-options: -O2 -rtsopts "-with-rtsopts=-T"+ -- -O2 is set per module, with OPTIONS_GHC: `cabal check` warns about it in+ -- ghc-options, even for a benchmark no user builds.+ ghc-options: -rtsopts "-with-rtsopts=-T" build-depends: base , typed-peg