diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/bench/Bench/Inputs.hs b/bench/Bench/Inputs.hs --- a/bench/Bench/Inputs.hs +++ b/bench/Bench/Inputs.hs @@ -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. diff --git a/bench/Bench/Mega.hs b/bench/Bench/Mega.hs --- a/bench/Bench/Mega.hs +++ b/bench/Bench/Mega.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -O2 #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} diff --git a/bench/Bench/Peg.hs b/bench/Bench/Peg.hs --- a/bench/Bench/Peg.hs +++ b/bench/Bench/Peg.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -O2 #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeApplications #-} diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -O2 #-} {-# LANGUAGE OverloadedStrings #-} -- | criterion driver comparing typed-peg against megaparsec. diff --git a/examples/Patterns.hs b/examples/Patterns.hs --- a/examples/Patterns.hs +++ b/examples/Patterns.hs @@ -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]+ |]))) diff --git a/peg-patterns.md b/peg-patterns.md --- a/peg-patterns.md +++ b/peg-patterns.md @@ -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. --- diff --git a/src/PEG.hs b/src/PEG.hs --- a/src/PEG.hs +++ b/src/PEG.hs @@ -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 diff --git a/src/PEG/Analysis.hs b/src/PEG/Analysis.hs --- a/src/PEG/Analysis.hs +++ b/src/PEG/Analysis.hs @@ -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 "" diff --git a/src/PEG/Location.hs b/src/PEG/Location.hs new file mode 100644 --- /dev/null +++ b/src/PEG/Location.hs @@ -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) diff --git a/src/PEG/Parse.hs b/src/PEG/Parse.hs --- a/src/PEG/Parse.hs +++ b/src/PEG/Parse.hs @@ -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 diff --git a/src/PEG/QQ.hs b/src/PEG/QQ.hs --- a/src/PEG/QQ.hs +++ b/src/PEG/QQ.hs @@ -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) diff --git a/src/PEG/QQ/Syntax.hs b/src/PEG/QQ/Syntax.hs --- a/src/PEG/QQ/Syntax.hs +++ b/src/PEG/QQ/Syntax.hs @@ -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) diff --git a/src/PEG/Syntax.hs b/src/PEG/Syntax.hs --- a/src/PEG/Syntax.hs +++ b/src/PEG/Syntax.hs @@ -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 diff --git a/tests/Analysis.hs b/tests/Analysis.hs --- a/tests/Analysis.hs +++ b/tests/Analysis.hs @@ -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 diff --git a/typed-peg.cabal b/typed-peg.cabal --- a/typed-peg.cabal +++ b/typed-peg.cabal @@ -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