packages feed

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