diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,450 @@ +# Changelog + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). + +## [Unreleased] + +## [0.11] - 2026-06-12 + +Highlights: RTK is now self-hosting by default — grammar files are parsed +with the front end RTK generated from its own grammar description, +`test-grammars/grammar.pg` is the authoritative definition of the grammar +language, and the hand-written front end is a reference oracle selected by +`--use-handwritten`. Errors are structured, positioned diagnostics rendered +in GNU one-line style; generated ASTs carry equality-transparent source +positions. A reworked test architecture — golden snapshots, dual-front-end +equivalence, a compile gate over every snapshot — enforces all of it. +Quasi-quoters gained a `$$` escape and honest context errors; packaging +gained PVP bounds; CI a pinned, cached toolchain. + +### Added +- Early-warning CI job (`ghc-latest`): builds with `-Werror` and runs the + cabal test suites once against the newest GHC series the CI runner image + ships (currently 9.14), relaxing only rtk's own bounds on the GHC boot + libraries. Warnings a new GHC promotes into `-Wall` (or turns on by + default) now surface on every push instead of at the next toolchain bump; + the pinned primary job stays authoritative. rtk's own code is kept + warning-clean portably: pattern matches instead of `head` (9.8 warns on + every `head`/`tail` use, `-Wx-partial`), and the no-op `Typeable` + derivings dropped (9.14 promotes `-Wderiving-typeable` into `-Wall`; + explicit `Typeable` deriving has been meaningless since GHC 7.10). The + compiled-in generated snapshot gets a scoped, GHC-gated `-Wno-x-partial` + (generated code is not edited to placate + linters - the lexer generator emitting `drop 1` instead of `tail` is + tracked as follow-up work, since it churns every golden) +- Provenance banner: every generated artifact (`Lexer.x`, + `Parser.y`, `QQ.hs`) now opens with `-- Generated by RTK from + grammar ''. Do not edit by hand.` The banner deliberately names the + grammar rather than the grammar file (a path would make the output - and + the golden snapshots - depend on where the grammar lives) and carries no + rtk version (a version would couple every release bump to a full golden + churn) +- `make test-compile-goldens`, wired into CI after the cabal test suites: + runs `alex -g` and `happy --ghc` over every checked-in golden + `Lexer.x`/`Parser.y` pair and typechecks the result with + `ghc -fno-code`. The golden suite diffs text only and sat green while the + debug-test and t1 snapshots did not compile; the gate closes that + test-architecture hole (QQ goldens join once the regex-posix dependency + is dropped, task 8b) +- Source positions in generated ASTs: every constructor that generated + parsers build (except the quasi-quotation-only `Anti_*` splice + constructors) now stores the position of its alternative's first symbol + in a leading `RtkPos` field. `RtkPos` is transparent for equality and + ordering (`==` always holds, `compare` is always `EQ`), so ASTs that + differ only in source positions compare equal — in particular a + quasi-quote parsed at compile time still matches the same construct + parsed at run time, and quasi-quote *patterns* wildcard every position + field while *expressions* may embed them. Payload-carrying `%token` + bindings now bind the whole positioned token, with generated `tkVal_*` + extractors recovering the payload in semantic actions; a generated + `RtkPosOf` class projects the position of any symbol (tokens, + nonterminals, lists, optionals). Generated code stays dependency-free. + The self-hosted front end now maps the rule constructors' positions into + `getIRulePos` (previously `Nothing` under `--use-generated`), so + pipeline diagnostics carry real `FILE:LINE:COL:` positions with both + front ends, and the dual-front-end AST equality suite compares positions + too. The hand-written parser's position for the `'.' id ':' …` rule form + moved from the identifier to the leading dot (a rule's position is where + the rule starts), aligning it with first-symbol capture; no corpus + grammar uses that form +- `--debug-rule RULENAME` is back, this time with a real implementation + (it was removed together with the other never-implemented placeholder + flags): it traces one rule through the pipeline, printing only that + rule's representation after each stage — its mentions in the token + stream (with positions), the matching `IRule`s after parsing and after + string normalization (making literal-to-`!tok_*` rewrites visible), and + the matching rule groups/lexical rules after clause normalization and + constructor filling — instead of full-grammar dumps. `--expand-rule` + shows a rule's final expanded form; this flag shows its evolution. When + the rule is missing at a stage the trace says so and lists up to five + case-insensitive near matches (normalization renames things — `Rule_N`, + `ListElem_*`, `tok_*`); a rule found at no stage at all fails the run + with exit code 1, so typos don't go unnoticed in scripts. Composes with + `--debug-stage` (stop early) and works under `--use-generated`, where + the token stage is internal to the generated front end and the trace + starts after parsing +- Self-hosting milestone (Prototype 2 closed): `rtk --use-generated` parses + grammar files with the lexer/parser RTK generated from + `test-grammars/grammar.pg`. The generated modules are compiled into rtk + straight from the checked-in golden snapshot (`test/golden/grammar/`, the + bootstrap stage produced by the previous rtk binary, kept current by `make + accept-golden`), and `src/generated/ASTAdapter.hs` converts the generated + AST to the hand-written `InitialGrammar`; everything after parsing is the + same shared pipeline. The golden suite now runs every grammar in + `test-grammars/` through BOTH front ends and requires byte-identical + artifacts, and the unit suite asserts AST equality (positions stripped) + for every grammar. The fixed point holds: `rtk --use-generated + test-grammars/grammar.pg out/` regenerates `test/golden/grammar/` exactly. + Accepted divergences (documented in BOOTSTRAP.md): errors carry positions + in the message text rather than structured diagnostics, `getIRulePos` is + not captured (both converge in task 7b), no nested `/* /* */ */` comments + (#25), no concatenation of adjacent `"""…"""` blocks. The harness also + surfaced two constructs the hand-written parser accepts beyond + grammar.pg's own definition of the language — empty alternatives + (`Gd = | ExpI ;` in haskell.pg) and redundant parentheses kept as + semantic grouping (`(ImportStatement)*` in java.pg, `(A B) C` in t1.pg) — + so those three grammars are pinned in the test suites + (`frontEndDivergentGrammars`) with a guard that fails once they stop + diverging; resolving which front end defines the language is follow-up + work +- Generated parsers, lexers and quasi-quoters report errors with `Either` + instead of throwing (the deferred "Stage G" of the diagnostics + migration): generated parsers use `%monad { Either String }`, so + `parse :: [PosToken] -> Either String ` mirrors the shape of + the hand-written grammar parser; generated lexers expose + `scanTokens :: String -> Either String [PosToken]` (`alexScanTokens` + stays as a throwing compatibility wrapper); and the generated + quasi-quoters route lexer, parser and unknown-metavariable failures + through `fail` in `TH.Q`, so a bad quasi-quote is now a positioned GHC + compile error at the splice site instead of a runtime crash during + Template Haskell expansion. Generated code stays dependency-free +- Duplicate rule definitions are rejected: defining the same rule name twice + in a grammar is now a normalization error carrying both source positions + (e.g. `g.pg:3:1: error: in rule 'Foo': rule 'Foo' is defined more than + once (first definition at line 2, column 1)`), instead of the definitions + being silently merged into one rule group with extra alternatives + (closes #20). `test-grammars/debug-test.pg`, the one grammar that relied + on this, now defines `IfStatement` once with `|` alternatives +- A `$$` escape in quasi-quote bodies: `$$name` now produces the literal + text `$name` instead of being rewritten as a metavariable (or rejected). + Previously the generated quasi-quoter rewrote `$ident` everywhere in a + quote body — including inside the quoted language's own string literals — + mangling programs. Each `$$` pair directly before a metavariable stands + for one literal `$` (so `$$$x` is a literal `$` followed by the + metavariable `$x`). The unknown-metavariable error now names the + offending `$name`, lists the known shortcuts and points at the `$$` + escape (see `docs/why-qq-limitations.md`) +- Hackage packaging hygiene: PVP version bounds on all dependencies and on + the `alex`/`happy` build tools, `Tested-With` now lists GHC 9.4.7 and + 9.6.4 (the versions actually exercised locally and in CI), and the + packages required by RTK-generated code are documented in the README and + the cabal description +- Structured diagnostics: grammar errors are now `Diagnostic` values + (message plus optional source position and context) threaded through + `Either`, instead of being thrown with `error`. The grammar-processing + pipeline functions (`scanTokens`, `parse`, `normalizeTopLevelClauses`, + `genX`/`genY`/`genAST`/`genQ`) are total for user-caused failures +- One-line GNU-style error reporting: `rtk` prints `FILE:LINE:COL: error: + MESSAGE` to stderr and exits 1 for a bad grammar, with no Haskell exception + or call stack (closes #23 and #31) +- A lifted (`,`) clause under `*`/`+`/`?` (e.g. `Foo = ,Bar* ;`) is now + rejected with a clear error during normalization, instead of silently + generating broken code +- A reference to an unknown rule now names both the unknown rule and the type + that references it +- Source positions on tokens: the lexer now returns `PosToken` values + (token plus line/column), both in the hand-written lexer and in all + generated lexers +- Parse errors report line, column and a human-readable description of the + unexpected token (e.g. `Parse error at line 2, column 1: unexpected + identifier 'Foo'`); generated parsers report positions too instead of + dumping the remaining token list +- Errors at end of input carry the position where the input ended, in both + the hand-written and generated parsers +- Grammar normalization errors name the offending rule and its source + position (e.g. `Grammar error in rule 'Foo' (at line 2, column 1): ...`) +- Lexer-generation errors name the lexical rule they occur in + +### Changed +- **RTK is now self-hosting by default — the headline of this release.** + Grammar files are parsed with the front end RTK generated from its own + grammar description, and `test-grammars/grammar.pg` is the authoritative + definition of the grammar language. The hand-written `Lexer.x`/`Parser.y` + are demoted to a reference oracle selected with the new + `--use-handwritten` flag (`--use-generated` remains accepted and is now a + no-op); the equivalence harness keeps holding both front ends to identical + artifacts and equal ASTs for every corpus grammar, and the bootstrap fixed + point now holds for a *default* invocation: `rtk test-grammars/grammar.pg + out/` reproduces `test/golden/grammar/` byte-for-byte. Changes to the + grammar language land in grammar.pg (plus regenerated goldens) first; the + hand-written files follow only to keep the harness green. See BOOTSTRAP.md +- Front-end error parity (prerequisite of the default flip): generated + lexers and parsers now encode failures as machine-splittable + `LINE:COL:message` (previously prose like `Parse error at line L, column + C: …`), the shared `Diagnostics.diagnosticFromPositioned` splits the + encoding into a positioned diagnostic, and rtk renders the same GNU-style + `FILE:LINE:COL: error: …` line under both front ends — for lexical errors + the stderr line is identical character for character; for parse errors the + position is identical and only the token wording differs (generated + parsers render tokens generically). Generated quasi-quoters re-render the + encoding human-readably (`line L, column C: …`) in their `fail` path, as + do the standalone test drivers. Every golden `Lexer.x`/`Parser.y` + changed uniformly with the new error templates +- The two historic front-end divergences are resolved and the + pinned-divergence list (`TestSupport.frontEndDivergentGrammars`) is empty: + the hand-written reference parser now defines the same language as + grammar.pg — it rejects empty alternatives (`R = | X ;`) and lifts + redundant parenthesis groups exactly like grammar.pg's + `Clause5 = '(' ,Clause ')'` (single-leaf groups collapse, pure-sequence + groups merge at the head of a sequence, alternation groups merge as the + first alternative); haskell.pg's `Gd = | ExpI ;` was rewritten as the + equivalent `Gd = ExpI? ;`. java.pg, t1.pg and haskell.pg artifacts changed + accordingly (fewer proxy sub-rules, e.g. java.pg's `(ImportStatement)*` + now generates a plain list rule) +- The core pipeline data types (`InitialGrammar`, `IClause`, + `NormalGrammar`, …) moved from the footer of the hand-written `Parser.y` + into the new front-end-agnostic `Syntax` module; a demoted parser no + longer owns the project's core types. Pure move, no behavior change +- `--debug-tokens` in the default (generated) front end now dumps the + generated lexer's token stream (it previously printed nothing under + `--use-generated`) +- The Java grammar parses exactly ONE `ModifierList` per declaration. The + class/interface/enum/`@interface` rules no longer begin with their own + nullable list; `TypeDeclRest` (ex-`NestedTypeDeclaration`, now used at the + top level too) carries everything after the modifiers, and the list lives + on the enclosing rule: `TypeDeclaration = OptDocComment ModifierList + TypeDeclRest`, `FieldDeclaration = OptDocComment ModifierList + (MemberDeclaration | TypeDeclRest | StaticInitializer) | ';'`. The nested + nullable lists used to produce 14 shift/reduce conflicts (after the outer + list, every modifier/annotation token chose between extending it and + epsilon-starting the inner one) whose shift resolution parsed + `public class A {}` with `public` on the OUTER list and a confusing, + always-empty inner list; that always-empty `ModifierList` field is gone + from the class/interface/enum/annotation AST constructors, and the + generated quasi-quoter renames `nestedTypeDeclaration` to `typeDeclRest`. + Together with the restored dangling-else conflict (see Fixed) the + generated `JavaParser.y` is down to 18 shift/reduce + 0 reduce/reduce + conflicts (from 32 + 0), and java.pg now opens with a complete inventory + of all 18 - each family with its automaton items and why the shift is the + correct Java reading (dangling else; catch/finally attach to the nearest + try; member id vs empty TypeParameters; greedy CompoundName `.`; + bracket-list `[` shifts; `<` commits to type arguments; the QQ bootstrap + dummy bracket) - replacing the stale "~14"/"~13"/"32" conflict comments. + The commons-lang corpus success sets are unchanged (14/16 main/tests + files), so the parser blacklists stay as they are +- The makefile test pipeline now runs alex with `-g` (the GHC backend), so + generated lexers in `test-out/` compile as compact string-encoded tables + instead of ~half-a-million-line pattern matches. GHC's compile of the + Java lexer drops from minutes to seconds with identical token streams + (verified against the `test-lex-java` goldens). The library's own lexers + already used `-g` via cabal's preprocessor; this closes the gap for the + makefile-driven tests (#27) +- The `$Type:var` splice alternative is now attached to a minimal set of + rules of a shared-type group instead of to every rule. The normalizer + builds the group's lift graph (rule A → rule B when B has an alternative + that is exactly the single nonterminal A, ignoring nullable clauses) and + greedily picks attach points whose unit-closure covers every rule the + grammar demands from some position; a splice token reduces at an attach + point and climbs the chain to the level its position requires. For + java.pg's 18-rule Expression chain the single attach point is + `PrimaryNoPostfix`, which removes the 806 reduce/reduce conflicts + (of 883) the per-rule alternatives used to cause, along with the three + "rule ... is unused" happy warnings, and makes the parse of a splice + independent of conflict-resolution accidents. Types declared by a + single rule are unaffected. A + group whose demanded rules cannot be covered from one attach point gets + several; if their closures overlap, the overlap can reintroduce + reduce/reduce conflicts between the splice reductions (inherent to such + grammars; normalization has no warning channel to report them) + +### Removed +- The `--debug-format` option: its only honest format was the `pretty` + default - `compact` merely stripped newlines into an unreadable single + line (and the advertised `json`/`tree` formats had already been removed + as never-implemented). Debug output is always pretty-printed now; + `DEBUG_OPTIONS.md` and `test-debug-options.sh` follow +- The orphan `PrintGrammar` module: a dead pretty-printing draft predating + the current pipeline, listed in the cabal file but imported by nothing + (pretty-printing returns properly as a tracked feature) +- The makefile's `Windows_NT` branch: its `dist/build/rtk/rtk.exe` was the + cabal-v1 path, dead for years - the makefile is Unix-only and now says so +- The superseded textual bootstrap comparison: `compare-bootstrap.sh`, the + `make test-bootstrap` target and its informational CI step. Behavioral + equivalence of the two front ends is enforced by the golden/unit harness + on every test run; textual identity of the generated `.x`/`.y` with the + hand-written ones was never the goal +- Unimplemented CLI options that were advertised in `--help` but had no + effect: `--debug-rule`, `--compare-stages`, `--memory-stats`, + `--debug-output-dir`, `--debug-log`, `--interactive`, the placeholder + `json`/`tree` debug formats, and the `--use-generated` stub that only + printed an error + +### Fixed +- Generated quasi-quoters' `quoteType`/`quoteDec` no longer lie: they used + to silently return dummies (`TH.ListT` / `[]`), so a quote in a type or + declaration context compiled into nonsense. Both now `fail` in `TH.Q`, + making the misuse a GHC compile error at the splice site ("this + quasi-quoter cannot be used in a type/declaration context") +- Writing into a missing output directory no longer escapes as a raw + `IOException`: `rtk g.pg /tmp/does/not/exist` now creates the directory + and succeeds; IO failures that remain (no permission, a file where the + directory should be) are rendered as the usual one-line GNU-style + diagnostic and exit 1 +- A literal backslash inside a `[...]` character class is now emitted + Alex-escaped (`\` → `\\`) by the lexer generator; it used to pass through + raw, where Alex set syntax reads it as an escape, forcing grammars onto + the `[\x5C]` hex spelling (issue #95's smaller finding). The `\n \t \r \f + \v` pairs that token post-processing preserves keep passing through bare. + java.pg drops its hex workarounds for a `backslash` charset macro and a + plain `[^\"\\\n\r]` negated class; generated Java token streams are + byte-identical (the `test-lex-java` goldens are untouched). One + grammar-lexer limitation remains, documented at the macro definition: a + class ending in a backslash must also end its source line, because `\]` + lexes as an escape pair +- `GenAST`'s unreachable backstop for lifted clauses claimed "lifted rules + are not yet implemented" - a missing feature it is not; reworded to the + `Internal error (GenAST): …` convention (Normalize rejects or filters + every lifted position before AST generation) +- A type declared only through rule annotations (`Thing : Item = …` with no + rule named `Thing`) could not be referenced: a plain `S = Thing ;`, a list + element `Thing* ~ ','`, or merely the QQ start wrapper (which references + every public type by name) failed generation with `reference to unknown + rule 'Thing'`. rtk now synthesizes the cover rule that grammar authors + wrote by hand for this (java.pg's + `Expression : Expression = AssignmentExpression ;`), in lifted form — + `Thing : Thing = ,Item1 | ,Item2 ;` — so the type gets a nonterminal + without an extra AST constructor. Synthesis is demand-driven (a grammar + that never references the bare type is generated byte-identically) and + happens on the parsed grammar before normalization, so the cover takes + part in the splice attach-point machinery like a hand-written one: the + `$Thing:var` alternative lands on one annotated rule and climbs to the + type through the cover, and the covered type gets a top-level quoter. + LALR conflicts of the synthesized cover are exactly those of its + hand-written equivalent (overlapping FIRST sets among the annotated + rules remain the grammar's own, and happy still reports them). The + remaining unresolvable case — referencing a lexical rule's *value* type, + which declares no syntax type — keeps a diagnostic that now explains the + type-named-rule convention. New corpus grammar `test-grammars/i14.pg` + pins all reference shapes in the golden suite and compile gate, and + `make test-i14-qq` (wired into CI) exercises quoters and splices against + the covered types (#14) +- A grammar whose start rule is a repetition (`Start = Item* ;`) generated a + parser that did not compile: the QQ start-wrapper alternatives extended + the start group as a `data` declaration while the repetition typed the + same nonterminal as the alias `[Item]` (plus a dummy-token shift/reduce + conflict against the empty list). Such an alias start group now skips the + QQ entry-point machinery entirely — no dummy tokens, wrapper alternatives + or top-level quoters, since an alias has no constructor to project a quote + through — while element-level `$Type:var` splices keep working. Groups + merely *referenced* by a wrapper alternative (grammar.pg's + `RuleList = Rule*`) were always well-typed and are unchanged. The + debug-test golden, uncompilable until now, is regenerated (#34) +- Repetition over a terminal silently generated uncompilable code: + `Foo = 'x'* ;` emitted a degenerate self-recursive `data Foo` against + list-building parser actions, and `Foo = num* ;` an invalid lowercase + `data num`. Decided as by-design and rejected during normalization with a + positioned diagnostic: a list element must be a syntax rule, because the + element type hosts the list's splice constructor — wrap the terminal in a + syntax rule and repeat that rule instead. A lifted `(,X)` element under + `*`/`+` is rejected the same way instead of crashing the generator (#28) +- The synthesized QQ start wrapper is now emitted directly adjacent to the + rule it wraps: list-element proxy rules could separate the two same-named + rule blocks in the generated `.y`, which happy rejects outright + ("Multiple rules for 'A'", t1.pg's golden was affected) +- A brace-less nested `if` parses again: `IfStatement`'s then-branch was + `StatementWithoutIf`, so valid Java like `if (a) if (b) f(); else g();` + was rejected with "unexpected 'if'". The then-branch is a full `Statement` + and `StatementWithoutIf` is inlined away (`Statement` absorbs its + alternatives; nothing else referenced it). This re-surfaces the classic + dangling-else shift/reduce conflict, which happy resolves by shifting: + `else` binds to the NEAREST `if`, exactly the JLS 14.5 rule (verified on + the printed AST; regression coverage via + `test-grammars/java/test-nested-if.java` / `make test-java-nested-if` and + a quasi-quotation construction case). The exclusion never even avoided + that conflict - it already existed through loop bodies in then-position, + e.g. `if (a) while (b) if (c) f(); else g();` - it only rejected the + direct nested form +- The Java grammar's last structural LALR ambiguity - deciding between a + type and an expression after a `CompoundName` at statement start or after + `(` - is resolved JLS-style (`happy` now reports 0 reduce/reduce + conflicts on the generated `JavaParser.y`, down from 2). Types and + declarators take only empty bracket pairs (`Dims`/`NonEmptyDims`, + anchored on the unreduced name so `[` is a plain shift); only array + creation takes sizing expressions; `CastExpression` uses the JLS trick + (`'(' Expression ')' UnaryExpressionNotPlusMinus` for reference casts + plus explicit primitive/generic/array alternatives); and array access is + anchored on `CompoundName` in `PrimaryNoPostfix`. `a[0] = 1;`, + `x = (a);`, `x = (Foo) y;`, `x = (List) y;`, `((Map) c).get(k);` + and `new int[3][];` now parse; JLS-invalid `int[3] x;` declarations are + now rejected. Known residual limitation (shared by LALR Java parsers + generally): `(a < b)` as a parenthesized primary mis-commits to a + generic cast on `<` (conditions like `if (a < b)` are unaffected) +- `make test-p` works again: the target had a hand-rolled recipe that + compiled the driver with bare `ghc` outside the cabal package environment, + failing with `Could not find module 'Data.Generics'` in clean + environments. It now uses the generic `make-test-rule` like its sibling + targets (`cabal exec -- ghc --make -itest-out ...`); the driver binary is + consequently named `test-out/p-main` instead of `test-out/p-rtk`. The + compile failure had masked a latent bug in the driver itself: + `p-main.hs`'s `subst` bound `e1 = subst id e1 i` etc., self-referential + recursive lets that shadow the pattern variables and diverge (`<>`) + on the first fold expression, and it had no base case. The lets now bind + fresh names and a catch-all clause terminates the recursion, so the + driver prints the substituted AST +- `'\f'` and `'\v'` escapes in grammar string and `[...]` regex literals now + reach the generated lexer as bare Alex escapes; previously token + post-processing (`unBackQuote`) stripped them to the literal letters + `f`/`v` even though `GenX.isAlexEscape` was ready to emit them, so the two + escape sets disagreed. The preserved set (`\n \t \r \f \v`) is now pinned + to `isAlexEscape` by a unit test +- `test-grammars/haskell.pg` is self-consistent again: minimal `Pat` and + `QOp` rules were added for the previously dangling references, so RTK + generation no longer aborts on it (progress on issue #30; the grammar is + still far from full Haskell). The haskell special cases in the test suites + were dropped and golden snapshots added +- A grammar whose first rule is lexical (or has a data-type annotation + different from the rule name) no longer crashes with `fromJust: Nothing`; + it reports that the first rule must be a syntax rule, or resolves the + annotated type correctly +- Internal `fromJust` calls in code generation replaced with descriptive + internal-error messages +- Invalid clauses in lexical-rule macros now abort generation with an error + instead of writing the error text into the generated lexer +- User-facing errors no longer print a GHC call stack +- `--debug-stage` now exits with a success status after stopping at the + requested stage instead of reporting failure via `error` +- `--profile-stages` timings now force each stage's result to normal form, + so per-stage durations are no longer skewed by lazy evaluation + +### Documentation +- Replaced the README "Grammar Format" example, which used Happy-style + semantic actions that RTK cannot parse, with a verified `.pg` example +- Removed the stale `Claude.MD` (a case-colliding near-duplicate of + `CLAUDE.md`; its Quick Reference table was folded into `CLAUDE.md`) and the + stray root `test-simple-return.java` duplicate + +## [0.10] - 2025-12-03 + +### Added +- MIT license with generated code exemption +- Full Java grammar support with comprehensive parsing tests +- Quasi-quotation support for embedding parsed syntax in Haskell +- Debug options for grammar development and troubleshooting +- Bootstrap self-hosting capability (RTK can parse its own grammar format) + +### Fixed +- Alex escape sequence generation in GenX.hs +- Java grammar lexer patterns for complete test coverage + +## [0.9] - Initial Development + +### Added +- Core grammar specification format (.pg files) +- Alex lexer generation (GenX.hs) +- Happy parser generation (GenY.hs) +- AST generation (GenAST.hs) +- Quasi-quotation generation (GenQ.hs) +- Grammar normalization and transformation diff --git a/Debug.hs b/Debug.hs new file mode 100644 --- /dev/null +++ b/Debug.hs @@ -0,0 +1,683 @@ +module Debug + ( -- * Debug output functions + debugOutput + , debugSection + , debugSubSection + + -- * Pipeline stage debugging + , printTokens + , printInitialGrammar + , printNormalGrammar + , printComparison + + -- * Single-rule pipeline trace + , traceRuleTokens + , traceRuleTokensUnavailable + , traceRuleInitial + , traceRuleNormal + + -- * Statistics and analysis + , showGrammarStats + , analyzeGrammarConflicts + , printRuleList + , printRuleGraph + + -- * Validation + , runGrammarValidation + , findUnusedRules + , detectLeftRecursion + , suggestGrammarShortcuts + , showExpandedRule + + -- * Performance profiling + , timed + , deepForce + , TimingInfo(..) + , showTimingInfo + + -- * Output utilities + , withColor + , Color(..) + ) where + +import qualified Lexer as L +import Syntax +import DebugOptions +import Diagnostics (showSourcePos) +import Text.Show.Pretty (ppShow) +import Control.Monad (when) +import Data.Char (toLower) +import Data.Data (Data, gmapQ) +import Data.Time.Clock (getCurrentTime, diffUTCTime, UTCTime) +import Data.List (intercalate, isInfixOf, nub, (\\)) +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Maybe (fromMaybe, mapMaybe) +import Control.Exception (evaluate) + +import qualified System.Console.ANSI as ANSI + +------------------------------------------------------------------------------- +-- Color support +------------------------------------------------------------------------------- + +data Color = Red | Green | Yellow | Blue | Magenta | Cyan | White + deriving (Eq, Show) + +-- | Output text with color if enabled +withColor :: Bool -> Color -> String -> IO () +withColor useColor color text = do + when' useColor $ ANSI.setSGR [ANSI.SetColor ANSI.Foreground ANSI.Vivid (toANSIColor color)] + putStr text + when' useColor $ ANSI.setSGR [ANSI.Reset] + where + when' True action = action + when' False _ = return () + + toANSIColor Red = ANSI.Red + toANSIColor Green = ANSI.Green + toANSIColor Yellow = ANSI.Yellow + toANSIColor Blue = ANSI.Blue + toANSIColor Magenta = ANSI.Magenta + toANSIColor Cyan = ANSI.Cyan + toANSIColor White = ANSI.White + +------------------------------------------------------------------------------- +-- Debug output formatting +------------------------------------------------------------------------------- + +-- | Output debug information under a section header +debugOutput :: DebugOptions -> String -> String -> IO () +debugOutput opts title content = do + debugSection opts title + putStrLn content + putStrLn "" + +-- | Print a section header +debugSection :: DebugOptions -> String -> IO () +debugSection opts title = do + let separator = replicate 70 '=' + withColor (debugColor opts) Cyan $ separator ++ "\n" + withColor (debugColor opts) Green $ " " ++ title ++ "\n" + withColor (debugColor opts) Cyan $ separator ++ "\n" + +-- | Print a subsection header +debugSubSection :: DebugOptions -> String -> IO () +debugSubSection opts title = do + withColor (debugColor opts) Yellow $ "-- " ++ title ++ "\n" + +------------------------------------------------------------------------------- +-- Pipeline stage debugging +------------------------------------------------------------------------------- + +-- | Debug tokens output +printTokens :: DebugOptions -> [L.PosToken] -> IO () +printTokens opts tokens = do + debugSection opts "LEXER OUTPUT - TOKENS" + putStrLn $ "Total tokens: " ++ show (length tokens) + putStrLn "" + putStrLn $ ppShow tokens + +-- | Debug initial grammar (after parsing) +printInitialGrammar :: DebugOptions -> InitialGrammar -> IO () +printInitialGrammar opts grammar = do + debugSection opts "PARSER OUTPUT - INITIAL GRAMMAR" + putStrLn $ "Grammar name: " ++ getIGrammarName grammar + putStrLn $ "Number of rules: " ++ show (length $ getIRules grammar) + putStrLn "" + putStrLn $ ppShow grammar + +-- | Debug normalized grammar +printNormalGrammar :: DebugOptions -> String -> NormalGrammar -> IO () +printNormalGrammar opts title grammar = do + debugSection opts title + putStrLn $ "Grammar name: " ++ getNGrammarName grammar + putStrLn $ "Syntax rule groups: " ++ show (length $ getSyntaxRuleGroups grammar) + putStrLn $ "Lexical rules: " ++ show (length $ getLexicalRules grammar) + putStrLn $ "Anti-rules (QQ): " ++ show (length $ getAntiRules grammar) + putStrLn "" + putStrLn $ ppShow grammar + +-- | Debug comparison between two values +printComparison :: (Show a, Eq a) => DebugOptions -> String -> a -> String -> a -> IO () +printComparison opts title1 val1 title2 val2 = do + debugSection opts $ "COMPARISON: " ++ title1 ++ " vs " ++ title2 + debugSubSection opts title1 + putStrLn $ ppShow val1 + putStrLn "" + debugSubSection opts title2 + putStrLn $ ppShow val2 + putStrLn "" + if val1 == val2 + then withColor (debugColor opts) Green "No differences found.\n" + else withColor (debugColor opts) Yellow "Differences detected.\n" + +------------------------------------------------------------------------------- +-- Single-rule pipeline trace (--debug-rule) +------------------------------------------------------------------------------- + +-- | Header shared by all stages of a rule trace +traceSection :: DebugOptions -> String -> String -> IO () +traceSection opts ruleName stage = + debugSection opts $ "RULE TRACE: '" ++ ruleName ++ "' - " ++ stage + +-- | Token-stage view of a rule trace: every place the rule name is mentioned +-- in the source, as Id tokens with their positions. Returns whether the rule +-- was found at this stage. +traceRuleTokens :: DebugOptions -> String -> [L.PosToken] -> IO Bool +traceRuleTokens opts ruleName tokens = do + traceSection opts ruleName "Tokens" + let mentions = [pos | L.PosToken pos (L.Id name) <- tokens, name == ruleName] + if null mentions + then do + reportNotFoundAtStage opts ruleName [n | L.PosToken _ (L.Id n) <- tokens] + return False + else do + putStrLn $ "Mentioned " ++ show (length mentions) ++ " time(s) in the token stream:" + mapM_ (putStrLn . showMention) mentions + putStrLn "" + return True + where + showMention (L.AlexPn _ line col) = + " line " ++ show line ++ ", column " ++ show col ++ ": Id " ++ show ruleName + +-- | Under --use-generated the front end has no separate token stream to +-- inspect, so the token stage of a rule trace is just a note. +traceRuleTokensUnavailable :: DebugOptions -> String -> IO () +traceRuleTokensUnavailable opts ruleName = do + traceSection opts ruleName "Tokens" + putStrLn "Token stage is internal to the generated front end; trace continues after parsing." + putStrLn "" + +-- | InitialGrammar-stage view of a rule trace (after parse, after +-- string-norm): the IRules whose rule name or data type name matches, each +-- headed by its source position. +traceRuleInitial :: DebugOptions -> String -> String -> InitialGrammar -> IO Bool +traceRuleInitial opts ruleName stage grammar = do + traceSection opts ruleName stage + let rules = getIRules grammar + matches = filter matchesRule rules + matchesRule r = getIRuleName r == ruleName + || getIDataTypeName r == Just ruleName + if null matches + then do + reportNotFoundAtStage opts ruleName + (map getIRuleName rules ++ mapMaybe getIDataTypeName rules) + return False + else do + mapM_ printMatch matches + return True + where + printMatch rule = do + debugSubSection opts $ + "Rule '" ++ getIRuleName rule ++ "' (" + ++ maybe "no position" showSourcePos (getIRulePos rule) ++ ")" + putStrLn $ ppShow rule + putStrLn "" + +-- | NormalGrammar-stage view of a rule trace (after clause-norm, after +-- constructor-fill): the syntax rule groups that define the rule (by data +-- type name or by a contained rule name) plus any matching lexical rule, +-- shown compactly, with the full structure in pretty format. +traceRuleNormal :: DebugOptions -> String -> String -> NormalGrammar -> IO Bool +traceRuleNormal opts ruleName stage grammar = do + traceSection opts ruleName stage + let groups = getSyntaxRuleGroups grammar + lRules = getLexicalRules grammar + proxyRules = getProxyRules (getGrammarInfo grammar) + matchingGroups = filter groupMatches groups + groupMatches g = getSDataTypeName g == ruleName + || any ((== ruleName) . getSRuleName) (getSRules g) + matchingLexical = filter ((== ruleName) . getLRuleName) lRules + if null matchingGroups && null matchingLexical + then do + reportNotFoundAtStage opts ruleName $ + map getSDataTypeName groups + ++ concatMap (map getSRuleName . getSRules) groups + ++ map getLRuleName lRules + return False + else do + mapM_ (printGroup proxyRules) matchingGroups + mapM_ printLexical matchingLexical + return True + where + printGroup proxyRules grp = do + showRuleGroup opts proxyRules grp + printDetail grp + printLexical rule = do + showLexicalRule opts rule + printDetail rule + printDetail :: Show a => a -> IO () + printDetail x = do + putStrLn $ ppShow x + putStrLn "" + +-- | Report a rule missing at one stage, with near matches: normalization +-- renames things (Rule_N, ListElem_*, tok_*), so suggestions keep the trace +-- usable across stages. +reportNotFoundAtStage :: DebugOptions -> String -> [String] -> IO () +reportNotFoundAtStage opts ruleName names = do + withColor (debugColor opts) Yellow $ + "Rule '" ++ ruleName ++ "' is not present at this stage.\n" + let suggestions = take 5 (nearMatches ruleName names) + when (not (null suggestions)) $ do + putStrLn "Near matches:" + mapM_ (putStrLn . (" - " ++)) suggestions + putStrLn "" + +-- | Case-insensitive near matches: equal up to case, or one name contained +-- in the other (catches tok_foo, Foo_1, ListElem_Foo style renames) +nearMatches :: String -> [String] -> [String] +nearMatches query names = filter close (nub names) + where + q = lower query + close name = let n = lower name in q `isInfixOf` n || n `isInfixOf` q + lower = map toLower + +------------------------------------------------------------------------------- +-- Statistics and analysis +------------------------------------------------------------------------------- + +-- | Show comprehensive grammar statistics +showGrammarStats :: DebugOptions -> InitialGrammar -> NormalGrammar -> IO () +showGrammarStats opts iGrammar nGrammar = do + debugSection opts "GRAMMAR STATISTICS" + + let iRules = getIRules iGrammar + sRuleGroups = getSyntaxRuleGroups nGrammar + lRules = getLexicalRules nGrammar + aRules = getAntiRules nGrammar + shortcuts = getShortcuts nGrammar + info = getGrammarInfo nGrammar + proxyRules = getProxyRules info + + totalSyntaxRules = sum $ map (length . getSRules) sRuleGroups + + putStrLn $ "Grammar name: " ++ getNGrammarName nGrammar + putStrLn "" + putStrLn "=== Rule Counts ===" + putStrLn $ " Initial rules: " ++ show (length iRules) + putStrLn $ " Syntax rule groups: " ++ show (length sRuleGroups) + putStrLn $ " Total syntax rules: " ++ show totalSyntaxRules + putStrLn $ " Lexical rules: " ++ show (length lRules) + putStrLn $ " Anti-rules (QQ): " ++ show (length aRules) + putStrLn $ " Proxy rules: " ++ show (S.size proxyRules) + putStrLn $ " Shortcuts: " ++ show (length shortcuts) + putStrLn "" + + putStrLn "=== Constructor Information ===" + let constructorCount = countConstructors sRuleGroups + putStrLn $ " Total constructors: " ++ show constructorCount + putStrLn "" + + putStrLn "=== Complexity Metrics ===" + putStrLn $ " Auto-generated rules: " ++ show (totalSyntaxRules - length iRules) + putStrLn $ " Name counter: " ++ show (getNameCounter info) + putStrLn "" + +-- | Count constructors in syntax rules +countConstructors :: [SyntaxRuleGroup] -> Int +countConstructors groups = sum $ map countInGroup groups + where + countInGroup grp = sum $ map countInRule (getSRules grp) + countInRule (SyntaxRule _ clause) = countInClause clause + countInClause (STAltOfSeq seqs) = length seqs + countInClause _ = 1 + +-- | Analyze grammar for potential conflicts +analyzeGrammarConflicts :: DebugOptions -> NormalGrammar -> IO () +analyzeGrammarConflicts opts grammar = do + debugSection opts "GRAMMAR CONFLICT ANALYSIS" + + let sRuleGroups = getSyntaxRuleGroups grammar + lRules = getLexicalRules grammar + + debugSubSection opts "Potential Ambiguities" + -- Check for rules with many alternatives + let complexRules = filter hasManyAlternatives sRuleGroups + if null complexRules + then putStrLn " No highly ambiguous rules found." + else do + putStrLn $ " Found " ++ show (length complexRules) ++ " rules with many alternatives:" + mapM_ (putStrLn . (" - " ++) . getSDataTypeName) complexRules + putStrLn "" + + debugSubSection opts "Lexical Token Conflicts" + -- Check for overlapping string literals + let stringLits = extractStringLiterals lRules + duplicates = findDuplicates stringLits + if null duplicates + then putStrLn " No duplicate string literals found." + else do + putStrLn $ " Found " ++ show (length duplicates) ++ " duplicate literals:" + mapM_ (putStrLn . (" - " ++)) duplicates + putStrLn "" + +-- | Helper: Check if rule group has many alternatives +hasManyAlternatives :: SyntaxRuleGroup -> Bool +hasManyAlternatives grp = any checkRule (getSRules grp) + where + checkRule (SyntaxRule _ (STAltOfSeq seqs)) = length seqs > 10 + checkRule _ = False + +-- | Helper: Extract string literals from lexical rules +extractStringLiterals :: [LexicalRule] -> [String] +extractStringLiterals = mapMaybe extractFromRule + where + extractFromRule (LexicalRule _ _ _ (IStrLit s)) = Just s + extractFromRule _ = Nothing + +-- | Helper: Find duplicates in a list +findDuplicates :: Eq a => [a] -> [a] +findDuplicates xs = xs \\ nub xs + +-- | Show list of all rules +printRuleList :: DebugOptions -> NormalGrammar -> IO () +printRuleList opts grammar = do + debugSection opts "RULE LISTING" + + let sRuleGroups = getSyntaxRuleGroups grammar + lRules = getLexicalRules grammar + info = getGrammarInfo grammar + proxyRules = getProxyRules info + + debugSubSection opts $ "Syntax Rules (" ++ show (length sRuleGroups) ++ " groups)" + mapM_ (showRuleGroup opts proxyRules) sRuleGroups + putStrLn "" + + debugSubSection opts $ "Lexical Rules (" ++ show (length lRules) ++ ")" + mapM_ (showLexicalRule opts) lRules + putStrLn "" + +-- | Show a single rule group +showRuleGroup :: DebugOptions -> S.Set String -> SyntaxRuleGroup -> IO () +showRuleGroup opts proxyRules grp = do + let typeName = getSDataTypeName grp + isProxy = S.member typeName proxyRules + prefix = if isProxy then " [PROXY] " else " " + withColor (debugColor opts) (if isProxy then Magenta else White) $ prefix ++ typeName + putStrLn $ " (" ++ show (length $ getSRules grp) ++ " rules)" + mapM_ (showSyntaxRule opts) (getSRules grp) + +-- | Show a single syntax rule +showSyntaxRule :: DebugOptions -> SyntaxRule -> IO () +showSyntaxRule _ (SyntaxRule name clause) = do + putStrLn $ " - " ++ name ++ ": " ++ summarizeClause clause + +-- | Summarize a clause +summarizeClause :: SyntaxTopClause -> String +summarizeClause (STMany STStar _ _) = "list (*)" +summarizeClause (STMany STPlus _ _) = "list (+)" +summarizeClause (STOpt _) = "optional (?)" +summarizeClause (STAltOfSeq seqs) = show (length seqs) ++ " alternatives" + +-- | Show a lexical rule +showLexicalRule :: DebugOptions -> LexicalRule -> IO () +showLexicalRule _ (LexicalRule dtype _ name _) = + putStrLn $ " - " ++ name ++ " :: " ++ dtype +showLexicalRule _ (MacroRule name _) = + putStrLn $ " - " ++ name ++ " [MACRO]" + +-- | Show rule dependency graph +printRuleGraph :: DebugOptions -> NormalGrammar -> IO () +printRuleGraph opts grammar = do + debugSection opts "RULE DEPENDENCY GRAPH" + + let sRuleGroups = getSyntaxRuleGroups grammar + deps = buildDependencyMap sRuleGroups + + putStrLn "Rule -> Dependencies:" + mapM_ (showDependency opts) (M.toList deps) + +-- | Build dependency map +buildDependencyMap :: [SyntaxRuleGroup] -> M.Map String [String] +buildDependencyMap groups = M.fromList $ map buildForGroup groups + where + buildForGroup grp = (getSDataTypeName grp, extractDeps grp) + extractDeps grp = nub $ concatMap (extractFromRule . getSClause) (getSRules grp) + extractFromRule (STMany _ sc _) = extractFromSimple sc + extractFromRule (STOpt sc) = extractFromSimple sc + extractFromRule (STAltOfSeq seqs) = concatMap extractFromSeq seqs + extractFromSeq (STSeq _ scs) = concatMap extractFromSimple scs + extractFromSimple (SSId ruleId) = [ruleId] + extractFromSimple (SSLifted ruleId) = [ruleId] + extractFromSimple (SSIgnore ruleId) = [ruleId] + +-- | Show a single dependency +showDependency :: DebugOptions -> (String, [String]) -> IO () +showDependency _ (rule, deps) = do + putStr $ " " ++ rule ++ " -> " + if null deps + then putStrLn "[no dependencies]" + else putStrLn $ intercalate ", " deps + +------------------------------------------------------------------------------- +-- Validation +------------------------------------------------------------------------------- + +-- | Validate grammar and report issues +runGrammarValidation :: DebugOptions -> NormalGrammar -> IO Bool +runGrammarValidation opts grammar = do + debugSection opts "GRAMMAR VALIDATION" + + let sRuleGroups = getSyntaxRuleGroups grammar + lRules = getLexicalRules grammar + allSyntaxRuleNames = S.fromList $ concatMap (map getSRuleName . getSRules) sRuleGroups + allLexicalRuleNames = S.fromList $ map getLRuleName lRules + + issues <- sequence + [ checkUndefinedReferences opts sRuleGroups (allSyntaxRuleNames `S.union` allLexicalRuleNames) + , checkDuplicateConstructors opts sRuleGroups + ] + + let totalIssues = sum issues + putStrLn "" + if totalIssues == 0 + then do + withColor (debugColor opts) Green "[OK] Grammar validation passed!\n" + return True + else do + withColor (debugColor opts) Red $ "[X] Found " ++ show totalIssues ++ " issue(s).\n" + return False + +-- | Check for undefined rule references +checkUndefinedReferences :: DebugOptions -> [SyntaxRuleGroup] -> S.Set String -> IO Int +checkUndefinedReferences opts groups allRules = do + debugSubSection opts "Undefined References" + let refs = S.fromList $ concatMap extractRefs groups + undefinedRefs = S.toList $ refs `S.difference` allRules + if null undefinedRefs + then do + putStrLn " No undefined references." + return 0 + else do + putStrLn $ " Found " ++ show (length undefinedRefs) ++ " undefined references:" + mapM_ (putStrLn . (" - " ++)) undefinedRefs + return (length undefinedRefs) + where + extractRefs grp = concatMap (extractFromRule . getSClause) (getSRules grp) + extractFromRule (STMany _ sc _) = extractFromSimple sc + extractFromRule (STOpt sc) = extractFromSimple sc + extractFromRule (STAltOfSeq seqs) = concatMap extractFromSeq seqs + extractFromSeq (STSeq _ scs) = concatMap extractFromSimple scs + extractFromSimple (SSId ruleId) = [ruleId] + extractFromSimple (SSLifted ruleId) = [ruleId] + extractFromSimple (SSIgnore ruleId) = [ruleId] + +-- | Check for duplicate constructor names +checkDuplicateConstructors :: DebugOptions -> [SyntaxRuleGroup] -> IO Int +checkDuplicateConstructors opts groups = do + debugSubSection opts "Duplicate Constructors" + let constructors = concatMap extractConstructors groups + duplicates = findDuplicates constructors + if null duplicates + then do + putStrLn " No duplicate constructors." + return 0 + else do + putStrLn $ " Found " ++ show (length duplicates) ++ " duplicate constructors:" + mapM_ (putStrLn . (" - " ++)) duplicates + return (length duplicates) + where + extractConstructors grp = concatMap extractFromRule (getSRules grp) + extractFromRule (SyntaxRule _ (STAltOfSeq seqs)) = map (\(STSeq name _) -> name) seqs + extractFromRule _ = [] + +-- | Find unused rules +findUnusedRules :: DebugOptions -> NormalGrammar -> IO () +findUnusedRules opts grammar = do + debugSection opts "UNUSED RULES" + + let sRuleGroups = getSyntaxRuleGroups grammar + info = getGrammarInfo grammar + startRule = getStartRuleName info + allRules = M.fromList $ map (\g -> (getSDataTypeName g, g)) sRuleGroups + deps = buildDependencyMap sRuleGroups + + reachable = case startRule of + Just start -> findReachable start deps + Nothing -> S.empty + + allRuleNames = M.keysSet allRules + unused = S.toList $ allRuleNames `S.difference` reachable + + if null unused + then putStrLn " All rules are reachable from start rule." + else do + putStrLn $ " Found " ++ show (length unused) ++ " unused rules:" + mapM_ (putStrLn . (" - " ++)) unused + +-- | Find all reachable rules from a start rule +findReachable :: String -> M.Map String [String] -> S.Set String +findReachable start deps = go (S.singleton start) (S.singleton start) + where + go visited frontier + | S.null frontier = visited + | otherwise = + let newNodes = S.fromList $ concatMap (\r -> fromMaybe [] (M.lookup r deps)) (S.toList frontier) + unvisited = newNodes `S.difference` visited + in go (visited `S.union` unvisited) unvisited + +-- | Check for left recursion +detectLeftRecursion :: DebugOptions -> NormalGrammar -> IO () +detectLeftRecursion opts grammar = do + debugSection opts "LEFT RECURSION CHECK" + + let sRuleGroups = getSyntaxRuleGroups grammar + leftRecursive = filter (isLeftRecursive sRuleGroups) sRuleGroups + + if null leftRecursive + then putStrLn " No left-recursive rules detected." + else do + putStrLn $ " Found " ++ show (length leftRecursive) ++ " potentially left-recursive rules:" + mapM_ (putStrLn . (" - " ++) . getSDataTypeName) leftRecursive + +-- | Check if a rule group is left-recursive +isLeftRecursive :: [SyntaxRuleGroup] -> SyntaxRuleGroup -> Bool +isLeftRecursive _ grp = + let ruleName = getSDataTypeName grp + firstSymbols = concatMap (getFirstSymbols . getSClause) (getSRules grp) + in ruleName `elem` firstSymbols + where + getFirstSymbols (STAltOfSeq seqs) = concatMap getFirstFromSeq seqs + getFirstSymbols (STMany _ sc _) = getFirstFromSimple sc + getFirstSymbols (STOpt _) = [] + getFirstFromSeq (STSeq _ []) = [] + getFirstFromSeq (STSeq _ (sc:_)) = getFirstFromSimple sc + getFirstFromSimple (SSId ruleId) = [ruleId] + getFirstFromSimple (SSLifted ruleId) = [ruleId] + getFirstFromSimple (SSIgnore _) = [] + +-- | Suggest shortcuts for common patterns +suggestGrammarShortcuts :: DebugOptions -> NormalGrammar -> IO () +suggestGrammarShortcuts opts grammar = do + debugSection opts "SHORTCUT SUGGESTIONS" + + let lRules = getLexicalRules grammar + stringLits = extractStringLiterals lRules + freq = countFrequencies stringLits + common = filter ((> 2) . snd) freq + + if null common + then putStrLn " No common patterns found for shortcuts." + else do + putStrLn " Common string literals (used > 2 times):" + mapM_ (\(s, n) -> putStrLn $ " - \"" ++ s ++ "\" (used " ++ show n ++ " times)") common + +-- | Count frequencies of elements +countFrequencies :: Eq a => [a] -> [(a, Int)] +countFrequencies xs = map (\x -> (x, length $ filter (== x) xs)) (nub xs) + +-- | Expand a rule by inlining all references +showExpandedRule :: DebugOptions -> NormalGrammar -> String -> IO () +showExpandedRule opts grammar ruleName = do + debugSection opts $ "EXPANDED RULE: " ++ ruleName + + let sRuleGroups = getSyntaxRuleGroups grammar + maybeGroup = lookup ruleName $ map (\g -> (getSDataTypeName g, g)) sRuleGroups + + case maybeGroup of + Nothing -> putStrLn $ " Rule '" ++ ruleName ++ "' not found." + Just grp -> do + putStrLn $ " Type: " ++ getSDataTypeName grp + putStrLn $ " Rules: " ++ show (length $ getSRules grp) + putStrLn "" + mapM_ (printExpandedSyntaxRule opts) (getSRules grp) + +-- | Show an expanded syntax rule +printExpandedSyntaxRule :: DebugOptions -> SyntaxRule -> IO () +printExpandedSyntaxRule _ (SyntaxRule name clause) = do + putStrLn $ " " ++ name ++ ":" + putStrLn $ ppShow clause + putStrLn "" + +------------------------------------------------------------------------------- +-- Performance profiling +------------------------------------------------------------------------------- + +-- | Timing information for a stage +data TimingInfo = TimingInfo + { stageName :: String + , startTime :: UTCTime + , endTime :: UTCTime + } deriving (Show) + +-- | Execute an action and time it +timed :: String -> IO a -> IO (a, TimingInfo) +timed name action = do + start <- getCurrentTime + result <- action + _ <- evaluate result -- Force evaluation + end <- getCurrentTime + return (result, TimingInfo name start end) + +-- | Force a value to normal form, using its 'Data' instance to reach every +-- subterm. WHNF alone is not enough for stage timings: laziness would defer +-- most of a stage's work into whichever later stage happens to demand it. +deepForce :: Data a => a -> a +deepForce x = go x `seq` x + where + go :: Data b => b -> () + go y = foldr seq () (gmapQ go y) + +-- | Show timing information +showTimingInfo :: DebugOptions -> [TimingInfo] -> IO () +showTimingInfo opts timings = do + debugSection opts "STAGE TIMING PROFILE" + + let totalTime = sum $ map (\t -> realToFrac $ diffUTCTime (endTime t) (startTime t)) timings + + putStrLn $ " Total time: " ++ formatTime totalTime + putStrLn "" + putStrLn " Stage breakdown:" + mapM_ (showSingleTiming opts) timings + where + formatTime :: Double -> String + formatTime t + | t < 0.001 = show (round $ t * 1000000 :: Integer) ++ "us" + | t < 1.0 = show (round $ t * 1000 :: Integer) ++ "ms" + | otherwise = show (round t :: Integer) ++ "s" + + showSingleTiming _ timing = do + let duration = realToFrac $ diffUTCTime (endTime timing) (startTime timing) + putStrLn $ " " ++ stageName timing ++ ": " ++ formatTime duration diff --git a/DebugOptions.hs b/DebugOptions.hs new file mode 100644 --- /dev/null +++ b/DebugOptions.hs @@ -0,0 +1,217 @@ +module DebugOptions + ( DebugOptions(..) + , DebugStage(..) + , parseOptions + , defaultDebugOptions + ) where + +import Options.Applicative + +-- | Compilation stages for selective debugging +data DebugStage = StageLex + | StageParse + | StageStringNorm + | StageClauseNorm + | StageFillNames + | StageGen + deriving (Eq, Show, Enum, Bounded) + +-- | All debugging options +data DebugOptions = DebugOptions + { -- Required arguments + grammarFile :: FilePath + , outputDir :: FilePath + + -- Front-end selection: by default the grammar is parsed with the + -- self-hosted front end (the lexer/parser RTK generated from + -- test-grammars/grammar.pg); --use-handwritten selects the hand-written + -- reference front end instead + , useGenerated :: Bool + + -- Pipeline stage inspection + , debugTokens :: Bool + , debugParse :: Bool + , debugStringNorm :: Bool + , debugClauseNorm :: Bool + , debugConstructors :: Bool + + -- Output stage inspection + , debugParserSpec :: Bool + , debugLexerSpec :: Bool + , debugQQSpec :: Bool + + -- Analysis and statistics + , showStats :: Bool + , analyzeConflicts :: Bool + , showRuleGraph :: Bool + , listRules :: Bool + + -- Selective debug + , debugRule :: Maybe String + , debugStage :: Maybe DebugStage + + -- Validation + , validateGrammar :: Bool + , showUnusedRules :: Bool + , checkLeftRecursion :: Bool + , suggestShortcuts :: Bool + , expandRule :: Maybe String + + -- Output format + , debugColor :: Bool + + -- Performance profiling + , profileStages :: Bool + } deriving (Eq, Show) + +-- | Default debug options (all disabled) +defaultDebugOptions :: FilePath -> FilePath -> DebugOptions +defaultDebugOptions file dir = DebugOptions + { grammarFile = file + , outputDir = dir + , useGenerated = True + , debugTokens = False + , debugParse = False + , debugStringNorm = False + , debugClauseNorm = False + , debugConstructors = False + , debugParserSpec = False + , debugLexerSpec = False + , debugQQSpec = False + , showStats = False + , analyzeConflicts = False + , showRuleGraph = False + , listRules = False + , debugRule = Nothing + , debugStage = Nothing + , validateGrammar = False + , showUnusedRules = False + , checkLeftRecursion = False + , suggestShortcuts = False + , expandRule = Nothing + , debugColor = True + , profileStages = False + } + +-- | Parse debug stage from string +parseStage :: String -> Maybe DebugStage +parseStage "lex" = Just StageLex +parseStage "parse" = Just StageParse +parseStage "string-norm" = Just StageStringNorm +parseStage "clause-norm" = Just StageClauseNorm +parseStage "fill-names" = Just StageFillNames +parseStage "gen" = Just StageGen +parseStage _ = Nothing + +-- | Command-line parser for debug options +debugOptionsParser :: Parser DebugOptions +debugOptionsParser = DebugOptions + <$> argument str + ( metavar "GRAMMAR_FILE" + <> help "Input grammar file" ) + <*> argument str + ( metavar "OUTPUT_DIR" + <> help "Output directory for generated files" ) + + -- Front-end selection: the self-hosted (generated) front end is the + -- default; --use-generated is kept as an accepted explicit choice + <*> ( flag' True + ( long "use-generated" + <> help "Parse the grammar with RTK's own generated lexer/parser (the default)" ) + <|> flag' False + ( long "use-handwritten" + <> help "Parse the grammar with the hand-written reference lexer/parser instead of the generated (default) front end" ) + <|> pure True ) + + -- Pipeline stage inspection + <*> switch + ( long "debug-tokens" + <> short 't' + <> help "Print tokens after lexical analysis" ) + <*> switch + ( long "debug-parse" + <> short 'p' + <> help "Print grammar after parsing" ) + <*> switch + ( long "debug-string-norm" + <> help "Print grammar before and after string normalization" ) + <*> switch + ( long "debug-clause-norm" + <> help "Print grammar after clause normalization" ) + <*> switch + ( long "debug-constructors" + <> short 'c' + <> help "Print grammar after constructor name generation" ) + + -- Output stage inspection + <*> switch + ( long "debug-parser-spec" + <> help "Print generated Happy parser specification" ) + <*> switch + ( long "debug-lexer-spec" + <> help "Print generated Alex lexer specification" ) + <*> switch + ( long "debug-qq-spec" + <> help "Print generated quasiquoter code" ) + + -- Analysis and statistics + <*> switch + ( long "stats" + <> short 's' + <> help "Print compilation statistics" ) + <*> switch + ( long "analyze-conflicts" + <> help "Analyze potential parser conflicts" ) + <*> switch + ( long "show-rule-graph" + <> help "Show dependency graph between rules" ) + <*> switch + ( long "list-rules" + <> help "List all rule names by category" ) + + -- Selective debug + <*> optional (strOption + ( long "debug-rule" + <> metavar "RULENAME" + <> help "Debug a specific rule through all stages" )) + <*> optional (option (maybeReader parseStage) + ( long "debug-stage" + <> metavar "STAGE" + <> help "Stop after a specific stage (lex|parse|string-norm|clause-norm|fill-names|gen)" )) + + -- Validation + <*> switch + ( long "validate-grammar" + <> help "Run validation checks without generating output" ) + <*> switch + ( long "unused-rules" + <> help "Find rules that are defined but never referenced" ) + <*> switch + ( long "check-left-recursion" + <> help "Detect left-recursive rules" ) + <*> switch + ( long "suggest-shortcuts" + <> help "Suggest common patterns for @shortcuts" ) + <*> optional (strOption + ( long "expand-rule" + <> metavar "RULENAME" + <> help "Show fully expanded form of a rule" )) + + -- Output format + <*> switch + ( long "debug-color" + <> help "Enable colored output (default: enabled)" ) + + -- Performance profiling + <*> switch + ( long "profile-stages" + <> help "Show timing for each compilation stage" ) + +-- | Parse command-line options +parseOptions :: IO DebugOptions +parseOptions = execParser opts + where + opts = info (debugOptionsParser <**> helper) + ( fullDesc + <> progDesc "RTK - Rewrite Toolkit for Grammar Development" + <> header "rtk - a grammar-to-parser compiler with comprehensive debugging" ) diff --git a/Diagnostics.hs b/Diagnostics.hs new file mode 100644 --- /dev/null +++ b/Diagnostics.hs @@ -0,0 +1,73 @@ +-- | Structured, user-facing diagnostics for the grammar-processing pipeline. +-- +-- Errors caused by a bad grammar are represented as 'Diagnostic' values that +-- are threaded through 'Either' instead of being thrown with 'error'. The +-- pipeline stages (lexing, parsing, normalization, code generation) return +-- @Either Diagnostic a@; the executable renders the diagnostic in GNU one-line +-- style and exits, so RTK never shows a Haskell exception for a user mistake. +-- +-- This module sits below the rest of the project (it imports nothing from it), +-- so 'SourcePos' lives here and both the lexer and the parser can refer to it. +module Diagnostics + ( SourcePos(..) + , showSourcePos + , Diagnostic(..) + , renderDiagnostic + , diagnosticFromPositioned + ) where + +import Data.Data (Data) + +-- | Position in the grammar source file (line and column, both 1-based). +data SourcePos = SourcePos { srcLine :: Int, srcColumn :: Int } + deriving (Eq, Ord, Show, Data) + +showSourcePos :: SourcePos -> String +showSourcePos (SourcePos line col) = "line " ++ show line ++ ", column " ++ show col + +-- | A user-facing diagnostic: an optional source position, optional context +-- (such as the rule being processed) and the message itself. +-- +-- The 'Data' instance lets @--profile-stages@ deep-force an @Either Diagnostic +-- a@ result like any other pipeline value. +data Diagnostic = Diagnostic + { diagPos :: Maybe SourcePos + , diagContext :: Maybe String -- ^ e.g. @"in rule 'Foo'"@ + , diagMessage :: String + } deriving (Eq, Show, Data) + +-- | Render a diagnostic in GNU one-line style: +-- +-- >>> renderDiagnostic "g.pg" (Diagnostic (Just (SourcePos 2 1)) (Just "in rule 'Foo'") "message") +-- "g.pg:2:1: error: in rule 'Foo': message" +-- +-- The position is omitted when unknown and the context when absent: +-- +-- >>> renderDiagnostic "g.pg" (Diagnostic Nothing Nothing "message") +-- "g.pg: error: message" +renderDiagnostic :: FilePath -> Diagnostic -> String +renderDiagnostic file (Diagnostic mpos mctx msg) = + file ++ posPart ++ ": error: " ++ ctxPart ++ msg + where + posPart = case mpos of + Just (SourcePos line col) -> ":" ++ show line ++ ":" ++ show col + Nothing -> "" + ctxPart = case mctx of + Just ctx -> ctx ++ ": " + Nothing -> "" + +-- | Recover a structured diagnostic from an error message that encodes its +-- position as @\"LINE:COL:message\"@ — the machine-splittable encoding shared +-- by the hand-written lexer and by every generated lexer and parser. Falls +-- back to a position-less diagnostic when the encoding is absent (e.g. an +-- internal alex error). +diagnosticFromPositioned :: String -> Diagnostic +diagnosticFromPositioned err = + case span (/= ':') err of + (l, ':' : rest1) | [(line, "")] <- reads l -> + case span (/= ':') rest1 of + (c, ':' : msg) | [(col, "")] <- reads c -> + Diagnostic (Just (SourcePos line col)) Nothing msg + _ -> noPos + _ -> noPos + where noPos = Diagnostic Nothing Nothing err diff --git a/GenAST.hs b/GenAST.hs new file mode 100644 --- /dev/null +++ b/GenAST.hs @@ -0,0 +1,150 @@ +module GenAST (genAST, isAntiConstructor) + where + +import Syntax +import Diagnostics (Diagnostic(..)) +import Text.PrettyPrint +import Grammar +import qualified Data.Map as Map +import qualified Data.List as List +import Data.Maybe (mapMaybe) + +-- Anti_* constructors are compile-time artifacts: they exist only so a +-- $Type:var quasi-quote splice has a constructor to reduce to, and they are +-- replaced by the spliced variable during Template Haskell expansion. They +-- never describe a source construct, so they are exempt from position +-- capture (no leading RtkPos field). The Anti_ naming convention is owned by +-- Normalize.addAntiRuleCached, which builds every such constructor name. +isAntiConstructor :: ConstructorName -> Bool +isAntiConstructor = List.isPrefixOf "Anti_" + +normalRulesNamed :: [SyntaxRuleGroup] -> [(ID, SyntaxTopClause)] +normalRulesNamed groups = map (\g -> (getSDataTypeName g, combineClauses $ map getSClause $ getSRules g)) + groups + +combineClauses :: [SyntaxTopClause] -> SyntaxTopClause +combineClauses [a] = a +combineClauses alts = STAltOfSeq $ deduplicateByConstructor $ concat $ map extractSeqs alts + where extractSeqs (STAltOfSeq seqs) = seqs + -- A multi-rule group is all-alternatives by construction + -- (postNormalizeGroup extracts everything else, and addStartGroup + -- never injects the wrapper rule into an alias group). Silently + -- dropping a repetition/option clause here is what used to emit a + -- data declaration whose parser actions still built lists - code + -- GHC rejects (issue #34) - so fail loudly if the invariant breaks. + extractSeqs c = error $ "rtk internal error: rule group mixes a" + ++ " repetition/option clause with alternatives: " ++ show c + -- Deduplicate alternatives with the same constructor name (e.g., Anti_Expression) + -- This is necessary for shared types where the same anti-alternative is added to multiple rules + deduplicateByConstructor seqs = List.nubBy sameConstructor seqs + sameConstructor (STSeq c1 _) (STSeq c2 _) = c1 == c2 + +type RulesMap = Map.Map ID ID + +rulesMap :: NormalGrammar -> RulesMap +rulesMap NormalGrammar{ getSyntaxRuleGroups = groups, getLexicalRules = lrules } = + Map.fromList $ concat + (mapMaybe lexRuleEntry lrules : + map (\ g -> map (\r -> (getSRuleName r, getSDataTypeName g)) $ getSRules g) groups) + +-- Macro rules are inlined into the lexer spec and carry no data type, so +-- they contribute nothing to the rules map. +lexRuleEntry :: LexicalRule -> Maybe (ID, ID) +lexRuleEntry LexicalRule{ getLRuleName = name, getLRuleDataType = dt } = Just (name, dt) +lexRuleEntry MacroRule{} = Nothing + +genAST :: NormalGrammar -> Either Diagnostic String +genAST grammar = do + docs <- mapM (genRule rules_map) (normalRulesNamed $ getSyntaxRuleGroups grammar) + return $ render $ vcat docs + where rules_map = rulesMap grammar + +genRule :: RulesMap -> (ID, SyntaxTopClause) -> Either Diagnostic Doc +genRule rmap (type_name, clause) = + case clause of + s@(STMany _ _ _) -> genType rmap type_name [s] + s@(STOpt _) -> genType rmap type_name [s] + (STAltOfSeq sequences) -> genData rmap type_name sequences + +genType :: RulesMap -> String -> [SyntaxTopClause] -> Either Diagnostic Doc +genType rmap name clauses = do + items <- mapM (genItem rmap name) clauses + return $ text "type" <+> text name <+> text "=" <+> hsep items + +needGenereateAlt :: STSeq -> Bool +needGenereateAlt (STSeq _ seqs) = not $ isClauseSeqLifted seqs + +genData :: RulesMap -> String -> [STSeq] -> Either Diagnostic Doc +genData rmap name sequences = do + ctors <- mapM (genConstructor rmap name) sequences' + return $ text "data" <+> text name <+> text "=" <+> (joinAlts ctors + $$ text "deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable)") + $$ genPosInstance name sequences' + where sequences' = filter needGenereateAlt sequences + +-- Every non-anti constructor stores its source position in its first field, +-- so projecting a node's position is one pattern match per constructor. +-- List and Maybe rules are type synonyms and are covered by the generic +-- [a]/Maybe instances emitted with the RtkPos definitions in GenY. +genPosInstance :: String -> [STSeq] -> Doc +genPosInstance name sequences = + text "instance RtkPosOf" <+> text name <+> text "where" + $$ nest 4 (vcat (map arm sequences)) + where arm (STSeq constructor clauses) = + let wildcards = hsep (replicate (fieldCount clauses) (text "_")) in + if isAntiConstructor constructor + then text "rtkPosOf" <+> parens (text constructor <+> wildcards) <+> text "= rtkNoPos" + else text "rtkPosOf" <+> parens (text constructor <+> text "p" <+> wildcards) <+> text "= p" + fieldCount = length . filter isField + isField SSId{} = True + isField _ = False + +genConstructor :: RulesMap -> String -> STSeq -> Either Diagnostic Doc +genConstructor rmap refType (STSeq constructor clauses) = do + items <- mapM (genSimpleItem rmap refType) clauses + let fields | isAntiConstructor constructor = items + | otherwise = text "RtkPos" : items + return $ text constructor <+> hsep fields + +genItem :: RulesMap -> String -> SyntaxTopClause -> Either Diagnostic Doc +genItem rmap refType (STMany _ cl _) = brackets <$> genSimpleItem rmap refType cl +genItem rmap refType (STOpt cl) = (\d -> parens (text "Maybe" <+> d)) <$> genSimpleItem rmap refType cl +genItem _ _ (STAltOfSeq _) = error "STAltOfSeq not supported in genItem" + +genSimpleItem :: RulesMap -> String -> SyntaxSimpleClause -> Either Diagnostic Doc +genSimpleItem rmap refType (SSId idName) = text <$> findRuleDataTypeName rmap refType idName +genSimpleItem _ _ (SSIgnore _) = Right empty +-- All-lifted alternatives are filtered out before constructor generation +-- (needGenereateAlt) and Normalize rejects every other lifted position, so a +-- lifted clause reaching this point is a pipeline bug, not a missing feature. +genSimpleItem _ _ (SSLifted _) = error "Internal error (GenAST): lifted clause survived normalization" + +-- A reference to an unknown rule is a user error; name both the unknown +-- rule and the type that references it. A bare type name resolves only via +-- a rule of the same name - hand-written, or the cover rtk synthesizes for +-- a type declared by syntax rule annotations (Normalize.synthesizeTypeCovers, +-- issue #14). What remains here is a name that is no rule and no such type: +-- a typo, or a lexical rule's value type ("T : tok = ..." declares the +-- token payload's Haskell type, not a referable syntax type), which the +-- rules map knows as a type and deserves the more specific message. +findRuleDataTypeName :: RulesMap -> String -> ID -> Either Diagnostic ID +findRuleDataTypeName rmap refType idName = case Map.lookup idName rmap of + Just r -> Right r + _ -> Left $ Diagnostic Nothing (Just ("in type '" ++ refType ++ "'")) message + where + message + | idName `elem` Map.elems rmap = + "reference to '" ++ idName ++ "', which is a type but not a rule:" + ++ " a type can be referenced by its bare name only when a rule of" + ++ " that name exists or some syntax rule declares the type ('" + ++ idName ++ " : SomeRule = ...', for which rtk synthesizes the" + ++ " cover rule '" ++ idName ++ "' automatically); a lexical rule's" + ++ " value type declares no such rule - reference the lexical rule" + ++ " itself instead" + | otherwise = + "reference to unknown rule '" ++ idName ++ "' (no rule of that name" + ++ " exists, and no syntax rule declares it as its type via '" + ++ idName ++ " : SomeRule = ...')" + +joinAlts :: [Doc] -> Doc +joinAlts alts = vcat $ punctuate (text " |") alts diff --git a/GenQ.hs b/GenQ.hs new file mode 100644 --- /dev/null +++ b/GenQ.hs @@ -0,0 +1,226 @@ +{-# LANGUAGE QuasiQuotes #-} +module GenQ (genQ) + where + +import Syntax +import Diagnostics (Diagnostic) +import qualified Data.Char as C +import qualified Data.Map as M +import Data.Maybe +import Data.List +import StrQuote + +sortNameToHaskellName :: String -> String +sortNameToHaskellName "import" = "__import" +sortNameToHaskellName "module" = "__module" +sortNameToHaskellName "type" = "__type" +sortNameToHaskellName "class" = "__class" +sortNameToHaskellName "deriving" = "__deriving" +sortNameToHaskellName s = s + +-- genQ has no user-reachable error paths today (its remaining guards are +-- internal invariants); the Either signature keeps it uniform with genX/genY. +genQ :: NormalGrammar -> Either Diagnostic String +genQ (NormalGrammar name rules _ antiRules shortcuts _ info) = Right [str|?banner +{-# LANGUAGE TemplateHaskell #-} +module ?name~QQ +where + +import qualified Data.Char as C +import qualified Data.Map as M +import Data.List +import Data.Maybe +import qualified Data.Generics as Generics +import qualified Data.Data as Data +import qualified Language.Haskell.TH as TH +import Language.Haskell.TH.Quote +import ?name~Lexer +import ?name~Parser + +qqShortcuts :: M.Map String String + +-- A $name metavariable is rewritten to $Type:name using the qqShortcuts +-- table below. The rewrite is purely textual, so it would also fire inside +-- the quoted language's own string literals: write $$name there to escape +-- it and get the literal text $name. Each '$$' pair directly before a +-- metavariable stands for one literal '$' (so $$$x is a literal '$' +-- followed by the metavariable $x). A '$' not followed by an identifier is +-- never rewritten and needs no escape, and an explicit $Type:name antiquote +-- (the character after the name is ':') passes through untouched. +-- A plain character scan rather than a regex: metavariables are recognized +-- regardless of what follows the name - including a newline or the end of +-- the quote, which the previous regex's terminator class missed. +replaceAllPatterns :: String -> Either String String +replaceAllPatterns [] = Right [] +replaceAllPatterns s@('$' : _) = + let (dollars, rest) = span (== '$') s + in case rest of + (c1 : _) | C.isAlpha c1 || c1 == '_' -> + let (varName, post) = span (\ ch -> C.isAlphaNum ch || ch == '_') rest + escCount = length dollars - 1 + keptPre = replicate (div escCount 2) '$' + in case post of + (':' : _) -> ((dollars ++ varName) ++) <$> replaceAllPatterns post + _ | odd escCount -> ((keptPre ++ '$' : varName) ++) <$> replaceAllPatterns post + _ -> case catMaybes $ map (\ prefix -> M.lookup prefix qqShortcuts) $ reverse $ inits varName of + [] -> Left $ unlines + [ "Unknown metavariable $" ++ varName ++ " in quasi-quote:" + , "no prefix of '" ++ varName ++ "' is a known shortcut. Known shortcuts:" + , " " ++ intercalate ", " (M.keys qqShortcuts) + , "To include the literal text $" ++ varName ++ " in the quoted code" + , "(e.g. inside a string literal), escape it as $$" ++ varName ++ "." ] + (rule : _) -> ((keptPre ++ '$' : rule ++ ":" ++ varName) ++) <$> replaceAllPatterns post + _ -> (dollars ++) <$> replaceAllPatterns rest +replaceAllPatterns (c : rest) = (c :) <$> replaceAllPatterns rest + +-- The generated lexer and parser encode error positions as "LINE:COL:message" +-- so structured-diagnostic callers can split them; render them back +-- human-readably for quasi-quote compile errors. Positions refer to the quote +-- body (padded with a start token in front). +rtkRenderError :: String -> String +rtkRenderError err = + case span (/= ':') err of + (l, ':' : rest1) | [(line, "")] <- (reads l :: [(Int, String)]) -> + case span (/= ':') rest1 of + (c, ':' : msg) | [(col, "")] <- (reads c :: [(Int, String)]) -> + "line " ++ show line ++ ", column " ++ show col ++ ": " ++ msg + _ -> err + _ -> err + +?qqShortCutsMapDef + +-- A quasi-quote pattern must match an AST parsed from anywhere in a source +-- file, while the pattern itself was parsed from the quote body - so every +-- RtkPos position field becomes a wildcard in generated patterns. +-- (Expressions need no special case: the compile-time position they embed +-- is equality-transparent.) +rtkPosWildPat :: RtkPos -> Maybe (TH.Q TH.Pat) +rtkPosWildPat _ = Just TH.wildP + +?(qqFunProtoGen expType) +?(qqFunImplGen expType) +?(qqFunProtoGen pat) +?(qqFunImplGen pat) +?antiFunsGenExp +?antiFunsGenPat + +-- This grammar's quasi-quoters work in expression and pattern contexts only +?qqFunType +?qqFunDecs + +?qqParseFuns +|] + where banner = provenanceBanner name + pat = "Pat" + expType = "Exp" + proxyRules = getProxyRules info + qqFunName typ = [str|quote?name~?typ|] + typeNames = map arQQName antiRules + antiNameGen typ n = "anti" ++ n ++ typ + antiTermGen typ = map (antiNameGen typ) typeNames + -- Patterns additionally wildcard every RtkPos field (see + -- rtkPosWildPat in the generated module) + extBase "Pat" = "const Nothing `Generics.extQ` rtkPosWildPat" + extBase _ = "const Nothing" + antiExprsGen typ = foldr (\antiTerm res -> [str|?res `Generics.extQ` ?antiTerm|]) (extBase typ) $ antiTermGen typ + antiFunsGen typ = map (\(AntiRule tdName qqName consName isList) -> + let antiName = antiNameGen typ qqName + varConstructor = case typ of + "Pat" -> "TH.varP" + "Exp" -> "TH.varE" + _ -> "TH.varE" -- default case + listPatGen = [str| +?antiName :: [ ?tdName ] -> Maybe (TH.Q TH.Pat) +?antiName [?consName v] = Just $ ?varConstructor (TH.mkName v) +?antiName _ = Nothing +|] + listExpGen = [str| +?antiName :: [ ?tdName ] -> Maybe (TH.Q TH.Exp) +?antiName ((?consName v):rest) = + let restExp = ?(dataToExpCall "Exp" "rest") + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |~] +?antiName _ = Nothing +|] + nonListGen = [str| +?antiName :: ?tdName -> Maybe (TH.Q TH.?typ ) +?antiName ( ?consName v) = Just $ ?varConstructor (TH.mkName v) +?antiName _ = Nothing +|] + in + if isList + then if typ == "Pat" + then listPatGen + else listExpGen + else nonListGen ) + antiRules + startRuleName = fromMaybe (error "Internal error (GenQ): start rule name is not set in grammar info") + (getStartRuleName info) + startTokenFor typeName = fromMaybe (error $ "Internal error (GenQ): no start token recorded for type '" ++ typeName ++ "'") + (M.lookup typeName $ getRuleToStartInfo info) + constructorFor typeName = fromMaybe (error $ "Internal error (GenQ): no start constructor found for type '" ++ typeName ++ "'") + (M.lookup typeName typeNameToConstructor) + qqFunProtoGen typ = [str|?(qqFunName typ) :: Data.Data a => String -> (?startRuleName -> a) -> String -> TH.?typ~Q|] + dataToExpCall typ var = [str| dataTo?typ~Q (?(antiExprsGen typ)) ?var|] + qqFunImplGen typ = [str|?(qqFunName typ ) dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parse?name of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast +|] ++ dataToExpCall typ "expr" + -- quoteType/quoteDec used to return dummies (TH.ListT / []), + -- silently compiling a quote in the wrong context into nonsense; + -- failing in TH.Q makes it a compile error at the splice site + qqFunType = qqFunName "Type" + ++ " _ = fail \"this quasi-quoter cannot be used in a type context\"" + qqFunDecs = qqFunName "Decs" + ++ " _ = fail \"this quasi-quoter cannot be used in a declaration context\"" + antiFunsGenExp = unlines $ antiFunsGen expType + antiFunsGenPat = unlines $ antiFunsGen pat + typeNameToConstructor = M.fromList $ map (\(STSeq cName lst) -> + case lst of + [_, SSId typeName, _] -> (typeName, cName) + _ -> ("", "")) + (case rules of + (firstRule:_) -> case getSRules firstRule of + (firstSRule:_) -> case getSClause firstSRule of + STAltOfSeq alts -> alts + _ -> [] + [] -> [] + [] -> []) + rulesWithoutProxies = filterProxyRules proxyRules rules + -- Only types wrapped by the synthesized start rule can have a + -- top-level quoter: quoting parses the dummy-padded fragment + -- through the start symbol and projects it back out by matching + -- the wrapper constructor. When the start group is a type alias + -- no wrappers exist (see Normalize.addStartGroup) and no quoters + -- are emitted; for a data start group every public type is + -- wrapped, so nothing is filtered. + quotableRules = filter ((`M.member` getRuleToStartInfo info) . getSDataTypeName) + rulesWithoutProxies + qqParseFuns = intercalate "\n" + $ map (\ruleGroup -> + case getSDataTypeName ruleGroup of + typeName@(s : rest) -> + let sortFunName = sortNameToHaskellName $ C.toLower s : rest + dummy = "\"" ++ startTokenFor typeName ++ "\"" + getFun = "get" ++ typeName + dataConstructor = constructorFor typeName + in + [str|?getFun ( ?dataConstructor _ s) = s + +?sortFunName :: QuasiQuoter +?sortFunName = QuasiQuoter (?(qqFunName expType) ?dummy ?getFun ) (?(qqFunName pat) ?dummy ?getFun ) ?(qqFunName "Type") ?(qqFunName "Decs") +|] + _ -> "") + quotableRules + shortCutTypes = map (\ruleGroup -> + case getSDataTypeName ruleGroup of + typeName@(s : rest) -> ((C.toLower s : rest), typeName) + _ -> ("", "")) + rulesWithoutProxies + qqShortCutsMapDef = "qqShortcuts = M.fromList [ " ++ (intercalate "," + (map (\(s, r) -> [str|("?s~","?r~")|]) + (shortCutTypes ++ shortcuts))) + ++ "]" diff --git a/GenX.hs b/GenX.hs new file mode 100644 --- /dev/null +++ b/GenX.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE QuasiQuotes #-} +module GenX (genX, isAlexEscape) + where + +import Syntax +import Diagnostics (Diagnostic(..)) +import Text.PrettyPrint hiding ((<>)) +import qualified Data.Set as S +import Data.Maybe (catMaybes) +import Grammar +import StrQuote + +getMacroIdsFromClause :: IClause -> S.Set String +getMacroIdsFromClause (IId s) = S.singleton s +getMacroIdsFromClause (IOpt clause) = getMacroIdsFromClause clause +getMacroIdsFromClause (IPlus clause _) = getMacroIdsFromClause clause +getMacroIdsFromClause (IStar clause _) = getMacroIdsFromClause clause +getMacroIdsFromClause (ISeq clauses) = S.unions $ map getMacroIdsFromClause clauses +getMacroIdsFromClause (IAlt clauses) = S.unions $ map getMacroIdsFromClause clauses +getMacroIdsFromClause _ = S.empty + +getMacroIdsHelper :: LexicalRule -> S.Set String +getMacroIdsHelper LexicalRule { getLClause = cl } = getMacroIdsFromClause cl +getMacroIdsHelper _ = S.empty + +getMacroIds :: [LexicalRule] -> S.Set String +getMacroIds lexRules = foldr (\lexRule result -> S.union result $ getMacroIdsHelper lexRule) S.empty lexRules + +getSymMacroIds :: [LexicalRule] -> S.Set String +getSymMacroIds lexRules = foldr (\lexRule result -> + case lexRule of + MacroRule { getLRuleName = name} -> + S.insert name result + _ -> result) + S.empty + lexRules + +-- The output lines are emitted in reverse token order, matching the original +-- foldl; keep it so the generated lexer is byte-for-byte unchanged. +genMacroText :: S.Set String -> S.Set String -> [LexicalRule] -> Either Diagnostic Doc +genMacroText sMacroIds macroIds tokens = do + docs <- mapM lineFor tokens + return $ vcat $ reverse $ catMaybes docs + where + lineFor (LexicalRule {getLRuleName = name, getLClause = cl}) + | name `S.member` macroIds = do + d <- translateClause name sMacroIds cl + return $ Just $ (text "@" <> text name) <+> text "=" <+> d + | otherwise = return Nothing + lineFor (MacroRule {getLRuleName = name, getLClause = cl}) = do + d <- translateClauseForMacro name cl + return $ Just $ (text "$" <> text name) <+> text "=" <+> d + +genX :: NormalGrammar -> Either Diagnostic String +genX (NormalGrammar { getNGrammarName = name, getLexicalRules = tokens, getNImports = imports}) = do + tokensText <- genTokens symMacroIds $ removeSymmacros tokens + macroText <- genMacroText symMacroIds macroIds tokens + return $ render $ vcat [ + header, + nl, + macroText, + nl, + tokensText, + nl, + footer + ] + where macroIds = getMacroIds tokens + symMacroIds = getSymMacroIds tokens + adt = genTokenADT $ removeSymmacros tokens + header = vcat [text (provenanceBanner name), + text "{", + text "{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}", + ((text "module" <+> text name) <> text "Lexer(scanTokens, alexScanTokens, Token(..), PosToken(..), AlexPosn(..))"), text "where", + text "import Data.Data (Data)", + text imports, text " }", + text "%wrapper \"monad\""] + funs_text = [str| +-- AlexPosn is defined by the alex wrapper, so the Data instance (required by +-- the parser's RtkPos position type) can only be attached via standalone +-- deriving - the same solution as the hand-written Lexer.x +deriving instance Data AlexPosn + +-- A token together with the source position where it starts +data PosToken = PosToken { ptPos :: AlexPosn, ptToken :: Token } + deriving (Show) + +alexEOF = do + (pos, _, _, _) <- alexGetInput + return $ PosToken pos EndOfFile + +-- Lex the input into a token stream, returning the positioned error message +-- on a lexical error (encoded as "LINE:COL:message", see rtkError below). +-- The returned list always ends with an EndOfFile token that carries the +-- position of the end of input, so parse errors at end of input can be +-- reported with a position too +scanTokens :: String -> Either String [PosToken] +scanTokens str = runAlex str $ do + let loop toks = do tok <- alexMonadScan + case tok of + PosToken _ EndOfFile -> return $ reverse (tok : toks) + _ -> let toks' = tok : toks + in toks' `seq` loop toks' + loop [] + +-- Thin compatibility wrapper: callers that have not switched to 'scanTokens' +-- get the error message thrown instead +alexScanTokens :: String -> [PosToken] +alexScanTokens str = + case scanTokens str of + Right toks -> toks + Left err -> errorWithoutStackTrace err + +simple1 :: (String -> Token) -> AlexInput -> Int -> Alex PosToken +simple1 t (pos, _, _, str) len = return $ PosToken pos (t (take len str)) + +simple :: Token -> AlexInput -> Int -> Alex PosToken +simple t (pos, _, _, _) len = return $ PosToken pos t + +-- Encode the position as "LINE:COL:message" so callers can split it back out +-- into a structured position - the same encoding the rtk grammar lexer uses +rtkError ((AlexPn _ line column), _, _, str) len = alexError $ (show line) ++ ":" ++ (show column) ++ ":lexical error. Following chars: " ++ (take 10 str) +|] + funs = text funs_text + footer = vcat [text "{", adt, funs , text "}"] + nl = text "" + +genTokenADT :: [LexicalRule] -> Doc +genTokenADT lexical_rules = text "data" <+> text "Token" <+> text "=" <+> (joinAlts (text "EndOfFile" : (map makeToken lexical_rules)) $$ text "deriving (Show)") + where makeToken LexicalRule { getLRuleDataType = data_type, getLRuleName = name } = + let token_name = text $ tokenName name in + case data_type of + "Keyword" -> token_name + "Ignore" -> empty + _ -> token_name <+> text data_type + makeToken (MacroRule _ _) = empty + +genTokens :: S.Set String -> [LexicalRule] -> Either Diagnostic Doc +genTokens smacroIds lexical_rules = do + toks <- mapM makeToken lexical_rules + return $ text "tokens" <+> text ":-" <+> vcat (toks ++ [text ". { rtkError }"]) + where makeToken LexicalRule { getLRuleDataType = data_type, getLRuleFunc = func, getLRuleName = name, getLClause = cl } = do + cld <- translateClause name smacroIds cl + return $ cld <+> makeProduction name data_type func + makeToken (MacroRule _ _) = return empty + makeProduction name data_type func = + let token_name = text $ tokenName name in + case data_type of + "Keyword" -> text "{ simple" <+> token_name <+> text "}" + "Ignore" -> text ";" + _ -> text "{ simple1 $ " <+> token_name <+> text "." <+> (parens $ text func) <+> text "}" + +backquoteStr :: String -> String +backquoteStr s = concat (map (\chr -> if (case chr of + '"' -> True + _ -> False) + then ['\\', chr] + else [chr] ) + s) + +-- Escape the characters that are special in Alex set syntax ([...]). A +-- literal backslash is special too and must become \\: it used to pass +-- through raw, where Alex reads it as an escape, so a backslash silently +-- changed the meaning of its class and users resorted to the [\x5C] hex +-- spelling (issue #95). The exception: token post-processing +-- (TokenProcessing.unBackQuote) keeps the \n \t \r \f \v escape pairs +-- intact in regex content, so a backslash heading one of those pairs +-- stands for the control character and passes through for Alex to read +-- the same way. +backquoteStrInBrackets :: String -> String +backquoteStrInBrackets ('\\' : c : rest) + | isAlexEscape ['\\', c] = '\\' : c : backquoteStrInBrackets rest +backquoteStrInBrackets (chr : rest) = escaped ++ backquoteStrInBrackets rest + where escaped | chr `elem` "[]() */{}$\"\\" = ['\\', chr] + | otherwise = [chr] +backquoteStrInBrackets [] = [] + +-- Report a lexical-rule generation error, naming the rule for context. +lexErr :: ID -> String -> Either Diagnostic a +lexErr rname msg = Left $ Diagnostic Nothing (Just ("in lexical rule '" ++ rname ++ "'")) msg + +translateClauseForMacro :: ID -> IClause -> Either Diagnostic Doc +translateClauseForMacro _ (IStrLit s) = Right $ text s +translateClauseForMacro _ (IRegExpLit re) = Right $ brackets $ text $ backquoteStrInBrackets re +translateClauseForMacro rname (ISeq cls) = do + ds <- mapM (translateClauseForMacro rname) cls + return $ hsep $ punctuate (text " ") ds +translateClauseForMacro rname (IAlt clauses) = do + ds <- mapM (translateClauseForMacro rname) clauses + return $ hsep $ punctuate (text "|") ds +translateClauseForMacro rname cl = lexErr rname $ "cannot translate clause to a lexer macro definition: " ++ showClause cl + +-- Detect Alex escape sequences that should be output as bare escapes, not quoted strings. +-- In Alex: "\n" = literal backslash+n, but \n = newline character. +-- When grammar has '\n', we want to generate \n (the escape), not "\n" (literal). +-- This set must stay identical to the escapes TokenProcessing.unBackQuote +-- preserves, or escapes get silently stripped before they reach this point. +isAlexEscape :: String -> Bool +isAlexEscape "\\n" = True -- newline +isAlexEscape "\\t" = True -- tab +isAlexEscape "\\r" = True -- carriage return +isAlexEscape "\\f" = True -- form feed +isAlexEscape "\\v" = True -- vertical tab +isAlexEscape _ = False + +translateClause :: ID -> S.Set ID -> IClause -> Either Diagnostic Doc +translateClause _ sMacroIds (IId name) | name `S.member` sMacroIds = + Right $ text "$" <> text name +translateClause _ _ (IId name) = + Right $ text "@" <> text name +translateClause _ _ (IStrLit s) + | isAlexEscape s = Right $ text s -- output bare escape: \n, \t, etc. + | otherwise = Right $ doubleQuotes $ text $ backquoteStr s +translateClause _ _ (IDot) = Right $ text "." +translateClause _ _ (IRegExpLit re) = Right $ brackets $ text $ backquoteStrInBrackets re +translateClause rname sMacroIds (IStar cl Nothing) = (<> text "*") <$> translateClause rname sMacroIds cl +-- a* ~x --> (a(x a)*)? +translateClause rname _ (IStar _ (Just _)) = lexErr rname "star (*) clauses with delimiters (~) are not supported in lexical rules" +translateClause rname sMacroIds (IPlus cl Nothing) = (<> text "+") <$> translateClause rname sMacroIds cl +translateClause rname _ (IPlus _ (Just _)) = lexErr rname "plus (+) clauses with delimiters (~) are not supported in lexical rules" +translateClause rname sMacroIds (IAlt clauses) = do + ds <- mapM (translateClause rname sMacroIds) clauses + return $ parens $ hsep $ punctuate (text "|") ds +translateClause rname sMacroIds (ISeq clauses) = do + ds <- mapM (translateClause rname sMacroIds) clauses + return $ hsep $ punctuate (text " ") ds +translateClause rname sMacroIds (IOpt clause) = (<+> text "?") <$> translateClause rname sMacroIds clause +translateClause rname _ cl = lexErr rname $ "cannot translate clause to lexer spec: " ++ showClause cl + +joinAlts :: [Doc] -> Doc +joinAlts alts = vcat $ punctuate (text " |") (filter (not.isEmpty) alts) diff --git a/GenY.hs b/GenY.hs new file mode 100644 --- /dev/null +++ b/GenY.hs @@ -0,0 +1,274 @@ +{-# LANGUAGE QuasiQuotes #-} +module GenY (genY) + where + +import Syntax +import Diagnostics (Diagnostic) +import Text.PrettyPrint hiding ((<>)) +import qualified Data.List as List +import qualified Data.Set as Set +import GenAST +import Grammar +import StrQuote + +genY :: NormalGrammar -> Either Diagnostic String +genY g@(NormalGrammar name srules lex_rules _ _ _ _) = do + ast <- genAST g + return $ render $ vcat [ + text header, + nl, + text "%name parse" <> text name, + text "%tokentype { L.PosToken }", + text "%monad { Either String }", + text "%error { parseError }", + nl, + text "%token", + nl, + lexDoc, + nl, + text "%%", + nl, + rulesDoc, + nl, + text (footer ast) + ] + where normal_rules = normalRules srules + listRuleSet = makeListRuleSet normal_rules + payloadTokens = makePayloadTokenSet lex_rules + -- The start rule is wrapped so that the parser consumes the + -- EndOfFile token emitted by the lexer; this way errors at end of + -- input are reported by parseError with a real source position. + -- A list-typed start rule (alias start group, "Start = Item* ;") + -- carries its list reversed like every list nonterminal does, so + -- the wrapper restores source order just like any other consumer + startWrapper = case normal_rules of + (r : _) -> [(text (name ++ "__top") <+> text ":" <+> text (getSRuleName r) + <+> text "rtk__eof" <+> text "{" <+> topResult r <+> text "}") <> text "\n"] + [] -> [] + topResult r | Set.member (getSRuleName r) listRuleSet = text "(reverse $1)" + | otherwise = text "$1" + rulesDoc = vcat (startWrapper ++ map (genRule listRuleSet payloadTokens) normal_rules) + lexDoc = vcat (combineAlt (text "rtk__eof") (text "L.PosToken _ L.EndOfFile") + : map genToken (removeSymmacros lex_rules)) + nl = text "" + header = provenanceBanner name ++ "\n\ + \{\n\ + \{-# LANGUAGE DeriveDataTypeable #-}\n\ + \module " ++ name ++ "Parser where\n\ + \import qualified Data.Generics as Gen\n\ + \import qualified " ++ name ++ "Lexer as L (Token(..), PosToken(..), AlexPosn(..), alexScanTokens)\n\ + \}" + -- The position is encoded as "LINE:COL:message" so callers can + -- split it back out into a structured position - the same encoding + -- the generated lexer's rtkError uses + parseErrorDefs = "parseError :: [L.PosToken] -> Either String a\n\ + \parseError [] = Left \"unexpected end of input\"\n\ + \parseError (L.PosToken (L.AlexPn _ line col) tok : _) =\n\ + \ Left $ show line ++ \":\" ++ show col ++ \":unexpected \" ++ showRtkToken tok\n" + showTokenDefs = render $ vcat (text "-- Render a token the way it appears in the source, for error messages" + : text "showRtkToken :: L.Token -> String" + : text "showRtkToken L.EndOfFile = \"end of input\"" + : map genShowToken (removeSymmacros lex_rules)) + posDefs = genPosDefs lex_rules + tkValDefs = render $ vcat (text "-- Recover a token's payload from the whole positioned token: %token" + : text "-- bindings keep the L.PosToken so semantic actions can read its position" + : map genTkVal (removeSymmacros lex_rules)) + footer ast = "{\n" ++ parseErrorDefs ++ "\n" ++ showTokenDefs ++ "\n\n" ++ posDefs + ++ "\n" ++ tkValDefs ++ "\n\n" ++ ast ++ "\n}" + +type ListRuleSet = Set.Set ID + +makeListRuleSet :: [SyntaxRule] -> ListRuleSet +makeListRuleSet lst = Set.fromList $ map getSRuleName $ filter isMany lst + where isMany (SyntaxRule { getSClause = STMany{} }) = True + isMany _ = False + +-- The tokens that carry a payload (everything except keywords, which are +-- their own value, and ignored tokens, which never reach the parser). +-- References to them in semantic actions go through a tkVal_* extractor. +type PayloadTokenSet = Set.Set ID + +makePayloadTokenSet :: [LexicalRule] -> PayloadTokenSet +makePayloadTokenSet lst = Set.fromList [ name | LexicalRule{ getLRuleName = name, getLRuleDataType = dt } <- lst + , not (dt == "Keyword" || dt == "Ignore") ] + +-- The RtkPos machinery shared by all generated parsers, plus one dummy +-- RtkPosOf instance per non-String token payload type (String is covered by +-- the Char instance through [a]); a list or optional rule over such a token +-- is a type synonym, and projecting its position goes through the payload. +genPosDefs :: [LexicalRule] -> String +genPosDefs lex_rules = + [str|-- Source position of a node: every constructor except the Anti_* splice +-- artifacts stores the position of its alternative's first symbol in its +-- first field. Positions are transparent for equality and ordering, so two +-- ASTs that differ only in source positions (e.g. a quasi-quote parsed at +-- compile time vs the same construct parsed at run time) compare equal. +newtype RtkPos = RtkPos L.AlexPosn deriving (Show, Gen.Data, Gen.Typeable) +instance Eq RtkPos where _ == _ = True +instance Ord RtkPos where compare _ _ = EQ + +-- The position used where no source token exists: empty productions, empty +-- lists, absent optionals and Anti_* quasi-quote splices +rtkNoPos :: RtkPos +rtkNoPos = RtkPos (L.AlexPn 0 0 0) + +class RtkPosOf a where + rtkPosOf :: a -> RtkPos +instance RtkPosOf L.PosToken where + rtkPosOf (L.PosToken p _) = RtkPos p +instance RtkPosOf a => RtkPosOf [a] where + rtkPosOf (x : _) = rtkPosOf x + rtkPosOf [] = rtkNoPos +instance RtkPosOf a => RtkPosOf (Maybe a) where + rtkPosOf (Just x) = rtkPosOf x + rtkPosOf Nothing = rtkNoPos +-- A Char carries no position; this also covers String token payloads +instance RtkPosOf Char where + rtkPosOf _ = rtkNoPos +|] ++ payloadInstances + where payloadInstances = + concat [ "instance RtkPosOf " ++ dt ++ " where rtkPosOf _ = rtkNoPos\n" + | dt <- List.nub [ dt | LexicalRule{ getLRuleDataType = dt } <- lex_rules ] + , dt `notElem` ["Keyword", "Ignore", "String", "Char"] ] + +genToken :: LexicalRule -> Doc +genToken LexicalRule{ getLRuleName = name, getLRuleDataType = dtn } = + case dtn of + "Keyword" -> combineAlt (text name) (text "L.PosToken _ L." <> text (tokenName name)) + "Ignore" -> empty + -- payload tokens bind the whole positioned token (not a $$ + -- projection), so semantic actions can take their position; the + -- payload is recovered with the tkVal_* extractor at the use site + _ -> combineAlt (text name) (text "L.PosToken _ (L." <> text (tokenName name) <> text " _)") +genToken (MacroRule _ _) = empty + +genTkVal :: LexicalRule -> Doc +genTkVal LexicalRule{ getLRuleName = name, getLRuleDataType = dtn } = + case dtn of + "Keyword" -> empty + "Ignore" -> empty + _ -> vcat [ text ("tkVal_" ++ name ++ " :: L.PosToken -> " ++ dtn) + , text ("tkVal_" ++ name ++ " (L.PosToken _ (L." ++ tokenName name ++ " v)) = v") + , text ("tkVal_" ++ name ++ " t = error (\"rtk internal error: token " + ++ name ++ " expected, got \" ++ showRtkToken (L.ptToken t))") + ] +genTkVal (MacroRule _ _) = empty + +genShowToken :: LexicalRule -> Doc +genShowToken LexicalRule{ getLRuleName = name, getLRuleDataType = dtn, getLClause = cl } = + case dtn of + "Ignore" -> empty + "Keyword" -> (text "showRtkToken L." <> text (tokenName name)) <+> text "=" <+> text (show (keywordText cl)) + _ -> (text "showRtkToken (L." <> text (tokenName name)) <+> text "v) =" <+> text (show (name ++ " ")) <+> text "++ show v" + where keywordText (IStrLit s) = "'" ++ s ++ "'" + keywordText _ = name +genShowToken (MacroRule _ _) = empty + +genRule :: ListRuleSet -> PayloadTokenSet -> SyntaxRule -> Doc +-- * with separator can only be expressed using two rules in LR grammar +-- Will do it here +genRule lrs toks SyntaxRule{ getSClause = (STMany STStar cl (Just cl1)), getSRuleName = name } = + let lstName = name ++ "__plus_list_" + in + vcat [ + ((text lstName) <+> (text ":") <+> (genTopClause lrs toks lstName + (STMany STPlus cl (Just cl1)))) <> text "\n", + ((text name) <+> (text ":") <+> (genOptPlusClause lstName)) <> text "\n" + ] + + +genRule lrs toks SyntaxRule{ getSClause = cl, getSRuleName = name } = + ((text name) <+> (text ":") <+> (genTopClause lrs toks name cl)) <> text "\n" + +genTopClause :: ListRuleSet -> PayloadTokenSet -> String -> SyntaxTopClause -> Doc + +-- Ignore is not expected in the cl +genTopClause _ toks rn (STMany op cl Nothing) = joinAlts [base, step] + where (baseAlt,alt) = case op of + STStar -> (text "[]", emptyAlt) + STPlus -> (brackets (clRef 1), clDoc) + base = combineAlt alt baseAlt + step = combineAlt (text rn <+> clDoc) (clRef 2 <+> text ": $1") + clDoc = genSimpleClause cl + clRef = tokenAwareRef toks cl + +genTopClause _ toks rn (STMany STPlus cl (Just cl1)) = joinAlts [base, step] + where base = combineAlt clDoc (brackets (clRef 1)) + step = combineAlt (text rn <+> genSimpleClause cl1 <+> clDoc) (clRef 3 <+> text ": $1") + clDoc = genSimpleClause cl + clRef = tokenAwareRef toks cl + +genTopClause _ _ _ (STMany STStar _ (Just _)) = error "STMany with STStar and separator not supported in this position" + +genTopClause lrs toks _ (STOpt cl) = joinAlts [present, not_present] + where present = combineAlt (genSimpleClause cl) + (text "Just" <+> constructor_call) + constructor_call = hsep $ enumClauses lrs toks [cl] + not_present = combineAlt emptyAlt (text "Nothing") + +genTopClause lrs toks _ (STAltOfSeq clauses) = joinAlts $ map (genClauseSeq lrs toks) clauses + +genOptPlusClause :: String -> Doc +genOptPlusClause lstName = joinAlts [present, not_present] + where present = combineAlt (text lstName) + (text "$1") + not_present = combineAlt emptyAlt (text "[]") + +genClauseSeq :: ListRuleSet -> PayloadTokenSet -> STSeq -> Doc +genClauseSeq lrs toks (STSeq _ clauses) | isClauseSeqLifted clauses = combineAlt rule production + where rule = hsep (map genSimpleClause clauses) + production = hsep $ (enumClauses lrs toks clauses) +genClauseSeq lrs toks (STSeq constructor clauses) = combineAlt rule production + where rule = hsep (map genSimpleClause clauses) + production = hsep $ (text constructor) : posArgs ++ (enumClauses lrs toks clauses) + -- Anti_* constructors are quasi-quote splice artifacts and carry + -- no position field (see GenAST.isAntiConstructor) + posArgs | isAntiConstructor constructor = [] + | otherwise = [posOfFirst lrs clauses] + +-- The position of an alternative's first symbol - token or nonterminal, +-- ignored or not (every symbol stays $n-addressable in happy actions). List +-- rules build their lists reversed, so the source-order head is at the end. +-- An empty alternative has no symbols and gets the dummy position. +posOfFirst :: ListRuleSet -> [SyntaxSimpleClause] -> Doc +posOfFirst _ [] = text "rtkNoPos" +posOfFirst lrs (cl : _) + | Set.member (getSID cl) lrs = text "(rtkPosOf (reverse $1))" + | otherwise = text "(rtkPosOf $1)" + +genSimpleClause :: SyntaxSimpleClause -> Doc +-- TODO: check whether reverse is needed (monad again) (switch to left recursion) +genSimpleClause (SSId idName) = text idName +genSimpleClause (SSIgnore idName) = text idName + -- TODO: no lifted yet, need monad with rules map here +genSimpleClause (SSLifted idName) = text idName + +-- A reference to symbol $n of a production: payload tokens go through their +-- tkVal_* extractor, everything else is the plain happy attribute. +tokenAwareRef :: PayloadTokenSet -> SyntaxSimpleClause -> Int -> Doc +tokenAwareRef toks cl n + | Set.member (getSID cl) toks = parens (text ("tkVal_" ++ getSID cl) <+> (text "$" <> int n)) + | otherwise = text "$" <> int n + +enumClauses :: ListRuleSet -> PayloadTokenSet -> [SyntaxSimpleClause] -> [Doc] +enumClauses lrs toks cls = f cls 1 [] + where f (ssc:rest) count acc | isNotIgnored ssc = f rest (count + 1) (ref ssc count : acc) + f (_: rest) count acc = f rest (count + 1) acc + f [] _ acc = reverse acc + ref ssc count | Set.member (getSID ssc) lrs = text "(reverse $" <> int count <> text ")" + | otherwise = tokenAwareRef toks ssc count + +getSID :: SyntaxSimpleClause -> ID +getSID (SSId n) = n +getSID (SSLifted n) = n +getSID (SSIgnore n) = n + +emptyAlt :: Doc +emptyAlt = text "{- empty -}" + +joinAlts :: [Doc] -> Doc +joinAlts alts = vcat $ punctuate (text " |") alts + +combineAlt :: Doc -> Doc -> Doc +combineAlt rule production = rule <+> text "{" <+> production <+> text "}" + diff --git a/Grammar.hs b/Grammar.hs new file mode 100644 --- /dev/null +++ b/Grammar.hs @@ -0,0 +1,29 @@ +module Grammar where + +import Syntax + +normalRules :: [SyntaxRuleGroup] -> [SyntaxRule] +normalRules groups = concat $ map getSRules groups + +tokenName :: String -> String +tokenName name = "Tk__" ++ name + +isClauseSeqLifted :: [SyntaxSimpleClause] -> Bool +isClauseSeqLifted sseq = case filter isNotIgnored sseq of + [SSLifted{}] -> True + _ -> if any isLifted sseq + then error $ "Lifted rule cannot be in the sequence" ++ show sseq + else False + where isLifted SSLifted{} = True + isLifted _ = False +isNotIgnored :: SyntaxSimpleClause -> Bool +isNotIgnored SSId{} = True +isNotIgnored SSLifted{} = True +isNotIgnored _ = False + +isSymmacro :: LexicalRule -> Bool +isSymmacro (MacroRule _ _) = True +isSymmacro _ = False + +removeSymmacros :: [LexicalRule] -> [LexicalRule] +removeSymmacros lst = filter (not . isSymmacro) lst diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +MIT License + +Copyright (c) 2025 prozak + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. + +--- + +Note on Generated Code: + +Code generated by RTK (lexers, parsers, and quasi-quotation modules) is not +subject to this license. You are free to use, license, and distribute the +generated code under any terms you choose, including proprietary licenses. diff --git a/Lexer.x b/Lexer.x new file mode 100644 --- /dev/null +++ b/Lexer.x @@ -0,0 +1,155 @@ +{ +module Lexer where + +import Data.Data (Data) +import Diagnostics (Diagnostic, diagnosticFromPositioned, renderDiagnostic) +} + +%wrapper "monadUserState" + +$digit = 0-9 +$alpha = [a-zA-Z] +$alphaDigit = [a-zA-Z0-9] +$dq = " +$squote = ' +$notsq = [^'] +$notdq = [^"] +$litsym = [^"] + +tokens:- + + $white+ { skip } + "#".* { skip } + <0>"/*" { beginMultiLineComment } + "/*" { beginMultiLineComment } + "*/" { tryEndMultiLineComment } + ([^\*\/]|[\*][^\/]|[\/][^\*])* { skip } + grammar { simple Grammar } + imports { simple Imports } + "@shortcuts" { simple Shortcuts } + "@symmacro" { simple Symmacro } + "=" { simple Eq } + ";" { simple RlEnd } + ":" { simple Colon } + "|" { simple OrClause } + "." { simple Dot } + "?" { simple Question } + "," { simple Comma } + "!" { simple Excl } + "~" { simple Tilde } + "$" { simple Dollar } + ")" { simple RParen } + "(" { simple LParen } + $squote ($notsq | "\'")* $squote { simple1 $ StrLit . (reverse.drop 1.reverse.drop 1) } + "[" ([^\]]|"\]")* "]" { simple1 $ RegExpLit . (reverse.drop 1.reverse.drop 1) } + "*" { simple Star } + "+" { simple Plus } + $alpha $alphaDigit* { simple1 Id } + $dq $dq $dq ($notdq|$dq $notdq | $dq $dq $notdq | [\n])* $dq $dq $dq { simple1 $ BigStr . (reverse.(drop 3).reverse.(drop 3))} + . { rtkError } + +{ + +getStateCommentDepth = Alex $ \s@AlexState{alex_ust=ust} -> Right (s, getCommentDepth ust) +setStateCommentDepth i = Alex $ \s@AlexState{alex_ust=ust} -> Right (s{alex_ust=ust{getCommentDepth = i}}, ()) + +beginMultiLineComment :: AlexInput -> Int -> Alex PosToken +beginMultiLineComment alexInput i = + do + commentDepth <- getStateCommentDepth + setStateCommentDepth $ commentDepth + 1 + alexSetStartCode mlcomment + skip alexInput i + +tryEndMultiLineComment :: AlexInput -> Int -> Alex PosToken +tryEndMultiLineComment alexInput i = + do + commentDepth <- getStateCommentDepth + setStateCommentDepth $ commentDepth - 1 + if (commentDepth - 1 == 0) + then + do + alexSetStartCode 0 + skip alexInput i + else + skip alexInput i + +data AlexUserState = AlexUserState {getCommentDepth :: Integer} + +alexInitUserState = AlexUserState { getCommentDepth = 0 } + +data Token = Grammar + | Imports + | Eq + | RlEnd + | OrClause + | Dot + | RegExpLit String + | StrLit String + | BigStr String + | Id String + | Star + | Plus + | Excl + | Comma + | RParen + | LParen + | Dollar + | Question + | Colon + | Tilde + | Shortcuts + | Symmacro + | EndOfFile + deriving (Eq, Show, Data) + +-- AlexPosn is defined by the alex wrapper, so a Data instance can only be +-- attached via standalone deriving; profiling deep-forces token lists +-- through it (see Debug.deepForce) +deriving instance Data AlexPosn + +-- A token together with the source position where it starts +data PosToken = PosToken { ptPos :: AlexPosn, ptToken :: Token } + deriving (Eq, Show, Data) + +-- Lex the input into a token stream, returning a structured diagnostic on a +-- lexical error. The returned list always ends with an EndOfFile token that +-- carries the position of the end of input, so parse errors at end of input +-- can be reported with a position too. +-- rtkError encodes the error position as "LINE:COL:message"; +-- diagnosticFromPositioned recovers it so the diagnostic carries a real +-- SourcePos. +scanTokens :: String -> Either Diagnostic [PosToken] +scanTokens str = + case alexScanTokens1 str of + Right toks -> Right toks + Left err -> Left (diagnosticFromPositioned err) + +-- Thin wrapper kept during the migration to structured diagnostics: callers +-- that have not yet switched to 'scanTokens' get the rendered message thrown. +alexScanTokens :: String -> [PosToken] +alexScanTokens str = either (errorWithoutStackTrace . renderDiagnostic "") id (scanTokens str) + +alexScanTokens1 str = runAlex str $ do + let loop toks = do tok <- alexMonadScan + case tok of + PosToken _ EndOfFile -> return $ reverse (tok : toks) + _ -> let toks' = tok : toks + in toks' `seq` loop toks' + loop [] + +alexEOF = do + (pos, _, _, _) <- alexGetInput + return $ PosToken pos EndOfFile + +-- Encode the position as "LINE:COL:message" so scanTokens can split it back +-- out into a SourcePos for the diagnostic. +rtkError ((AlexPn _ line column), _, _, str) _ = alexError $ (show line) ++ ":" ++ (show column) ++ ":lexical error. Following chars: " ++ (take 10 str) + +simple1 :: (String -> Token) -> AlexInput -> Int -> Alex PosToken +simple1 t (pos, _, _, str) len = return $ PosToken pos (t (take len str)) + +simple :: Token -> AlexInput -> Int -> Alex PosToken +simple t (pos, _, _, _) _ = return $ PosToken pos t + +} diff --git a/Normalize.hs b/Normalize.hs new file mode 100644 --- /dev/null +++ b/Normalize.hs @@ -0,0 +1,792 @@ +{-# LANGUAGE TemplateHaskell #-} +module Normalize(normalizeTopLevelClauses, fillConstructorNames) + where + +import Syntax +import Diagnostics (Diagnostic(..), showSourcePos) +import Grammar (isNotIgnored) +import Data.Generics +import Data.Maybe +import qualified Data.Map as M +import qualified Data.List as L +import qualified Data.Set as S +import Control.Lens + +import Control.Monad.State.Strict hiding (lift) +import Control.Monad.State.Strict (lift) + +-- In the normal form top level clause of the non-lexical rule can be the following: +-- 1. simple_clause * +-- 2. simple_clause + +-- 3. simple_clause ? +-- 4. Seq [simple_clause] +-- 5. alternative of sequences of simple_clause +-- +-- simple_clause is one of the following: +-- 1. id +-- 2. Ignore simple_clause +-- 3. Lifted id + +data NormalizationState = NormalizationState { + _normSRules :: M.Map ID [SyntaxRule], + _normLRules :: [LexicalRule], + _nameCounter :: Int, + _normAntiRules :: [AntiRule], + _normShortcuts :: [(String, String)], + _proxyRuleNames :: S.Set ID, + _qqLexRuleCache :: M.Map ID ID, + _antiRuleCache :: M.Map ID ID, + _ruleToTypeName :: M.Map ID ID, + -- type name -> rules that receive the $Type:var + -- splice alternative (see computeQQAttachPoints) + _qqAttachPoints :: M.Map ID (S.Set ID), + _currentRule :: Maybe IRule + } + +$(makeLenses ''NormalizationState) + +-- Normalization can fail with a structured Diagnostic, carried in the Either +-- under the state transformer. +type Normalization a = StateT NormalizationState (Either Diagnostic) a + +-- Report a grammar error as a Diagnostic, attaching the rule being normalized +-- (its name as context and its source position, when known) when the problem +-- was found. +normError :: String -> Normalization a +normError msg = do + ctx <- gets _currentRule + let diag = case ctx of + Just r -> Diagnostic (getIRulePos r) (Just ("in rule '" ++ getIRuleName r ++ "'")) msg + Nothing -> Diagnostic Nothing Nothing msg + lift (Left diag) + +newNamePrefixed :: String -> Normalization String +newNamePrefixed prefix = do + n <- gets _nameCounter + nameCounter .= (n + 1) + return $ prefix ++ (show n) + +newName :: Normalization String +newName = newNamePrefixed "Rule_" + +saveProxyRuleName :: ID -> Normalization () +saveProxyRuleName ruleName = do + proxyRuleNames %= S.insert ruleName + return () + +addRule :: ID -> ID -> SyntaxTopClause -> Normalization () +addRule tdName ruleName clause = do + let doAdd rs = Just $ (SyntaxRule ruleName clause) : (maybe [] id rs) + normSRules %= M.alter doAdd tdName + return () + +addShortcut :: String -> String -> Normalization () +addShortcut strFrom strTo = do + normShortcuts %= ((strFrom, strTo) :) + return () + +addAntiRule :: AntiRule -> Normalization () +addAntiRule rl = do + normAntiRules %= (rl :) + return () + +addQQLexRule :: ID -> Normalization ID +addQQLexRule tdName = do + -- Use deterministic name based on type name, not counter + let termKindName = "qq_" ++ tdName + addLexicalRule $ LexicalRule "String" "(tail . dropWhile (/= ':'))" termKindName + (IAlt [ISeq [IStrLit "$", + IStrLit tdName, + IStrLit ":", + IRegExpLit "a-zA-Z_", + IStar (IRegExpLit "A-Za-z0-9_") Nothing]]) + return termKindName + +-- Cached version of addQQLexRule that reuses existing QQ lex rules for the same type +addQQLexRuleCached :: ID -> Normalization ID +addQQLexRuleCached tdName = do + cache <- gets _qqLexRuleCache + case M.lookup tdName cache of + Just lexRuleName -> return lexRuleName -- Reuse existing rule + Nothing -> do + lexRuleName <- addQQLexRule tdName + qqLexRuleCache %= M.insert tdName lexRuleName -- Cache it + return lexRuleName + +addLexicalRule :: LexicalRule -> Normalization () +addLexicalRule lr = do + normLRules %= (lr :) + return () + +-- Cached version of anti-rule creation that reuses existing constructors for the same type +-- Only adds the AntiRule to the list ONCE per type, not once per grammar rule +-- Uses deterministic naming: Anti_{TypeName} instead of counter-based names +addAntiRuleCached :: ID -> Bool -> Normalization ID +addAntiRuleCached tdName isList = do + cache <- gets _antiRuleCache + case M.lookup tdName cache of + Just constr -> return constr -- Reuse existing constructor, don't add duplicate AntiRule + Nothing -> do + -- Use deterministic name based on type name, not counter + let constr = "Anti_" ++ tdName + addAntiRule $ AntiRule tdName tdName constr isList -- Only called ONCE per type + antiRuleCache %= M.insert tdName constr -- Cache it + return constr + +addRuleWithQQ :: ID -> ID -> SyntaxTopClause -> Normalization () +addRuleWithQQ tdName ruleName clause = do + case clause of + STAltOfSeq altseqs -> + case L.find (\(STSeq _ ssc) -> case ssc of + (SSLifted _ : _) -> True + _ -> False) + altseqs of + Just _ -> addRule tdName ruleName clause + Nothing -> qqAdd altseqs + STMany opType (SSId rule) mcl -> do + -- For list rules, look up the actual type data name for the element rule + -- This handles cases where the element rule has a shared type (e.g., Expression : AddExpr) + typeMap <- use ruleToTypeName + let elemTypeName = M.findWithDefault rule rule typeMap + newRule <- addListProxyRule elemTypeName rule ruleName + addRule tdName ruleName $ STMany opType (SSId newRule) mcl + _ -> addRule tdName ruleName clause + where qqAdd altseqs = do + -- The QQ machinery (lexical rule, anti rule) is created at the first + -- eligible rule of the type, as before; but the splice alternative + -- itself is only attached at the group's attach points (a minimal + -- set of rules from which every rule of a shared-type group is + -- reachable via unit productions, see computeQQAttachPoints). + -- Attaching it to every rule instead would add one reduce item per + -- rule for the same splice token, flooding the parser with + -- reduce/reduce conflicts. + qqLexRule <- addQQLexRuleCached tdName -- Use cached version + constr <- addAntiRuleCached tdName False -- Use cached version + attachMap <- use qqAttachPoints + let attachHere = S.member ruleName $ M.findWithDefault S.empty tdName attachMap + if attachHere + then addRule tdName ruleName $ STAltOfSeq (STSeq constr [SSId qqLexRule] : altseqs) + else addRule tdName ruleName clause + +addListProxyRule :: ID -> ID -> ID -> Normalization ID +addListProxyRule tdName elemRuleName listName = do + ruleName <- newNamePrefixed $ "ListElem_" ++ listName + -- The QQ token is named after the LIST rule (e.g. $RuleList:xs for + -- "RuleList = Rule*"), because GenQ's anti functions for isList rules + -- splice whole lists: in patterns the anti node binds the entire list, + -- in expressions it prepends a list variable to the remaining elements. + -- The anti constructor lives in the ELEMENT's type (Anti_), + -- since the token parses in element position within the list. + qqLexRule <- addQQLexRuleCached listName + constr <- addAntiRuleCached tdName True + addRule tdName ruleName $ STAltOfSeq [STSeq constr [SSId qqLexRule], STSeq "" [SSLifted elemRuleName]] + return ruleName + +extractClause :: IClause -> Normalization ID +extractClause cl = do + ruleName <- newName + cl1 <- checkNormalClause cl + addRule ruleName ruleName cl1 + saveProxyRuleName ruleName + return $ ruleName + +extractSClause :: SyntaxTopClause -> Normalization ID +extractSClause cl = do + ruleName <- newName + addRule ruleName ruleName cl + saveProxyRuleName ruleName + return $ ruleName + +processRuleOptions :: IRule -> Normalization () +processRuleOptions IRule{getIDataTypeName=dtn, getIRuleName=rn, getIRuleOptions=ropts} = do + let dtName = (maybe rn Prelude.id dtn) + mapM_ (\ opt -> case opt of + OShortcuts lst -> mapM_ (\ shortcut -> do + addShortcut shortcut dtName + return ()) lst + OSymmacro -> return () -- Handle symmacro option + ) ropts + +checkSimpleClause :: IClause -> Normalization SyntaxSimpleClause +checkSimpleClause (IId idName) = return $ SSId idName +checkSimpleClause (ILifted (IId idName)) = return $ SSLifted idName +checkSimpleClause (IIgnore c1) = do + newC1 <- checkSimpleClause c1 + case newC1 of + SSId idName -> return $ SSIgnore idName + _ -> normError $ "ignore (!) cannot be applied to: " ++ showClause c1 +checkSimpleClause c = extractClause c >>= return . SSId + +-- A repetition/option clause: cannot be the body of a lifted (,) clause. +isRepetition :: IClause -> Bool +isRepetition IStar{} = True +isRepetition IPlus{} = True +isRepetition IOpt{} = True +isRepetition _ = False + +-- The repeated element of a * or + clause must be a syntax rule: the rule's +-- value is a list of the element's values, and the element's splice support +-- (a ListElem proxy whose Anti_ constructor lives in the element's data +-- type, see addListProxyRule) needs a grammar-owned data declaration to +-- host that constructor. Terminals have neither: an ignored item (a string +-- literal or !-clause) produces no value to collect, and a lexical rule +-- produces a bare token payload with no data declaration. Both used to slip +-- through to the generators and emit uncompilable Haskell (issue #28), as +-- did a lifted (,) element, which crashed GenAST. Reject them here, where +-- the offending rule is still known. The delimiter is unrestricted: it is +-- matched and dropped, so any clause works there. +checkRepeatedClause :: IClause -> Normalization SyntaxSimpleClause +checkRepeatedClause c = do + c1 <- checkSimpleClause c + case c1 of + -- Not rendered via showClause: a string literal is already replaced by + -- its internal token name (tok_..._N) at this stage, which would leak + -- into the message; the rule context and position locate the clause. + SSIgnore _ -> normError $ "repetition of an item that produces no value:" + ++ " the repeated item is a string literal or !-ignored clause," + ++ " which is matched but dropped;" + ++ " wrap the item in a syntax rule and repeat that rule instead" + SSId name | isLexicalRule name -> + normError $ "repetition over the lexical rule '" ++ name ++ "' is not supported:" + ++ " wrap it in a syntax rule (Item = " ++ name ++ " ;) and repeat Item" + ++ " to give the list elements a data type" + SSLifted _ -> normError "a lifted (,) clause is not supported under *, + or ?" + _ -> return c1 + +checkNormalClause :: IClause -> Normalization SyntaxTopClause +checkNormalClause (IStar c mc) = do + c1 <- checkRepeatedClause c + c2l <- mapM checkSimpleClause (maybeToList mc) + return $ STMany STStar c1 (listToMaybe c2l) +checkNormalClause (IPlus c mc) = do + c1 <- checkRepeatedClause c + c2l <- mapM checkSimpleClause (maybeToList mc) + return $ STMany STPlus c1 (listToMaybe c2l) +checkNormalClause (IOpt c) = do + c1 <- checkSimpleClause c + return $ STOpt c1 +checkNormalClause (IAlt [c]) = do + checkNormalClause c +checkNormalClause (IAlt cs) = do + cs1 <- mapM checkNormalClauseSeq cs + return $ STAltOfSeq cs1 +checkNormalClause (ISeq [c]) = do + checkNormalClause c +checkNormalClause tc@(ISeq _) = do + c1 <- checkNormalClauseSeq tc + return $ STAltOfSeq [c1] +-- A lifted (,) clause names the single rule whose value becomes this rule's +-- value, so it must reference one rule, not a repetition. Lifting a list/plus +-- (e.g. "Foo = ,Bar* ;") is not implemented: it would otherwise slip through to +-- GenAST.genSimpleItem and die there ("lifted rules are not yet implemented"). +-- (IOpt is desugared by removeOpts before normalization, so only * and + reach +-- here as repetitions.) +checkNormalClause (ILifted c) + | isRepetition c = + normError "a lifted (,) clause is not supported under *, + or ?" + | otherwise = do + c1 <- checkSimpleClause c + case c1 of + SSId idName -> return $ STAltOfSeq [STSeq "" [SSLifted idName]] + _ -> normError $ "lifted (,) cannot be applied to: " ++ showClause c +checkNormalClause (IIgnore c) = do + c1 <- checkSimpleClause c + case c1 of + SSId idName -> return $ STAltOfSeq [STSeq "" [SSIgnore idName]] + _ -> normError $ "ignore (!) cannot be applied to: " ++ showClause c +checkNormalClause (IId idName) = do + return $ STAltOfSeq [STSeq "" [SSId idName]] +checkNormalClause c = normError $ "this clause cannot be used in a syntax rule: " ++ showClause c + ++ " (regular expressions and '.' are only allowed in lexical rules)" + +checkNormalClauseSeq :: IClause -> Normalization STSeq +checkNormalClauseSeq (ISeq cs) = do + cs1 <- mapM checkSimpleClause cs + checkLiftedInSeq cs cs1 + return $ STSeq "" cs1 +checkNormalClauseSeq ic = do + c1 <- checkSimpleClause ic + return $ STSeq "" [c1] + +-- A lifted (,) clause must be the only non-ignored clause of its sequence. +-- Check it here, where the offending rule is still known, instead of failing +-- without context during code generation (see isClauseSeqLifted) +checkLiftedInSeq :: [IClause] -> [SyntaxSimpleClause] -> Normalization () +checkLiftedInSeq orig cs = + case filter isNotIgnored cs of + [SSLifted _] -> return () + cs1 | any isLifted cs1 -> normError $ "a lifted (,) clause cannot be mixed with other clauses in a sequence: " + ++ showClause (ISeq orig) + _ -> return () + where isLifted SSLifted{} = True + isLifted _ = False + +normalizeRule :: IRule -> Normalization () +normalizeRule r@IRule{getIDataTypeName=dtn, getIRuleName=rn, getIClause=cl, getIDataFunc=_, getIRuleOptions=_} | not (isLexicalRule rn) = do + processRuleOptions r + newCl <- checkNormalClause cl + addRuleWithQQ (maybe rn Prelude.id dtn) rn newCl +normalizeRule r@IRule{getIDataTypeName=dtn, getIDataFunc=df, getIRuleName=rn, getIClause=cl, getIRuleOptions=_} | (isLexicalRule rn) = do + let (dtn1, df1) = case (dtn, df) of + (Nothing, Nothing) -> ("String", "id") + (Just d, Nothing) -> (d, "read") + (Just d, Just f) -> (d, f) + (Nothing, Just f) -> ("String", f) + if (OSymmacro `elem` (getIRuleOptions r)) + then + addLexicalRule $ MacroRule rn cl + else + addLexicalRule $ LexicalRule dtn1 df1 rn cl +normalizeRule r = error $ "normalizeRule: unexpected rule pattern: " ++ show r + +-- Build a map from rule name to type data name for all rules in the grammar. +-- This is needed to look up the correct type when processing list rules. +buildRuleToTypeMap :: InitialGrammar -> M.Map ID ID +buildRuleToTypeMap grammar = M.fromList $ map ruleMapping $ getIRules grammar + where + ruleMapping r = (getIRuleName r, maybe (getIRuleName r) id (getIDataTypeName r)) + +-- A rule name may be defined only once: addRule would otherwise silently +-- merge the definitions into one rule group, turning an (almost certainly +-- accidental) duplicate into extra alternatives (issue #20). Checked on the +-- input rules, so the synthesized start wrapper added later by addStartGroup +-- - which legitimately reuses the start rule's name - is exempt. +checkDuplicateRuleNames :: [IRule] -> Normalization () +checkDuplicateRuleNames = go M.empty + where + go _ [] = return () + go seen (r : rest) = + case M.lookup (getIRuleName r) seen of + Nothing -> go (M.insert (getIRuleName r) r seen) rest + Just firstDef -> do + currentRule .= Just r + normError $ "rule '" ++ getIRuleName r ++ "' is defined more than once" + ++ firstDefinedAt firstDef + firstDefinedAt r = case getIRulePos r of + Just pos -> " (first definition at " ++ showSourcePos pos ++ ")" + Nothing -> "" + +-- Every bare-name reference inside a clause. +allIdRefs :: IClause -> [ID] +allIdRefs = everything (++) ([] `mkQ` idRef) + where idRef (IId n) = [n] + idRef _ = [] + +-- A declared type may exist only through rule annotations ("T : Rule = ..."), +-- with no rule named T - a "pure type group". A reference to such a bare type +-- name would reach the generators as a reference to the nonexistent rule T +-- and die in GenAST.findRuleDataTypeName (issue #14). The reference can be +-- the author's (a plain "S = T ;" or a list element "T* ~ ','") or one the +-- QQ machinery generates itself: the start wrapper added by addStartGroup +-- references every public group's type name, so a data-start grammar fails +-- on a pure type group even when the author never mentions the bare name. +-- +-- Synthesize the cover rule that authors write by hand (java.pg's +-- "Expression : Expression = AssignmentExpression ;"), in its lifted form: +-- +-- T : T = ,r1 | ,r2 | ... ; -- one alternative per rule annotated T +-- +-- A lifted alternative passes the annotated rule's value through, so the +-- cover adds a nonterminal for T without adding an AST constructor. It is +-- synthesized on the InitialGrammar, before any normalization bookkeeping, +-- so it flows through buildRuleToTypeMap and computeQQAttachPoints exactly +-- like a hand-written cover: its alternatives are unit edges r_i -> T, the +-- annotated rules therefore cover the always-demanded T, and a $T:var +-- splice climbs to T through the cover from whatever attach point the +-- greedy cover picks. +-- +-- Synthesis is demand-driven: a cover appears only when something will +-- reference T - a bare-name reference in some syntax rule, or the QQ start +-- wrapper. The wrapper exists only for a data start group (an alias start +-- group skips the QQ entry-point machinery, see addStartGroup), so that +-- demand is predicted here with the same group-shape rules normalization +-- applies: the start group ends up an alias exactly when it keeps a single +-- rule whose top-level clause is a repetition - no second user rule of the +-- start type, no synthesized cover joining the group, and no list-element +-- proxy added into it by a repetition over a start-typed element. Grammars +-- that demand no cover are returned untouched, output byte for byte. +synthesizeTypeCovers :: InitialGrammar -> InitialGrammar +synthesizeTypeCovers grammar + | null covers = grammar + | otherwise = grammar { getIRules = getIRules grammar ++ covers } + where + rules = getIRules grammar + synRules = [ r | r <- rules, not (isLexicalRule (getIRuleName r)) ] + ruleNames = S.fromList (map getIRuleName rules) + ruleTypeOf r = maybe (getIRuleName r) Prelude.id (getIDataTypeName r) + typeOfName = M.fromList [ (getIRuleName r, ruleTypeOf r) | r <- synRules ] + + -- declared types and each type's annotated rules, in declaration order + declaredTypes = L.nub [ t | r <- synRules, Just t <- [getIDataTypeName r] ] + rulesOfType t = [ getIRuleName r | r <- synRules, getIDataTypeName r == Just t ] + pureTypes = [ t | t <- declaredTypes, not (t `S.member` ruleNames) ] + + referenced = S.fromList $ concatMap (allIdRefs . getIClause) synRules + demanded + | aliasStart = [ t | t <- pureTypes, t `S.member` referenced ] + | otherwise = pureTypes -- the start wrapper references every type + + covers = map coverRule demanded + coverRule t = IRule { getIDataTypeName = Just t + , getIDataFunc = Nothing + , getIRuleName = t + , getIClause = IAlt [ ILifted (IId r) | r <- rulesOfType t ] + , getIRuleOptions = [] + , getIRulePos = Nothing } + + aliasStart = case synRules of + [] -> True -- no wrappers (normalization rejects the grammar first) + (firstRule : _) -> + let firstID = ruleTypeOf firstRule + in case [ r | r <- synRules, ruleTypeOf r == firstID ] of + -- a cover joins the group when the start type is itself a + -- referenced pure type + [r] -> isTopRepetition (getIClause r) + && not (firstID `elem` pureTypes && firstID `S.member` referenced) + && all ((/= Just firstID) . topRepetitionElemType) synRules + _ -> False + + isTopRepetition c = case unwrapSingleton c of + IStar{} -> True + IPlus{} -> True + _ -> False + + -- The type of the element a top-level repetition rule collects: such a + -- rule gets a ListElem proxy added into the ELEMENT type's group (see + -- addRuleWithQQ/addListProxyRule). A non-reference element is extracted + -- into a fresh proxy group of its own and can never hit the start group. + topRepetitionElemType r = case unwrapSingleton (getIClause r) of + IStar c _ -> elemType c + IPlus c _ -> elemType c + _ -> Nothing + where elemType (IId e) = Just (M.findWithDefault e e typeOfName) + elemType _ = Nothing + + -- mirrors checkNormalClause's singleton unwrapping + unwrapSingleton (IAlt [c]) = unwrapSingleton c + unwrapSingleton (ISeq [c]) = unwrapSingleton c + unwrapSingleton c = c + +-- Decide, for every data type, which of its rules receive the $Type:var +-- splice alternative ("attach points"). A type declared by a single rule +-- keeps today's behavior: the rule itself is the attach point. +-- +-- For a shared type (several rules declaring the same type, e.g. java.pg's +-- 18-rule Expression precedence chain) attaching the alternative to every +-- rule would make the splice token reducible to all of them at once: the +-- parser gets one reduce item per rule in the same states and cannot know +-- which rule to reduce the token to (in java.pg this used to cause 806 of +-- the 883 reduce/reduce conflicts). Instead the alternative is attached to +-- a minimal set of rules from which the rest of the group is reachable via +-- unit productions: +-- +-- * Build the intra-group "lift graph": an edge A -> B when rule B has an +-- alternative consisting of exactly the single nonterminal A once +-- nullable clauses are dropped (i.e. an A on the stack reduces to B by a +-- unit production, possibly surrounded by empty reductions). For java.pg +-- this is the chain PrimaryNoPostfix -> PostfixExpression -> ... -> +-- Expression. +-- * Collect the rules of the group some grammar position actually demands: +-- every reference from any rule's alternatives counts, except the +-- reference that forms a lift edge inside the group itself (a splice +-- never needs to stop at that position: reducing further is the only +-- thing the parser can do with it). The rule named after the type is +-- always demanded, because the synthesized start rule references it. +-- * Greedily pick attach points whose unit-closure covers all demanded +-- rules. A precedence chain needs exactly one (its bottom rule). A group +-- that genuinely needs several attach points gets several; if their +-- closures overlap, the overlap reintroduces reduce/reduce conflicts +-- between the splice reductions -- that is inherent to such a grammar, +-- not to this placement (there is no warning channel in normalization, +-- so such groups are not reported). +-- +-- Only rules that addRuleWithQQ would accept the alternative for are attach +-- point candidates (rules whose clause normalizes to plain alternatives with +-- no leading lifted (,) clause). Two conservative fallbacks keep splicing at +-- least as available as before: when no rule is named after the type, every +-- rule of the group counts as demanded; and when the greedy cover cannot +-- cover anything, every candidate becomes an attach point. +computeQQAttachPoints :: InitialGrammar -> M.Map ID (S.Set ID) +computeQQAttachPoints grammar = M.fromList $ map attachFor groups + where + synRules = [ r | r <- getIRules grammar, not (isLexicalRule (getIRuleName r)) ] + ruleTypeOf r = maybe (getIRuleName r) Prelude.id (getIDataTypeName r) + groupNames = L.nub $ map ruleTypeOf synRules + groups = [ (t, [ r | r <- synRules, ruleTypeOf r == t ]) | t <- groupNames ] + groupOfRule = M.fromList [ (getIRuleName r, ruleTypeOf r) | r <- synRules ] + + -- Rule-level nullability, by fixpoint. Lexical rules (and unknown names) + -- never match the empty input. + clausesByName = M.fromListWith (flip (++)) [ (getIRuleName r, [getIClause r]) | r <- synRules ] + nullableRules = fixNullable S.empty + fixNullable env = + let env' = S.fromList [ n | (n, cls) <- M.toList clausesByName + , any (clauseNullable env) cls ] + in if env' == env then env else fixNullable env' + clauseNullable env c = case c of + IId n -> S.member n env + IStrLit _ -> False + IDot -> False + IRegExpLit _ -> False + IStar _ _ -> True + IOpt _ -> True + IPlus c1 _ -> clauseNullable env c1 + IAlt cs -> any (clauseNullable env) cs + ISeq cs -> all (clauseNullable env) cs + ILifted c1 -> clauseNullable env c1 + IIgnore c1 -> clauseNullable env c1 + isNullable = clauseNullable nullableRules + + -- The alternatives a clause normalizes to, mirroring checkNormalClause: + -- singleton wrappers unwrap, a top-level option contributes an empty + -- alternative (removeOpts), everything else is a single alternative. + unwrapTop (IAlt [c]) = unwrapTop c + unwrapTop (ISeq [c]) = unwrapTop c + unwrapTop c = c + topAlts c = case unwrapTop c of + IAlt cs -> cs + IOpt c1 -> [ISeq [], ISeq [c1]] + c' -> [c'] + + -- The non-nullable core of an alternative: Just n for a nonterminal + -- whose value passes through (a plain or lifted reference), Nothing for + -- anything opaque (tokens, ignored or repeated material, nested + -- alternatives, which normalize to proxy rules). + coreElems c + | isNullable c = [] + | otherwise = case c of + ISeq cs -> concatMap coreElems cs + IId n -> [Just n] + ILifted c1 -> coreElems c1 + _ -> [Nothing] + unitTarget alt = case coreElems alt of + [Just n] -> Just n + _ -> Nothing + + -- Mirror of the addRuleWithQQ guard: would this clause get the splice + -- alternative at all? (STMany rules take the list-proxy path; a leading + -- lifted (,) clause suppresses the alternative.) + eligibleClause c = case unwrapTop c of + IStar{} -> False + IPlus{} -> False + ILifted _ -> False + c' -> not $ any altLeadsLifted (topAlts c') + altLeadsLifted (ISeq (c:_)) = liftedIdHead c + altLeadsLifted c = liftedIdHead c + liftedIdHead (ILifted (IId _)) = True + liftedIdHead _ = False + + attachFor (t, [r]) = (t, S.singleton (getIRuleName r)) + attachFor (t, rs) = (t, picked) + where + names = L.nub $ map getIRuleName rs -- in declaration order + nameSet = S.fromList names + + -- lift graph: source -> targets it reduces to by a unit production + edges = M.fromListWith S.union + [ (src, S.singleton (getIRuleName r)) + | r <- rs + , alt <- topAlts (getIClause r) + , Just src <- [unitTarget alt] + , src `S.member` nameSet ] + closureOf n0 = go (S.singleton n0) [n0] + where go seen [] = seen + go seen (x:xs) = + let new = [ y | y <- S.toList (M.findWithDefault S.empty x edges) + , not (S.member y seen) ] + in go (foldr S.insert seen new) (new ++ xs) + closures = M.fromList [ (n, closureOf n) | n <- names ] + + -- rules of this group demanded by some position of the grammar + demandRefs r alt = + let refs = filter (`S.member` nameSet) (allIdRefs alt) + in case unitTarget alt of + Just n | M.lookup (getIRuleName r) groupOfRule == Just t + , n `S.member` nameSet -> L.delete n refs + _ -> refs + demanded + | t `S.member` nameSet = S.insert t demanded0 + | otherwise = nameSet -- no rule carries the type name: + -- assume everything is demanded + where demanded0 = S.fromList [ ref | r <- synRules + , alt <- topAlts (getIClause r) + , ref <- demandRefs r alt ] + + candidates = [ n | n <- names + , any (eligibleClause . getIClause) + [ r | r <- rs, getIRuleName r == n ] ] + + greedy uncovered acc + | S.null uncovered = reverse acc + | otherwise = case best of + Just n -> greedy (uncovered S.\\ (closures M.! n)) (n : acc) + Nothing -> reverse acc + where -- most newly covered demands first; among equals the rule + -- with the larger closure, i.e. the bottom-most rule of the + -- chain (a chain bottom and the rule just above it cover the + -- same demands when the bottom itself is never demanded, but + -- splices must enter the chain at the bottom to be able to + -- climb everywhere); declaration order breaks remaining ties + gain n = (S.size $ (closures M.! n) `S.intersection` uncovered, + S.size $ closures M.! n) + best = fst $ L.foldl' pick (Nothing, (0, 0)) candidates + pick (b, g0) n = let g = gain n + in if fst g > 0 && g > g0 then (Just n, g) else (b, g0) + + picked = case greedy demanded [] of + [] -> S.fromList candidates -- cover made no progress: keep + -- the old attach-everywhere + ns -> S.fromList ns + +doNM :: InitialGrammar -> Normalization () +doNM grammar = do + let grammar0 = everywhereBut (False `mkQ` (isLexicalRule . getIRuleName)) (mkT removeOpts) grammar + checkDuplicateRuleNames $ getIRules grammar0 + mapM_ (\r -> do currentRule .= Just r + normalizeRule r) + $ getIRules grammar0 + currentRule .= Nothing + postNormalizeGrammar + +postNormalizeGroup :: (ID, [SyntaxRule]) -> Normalization (ID, [SyntaxRule]) +postNormalizeGroup g@(_, [_]) = return g +postNormalizeGroup (idName, rules) = do + newRules <- mapM normRule rules + return (idName, newRules) + where + normRule r@(SyntaxRule _ (STAltOfSeq _)) = return r + normRule (SyntaxRule rn cl) = do + extractedId <- extractSClause cl + return (SyntaxRule rn (STAltOfSeq [STSeq "" [SSId extractedId]])) + +postNormalizeGrammar :: Normalization () +postNormalizeGrammar = do + rules <- gets (M.toList . _normSRules) + newRules <- mapM postNormalizeGroup rules + normSRules %= flip (foldr $ uncurry M.insert) newRules + +-- Whether a group's value is a type alias (a list from a top-level +-- repetition rule, a Maybe from an option rule) rather than a data +-- declaration with constructors. After postNormalizeGrammar such a group +-- has exactly one rule; a group with several rules is all-STAltOfSeq. +isAliasGroup :: SyntaxRuleGroup -> Bool +isAliasGroup = any (not . isAltOfSeq . getSClause) . getSRules + where isAltOfSeq STAltOfSeq{} = True + isAltOfSeq _ = False + +addStartGroup :: NormalGrammar -> NormalGrammar +-- The QQ entry-point machinery extends the START group's data declaration: +-- one wrapper alternative (dummy tokens around a type reference) per public +-- type, which the per-type quoters parse through and pattern-match on. When +-- the start group is a type alias (the grammar's first rule is a +-- repetition, e.g. "Start = Item* ;"), there is no data declaration to +-- extend: injecting the wrapper rule used to type the start nonterminal +-- both as a data and as a list, generating a parser GHC rejects, plus a +-- dummy-token shift/reduce conflict against the empty list (issue #34). +-- Such a grammar gets no start wrappers, dummy tokens or top-level quoters +-- at all; the element-level splice machinery (qq_* tokens, Anti_* +-- alternatives) is untouched. Note the host/target distinction: a group +-- merely REFERENCED by a wrapper alternative may be an alias, because the +-- alias is just the field type of the start group's wrapper constructor +-- (grammar.pg's "RuleList = Rule*" works this way). +addStartGroup ng@NormalGrammar { getSyntaxRuleGroups = startGroup : _ } + | isAliasGroup startGroup = ng +addStartGroup ng@NormalGrammar { getSyntaxRuleGroups = rules, getLexicalRules = tokens , getGrammarInfo = info } = + let proxyRules = getProxyRules info + (ruleToStartInfo, counter) = foldr + (\el (ruleMap, cnt) -> + let typeName = getSDataTypeName el + in + if S.member typeName proxyRules + then (ruleMap, cnt) + else + (M.insert typeName + ("tok_" ++ typeName ++ "_dummy_" ++ show cnt) + ruleMap, + cnt + 1)) + (M.empty, getNameCounter info) + rules + rulesClauses = map (\s -> + let typeName = getSDataTypeName s + startTok = fromMaybe (error $ "Internal error: no start token generated for type '" ++ typeName ++ "'") + (M.lookup typeName ruleToStartInfo) + dummy = SSIgnore startTok + in + STSeq "" [dummy, + SSId typeName, + dummy]) $ filterProxyRules proxyRules rules + newTokens = map (\(_, name) -> LexicalRule { getLRuleDataType = "Keyword", + getLRuleFunc = "", + getLRuleName = name, getLClause = (IStrLit name)}) $ M.toList ruleToStartInfo + + qqRule = SyntaxRule (fromMaybe (error "Internal error: start rule name is not set in grammar info") + (getStartRuleName info)) + $ STAltOfSeq rulesClauses + in case rules of + (startRule:restRules) -> + -- The wrapper rule shares the start rule's name, and happy merges + -- same-named rule blocks only when they are adjacent in the .y file + -- (separated blocks are a hard "Multiple rules for ..." error). The + -- start group may hold other rules - list-element proxies of lists + -- over the start type, prepended by addRule after the start rule - + -- so emit the original start-named rule(s) right after the wrapper + -- instead of wherever they ended up in the group. + let startName = getSRuleName qqRule + (startNamed, others) = L.partition ((== startName) . getSRuleName) + (getSRules startRule) + in + ng { getSyntaxRuleGroups = startRule { getSRules = qqRule : startNamed ++ others }: restRules, + getLexicalRules = newTokens ++ tokens, + getGrammarInfo = info { getNameCounter = counter, getRuleToStartInfo = ruleToStartInfo }} + [] -> error "Grammar must have at least one rule group" + +normalizeTopLevelClauses :: InitialGrammar -> Either Diagnostic NormalGrammar +normalizeTopLevelClauses grammar0 = + let grammar = synthesizeTypeCovers grammar0 in + case getIRules grammar of + [] -> Left $ Diagnostic Nothing Nothing $ + "grammar '" ++ getIGrammarName grammar ++ "' contains no rules" + (firstIRule:_) -> do + let firstID = maybe (getIRuleName firstIRule) Prelude.id (getIDataTypeName firstIRule) + ruleTypeMap = buildRuleToTypeMap grammar + attachPoints = computeQQAttachPoints grammar + (_, NormalizationState nrs nls counter antiRules shortcuts proxyRules _ _ _ _ _) <- + runStateT (doNM grammar) (NormalizationState M.empty [] 0 [] [] S.empty M.empty M.empty ruleTypeMap attachPoints Nothing) + firstRuleGroupRules <- case M.lookup firstID nrs of + Just rs -> Right rs + Nothing -> Left $ Diagnostic (getIRulePos firstIRule) Nothing $ + "the first rule ('" ++ getIRuleName firstIRule + ++ "') must be a syntax rule (its name must start with an uppercase letter)," + ++ " because it defines the start symbol of the grammar" + let nrs1 = M.delete firstID nrs + firstGroup = SyntaxRuleGroup firstID firstRuleGroupRules + otherGroups = map (\ (k,v) -> SyntaxRuleGroup k v) $ M.toList nrs1 + groups = firstGroup : otherGroups + return $ addStartGroup $ NormalGrammar (getIGrammarName grammar) groups nls antiRules shortcuts (getImports grammar) (GrammarInfo (Just firstID) M.empty counter proxyRules) + +data FillNameState = FillNameState { nameCtr :: Int, nameBase :: String } +type FillName a = State FillNameState a + +newConstructorName :: FillName String +newConstructorName = do + n <- gets nameCtr + b <- gets nameBase + modify $ (\ s -> s{nameCtr = n + 1}) + return $ "Ctr__" ++ b ++ "__" ++ (show n) + +fillConstructorName :: String -> STSeq -> FillName STSeq +fillConstructorName _ (STSeq "" l) = do + n <- newConstructorName + return $ STSeq n l +fillConstructorName _ seqValue = return seqValue + +fillConstructorNames :: NormalGrammar -> NormalGrammar +fillConstructorNames ng@NormalGrammar { getSyntaxRuleGroups = rules, getGrammarInfo = info } = + ng { getSyntaxRuleGroups = newrules, getGrammarInfo = info } + where newrules = map (\r -> doRename (getSDataTypeName r) r) rules + doRename n dat = let (dat1, (FillNameState _ _)) = runState (everywhereM (mkM (fillConstructorName n)) dat) (FillNameState 0 n) + in dat1 + +removeOpts :: IClause -> IClause +removeOpts (IOpt c) = IAlt [ISeq [], ISeq [c]] +removeOpts a = a diff --git a/Parser.y b/Parser.y new file mode 100644 --- /dev/null +++ b/Parser.y @@ -0,0 +1,215 @@ +{ +module Parser where + +import qualified Lexer as L (Token(..), PosToken(..), AlexPosn(..), alexScanTokens) +import Diagnostics (Diagnostic(..), SourcePos(..)) +import Syntax +import Data.List (intercalate) + +} + +%name parse +%tokentype { L.PosToken } +%monad { Either Diagnostic } +%error { parseError } + +%token + +grammar { L.PosToken _ L.Grammar } +imports { L.PosToken _ L.Imports } +'=' { L.PosToken _ L.Eq } +'|' { L.PosToken _ L.OrClause } +':' { L.PosToken _ L.Colon } +';' { L.PosToken _ L.RlEnd } +'*' { L.PosToken _ L.Star } +'+' { L.PosToken _ L.Plus } +'?' { L.PosToken _ L.Question } +')' { L.PosToken _ L.RParen } +'(' { L.PosToken _ L.LParen } +'.' { L.PosToken _ L.Dot } +'!' { L.PosToken _ L.Excl } +'~' { L.PosToken _ L.Tilde } +',' { L.PosToken _ L.Comma } +'@shortcuts' { L.PosToken _ L.Shortcuts } +'@symmacro' { L.PosToken _ L.Symmacro } +id { L.PosToken _ (L.Id _) } +str { L.PosToken _ (L.StrLit $$) } +rexplit { L.PosToken _ (L.RegExpLit $$) } +bigstr { L.PosToken _ (L.BigStr $$) } +eof { L.PosToken _ L.EndOfFile } + +%% + +Grammar : grammar str ';' ImportsOpt Rules eof { InitialGrammar $2 $4 (reverse $5) } + +ImportsOpt : imports bigstr { $2 } + | {- empty -} { "" } + +Rules : RuleWithOptions { [$1] } + | Rules RuleWithOptions { $2 : $1 } + | {- empty -} { [] } + + +RuleWithOptions : OptionsList Rule { addRuleOptions (reverse $1) $2 } + +OptionsList : OptionsList Option { $2 : $1 } + | {- empty -} { [] } + +Option : '@shortcuts' '(' IdListOpt ')' { OShortcuts (reverse $3)} + | '@symmacro' { OSymmacro } + +IdListOpt : IdList { $1 } + | {- empty -} { [] } + +IdList : IdList ',' id { idStr $3 : $1} + | id { [idStr $1] } + +Rule : id '=' ClauseAlt ';' { IRule Nothing Nothing (idStr $1) $3 [] (Just (idPos $1)) } + | id ':' id '=' ClauseAlt ';' { IRule (Just (idStr $1)) Nothing (idStr $3) $5 [] (Just (idPos $1)) } + | id '.' id ':' id '=' ClauseAlt ';' { IRule (Just (idStr $1)) (Just (idStr $3)) (idStr $5) $7 [] (Just (idPos $1)) } + -- a rule's position is where the rule starts: for the '.' form that is + -- the dot itself, matching the first-symbol positions captured by + -- generated parsers + | '.' id ':' id '=' ClauseAlt ';' { IRule Nothing (Just (idStr $2)) (idStr $4) $6 [] (Just (idPos $1)) } + +ClauseAlt : ClauseAlt1 { mkAlt (reverse $1) } + +ClauseAlt1 : ClauseAlt1 '|' ClauseSeq { $3 : $1 } + | ClauseSeq { [$1] } + +ClauseSeq : ClauseSeq1 { mkSeq (reverse $1) } + +-- A sequence has at least one element: grammar.pg's clause syntax cannot +-- derive an empty alternative, and the reference parser must define the same +-- language +ClauseSeq1 : ClauseSeq1 ClausePre { $2 : $1 } + | ClausePre { [$1] } + +ClausePre : ',' ClausePost { ILifted (unliftGroupOp $2) } + | '!' ClausePost { IIgnore (unliftGroupOp $2) } + | ClausePost { unliftGroupElem $1 } + +ClausePost : ClauseItem '*' OptDelim { IStar $1 $3 } + | ClauseItem '+' OptDelim { IPlus $1 $3 } + | ClauseItem '?' { IOpt $1 } + | ClauseItem { $1 } + + +ClauseItem : '(' ClauseAlt ')' { unliftGroupLeaf $2 } + | id { IId (idStr $1) } + | str { IStrLit $1 } + | '.' { IDot } + | rexplit { IRegExpLit $1 } + +OptDelim : {- empty -} { Nothing } + | '~' ClauseItem { Just $2 } + +{ + +-- grammar.pg, the authoritative definition of the grammar language, treats +-- parentheses as pure grouping: its 'Clause5 = '(' ,Clause ')'' lifts the +-- group, so the generated front end records no node for the parentheses +-- themselves. The reference parser mirrors that with the helpers below, which +-- reproduce exactly what the lifted parse trees look like after +-- ASTAdapter flattens them (the AST-equality test suite holds the two front +-- ends to it for every corpus grammar): +-- +-- * a group around a single leaf collapses to the leaf (every position); +-- * in sequence-element position, a group around a single repetition, +-- option, lifted or ignored clause collapses to that clause; +-- * a pure-sequence group at the head of a sequence merges into it (the +-- juxtaposition spine is left-recursive, so only the head merges); +-- * an alternation group that is the whole first alternative merges into +-- the enclosing alternation (the '|' spine is left-recursive too). + +-- Group content that collapses everywhere parentheses themselves may appear +isLeafClause :: IClause -> Bool +isLeafClause (IId _) = True +isLeafClause (IStrLit _) = True +isLeafClause IDot = True +isLeafClause (IRegExpLit _) = True +isLeafClause _ = False + +-- In item position (operand of '*'/'+'/'?' and the '~' delimiter) only a +-- single-leaf group collapses +unliftGroupLeaf :: IClause -> IClause +unliftGroupLeaf (IAlt [ISeq [c]]) | isLeafClause c = c +unliftGroupLeaf c = c + +-- Under ',' and '!' a group around one repetition or option collapses too +unliftGroupOp :: IClause -> IClause +unliftGroupOp (IAlt [ISeq [c]]) | isOpClause c = c + where isOpClause IStar{} = True + isOpClause IPlus{} = True + isOpClause IOpt{} = True + isOpClause _ = False +unliftGroupOp c = c + +-- In sequence-element position lifted and ignored content collapses as well +unliftGroupElem :: IClause -> IClause +unliftGroupElem (IAlt [ISeq [c]]) | isElemClause c = c + where isElemClause IStar{} = True + isElemClause IPlus{} = True + isElemClause IOpt{} = True + isElemClause ILifted{} = True + isElemClause IIgnore{} = True + isElemClause _ = False +unliftGroupElem c = c + +-- A pure-sequence group at the head of a sequence merges into it +mkSeq :: [IClause] -> IClause +mkSeq (IAlt [ISeq xs] : rest) = ISeq (xs ++ rest) +mkSeq cs = ISeq cs + +-- An alternation group as the whole first alternative merges into the +-- enclosing alternation (a single-alternative group cannot reach here: mkSeq +-- has already merged it into its alternative's sequence) +mkAlt :: [IClause] -> IClause +mkAlt (ISeq [IAlt alts] : rest) = IAlt (alts ++ rest) +mkAlt alts = IAlt alts + +parseError :: [L.PosToken] -> Either Diagnostic a +parseError [] = Left $ Diagnostic Nothing Nothing "unexpected end of input; expected a grammar definition" +parseError (L.PosToken pos tok : rest) = + Left $ Diagnostic (Just (alexPosToSourcePos pos)) Nothing + ("unexpected " ++ showToken tok ++ following) + where following = case rest of + [] -> "" + _ -> ", followed by: " ++ intercalate ", " (map (showToken . L.ptToken) (take 4 rest)) + +alexPosToSourcePos :: L.AlexPosn -> SourcePos +alexPosToSourcePos (L.AlexPn _ line col) = SourcePos line col + +-- Render a token the way it appears in the grammar source, for error messages +showToken :: L.Token -> String +showToken L.Grammar = "keyword 'grammar'" +showToken L.Imports = "keyword 'imports'" +showToken L.Eq = "'='" +showToken L.RlEnd = "';'" +showToken L.OrClause = "'|'" +showToken L.Dot = "'.'" +showToken (L.RegExpLit s) = "regular expression [" ++ s ++ "]" +showToken (L.StrLit s) = "string literal '" ++ s ++ "'" +showToken (L.BigStr _) = "multi-line string" +showToken (L.Id s) = "identifier '" ++ s ++ "'" +showToken L.Star = "'*'" +showToken L.Plus = "'+'" +showToken L.Excl = "'!'" +showToken L.Comma = "','" +showToken L.RParen = "')'" +showToken L.LParen = "'('" +showToken L.Dollar = "'$'" +showToken L.Question = "'?'" +showToken L.Colon = "':'" +showToken L.Tilde = "'~'" +showToken L.Shortcuts = "'@shortcuts'" +showToken L.Symmacro = "'@symmacro'" +showToken L.EndOfFile = "end of input" + +idStr :: L.PosToken -> String +idStr (L.PosToken _ (L.Id s)) = s +idStr t = error $ "Internal error: identifier token expected, but got: " ++ show t + +idPos :: L.PosToken -> SourcePos +idPos (L.PosToken (L.AlexPn _ line col) _) = SourcePos line col +} diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,113 @@ +# RTK - Rewrite ToolKit + +RTK generates parser and rewrite facilities from grammar specifications. It produces Alex lexer and Happy parser files, with support for quasi-quotation to embed parsed syntax directly in Haskell code. + +## Features + +- **Grammar Specifications**: Define languages using `.pg` grammar files +- **Lexer Generation**: Generates Alex (`.x`) lexer specifications +- **Parser Generation**: Generates Happy (`.y`) parser specifications +- **Quasi-Quotation**: Embed parsed syntax in Haskell via Template Haskell +- **Self-Hosting**: RTK parses grammar files with the parser it generated + from its own grammar description (`test-grammars/grammar.pg`) — by default. + The hand-written front end is kept as a reference oracle behind + `--use-handwritten`; see [BOOTSTRAP.md](BOOTSTRAP.md) + +## Installation + +```bash +cabal update +cabal install rtk +``` + +## Usage + +Generate lexer and parser from a grammar file: + +```bash +rtk .pg +``` + +This creates: +- `Lexer.x` - Alex lexer specification +- `Parser.y` - Happy parser specification +- `QQ.hs` - Quasi-quoter module + +Then compile with Alex and Happy: + +```bash +alex Lexer.x -o Lexer.hs +happy Parser.y --ghc -o Parser.hs +``` + +### Using the generated code + +The generated modules are compiled as part of *your* project, so your project +must depend on the packages they use: + +- `array` — runtime support for the Alex lexer and the Happy parser tables +- `syb` — the generated parser and quasi-quoter use `Data.Generics` +- `containers` — the quasi-quoter keeps its shortcut table in a `Data.Map` +- `template-haskell` — the quasi-quoter builds `Language.Haskell.TH` splices + +If you only use the lexer and parser (no quasi-quotation), `array` and `syb` +are enough. A typical `build-depends` line for code that uses all three +generated modules: + +``` +build-depends: base, array, syb, containers, template-haskell +``` + +## Grammar Format + +Grammar files use a simple specification format. Each file starts with a +`grammar 'Name';` header. A rule is a syntax rule if its name begins with an +uppercase letter and a lexical rule if it begins with a lowercase letter. +A rule may carry an optional `Type:` data-type annotation before its name +(as in `Int: num = …` below — the rule name is `num`; `Int` is the +annotation). `'…'` matches a string literal, `[…]` a character class, and +`* + ?` denote repetition. Constructors for the AST are generated +automatically — there are no inline semantic actions. + +``` +grammar 'Calc'; + +# Syntax rules: name starts with an uppercase letter +Expr = Term ('+' Term)* ; +Term = num ; + +# Lexical rules: name starts with a lowercase letter +# ('Int:' and 'Ignore:' are data-type annotations, not rule names) +Int: num = [0-9]+ ; +Ignore: ws = [ \t\n]+ ; +``` + +See `test-grammars/grammar.pg` for the grammar language described in itself — +that file is the authoritative definition of the grammar language: rtk parses +your grammar with the parser it generated from it (self-hosting). + +## Example Grammars + +The `test-grammars/` directory contains example grammars: +- `java.pg` - Java language grammar +- `grammar.pg` - Grammar for the grammar language itself (bootstrap) +- `haskell.pg` - Haskell subset grammar + +## Building from Source + +Requirements: +- GHC >= 9.4 +- Cabal >= 3.8 +- Alex +- Happy + +```bash +cabal build +cabal test +``` + +## License + +MIT License - see [LICENSE](LICENSE) for details. + +Generated code (lexers, parsers, quasi-quoters) produced by RTK is exempt from this license and may be used without restriction. diff --git a/StrQuote.hs b/StrQuote.hs new file mode 100644 --- /dev/null +++ b/StrQuote.hs @@ -0,0 +1,108 @@ +{- Taken from http://www.haskell.org/haskellwiki/Poor_man's_here_document -} +{-# LANGUAGE QuasiQuotes, TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-type-defaults #-} +module StrQuote(str) where + +import Language.Haskell.TH +import Language.Haskell.TH.Quote +import Language.Haskell.Exts.Parser +import Language.Haskell.Exts.Syntax +import Data.String.Utils +import Data.List + +getCodeToRunHelper :: (Eq t1, Num t1, Num t2) => [Char] -> t1 -> t2 -> Maybe t2 +getCodeToRunHelper [] _ _ = Nothing +getCodeToRunHelper (')' : _) 0 result = Just $ result + 1 +getCodeToRunHelper (')' : rest) bcounter result = getCodeToRunHelper rest (bcounter - 1) (1 + result) +getCodeToRunHelper ('(' : rest) bcounter result = getCodeToRunHelper rest (bcounter + 1) (1 + result) +getCodeToRunHelper (_ : rest) bcounter result = getCodeToRunHelper rest bcounter (1 + result) + +getCodeToRun :: Num a => String -> Maybe a +getCodeToRun "" = Nothing +getCodeToRun ('(' : rest) = getCodeToRunHelper rest 0 2 +getCodeToRun _ = Nothing + +processVarAndAfter :: [Char] -> ([Char], String) +processVarAndAfter varAndAfter = + case getCodeToRun $ drop 1 varAndAfter of + Nothing -> + let mbSpaceInd = findIndex (\c -> (c == ' ') || (c == '\n')) varAndAfter + mbTildInd = findIndex ((==) '~') varAndAfter + in + case mbSpaceInd of + Nothing -> + case mbTildInd of + Nothing -> (varAndAfter, "") + Just tildInd -> + let (var, tildAndAfter) = splitAt tildInd varAndAfter in (var, drop 1 tildAndAfter) + Just spaceInd -> + case mbTildInd of + Nothing -> splitAt spaceInd varAndAfter + Just tildInd -> + if tildInd < spaceInd + then let (var, tildAndAfter) = splitAt tildInd varAndAfter in (var, drop 1 tildAndAfter) + else splitAt spaceInd varAndAfter + Just ind -> splitAt ind varAndAfter + +splitStringByVarsHelper :: String -> [[Char]] -> [[Char]] +splitStringByVarsHelper [] result = result +splitStringByVarsHelper inputStr result = + case elemIndex '?' inputStr of + Nothing -> inputStr : result + Just ind -> + let (beforeVar, varAndAfter) = splitAt ind inputStr + (var, afterVar) = processVarAndAfter varAndAfter + in splitStringByVarsHelper afterVar (var : beforeVar : result) + +translateQName :: QName () -> Language.Haskell.TH.Name +translateQName qname = + case qname of + UnQual () (Ident () s) -> mkName s + UnQual () (Symbol () s) -> mkName s + Qual () _ (Ident () s) -> mkName s + Qual () _ (Symbol () s) -> mkName s + Special () (UnitCon ()) -> mkName "()" + Special () (ListCon ()) -> mkName "[]" + Special () (FunCon ()) -> mkName "->" + Special () (TupleCon () _ n) -> mkName $ "(" ++ replicate (n-1) ',' ++ ")" + Special () (Cons ()) -> mkName ":" + Special () (UnboxedSingleCon ()) -> mkName "(# #)" + Special () (ExprHole ()) -> mkName "_" + +translateQOp :: Quote m => QOp () -> m Language.Haskell.TH.Exp +translateQOp qop = + case qop of + QVarOp () qname -> varE $ translateQName qname + QConOp () qname -> conE $ translateQName qname + +convertToTHHelper :: Quote m => Language.Haskell.Exts.Syntax.Exp () -> m Language.Haskell.TH.Exp +convertToTHHelper (Paren () e) = convertToTHHelper e +convertToTHHelper (App () e1 e2) = appE (convertToTHHelper e1) (convertToTHHelper e2) +convertToTHHelper (InfixApp () e1 qop e2) = uInfixE (convertToTHHelper e1) (translateQOp qop) (convertToTHHelper e2) +convertToTHHelper (Var () qnm) = varE $ translateQName qnm +convertToTHHelper (Lit () (String () s _)) = stringE s +convertToTHHelper e = stringE ("") + +convertToTH :: Quote m => ParseResult (Language.Haskell.Exts.Syntax.Exp ()) -> m Language.Haskell.TH.Exp +convertToTH result = + case result of + ParseOk expr -> convertToTHHelper expr + ParseFailed loc errMsg -> stringE ("<" ++ errMsg ++ ":" ++ show loc ++ ">") + +splitStringByVars :: Quote m => [Char] -> m Language.Haskell.TH.Exp +splitStringByVars inputString = + let result = splitStringByVarsHelper (replace "|~]" "|]" inputString) [] + in foldr (\s prevExpr -> + case s of + "?()" -> [|$prevExpr ++ $(stringE "")|] + '?' : '(' : rest -> + let lifted = convertToTH $ fmap (fmap (const ())) $ parseExp $ '(' : rest + in [|$prevExpr ++ $lifted|] + "?" -> [|$prevExpr ++ $(stringE "")|] + '?' : rest -> + [|$prevExpr ++ $(varE $ mkName rest)|] + _ -> [|$prevExpr ++ $(stringE s)|]) + (stringE "") result + +str :: QuasiQuoter +str = QuasiQuoter { quoteExp = splitStringByVars, quotePat = litP . stringL, quoteType = \_ -> return ListT, quoteDec = \_ -> return [] } diff --git a/StringLiterals.hs b/StringLiterals.hs new file mode 100644 --- /dev/null +++ b/StringLiterals.hs @@ -0,0 +1,78 @@ +module StringLiterals (normalizeStringLiterals) + where + +import Syntax +import Data.Char +import Data.Generics +import qualified Data.Map as Map + +import Control.Monad.State.Strict hiding (lift) + +translateStrLiteral :: String -> String +translateStrLiteral str = concat (map (\char -> case char of + '+' -> "_plus_" + '-' -> "_minus_" + '.' -> "_dot_" + ',' -> "_coma_" + '[' -> "_sq_bkt_l_" + ']' -> "_sq_bkt_r_" + ';' -> "_semi_" + ':' -> "_colon_" + '=' -> "_eql_" + '*' -> "_star_" + '|' -> "_pipe_" + '$' -> "_dollar_" + '!' -> "_exclamation_" + '~' -> "_tilde_" + '(' -> "_lparen_" + ')' -> "_rparen_" + c | isAlpha c -> [c] + c | isDigit c -> [c] + _ -> "_symbol_") + str) + +type StringLiteralsMap = Map.Map String String + +data StringLiteralsNormalizationState = StringLiteralsNormalizationState { + slnMap :: StringLiteralsMap, + nameCounter :: Int + } +type StringLiteralsNormalization a = State StringLiteralsNormalizationState a + +newTokName :: String -> StringLiteralsNormalization String +newTokName str = do + n <- gets nameCounter + modify $ (\ s -> s{nameCounter = n + 1}) + return $ "tok_" ++ (translateStrLiteral str) ++ "_" ++ (show n) + +addStrLit :: String -> StringLiteralsNormalization String +addStrLit str = do + m <- gets slnMap + case Map.lookup str m of + Nothing -> do + tokName <- newTokName str + modify $ \s -> s{slnMap = Map.insert str tokName m} + return tokName + Just tokName -> return tokName + +normalizeClause :: IClause -> StringLiteralsNormalization IClause +normalizeClause (IStrLit str) = do + tokName <- addStrLit str + return $ IIgnore (IId tokName) +normalizeClause c = return c + +normalizeRule :: IRule -> StringLiteralsNormalization IRule +normalizeRule r@IRule{getIRuleName=rn, getIClause=cl} | not (isLexicalRule rn) = do + newCl <- everywhereM (mkM normalizeClause) cl + return r{getIClause = newCl} +normalizeRule r = return r + +doSLNM :: InitialGrammar -> StringLiteralsNormalization InitialGrammar +doSLNM grammar = do + newGr <- everywhereM (mkM normalizeRule) grammar + return newGr + +normalizeStringLiterals :: InitialGrammar -> InitialGrammar +normalizeStringLiterals grammar = let (InitialGrammar nm imports rules, StringLiteralsNormalizationState m _) = runState (doSLNM grammar) (StringLiteralsNormalizationState Map.empty 0) + slRules sm = map (\ (k, v) -> IRule (Just "Keyword") (Just "id") v (IStrLit k) [] Nothing) $ Map.toList sm + in InitialGrammar nm imports (rules ++ slRules m) diff --git a/Syntax.hs b/Syntax.hs new file mode 100644 --- /dev/null +++ b/Syntax.hs @@ -0,0 +1,146 @@ +-- | The core data types of the grammar-processing pipeline: the parsed +-- grammar ('InitialGrammar' and its clauses), the normalized grammar +-- ('NormalGrammar' and friends) that the code generators consume, and the +-- pure helpers over them. +-- +-- These types used to live in the footer of the hand-written @Parser.y@. +-- They are owned by the pipeline, not by any particular front end: both the +-- hand-written parser and the generated one (via @ASTAdapter@) produce an +-- 'InitialGrammar', and everything downstream is front-end agnostic. +module Syntax where + +import Data.Char (isLower) +import Data.Data (Data) +import Data.List (intercalate) +import qualified Data.Map as M +import qualified Data.Set as S + +import Diagnostics (SourcePos) + +data InitialGrammar = InitialGrammar { getIGrammarName :: String, getImports :: String, getIRules :: [IRule] } + deriving (Eq, Show, Data) + +data IRule = IRule { getIDataTypeName :: (Maybe String), + getIDataFunc :: (Maybe String), + getIRuleName :: String, + getIClause :: IClause, + getIRuleOptions :: [IOption], + getIRulePos :: (Maybe SourcePos)} + deriving (Eq, Show, Data) + +data IOption = OShortcuts [ID] | OSymmacro + deriving (Eq, Show, Data) + +addRuleOptions :: [IOption] -> IRule -> IRule +addRuleOptions opts rule = rule{ getIRuleOptions = opts ++ (getIRuleOptions rule)} + +type ConstructorName = String + +type ID = String + +data IClause = IId { getIdStr :: ID } + | IStrLit String + | IDot + | IRegExpLit String + | IStar IClause (Maybe IClause) + | IPlus IClause (Maybe IClause) + | IAlt [IClause] + | ISeq [IClause] + | IOpt IClause + | ILifted IClause + | IIgnore IClause + deriving (Eq, Show, Data) + +-- Render a clause the way it appears in the grammar source, for error messages +showClause :: IClause -> String +showClause (IId name) = name +showClause (IStrLit s) = "'" ++ s ++ "'" +showClause IDot = "." +showClause (IRegExpLit s) = "[" ++ s ++ "]" +showClause (IStar c md) = showClause c ++ "*" ++ showDelim md +showClause (IPlus c md) = showClause c ++ "+" ++ showDelim md +showClause (IAlt cs) = "(" ++ intercalate " | " (map showClause cs) ++ ")" +showClause (ISeq cs) = unwords (map showClause cs) +showClause (IOpt c) = showClause c ++ "?" +showClause (ILifted c) = "," ++ showClause c +showClause (IIgnore c) = "!" ++ showClause c + +showDelim :: Maybe IClause -> String +showDelim = maybe "" (\d -> " ~ " ++ showClause d) + +-- | The first line of every generated artifact (lexer spec, parser spec, +-- quasi-quoter module). The banner names the grammar, not the grammar file: +-- a file path would make the generated output - and with it every golden +-- snapshot - depend on where the grammar happens to live. It also carries +-- no rtk version: a version in the banner would couple every release bump +-- to a full golden churn even when the generated code is byte-identical. +provenanceBanner :: String -> String +provenanceBanner name = + "-- Generated by RTK from grammar '" ++ name ++ "'. Do not edit by hand." + +data GrammarInfo = + GrammarInfo + { + getStartRuleName :: Maybe String, + getRuleToStartInfo :: M.Map String String, + getNameCounter :: Int, + getProxyRules :: S.Set String + } + deriving (Eq, Show, Data) + +data AntiRule = AntiRule { arTypeName :: ID, + arQQName :: ID, + arConstr :: ID , + arIsList :: Bool + } + deriving (Eq, Show, Data) + +data NormalGrammar = NormalGrammar { getNGrammarName :: String, + getSyntaxRuleGroups :: [SyntaxRuleGroup], + getLexicalRules :: [LexicalRule], + getAntiRules :: [AntiRule], + getShortcuts :: [(String, String)], + getNImports :: String, + getGrammarInfo :: GrammarInfo } + deriving (Eq, Show, Data) + +data SyntaxRuleGroup = SyntaxRuleGroup { getSDataTypeName :: ID, + getSRules :: [SyntaxRule]} + deriving (Eq, Show, Data) + +data SyntaxRule = SyntaxRule { getSRuleName :: ID, + getSClause :: SyntaxTopClause} + deriving (Eq, Show, Data) + +data STManyOp = STStar + | STPlus + deriving (Eq, Show, Data) + +data STSeq = STSeq ConstructorName [SyntaxSimpleClause] + deriving (Eq, Show, Data) + +data SyntaxTopClause = STMany STManyOp SyntaxSimpleClause (Maybe SyntaxSimpleClause) + | STOpt SyntaxSimpleClause + | STAltOfSeq { getAltOfSeq :: [STSeq] } -- alternative of sequences + deriving (Eq, Show, Data) + +data SyntaxSimpleClause = SSId ID + | SSLifted ID + | SSIgnore ID + deriving (Eq, Show, Data) + +data LexicalRule = LexicalRule { getLRuleDataType :: String, + getLRuleFunc :: String, + getLRuleName :: String, + getLClause :: LClause} + | MacroRule { getLRuleName :: String, getLClause :: LClause} + deriving (Eq, Show, Data) + +type LClause = IClause + +isLexicalRule :: String -> Bool +isLexicalRule [] = False +isLexicalRule (c:_) = isLower c + +filterProxyRules :: S.Set ID -> [SyntaxRuleGroup] -> [SyntaxRuleGroup] +filterProxyRules proxyRules rules = filter (((flip S.notMember) proxyRules) . getSDataTypeName) rules diff --git a/TokenProcessing.hs b/TokenProcessing.hs new file mode 100644 --- /dev/null +++ b/TokenProcessing.hs @@ -0,0 +1,45 @@ +module TokenProcessing + ( processTokens + , unBackQuote + , catBigstrs + ) where + +import Lexer (Token(..), PosToken(..)) + +-- | Process tokens after lexical analysis +-- This applies escape sequence handling and concatenates multi-line strings +processTokens :: [PosToken] -> [PosToken] +processTokens = catBigstrs . map processEscapes + +-- | Process escape sequences in string and regex tokens +processEscapes :: PosToken -> PosToken +processEscapes (PosToken pos tok) = PosToken pos (processEscapesTok tok) + +processEscapesTok :: Token -> Token +processEscapesTok (StrLit s) = StrLit (unBackQuote s) +processEscapesTok (RegExpLit s) = RegExpLit (unBackQuote s) +processEscapesTok tok = tok + +-- | Handle backslash escape sequences +-- Preserves \\n, \\t, \\r, \\f, \\v as-is (for grammar rules); this must stay +-- exactly the set that GenX.isAlexEscape emits bare into the generated lexer +-- Removes backslash from other escaped characters +unBackQuote :: String -> String +unBackQuote ('\\':'n':xs) = '\\':'n' : unBackQuote xs +unBackQuote ('\\':'t':xs) = '\\':'t' : unBackQuote xs +unBackQuote ('\\':'r':xs) = '\\':'r' : unBackQuote xs +unBackQuote ('\\':'f':xs) = '\\':'f' : unBackQuote xs +unBackQuote ('\\':'v':xs) = '\\':'v' : unBackQuote xs +unBackQuote ('\\':c:xs) = c : unBackQuote xs +unBackQuote (c:xs) = c : unBackQuote xs +unBackQuote [] = [] + +-- | Concatenate adjacent BigStr tokens with newlines +-- This handles multi-line triple-quoted strings +-- The merged token keeps the position of the first part +catBigstrs :: [PosToken] -> [PosToken] +catBigstrs (PosToken pos (BigStr s1) : toks) = case catBigstrs toks of + (PosToken _ (BigStr s2) : toks') -> (PosToken pos (BigStr (s1 ++ ('\n' : s2))) : toks') + _ -> PosToken pos (BigStr s1) : toks +catBigstrs (tok : toks) = tok : catBigstrs toks +catBigstrs [] = [] diff --git a/app/main.hs b/app/main.hs new file mode 100644 --- /dev/null +++ b/app/main.hs @@ -0,0 +1,258 @@ +import Lexer +import Parser (parse) +import Syntax +import ASTAdapter (parseWithGenerated, scanTokensGenerated) +import Diagnostics (Diagnostic (..), renderDiagnostic) +import TokenProcessing +import StringLiterals +import Normalize +import GenY +import GenX +import GenQ +import DebugOptions +import qualified Debug as D +import Control.Monad (when) +import Data.Data (Data) +import Data.IORef (newIORef, readIORef, writeIORef) +import Data.Maybe (catMaybes, isJust) +import Control.Exception (IOException, evaluate, try) +import System.Directory (createDirectoryIfMissing) +import System.IO (hPutStrLn, stderr) +import System.Exit (exitSuccess, exitWith, ExitCode (ExitFailure)) + +main :: IO () +main = do + -- Parse command-line options + opts <- parseOptions + + -- Load grammar file + content <- readFile (grammarFile opts) + + -- --debug-rule: trace one rule through the pipeline, printing only its + -- representation after each stage. Remember whether it was seen at any + -- stage so an unknown name can fail the run at the end (catches typos). + ruleFound <- newIORef False + let traceRule trace = case debugRule opts of + Just name -> do + found <- trace name + when found $ writeIORef ruleFound True + Nothing -> return () + + -- Stages 1-2: front end (lexing and parsing). The default is the + -- self-hosted front end: the lexer/parser RTK generated from + -- test-grammars/grammar.pg (compiled from the test/golden/grammar + -- snapshot) plus the AST adapter. --use-handwritten swaps in the + -- hand-written reference Lexer.x/Parser.y instead; everything after this + -- point is the same shared pipeline. The generated front end has no + -- token post-processing stage, so --debug-tokens shows the raw generated + -- token stream and --debug-stage lex stops after the combined front end. + (grammar, frontEndTimings) <- + if useGenerated opts + then do + when (debugTokens opts) $ do + D.debugSection opts "LEXER OUTPUT - TOKENS (generated front end)" + case scanTokensGenerated content of + Left _ -> return () -- the parse below reports it + Right toks -> do + putStrLn $ "Total tokens: " ++ show (length toks) + putStrLn "" + mapM_ putStrLn toks + (eGrammar, maybeT) <- runStage opts "Front End (generated)" $ + parseWithGenerated content + g <- orDie opts eGrammar + traceRule $ \name -> do + D.traceRuleTokensUnavailable opts name + return False + when (debugStage opts == Just StageLex) + exitAfterDebug + return (g, [maybeT]) + else do + -- Stage 1: Lexical Analysis + (eRawTokens, maybeT1) <- runStage opts "Lexical Analysis" $ scanTokens content + rawTokens <- orDie opts eRawTokens + + -- Stage 1.5: Token Post-Processing + -- Process escape sequences and concatenate multi-line strings + (tokens, maybeT1_5) <- runStage opts "Token Post-Processing" $ processTokens rawTokens + + when (debugTokens opts) $ + D.printTokens opts tokens + + traceRule $ \name -> D.traceRuleTokens opts name tokens + + when (debugStage opts == Just StageLex) + exitAfterDebug + + -- Stage 2: Parsing + (eGrammar, maybeT2) <- runStage opts "Parsing" $ parse tokens + g <- orDie opts eGrammar + return (g, [maybeT1, maybeT1_5, maybeT2]) + + when (debugParse opts) $ + D.printInitialGrammar opts grammar + + traceRule $ \name -> D.traceRuleInitial opts name "After Parse" grammar + + when (debugStage opts == Just StageParse) + exitAfterDebug + + -- Stage 3: String Literal Normalization + (grammar0, maybeT3) <- runStage opts "String Normalization" $ normalizeStringLiterals grammar + + when (debugStringNorm opts) $ + D.printComparison opts "Before String Normalization" grammar "After String Normalization" grammar0 + + traceRule $ \name -> D.traceRuleInitial opts name "After String Normalization" grammar0 + + when (debugStage opts == Just StageStringNorm) + exitAfterDebug + + -- Stage 4: Clause Normalization + (eGrammar1, maybeT4) <- runStage opts "Clause Normalization" $ normalizeTopLevelClauses grammar0 + grammar1 <- orDie opts eGrammar1 + + when (debugClauseNorm opts) $ + D.printNormalGrammar opts "CLAUSE NORMALIZATION OUTPUT" grammar1 + + traceRule $ \name -> D.traceRuleNormal opts name "After Clause Normalization" grammar1 + + when (debugStage opts == Just StageClauseNorm) + exitAfterDebug + + -- Stage 5: Constructor Name Filling + (grammar2, maybeT5) <- runStage opts "Constructor Name Filling" $ fillConstructorNames grammar1 + + when (debugConstructors opts) $ + D.printNormalGrammar opts "FINAL GRAMMAR (with Constructor Names)" grammar2 + + traceRule $ \name -> D.traceRuleNormal opts name "After Constructor Fill" grammar2 + + -- Constructor fill is the last traced stage: a rule that matched nowhere + -- can only be a typo, so fail the run + case debugRule opts of + Just name -> do + found <- readIORef ruleFound + when (not found) $ do + hPutStrLn stderr $ + "rtk: rule '" ++ name ++ "' was not found at any pipeline stage" + exitWith (ExitFailure 1) + Nothing -> return () + + when (debugStage opts == Just StageFillNames) + exitAfterDebug + + -- Statistics and Analysis (before code generation) + when (showStats opts) $ + D.showGrammarStats opts grammar grammar2 + + when (analyzeConflicts opts) $ + D.analyzeGrammarConflicts opts grammar2 + + when (showRuleGraph opts) $ + D.printRuleGraph opts grammar2 + + when (listRules opts) $ + D.printRuleList opts grammar2 + + -- Validation + when (validateGrammar opts) $ do + valid <- D.runGrammarValidation opts grammar2 + when (not valid) $ + putStrLn "Warning: Grammar has validation issues." + + when (showUnusedRules opts) $ + D.findUnusedRules opts grammar2 + + when (checkLeftRecursion opts) $ + D.detectLeftRecursion opts grammar2 + + when (suggestShortcuts opts) $ + D.suggestGrammarShortcuts opts grammar2 + + -- Expand specific rule if requested + case expandRule opts of + Just ruleName -> D.showExpandedRule opts grammar2 ruleName + Nothing -> return () + + -- Stage 6: Code Generation + let grammar_name = getNGrammarName grammar2 + + (eY, maybeT6) <- runStage opts "Parser (Y) Generation" $ genY grammar2 + y_content <- orDie opts eY + + (eX, maybeT7) <- runStage opts "Lexer (X) Generation" $ genX grammar2 + x_content <- orDie opts eX + + (eQ, maybeT8) <- runStage opts "QuasiQuoter (Q) Generation" $ genQ grammar2 + q_content <- orDie opts eQ + + -- Debug generated specs if requested + when (debugParserSpec opts) $ do + D.debugSection opts "GENERATED HAPPY PARSER SPECIFICATION" + putStrLn y_content + + when (debugLexerSpec opts) $ do + D.debugSection opts "GENERATED ALEX LEXER SPECIFICATION" + putStrLn x_content + + when (debugQQSpec opts) $ do + D.debugSection opts "GENERATED QUASIQUOTER CODE" + putStrLn q_content + + -- Write output files (unless we're only validating). A spec dump still + -- writes the files; validation alone suppresses them. + let specDumpRequested = any id [debugParserSpec opts, debugLexerSpec opts, debugQQSpec opts] + when (not (validateGrammar opts) || specDumpRequested) $ do + let dir = outputDir opts + -- A missing output directory is created on the fly; any remaining + -- IO failure (no permission, a file where the directory should be) + -- is rendered as a one-line diagnostic instead of escaping as an + -- uncaught IOException + written <- try $ do + createDirectoryIfMissing True dir + writeFile (dir ++ "/" ++ grammar_name ++ "Parser.y") y_content + writeFile (dir ++ "/" ++ grammar_name ++ "Lexer.x") x_content + writeFile (dir ++ "/" ++ grammar_name ++ "QQ.hs") q_content + case written of + Left e -> orDie opts $ Left $ Diagnostic Nothing Nothing $ + "cannot write generated files: " ++ show (e :: IOException) + Right () -> return () + + -- Show timing profile if requested + when (profileStages opts) $ do + let allTimings = catMaybes (frontEndTimings ++ [maybeT3, maybeT4, maybeT5, maybeT6, maybeT7, maybeT8]) + when (not $ null allTimings) $ + D.showTimingInfo opts allTimings + + -- Success message + when (not $ any id [debugTokens opts, debugParse opts, debugStringNorm opts, + debugClauseNorm opts, debugConstructors opts, + debugParserSpec opts, debugLexerSpec opts, debugQQSpec opts, + showStats opts, validateGrammar opts, + isJust (debugRule opts)]) $ do + putStrLn $ "Successfully generated files for " ++ grammar_name + +-- | Either surface a pipeline diagnostic on stderr and exit 1, or return the +-- value. The grammar file name gives the diagnostic its GNU-style prefix. +orDie :: DebugOptions -> Either Diagnostic a -> IO a +orDie opts (Left d) = do + hPutStrLn stderr (renderDiagnostic (grammarFile opts) d) + exitWith (ExitFailure 1) +orDie _ (Right a) = return a + +-- | Run one pure pipeline stage. Under --profile-stages the result is forced +-- to normal form inside the timed window, so the timing reflects the stage +-- that produced the value rather than the stage that first consumed it. +runStage :: Data a => DebugOptions -> String -> a -> IO (a, Maybe D.TimingInfo) +runStage opts name value + | profileStages opts = do + (result, timing) <- D.timed name $ evaluate $ D.deepForce value + return (result, Just timing) + | otherwise = return (value, Nothing) + +-- Helper function +exitAfterDebug :: IO () +exitAfterDebug = do + putStrLn "" + putStrLn "Stopped after requested debug stage." + exitSuccess diff --git a/rtk.cabal b/rtk.cabal new file mode 100644 --- /dev/null +++ b/rtk.cabal @@ -0,0 +1,158 @@ +Cabal-Version: 2.4 +Name: rtk +Version: 0.11 +Synopsis: Parser and rewrite facility generator from grammar specifications +Description: RTK (Rewrite ToolKit) generates Alex lexer and Happy parser + files from grammar specifications. It supports quasi-quotation + for embedding parsed syntax in Haskell code. + . + Projects that compile the generated modules need to depend on + @array@ and @syb@ (lexer and parser), plus @containers@ and + @template-haskell@ for the generated quasi-quoter; see the + README for details. +License: MIT +License-File: LICENSE +Author: prozak +Maintainer: nickolay.lysenko@gmail.com +Homepage: https://github.com/prozak/rtk +Bug-Reports: https://github.com/prozak/rtk/issues +Category: Language, Development +Build-Type: Simple +Tested-With: GHC == 9.4.7 || == 9.6.4 + +Extra-Source-Files: + CHANGELOG.md + README.md + test-grammars/*.pg + test/golden/**/*.x + test/golden/**/*.y + test/golden/**/*.hs + +Source-Repository head + Type: git + Location: https://github.com/prozak/rtk.git + +Common warnings + Default-Language: Haskell2010 + ghc-options: -Wall -Wunused-imports -Wunused-top-binds -Wunused-local-binds -Wunused-matches + +-- The self-hosted front end (the default): the lexer/parser RTK generated +-- from test-grammars/grammar.pg, compiled directly from the checked-in golden +-- snapshot in test/golden/grammar (the bootstrap stage, produced by the +-- previous rtk binary like every self-hosting compiler's stage files). +-- Compiling the snapshot directly means `make accept-golden` keeps the build +-- input of the default front end in sync by construction. +-- GrammarQQ deliberately stays out: compiling the generated quasi-quoter +-- would pull Template Haskell into the bootstrap build path. +-- Separate component because generated alex code trips -Wunused-matches +-- (happy output carries its own -w; alex output does not suppress that one), +-- and the snapshot must not be edited to placate the linter. +Library generated-frontend + Import: warnings + ghc-options: -Wno-unused-matches + -- The snapshot's splice-token actions use 'tail', which GHC >= 9.8 warns + -- about on every use (-Wx-partial, on by default). Same policy as + -- -Wno-unused-matches above: generated code, not edited to placate the + -- linter. Guarded because older GHCs would warn about the unrecognised + -- flag (fatal under -Werror). + if impl(ghc >= 9.8) + ghc-options: -Wno-x-partial + Hs-Source-Dirs: test/golden/grammar + Exposed-Modules: + GrammarLexer, + GrammarParser + Build-Depends: + base >= 4.17 && < 4.19, + array >= 0.5 && < 0.6, + syb >= 0.7 && < 0.8, + -- grammar.pg's imports section pulls in Data.Map + containers >= 0.6 && < 0.7 + Build-Tool-Depends: happy:happy == 2.2.*, alex:alex == 3.5.* + Default-Extensions: DeriveDataTypeable, StandaloneDeriving + +Library + Import: warnings + Hs-Source-Dirs: . + src/generated + Exposed-Modules: + Diagnostics, + Syntax, + Lexer, + Parser, + TokenProcessing, + Grammar, + GenAST, + GenQ, + GenX, + GenY, + Normalize, + StrQuote, + StringLiterals, + DebugOptions, + Debug, + ASTAdapter + Build-Depends: + generated-frontend, + base >= 4.17 && < 4.19, + array >= 0.5 && < 0.6, + syb >= 0.7 && < 0.8, + template-haskell >= 2.19 && < 2.21, + containers >= 0.6 && < 0.7, + mtl >= 2.2 && < 2.4, + pretty >= 1.1 && < 1.2, + pretty-show >= 1.10 && < 1.11, + MissingH >= 1.6 && < 1.7, + haskell-src-exts >= 1.23 && < 1.24, + haskell-src-meta >= 0.8 && < 0.9, + lens >= 5.2 && < 5.4, + optparse-applicative >= 0.18 && < 0.20, + time >= 1.12 && < 1.13, + ansi-terminal >= 1.0 && < 1.2 + -- CI pins the exact tool versions (alex-3.5.4.2, happy-2.2 in + -- .github/workflows/ci.yml); these ranges must stay compatible with them. + Build-Tool-Depends: happy:happy == 2.2.*, alex:alex == 3.5.* + Default-Extensions: DeriveDataTypeable, StandaloneDeriving + +Executable rtk + Import: warnings + Main-is: main.hs + Hs-Source-Dirs: app + Build-Depends: base >= 4.17 && < 4.19, + directory >= 1.3 && < 1.4, + rtk + ghc-options: -rtsopts + +-- In-process tests of the generation pipeline (lex/parse/normalize/generate). +-- They do not need alex, happy, or a GHC compile cycle, so they are fast and +-- can run with plain `cabal test`. +Test-Suite unit + Import: warnings + Type: exitcode-stdio-1.0 + Main-Is: UnitTests.hs + Hs-Source-Dirs: test + Other-Modules: TestSupport + Build-Depends: + base >= 4.17 && < 4.19, + rtk, + HUnit >= 1.6 && < 1.7, + containers >= 0.6 && < 0.7, + directory >= 1.3 && < 1.4, + filepath >= 1.4 && < 1.6, + syb >= 0.7 && < 0.8 + +-- Golden tests: generated .x/.y/QQ.hs output for every grammar under +-- test-grammars/ is compared against snapshots in test/golden/. +-- Refresh the snapshots with `make accept-golden` after intentional +-- generator changes. +Test-Suite golden + Import: warnings + Type: exitcode-stdio-1.0 + Main-Is: GoldenTests.hs + Hs-Source-Dirs: test + Other-Modules: TestSupport + Build-Depends: + base >= 4.17 && < 4.19, + rtk, + HUnit >= 1.6 && < 1.7, + directory >= 1.3 && < 1.4, + filepath >= 1.4 && < 1.6 diff --git a/src/generated/ASTAdapter.hs b/src/generated/ASTAdapter.hs new file mode 100644 --- /dev/null +++ b/src/generated/ASTAdapter.hs @@ -0,0 +1,167 @@ +-- | The self-hosted front end: parse a grammar source with the lexer and +-- parser that RTK generated from @test-grammars/grammar.pg@, and convert the +-- resulting generated AST to the hand-written 'InitialGrammar' that the rest +-- of the pipeline consumes. +-- +-- The generated modules ('GrammarLexer', 'GrammarParser') are compiled +-- straight from the checked-in golden snapshot in @test/golden/grammar/@, so +-- @make accept-golden@ keeps this front end in sync with the generators by +-- construction. +-- +-- The conversion is plain total pattern matching on the generated +-- constructors. It has to replicate two things the hand-written front end +-- does between lexing and parsing: +-- +-- * the hand-written lexer strips literal delimiters from token text +-- (quotes around @'str'@, brackets around @[regex]@, triple quotes around +-- @\"\"\"bigstr\"\"\"@) while the generated lexer keeps the full match, +-- so 'convertGrammar' strips them here; +-- +-- * 'TokenProcessing.processTokens' applies 'unBackQuote' to string and +-- regex literals, so 'convertGrammar' applies the same exported function +-- to those leaves. +-- +-- Every generated constructor (except the quasi-quotation-only @Anti_*@ +-- ones) carries the source position of its first symbol in its first field; +-- the adapter maps the rule constructors' position into 'getIRulePos', so +-- diagnostics under the default front end point at real source locations, +-- the same ones the hand-written reference front end records. +module ASTAdapter + ( parseWithGenerated + , scanTokensGenerated + , convertGrammar + ) where + +import qualified GrammarLexer as GL +import qualified GrammarParser as GP + +import Diagnostics (Diagnostic, SourcePos(..), diagnosticFromPositioned) +import Syntax (IClause(..), IOption(..), IRule(..), InitialGrammar(..), + addRuleOptions) +import TokenProcessing (unBackQuote) + +-- | Lex and parse a grammar source with the generated front end and adapt the +-- result. The generated lexer and parser encode error positions as +-- @\"LINE:COL:message\"@ (the same encoding the hand-written lexer uses), so +-- their failures are split back into a positioned 'Diagnostic' here and +-- render with the same GNU-style @FILE:LINE:COL:@ prefix as the hand-written +-- front end's. +parseWithGenerated :: String -> Either Diagnostic InitialGrammar +parseWithGenerated src = + case GL.scanTokens src >>= GP.parseGrammar of + Left msg -> Left (diagnosticFromPositioned msg) + Right g -> Right (convertGrammar g) + +-- | The generated lexer's token stream, rendered one token per line for +-- @--debug-tokens@. The generated front end has no separate token +-- post-processing stage (the adapter strips delimiters and escapes during +-- AST conversion), so this is the stream exactly as the parser consumes it. +scanTokensGenerated :: String -> Either Diagnostic [String] +scanTokensGenerated src = + case GL.scanTokens src of + Left msg -> Left (diagnosticFromPositioned msg) + Right toks -> Right (map show toks) + +-- | Convert the generated AST to the hand-written 'InitialGrammar'. +convertGrammar :: GP.Grammar -> InitialGrammar +convertGrammar (GP.Ctr__Grammar__11 _ gname imports rules) = + InitialGrammar { getIGrammarName = strLit gname + , getImports = importsOpt imports + , getIRules = map rule rules + } +convertGrammar g = qqOnly "Grammar" g + +rule :: GP.Rule -> IRule +rule (GP.Ctr__Rule__0 p n c) = mkRule p Nothing Nothing n c +rule (GP.Ctr__Rule__1 p t n c) = mkRule p (Just (name t)) Nothing n c +rule (GP.Ctr__Rule__2 p t f n c) = mkRule p (Just (name t)) (Just (name f)) n c +rule (GP.Ctr__Rule__3 p f n c) = mkRule p Nothing (Just (name f)) n c +rule (GP.Ctr__Rule__4 _ opts r) = addRuleOptions (map option opts) (rule r) +rule r@GP.Anti_Rule{} = qqOnly "Rule" r + +mkRule :: GP.RtkPos -> Maybe String -> Maybe String -> GP.Name -> GP.Clause -> IRule +mkRule p dataType dataFunc n c = + IRule dataType dataFunc (name n) (topClause c) [] (Just (sourcePos p)) + +-- | The position of a rule's first token, as the hand-written parser's +-- 'SourcePos' (the hand-written front end records the same token's position). +sourcePos :: GP.RtkPos -> SourcePos +sourcePos (GP.RtkPos (GL.AlexPn _ line col)) = SourcePos line col + +option :: GP.Option -> IOption +option (GP.Ctr__Option__0 _ ids) = OShortcuts (map name ids) +option (GP.Ctr__Option__1 _) = OSymmacro +option o@GP.Anti_Option{} = qqOnly "Option" o + +importsOpt :: GP.ImportsOpt -> String +importsOpt (GP.Ctr__ImportsOpt__0 _) = "" +importsOpt (GP.Ctr__ImportsOpt__1 _ (GP.Ctr__Rule_0__0 _ big)) = stripEnds 3 big +importsOpt i@GP.Anti_ImportsOpt{} = qqOnly "ImportsOpt" i + +-- | A clause in alternative position: a rule's right-hand side or a +-- parenthesized group. The hand-written parser always wraps these as an +-- alternative of sequences, even degenerate ones, so this does too. +topClause :: GP.Clause -> IClause +topClause c = IAlt [ ISeq (map preClause (seqElems alt)) | alt <- altElems c ] + +-- | Flatten the left-recursive @'|'@ spine into source-order alternatives. +-- The right operand of each node is a single alternative, never another +-- alternation (parenthesized alternations stay as elements and get wrapped +-- by 'itemClause'). +altElems :: GP.Clause -> [GP.Clause] +altElems (GP.Ctr__Clause__14 _ l r) = altElems l ++ [r] +altElems c = [c] + +-- | Flatten the left-recursive juxtaposition spine of one alternative. +seqElems :: GP.Clause -> [GP.Clause] +seqElems (GP.Ctr__Clause__12 _ l r) = seqElems l ++ [r] +seqElems c = [c] + +preClause :: GP.Clause -> IClause +preClause (GP.Ctr__Clause__9 _ c) = ILifted (postClause c) +preClause (GP.Ctr__Clause__10 _ c) = IIgnore (postClause c) +preClause c = postClause c + +postClause :: GP.Clause -> IClause +postClause (GP.Ctr__Clause__5 _ c d) = IStar (itemClause c) (delim d) +postClause (GP.Ctr__Clause__6 _ c d) = IPlus (itemClause c) (delim d) +postClause (GP.Ctr__Clause__7 _ c) = IOpt (itemClause c) +postClause c = itemClause c + +-- | A clause in item position: a leaf, or — when it is still a sequence, +-- alternation, lift, ignore or repetition — a construct that can only have +-- come from a parenthesized group, which the hand-written parser represents +-- as a nested @IAlt [ISeq …]@. The generated parser drops the parentheses +-- themselves, so redundant parens around a single leaf normalize away. +itemClause :: GP.Clause -> IClause +itemClause (GP.Ctr__Clause__1 _ n) = IId (name n) +itemClause (GP.Ctr__Clause__2 _ s) = IStrLit (strLit s) +itemClause (GP.Ctr__Clause__3 _) = IDot +itemClause (GP.Ctr__Clause__4 _ s) = IRegExpLit (unBackQuote (stripEnds 1 s)) +itemClause c@GP.Anti_Clause{} = qqOnly "Clause" c +itemClause c = topClause c + +delim :: GP.OptDelim -> Maybe IClause +delim (GP.Ctr__OptDelim__0 _) = Nothing +delim (GP.Ctr__OptDelim__1 _ (GP.Ctr__Rule_4__0 _ c)) = Just (itemClause c) +delim d@GP.Anti_OptDelim{} = qqOnly "OptDelim" d + +name :: GP.Name -> String +name (GP.Ctr__Name__0 _ s) = s +name n@GP.Anti_Name{} = qqOnly "Name" n + +strLit :: GP.StrLit -> String +strLit (GP.Ctr__StrLit__0 _ s) = unBackQuote (stripEnds 1 s) +strLit s@GP.Anti_StrLit{} = qqOnly "StrLit" s + +-- | Drop @n@ delimiter characters from both ends of a token's text. +stripEnds :: Int -> String -> String +stripEnds n s = take (length s - 2 * n) (drop n s) + +-- | The generated grammar also contains constructors that only quasi-quote +-- splices can produce: @Anti_*@ metavariables and the @Ctr__Grammar__0..10@ +-- start-rule wrappers around dummy tokens. Parsing a grammar source file +-- cannot reach them, so they are an internal error rather than a diagnostic. +qqOnly :: Show a => String -> a -> b +qqOnly ty v = error $ "ASTAdapter: quasi-quotation-only " ++ ty + ++ " constructor cannot come from a grammar file: " ++ show v diff --git a/test-grammars/debug-test.pg b/test-grammars/debug-test.pg new file mode 100644 --- /dev/null +++ b/test-grammars/debug-test.pg @@ -0,0 +1,33 @@ +grammar 'DebugTest'; + +# This grammar is designed to test all debug options + +# Start rule - will be reached +Program = Statement *; + +# Various statement types (some will be unreachable) +Statement = Assignment + | IfStatement + | WhileLoop + | Block; + +# Reachable rules +Assignment = identifier '=' Expression ';'; +Expression = Term (('+' | '-') Term)*; +Term = Factor (('*' | '/') Factor)*; +Factor = identifier | number | '(' Expression ')'; + +IfStatement = 'if' '(' Expression ')' Statement + | 'if' '(' Expression ')' Statement 'else' Statement; + +WhileLoop = 'while' '(' Expression ')' Statement; + +Block = '{' Statement * '}'; + +# Unreachable rules (to test --unused-rules) +UnusedRule1 = 'unused' identifier; +UnusedRule2 = UnusedRule1 *; + +# Lexical rules +identifier = ['a'-'z' 'A'-'Z'] ['a'-'z' 'A'-'Z' '0'-'9']* ; +number = ['0'-'9']+; diff --git a/test-grammars/grammar.pg b/test-grammars/grammar.pg new file mode 100644 --- /dev/null +++ b/test-grammars/grammar.pg @@ -0,0 +1,81 @@ +grammar 'Grammar'; + +/* +Section of Haskell imports. Would go to the source code directly +*/ + +imports """ +import Data.List +import qualified Data.Map as M +""" + +/* +Grammar rules section. These rules are started with capital letter +*/ + +/* a */ + +Grammar = 'grammar' StrLit ';' ImportsOpt RuleList ; + +ImportsOpt = ('imports' bigstr)? ; + +RuleList = Rule *; + +@shortcuts(r) +Rule = OptionList Rule1 + | ,Rule1 ; + +Rule: Rule1 = Name '=' Clause ';' + | Name ':' Name '=' Clause ';' + | Name '.' Name ':' Name '=' Clause ';' + | '.' Name ':' Name '=' Clause ';' ; + +OptionList = Option+ ; + +Option = '@shortcuts' '(' IdList ')' | '@symmacro' ; + +IdList = Name* ~ ',' ; + +@shortcuts(cl) +Clause = Clause '|' Clause2 + | ,Clause2; + +Clause: Clause2 = Clause2 Clause3 + | ,Clause3 ; + +Clause: Clause3 = ',' Clause4 + | '!' Clause4 + | ,Clause4 ; + +Clause: Clause4 = Clause5 '*' OptDelim + | Clause5 '+' OptDelim + | Clause5 '?' + | ,Clause5 ; + +Clause: Clause5 = '(' ,Clause ')' + | Name + | StrLit + | '.' + | regexplit ; + +OptDelim = ('~' Clause5)? ; + +StrLit = str ; +Name = id ; + +/* +Lexical rules section. These rules are started with regular letter +*/ + +id = [a-zA-Z][A-Za-z0-9_]* ; +str = '\'' ([^'] | '\\\'')* '\'' ; +@symmacro +dq = '"' ; # production would not be generated for symmacro +@symmacro +ndq = [^"] ; +bigstr = dq dq dq (ndq|dq ndq| dq dq ndq |[\n])* dq dq dq; +regexplit = '[' ([^\]] | '\\]')* ']' ; +Ignore: ws = [ \t\n]+ ; +Ignore: comment = '#' .* [\n] ; +Ignore: comment1 = '/*' ([^\*]|[\*][^\/]|[\n])* '*/'; + diff --git a/test-grammars/haskell.pg b/test-grammars/haskell.pg new file mode 100644 --- /dev/null +++ b/test-grammars/haskell.pg @@ -0,0 +1,165 @@ +grammar 'Haskell'; + +Haskell = Module ; + +Module = 'module' ModId ExportsOpt 'where' Body | Body; + +ExportsOpt = ( '(' ExportsList (',')?')' )?; + +ExportsList = Export * ',' ; + +Export = 'module' ModId | QVar | QTyCon ( '(' '..' ')' | '(' CNameList ')')? | QTyCls ( '(' '..' ')' | '(' QVarList ')')?; + +Body = '{' (ImpDeclList (';' TopDecls)? | ImpDeclList) '}' ; + +ImpDeclList = ImpDecl + ';'; + +ImportList = Import * ',' ; + +Var = varid; +Con = conid; + +ModIdList = (ModId '.')*; + +QVarId = ModIdList varid; +QVar = QVarId; + +QTyCls = ModIdList TyCls; + +QTyCon = ModIdList TyCon; + +CName = Var | Con ; + +CNameList = CName * ',' ; + +QVarList = QVar * ',' ; + +Import = Var | TyCon ( '(' '..' ')' | '(' CNameList ')' )? ; + +OptQualified = ('qualified')?; +OptQualifiedAs = ('as' ModId)?; +OptImpSpec = '(' ImportList (',')? ')' ; + +ImpDecl = 'import' OptQualified ModId OptQualifiedAs OptImpSpec? ; + +TopDecls = TopDecl * ';'; + +TopDecl = 'type' SimpleType '=' Type + | 'data' OptContext SimpleType '=' Constrs OptDeriving + | Decl; + +Decl = GenDecl | + (FunLhs | Pat) Rhs ; + +OptContext = (Context '=>')? ; + +GenDecl = Vars '::' OptContext Type + | Fixity OptInteger Ops; + +OptInteger = (integer)? ; + +Ops = Op * ',' ; + +Fixity = 'infixl' | 'infixr' | 'infix' ; + +FunLhs = Var ; + +# TODO: incomplete (issue #30) -- only constructor patterns over plain +# variables; the variable-only case is already covered by FunLhs +Pat = Con (Var)* ; + +OptWhere = ('where' Decls) ; + +DeclList = Decl * ';' ; + +Decls = '{' DeclList '}' ; + +Rhs = '=' Exp OptWhere + | GdRhs OptWhere; + +OptGdRhs = (GdRhs)? ; + +# An optional guard expression. (Formerly written with an empty first +# alternative 'Gd = | ExpI ;', hand-parser-only syntax that grammar.pg cannot +# derive; a top-level option normalizes to exactly the same empty-or-present +# alternatives.) +Gd = ExpI? ; + +OptExpTypeSignature = ('::' OptContext Type)?; + +Exp = ExpI OptExpTypeSignature ; + +ExpI = ExpI (QOp ExpI)*; + +GdRhs = Gd '=' Exp OptGdRhs ; + +Constrs = Constr * '|' ; + +Constr = Con '{' FieldDeclList '}'; + +FieldDeclList = FieldDecl * ',' ; + +FieldDecl = Vars '::' (Type | '!' AType) ; + +Vars = Var * ',' ; + +OptDeriving = (Deriving)? ; + +Deriving = 'deriving' (DClass | '(' DClassList ')' ) ; + +DClassList = DClass * ',' ; + +DClass = QTyCls ; + +Context = Class | '(' ClassList ')' ; + +ClassList = Class * ',' ; + +Class = QTyCls TyVar | QTyCls '(' TyVar ATypeList ')'; + +Type = BType ('->' Type)? ; + +BType = (BType)? AType ; + +ATypeList = AType * ; + +AType = TyVar + | GTyCon + | '(' (TypeList /*| ',' +*/) ')' # TODO: this should be fixed + | '[' (Type)? ']'; + +GTyCon = QTyCon + | '(' '->' ')' ; + +TypeList = Type * ',' ; + +SimpleType = TyCon TyVars ; + +TyVars = TyVar * ; + +conid = [A-Z] [a-zA-Z_0-9]* ; +varid = [a-zA-Z_] [a-zA-Z_0-9]* ; +TyVar = varid ; + +TyCon = conid ; +ModId = conid ; +TyCls = conid ; +Op = varid | conid ; + +# TODO: incomplete (issue #30) -- symbolic and backtick-quoted operators are +# not covered; an optionally qualified Op, mirroring QVarId +QOp = ModIdList Op ; + +decimal = [0-9]+ ; +octal = [0-7]+ ; +hexadecimal = [0-9A-Fa-f]+ ; + +integer = decimal + | ('0o' | '0O') octal + | ('0x' | '0X') hexadecimal ; + +whitespace = [ \t\n] ; + +Ignore: comment = '--' .* [\n] ; +ncomment = '{-' (.|[\n])* '-}' ; +th = '$(' ([^\)]|[\n])* ')' ; diff --git a/test-grammars/i14.pg b/test-grammars/i14.pg new file mode 100644 --- /dev/null +++ b/test-grammars/i14.pg @@ -0,0 +1,23 @@ +grammar 'I14'; + +# Issue #14 fixture: 'Shape' and 'Label' are pure type groups - they exist +# only through rule annotations, no rule carries the type's name. rtk +# synthesizes the lifted cover rule for each demanded one +# (Shape = ,Circle | ,Square ; Label = ,Note ;), exactly what authors +# otherwise write by hand (java.pg's +# "Expression : Expression = AssignmentExpression ;"). + +# A plain reference to the bare type name +Start = Shape Items ; + +Shape : Circle = 'circle' num ; +Shape : Square = 'square' num ; + +# The original issue shape: a list over the bare type name +Items = Shape* ~ ',' ; + +# Never referenced by name: only the QQ start wrapper demands its cover +Label : Note = 'note' num ; + +num = [0-9]+ ; +Ignore: ws = [ \t\n]+ ; diff --git a/test-grammars/java-simple.pg b/test-grammars/java-simple.pg new file mode 100644 --- /dev/null +++ b/test-grammars/java-simple.pg @@ -0,0 +1,21 @@ +grammar 'JavaSimple'; + +JavaSimple = CompilationUnit ; + +CompilationUnit = Package? ClassDeclaration? ; + +Package = 'package' CompoundName ';' ; + +ClassDeclaration = 'public'? 'class' id '{' FieldList '}' ; + +FieldList = Field* ; + +Field = Type id ';' ; + +Type = 'int' | 'String' | id ; + +CompoundName = id | CompoundName '.' id ; + +id = [a-zA-Z_][A-Za-z0-9_]* ; + +Ignore: ws = [ \t\n\r]+ ; diff --git a/test-grammars/java.pg b/test-grammars/java.pg new file mode 100644 --- /dev/null +++ b/test-grammars/java.pg @@ -0,0 +1,786 @@ +grammar 'Java'; + +# ============================================================================ +# LALR conflict inventory (happy: 17 shift/reduce, 0 reduce/reduce) +# ============================================================================ +# Every remaining conflict is a shift/reduce whose default resolution (shift) +# is the correct Java reading. They fall into seven families; the items +# identify the automaton state (happy -i state numbers move with every +# grammar change, the items do not): +# +# 1. Dangling else - 1 state, 2 conflicts: 'else' and its splice token +# qq_OptElsePart, against reduce OptElsePart -> empty. Item: +# IfStatement -> 'if' '(' Expression ')' Statement . OptElsePart +# Shift binds the else part to the NEAREST 'if'; the reduce would close +# this if and hand the 'else' to an enclosing one. Shifting is the JLS +# 14.5 rule. See IfStatement. +# +# 2. catch/finally attach to the nearest try - 1 state, 4 conflicts: +# 'catch', 'finally' and their splice tokens qq_CatchList, qq_OptFinally, +# against reduce OptFinally -> empty. Items: +# TryStatement -> 'try' Statement CatchList . OptFinally +# CatchList -> CatchList . ('catch' '(' Parameter ')' Statement) +# In 'try try { } catch (E e) { } finally { }' each clause could extend +# the inner try (shift) or close it and attach to the outer one (reduce). +# Java attaches both to the nearest try. +# +# 3. Member id vs empty TypeParameters - 2 states (a type body after +# ModifierList, and the MemberDeclaration QQ entry), 1 conflict each on +# id, against reduce TypeParameters -> empty. Items: +# MemberDeclaration -> . id MemberAfterFirstId +# TypeParameters -> . +# In 'Foo bar(...)' the id either starts the non-generic alternative +# (shift) or follows an empty TypeParameters inside the generic one +# (reduce). No input is lost: id MemberAfterFirstId derives everything +# the empty-TypeParameters generic alternative would. +# +# 4. Greedy CompoundName '.' - 1 state, 1 conflict on '.', against reduce +# CompoundName -> id CompoundNameTail . Item: +# CompoundNameTail -> CompoundNameTail . ('.' id) +# 'a.b.c' extends the unreduced name instead of reducing 'a' early and +# parsing '.' as a field access; PostfixExpression '.' id still handles +# non-name bases ('f().x', 'this.x'), so no input is lost. The state +# also holds the class-literal/qualified-this/generic-invocation items +# anchored on the same 'id CompoundNameTail' prefix; they ride the SAME +# '.' shift, and the token after the '.' picks the branch (id extends +# the name, 'class'/'this'/'<' commit to one of them) - see the NOTE at +# PrimaryNoPostfix. Only expression positions carry those items: pure +# type positions (package, throws, extends, after 'new', ...) parse the +# name in a twin state without them and without the conflict. +# +# 5. Bracket-list shifts on '[' - 5 states, 1 conflict each: +# - after CompoundName in an expression, at statement start, and in a +# cast head (reduce: the call-parens option ('(' Arglist ')')? -> +# empty, i.e. commit to the bare name as a complete primary). Items: +# PrimaryNoPostfix -> CompoundName . '[' Expression ']' +# Type -> CompoundName . NonEmptyDims (and the +# CastExpression heads in the cast state) +# - after DimExprs and after NonEmptyDims in array creation (reduce: +# stop the dims list). Items: +# DimExprs -> DimExprs . ('[' Expression ']') +# NonEmptyDims -> NonEmptyDims . ('[' ']') +# Shifting '[' defers the type-vs-access decision by exactly one token +# (']' means a type's empty pair, an expression start means array +# access/sizing) or greedily extends the dims list; no input is lost. +# See the NOTEs at Dims and PrimaryNoPostfix. +# +# 6. '<' commits to type arguments - 2 states, 1 conflict each on '<': +# after CompoundName at statement start and in a cast head (reduce: bare- +# name primary, as in family 5). Standard for LALR Java parsers; see the +# NOTE at TypeArguments. Only the cast-head state loses real input +# ('(a < b)' as a parenthesized primary, see KNOWN LIMITATION at +# CastExpression); the other rejects only semantically invalid Java +# ('a < b;' as a bare statement-expression). The family's third state - +# pure type position, reduce Type -> CompoundName, whose lookahead held +# '<' only through 'x instanceof T < y' - vanished when +# RelationalExpression became non-associative: '<' no longer follows a +# complete relational operand. The same restructure lets ShiftOp be +# composed from single '>' tokens with NO conflict at all: RelationalOp +# '>' and ShiftOp '>' '>' share the shift of the first '>', and the next +# token splits them deterministically (another '>' extends the shift +# operator, an operand start reduces RelationalOp). See the NOTEs at +# RelationalExpression and ShiftOp. +# +# 7. QQ bootstrap dummy bracket - 1 state, 1 conflict. The quasi-quoter +# wraps a quote body in a per-rule dummy-token pair, and the whole-file +# entry 'Java -> DUMMY . Java DUMMY' lets a second opening DUMMY (shift) +# compete with deriving an empty CompilationUnit ((Package)? -> empty) +# right before the closing DUMMY (reduce). Only a completely empty +# [java| |] quote is affected (it fails to parse); any non-empty quote +# has a real token after the opening DUMMY. +# +# The cast-vs-paren decision one token AFTER ')' is conflict-free; see +# CastExpression. +# ============================================================================ + +Java = CompilationUnit ; + +OptDocComment = (DocComment)? ; + +TypeDeclaration = + OptDocComment ModifierList TypeDeclRest ; + +ImportList = (ImportStatement)*; +CompilationUnit = + (Package)? + ImportList + (TypeDeclaration)? ; + +Package = + 'package' CompoundName ';' ; + +ImportStatement = + 'import' ('static')? ImportName ';' ; + +# Import names have their own LEFT-recursive spelling instead of reusing +# CompoundName: the on-demand form would need CompoundName reduced on +# lookahead '.' (to then shift '.' '*'), but that reduce loses to the greedy +# name-extension shift (family 4), which made the star branch unreachable +# ('import a.b.*;' never parsed). Left recursion keeps both '.' +# continuations in one item set, so the token AFTER each '.' (id vs '*') +# picks the branch - no early commitment, no conflict. +ImportName = + ImportHead + | ImportHead '.' '*' ; + +ImportHead = + id + | ImportHead '.' id ; + +DocComment = doccomment; + +# Annotations support +Annotation = '@' CompoundName ('(' AnnotationArguments? ')')? ; + +AnnotationArguments = AnnotationElement (',' AnnotationElement)* ; + +# Explicit alternatives (not (id '=')? Expression) so LALR keeps both items +# alive after shifting id; otherwise values starting with an identifier, e.g. +# @Retention(RetentionPolicy.RUNTIME), fail. ConditionalExpression is the JLS +# ElementValue level; full Expression would make @Foo(a = b) ambiguous. +AnnotationElement = id '=' ConditionalExpression | ConditionalExpression ; + +AnnotationList = Annotation* ; + +# Exactly ONE ModifierList is parsed per declaration, owned by the enclosing +# declaration rule (TypeDeclaration at the top level, FieldDeclaration inside +# a type body). The class/interface/enum/@interface rules must NOT start with +# their own nullable ModifierList: after the enclosing list, every token that +# can extend a ModifierList (the 10 modifier keywords, '@', and the splice +# tokens qq_Modifier/qq_Annotation/qq_ModifierList) used to conflict between +# extending the outer list and epsilon-starting the inner one - 14 +# shift/reduce conflicts whose shift put all modifiers on the outer list and +# left the inner one always empty. +ModifierList = (Modifier | Annotation)* ; + +# A supertype reference (JLS ClassOrInterfaceType): a possibly qualified +# name with optional type arguments - Comparable, java.util.List. +# The nullable TypeArguments directly after CompoundName is safe here: in +# extends/implements position no expression interpretation competes, so the +# epsilon-reduce of the empty TypeArguments (on ',', '{' or 'implements') is +# the state's only action on those tokens and '<' is a plain shift into +# NonEmptyTypeArguments. (Contrast with Type, which must spell out its +# NonEmptyTypeArguments alternative; see the NOTE there.) +ClassOrInterfaceType = CompoundName TypeArguments ; + +ExtendsList = 'extends' ClassOrInterfaceType (',' ClassOrInterfaceType)* ; +ImplementsList = 'implements' ClassOrInterfaceType + ~','; +FieldDeclarationList = FieldDeclaration *; + +ClassDeclaration = + 'class' id TypeParameters + ExtendsList? + ImplementsList? + '{' FieldDeclarationList '}' ; + +InterfaceDeclaration = + 'interface' id TypeParameters + ExtendsList? + '{' FieldDeclarationList '}' ; + +# Annotation declaration (@interface). The leading '@' shifts from the same +# state where '@' could extend the enclosing ModifierList with an Annotation; +# the NEXT token disambiguates ('interface' here vs id for an annotation), so +# the two uses of '@' never conflict. +AnnotationDeclaration = + '@' 'interface' id + '{' AnnotationTypeElementList '}' ; + +AnnotationTypeElementList = AnnotationTypeElement* ; + +# Annotation-type elements reuse FieldDeclaration; the default clause is +# handled by MemberRest (a dedicated alternative here would race its nullable +# ModifierList against FieldDeclaration's nullable OptDocComment → r/r). +AnnotationTypeElement = FieldDeclaration ; + +# Enum declaration +EnumConstant = AnnotationList id ('(' Arglist ')')? ('{' FieldDeclarationList '}')? ; + +EnumConstantList = EnumConstant (',' EnumConstant)* (',')? ; + +EnumDeclaration = + 'enum' id + ImplementsList? + '{' EnumConstantList (';' FieldDeclarationList)? '}' ; + +# NOTE: MemberDeclaration unifies MethodDeclaration, VariableDeclaration, and ConstructorDeclaration +# to eliminate ambiguity. All three can start with an identifier: +# - Constructor: id '(' ... +# - Method: Type id '(' ... (where Type can be CompoundName, which is also id) +# - Field: Type id ';' or '=' ... +# By structuring alternatives carefully, we can distinguish them. +# +# NOTE: DocComment comes BEFORE ModifierList to match standard Java style: +# /** doc */ public int field; +# NOT: public /** doc */ int field; +# TypeDeclRest is everything of a type declaration AFTER its modifiers: the +# class/interface/enum/@interface keyword onwards. The ModifierList lives on +# the enclosing rule (TypeDeclaration at the top level, FieldDeclaration for +# nested types), see the NOTE at ModifierList. +TypeDeclRest = + ClassDeclaration + | InterfaceDeclaration + | EnumDeclaration + | AnnotationDeclaration ; + +FieldDeclaration = + OptDocComment ModifierList (MemberDeclaration | TypeDeclRest | StaticInitializer) + | ';' ; + +# Array brackets (JLS-style split): types and declarators may only contain +# EMPTY bracket pairs; sizing expressions are only allowed in array creation +# (see CreationExpression). Keeping expressions out of type brackets is what +# lets one token after 'name [' decide between a type (']') and an array +# access (expression start), so 'a[0] = 1;' and 'Foo[] x;' both parse. +# +# NOTE: RTK expands X* into a LEFT-recursive list with an empty base case, so +# a nullable Dims placed directly after CompoundName would demand an +# epsilon-reduce on '[' - exactly the early commitment we must avoid. Where +# the brackets compete with an expression interpretation (Type, casts) we +# therefore use NonEmptyDims, whose first '[' is a plain shift. +Dims = ('[' ']')* ; +NonEmptyDims = ('[' ']')+ ; + +# MemberDeclaration unifies constructors, methods, and fields +# Strategy: Disambiguate early by checking what comes first +# - Primitive type keyword → definitely method/field +# - TypeParameters → definitely method (generic) +# - id → could be constructor or reference type method/field +MemberDeclaration = + PrimitiveTypeKeyword Dims id MemberRest # Primitive type method/field + | TypeParameters id MoreTypeSpecifier id MemberRest # Generic method with any type + | id MemberAfterFirstId ; # Constructor or reference type + +# Primitive type keywords (from TypeSpecifier) +PrimitiveTypeKeyword = + 'boolean' | 'byte' | 'char' | 'short' | 'int' | 'float' | 'long' | 'double' | 'void' ; + +# After first id (without TypeParameters or primitive type), branch on next token: +MemberAfterFirstId = + '(' ParameterList? ')' ThrowsClause? StatementBlock # Constructor: id '(' ... + | MoreTypeSpecifier id MemberRest ; # Reference type: id ... id MemberRest + +# MoreTypeSpecifier handles the rest of a type after the first id +# Could be: empty (simple type), '.' id (qualified), '<' ... '>' (generics), '[' ']' (array) +MoreTypeSpecifier = + '.' id MoreTypeSpecifier # Qualified name + | TypeArguments Dims ; # Generics + array brackets + +# Throws clause for methods and constructors (JLS 8.4.6): 'throws' is a fresh +# keyword in follow position, so the optional clause never conflicts with the +# tokens that end a method header ('{', ';', 'default'). Exception types are +# CompoundNames: a generic class may not subclass Throwable, so type +# arguments cannot occur here. +ThrowsClause = 'throws' CompoundName (',' CompoundName)* ; + +# MemberRest branches on what follows "Type id": +# - '(' indicates a method declaration +# - '[' or '=' or ',' or ';' indicates a variable declaration +# The optional 'default' clause before ';' is for annotation-type elements +# (int value() default 5;). Accepting it on ordinary methods too is +# parser-level tolerance; rejecting it there is a semantic check (javac's job). +MemberRest = + '(' ParameterList? ')' Dims ThrowsClause? ( StatementBlock | ('default' Expression)? ';' ) + | Dims OptVariableInitializer MoreVariableDeclarators ';' ; + +MoreVariableDeclarators = (',' VariableDeclarator)* ; + +# Legacy: MethodDeclaration is now unified with VariableDeclaration in MemberDeclaration above +# MethodDeclaration = +# TypeParameters Type id +# '(' ParameterList ')' SquareBracketsList +# ( StatementBlock | ';' ) ; + +# Legacy: ConstructorDeclaration is now unified in MemberDeclaration above +# ConstructorDeclaration = +# id '(' ParameterList ')' +# StatementBlock ; + +StatementBlock = '{' StatementList '}' ; + +VariableDeclaratorList = VariableDeclarator (',' VariableDeclarator)* ; + +# VariableDeclaration is used for: +# 1. Local variable declarations inside method bodies (via Statement) +# 2. For loops (via ForStatement) +# Note: Field-level variable declarations use MemberDeclaration above +# +# The modified alternative carries a NON-EMPTY modifier list - deliberately +# not Parameter's nullable ParamModifierList: at statement start the parser +# already weighs "Type vs Expression" after an identifier, and a nullable +# prefix would force an epsilon-reduce decision BEFORE that identifier is +# shifted, sending 'Foo x;' down the expression path. 'final' and '@' cannot +# start an expression, so the modified alternative is keyword-anchored and +# the unmodified one keeps today's exact automaton. +VariableDeclaration = + Type VariableDeclaratorList + ';' + | LocalModifierList1 Type VariableDeclaratorList ';' ; + +# Local variable modifiers (JLS 14.4 VariableModifier), at least one. +LocalModifierList1 = ('final' | Annotation)+ ; + +OptVariableInitializer = ('=' VariableInitializer)? ; + +VariableDeclarator = + id Dims OptVariableInitializer ; + +VariableInitializerList = (VariableInitializer (',' VariableInitializer)* (',')?)? ; + +VariableInitializer = +Expression + | '{' VariableInitializerList '}' ; + +StaticInitializer = + StatementBlock ; + +ParameterList = +Parameter (',' Parameter)* ; + +# Parameter modifiers (JLS 8.4.1 VariableModifier: 'final' and annotations). +# The NULLABLE prefix is safe here because parameter positions (after '(' or +# ',' in a parameter list, and in 'catch (...)') have no competing expression +# interpretation: the epsilon-reduce of the empty list on a type-start token +# is the state's only action. Do NOT reuse this at statement level, where a +# nullable prefix would break 'Foo x;' - see the NOTE at VariableDeclaration. +ParamModifierList = ('final' | Annotation)* ; + +# '...' (varargs, JLS 8.4.1) is one lexer token: Alex's maximal munch prefers +# it over '.', and no float literal can follow '..'. That only the LAST +# parameter may be variadic is a semantic check (javac's job): the parser +# accepts the ellipsis on any parameter, including a catch parameter. +Parameter = +ParamModifierList Type ('...')? id Dims ; + +StatementList = Statement *; + +OptExpression = Expression? ; + +OptId = id?; + +# The 'super'/'this' call alternatives are explicit constructor invocations +# (JLS 8.8.7.1). They are allowed wherever a statement is: that they may +# only appear as the FIRST statement of a constructor body is a semantic +# check (javac's job). Both are conflict-free: 'this'/'super' directly +# followed by '(' had no parse at all before, and after shifting the +# keyword at statement start the next token decides ('(' starts the +# invocation; '.' and the operator/closer tokens reduce the keyword to the +# expression primary). +Statement = +VariableDeclaration + | 'return' OptExpression ';' + | Expression ';' + | StatementBlock + | IfStatement + | DoStatement + | WhileStatement + | ForStatement + | TryStatement + | SwitchStatement + | 'synchronized' '(' Expression ')' Statement + | 'throw' Expression ';' + | id ':' Statement + | 'break' OptId ';' + | 'continue' OptId ';' + | 'super' '(' Arglist ')' ';' + | 'this' '(' Arglist ')' ';' + | ';' ; + +OptElsePart = ('else' Statement)? ; + +# The then-branch is a full Statement, so a nested if needs no braces: +# 'if (a) if (b) f(); else g();' is valid Java. This is the classic +# dangling-else shift/reduce conflict (family 1 of the inventory at the top +# of this file); happy resolves it by shifting, i.e. 'else' binds to the +# NEAREST 'if' - exactly the JLS 14.5 rule. (A StatementWithoutIf then- +# branch used to exclude nested ifs from the then position: that dodged +# nothing - the conflict already existed via loop bodies like +# 'if (a) while (b) if (c) f(); else g();' - while rejecting the valid +# direct form above.) +IfStatement = + 'if' '(' Expression ')' Statement + OptElsePart ; + +DoStatement = + 'do' Statement 'while' '(' Expression ')' ';' ; + +WhileStatement = + 'while' '(' Expression ')' Statement ; + +ForStatement = + 'for' '(' ( VariableDeclaration | ( Expression ';' ) | ';' ) + OptExpression ';' + OptExpression + ')' Statement ; + +CatchList = ( 'catch' '(' Parameter ')' Statement)* ; + +OptFinally = ('finally' Statement)?; + +TryStatement = + 'try' Statement + CatchList + OptFinally ; + +SwitchCaseList = (( 'case' Expression ':' ) + | ( 'default' ':' ) + | Statement )*; + +SwitchStatement = + 'switch' '(' Expression ')' '{' + SwitchCaseList + '}' ; + +# Expression Hierarchy +# Restructured to eliminate reduce/reduce conflicts by ensuring a single parse path +# through the operator precedence chain. Each expression level flows into the next +# without overlapping alternatives. +# +# UPDATED: All expression rules now use shared "Expression" type for QQ support +Expression : Expression = AssignmentExpression ; + +Expression : AssignmentExpression = + ConditionalExpression (AssignmentOp AssignmentExpression)? ; + +# COMMENTED OUT - CAUSES LEFT RECURSION: + # | Expression (/*NumericExpressionEnd + # | TestingExpressionEnd + # | LogicalExpressionEnd + # | BitExpressionEnd + # | */'(' Arglist ')' + # | '[' Expression ']' + # | '.' Expression + # | ',' Expression + # | 'instanceof' CompoundName ) + +AssignmentOp = + '=' + | '+=' + | '-=' + | '*=' + | '/=' + | '|=' + | '&=' + | '^=' + | '%=' + | '<<=' + | '>>=' + | '>>>=' ; + +Expression : ConditionalExpression = ConditionalOrExpression | ConditionalOrExpression '?' Expression ':' ConditionalExpression ; + +Expression : ConditionalOrExpression = ConditionalAndExpression | ConditionalOrExpression '||' ConditionalAndExpression ; + +Expression : ConditionalAndExpression = InclusiveOrEpression | ConditionalAndExpression '&&' InclusiveOrEpression ; + +Expression : InclusiveOrEpression = ExclusiveOrExpression | InclusiveOrEpression '|' ExclusiveOrExpression; + +Expression : ExclusiveOrExpression = AndExpression | ExclusiveOrExpression '^' AndExpression ; + +Expression : AndExpression = EqualityExpression | AndExpression '&' EqualityExpression ; + +EqualityOp = '==' | '!=' ; + +Expression : EqualityExpression = RelationalExpression | EqualityExpression EqualityOp RelationalExpression ; + +RelationalOp = '<' | '>' | '<=' | '>=' ; + +# Non-associative on purpose: both operands are ShiftExpressions, not the +# JLS's left-recursive RelationalExpression. This is what lets ShiftOp below +# be composed from single '>' tokens: RelationalOp and ShiftOp are then +# expected from the SAME automaton state, so a lone '>' is shifted without +# committing and the NEXT token decides - a second '>' extends a shift +# operator, an operand start reduces RelationalOp '>'. With a left-recursive +# first operand that decision would instead be a reduce-vs-shift at the +# FIRST '>' (reduce to RelationalExpression to compare vs shift into +# ShiftOp), and happy's shift preference would make every plain 'a > b' +# unparseable. Cost: a chained relational ('a < b < c') is now a parse +# error instead of a semantic error - no loss for valid Java, where a +# relational result (boolean) admits no further relational operator. +# 'instanceof' keeps its left-recursive operand: the keyword follows a +# COMPLETE relational expression, so shifting it needs no early commitment. +Expression : RelationalExpression = ShiftExpression | ShiftExpression RelationalOp ShiftExpression | RelationalExpression 'instanceof' Type ; + +# There are NO '>>'/'>>>' tokens: shift operators are composed in the parser +# from adjacent '>' tokens. RTK collects lexer literals from the rule text, +# so once no rule spells '>>'/'>>>', the input '>>' lexes as two '>' tokens: +# in 'Map>' each '>' closes one TypeArguments level, +# while in 'a >> b' the parser assembles the operator from the two tokens +# (see the RelationalExpression NOTE above for why that is decidable). +# '>>=' and '>>>=' STAY single tokens in AssignmentOp: in valid Java those +# character sequences are always the assignment operator (a type-argument +# closer is never followed directly by '='). Trade-off: token adjacency is +# not checked, so a spaced 'a > > b' is (wrongly but harmlessly) accepted +# as 'a >> b'. +ShiftOp = '<<' | '>' '>' | '>' '>' '>' ; + +Expression : ShiftExpression = AdditiveExpression | ShiftExpression ShiftOp AdditiveExpression ; + +AdditiveOp = '+' | '-' ; + +Expression : AdditiveExpression = MultiplicativeExpression | AdditiveExpression AdditiveOp MultiplicativeExpression ; + +MultiplicativeOp = '*' | '/' | '%' ; + +Expression : MultiplicativeExpression = UnaryExpression | MultiplicativeExpression MultiplicativeOp UnaryExpression ; + +# JLS cast trick (JLS 19, CastExpression): no alternative needs a reduce +# before its first distinguishing token, so LALR(1) never has to decide +# "type or expression?" early: +# - a primitive keyword after '(' can only be a cast; +# - '(' CompoundName '<' commits to a generic cast (NonEmptyTypeArguments); +# - '(' CompoundName '[' is decided one token later: ']' means an array +# cast (NonEmptyDims), an expression start means an array access inside +# a parenthesized expression; +# - every other reference cast is parsed as '(' Expression ')' with the +# type-as-expression, e.g. (Foo) x or (java.util.List) x. Whether +# '(' Expression ')' is a cast or a parenthesized expression is decided +# one token after ')': an operand start means cast. '(a) + b' stays an +# addition precisely because '+'/'-' are excluded from +# UnaryExpressionNotPlusMinus (which is why the JLS has that nonterminal). +# +# KNOWN LIMITATION: '(a < b)' as a primary expression mis-commits on '<' +# (the shift prefers a generic cast '(a<...>) ...'), so e.g. 'x = (a < b);' +# is rejected. This is the standard trade-off of LALR Java parsers. In +# conditions (if/while/for) and argument lists there is no cast context, so +# 'if (a < b)' and 'f(a < b)' are unaffected. +# +# The '[' and '<' shifts inside the cast head are families 5 and 6 of the +# conflict inventory at the top of this file. The cast-vs-paren decision +# after ')' is conflict-FREE: operand-start tokens can never follow a +# complete parenthesized expression, so the lookahead sets are disjoint. +Expression : CastExpression = + '(' PrimitiveTypeKeyword Dims ')' UnaryExpression + | '(' CompoundName NonEmptyTypeArguments Dims ')' UnaryExpressionNotPlusMinus + | '(' CompoundName NonEmptyDims ')' UnaryExpressionNotPlusMinus + | '(' Expression ')' UnaryExpressionNotPlusMinus ; + +# '~' and '!' live in UnaryExpressionNotPlusMinus (JLS 15.15), not here: +# keeping them in both derives ~x two ways, and they must stay in +# UnaryExpressionNotPlusMinus so reference-type casts can be followed by ~/!. +PrefixOp = '++' | '--' | '+' | '-' ; + +PostfixOp = '++' | '--' ; + +Expression : UnaryExpression = + PrefixOp UnaryExpression + | UnaryExpressionNotPlusMinus ; + +Expression : UnaryExpressionNotPlusMinus = + PostfixExpression + | '~' UnaryExpression + | '!' UnaryExpression + | CastExpression ; + +# The NonEmptyTypeArguments alternative is the explicit-type-argument call +# on a non-name base: this.m(), f().m(). After the shifted '.' the +# tokens id and '<' are distinct, so it adds no conflict. A NAME base +# (Collections.emptyList()) never reaches it - the greedy family-4 +# shift keeps the name unreduced - and parses through the PrimaryNoPostfix +# alternative anchored on 'id CompoundNameTail' instead; see the NOTE +# there. +Expression : PostfixExpression = + PrimaryNoPostfix + | PostfixExpression PostfixOp + | PostfixExpression '.' id + | PostfixExpression '.' id '(' Arglist ')' + | PostfixExpression '.' NonEmptyTypeArguments id '(' Arglist ')' + | PostfixExpression '[' Expression ']' ; + +# The 'CompoundName '[' Expression ']'' alternative anchors array access on +# the unreduced name (JLS ArrayAccess: Name [ Expression ]). It must sit here +# and not only on PostfixExpression: reaching PostfixExpression first would +# reduce CompoundName on lookahead '[', committing against the type +# interpretation ('Foo[] x;', '(Foo[]) x') one token too early. With the +# anchored alternative both interpretations shift '[' and the NEXT token +# decides. 'a[0]' is still derivable through PostfixExpression too; the +# resulting shift/reduce conflicts on '[' prefer the shift, i.e. exactly this +# anchored production (the PostfixExpression production still applies to +# non-name bases such as 'f()[0]' or 'this.x[0]'). +# +# The class-literal, qualified-this and explicit-type-argument-call +# alternatives anchor on the UNREDUCED name spelling 'id CompoundNameTail', +# NOT on CompoundName: the greedy name-extension shift (family 4) means a +# complete CompoundName is never reduced on lookahead '.', so a +# 'CompoundName '.' X' alternative could never be reached - the import-star +# lesson (see ImportName), expression edition. Spelling the shared +# CompoundNameTail keeps every '.' continuation in ONE item set, and the +# token after the shifted '.' decides: id extends the name, 'class'/'this'/ +# '<' commit to one of these alternatives. The primitive class literal +# (int.class, void.class) is its own alternative; after the keyword the '.' +# shift is distinct from every Dims/declarator continuation. Array class +# literals (String[].class) are not covered (rare). +Expression : PrimaryNoPostfix = + Literal + | 'this' + | '(' Expression ')' + | CreationExpression + | CompoundName ('(' Arglist ')')? + | CompoundName '[' Expression ']' + | 'super' '.' id ('(' Arglist ')')? + | id CompoundNameTail '.' 'class' + | id CompoundNameTail '.' 'this' + | id CompoundNameTail '.' NonEmptyTypeArguments id '(' Arglist ')' + | PrimitiveTypeKeyword '.' 'class' ; + +# Only array creation takes sizing expressions (DimExprs); trailing empty +# pairs allow 'new int[3][]'. Uses TypeSpecifier, not Type, so the dims are +# not consumed twice. 'new int[] {1,2}' (initializer syntax) is a separate +# feature (Phase 4g). +CreationExpression = 'new' TypeSpecifier ( '(' Arglist ')' | DimExprs (NonEmptyDims)? ); + +DimExprs = ('[' Expression ']')+ ; + +Literal = integerLiteral | floatLiteral | 'true' | 'false' | char | string | 'null' ; + +Arglist = (Expression (',' Expression)*)? ; + +# Generics support +# NOTE: '<' is both the type-argument opener (List) and the +# comparison operator (x < y). Wherever a CompoundName can be followed by +# either, the parser shifts '<' into NonEmptyTypeArguments (standard for +# Java parsers); see family 6 of the conflict inventory at the top of this +# file for the two states where this surfaces. +TypeArguments = NonEmptyTypeArguments? ; + +# Non-optional variant: Type and CastExpression need the '<' to be a plain +# shift from CompoundName (an optional TypeArguments would interpose an +# epsilon-reduce and recreate the type-vs-expression conflict). +# +# The '<' '>' alternative is the diamond (JLS 15.9, new ArrayList<>()). +# After the shifted '<', the '>' and every type-argument start token are +# distinct, so it adds no conflict. "NonEmpty" still holds in the token +# sense - the rule always consumes the '<' '>' pair, it just may hold zero +# TypeArguments - which is exactly what keeps the '<' a plain shift. The +# diamond is thereby accepted wherever type arguments are (casts, extends, +# member types, ...); rejecting it outside 'new' is a semantic check +# (javac's job). +NonEmptyTypeArguments = '<' TypeArgument (',' TypeArgument)* '>' | '<' '>' ; + +TypeArgument = + Type + | WildcardType ; + +WildcardType = + '?' + | '?' 'extends' Type + | '?' 'super' Type ; + +TypeParameters = ('<' TypeParameter (',' TypeParameter)* '>')? ; + +TypeParameter = id ('extends' Type ('&' Type)*)? ; + +# Type is spelled out by alternatives (instead of 'TypeSpecifier Dims') so +# that in positions where both a type and an expression may start (statement +# start, for-init) every alternative either shifts its next token directly +# from CompoundName ('<' for generics, '[' for array types) or reduces bare +# CompoundName only on lookahead 'id' (the declared variable's name), which +# no expression interpretation shares. This is what removes the +# PrimaryNoPostfix-vs-TypeSpecifier reduce/reduce conflict: the parser no +# longer has to pick type-or-expression while staring at '['. +Type = + PrimitiveTypeKeyword Dims + | CompoundName NonEmptyTypeArguments Dims + | CompoundName NonEmptyDims + | CompoundName ; + +# Only used by CreationExpression nowadays (Type spells out its own +# alternatives, see above). +TypeSpecifier = + 'boolean' + | 'byte' + | 'char' + | 'short' + | 'int' + | 'float' + | 'long' + | 'double' + | 'void' + | CompoundName TypeArguments ; + +Modifier = + 'public' + | 'private' + | 'protected' + | 'static' + | 'final' + | 'native' + | 'synchronized' + | 'abstract' + | 'threadsafe' + | 'transient' ; + +# The tail of a dotted name, hoisted into a NAMED rule so that CompoundName +# and the PrimaryNoPostfix alternatives anchored on 'id CompoundNameTail' +# (class literal, qualified this, explicit-type-argument call) share ONE +# list nonterminal. The sharing is what makes those alternatives reachable: +# RTK extracts every inline sub-pattern into a FRESH nonterminal, and two +# distinct nullable lists starting after the same id would epsilon-reduce +# against each other (reduce/reduce) before the first '.' ever arrives. +# With one shared tail, all '.' continuations sit in one item set and the +# token after the '.' picks the branch - the same cure as ImportName's +# left-recursive spelling, applied to expression position. +CompoundNameTail = ('.' id)* ; + +CompoundName = +id CompoundNameTail ; + +# Integer literals (JLS 3.10.1): decimal/octal, hex (0x/0X), binary (0b/0B), +# underscores between digits, and l/L suffix. The decimal branch also covers +# octal since they are lexically identical. +integerLiteral = + ( ( [0-9] ([0-9_]* [0-9])? ) + | ( '0' [xX] [0-9a-fA-F] ([0-9a-fA-F_]* [0-9a-fA-F])? ) + | ( '0' [bB] [01] ([01_]* [01])? ) ) + [lL]? ; + +# Float literals (JLS 3.10.2): underscores between digits, e/E exponent, +# f/F/d/D suffix. A bare exponent (1e5) or suffix (10f) also makes a float. +floatLiteral = + [0-9] ([0-9_]* [0-9])? '.' ([0-9] ([0-9_]* [0-9])?)? exponentPart? floatTypeSuffix? + | '.' [0-9] ([0-9_]* [0-9])? exponentPart? floatTypeSuffix? + | [0-9] ([0-9_]* [0-9])? exponentPart floatTypeSuffix? + | [0-9] ([0-9_]* [0-9])? floatTypeSuffix ; + +exponentPart = + [eE] ( '+' | '-' )? [0-9] ([0-9_]* [0-9])? ; + +floatTypeSuffix = + [fFdD] ; + +# Character literal: handles simple chars and escape sequences +# Simple char: 'a', single-char escapes: '\n', '\t', multi-digit octal +# escapes: '\12', '\101', '\377' (JLS 3.10.6), and Unicode: '\u0041' +char = '\'' . '\'' + | '\'' backslash . '\'' + | '\'' backslash [0-7] [0-7] '\'' + | '\'' backslash [0-3] [0-7] [0-7] '\'' + | '\'' backslash 'u' [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] '\'' ; + +# String literal: handles escape sequences like \", \\, \n, etc. +# Use negated class to match any char except quote, backslash, newline, CR +# Allow backslash followed by any char for escape sequences +string = [\"] ([^\"\\\n\r] | backslash .)* [\"] ; + +# The literal-backslash class, as a charset macro. The grammar lexer reads +# '\]' as an escape pair inside [...], so a class ENDING in a backslash +# (like this one) mis-lexes whenever another ']' follows it on the same +# line; the macro pins the class at a line end once instead of constraining +# every use site. (It used to be spelled [\\x5C] at each use, leaking +# Alex's hex escape through the then-unescaped bracket translation - +# issue #95.) +@symmacro +backslash = [\\] ; + +id = [a-zA-Z$_][a-zA-Z$_0-9]* ; +# Fixed: Split [*] [^/] into explicit cases for better Alex DFA generation +# This fixes blank line + {@link Class#method()} parsing issues +doccomment = '/**' ([\n] | [^*\n] | [*] [^/\n] | [*] [\n])* '*/'; + +# Whitespace and comments (ignored) +Ignore: ws = [ \t\n\r]+ ; +Ignore: comment = '//' [^\n]* '\n' ; +# Block comment must not match /** (which is doccomment) +# Same fix applied as doccomment +# Note: [^*] doesn't match newline in Alex, so we use ([^*\n] | [\n]) +Ignore: blockComment = '/*' ([^*\n] | [\n]) ([\n] | [^*\n] | [*] [^/\n] | [*] [\n])* '*/' ; diff --git a/test-grammars/p.pg b/test-grammars/p.pg new file mode 100644 --- /dev/null +++ b/test-grammars/p.pg @@ -0,0 +1,13 @@ +grammar 'P'; + +P = '(' 'lambda' '(' Id ')' E ')' ; +E = '0' | '1' | Id + | '(' 'if0' E E E ')' + | '(' 'fold' E E '(' 'lambda' '(' Id Id ')' E ')' ')' + | '(' Op1 E ')' + | '(' Op2 E E ')'; +Op1 = 'not' | 'shl1' | 'shr1' | 'shr4' | 'shr16' ; +Op2 = 'and' | 'or' | 'xor' | 'plus' ; +Id = id; +id = [a-z][a-z_0-9]* ; +Ignore: ws = [ \t\n]+ ; diff --git a/test-grammars/sandbox.pg b/test-grammars/sandbox.pg new file mode 100644 --- /dev/null +++ b/test-grammars/sandbox.pg @@ -0,0 +1,10 @@ +grammar 'Sandbox'; + +Sandbox = doccomment ; + +doccomment = '/**' ([^\*] | [\*] [^\/] | [\n])* '*/'; + +# Whitespace and comments (ignored) +Ignore: ws = [ \t\n\r]+ ; +Ignore: comment = '//' .* ; +Ignore: blockComment = '/*' ([^\*] | [\*] [^\/] | [\n])* '*/' ; diff --git a/test-grammars/t1.pg b/test-grammars/t1.pg new file mode 100644 --- /dev/null +++ b/test-grammars/t1.pg @@ -0,0 +1,13 @@ +grammar 'T1'; + +A = 'a'; +B = 'a' | 'b'; +C = A *; +D = (A B) C; +E = (A B) | C; +F1 = A +; +F2 = A *; +F3 = A * ~','; +F4 = A ?; +F5 = A + ~','; +G = (A (B C (D E) A)); diff --git a/test/GoldenTests.hs b/test/GoldenTests.hs new file mode 100644 --- /dev/null +++ b/test/GoldenTests.hs @@ -0,0 +1,206 @@ +-- | Golden tests for the code generators. +-- +-- For every grammar under test-grammars/ the full in-process pipeline is run +-- and the generated Lexer.x, Parser.y and QQ.hs are compared +-- byte-for-byte against snapshots checked in under test/golden//. +-- This catches generator regressions instantly, without alex, happy or a GHC +-- compile cycle. +-- +-- Every grammar is run through BOTH front ends — the self-hosted one that +-- RTK generated from grammar.pg (the default) and the hand-written reference +-- lexer/parser (--use-handwritten) — and both must reproduce the same +-- snapshots byte-for-byte. This is the self-hosting equivalence harness: +-- source positions only affect diagnostics, never the generated artifacts, +-- so any artifact divergence on a valid grammar is a real front-end bug. +-- Grammars pinned in TestSupport.frontEndDivergentGrammars (none today) +-- would be checked with the reference front end only, plus a guard that +-- fails once they stop diverging. +-- +-- After an intentional generator change, refresh the snapshots with +-- `make accept-golden` (or `RTK_ACCEPT=1 cabal test golden`) and review the +-- resulting diff like any other code change. +module Main (main) where + +import Control.Exception (SomeException, evaluate, try) +import Control.Monad (forM, forM_, unless, when) +import Data.List (isInfixOf, sort) +import Data.Maybe (listToMaybe) +import System.Directory (createDirectoryIfMissing, doesDirectoryExist, + doesFileExist, listDirectory) +import System.Environment (getArgs, lookupEnv) +import System.Exit (exitFailure) +import System.FilePath ((), takeBaseName) +import Test.HUnit + +import Diagnostics (Diagnostic, renderDiagnostic) +import Syntax (InitialGrammar) +import TestSupport + +goldenRoot :: FilePath +goldenRoot = "test" "golden" + +-- | Grammars that are known not to generate, with a fragment of the expected +-- error. Currently empty: every grammar in test-grammars/ generates. Pin a +-- grammar here only while a known generation defect is being worked on; the +-- test fails once the grammar generates again so the entry gets dropped. +knownBrokenGrammars :: [(String, String)] +knownBrokenGrammars = [] + +regenerateHint :: String +regenerateHint = + "\nIf the new output is intentional, refresh the snapshots with" ++ + "\n make accept-golden" ++ + "\nand review the diff of test/golden/ before committing." + +-- | Run the pipeline on one grammar file, forcing the generated contents so +-- that any lazy `error` from the generators surfaces here as a test failure. +generateArtifacts :: (String -> Either Diagnostic InitialGrammar) + -> FilePath -> IO (Either String [(FilePath, String)]) +generateArtifacts parseSrc pgFile = do + source <- readFileUtf8 pgFile + result <- try $ + case parseSrc source >>= normalizeParsedGrammar >>= artifactsFor of + Left d -> return (Left (renderDiagnostic pgFile d)) + Right artifacts -> do + mapM_ (\(_, content) -> evaluate (length content)) artifacts + return (Right artifacts) + return $ case result of + Left e -> Left (show (e :: SomeException)) + Right inner -> inner + +-- | A short, readable summary of where two artifacts diverge. +diffSummary :: String -> String -> String +diffSummary expected actual = + unlines $ sizes : maybe onlyNewlines describe firstDiff + where + el = lines expected + al = lines actual + sizes = "golden has " ++ show (length el) ++ " lines, generated output has " + ++ show (length al) ++ " lines" + n = max (length el) (length al) + pad xs = take n (xs ++ repeat "") + firstDiff = listToMaybe [ d | d@(_, e, a) <- zip3 [1 :: Int ..] (pad el) (pad al) + , e /= a ] + describe (lineNo, e, a) = + [ "first difference at line " ++ show lineNo + , " golden: " ++ e + , " generated: " ++ a + ] + onlyNewlines = ["contents differ only in trailing whitespace/newlines"] + +goldenTestFor :: FilePath -> IO Test +goldenTestFor pgFile = do + let grammarKey = takeBaseName pgFile + handResult <- generateArtifacts parseGrammarSource pgFile + genResult <- generateArtifacts parseGrammarSourceGenerated pgFile + genTest <- case lookup grammarKey frontEndDivergentGrammars of + Nothing -> return $ frontEndTest grammarKey genResult + Just reason -> divergenceGuard grammarKey reason genResult + return $ TestLabel grammarKey $ TestList + [ TestLabel "hand-written front end" (frontEndTest grammarKey handResult) + , TestLabel "generated front end" genTest + ] + where + frontEndTest grammarKey generated = case lookup grammarKey knownBrokenGrammars of + Just expectedError -> TestCase $ case generated of + Left err -> assertBool + ("expected failure mentioning " ++ show expectedError ++ ", got:\n" ++ err) + (expectedError `isInfixOf` err) + Right _ -> assertFailure $ + pgFile ++ " generates now; drop it from knownBrokenGrammars and run" + ++ " `make accept-golden` to snapshot it" + Nothing -> case generated of + Left err -> TestCase $ assertFailure $ + "generation failed for " ++ pgFile ++ ":\n" ++ err + Right artifacts -> TestList (map (check grammarKey) artifacts) + + check grammarKey (fileName, actual) = TestLabel fileName $ TestCase $ do + let goldenFile = goldenRoot grammarKey fileName + exists <- doesFileExist goldenFile + if not exists + then assertFailure $ "missing golden file " ++ goldenFile ++ regenerateHint + else do + expected <- readFileUtf8 goldenFile + when (expected /= actual) $ assertFailure $ + "generated output differs from " ++ goldenFile ++ ":\n" + ++ diffSummary expected actual ++ regenerateHint + + -- A pinned divergent grammar must actually diverge: as soon as the + -- generated front end reproduces the snapshots too, this fails so the + -- pin gets dropped and the grammar joins the strict equivalence check. + divergenceGuard grammarKey reason generated = + return $ TestLabel "known divergence (pinned in TestSupport)" $ TestCase $ + case generated of + Left _ -> return () -- rejected by the generated front end + Right artifacts -> do + same <- mapM (matchesGolden grammarKey) artifacts + when (and same) $ assertFailure $ + "the generated front end now reproduces the snapshots for this grammar\n" + ++ "(pinned because: " ++ reason ++ ");\n" + ++ "drop it from frontEndDivergentGrammars in test/TestSupport.hs" + + matchesGolden grammarKey (fileName, actual) = do + let goldenFile = goldenRoot grammarKey fileName + exists <- doesFileExist goldenFile + if exists + then (== actual) <$> readFileUtf8 goldenFile + else return False + +-- | Guard against stale snapshots: every directory under test/golden/ must +-- correspond to an existing grammar file. +staleGoldenTest :: [FilePath] -> Test +staleGoldenTest pgFiles = TestLabel "no stale golden directories" $ TestCase $ do + hasGolden <- doesDirectoryExist goldenRoot + entries <- if hasGolden then listDirectory goldenRoot else return [] + let known = map takeBaseName pgFiles + stale = [ e | e <- sort entries, e `notElem` known ] + unless (null stale) $ assertFailure $ + "golden directories without a matching grammar in " ++ grammarsDir ++ ": " + ++ show stale ++ "\nDelete them (or restore the grammar)." + +acceptAll :: [FilePath] -> IO () +acceptAll pgFiles = do + failed <- forM pgFiles $ \pgFile -> do + let grammarKey = takeBaseName pgFile + if grammarKey `elem` map fst knownBrokenGrammars + then do + putStrLn $ "skipping " ++ pgFile ++ " (listed in knownBrokenGrammars)" + return False + else do + -- Snapshots are produced by the generated (default) front + -- end — grammar.pg is the authority; the hand-written + -- reference front end must then reproduce them. A grammar + -- pinned as divergent (none today) is snapshotted from the + -- reference front end, matching how it is checked. + let parseSrc = case lookup grammarKey frontEndDivergentGrammars of + Just _ -> parseGrammarSource + Nothing -> parseGrammarSourceGenerated + generated <- generateArtifacts parseSrc pgFile + case generated of + Left err -> do + putStrLn $ "FAILED to generate " ++ pgFile ++ ":\n" ++ err + return True + Right artifacts -> do + let dir = goldenRoot grammarKey + createDirectoryIfMissing True dir + forM_ artifacts $ \(fileName, content) -> do + writeFileUtf8 (dir fileName) content + putStrLn $ "wrote " ++ (dir fileName) + return False + when (or failed) exitFailure + +main :: IO () +main = do + args <- getArgs + acceptEnv <- lookupEnv "RTK_ACCEPT" + let accept = "--accept" `elem` args || maybe False (not . null) acceptEnv + pgFiles <- discoverGrammarFiles grammarsDir + when (null pgFiles) $ do + putStrLn $ "no grammar files found under " ++ grammarsDir + exitFailure + if accept + then acceptAll pgFiles + else do + perGrammar <- mapM goldenTestFor pgFiles + results <- runTestTT $ TestList (staleGoldenTest pgFiles : perGrammar) + when (errors results + failures results /= 0) exitFailure diff --git a/test/TestSupport.hs b/test/TestSupport.hs new file mode 100644 --- /dev/null +++ b/test/TestSupport.hs @@ -0,0 +1,110 @@ +-- | Helpers shared by the unit and golden test suites: the in-process +-- generation pipeline (the same stages app/main.hs runs) and locale-independent +-- file IO for grammar sources and generated artifacts. +module TestSupport + ( parseGrammarSource + , parseGrammarSourceGenerated + , normalizeGrammarSource + , normalizeParsedGrammar + , artifactsFor + , frontEndDivergentGrammars + , grammarsDir + , discoverGrammarFiles + , readFileUtf8 + , writeFileUtf8 + ) where + +import Control.Exception (evaluate) +import Data.List (sort) +import System.Directory (listDirectory) +import System.FilePath ((), takeExtension) +import System.IO + +import ASTAdapter (parseWithGenerated) +import Diagnostics (Diagnostic) +import GenQ (genQ) +import GenX (genX) +import GenY (genY) +import Lexer (scanTokens) +import Normalize (fillConstructorNames, normalizeTopLevelClauses) +import Parser (parse) +import StringLiterals (normalizeStringLiterals) +import Syntax +import TokenProcessing (processTokens) + +-- | Lexing, token post-processing and parsing of a grammar specification. +parseGrammarSource :: String -> Either Diagnostic InitialGrammar +parseGrammarSource src = scanTokens src >>= (parse . processTokens) + +-- | The self-hosted front end: the same job as 'parseGrammarSource', done by +-- the lexer/parser RTK generated from grammar.pg plus the AST adapter. +parseGrammarSourceGenerated :: String -> Either Diagnostic InitialGrammar +parseGrammarSourceGenerated = parseWithGenerated + +-- | The shared back half of the front-end pipeline: normalization of an +-- already-parsed grammar down to what the code generators consume. +normalizeParsedGrammar :: InitialGrammar -> Either Diagnostic NormalGrammar +normalizeParsedGrammar ig = do + ng <- normalizeTopLevelClauses (normalizeStringLiterals ig) + return (fillConstructorNames ng) + +-- | The full front-end pipeline, producing the normalized grammar that the +-- code generators consume. +normalizeGrammarSource :: String -> Either Diagnostic NormalGrammar +normalizeGrammarSource src = parseGrammarSource src >>= normalizeParsedGrammar + +-- | The three files rtk writes for a grammar, as (file name, content) pairs. +artifactsFor :: NormalGrammar -> Either Diagnostic [(FilePath, String)] +artifactsFor g = do + x <- genX g + y <- genY g + q <- genQ g + return [ (name ++ "Lexer.x", x) + , (name ++ "Parser.y", y) + , (name ++ "QQ.hs", q) + ] + where name = getNGrammarName g + +-- | Grammars whose hand-written-front-end parse the generated front end +-- provably cannot reproduce, with the reason. +-- +-- EMPTY since the generated front end became the default: the two historic +-- divergences were resolved by making the reference parser define the same +-- language as grammar.pg (empty alternatives are rejected, redundant +-- parentheses are lifted exactly like grammar.pg's @Clause5 = '(' ,Clause ')'@ +-- does) and by rewriting haskell.pg's @Gd = | ExpI ;@ as @Gd = ExpI? ;@. Every +-- grammar in the corpus now passes the strict dual-front-end equivalence. +-- +-- Should a new divergence ever have to be tolerated temporarily, pin the +-- grammar here: the golden suite then checks it with the reference front end +-- only, and both suites fail as soon as the grammar stops diverging so the +-- pin gets dropped again. +frontEndDivergentGrammars :: [(String, String)] +frontEndDivergentGrammars = [] + +grammarsDir :: FilePath +grammarsDir = "test-grammars" + +-- | All grammar specifications directly under the given directory, sorted. +discoverGrammarFiles :: FilePath -> IO [FilePath] +discoverGrammarFiles dir = do + entries <- listDirectory dir + return [ dir e | e <- sort entries, takeExtension e == ".pg" ] + +-- Grammar files and generated artifacts are UTF-8. Use an explicit encoding +-- and newline mode so the tests do not depend on the ambient locale. +readFileUtf8 :: FilePath -> IO String +readFileUtf8 path = do + h <- openFile path ReadMode + hSetEncoding h utf8 + hSetNewlineMode h noNewlineTranslation + contents <- hGetContents h + _ <- evaluate (length contents) + hClose h + return contents + +writeFileUtf8 :: FilePath -> String -> IO () +writeFileUtf8 path contents = withFile path WriteMode $ \h -> do + hSetEncoding h utf8 + hSetNewlineMode h noNewlineTranslation + hPutStr h contents diff --git a/test/UnitTests.hs b/test/UnitTests.hs new file mode 100644 --- /dev/null +++ b/test/UnitTests.hs @@ -0,0 +1,894 @@ +{-# LANGUAGE QuasiQuotes #-} +-- | Unit tests for the rtk front end: +-- +-- * StrQuote quasi-quoter behavior (ported from StrQuote_Test.hs) +-- * token post-processing +-- * pipeline error handling (ported from EmptyGrammar_Test.hs) +-- * normalization behavior on small inline grammars +-- * normalization invariants checked against every grammar in test-grammars/ +module Main (main) where + +import Control.Exception (SomeException, evaluate, try) +import Control.Monad (when) +import Data.List (find, group, isInfixOf, isPrefixOf, nub, sort) +import qualified Data.Map as M +import Data.Maybe (maybeToList) +import qualified Data.Set as S +import System.Exit (exitFailure) +import System.FilePath (takeBaseName) +import Test.HUnit + +import Diagnostics (Diagnostic (..), SourcePos (..), renderDiagnostic) +import GenX (isAlexEscape) +import Grammar (isClauseSeqLifted) +import Lexer (AlexPosn (..), PosToken (..), Token (..)) +import Normalize (fillConstructorNames, normalizeTopLevelClauses) +import Syntax +import StrQuote (str) +import StringLiterals (normalizeStringLiterals) +import TokenProcessing (catBigstrs, processTokens, unBackQuote) + +import TestSupport + +main :: IO () +main = do + pgFiles <- discoverGrammarFiles grammarsDir + perGrammar <- mapM invariantTestsFor pgFiles + astEquality <- mapM astEqualityTestFor pgFiles + results <- runTestTT $ TestList $ + [ TestLabel "StrQuote" strQuoteTests + , TestLabel "TokenProcessing" tokenProcessingTests + , TestLabel "diagnostics" diagnosticsTests + , TestLabel "pipeline error handling" errorHandlingTests + , TestLabel "normalization behavior" normalizationTests + , TestLabel "self-hosted front end" selfHostedFrontEndTests + ] ++ perGrammar ++ astEquality + when (errors results + failures results /= 0) exitFailure + +-- | Normalize without constructor-name filling, returning the diagnostic on +-- failure. Used by the error-handling tests. +normalizeNoFillE :: String -> Either Diagnostic NormalGrammar +normalizeNoFillE src = parseGrammarSource src >>= (normalizeTopLevelClauses . normalizeStringLiterals) + +-- | Partial unwrapping for the behavior tests, which all use valid grammars: +-- a diagnostic here means the test grammar itself is wrong. +normalizeNoFill :: String -> NormalGrammar +normalizeNoFill = either (error . ("unexpected diagnostic: " ++) . show) id . normalizeNoFillE + +-- | Parse a valid grammar, failing loudly on a diagnostic. +parseOrDie :: String -> InitialGrammar +parseOrDie = either (error . ("unexpected diagnostic: " ++) . show) id . parseGrammarSource + +-------------------------------------------------------------------------------- +-- StrQuote +-------------------------------------------------------------------------------- + +strQuoteTests :: Test +strQuoteTests = TestList + [ TestCase $ assertEqual "simple string" "simple string" [str|simple string|] + , TestCase $ assertEqual "string with newline" "simple string\nwith new line" [str|simple string +with new line|] + , TestCase $ assertEqual "empty string" "" [str||] + , TestCase $ assertEqual "empty var name" "" [str|?|] + , TestCase $ assertEqual "empty expr" "" [str|?()|] + ] + +-------------------------------------------------------------------------------- +-- TokenProcessing +-------------------------------------------------------------------------------- + +tokenProcessingTests :: Test +tokenProcessingTests = TestList + [ TestLabel "unBackQuote strips escaping backslashes" $ TestCase $ + assertEqual "" "a'b" (unBackQuote "a\\'b") + , TestLabel "unBackQuote keeps \\n \\t \\r \\f \\v escapes" $ TestCase $ + assertEqual "" "\\n\\t\\r\\f\\v" (unBackQuote "\\n\\t\\r\\f\\v") + , TestLabel "preserved escapes are exactly the ones GenX emits bare" $ TestCase $ + mapM_ (\c -> do + let esc = ['\\', c] + assertEqual ("unBackQuote preserves " ++ esc) esc (unBackQuote esc) + assertBool ("GenX.isAlexEscape recognizes " ++ esc) (isAlexEscape esc)) + "ntrfv" + , TestLabel "unBackQuote unescapes backslash itself" $ TestCase $ + assertEqual "" "\\" (unBackQuote "\\\\") + , TestLabel "catBigstrs joins adjacent big strings" $ TestCase $ + assertEqual "" (map at [BigStr "a\nb", Id "x"]) + (catBigstrs (map at [BigStr "a", BigStr "b", Id "x"])) + , TestLabel "catBigstrs keeps the position of the first part" $ TestCase $ + assertEqual "" [PosToken (AlexPn 0 1 1) (BigStr "a\nb")] + (catBigstrs [ PosToken (AlexPn 0 1 1) (BigStr "a") + , PosToken (AlexPn 5 2 1) (BigStr "b") ]) + , TestLabel "processTokens combines both steps" $ TestCase $ + assertEqual "" (map at [StrLit "'", BigStr "a\nb"]) + (processTokens (map at [StrLit "\\'", BigStr "a", BigStr "b"])) + , TestLabel "a '\\f' keyword survives to the generated lexer" testFormFeedReachesLexer + , TestLabel "a backslash in a character class is emitted Alex-escaped" testBackslashClassEscaped + ] + +-- | End-to-end: a '\f' keyword must reach the generated Alex spec as the bare +-- \f escape (neither stripped to a literal 'f' nor quoted as "\f", which Alex +-- would read as backslash + 'f'). +testFormFeedReachesLexer :: Test +testFormFeedReachesLexer = TestCase $ + case normalizeGrammarSource "grammar 'Esc';\nS = '\\f' ;\n" >>= artifactsFor of + Left d -> assertFailure $ "generation failed: " ++ show d + Right artifacts -> case lookup "EscLexer.x" artifacts of + Nothing -> assertFailure "no EscLexer.x artifact generated" + Just lexerSpec -> do + assertBool "lexer spec contains the bare \\f escape" + ("\\f" `isInfixOf` lexerSpec) + assertBool "\\f is not emitted as a quoted string literal" + (not ("\"\\f\"" `isInfixOf` lexerSpec)) + +-- | End-to-end (issue #95): a literal backslash in a regex character class +-- must reach the generated Alex spec escaped ([\\]). It used to pass through +-- raw, where Alex set syntax reads a lone backslash as an escape, so users +-- needed the [\x5C] hex spelling. The \n \t \r \f \v pairs that token +-- post-processing preserves must keep passing through bare - including +-- directly after an escaped literal backslash. +testBackslashClassEscaped :: Test +testBackslashClassEscaped = TestCase $ + case normalizeGrammarSource src >>= artifactsFor of + Left d -> assertFailure $ "generation failed: " ++ show d + Right artifacts -> case lookup "BsLexer.x" artifacts of + Nothing -> assertFailure "no BsLexer.x artifact generated" + Just lexerSpec -> do + assertBool "literal backslash class is emitted as [\\\\]" + ("[\\\\]" `isInfixOf` lexerSpec) + assertBool "preserved control-character pairs stay bare in classes" + ("[\\ \\t\\n]+" `isInfixOf` lexerSpec) + assertBool "negated class mixing both kinds keeps each one intact" + ("[^\\\"\\\\\\n\\r]" `isInfixOf` lexerSpec) + where + -- the backslash class must end its source line: the grammar lexer reads + -- '\]' as an escape pair, so [\\] followed by another ']' on the same + -- line would mis-lex (see the backslash macro comment in java.pg) + src = unlines + [ "grammar 'Bs';" + , "S = cls tab nq ;" + , "cls = 'x' [\\\\] ;" + , "tab = [ \\t\\n]+ ;" + , "nq = [^\\\"\\\\\\n\\r] ;" + ] + +-- | Wrap a token at a dummy position; token processing ignores positions. +at :: Token -> PosToken +at = PosToken (AlexPn 0 1 1) + +-------------------------------------------------------------------------------- +-- Pipeline error handling +-------------------------------------------------------------------------------- + +-- | Assert that an Either is Left and hand the diagnostic to a checker. +expectDiagnostic :: String -> Either Diagnostic a -> (Diagnostic -> Assertion) -> Assertion +expectDiagnostic _ (Left d) check = check d +expectDiagnostic what (Right _) _ = assertFailure $ "expected a diagnostic for " ++ what + +-------------------------------------------------------------------------------- +-- Diagnostics rendering +-------------------------------------------------------------------------------- + +diagnosticsTests :: Test +diagnosticsTests = TestList + [ TestLabel "renderDiagnostic with position and context" $ TestCase $ + assertEqual "" + "g.pg:2:1: error: in rule 'Foo': bad thing" + (renderDiagnostic "g.pg" + (Diagnostic (Just (SourcePos 2 1)) (Just "in rule 'Foo'") "bad thing")) + , TestLabel "renderDiagnostic with position, no context" $ TestCase $ + assertEqual "" + "g.pg:2:1: error: bad thing" + (renderDiagnostic "g.pg" (Diagnostic (Just (SourcePos 2 1)) Nothing "bad thing")) + , TestLabel "renderDiagnostic without position or context" $ TestCase $ + assertEqual "" + "g.pg: error: bad thing" + (renderDiagnostic "g.pg" (Diagnostic Nothing Nothing "bad thing")) + ] + +-------------------------------------------------------------------------------- +-- Pipeline error handling +-------------------------------------------------------------------------------- + +errorHandlingTests :: Test +errorHandlingTests = TestList + [ TestLabel "grammar without rules is rejected" $ TestCase $ + expectDiagnostic "an empty grammar" (normalizeNoFillE "grammar 'Empty';") $ \d -> do + assertBool ("unexpected message: " ++ diagMessage d) $ + "contains no rules" `isInfixOf` diagMessage d + && "Empty" `isInfixOf` diagMessage d + assertEqual "no position" Nothing (diagPos d) + , TestLabel "empty input is a parse error" $ TestCase $ + expectDiagnostic "empty input" (parseGrammarSource "") $ \d -> do + assertBool ("unexpected message: " ++ diagMessage d) $ + "end of input" `isInfixOf` diagMessage d + assertEqual "position of end of input" (Just (SourcePos 1 1)) (diagPos d) + , TestLabel "minimal valid grammar normalizes" $ TestCase $ + case normalizeGrammarSource "grammar 'Valid';\nRule = 'test' ;" of + Right _ -> return () + Left d -> assertFailure $ "valid grammar should normalize, got: " ++ show d + , TestLabel "parse errors report the offending position" $ TestCase $ + -- ';' missing after the grammar declaration: the parser should point + -- at the identifier 'Foo' on line 2 + expectDiagnostic "a missing ';'" (parseGrammarSource "grammar 'Test'\nFoo = bar;\n") $ \d -> do + assertEqual "position of 'Foo'" (Just (SourcePos 2 1)) (diagPos d) + assertBool ("unexpected message: " ++ diagMessage d) $ + "identifier 'Foo'" `isInfixOf` diagMessage d + , TestLabel "errors at end of input carry a position" $ TestCase $ + expectDiagnostic "a truncated rule" (parseGrammarSource "grammar 'Test';\nFoo =\n") $ \d -> do + assertEqual "position of end of input" (Just (SourcePos 3 1)) (diagPos d) + assertBool ("unexpected message: " ++ diagMessage d) $ + "end of input" `isInfixOf` diagMessage d + , TestLabel "a lexical first rule is rejected with an explanation" $ TestCase $ + expectDiagnostic "a lexical first rule" + (normalizeGrammarSource "grammar 'Test';\nfoo = [a-z];\n") $ \d -> do + assertBool ("unexpected message: " ++ diagMessage d) $ + "must be a syntax rule" `isInfixOf` diagMessage d + && "foo" `isInfixOf` diagMessage d + assertEqual "position of 'foo'" (Just (SourcePos 2 1)) (diagPos d) + , TestLabel "normalization errors name the offending rule and position" $ TestCase $ + -- a lifted (,) clause mixed with other clauses is rejected; the error + -- should point at rule 'Foo' on line 2 + expectDiagnostic "a mixed lifted clause" + (normalizeGrammarSource "grammar 'Test';\nFoo = ,Bar Baz;\nBar = 'b';\nBaz = 'z';\n") $ \d -> do + assertEqual "context names the rule" (Just "in rule 'Foo'") (diagContext d) + assertEqual "position of 'Foo'" (Just (SourcePos 2 1)) (diagPos d) + assertBool ("unexpected message: " ++ diagMessage d) $ + "lifted" `isInfixOf` diagMessage d + , TestLabel "a lifted clause under * is rejected" $ TestCase $ + expectDiagnostic "a lifted clause under *" + (normalizeGrammarSource "grammar 'X';\nFoo = ,Bar * ;\nBar = 'b';\n") $ \d -> do + assertEqual "context names the rule" (Just "in rule 'Foo'") (diagContext d) + assertEqual "position of 'Foo'" (Just (SourcePos 2 1)) (diagPos d) + assertBool ("unexpected message: " ++ diagMessage d) $ + "lifted" `isInfixOf` diagMessage d && "*" `isInfixOf` diagMessage d + , TestLabel "repetition of a value-less item is rejected" $ TestCase $ + -- 'x' is matched but dropped (string literals normalize to ignored + -- tokens), so 'x'* would collect nothing; it used to generate a + -- parser that does not compile (issue #28) + expectDiagnostic "a string literal under *" + (normalizeGrammarSource "grammar 'I28';\nFoo = 'x'* ;\n") $ \d -> do + assertEqual "context names the rule" (Just "in rule 'Foo'") (diagContext d) + assertEqual "position of 'Foo'" (Just (SourcePos 2 1)) (diagPos d) + assertBool ("unexpected message: " ++ diagMessage d) $ + "produces no value" `isInfixOf` diagMessage d + , TestLabel "repetition over a lexical rule is rejected" $ TestCase $ + -- a token payload has no grammar-owned data type to host the list + -- element's splice constructor; it used to generate an invalid + -- lowercase data declaration (issue #28) + expectDiagnostic "a lexical rule under +" + (normalizeGrammarSource "grammar 'I28';\nFoo = num+ ;\nnum = [0-9]+ ;\n") $ \d -> do + assertEqual "context names the rule" (Just "in rule 'Foo'") (diagContext d) + assertEqual "position of 'Foo'" (Just (SourcePos 2 1)) (diagPos d) + assertBool ("unexpected message: " ++ diagMessage d) $ + "lexical rule" `isInfixOf` diagMessage d && "num" `isInfixOf` diagMessage d + , TestLabel "duplicate rule definitions are rejected" $ TestCase $ + -- the error points at the second definition and names the first + expectDiagnostic "a duplicate rule" + (normalizeGrammarSource "grammar 'Dup';\nFoo = 'a';\nFoo = 'b';\n") $ \d -> do + assertEqual "context names the rule" (Just "in rule 'Foo'") (diagContext d) + assertEqual "position of the second definition" (Just (SourcePos 3 1)) (diagPos d) + assertBool ("unexpected message: " ++ diagMessage d) $ + "defined more than once" `isInfixOf` diagMessage d + && "line 2, column 1" `isInfixOf` diagMessage d + , TestLabel "a reference to an unknown rule is rejected during generation" $ TestCase $ + expectDiagnostic "an unknown rule reference" + (normalizeGrammarSource "grammar 'X';\nFoo = Nope;\n" >>= artifactsFor) $ \d -> do + assertEqual "context names the referencing type" (Just "in type 'Foo'") (diagContext d) + assertBool ("unexpected message: " ++ diagMessage d) $ + "unknown rule" `isInfixOf` diagMessage d && "Nope" `isInfixOf` diagMessage d + -- the fallback names the type-named-rule convention that + -- cover synthesis (issue #14) builds on + && "Nope : SomeRule = ..." `isInfixOf` diagMessage d + , TestLabel "a lexical value type is not referable, and the error says why" $ TestCase $ + -- 'Thing : num = ...' declares the token payload's Haskell type, not + -- a syntax type: no cover rule can be synthesized from it (issue + -- #14), and the diagnostic explains the convention instead of the + -- bare "unknown rule" + expectDiagnostic "a lexical value type reference" + (normalizeGrammarSource "grammar 'X';\nFoo = Thing;\nThing : num = [0-9]+ ;\n" + >>= artifactsFor) $ \d -> do + assertEqual "context names the referencing type" (Just "in type 'Foo'") (diagContext d) + assertBool ("unexpected message: " ++ diagMessage d) $ + "a type but not a rule" `isInfixOf` diagMessage d + && "Thing : SomeRule = ..." `isInfixOf` diagMessage d + && "lexical rule" `isInfixOf` diagMessage d + ] + +-- | Force the whole grammar value so lazy errors surface where we expect them. +forceGrammar :: NormalGrammar -> NormalGrammar +forceGrammar g = length (show g) `seq` g + +-------------------------------------------------------------------------------- +-- Normalization behavior on small inline grammars +-------------------------------------------------------------------------------- + +normalizationTests :: Test +normalizationTests = TestList + [ TestLabel "string literals become shared ignored keyword tokens" testStringLiterals + , TestLabel "list rules get an element proxy with QQ splicing support" testListProxy + , TestLabel "QQ anti machinery is created once per shared type" testAntiRuleSharing + , TestLabel "a referenced pure type group gets a synthesized cover rule" testTypeCoverSynthesis + , TestLabel "a bare type as a list element resolves through the cover" testTypeCoverListElement + , TestLabel "the start wrapper demands covers for unreferenced pure types" testTypeCoverWrapperDemand + , TestLabel "no cover is synthesized for an unreferenced pure type (alias start)" testTypeCoverOnDemand + , TestLabel "a precedence chain gets one splice alternative, at its bottom" testChainAttachment + , TestLabel "splice attachment falls back to eligible rules when nothing covers" testAttachFallbackNoCover + , TestLabel "shortcuts are recorded against the rule's type" testShortcuts + , TestLabel "optional clauses desugar to an empty alternative" testOptionalDesugars + , TestLabel "lexical rule type and conversion defaults" testLexicalRuleDefaults + , TestLabel "start group wraps every public type in dummy tokens" testStartGroup + , TestLabel "an alias start group gets no QQ start wrapper" testAliasStartGroup + , TestLabel "fillConstructorNames fills every constructor and is idempotent" testFillConstructorNames + ] + +testStringLiterals :: Test +testStringLiterals = TestCase $ do + let g = normalizeStringLiterals $ parseOrDie $ unlines + [ "grammar 'Lit';" + , "A = 'x' bb ;" + , "B = 'x' A ;" + , "bb = [b]+ ;" + ] + tokenRules = [ r | r <- getIRules g, getIClause r == IStrLit "x" ] + -- both uses of 'x' share a single generated keyword rule + case tokenRules of + [tok] -> do + assertEqual "keyword token type" (Just "Keyword") (getIDataTypeName tok) + let tokName = getIRuleName tok + clauseOf n = getIClause <$> find ((== n) . getIRuleName) (getIRules g) + assertEqual "literal in A replaced by ignored token" + (Just $ IAlt [ISeq [IIgnore (IId tokName), IId "bb"]]) (clauseOf "A") + assertEqual "literal in B replaced by ignored token" + (Just $ IAlt [ISeq [IIgnore (IId tokName), IId "A"]]) (clauseOf "B") + _ -> assertFailure $ "expected exactly one token rule for 'x', got: " ++ show tokenRules + +listGrammar :: NormalGrammar +listGrammar = normalizeNoFill $ unlines + [ "grammar 'Mini';" + , "Program = Item* ;" + , "Item = ident ;" + , "ident = [a-z]+ ;" + ] + +testListProxy :: Test +testListProxy = TestCase $ do + let g = listGrammar + -- the user's list rule now points at a generated proxy element rule + proxyName <- case [ r | r <- allRules g, getSRuleName r == "Program" + , STMany{} <- [getSClause r] ] of + [SyntaxRule _ (STMany STStar (SSId proxy) Nothing)] -> return proxy + other -> fail $ "expected Program to stay a star rule over a proxy, got: " ++ show other + assertBool ("proxy named after the list rule: " ++ proxyName) + ("ListElem_Program" `isPrefixOf` proxyName) + -- the proxy parses either a $Program:var splice or a real (lifted) element + case find ((== proxyName) . getSRuleName) (allRules g) of + Just (SyntaxRule _ (STAltOfSeq [STSeq anti [SSId qqTok], STSeq "" [SSLifted "Item"]])) -> do + assertEqual "anti constructor lives in the element type" "Anti_Item" anti + assertEqual "QQ token is named after the list rule" "qq_Program" qqTok + other -> assertFailure $ "unexpected proxy rule shape: " ++ show other + -- the proxy is grouped under the element's type, and the anti rule splices lists + assertEqual "group of the proxy rule" ["Item"] + [ getSDataTypeName grp | grp <- getSyntaxRuleGroups g + , proxyName `elem` map getSRuleName (getSRules grp) ] + assertEqual "anti rules" [AntiRule "Item" "Item" "Anti_Item" True] (getAntiRules g) + +testAntiRuleSharing :: Test +testAntiRuleSharing = TestCase $ do + let g = normalizeNoFill $ unlines + [ "grammar 'Shared';" + , "Top = Expr ;" + , "Expr: Add = aa ;" + , "Expr: Mul = bb ;" + , "aa = [a]+ ;" + , "bb = [b]+ ;" + ] + assertEqual "one anti rule per type" + ["Expr", "Top"] (sort $ map arTypeName $ getAntiRules g) + assertEqual "one QQ lexical token per type" + ["qq_Expr", "qq_Top"] + (sort [ n | LexicalRule{getLRuleName = n} <- getLexicalRules g, "qq_" `isPrefixOf` n ]) + -- 'Expr' is a pure type group ("Top = Expr ;" references it but no rule + -- carries the name), so rtk synthesizes the cover "Expr = ,Add | ,Mul" + -- and the splice alternative sits only on the greedy attach point (Add, + -- first by declaration); a $Expr:var splice climbs to Expr through the + -- cover's unit production instead of every rule carrying a conflicting + -- reduce item of its own + let antiAltsOf name = [ alt | SyntaxRule rn (STAltOfSeq alts) <- allRules g, rn == name + , alt@(STSeq "Anti_Expr" _) <- alts ] + assertEqual "Add (the attach point) accepts $Expr: splices" + [STSeq "Anti_Expr" [SSId "qq_Expr"]] (antiAltsOf "Add") + assertEqual "Mul reaches splices through the cover instead" [] (antiAltsOf "Mul") + assertEqual "the synthesized cover carries no splice alternative" [] (antiAltsOf "Expr") + +-- | Issue #14: a declared type may exist only through rule annotations (a +-- "pure type group" - no rule is named after the type). Referencing the +-- bare type name used to fail generation with "reference to unknown rule"; +-- rtk now synthesizes the cover rule that authors write by hand, in lifted +-- form ("Thing = ,A | ,B"), so the type has a nonterminal and the lifted +-- alternatives pass the annotated rules' values through without adding an +-- AST constructor. The cover integrates with the splice attach machinery: +-- its alternatives are ordinary unit-production edges, so the splice +-- alternative lands on an annotated rule and a $Thing:var splice climbs to +-- Thing through the cover. +testTypeCoverSynthesis :: Test +testTypeCoverSynthesis = TestCase $ do + let g = normalizeNoFill $ unlines + [ "grammar 'I14';" + , "Start = Thing ;" + , "Thing : A = aa ;" + , "Thing : B = bb ;" + , "aa = [a]+ ;" + , "bb = [b]+ ;" + ] + -- the synthesized cover: one lifted alternative per annotated rule, in + -- declaration order + case [ alts | SyntaxRule "Thing" (STAltOfSeq alts) <- allRules g ] of + [alts] -> assertEqual "lifted unit production per annotated rule" + [STSeq "" [SSLifted "A"], STSeq "" [SSLifted "B"]] alts + other -> assertFailure $ "expected one synthesized cover rule 'Thing', got: " ++ show other + assertEqual "the cover is grouped under its type" ["Thing"] + [ getSDataTypeName grp | grp <- getSyntaxRuleGroups g + , "Thing" `elem` map getSRuleName (getSRules grp) ] + -- the covered group is an ordinary public data group: the start wrapper + -- includes it, so it gets a top-level quoter like a hand-written type + assertBool "the start wrapper covers Thing" + ("Thing" `M.member` getRuleToStartInfo (getGrammarInfo g)) + -- splice integration: the alternative sits on the attach point A; the + -- all-lifted cover itself carries none + let antiAltsOf name = [ alt | SyntaxRule rn (STAltOfSeq alts) <- allRules g, rn == name + , alt@(STSeq "Anti_Thing" _) <- alts ] + assertEqual "A (the attach point) accepts $Thing: splices" + [STSeq "Anti_Thing" [SSId "qq_Thing"]] (antiAltsOf "A") + assertEqual "B reaches splices through the cover instead" [] (antiAltsOf "B") + assertEqual "the cover has no splice alternative of its own" [] (antiAltsOf "Thing") + +-- | The original issue #14 shape: a list over the bare type name +-- ("Items = Thing* ~ ','"). The element resolves through the synthesized +-- cover - the list's element proxy is grouped under the type and lifts the +-- cover rule as its real-element alternative. +testTypeCoverListElement :: Test +testTypeCoverListElement = TestCase $ do + let g = normalizeNoFill $ unlines + [ "grammar 'I14';" + , "Start = Items ;" + , "Items = Thing* ~ ',' ;" + , "Thing : Leaf = num ;" + , "num = [0-9]+ ;" + ] + assertEqual "lifted cover over the single annotated rule" + [[STSeq "" [SSLifted "Leaf"]]] + [ alts | SyntaxRule "Thing" (STAltOfSeq alts) <- allRules g ] + proxyName <- case [ r | r <- allRules g, getSRuleName r == "Items" + , STMany{} <- [getSClause r] ] of + [SyntaxRule _ (STMany STStar (SSId proxy) (Just _))] -> return proxy + other -> fail $ "expected Items to stay a star rule over a proxy, got: " ++ show other + assertEqual "the list proxy is grouped under the covered type" ["Thing"] + [ getSDataTypeName grp | grp <- getSyntaxRuleGroups g + , proxyName `elem` map getSRuleName (getSRules grp) ] + case find ((== proxyName) . getSRuleName) (allRules g) of + Just (SyntaxRule _ (STAltOfSeq [STSeq "Anti_Thing" [SSId "qq_Items"], + STSeq "" [SSLifted lifted]])) -> + assertEqual "the proxy's real element is the cover" "Thing" lifted + other -> assertFailure $ "unexpected proxy rule shape: " ++ show other + +-- | The QQ start wrapper references every public type by name, so a +-- data-start grammar demands a cover even for a pure type the author never +-- references; generation used to fail on the wrapper's dangling reference +-- alone. The covered type then gets a top-level quoter like any other. +testTypeCoverWrapperDemand :: Test +testTypeCoverWrapperDemand = TestCase $ do + let g = normalizeNoFill $ unlines + [ "grammar 'I14';" + , "Start = Item ;" + , "Item = ident ;" + , "Thing : Leaf = ident ;" + , "ident = [a-z]+ ;" + ] + assertEqual "cover synthesized for the wrapper-demanded type" + [[STSeq "" [SSLifted "Leaf"]]] + [ alts | SyntaxRule "Thing" (STAltOfSeq alts) <- allRules g ] + assertBool "the start wrapper covers Thing" + ("Thing" `M.member` getRuleToStartInfo (getGrammarInfo g)) + +-- | Synthesis is demand-driven. An alias start group generates no QQ start +-- wrapper, so a pure type that nothing references demands no cover and the +-- grammar's output stays exactly as before - no unused-nonterminal noise. +-- This is the issue #14 retest's I14B reproducer, which already generated. +testTypeCoverOnDemand :: Test +testTypeCoverOnDemand = TestCase $ do + let g = normalizeNoFill $ unlines + [ "grammar 'I14B';" + , "Items = Item* ~ ',' ;" + , "Thing : Item = num ;" + , "num = [0-9]+ ;" + ] + assertEqual "no cover rule synthesized" [] + [ r | r <- allRules g, getSRuleName r == "Thing" ] + assertEqual "alias start group keeps no wrapper entries" + M.empty (getRuleToStartInfo (getGrammarInfo g)) + +-- | In a shared-type group whose rules form a unit-production chain +-- (java.pg's Expression hierarchy in miniature), only the bottom rule of +-- the chain receives the splice alternative; a splice climbs the unit +-- productions to whatever level its position demands. One alternative +-- means one reduce item for the splice token, so the parser has no +-- reduce/reduce conflict to resolve arbitrarily. +testChainAttachment :: Test +testChainAttachment = TestCase $ do + let g = normalizeNoFill $ unlines + [ "grammar 'Chain';" + , "Top = Expr ';' ;" + , "Expr : Expr = Add ;" + , "Expr : Add = Mul | Add '+' Mul ;" + , "Expr : Mul = aa | Mul '*' aa ;" + , "aa = [a]+ ;" + ] + antiAltsOf name = [ alt | SyntaxRule rn (STAltOfSeq alts) <- allRules g, rn == name + , alt@(STSeq "Anti_Expr" _) <- alts ] + assertEqual "Mul (the chain bottom) accepts $Expr: splices" + [STSeq "Anti_Expr" [SSId "qq_Expr"]] (antiAltsOf "Mul") + assertEqual "Add has no splice alternative of its own" [] (antiAltsOf "Add") + assertEqual "Expr has no splice alternative of its own" [] (antiAltsOf "Expr") + +-- | When no attach point can cover a demanded rule (here T is all-lifted, +-- so it cannot carry the alternative, and no unit production reaches it), +-- attachment falls back to every eligible rule of the group -- and, just as +-- important, normalization terminates instead of retrying a candidate that +-- covers nothing. +testAttachFallbackNoCover :: Test +testAttachFallbackNoCover = TestCase $ do + let g = normalizeNoFill $ unlines + [ "grammar 'X';" + , "S = T ;" + , "T : T = ,Q ;" + , "T : U = uu ;" + , "Q = qq ;" + , "uu = [u]+ ;" + , "qq = [q]+ ;" + ] + antiAltsOf name = [ alt | SyntaxRule rn (STAltOfSeq alts) <- allRules g, rn == name + , alt@(STSeq "Anti_T" _) <- alts ] + assertEqual "U accepts $T: splices" [STSeq "Anti_T" [SSId "qq_T"]] (antiAltsOf "U") + assertEqual "the lifted rule carries no splice alternative" [] (antiAltsOf "T") + +testShortcuts :: Test +testShortcuts = TestCase $ do + let g = normalizeNoFill $ unlines + [ "grammar 'Cut';" + , "Top = Expr ;" + , "@shortcuts(e, ex)" + , "Expr = ident ;" + , "ident = [a-z]+ ;" + ] + assertEqual "shortcuts map to the rule's type" + [("e", "Expr"), ("ex", "Expr")] (sort $ getShortcuts g) + +testOptionalDesugars :: Test +testOptionalDesugars = TestCase $ do + let g = normalizeNoFill $ unlines + [ "grammar 'Opt';" + , "Top = S ;" + , "S = ident? ;" + , "ident = [a-z]+ ;" + ] + case [ alts | SyntaxRule "S" (STAltOfSeq alts) <- allRules g ] of + [alts] -> assertEqual "splice, absent and present alternatives" + [STSeq "Anti_S" [SSId "qq_S"], STSeq "" [], STSeq "" [SSId "ident"]] alts + other -> assertFailure $ "unexpected S alternatives: " ++ show other + +testLexicalRuleDefaults :: Test +testLexicalRuleDefaults = TestCase $ do + let g = normalizeNoFill $ unlines + [ "grammar 'Lex';" + , "S = w ;" + , "w = [a]+ ;" + , "Int: x = [0-9]+ ;" + , "Int.toInteger: y = [0-9]+ ;" + , "@symmacro" + , "z = [c] ;" + ] + ruleOf n = find ((== n) . getLRuleName) (getLexicalRules g) + typeAndFunc n = case ruleOf n of + Just LexicalRule{getLRuleDataType = t, getLRuleFunc = f} -> Just (t, f) + _ -> Nothing + assertEqual "untyped rule is a String with id" (Just ("String", "id")) (typeAndFunc "w") + assertEqual "typed rule defaults to read" (Just ("Int", "read")) (typeAndFunc "x") + assertEqual "explicit conversion function wins" (Just ("Int", "toInteger")) (typeAndFunc "y") + case ruleOf "z" of + Just MacroRule{} -> return () + other -> assertFailure $ "@symmacro should produce a macro rule, got: " ++ show other + +testStartGroup :: Test +testStartGroup = TestCase $ do + -- a data start group: alias start groups get no wrapper at all + -- (see testAliasStartGroup) + let g = normalizeNoFill $ unlines + [ "grammar 'Mini';" + , "Top = Item ;" + , "Item = ident ;" + , "ident = [a-z]+ ;" + ] + info = getGrammarInfo g + startInfo = getRuleToStartInfo info + assertEqual "start rule is the first user rule" (Just "Top") (getStartRuleName info) + assertEqual "every public type gets a start entry" + ["Item", "Top"] (sort $ M.keys startInfo) + -- the synthesized start rule is prepended to the start group and wraps + -- each type between its dummy tokens (compared via show because STSeq + -- has no Ord instance) + case map getSRules (getSyntaxRuleGroups g) of + (SyntaxRule "Top" (STAltOfSeq alts) : _) : _ -> assertEqual "wrapper alternatives" + (sort [ show (STSeq "" [SSIgnore d, SSId t, SSIgnore d]) | (t, d) <- M.toList startInfo ]) + (sort (map show alts)) + other -> assertFailure $ "expected the synthesized start rule first, got: " ++ show other + -- each dummy token is lexed as a keyword spelled like its own name + mapM_ (\dummy -> case find ((== dummy) . getLRuleName) (getLexicalRules g) of + Just LexicalRule{getLRuleDataType = t, getLClause = cl} -> do + assertEqual ("dummy token type for " ++ dummy) "Keyword" t + assertEqual ("dummy token spelling for " ++ dummy) (IStrLit dummy) cl + other -> assertFailure $ "missing dummy keyword " ++ dummy ++ ": " ++ show other) + (M.elems startInfo) + +-- | A grammar whose START rule is a repetition normalizes to a type-alias +-- start group (type Start = [Item]). The QQ start-wrapper machinery (dummy +-- tokens, wrapper alternatives, top-level quoters) must be skipped for such +-- a grammar: a wrapper alternative needs a constructor in the start group's +-- data declaration, and an alias has none - injecting it used to generate a +-- parser that types the start nonterminal both as a data and as a list +-- (issue #34). The element-level splice machinery survives untouched. +testAliasStartGroup :: Test +testAliasStartGroup = TestCase $ do + let g = normalizeNoFill $ unlines + [ "grammar 'I34';" + , "Start = Item* ;" + , "Item = 'x' ;" + ] + info = getGrammarInfo g + assertEqual "no start wrapper entries" M.empty (getRuleToStartInfo info) + assertEqual "start rule name is still recorded" (Just "Start") (getStartRuleName info) + assertEqual "no dummy keyword tokens" [] + [ n | LexicalRule{getLRuleName = n} <- getLexicalRules g, "_dummy_" `isInfixOf` n ] + -- the start group is exactly the user's list rule over the element proxy + case getSyntaxRuleGroups g of + startGroup : _ -> case getSRules startGroup of + [SyntaxRule "Start" (STMany STStar (SSId proxy) Nothing)] -> + assertBool ("list proxy survives: " ++ proxy) + ("ListElem_Start" `isPrefixOf` proxy) + other -> assertFailure $ "expected only the bare list rule, got: " ++ show other + [] -> assertFailure "no rule groups" + -- element splices stay wired: the element type keeps its anti rule and + -- the $Start:var splice token is still lexed + assertEqual "anti rule for the element type" + [AntiRule "Item" "Item" "Anti_Item" True] (getAntiRules g) + assertBool "qq_Start splice token survives" + ("qq_Start" `elem` [ n | LexicalRule{getLRuleName = n} <- getLexicalRules g ]) + +testFillConstructorNames :: Test +testFillConstructorNames = TestCase $ do + let g = listGrammar + filled = fillConstructorNames g + assertEqual "no unnamed constructors remain" [] (unnamedConstructors filled) + assertBool "anti constructors survive filling" + ("Anti_Item" `elem` [ c | STSeq c _ <- allSeqs filled ]) + assertEqual "filling is idempotent" filled (fillConstructorNames filled) + +-------------------------------------------------------------------------------- +-- Self-hosted front end (the lexer/parser RTK generated from grammar.pg) +-------------------------------------------------------------------------------- + +selfHostedFrontEndTests :: Test +selfHostedFrontEndTests = TestList + [ TestLabel "parse errors carry a structured position" $ TestCase $ + -- ';' missing after the grammar declaration. The generated parser + -- encodes the position as "LINE:COL:message" and the adapter splits + -- it back out, so the diagnostic points at the identifier 'Foo' on + -- line 2 exactly like the hand-written front end's does. + expectDiagnostic "a missing ';'" + (parseGrammarSourceGenerated "grammar 'Test'\nFoo = bar;\n") $ \d -> do + assertEqual "position of 'Foo'" (Just (SourcePos 2 1)) (diagPos d) + assertBool ("unexpected message: " ++ diagMessage d) $ + "unexpected id" `isInfixOf` diagMessage d + , TestLabel "parse errors point where the reference front end points" $ TestCase $ + -- The wording differs (the generated parser renders tokens + -- generically, the reference parser knows the grammar language's + -- token names) but the position must be the same. + case ( parseGrammarSource "grammar 'Test'\nFoo = bar;\n" + , parseGrammarSourceGenerated "grammar 'Test'\nFoo = bar;\n" ) of + (Left dh, Left dg) -> assertEqual "same position" (diagPos dh) (diagPos dg) + _ -> assertFailure "both front ends should reject the missing ';'" + , TestLabel "lexical errors are identical to the reference front end's" $ TestCase $ + -- Both lexers encode "LINE:COL:lexical error. Following chars: ...", + -- so the rendered FILE:LINE:COL: error line is the same character + -- for character. + case ( parseGrammarSource "grammar 'Test';\nA = % ;\n" + , parseGrammarSourceGenerated "grammar 'Test';\nA = % ;\n" ) of + (Left dh, Left dg) -> do + assertEqual "identical diagnostics" dh dg + assertEqual "position of '%'" (Just (SourcePos 2 5)) (diagPos dg) + _ -> assertFailure "both front ends should reject the '%'" + , TestLabel "rule positions are captured: duplicate rules get a structured diagnostic" $ TestCase $ + -- The generated AST carries the position of every rule's first + -- token, and the adapter maps it into getIRulePos, so a + -- normalization diagnostic under the default front end points at the + -- offending line and column exactly like the hand-written front end. + expectDiagnostic "a duplicate rule" + (parseGrammarSourceGenerated "grammar 'Dup';\nFoo = 'a';\nFoo = 'b';\n" + >>= normalizeParsedGrammar) $ \d -> do + assertEqual "position of the second definition" (Just (SourcePos 3 1)) (diagPos d) + assertBool ("unexpected message: " ++ diagMessage d) $ + "defined more than once" `isInfixOf` diagMessage d + && "line 2, column 1" `isInfixOf` diagMessage d + ] + +-- | Both front ends must produce the same 'InitialGrammar' for every grammar +-- in the corpus, source positions included: the generated front end captures +-- 'getIRulePos' from the position fields of its AST, and they must agree +-- with the positions the hand-written parser records. This catches adapter +-- bugs with far better messages than a generated-artifact diff. Grammars +-- pinned in 'frontEndDivergentGrammars' are expected to differ (or be +-- rejected); the test fails once they agree, so the pin gets dropped. +astEqualityTestFor :: FilePath -> IO Test +astEqualityTestFor pgFile = do + source <- readFileUtf8 pgFile + let grammarKey = takeBaseName pgFile + hand = parseGrammarSource source + gen = parseGrammarSourceGenerated source + return $ TestLabel (grammarKey ++ " front-end AST equality") $ TestCase $ + case (lookup grammarKey frontEndDivergentGrammars, hand, gen) of + (_, Left d, _) -> assertFailure $ + "hand-written front end failed on " ++ pgFile ++ ": " ++ show d + (Nothing, Right h, Right g) -> + assertEqual "hand-written vs generated front end (positions included)" h g + (Nothing, _, Left d) -> assertFailure $ + "generated front end failed on " ++ pgFile ++ ": " ++ show d + (Just _, _, Left _) -> return () -- rejected: still divergent + (Just reason, Right h, Right g) -> + when (h == g) $ assertFailure $ + "the front ends now agree on this grammar (pinned because: " ++ reason + ++ ");\ndrop it from frontEndDivergentGrammars in test/TestSupport.hs" + +-------------------------------------------------------------------------------- +-- Invariants checked against every grammar in test-grammars/ +-------------------------------------------------------------------------------- + +invariantTestsFor :: FilePath -> IO Test +invariantTestsFor pgFile = do + source <- readFileUtf8 pgFile + normalized <- try (evaluate (forceGrammar (normalizeNoFill source))) + return $ TestLabel (takeBaseName pgFile ++ " invariants") $ case normalized of + Left err -> TestCase $ assertFailure $ + "normalization failed for " ++ pgFile ++ ":\n" ++ show (err :: SomeException) + Right g -> invariants (takeBaseName pgFile) g + +-- | References to rules that a grammar is known to leave undefined. +-- Currently empty: every grammar in test-grammars/ resolves all its +-- references. Pin a grammar here only to keep the invariant active for the +-- others while a known defect is being worked on. +knownUnresolvedReferences :: String -> [ID] +knownUnresolvedReferences _ = [] + +invariants :: String -> NormalGrammar -> Test +invariants grammarKey g = TestList + [ TestLabel "syntax rule names are unique" $ TestCase $ + -- the synthesized start wrapper legitimately shares the start rule's name + assertEqual "duplicate rule names" [] $ + duplicates (map getSRuleName (allRules g)) + `removeAll` maybeToList (getStartRuleName info) + , TestLabel "rule group types are unique" $ TestCase $ + assertEqual "duplicate group types" [] $ + duplicates (map getSDataTypeName (getSyntaxRuleGroups g)) + , TestLabel "token names are unique" $ TestCase $ + assertEqual "duplicate token names" [] $ + duplicates [ getLRuleName lr | lr@LexicalRule{} <- getLexicalRules g ] + , TestLabel "every clause reference resolves" $ TestCase $ do + let defined = S.fromList (map getSRuleName (allRules g)) `S.union` usableTokens + missing = [ ref + | r <- allRules g + , ref <- map clauseRef (clauseElems (getSClause r)) + , not (ref `S.member` defined) ] + assertEqual "references to unknown rules or tokens" + (knownUnresolvedReferences grammarKey) (sort (nub missing)) + , TestLabel "anti rules are unique per type" $ TestCase $ + assertEqual "duplicate anti rules" [] (duplicates (map arTypeName (getAntiRules g))) + , TestLabel "lifted clauses are well-formed" $ TestCase $ do + checked <- try (evaluate (length (filter (isClauseSeqLifted . seqClauses) (allSeqs g)))) + case checked of + Left err -> assertFailure $ "isClauseSeqLifted rejected a sequence: " + ++ show (err :: SomeException) + Right _ -> return () + , TestLabel "constructors are filled and unambiguous" $ TestCase $ do + let filled = fillConstructorNames g + assertEqual "unnamed constructors" [] (unnamedConstructors filled) + assertEqual "constructors with conflicting field types" [] (ambiguousConstructors filled) + assertEqual "filling is idempotent" filled (fillConstructorNames filled) + , TestLabel "start rule bookkeeping is consistent" $ TestCase $ + case getStartRuleName info of + Nothing -> assertFailure "start rule name is missing" + -- An alias start group (the grammar's first rule is a + -- repetition, e.g. debug-test's "Program = Statement *") gets + -- no start wrapper and no start info: there is no data + -- declaration for the wrapper constructors to extend + -- (see Normalize.addStartGroup, issue #34) + Just startName + | startGroupIsAlias -> do + assertEqual "only the original rule for an alias start group" + 1 (length [ () | r <- allRules g, getSRuleName r == startName ]) + assertEqual "no start info for an alias start group" + M.empty (getRuleToStartInfo info) + | otherwise -> do + assertEqual "start wrapper and original rule" + 2 (length [ () | r <- allRules g, getSRuleName r == startName ]) + assertEqual "start info covers exactly the public types" + (sort (map getSDataTypeName publicGroups)) + (sort (M.keys (getRuleToStartInfo info))) + , TestLabel "proxy rules refer to existing groups" $ TestCase $ + assertEqual "unknown proxy rules" [] $ + S.toList (getProxyRules info) + `removeAll` map getSDataTypeName (getSyntaxRuleGroups g) + ] + where + info = getGrammarInfo g + publicGroups = filterProxyRules (getProxyRules info) (getSyntaxRuleGroups g) + startGroupIsAlias = case getSyntaxRuleGroups g of + grp : _ -> any (notAltOfSeq . getSClause) (getSRules grp) + [] -> False + where notAltOfSeq STAltOfSeq{} = False + notAltOfSeq _ = True + -- tokens that may be referenced from syntax rules: macro rules are inlined + -- into the lexer spec and Ignore tokens are dropped from the token stream, + -- so neither may appear in a parser rule + usableTokens = S.fromList [ name | LexicalRule{getLRuleName = name, getLRuleDataType = dt} <- getLexicalRules g + , dt /= "Ignore" ] + +-------------------------------------------------------------------------------- +-- Small helpers over the normalized grammar +-------------------------------------------------------------------------------- + +allRules :: NormalGrammar -> [SyntaxRule] +allRules = concatMap getSRules . getSyntaxRuleGroups + +allSeqs :: NormalGrammar -> [STSeq] +allSeqs g = [ s | SyntaxRule _ (STAltOfSeq alts) <- allRules g, s <- alts ] + +seqClauses :: STSeq -> [SyntaxSimpleClause] +seqClauses (STSeq _ cs) = cs + +clauseElems :: SyntaxTopClause -> [SyntaxSimpleClause] +clauseElems (STMany _ c mc) = c : maybeToList mc +clauseElems (STOpt c) = [c] +clauseElems (STAltOfSeq alts) = concatMap seqClauses alts + +clauseRef :: SyntaxSimpleClause -> ID +clauseRef (SSId i) = i +clauseRef (SSLifted i) = i +clauseRef (SSIgnore i) = i + +unnamedConstructors :: NormalGrammar -> [STSeq] +unnamedConstructors g = [ s | s@(STSeq "" _) <- allSeqs g ] + +-- | Constructor names that would be generated with conflicting field types. +-- GenAST deduplicates alternatives by constructor name (shared types see the +-- same Anti_ alternative from several rules), which is only sound if every +-- occurrence of a constructor has the same field types. +ambiguousConstructors :: NormalGrammar -> [(ConstructorName, [[ID]])] +ambiguousConstructors g = + [ (name, S.toList fieldVariants) + | (name, fieldVariants) <- M.toList byConstructor, S.size fieldVariants > 1 ] + where + byConstructor = M.fromListWith S.union + [ (name, S.singleton (fieldTypes cs)) + | grp <- getSyntaxRuleGroups g + , SyntaxRule _ (STAltOfSeq alts) <- getSRules grp + , STSeq name cs <- alts + , not (isClauseSeqLifted cs) ] + fieldTypes cs = [ M.findWithDefault ("?" ++ i) i typeOf | SSId i <- cs ] + typeOf = M.fromList $ + [ (name, dt) | LexicalRule{getLRuleName = name, getLRuleDataType = dt} <- getLexicalRules g ] + ++ [ (getSRuleName r, getSDataTypeName grp) + | grp <- getSyntaxRuleGroups g, r <- getSRules grp ] + +duplicates :: Ord a => [a] -> [a] +duplicates xs = [ x | x : _ : _ <- group (sort xs) ] + +removeAll :: Eq a => [a] -> [a] -> [a] +removeAll xs banned = [ x | x <- xs, x `notElem` banned ] diff --git a/test/golden/debug-test/DebugTestLexer.x b/test/golden/debug-test/DebugTestLexer.x new file mode 100644 --- /dev/null +++ b/test/golden/debug-test/DebugTestLexer.x @@ -0,0 +1,117 @@ +-- Generated by RTK from grammar 'DebugTest'. Do not edit by hand. +{ +{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} +module DebugTestLexer(scanTokens, alexScanTokens, Token(..), PosToken(..), AlexPosn(..)) +where +import Data.Data (Data) + + } +%wrapper "monad" + + +tokens :- "}" { simple Tk__tok__symbol__12 } + "{" { simple Tk__tok__symbol__11 } + "while" { simple Tk__tok_while_10 } + "unused" { simple Tk__tok_unused_13 } + "if" { simple Tk__tok_if_8 } + "else" { simple Tk__tok_else_9 } + "=" { simple Tk__tok__eql__0 } + ";" { simple Tk__tok__semi__1 } + "/" { simple Tk__tok__symbol__5 } + "-" { simple Tk__tok__minus__3 } + "+" { simple Tk__tok__plus__2 } + "*" { simple Tk__tok__star__4 } + ")" { simple Tk__tok__rparen__7 } + "(" { simple Tk__tok__lparen__6 } + (['0'-'9']+) { simple1 $ Tk__number . (id) } + (['a'-'z'\ 'A'-'Z'] ['a'-'z'\ 'A'-'Z'\ '0'-'9']*) { simple1 $ Tk__identifier . (id) } + ("$" "UnusedRule2" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_UnusedRule2 . ((tail . dropWhile (/= ':'))) } + ("$" "UnusedRule1" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_UnusedRule1 . ((tail . dropWhile (/= ':'))) } + ("$" "Block" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Block . ((tail . dropWhile (/= ':'))) } + ("$" "WhileLoop" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_WhileLoop . ((tail . dropWhile (/= ':'))) } + ("$" "IfStatement" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_IfStatement . ((tail . dropWhile (/= ':'))) } + ("$" "Factor" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Factor . ((tail . dropWhile (/= ':'))) } + ("$" "Term" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Term . ((tail . dropWhile (/= ':'))) } + ("$" "Expression" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Expression . ((tail . dropWhile (/= ':'))) } + ("$" "Assignment" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Assignment . ((tail . dropWhile (/= ':'))) } + ("$" "Statement" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Statement . ((tail . dropWhile (/= ':'))) } + ("$" "Program" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Program . ((tail . dropWhile (/= ':'))) } + . { rtkError } + +{ +data Token = EndOfFile | + Tk__tok__symbol__12 | + Tk__tok__symbol__11 | + Tk__tok_while_10 | + Tk__tok_unused_13 | + Tk__tok_if_8 | + Tk__tok_else_9 | + Tk__tok__eql__0 | + Tk__tok__semi__1 | + Tk__tok__symbol__5 | + Tk__tok__minus__3 | + Tk__tok__plus__2 | + Tk__tok__star__4 | + Tk__tok__rparen__7 | + Tk__tok__lparen__6 | + Tk__number String | + Tk__identifier String | + Tk__qq_UnusedRule2 String | + Tk__qq_UnusedRule1 String | + Tk__qq_Block String | + Tk__qq_WhileLoop String | + Tk__qq_IfStatement String | + Tk__qq_Factor String | + Tk__qq_Term String | + Tk__qq_Expression String | + Tk__qq_Assignment String | + Tk__qq_Statement String | + Tk__qq_Program String + deriving (Show) + +-- AlexPosn is defined by the alex wrapper, so the Data instance (required by +-- the parser's RtkPos position type) can only be attached via standalone +-- deriving - the same solution as the hand-written Lexer.x +deriving instance Data AlexPosn + +-- A token together with the source position where it starts +data PosToken = PosToken { ptPos :: AlexPosn, ptToken :: Token } + deriving (Show) + +alexEOF = do + (pos, _, _, _) <- alexGetInput + return $ PosToken pos EndOfFile + +-- Lex the input into a token stream, returning the positioned error message +-- on a lexical error (encoded as "LINE:COL:message", see rtkError below). +-- The returned list always ends with an EndOfFile token that carries the +-- position of the end of input, so parse errors at end of input can be +-- reported with a position too +scanTokens :: String -> Either String [PosToken] +scanTokens str = runAlex str $ do + let loop toks = do tok <- alexMonadScan + case tok of + PosToken _ EndOfFile -> return $ reverse (tok : toks) + _ -> let toks' = tok : toks + in toks' `seq` loop toks' + loop [] + +-- Thin compatibility wrapper: callers that have not switched to 'scanTokens' +-- get the error message thrown instead +alexScanTokens :: String -> [PosToken] +alexScanTokens str = + case scanTokens str of + Right toks -> toks + Left err -> errorWithoutStackTrace err + +simple1 :: (String -> Token) -> AlexInput -> Int -> Alex PosToken +simple1 t (pos, _, _, str) len = return $ PosToken pos (t (take len str)) + +simple :: Token -> AlexInput -> Int -> Alex PosToken +simple t (pos, _, _, _) len = return $ PosToken pos t + +-- Encode the position as "LINE:COL:message" so callers can split it back out +-- into a structured position - the same encoding the rtk grammar lexer uses +rtkError ((AlexPn _ line column), _, _, str) len = alexError $ (show line) ++ ":" ++ (show column) ++ ":lexical error. Following chars: " ++ (take 10 str) + +} diff --git a/test/golden/debug-test/DebugTestParser.y b/test/golden/debug-test/DebugTestParser.y new file mode 100644 --- /dev/null +++ b/test/golden/debug-test/DebugTestParser.y @@ -0,0 +1,312 @@ +-- Generated by RTK from grammar 'DebugTest'. Do not edit by hand. +{ +{-# LANGUAGE DeriveDataTypeable #-} +module DebugTestParser where +import qualified Data.Generics as Gen +import qualified DebugTestLexer as L (Token(..), PosToken(..), AlexPosn(..), alexScanTokens) +} + +%name parseDebugTest +%tokentype { L.PosToken } +%monad { Either String } +%error { parseError } + +%token + +rtk__eof { L.PosToken _ L.EndOfFile } +tok__symbol__12 { L.PosToken _ L.Tk__tok__symbol__12 } +tok__symbol__11 { L.PosToken _ L.Tk__tok__symbol__11 } +tok_while_10 { L.PosToken _ L.Tk__tok_while_10 } +tok_unused_13 { L.PosToken _ L.Tk__tok_unused_13 } +tok_if_8 { L.PosToken _ L.Tk__tok_if_8 } +tok_else_9 { L.PosToken _ L.Tk__tok_else_9 } +tok__eql__0 { L.PosToken _ L.Tk__tok__eql__0 } +tok__semi__1 { L.PosToken _ L.Tk__tok__semi__1 } +tok__symbol__5 { L.PosToken _ L.Tk__tok__symbol__5 } +tok__minus__3 { L.PosToken _ L.Tk__tok__minus__3 } +tok__plus__2 { L.PosToken _ L.Tk__tok__plus__2 } +tok__star__4 { L.PosToken _ L.Tk__tok__star__4 } +tok__rparen__7 { L.PosToken _ L.Tk__tok__rparen__7 } +tok__lparen__6 { L.PosToken _ L.Tk__tok__lparen__6 } +number { L.PosToken _ (L.Tk__number _) } +identifier { L.PosToken _ (L.Tk__identifier _) } +qq_UnusedRule2 { L.PosToken _ (L.Tk__qq_UnusedRule2 _) } +qq_UnusedRule1 { L.PosToken _ (L.Tk__qq_UnusedRule1 _) } +qq_Block { L.PosToken _ (L.Tk__qq_Block _) } +qq_WhileLoop { L.PosToken _ (L.Tk__qq_WhileLoop _) } +qq_IfStatement { L.PosToken _ (L.Tk__qq_IfStatement _) } +qq_Factor { L.PosToken _ (L.Tk__qq_Factor _) } +qq_Term { L.PosToken _ (L.Tk__qq_Term _) } +qq_Expression { L.PosToken _ (L.Tk__qq_Expression _) } +qq_Assignment { L.PosToken _ (L.Tk__qq_Assignment _) } +qq_Statement { L.PosToken _ (L.Tk__qq_Statement _) } +qq_Program { L.PosToken _ (L.Tk__qq_Program _) } + +%% + +DebugTest__top : Program rtk__eof { (reverse $1) } + +Program : {- empty -} { [] } | + Program ListElem_Program0 { $2 : $1 } + +Assignment : qq_Assignment { Anti_Assignment (tkVal_qq_Assignment $1) } | + identifier tok__eql__0 Expression tok__semi__1 { Ctr__Assignment__0 (rtkPosOf $1) (tkVal_identifier $1) $3 } + +Block : qq_Block { Anti_Block (tkVal_qq_Block $1) } | + tok__symbol__11 Rule_7 tok__symbol__12 { Ctr__Block__0 (rtkPosOf $1) (reverse $2) } + +Expression : qq_Expression { Anti_Expression (tkVal_qq_Expression $1) } | + Term Rule_1 { Ctr__Expression__0 (rtkPosOf $1) $1 (reverse $2) } + +Factor : qq_Factor { Anti_Factor (tkVal_qq_Factor $1) } | + identifier { Ctr__Factor__0 (rtkPosOf $1) (tkVal_identifier $1) } | + number { Ctr__Factor__1 (rtkPosOf $1) (tkVal_number $1) } | + tok__lparen__6 Expression tok__rparen__7 { Ctr__Factor__2 (rtkPosOf $1) $2 } + +IfStatement : qq_IfStatement { Anti_IfStatement (tkVal_qq_IfStatement $1) } | + tok_if_8 tok__lparen__6 Expression tok__rparen__7 Statement { Ctr__IfStatement__0 (rtkPosOf $1) $3 $5 } | + tok_if_8 tok__lparen__6 Expression tok__rparen__7 Statement tok_else_9 Statement { Ctr__IfStatement__1 (rtkPosOf $1) $3 $5 $7 } + +Rule_1 : {- empty -} { [] } | + Rule_1 Rule_2 { $2 : $1 } + +Rule_2 : Rule_3 Term { Ctr__Rule_2__0 (rtkPosOf $1) $1 $2 } + +Rule_3 : tok__plus__2 { Ctr__Rule_3__0 (rtkPosOf $1) } | + tok__minus__3 { Ctr__Rule_3__1 (rtkPosOf $1) } + +Rule_4 : {- empty -} { [] } | + Rule_4 Rule_5 { $2 : $1 } + +Rule_5 : Rule_6 Factor { Ctr__Rule_5__0 (rtkPosOf $1) $1 $2 } + +Rule_6 : tok__star__4 { Ctr__Rule_6__0 (rtkPosOf $1) } | + tok__symbol__5 { Ctr__Rule_6__1 (rtkPosOf $1) } + +Rule_7 : {- empty -} { [] } | + Rule_7 Statement { $2 : $1 } + +Statement : qq_Statement { Anti_Statement (tkVal_qq_Statement $1) } | + Assignment { Ctr__Statement__0 (rtkPosOf $1) $1 } | + IfStatement { Ctr__Statement__1 (rtkPosOf $1) $1 } | + WhileLoop { Ctr__Statement__2 (rtkPosOf $1) $1 } | + Block { Ctr__Statement__3 (rtkPosOf $1) $1 } + +ListElem_Program0 : qq_Program { Anti_Statement (tkVal_qq_Program $1) } | + Statement { $1 } + +Term : qq_Term { Anti_Term (tkVal_qq_Term $1) } | + Factor Rule_4 { Ctr__Term__0 (rtkPosOf $1) $1 (reverse $2) } + +ListElem_UnusedRule28 : qq_UnusedRule2 { Anti_UnusedRule1 (tkVal_qq_UnusedRule2 $1) } | + UnusedRule1 { $1 } + +UnusedRule1 : qq_UnusedRule1 { Anti_UnusedRule1 (tkVal_qq_UnusedRule1 $1) } | + tok_unused_13 identifier { Ctr__UnusedRule1__1 (rtkPosOf $1) (tkVal_identifier $2) } + +UnusedRule2 : {- empty -} { [] } | + UnusedRule2 ListElem_UnusedRule28 { $2 : $1 } + +WhileLoop : qq_WhileLoop { Anti_WhileLoop (tkVal_qq_WhileLoop $1) } | + tok_while_10 tok__lparen__6 Expression tok__rparen__7 Statement { Ctr__WhileLoop__0 (rtkPosOf $1) $3 $5 } + + +{ +parseError :: [L.PosToken] -> Either String a +parseError [] = Left "unexpected end of input" +parseError (L.PosToken (L.AlexPn _ line col) tok : _) = + Left $ show line ++ ":" ++ show col ++ ":unexpected " ++ showRtkToken tok + +-- Render a token the way it appears in the source, for error messages +showRtkToken :: L.Token -> String +showRtkToken L.EndOfFile = "end of input" +showRtkToken L.Tk__tok__symbol__12 = "'}'" +showRtkToken L.Tk__tok__symbol__11 = "'{'" +showRtkToken L.Tk__tok_while_10 = "'while'" +showRtkToken L.Tk__tok_unused_13 = "'unused'" +showRtkToken L.Tk__tok_if_8 = "'if'" +showRtkToken L.Tk__tok_else_9 = "'else'" +showRtkToken L.Tk__tok__eql__0 = "'='" +showRtkToken L.Tk__tok__semi__1 = "';'" +showRtkToken L.Tk__tok__symbol__5 = "'/'" +showRtkToken L.Tk__tok__minus__3 = "'-'" +showRtkToken L.Tk__tok__plus__2 = "'+'" +showRtkToken L.Tk__tok__star__4 = "'*'" +showRtkToken L.Tk__tok__rparen__7 = "')'" +showRtkToken L.Tk__tok__lparen__6 = "'('" +showRtkToken (L.Tk__number v) = "number " ++ show v +showRtkToken (L.Tk__identifier v) = "identifier " ++ show v +showRtkToken (L.Tk__qq_UnusedRule2 v) = "qq_UnusedRule2 " ++ show v +showRtkToken (L.Tk__qq_UnusedRule1 v) = "qq_UnusedRule1 " ++ show v +showRtkToken (L.Tk__qq_Block v) = "qq_Block " ++ show v +showRtkToken (L.Tk__qq_WhileLoop v) = "qq_WhileLoop " ++ show v +showRtkToken (L.Tk__qq_IfStatement v) = "qq_IfStatement " ++ show v +showRtkToken (L.Tk__qq_Factor v) = "qq_Factor " ++ show v +showRtkToken (L.Tk__qq_Term v) = "qq_Term " ++ show v +showRtkToken (L.Tk__qq_Expression v) = "qq_Expression " ++ show v +showRtkToken (L.Tk__qq_Assignment v) = "qq_Assignment " ++ show v +showRtkToken (L.Tk__qq_Statement v) = "qq_Statement " ++ show v +showRtkToken (L.Tk__qq_Program v) = "qq_Program " ++ show v + +-- Source position of a node: every constructor except the Anti_* splice +-- artifacts stores the position of its alternative's first symbol in its +-- first field. Positions are transparent for equality and ordering, so two +-- ASTs that differ only in source positions (e.g. a quasi-quote parsed at +-- compile time vs the same construct parsed at run time) compare equal. +newtype RtkPos = RtkPos L.AlexPosn deriving (Show, Gen.Data, Gen.Typeable) +instance Eq RtkPos where _ == _ = True +instance Ord RtkPos where compare _ _ = EQ + +-- The position used where no source token exists: empty productions, empty +-- lists, absent optionals and Anti_* quasi-quote splices +rtkNoPos :: RtkPos +rtkNoPos = RtkPos (L.AlexPn 0 0 0) + +class RtkPosOf a where + rtkPosOf :: a -> RtkPos +instance RtkPosOf L.PosToken where + rtkPosOf (L.PosToken p _) = RtkPos p +instance RtkPosOf a => RtkPosOf [a] where + rtkPosOf (x : _) = rtkPosOf x + rtkPosOf [] = rtkNoPos +instance RtkPosOf a => RtkPosOf (Maybe a) where + rtkPosOf (Just x) = rtkPosOf x + rtkPosOf Nothing = rtkNoPos +-- A Char carries no position; this also covers String token payloads +instance RtkPosOf Char where + rtkPosOf _ = rtkNoPos + +-- Recover a token's payload from the whole positioned token: %token +-- bindings keep the L.PosToken so semantic actions can read its position +tkVal_number :: L.PosToken -> String +tkVal_number (L.PosToken _ (L.Tk__number v)) = v +tkVal_number t = error ("rtk internal error: token number expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_identifier :: L.PosToken -> String +tkVal_identifier (L.PosToken _ (L.Tk__identifier v)) = v +tkVal_identifier t = error ("rtk internal error: token identifier expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_UnusedRule2 :: L.PosToken -> String +tkVal_qq_UnusedRule2 (L.PosToken _ (L.Tk__qq_UnusedRule2 v)) = v +tkVal_qq_UnusedRule2 t = error ("rtk internal error: token qq_UnusedRule2 expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_UnusedRule1 :: L.PosToken -> String +tkVal_qq_UnusedRule1 (L.PosToken _ (L.Tk__qq_UnusedRule1 v)) = v +tkVal_qq_UnusedRule1 t = error ("rtk internal error: token qq_UnusedRule1 expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Block :: L.PosToken -> String +tkVal_qq_Block (L.PosToken _ (L.Tk__qq_Block v)) = v +tkVal_qq_Block t = error ("rtk internal error: token qq_Block expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_WhileLoop :: L.PosToken -> String +tkVal_qq_WhileLoop (L.PosToken _ (L.Tk__qq_WhileLoop v)) = v +tkVal_qq_WhileLoop t = error ("rtk internal error: token qq_WhileLoop expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_IfStatement :: L.PosToken -> String +tkVal_qq_IfStatement (L.PosToken _ (L.Tk__qq_IfStatement v)) = v +tkVal_qq_IfStatement t = error ("rtk internal error: token qq_IfStatement expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Factor :: L.PosToken -> String +tkVal_qq_Factor (L.PosToken _ (L.Tk__qq_Factor v)) = v +tkVal_qq_Factor t = error ("rtk internal error: token qq_Factor expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Term :: L.PosToken -> String +tkVal_qq_Term (L.PosToken _ (L.Tk__qq_Term v)) = v +tkVal_qq_Term t = error ("rtk internal error: token qq_Term expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Expression :: L.PosToken -> String +tkVal_qq_Expression (L.PosToken _ (L.Tk__qq_Expression v)) = v +tkVal_qq_Expression t = error ("rtk internal error: token qq_Expression expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Assignment :: L.PosToken -> String +tkVal_qq_Assignment (L.PosToken _ (L.Tk__qq_Assignment v)) = v +tkVal_qq_Assignment t = error ("rtk internal error: token qq_Assignment expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Statement :: L.PosToken -> String +tkVal_qq_Statement (L.PosToken _ (L.Tk__qq_Statement v)) = v +tkVal_qq_Statement t = error ("rtk internal error: token qq_Statement expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Program :: L.PosToken -> String +tkVal_qq_Program (L.PosToken _ (L.Tk__qq_Program v)) = v +tkVal_qq_Program t = error ("rtk internal error: token qq_Program expected, got " ++ showRtkToken (L.ptToken t)) + +type Program = [Statement] +data Assignment = Anti_Assignment String | + Ctr__Assignment__0 RtkPos String Expression + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Assignment where + rtkPosOf (Anti_Assignment _) = rtkNoPos + rtkPosOf (Ctr__Assignment__0 p _ _) = p +data Block = Anti_Block String | + Ctr__Block__0 RtkPos Rule_7 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Block where + rtkPosOf (Anti_Block _) = rtkNoPos + rtkPosOf (Ctr__Block__0 p _) = p +data Expression = Anti_Expression String | + Ctr__Expression__0 RtkPos Term Rule_1 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Expression where + rtkPosOf (Anti_Expression _) = rtkNoPos + rtkPosOf (Ctr__Expression__0 p _ _) = p +data Factor = Anti_Factor String | + Ctr__Factor__0 RtkPos String | + Ctr__Factor__1 RtkPos String | + Ctr__Factor__2 RtkPos Expression + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Factor where + rtkPosOf (Anti_Factor _) = rtkNoPos + rtkPosOf (Ctr__Factor__0 p _) = p + rtkPosOf (Ctr__Factor__1 p _) = p + rtkPosOf (Ctr__Factor__2 p _) = p +data IfStatement = Anti_IfStatement String | + Ctr__IfStatement__0 RtkPos Expression Statement | + Ctr__IfStatement__1 RtkPos Expression Statement Statement + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf IfStatement where + rtkPosOf (Anti_IfStatement _) = rtkNoPos + rtkPosOf (Ctr__IfStatement__0 p _ _) = p + rtkPosOf (Ctr__IfStatement__1 p _ _ _) = p +type Rule_1 = [Rule_2] +data Rule_2 = Ctr__Rule_2__0 RtkPos Rule_3 Term + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_2 where + rtkPosOf (Ctr__Rule_2__0 p _ _) = p +data Rule_3 = Ctr__Rule_3__0 RtkPos | + Ctr__Rule_3__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_3 where + rtkPosOf (Ctr__Rule_3__0 p) = p + rtkPosOf (Ctr__Rule_3__1 p) = p +type Rule_4 = [Rule_5] +data Rule_5 = Ctr__Rule_5__0 RtkPos Rule_6 Factor + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_5 where + rtkPosOf (Ctr__Rule_5__0 p _ _) = p +data Rule_6 = Ctr__Rule_6__0 RtkPos | + Ctr__Rule_6__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_6 where + rtkPosOf (Ctr__Rule_6__0 p) = p + rtkPosOf (Ctr__Rule_6__1 p) = p +type Rule_7 = [Statement] +data Statement = Anti_Statement String | + Ctr__Statement__0 RtkPos Assignment | + Ctr__Statement__1 RtkPos IfStatement | + Ctr__Statement__2 RtkPos WhileLoop | + Ctr__Statement__3 RtkPos Block + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Statement where + rtkPosOf (Anti_Statement _) = rtkNoPos + rtkPosOf (Ctr__Statement__0 p _) = p + rtkPosOf (Ctr__Statement__1 p _) = p + rtkPosOf (Ctr__Statement__2 p _) = p + rtkPosOf (Ctr__Statement__3 p _) = p +data Term = Anti_Term String | + Ctr__Term__0 RtkPos Factor Rule_4 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Term where + rtkPosOf (Anti_Term _) = rtkNoPos + rtkPosOf (Ctr__Term__0 p _ _) = p +data UnusedRule1 = Anti_UnusedRule1 String | + Ctr__UnusedRule1__1 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf UnusedRule1 where + rtkPosOf (Anti_UnusedRule1 _) = rtkNoPos + rtkPosOf (Ctr__UnusedRule1__1 p _) = p +type UnusedRule2 = [UnusedRule1] +data WhileLoop = Anti_WhileLoop String | + Ctr__WhileLoop__0 RtkPos Expression Statement + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf WhileLoop where + rtkPosOf (Anti_WhileLoop _) = rtkNoPos + rtkPosOf (Ctr__WhileLoop__0 p _ _) = p +} diff --git a/test/golden/debug-test/DebugTestQQ.hs b/test/golden/debug-test/DebugTestQQ.hs new file mode 100644 --- /dev/null +++ b/test/golden/debug-test/DebugTestQQ.hs @@ -0,0 +1,193 @@ +-- Generated by RTK from grammar 'DebugTest'. Do not edit by hand. +{-# LANGUAGE TemplateHaskell #-} +module DebugTestQQ +where + +import qualified Data.Char as C +import qualified Data.Map as M +import Data.List +import Data.Maybe +import qualified Data.Generics as Generics +import qualified Data.Data as Data +import qualified Language.Haskell.TH as TH +import Language.Haskell.TH.Quote +import DebugTestLexer +import DebugTestParser + +qqShortcuts :: M.Map String String + +-- A $name metavariable is rewritten to $Type:name using the qqShortcuts +-- table below. The rewrite is purely textual, so it would also fire inside +-- the quoted language's own string literals: write $$name there to escape +-- it and get the literal text $name. Each '$$' pair directly before a +-- metavariable stands for one literal '$' (so $$$x is a literal '$' +-- followed by the metavariable $x). A '$' not followed by an identifier is +-- never rewritten and needs no escape, and an explicit $Type:name antiquote +-- (the character after the name is ':') passes through untouched. +-- A plain character scan rather than a regex: metavariables are recognized +-- regardless of what follows the name - including a newline or the end of +-- the quote, which the previous regex's terminator class missed. +replaceAllPatterns :: String -> Either String String +replaceAllPatterns [] = Right [] +replaceAllPatterns s@('$' : _) = + let (dollars, rest) = span (== '$') s + in case rest of + (c1 : _) | C.isAlpha c1 || c1 == '_' -> + let (varName, post) = span (\ ch -> C.isAlphaNum ch || ch == '_') rest + escCount = length dollars - 1 + keptPre = replicate (div escCount 2) '$' + in case post of + (':' : _) -> ((dollars ++ varName) ++) <$> replaceAllPatterns post + _ | odd escCount -> ((keptPre ++ '$' : varName) ++) <$> replaceAllPatterns post + _ -> case catMaybes $ map (\ prefix -> M.lookup prefix qqShortcuts) $ reverse $ inits varName of + [] -> Left $ unlines + [ "Unknown metavariable $" ++ varName ++ " in quasi-quote:" + , "no prefix of '" ++ varName ++ "' is a known shortcut. Known shortcuts:" + , " " ++ intercalate ", " (M.keys qqShortcuts) + , "To include the literal text $" ++ varName ++ " in the quoted code" + , "(e.g. inside a string literal), escape it as $$" ++ varName ++ "." ] + (rule : _) -> ((keptPre ++ '$' : rule ++ ":" ++ varName) ++) <$> replaceAllPatterns post + _ -> (dollars ++) <$> replaceAllPatterns rest +replaceAllPatterns (c : rest) = (c :) <$> replaceAllPatterns rest + +-- The generated lexer and parser encode error positions as "LINE:COL:message" +-- so structured-diagnostic callers can split them; render them back +-- human-readably for quasi-quote compile errors. Positions refer to the quote +-- body (padded with a start token in front). +rtkRenderError :: String -> String +rtkRenderError err = + case span (/= ':') err of + (l, ':' : rest1) | [(line, "")] <- (reads l :: [(Int, String)]) -> + case span (/= ':') rest1 of + (c, ':' : msg) | [(col, "")] <- (reads c :: [(Int, String)]) -> + "line " ++ show line ++ ", column " ++ show col ++ ": " ++ msg + _ -> err + _ -> err + +qqShortcuts = M.fromList [ ("program","Program"),("assignment","Assignment"),("block","Block"),("expression","Expression"),("factor","Factor"),("ifStatement","IfStatement"),("statement","Statement"),("term","Term"),("unusedRule1","UnusedRule1"),("unusedRule2","UnusedRule2"),("whileLoop","WhileLoop")] + +-- A quasi-quote pattern must match an AST parsed from anywhere in a source +-- file, while the pattern itself was parsed from the quote body - so every +-- RtkPos position field becomes a wildcard in generated patterns. +-- (Expressions need no special case: the compile-time position they embed +-- is equality-transparent.) +rtkPosWildPat :: RtkPos -> Maybe (TH.Q TH.Pat) +rtkPosWildPat _ = Just TH.wildP + +quoteDebugTestExp :: Data.Data a => String -> (Program -> a) -> String -> TH.ExpQ +quoteDebugTestExp dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseDebugTest of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToExpQ (const Nothing `Generics.extQ` antiStatementExp `Generics.extQ` antiAssignmentExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiTermExp `Generics.extQ` antiFactorExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiWhileLoopExp `Generics.extQ` antiBlockExp `Generics.extQ` antiUnusedRule1Exp) expr +quoteDebugTestPat :: Data.Data a => String -> (Program -> a) -> String -> TH.PatQ +quoteDebugTestPat dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseDebugTest of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToPatQ (const Nothing `Generics.extQ` rtkPosWildPat `Generics.extQ` antiStatementPat `Generics.extQ` antiAssignmentPat `Generics.extQ` antiExpressionPat `Generics.extQ` antiTermPat `Generics.extQ` antiFactorPat `Generics.extQ` antiIfStatementPat `Generics.extQ` antiWhileLoopPat `Generics.extQ` antiBlockPat `Generics.extQ` antiUnusedRule1Pat) expr + +antiUnusedRule1Exp :: UnusedRule1 -> Maybe (TH.Q TH.Exp ) +antiUnusedRule1Exp ( Anti_UnusedRule1 v) = Just $ TH.varE (TH.mkName v) +antiUnusedRule1Exp _ = Nothing + + +antiBlockExp :: Block -> Maybe (TH.Q TH.Exp ) +antiBlockExp ( Anti_Block v) = Just $ TH.varE (TH.mkName v) +antiBlockExp _ = Nothing + + +antiWhileLoopExp :: WhileLoop -> Maybe (TH.Q TH.Exp ) +antiWhileLoopExp ( Anti_WhileLoop v) = Just $ TH.varE (TH.mkName v) +antiWhileLoopExp _ = Nothing + + +antiIfStatementExp :: IfStatement -> Maybe (TH.Q TH.Exp ) +antiIfStatementExp ( Anti_IfStatement v) = Just $ TH.varE (TH.mkName v) +antiIfStatementExp _ = Nothing + + +antiFactorExp :: Factor -> Maybe (TH.Q TH.Exp ) +antiFactorExp ( Anti_Factor v) = Just $ TH.varE (TH.mkName v) +antiFactorExp _ = Nothing + + +antiTermExp :: Term -> Maybe (TH.Q TH.Exp ) +antiTermExp ( Anti_Term v) = Just $ TH.varE (TH.mkName v) +antiTermExp _ = Nothing + + +antiExpressionExp :: Expression -> Maybe (TH.Q TH.Exp ) +antiExpressionExp ( Anti_Expression v) = Just $ TH.varE (TH.mkName v) +antiExpressionExp _ = Nothing + + +antiAssignmentExp :: Assignment -> Maybe (TH.Q TH.Exp ) +antiAssignmentExp ( Anti_Assignment v) = Just $ TH.varE (TH.mkName v) +antiAssignmentExp _ = Nothing + + +antiStatementExp :: [ Statement ] -> Maybe (TH.Q TH.Exp) +antiStatementExp ((Anti_Statement v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiStatementExp `Generics.extQ` antiAssignmentExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiTermExp `Generics.extQ` antiFactorExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiWhileLoopExp `Generics.extQ` antiBlockExp `Generics.extQ` antiUnusedRule1Exp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiStatementExp _ = Nothing + + + +antiUnusedRule1Pat :: UnusedRule1 -> Maybe (TH.Q TH.Pat ) +antiUnusedRule1Pat ( Anti_UnusedRule1 v) = Just $ TH.varP (TH.mkName v) +antiUnusedRule1Pat _ = Nothing + + +antiBlockPat :: Block -> Maybe (TH.Q TH.Pat ) +antiBlockPat ( Anti_Block v) = Just $ TH.varP (TH.mkName v) +antiBlockPat _ = Nothing + + +antiWhileLoopPat :: WhileLoop -> Maybe (TH.Q TH.Pat ) +antiWhileLoopPat ( Anti_WhileLoop v) = Just $ TH.varP (TH.mkName v) +antiWhileLoopPat _ = Nothing + + +antiIfStatementPat :: IfStatement -> Maybe (TH.Q TH.Pat ) +antiIfStatementPat ( Anti_IfStatement v) = Just $ TH.varP (TH.mkName v) +antiIfStatementPat _ = Nothing + + +antiFactorPat :: Factor -> Maybe (TH.Q TH.Pat ) +antiFactorPat ( Anti_Factor v) = Just $ TH.varP (TH.mkName v) +antiFactorPat _ = Nothing + + +antiTermPat :: Term -> Maybe (TH.Q TH.Pat ) +antiTermPat ( Anti_Term v) = Just $ TH.varP (TH.mkName v) +antiTermPat _ = Nothing + + +antiExpressionPat :: Expression -> Maybe (TH.Q TH.Pat ) +antiExpressionPat ( Anti_Expression v) = Just $ TH.varP (TH.mkName v) +antiExpressionPat _ = Nothing + + +antiAssignmentPat :: Assignment -> Maybe (TH.Q TH.Pat ) +antiAssignmentPat ( Anti_Assignment v) = Just $ TH.varP (TH.mkName v) +antiAssignmentPat _ = Nothing + + +antiStatementPat :: [ Statement ] -> Maybe (TH.Q TH.Pat) +antiStatementPat [Anti_Statement v] = Just $ TH.varP (TH.mkName v) +antiStatementPat _ = Nothing + + + +-- This grammar's quasi-quoters work in expression and pattern contexts only +quoteDebugTestType _ = fail "this quasi-quoter cannot be used in a type context" +quoteDebugTestDecs _ = fail "this quasi-quoter cannot be used in a declaration context" + + diff --git a/test/golden/grammar/GrammarLexer.x b/test/golden/grammar/GrammarLexer.x new file mode 100644 --- /dev/null +++ b/test/golden/grammar/GrammarLexer.x @@ -0,0 +1,157 @@ +-- Generated by RTK from grammar 'Grammar'. Do not edit by hand. +{ +{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} +module GrammarLexer(scanTokens, alexScanTokens, Token(..), PosToken(..), AlexPosn(..)) +where +import Data.Data (Data) + +import Data.List +import qualified Data.Map as M + + } +%wrapper "monad" + +$dq = " +$ndq = [^\"] + +tokens :- "tok_Clause_dummy_14" { simple Tk__tok_Clause_dummy_14 } + "tok_Grammar_dummy_15" { simple Tk__tok_Grammar_dummy_15 } + "tok_IdList_dummy_13" { simple Tk__tok_IdList_dummy_13 } + "tok_ImportsOpt_dummy_12" { simple Tk__tok_ImportsOpt_dummy_12 } + "tok_Name_dummy_11" { simple Tk__tok_Name_dummy_11 } + "tok_OptDelim_dummy_10" { simple Tk__tok_OptDelim_dummy_10 } + "tok_Option_dummy_9" { simple Tk__tok_Option_dummy_9 } + "tok_OptionList_dummy_8" { simple Tk__tok_OptionList_dummy_8 } + "tok_Rule_dummy_7" { simple Tk__tok_Rule_dummy_7 } + "tok_RuleList_dummy_6" { simple Tk__tok_RuleList_dummy_6 } + "tok_StrLit_dummy_5" { simple Tk__tok_StrLit_dummy_5 } + "~" { simple Tk__tok__tilde__16 } + "|" { simple Tk__tok__pipe__11 } + "imports" { simple Tk__tok_imports_2 } + "grammar" { simple Tk__tok_grammar_0 } + "@symmacro" { simple Tk__tok__symbol_symmacro_9 } + "@shortcuts" { simple Tk__tok__symbol_shortcuts_6 } + "?" { simple Tk__tok__symbol__15 } + "=" { simple Tk__tok__eql__3 } + ";" { simple Tk__tok__semi__1 } + ":" { simple Tk__tok__colon__4 } + "." { simple Tk__tok__dot__5 } + "," { simple Tk__tok__coma__10 } + "+" { simple Tk__tok__plus__14 } + "*" { simple Tk__tok__star__13 } + ")" { simple Tk__tok__rparen__8 } + "(" { simple Tk__tok__lparen__7 } + "!" { simple Tk__tok__exclamation__12 } + ("/*" ([^\*]| [\*] [^\/]| [\n])* "*/") ; + ("#" .* [\n]) ; + ([\ \t\n]+) ; + ("[" ([^\]]| "\]")* "]") { simple1 $ Tk__regexplit . (id) } + ($dq $dq $dq ($ndq| $dq $ndq| $dq $dq $ndq| [\n])* $dq $dq $dq) { simple1 $ Tk__bigstr . (id) } + ("'" ([^']| "\'")* "'") { simple1 $ Tk__str . (id) } + ([a-zA-Z] [A-Za-z0-9_]*) { simple1 $ Tk__id . (id) } + ("$" "Name" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Name . ((tail . dropWhile (/= ':'))) } + ("$" "StrLit" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_StrLit . ((tail . dropWhile (/= ':'))) } + ("$" "OptDelim" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptDelim . ((tail . dropWhile (/= ':'))) } + ("$" "Clause" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Clause . ((tail . dropWhile (/= ':'))) } + ("$" "IdList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_IdList . ((tail . dropWhile (/= ':'))) } + ("$" "Option" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Option . ((tail . dropWhile (/= ':'))) } + ("$" "OptionList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptionList . ((tail . dropWhile (/= ':'))) } + ("$" "Rule" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Rule . ((tail . dropWhile (/= ':'))) } + ("$" "RuleList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_RuleList . ((tail . dropWhile (/= ':'))) } + ("$" "ImportsOpt" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ImportsOpt . ((tail . dropWhile (/= ':'))) } + ("$" "Grammar" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Grammar . ((tail . dropWhile (/= ':'))) } + . { rtkError } + +{ +data Token = EndOfFile | + Tk__tok_Clause_dummy_14 | + Tk__tok_Grammar_dummy_15 | + Tk__tok_IdList_dummy_13 | + Tk__tok_ImportsOpt_dummy_12 | + Tk__tok_Name_dummy_11 | + Tk__tok_OptDelim_dummy_10 | + Tk__tok_Option_dummy_9 | + Tk__tok_OptionList_dummy_8 | + Tk__tok_Rule_dummy_7 | + Tk__tok_RuleList_dummy_6 | + Tk__tok_StrLit_dummy_5 | + Tk__tok__tilde__16 | + Tk__tok__pipe__11 | + Tk__tok_imports_2 | + Tk__tok_grammar_0 | + Tk__tok__symbol_symmacro_9 | + Tk__tok__symbol_shortcuts_6 | + Tk__tok__symbol__15 | + Tk__tok__eql__3 | + Tk__tok__semi__1 | + Tk__tok__colon__4 | + Tk__tok__dot__5 | + Tk__tok__coma__10 | + Tk__tok__plus__14 | + Tk__tok__star__13 | + Tk__tok__rparen__8 | + Tk__tok__lparen__7 | + Tk__tok__exclamation__12 | + Tk__regexplit String | + Tk__bigstr String | + Tk__str String | + Tk__id String | + Tk__qq_Name String | + Tk__qq_StrLit String | + Tk__qq_OptDelim String | + Tk__qq_Clause String | + Tk__qq_IdList String | + Tk__qq_Option String | + Tk__qq_OptionList String | + Tk__qq_Rule String | + Tk__qq_RuleList String | + Tk__qq_ImportsOpt String | + Tk__qq_Grammar String + deriving (Show) + +-- AlexPosn is defined by the alex wrapper, so the Data instance (required by +-- the parser's RtkPos position type) can only be attached via standalone +-- deriving - the same solution as the hand-written Lexer.x +deriving instance Data AlexPosn + +-- A token together with the source position where it starts +data PosToken = PosToken { ptPos :: AlexPosn, ptToken :: Token } + deriving (Show) + +alexEOF = do + (pos, _, _, _) <- alexGetInput + return $ PosToken pos EndOfFile + +-- Lex the input into a token stream, returning the positioned error message +-- on a lexical error (encoded as "LINE:COL:message", see rtkError below). +-- The returned list always ends with an EndOfFile token that carries the +-- position of the end of input, so parse errors at end of input can be +-- reported with a position too +scanTokens :: String -> Either String [PosToken] +scanTokens str = runAlex str $ do + let loop toks = do tok <- alexMonadScan + case tok of + PosToken _ EndOfFile -> return $ reverse (tok : toks) + _ -> let toks' = tok : toks + in toks' `seq` loop toks' + loop [] + +-- Thin compatibility wrapper: callers that have not switched to 'scanTokens' +-- get the error message thrown instead +alexScanTokens :: String -> [PosToken] +alexScanTokens str = + case scanTokens str of + Right toks -> toks + Left err -> errorWithoutStackTrace err + +simple1 :: (String -> Token) -> AlexInput -> Int -> Alex PosToken +simple1 t (pos, _, _, str) len = return $ PosToken pos (t (take len str)) + +simple :: Token -> AlexInput -> Int -> Alex PosToken +simple t (pos, _, _, _) len = return $ PosToken pos t + +-- Encode the position as "LINE:COL:message" so callers can split it back out +-- into a structured position - the same encoding the rtk grammar lexer uses +rtkError ((AlexPn _ line column), _, _, str) len = alexError $ (show line) ++ ":" ++ (show column) ++ ":lexical error. Following chars: " ++ (take 10 str) + +} diff --git a/test/golden/grammar/GrammarParser.y b/test/golden/grammar/GrammarParser.y new file mode 100644 --- /dev/null +++ b/test/golden/grammar/GrammarParser.y @@ -0,0 +1,399 @@ +-- Generated by RTK from grammar 'Grammar'. Do not edit by hand. +{ +{-# LANGUAGE DeriveDataTypeable #-} +module GrammarParser where +import qualified Data.Generics as Gen +import qualified GrammarLexer as L (Token(..), PosToken(..), AlexPosn(..), alexScanTokens) +} + +%name parseGrammar +%tokentype { L.PosToken } +%monad { Either String } +%error { parseError } + +%token + +rtk__eof { L.PosToken _ L.EndOfFile } +tok_Clause_dummy_14 { L.PosToken _ L.Tk__tok_Clause_dummy_14 } +tok_Grammar_dummy_15 { L.PosToken _ L.Tk__tok_Grammar_dummy_15 } +tok_IdList_dummy_13 { L.PosToken _ L.Tk__tok_IdList_dummy_13 } +tok_ImportsOpt_dummy_12 { L.PosToken _ L.Tk__tok_ImportsOpt_dummy_12 } +tok_Name_dummy_11 { L.PosToken _ L.Tk__tok_Name_dummy_11 } +tok_OptDelim_dummy_10 { L.PosToken _ L.Tk__tok_OptDelim_dummy_10 } +tok_Option_dummy_9 { L.PosToken _ L.Tk__tok_Option_dummy_9 } +tok_OptionList_dummy_8 { L.PosToken _ L.Tk__tok_OptionList_dummy_8 } +tok_Rule_dummy_7 { L.PosToken _ L.Tk__tok_Rule_dummy_7 } +tok_RuleList_dummy_6 { L.PosToken _ L.Tk__tok_RuleList_dummy_6 } +tok_StrLit_dummy_5 { L.PosToken _ L.Tk__tok_StrLit_dummy_5 } +tok__tilde__16 { L.PosToken _ L.Tk__tok__tilde__16 } +tok__pipe__11 { L.PosToken _ L.Tk__tok__pipe__11 } +tok_imports_2 { L.PosToken _ L.Tk__tok_imports_2 } +tok_grammar_0 { L.PosToken _ L.Tk__tok_grammar_0 } +tok__symbol_symmacro_9 { L.PosToken _ L.Tk__tok__symbol_symmacro_9 } +tok__symbol_shortcuts_6 { L.PosToken _ L.Tk__tok__symbol_shortcuts_6 } +tok__symbol__15 { L.PosToken _ L.Tk__tok__symbol__15 } +tok__eql__3 { L.PosToken _ L.Tk__tok__eql__3 } +tok__semi__1 { L.PosToken _ L.Tk__tok__semi__1 } +tok__colon__4 { L.PosToken _ L.Tk__tok__colon__4 } +tok__dot__5 { L.PosToken _ L.Tk__tok__dot__5 } +tok__coma__10 { L.PosToken _ L.Tk__tok__coma__10 } +tok__plus__14 { L.PosToken _ L.Tk__tok__plus__14 } +tok__star__13 { L.PosToken _ L.Tk__tok__star__13 } +tok__rparen__8 { L.PosToken _ L.Tk__tok__rparen__8 } +tok__lparen__7 { L.PosToken _ L.Tk__tok__lparen__7 } +tok__exclamation__12 { L.PosToken _ L.Tk__tok__exclamation__12 } +regexplit { L.PosToken _ (L.Tk__regexplit _) } +bigstr { L.PosToken _ (L.Tk__bigstr _) } +str { L.PosToken _ (L.Tk__str _) } +id { L.PosToken _ (L.Tk__id _) } +qq_Name { L.PosToken _ (L.Tk__qq_Name _) } +qq_StrLit { L.PosToken _ (L.Tk__qq_StrLit _) } +qq_OptDelim { L.PosToken _ (L.Tk__qq_OptDelim _) } +qq_Clause { L.PosToken _ (L.Tk__qq_Clause _) } +qq_IdList { L.PosToken _ (L.Tk__qq_IdList _) } +qq_Option { L.PosToken _ (L.Tk__qq_Option _) } +qq_OptionList { L.PosToken _ (L.Tk__qq_OptionList _) } +qq_Rule { L.PosToken _ (L.Tk__qq_Rule _) } +qq_RuleList { L.PosToken _ (L.Tk__qq_RuleList _) } +qq_ImportsOpt { L.PosToken _ (L.Tk__qq_ImportsOpt _) } +qq_Grammar { L.PosToken _ (L.Tk__qq_Grammar _) } + +%% + +Grammar__top : Grammar rtk__eof { $1 } + +Grammar : tok_Grammar_dummy_15 Grammar tok_Grammar_dummy_15 { Ctr__Grammar__0 (rtkPosOf $1) $2 } | + tok_Clause_dummy_14 Clause tok_Clause_dummy_14 { Ctr__Grammar__1 (rtkPosOf $1) $2 } | + tok_IdList_dummy_13 IdList tok_IdList_dummy_13 { Ctr__Grammar__2 (rtkPosOf $1) (reverse $2) } | + tok_ImportsOpt_dummy_12 ImportsOpt tok_ImportsOpt_dummy_12 { Ctr__Grammar__3 (rtkPosOf $1) $2 } | + tok_Name_dummy_11 Name tok_Name_dummy_11 { Ctr__Grammar__4 (rtkPosOf $1) $2 } | + tok_OptDelim_dummy_10 OptDelim tok_OptDelim_dummy_10 { Ctr__Grammar__5 (rtkPosOf $1) $2 } | + tok_Option_dummy_9 Option tok_Option_dummy_9 { Ctr__Grammar__6 (rtkPosOf $1) $2 } | + tok_OptionList_dummy_8 OptionList tok_OptionList_dummy_8 { Ctr__Grammar__7 (rtkPosOf $1) (reverse $2) } | + tok_Rule_dummy_7 Rule tok_Rule_dummy_7 { Ctr__Grammar__8 (rtkPosOf $1) $2 } | + tok_RuleList_dummy_6 RuleList tok_RuleList_dummy_6 { Ctr__Grammar__9 (rtkPosOf $1) (reverse $2) } | + tok_StrLit_dummy_5 StrLit tok_StrLit_dummy_5 { Ctr__Grammar__10 (rtkPosOf $1) $2 } + +Grammar : qq_Grammar { Anti_Grammar (tkVal_qq_Grammar $1) } | + tok_grammar_0 StrLit tok__semi__1 ImportsOpt RuleList { Ctr__Grammar__11 (rtkPosOf $1) $2 $4 (reverse $5) } + +Clause5 : qq_Clause { Anti_Clause (tkVal_qq_Clause $1) } | + tok__lparen__7 Clause tok__rparen__8 { $2 } | + Name { Ctr__Clause__1 (rtkPosOf $1) $1 } | + StrLit { Ctr__Clause__2 (rtkPosOf $1) $1 } | + tok__dot__5 { Ctr__Clause__3 (rtkPosOf $1) } | + regexplit { Ctr__Clause__4 (rtkPosOf $1) (tkVal_regexplit $1) } + +Clause4 : Clause5 tok__star__13 OptDelim { Ctr__Clause__5 (rtkPosOf $1) $1 $3 } | + Clause5 tok__plus__14 OptDelim { Ctr__Clause__6 (rtkPosOf $1) $1 $3 } | + Clause5 tok__symbol__15 { Ctr__Clause__7 (rtkPosOf $1) $1 } | + Clause5 { $1 } + +Clause3 : tok__coma__10 Clause4 { Ctr__Clause__9 (rtkPosOf $1) $2 } | + tok__exclamation__12 Clause4 { Ctr__Clause__10 (rtkPosOf $1) $2 } | + Clause4 { $1 } + +Clause2 : Clause2 Clause3 { Ctr__Clause__12 (rtkPosOf $1) $1 $2 } | + Clause3 { $1 } + +Clause : Clause tok__pipe__11 Clause2 { Ctr__Clause__14 (rtkPosOf $1) $1 $3 } | + Clause2 { $1 } + +IdList__plus_list_ : ListElem_IdList3 { [$1] } | + IdList__plus_list_ tok__coma__10 ListElem_IdList3 { $3 : $1 } + +IdList : IdList__plus_list_ { $1 } | + {- empty -} { [] } + +ImportsOpt : qq_ImportsOpt { Anti_ImportsOpt (tkVal_qq_ImportsOpt $1) } | + { Ctr__ImportsOpt__0 rtkNoPos } | + Rule_0 { Ctr__ImportsOpt__1 (rtkPosOf $1) $1 } + +Name : qq_Name { Anti_Name (tkVal_qq_Name $1) } | + id { Ctr__Name__0 (rtkPosOf $1) (tkVal_id $1) } + +ListElem_IdList3 : qq_IdList { Anti_Name (tkVal_qq_IdList $1) } | + Name { $1 } + +OptDelim : qq_OptDelim { Anti_OptDelim (tkVal_qq_OptDelim $1) } | + { Ctr__OptDelim__0 rtkNoPos } | + Rule_4 { Ctr__OptDelim__1 (rtkPosOf $1) $1 } + +Option : qq_Option { Anti_Option (tkVal_qq_Option $1) } | + tok__symbol_shortcuts_6 tok__lparen__7 IdList tok__rparen__8 { Ctr__Option__0 (rtkPosOf $1) (reverse $3) } | + tok__symbol_symmacro_9 { Ctr__Option__1 (rtkPosOf $1) } + +ListElem_OptionList2 : qq_OptionList { Anti_Option (tkVal_qq_OptionList $1) } | + Option { $1 } + +OptionList : ListElem_OptionList2 { [$1] } | + OptionList ListElem_OptionList2 { $2 : $1 } + +Rule1 : qq_Rule { Anti_Rule (tkVal_qq_Rule $1) } | + Name tok__eql__3 Clause tok__semi__1 { Ctr__Rule__0 (rtkPosOf $1) $1 $3 } | + Name tok__colon__4 Name tok__eql__3 Clause tok__semi__1 { Ctr__Rule__1 (rtkPosOf $1) $1 $3 $5 } | + Name tok__dot__5 Name tok__colon__4 Name tok__eql__3 Clause tok__semi__1 { Ctr__Rule__2 (rtkPosOf $1) $1 $3 $5 $7 } | + tok__dot__5 Name tok__colon__4 Name tok__eql__3 Clause tok__semi__1 { Ctr__Rule__3 (rtkPosOf $1) $2 $4 $6 } + +Rule : OptionList Rule1 { Ctr__Rule__4 (rtkPosOf (reverse $1)) (reverse $1) $2 } | + Rule1 { $1 } + +ListElem_RuleList1 : qq_RuleList { Anti_Rule (tkVal_qq_RuleList $1) } | + Rule { $1 } + +RuleList : {- empty -} { [] } | + RuleList ListElem_RuleList1 { $2 : $1 } + +Rule_0 : tok_imports_2 bigstr { Ctr__Rule_0__0 (rtkPosOf $1) (tkVal_bigstr $2) } + +Rule_4 : tok__tilde__16 Clause5 { Ctr__Rule_4__0 (rtkPosOf $1) $2 } + +StrLit : qq_StrLit { Anti_StrLit (tkVal_qq_StrLit $1) } | + str { Ctr__StrLit__0 (rtkPosOf $1) (tkVal_str $1) } + + +{ +parseError :: [L.PosToken] -> Either String a +parseError [] = Left "unexpected end of input" +parseError (L.PosToken (L.AlexPn _ line col) tok : _) = + Left $ show line ++ ":" ++ show col ++ ":unexpected " ++ showRtkToken tok + +-- Render a token the way it appears in the source, for error messages +showRtkToken :: L.Token -> String +showRtkToken L.EndOfFile = "end of input" +showRtkToken L.Tk__tok_Clause_dummy_14 = "'tok_Clause_dummy_14'" +showRtkToken L.Tk__tok_Grammar_dummy_15 = "'tok_Grammar_dummy_15'" +showRtkToken L.Tk__tok_IdList_dummy_13 = "'tok_IdList_dummy_13'" +showRtkToken L.Tk__tok_ImportsOpt_dummy_12 = "'tok_ImportsOpt_dummy_12'" +showRtkToken L.Tk__tok_Name_dummy_11 = "'tok_Name_dummy_11'" +showRtkToken L.Tk__tok_OptDelim_dummy_10 = "'tok_OptDelim_dummy_10'" +showRtkToken L.Tk__tok_Option_dummy_9 = "'tok_Option_dummy_9'" +showRtkToken L.Tk__tok_OptionList_dummy_8 = "'tok_OptionList_dummy_8'" +showRtkToken L.Tk__tok_Rule_dummy_7 = "'tok_Rule_dummy_7'" +showRtkToken L.Tk__tok_RuleList_dummy_6 = "'tok_RuleList_dummy_6'" +showRtkToken L.Tk__tok_StrLit_dummy_5 = "'tok_StrLit_dummy_5'" +showRtkToken L.Tk__tok__tilde__16 = "'~'" +showRtkToken L.Tk__tok__pipe__11 = "'|'" +showRtkToken L.Tk__tok_imports_2 = "'imports'" +showRtkToken L.Tk__tok_grammar_0 = "'grammar'" +showRtkToken L.Tk__tok__symbol_symmacro_9 = "'@symmacro'" +showRtkToken L.Tk__tok__symbol_shortcuts_6 = "'@shortcuts'" +showRtkToken L.Tk__tok__symbol__15 = "'?'" +showRtkToken L.Tk__tok__eql__3 = "'='" +showRtkToken L.Tk__tok__semi__1 = "';'" +showRtkToken L.Tk__tok__colon__4 = "':'" +showRtkToken L.Tk__tok__dot__5 = "'.'" +showRtkToken L.Tk__tok__coma__10 = "','" +showRtkToken L.Tk__tok__plus__14 = "'+'" +showRtkToken L.Tk__tok__star__13 = "'*'" +showRtkToken L.Tk__tok__rparen__8 = "')'" +showRtkToken L.Tk__tok__lparen__7 = "'('" +showRtkToken L.Tk__tok__exclamation__12 = "'!'" +showRtkToken (L.Tk__regexplit v) = "regexplit " ++ show v +showRtkToken (L.Tk__bigstr v) = "bigstr " ++ show v +showRtkToken (L.Tk__str v) = "str " ++ show v +showRtkToken (L.Tk__id v) = "id " ++ show v +showRtkToken (L.Tk__qq_Name v) = "qq_Name " ++ show v +showRtkToken (L.Tk__qq_StrLit v) = "qq_StrLit " ++ show v +showRtkToken (L.Tk__qq_OptDelim v) = "qq_OptDelim " ++ show v +showRtkToken (L.Tk__qq_Clause v) = "qq_Clause " ++ show v +showRtkToken (L.Tk__qq_IdList v) = "qq_IdList " ++ show v +showRtkToken (L.Tk__qq_Option v) = "qq_Option " ++ show v +showRtkToken (L.Tk__qq_OptionList v) = "qq_OptionList " ++ show v +showRtkToken (L.Tk__qq_Rule v) = "qq_Rule " ++ show v +showRtkToken (L.Tk__qq_RuleList v) = "qq_RuleList " ++ show v +showRtkToken (L.Tk__qq_ImportsOpt v) = "qq_ImportsOpt " ++ show v +showRtkToken (L.Tk__qq_Grammar v) = "qq_Grammar " ++ show v + +-- Source position of a node: every constructor except the Anti_* splice +-- artifacts stores the position of its alternative's first symbol in its +-- first field. Positions are transparent for equality and ordering, so two +-- ASTs that differ only in source positions (e.g. a quasi-quote parsed at +-- compile time vs the same construct parsed at run time) compare equal. +newtype RtkPos = RtkPos L.AlexPosn deriving (Show, Gen.Data, Gen.Typeable) +instance Eq RtkPos where _ == _ = True +instance Ord RtkPos where compare _ _ = EQ + +-- The position used where no source token exists: empty productions, empty +-- lists, absent optionals and Anti_* quasi-quote splices +rtkNoPos :: RtkPos +rtkNoPos = RtkPos (L.AlexPn 0 0 0) + +class RtkPosOf a where + rtkPosOf :: a -> RtkPos +instance RtkPosOf L.PosToken where + rtkPosOf (L.PosToken p _) = RtkPos p +instance RtkPosOf a => RtkPosOf [a] where + rtkPosOf (x : _) = rtkPosOf x + rtkPosOf [] = rtkNoPos +instance RtkPosOf a => RtkPosOf (Maybe a) where + rtkPosOf (Just x) = rtkPosOf x + rtkPosOf Nothing = rtkNoPos +-- A Char carries no position; this also covers String token payloads +instance RtkPosOf Char where + rtkPosOf _ = rtkNoPos + +-- Recover a token's payload from the whole positioned token: %token +-- bindings keep the L.PosToken so semantic actions can read its position +tkVal_regexplit :: L.PosToken -> String +tkVal_regexplit (L.PosToken _ (L.Tk__regexplit v)) = v +tkVal_regexplit t = error ("rtk internal error: token regexplit expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_bigstr :: L.PosToken -> String +tkVal_bigstr (L.PosToken _ (L.Tk__bigstr v)) = v +tkVal_bigstr t = error ("rtk internal error: token bigstr expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_str :: L.PosToken -> String +tkVal_str (L.PosToken _ (L.Tk__str v)) = v +tkVal_str t = error ("rtk internal error: token str expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_id :: L.PosToken -> String +tkVal_id (L.PosToken _ (L.Tk__id v)) = v +tkVal_id t = error ("rtk internal error: token id expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Name :: L.PosToken -> String +tkVal_qq_Name (L.PosToken _ (L.Tk__qq_Name v)) = v +tkVal_qq_Name t = error ("rtk internal error: token qq_Name expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_StrLit :: L.PosToken -> String +tkVal_qq_StrLit (L.PosToken _ (L.Tk__qq_StrLit v)) = v +tkVal_qq_StrLit t = error ("rtk internal error: token qq_StrLit expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptDelim :: L.PosToken -> String +tkVal_qq_OptDelim (L.PosToken _ (L.Tk__qq_OptDelim v)) = v +tkVal_qq_OptDelim t = error ("rtk internal error: token qq_OptDelim expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Clause :: L.PosToken -> String +tkVal_qq_Clause (L.PosToken _ (L.Tk__qq_Clause v)) = v +tkVal_qq_Clause t = error ("rtk internal error: token qq_Clause expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_IdList :: L.PosToken -> String +tkVal_qq_IdList (L.PosToken _ (L.Tk__qq_IdList v)) = v +tkVal_qq_IdList t = error ("rtk internal error: token qq_IdList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Option :: L.PosToken -> String +tkVal_qq_Option (L.PosToken _ (L.Tk__qq_Option v)) = v +tkVal_qq_Option t = error ("rtk internal error: token qq_Option expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptionList :: L.PosToken -> String +tkVal_qq_OptionList (L.PosToken _ (L.Tk__qq_OptionList v)) = v +tkVal_qq_OptionList t = error ("rtk internal error: token qq_OptionList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Rule :: L.PosToken -> String +tkVal_qq_Rule (L.PosToken _ (L.Tk__qq_Rule v)) = v +tkVal_qq_Rule t = error ("rtk internal error: token qq_Rule expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_RuleList :: L.PosToken -> String +tkVal_qq_RuleList (L.PosToken _ (L.Tk__qq_RuleList v)) = v +tkVal_qq_RuleList t = error ("rtk internal error: token qq_RuleList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ImportsOpt :: L.PosToken -> String +tkVal_qq_ImportsOpt (L.PosToken _ (L.Tk__qq_ImportsOpt v)) = v +tkVal_qq_ImportsOpt t = error ("rtk internal error: token qq_ImportsOpt expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Grammar :: L.PosToken -> String +tkVal_qq_Grammar (L.PosToken _ (L.Tk__qq_Grammar v)) = v +tkVal_qq_Grammar t = error ("rtk internal error: token qq_Grammar expected, got " ++ showRtkToken (L.ptToken t)) + +data Grammar = Ctr__Grammar__0 RtkPos Grammar | + Ctr__Grammar__1 RtkPos Clause | + Ctr__Grammar__2 RtkPos IdList | + Ctr__Grammar__3 RtkPos ImportsOpt | + Ctr__Grammar__4 RtkPos Name | + Ctr__Grammar__5 RtkPos OptDelim | + Ctr__Grammar__6 RtkPos Option | + Ctr__Grammar__7 RtkPos OptionList | + Ctr__Grammar__8 RtkPos Rule | + Ctr__Grammar__9 RtkPos RuleList | + Ctr__Grammar__10 RtkPos StrLit | + Anti_Grammar String | + Ctr__Grammar__11 RtkPos StrLit ImportsOpt RuleList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Grammar where + rtkPosOf (Ctr__Grammar__0 p _) = p + rtkPosOf (Ctr__Grammar__1 p _) = p + rtkPosOf (Ctr__Grammar__2 p _) = p + rtkPosOf (Ctr__Grammar__3 p _) = p + rtkPosOf (Ctr__Grammar__4 p _) = p + rtkPosOf (Ctr__Grammar__5 p _) = p + rtkPosOf (Ctr__Grammar__6 p _) = p + rtkPosOf (Ctr__Grammar__7 p _) = p + rtkPosOf (Ctr__Grammar__8 p _) = p + rtkPosOf (Ctr__Grammar__9 p _) = p + rtkPosOf (Ctr__Grammar__10 p _) = p + rtkPosOf (Anti_Grammar _) = rtkNoPos + rtkPosOf (Ctr__Grammar__11 p _ _ _) = p +data Clause = Anti_Clause String | + Ctr__Clause__1 RtkPos Name | + Ctr__Clause__2 RtkPos StrLit | + Ctr__Clause__3 RtkPos | + Ctr__Clause__4 RtkPos String | + Ctr__Clause__5 RtkPos Clause OptDelim | + Ctr__Clause__6 RtkPos Clause OptDelim | + Ctr__Clause__7 RtkPos Clause | + Ctr__Clause__9 RtkPos Clause | + Ctr__Clause__10 RtkPos Clause | + Ctr__Clause__12 RtkPos Clause Clause | + Ctr__Clause__14 RtkPos Clause Clause + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Clause where + rtkPosOf (Anti_Clause _) = rtkNoPos + rtkPosOf (Ctr__Clause__1 p _) = p + rtkPosOf (Ctr__Clause__2 p _) = p + rtkPosOf (Ctr__Clause__3 p) = p + rtkPosOf (Ctr__Clause__4 p _) = p + rtkPosOf (Ctr__Clause__5 p _ _) = p + rtkPosOf (Ctr__Clause__6 p _ _) = p + rtkPosOf (Ctr__Clause__7 p _) = p + rtkPosOf (Ctr__Clause__9 p _) = p + rtkPosOf (Ctr__Clause__10 p _) = p + rtkPosOf (Ctr__Clause__12 p _ _) = p + rtkPosOf (Ctr__Clause__14 p _ _) = p +type IdList = [Name] +data ImportsOpt = Anti_ImportsOpt String | + Ctr__ImportsOpt__0 RtkPos | + Ctr__ImportsOpt__1 RtkPos Rule_0 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ImportsOpt where + rtkPosOf (Anti_ImportsOpt _) = rtkNoPos + rtkPosOf (Ctr__ImportsOpt__0 p) = p + rtkPosOf (Ctr__ImportsOpt__1 p _) = p +data Name = Anti_Name String | + Ctr__Name__0 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Name where + rtkPosOf (Anti_Name _) = rtkNoPos + rtkPosOf (Ctr__Name__0 p _) = p +data OptDelim = Anti_OptDelim String | + Ctr__OptDelim__0 RtkPos | + Ctr__OptDelim__1 RtkPos Rule_4 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptDelim where + rtkPosOf (Anti_OptDelim _) = rtkNoPos + rtkPosOf (Ctr__OptDelim__0 p) = p + rtkPosOf (Ctr__OptDelim__1 p _) = p +data Option = Anti_Option String | + Ctr__Option__0 RtkPos IdList | + Ctr__Option__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Option where + rtkPosOf (Anti_Option _) = rtkNoPos + rtkPosOf (Ctr__Option__0 p _) = p + rtkPosOf (Ctr__Option__1 p) = p +type OptionList = [Option] +data Rule = Anti_Rule String | + Ctr__Rule__0 RtkPos Name Clause | + Ctr__Rule__1 RtkPos Name Name Clause | + Ctr__Rule__2 RtkPos Name Name Name Clause | + Ctr__Rule__3 RtkPos Name Name Clause | + Ctr__Rule__4 RtkPos OptionList Rule + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule where + rtkPosOf (Anti_Rule _) = rtkNoPos + rtkPosOf (Ctr__Rule__0 p _ _) = p + rtkPosOf (Ctr__Rule__1 p _ _ _) = p + rtkPosOf (Ctr__Rule__2 p _ _ _ _) = p + rtkPosOf (Ctr__Rule__3 p _ _ _) = p + rtkPosOf (Ctr__Rule__4 p _ _) = p +type RuleList = [Rule] +data Rule_0 = Ctr__Rule_0__0 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_0 where + rtkPosOf (Ctr__Rule_0__0 p _) = p +data Rule_4 = Ctr__Rule_4__0 RtkPos Clause + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_4 where + rtkPosOf (Ctr__Rule_4__0 p _) = p +data StrLit = Anti_StrLit String | + Ctr__StrLit__0 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf StrLit where + rtkPosOf (Anti_StrLit _) = rtkNoPos + rtkPosOf (Ctr__StrLit__0 p _) = p +} diff --git a/test/golden/grammar/GrammarQQ.hs b/test/golden/grammar/GrammarQQ.hs new file mode 100644 --- /dev/null +++ b/test/golden/grammar/GrammarQQ.hs @@ -0,0 +1,243 @@ +-- Generated by RTK from grammar 'Grammar'. Do not edit by hand. +{-# LANGUAGE TemplateHaskell #-} +module GrammarQQ +where + +import qualified Data.Char as C +import qualified Data.Map as M +import Data.List +import Data.Maybe +import qualified Data.Generics as Generics +import qualified Data.Data as Data +import qualified Language.Haskell.TH as TH +import Language.Haskell.TH.Quote +import GrammarLexer +import GrammarParser + +qqShortcuts :: M.Map String String + +-- A $name metavariable is rewritten to $Type:name using the qqShortcuts +-- table below. The rewrite is purely textual, so it would also fire inside +-- the quoted language's own string literals: write $$name there to escape +-- it and get the literal text $name. Each '$$' pair directly before a +-- metavariable stands for one literal '$' (so $$$x is a literal '$' +-- followed by the metavariable $x). A '$' not followed by an identifier is +-- never rewritten and needs no escape, and an explicit $Type:name antiquote +-- (the character after the name is ':') passes through untouched. +-- A plain character scan rather than a regex: metavariables are recognized +-- regardless of what follows the name - including a newline or the end of +-- the quote, which the previous regex's terminator class missed. +replaceAllPatterns :: String -> Either String String +replaceAllPatterns [] = Right [] +replaceAllPatterns s@('$' : _) = + let (dollars, rest) = span (== '$') s + in case rest of + (c1 : _) | C.isAlpha c1 || c1 == '_' -> + let (varName, post) = span (\ ch -> C.isAlphaNum ch || ch == '_') rest + escCount = length dollars - 1 + keptPre = replicate (div escCount 2) '$' + in case post of + (':' : _) -> ((dollars ++ varName) ++) <$> replaceAllPatterns post + _ | odd escCount -> ((keptPre ++ '$' : varName) ++) <$> replaceAllPatterns post + _ -> case catMaybes $ map (\ prefix -> M.lookup prefix qqShortcuts) $ reverse $ inits varName of + [] -> Left $ unlines + [ "Unknown metavariable $" ++ varName ++ " in quasi-quote:" + , "no prefix of '" ++ varName ++ "' is a known shortcut. Known shortcuts:" + , " " ++ intercalate ", " (M.keys qqShortcuts) + , "To include the literal text $" ++ varName ++ " in the quoted code" + , "(e.g. inside a string literal), escape it as $$" ++ varName ++ "." ] + (rule : _) -> ((keptPre ++ '$' : rule ++ ":" ++ varName) ++) <$> replaceAllPatterns post + _ -> (dollars ++) <$> replaceAllPatterns rest +replaceAllPatterns (c : rest) = (c :) <$> replaceAllPatterns rest + +-- The generated lexer and parser encode error positions as "LINE:COL:message" +-- so structured-diagnostic callers can split them; render them back +-- human-readably for quasi-quote compile errors. Positions refer to the quote +-- body (padded with a start token in front). +rtkRenderError :: String -> String +rtkRenderError err = + case span (/= ':') err of + (l, ':' : rest1) | [(line, "")] <- (reads l :: [(Int, String)]) -> + case span (/= ':') rest1 of + (c, ':' : msg) | [(col, "")] <- (reads c :: [(Int, String)]) -> + "line " ++ show line ++ ", column " ++ show col ++ ": " ++ msg + _ -> err + _ -> err + +qqShortcuts = M.fromList [ ("grammar","Grammar"),("clause","Clause"),("idList","IdList"),("importsOpt","ImportsOpt"),("name","Name"),("optDelim","OptDelim"),("option","Option"),("optionList","OptionList"),("rule","Rule"),("ruleList","RuleList"),("strLit","StrLit"),("cl","Clause"),("r","Rule")] + +-- A quasi-quote pattern must match an AST parsed from anywhere in a source +-- file, while the pattern itself was parsed from the quote body - so every +-- RtkPos position field becomes a wildcard in generated patterns. +-- (Expressions need no special case: the compile-time position they embed +-- is equality-transparent.) +rtkPosWildPat :: RtkPos -> Maybe (TH.Q TH.Pat) +rtkPosWildPat _ = Just TH.wildP + +quoteGrammarExp :: Data.Data a => String -> (Grammar -> a) -> String -> TH.ExpQ +quoteGrammarExp dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseGrammar of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToExpQ (const Nothing `Generics.extQ` antiGrammarExp `Generics.extQ` antiImportsOptExp `Generics.extQ` antiRuleExp `Generics.extQ` antiOptionExp `Generics.extQ` antiNameExp `Generics.extQ` antiClauseExp `Generics.extQ` antiOptDelimExp `Generics.extQ` antiStrLitExp) expr +quoteGrammarPat :: Data.Data a => String -> (Grammar -> a) -> String -> TH.PatQ +quoteGrammarPat dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseGrammar of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToPatQ (const Nothing `Generics.extQ` rtkPosWildPat `Generics.extQ` antiGrammarPat `Generics.extQ` antiImportsOptPat `Generics.extQ` antiRulePat `Generics.extQ` antiOptionPat `Generics.extQ` antiNamePat `Generics.extQ` antiClausePat `Generics.extQ` antiOptDelimPat `Generics.extQ` antiStrLitPat) expr + +antiStrLitExp :: StrLit -> Maybe (TH.Q TH.Exp ) +antiStrLitExp ( Anti_StrLit v) = Just $ TH.varE (TH.mkName v) +antiStrLitExp _ = Nothing + + +antiOptDelimExp :: OptDelim -> Maybe (TH.Q TH.Exp ) +antiOptDelimExp ( Anti_OptDelim v) = Just $ TH.varE (TH.mkName v) +antiOptDelimExp _ = Nothing + + +antiClauseExp :: Clause -> Maybe (TH.Q TH.Exp ) +antiClauseExp ( Anti_Clause v) = Just $ TH.varE (TH.mkName v) +antiClauseExp _ = Nothing + + +antiNameExp :: [ Name ] -> Maybe (TH.Q TH.Exp) +antiNameExp ((Anti_Name v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiGrammarExp `Generics.extQ` antiImportsOptExp `Generics.extQ` antiRuleExp `Generics.extQ` antiOptionExp `Generics.extQ` antiNameExp `Generics.extQ` antiClauseExp `Generics.extQ` antiOptDelimExp `Generics.extQ` antiStrLitExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiNameExp _ = Nothing + + +antiOptionExp :: [ Option ] -> Maybe (TH.Q TH.Exp) +antiOptionExp ((Anti_Option v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiGrammarExp `Generics.extQ` antiImportsOptExp `Generics.extQ` antiRuleExp `Generics.extQ` antiOptionExp `Generics.extQ` antiNameExp `Generics.extQ` antiClauseExp `Generics.extQ` antiOptDelimExp `Generics.extQ` antiStrLitExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiOptionExp _ = Nothing + + +antiRuleExp :: [ Rule ] -> Maybe (TH.Q TH.Exp) +antiRuleExp ((Anti_Rule v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiGrammarExp `Generics.extQ` antiImportsOptExp `Generics.extQ` antiRuleExp `Generics.extQ` antiOptionExp `Generics.extQ` antiNameExp `Generics.extQ` antiClauseExp `Generics.extQ` antiOptDelimExp `Generics.extQ` antiStrLitExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiRuleExp _ = Nothing + + +antiImportsOptExp :: ImportsOpt -> Maybe (TH.Q TH.Exp ) +antiImportsOptExp ( Anti_ImportsOpt v) = Just $ TH.varE (TH.mkName v) +antiImportsOptExp _ = Nothing + + +antiGrammarExp :: Grammar -> Maybe (TH.Q TH.Exp ) +antiGrammarExp ( Anti_Grammar v) = Just $ TH.varE (TH.mkName v) +antiGrammarExp _ = Nothing + + + +antiStrLitPat :: StrLit -> Maybe (TH.Q TH.Pat ) +antiStrLitPat ( Anti_StrLit v) = Just $ TH.varP (TH.mkName v) +antiStrLitPat _ = Nothing + + +antiOptDelimPat :: OptDelim -> Maybe (TH.Q TH.Pat ) +antiOptDelimPat ( Anti_OptDelim v) = Just $ TH.varP (TH.mkName v) +antiOptDelimPat _ = Nothing + + +antiClausePat :: Clause -> Maybe (TH.Q TH.Pat ) +antiClausePat ( Anti_Clause v) = Just $ TH.varP (TH.mkName v) +antiClausePat _ = Nothing + + +antiNamePat :: [ Name ] -> Maybe (TH.Q TH.Pat) +antiNamePat [Anti_Name v] = Just $ TH.varP (TH.mkName v) +antiNamePat _ = Nothing + + +antiOptionPat :: [ Option ] -> Maybe (TH.Q TH.Pat) +antiOptionPat [Anti_Option v] = Just $ TH.varP (TH.mkName v) +antiOptionPat _ = Nothing + + +antiRulePat :: [ Rule ] -> Maybe (TH.Q TH.Pat) +antiRulePat [Anti_Rule v] = Just $ TH.varP (TH.mkName v) +antiRulePat _ = Nothing + + +antiImportsOptPat :: ImportsOpt -> Maybe (TH.Q TH.Pat ) +antiImportsOptPat ( Anti_ImportsOpt v) = Just $ TH.varP (TH.mkName v) +antiImportsOptPat _ = Nothing + + +antiGrammarPat :: Grammar -> Maybe (TH.Q TH.Pat ) +antiGrammarPat ( Anti_Grammar v) = Just $ TH.varP (TH.mkName v) +antiGrammarPat _ = Nothing + + + +-- This grammar's quasi-quoters work in expression and pattern contexts only +quoteGrammarType _ = fail "this quasi-quoter cannot be used in a type context" +quoteGrammarDecs _ = fail "this quasi-quoter cannot be used in a declaration context" + +getGrammar ( Ctr__Grammar__0 _ s) = s + +grammar :: QuasiQuoter +grammar = QuasiQuoter (quoteGrammarExp "tok_Grammar_dummy_15" getGrammar ) (quoteGrammarPat "tok_Grammar_dummy_15" getGrammar ) quoteGrammarType quoteGrammarDecs + +getClause ( Ctr__Grammar__1 _ s) = s + +clause :: QuasiQuoter +clause = QuasiQuoter (quoteGrammarExp "tok_Clause_dummy_14" getClause ) (quoteGrammarPat "tok_Clause_dummy_14" getClause ) quoteGrammarType quoteGrammarDecs + +getIdList ( Ctr__Grammar__2 _ s) = s + +idList :: QuasiQuoter +idList = QuasiQuoter (quoteGrammarExp "tok_IdList_dummy_13" getIdList ) (quoteGrammarPat "tok_IdList_dummy_13" getIdList ) quoteGrammarType quoteGrammarDecs + +getImportsOpt ( Ctr__Grammar__3 _ s) = s + +importsOpt :: QuasiQuoter +importsOpt = QuasiQuoter (quoteGrammarExp "tok_ImportsOpt_dummy_12" getImportsOpt ) (quoteGrammarPat "tok_ImportsOpt_dummy_12" getImportsOpt ) quoteGrammarType quoteGrammarDecs + +getName ( Ctr__Grammar__4 _ s) = s + +name :: QuasiQuoter +name = QuasiQuoter (quoteGrammarExp "tok_Name_dummy_11" getName ) (quoteGrammarPat "tok_Name_dummy_11" getName ) quoteGrammarType quoteGrammarDecs + +getOptDelim ( Ctr__Grammar__5 _ s) = s + +optDelim :: QuasiQuoter +optDelim = QuasiQuoter (quoteGrammarExp "tok_OptDelim_dummy_10" getOptDelim ) (quoteGrammarPat "tok_OptDelim_dummy_10" getOptDelim ) quoteGrammarType quoteGrammarDecs + +getOption ( Ctr__Grammar__6 _ s) = s + +option :: QuasiQuoter +option = QuasiQuoter (quoteGrammarExp "tok_Option_dummy_9" getOption ) (quoteGrammarPat "tok_Option_dummy_9" getOption ) quoteGrammarType quoteGrammarDecs + +getOptionList ( Ctr__Grammar__7 _ s) = s + +optionList :: QuasiQuoter +optionList = QuasiQuoter (quoteGrammarExp "tok_OptionList_dummy_8" getOptionList ) (quoteGrammarPat "tok_OptionList_dummy_8" getOptionList ) quoteGrammarType quoteGrammarDecs + +getRule ( Ctr__Grammar__8 _ s) = s + +rule :: QuasiQuoter +rule = QuasiQuoter (quoteGrammarExp "tok_Rule_dummy_7" getRule ) (quoteGrammarPat "tok_Rule_dummy_7" getRule ) quoteGrammarType quoteGrammarDecs + +getRuleList ( Ctr__Grammar__9 _ s) = s + +ruleList :: QuasiQuoter +ruleList = QuasiQuoter (quoteGrammarExp "tok_RuleList_dummy_6" getRuleList ) (quoteGrammarPat "tok_RuleList_dummy_6" getRuleList ) quoteGrammarType quoteGrammarDecs + +getStrLit ( Ctr__Grammar__10 _ s) = s + +strLit :: QuasiQuoter +strLit = QuasiQuoter (quoteGrammarExp "tok_StrLit_dummy_5" getStrLit ) (quoteGrammarPat "tok_StrLit_dummy_5" getStrLit ) quoteGrammarType quoteGrammarDecs + diff --git a/test/golden/haskell/HaskellLexer.x b/test/golden/haskell/HaskellLexer.x new file mode 100644 --- /dev/null +++ b/test/golden/haskell/HaskellLexer.x @@ -0,0 +1,415 @@ +-- Generated by RTK from grammar 'Haskell'. Do not edit by hand. +{ +{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} +module HaskellLexer(scanTokens, alexScanTokens, Token(..), PosToken(..), AlexPosn(..)) +where +import Data.Data (Data) + + } +%wrapper "monad" + +@decimal = ([0-9]+) +@octal = ([0-7]+) +@hexadecimal = ([0-9A-Fa-f]+) + +tokens :- "tok_AType_dummy_111" { simple Tk__tok_AType_dummy_111 } + "tok_ATypeList_dummy_110" { simple Tk__tok_ATypeList_dummy_110 } + "tok_BType_dummy_109" { simple Tk__tok_BType_dummy_109 } + "tok_Body_dummy_108" { simple Tk__tok_Body_dummy_108 } + "tok_CName_dummy_107" { simple Tk__tok_CName_dummy_107 } + "tok_CNameList_dummy_106" { simple Tk__tok_CNameList_dummy_106 } + "tok_Class_dummy_105" { simple Tk__tok_Class_dummy_105 } + "tok_ClassList_dummy_104" { simple Tk__tok_ClassList_dummy_104 } + "tok_Con_dummy_103" { simple Tk__tok_Con_dummy_103 } + "tok_Constr_dummy_102" { simple Tk__tok_Constr_dummy_102 } + "tok_Constrs_dummy_101" { simple Tk__tok_Constrs_dummy_101 } + "tok_Context_dummy_100" { simple Tk__tok_Context_dummy_100 } + "tok_DClass_dummy_99" { simple Tk__tok_DClass_dummy_99 } + "tok_DClassList_dummy_98" { simple Tk__tok_DClassList_dummy_98 } + "tok_Decl_dummy_97" { simple Tk__tok_Decl_dummy_97 } + "tok_DeclList_dummy_96" { simple Tk__tok_DeclList_dummy_96 } + "tok_Decls_dummy_95" { simple Tk__tok_Decls_dummy_95 } + "tok_Deriving_dummy_94" { simple Tk__tok_Deriving_dummy_94 } + "tok_Exp_dummy_93" { simple Tk__tok_Exp_dummy_93 } + "tok_ExpI_dummy_92" { simple Tk__tok_ExpI_dummy_92 } + "tok_Export_dummy_91" { simple Tk__tok_Export_dummy_91 } + "tok_ExportsList_dummy_90" { simple Tk__tok_ExportsList_dummy_90 } + "tok_ExportsOpt_dummy_89" { simple Tk__tok_ExportsOpt_dummy_89 } + "tok_FieldDecl_dummy_88" { simple Tk__tok_FieldDecl_dummy_88 } + "tok_FieldDeclList_dummy_87" { simple Tk__tok_FieldDeclList_dummy_87 } + "tok_Fixity_dummy_86" { simple Tk__tok_Fixity_dummy_86 } + "tok_FunLhs_dummy_85" { simple Tk__tok_FunLhs_dummy_85 } + "tok_GTyCon_dummy_84" { simple Tk__tok_GTyCon_dummy_84 } + "tok_Gd_dummy_83" { simple Tk__tok_Gd_dummy_83 } + "tok_GdRhs_dummy_82" { simple Tk__tok_GdRhs_dummy_82 } + "tok_GenDecl_dummy_81" { simple Tk__tok_GenDecl_dummy_81 } + "tok_Haskell_dummy_112" { simple Tk__tok_Haskell_dummy_112 } + "tok_ImpDecl_dummy_80" { simple Tk__tok_ImpDecl_dummy_80 } + "tok_ImpDeclList_dummy_79" { simple Tk__tok_ImpDeclList_dummy_79 } + "tok_Import_dummy_78" { simple Tk__tok_Import_dummy_78 } + "tok_ImportList_dummy_77" { simple Tk__tok_ImportList_dummy_77 } + "tok_ModId_dummy_76" { simple Tk__tok_ModId_dummy_76 } + "tok_ModIdList_dummy_75" { simple Tk__tok_ModIdList_dummy_75 } + "tok_Module_dummy_74" { simple Tk__tok_Module_dummy_74 } + "tok_Op_dummy_73" { simple Tk__tok_Op_dummy_73 } + "tok_Ops_dummy_72" { simple Tk__tok_Ops_dummy_72 } + "tok_OptContext_dummy_71" { simple Tk__tok_OptContext_dummy_71 } + "tok_OptDeriving_dummy_70" { simple Tk__tok_OptDeriving_dummy_70 } + "tok_OptExpTypeSignature_dummy_69" { simple Tk__tok_OptExpTypeSignature_dummy_69 } + "tok_OptGdRhs_dummy_68" { simple Tk__tok_OptGdRhs_dummy_68 } + "tok_OptImpSpec_dummy_67" { simple Tk__tok_OptImpSpec_dummy_67 } + "tok_OptInteger_dummy_66" { simple Tk__tok_OptInteger_dummy_66 } + "tok_OptQualified_dummy_65" { simple Tk__tok_OptQualified_dummy_65 } + "tok_OptQualifiedAs_dummy_64" { simple Tk__tok_OptQualifiedAs_dummy_64 } + "tok_OptWhere_dummy_63" { simple Tk__tok_OptWhere_dummy_63 } + "tok_Pat_dummy_62" { simple Tk__tok_Pat_dummy_62 } + "tok_QOp_dummy_61" { simple Tk__tok_QOp_dummy_61 } + "tok_QTyCls_dummy_60" { simple Tk__tok_QTyCls_dummy_60 } + "tok_QTyCon_dummy_59" { simple Tk__tok_QTyCon_dummy_59 } + "tok_QVar_dummy_58" { simple Tk__tok_QVar_dummy_58 } + "tok_QVarId_dummy_57" { simple Tk__tok_QVarId_dummy_57 } + "tok_QVarList_dummy_56" { simple Tk__tok_QVarList_dummy_56 } + "tok_Rhs_dummy_55" { simple Tk__tok_Rhs_dummy_55 } + "tok_SimpleType_dummy_54" { simple Tk__tok_SimpleType_dummy_54 } + "tok_TopDecl_dummy_53" { simple Tk__tok_TopDecl_dummy_53 } + "tok_TopDecls_dummy_52" { simple Tk__tok_TopDecls_dummy_52 } + "tok_TyCls_dummy_51" { simple Tk__tok_TyCls_dummy_51 } + "tok_TyCon_dummy_50" { simple Tk__tok_TyCon_dummy_50 } + "tok_TyVar_dummy_49" { simple Tk__tok_TyVar_dummy_49 } + "tok_TyVars_dummy_48" { simple Tk__tok_TyVars_dummy_48 } + "tok_Type_dummy_47" { simple Tk__tok_Type_dummy_47 } + "tok_TypeList_dummy_46" { simple Tk__tok_TypeList_dummy_46 } + "tok_Var_dummy_45" { simple Tk__tok_Var_dummy_45 } + "tok_Vars_dummy_44" { simple Tk__tok_Vars_dummy_44 } + "}" { simple Tk__tok__symbol__8 } + "|" { simple Tk__tok__pipe__21 } + "{" { simple Tk__tok__symbol__6 } + "where" { simple Tk__tok_where_1 } + "type" { simple Tk__tok_type_13 } + "qualified" { simple Tk__tok_qualified_10 } + "module" { simple Tk__tok_module_0 } + "infixr" { simple Tk__tok_infixr_19 } + "infixl" { simple Tk__tok_infixl_18 } + "infix" { simple Tk__tok_infix_20 } + "import" { simple Tk__tok_import_12 } + "deriving" { simple Tk__tok_deriving_23 } + "data" { simple Tk__tok_data_15 } + "as" { simple Tk__tok_as_11 } + "]" { simple Tk__tok__sq_bkt_r__26 } + "[" { simple Tk__tok__sq_bkt_l__25 } + "=>" { simple Tk__tok__eql__symbol__16 } + "=" { simple Tk__tok__eql__14 } + ";" { simple Tk__tok__semi__7 } + "::" { simple Tk__tok__colon__colon__17 } + ".." { simple Tk__tok__dot__dot__5 } + "." { simple Tk__tok__dot__9 } + "->" { simple Tk__tok__minus__symbol__24 } + "," { simple Tk__tok__coma__3 } + ")" { simple Tk__tok__rparen__4 } + "(" { simple Tk__tok__lparen__2 } + "!" { simple Tk__tok__exclamation__22 } + ("$(" ([^\)]| [\n])* ")") { simple1 $ Tk__th . (id) } + ("{-" (.| [\n])* "-}") { simple1 $ Tk__ncomment . (id) } + ("--" .* [\n]) ; + ([\ \t\n]) { simple1 $ Tk__whitespace . (id) } + (@decimal| ("0o"| "0O") @octal| ("0x"| "0X") @hexadecimal) { simple1 $ Tk__integer . (id) } + ([0-9A-Fa-f]+) { simple1 $ Tk__hexadecimal . (id) } + ([0-7]+) { simple1 $ Tk__octal . (id) } + ([0-9]+) { simple1 $ Tk__decimal . (id) } + ("$" "QOp" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_QOp . ((tail . dropWhile (/= ':'))) } + ("$" "Op" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Op . ((tail . dropWhile (/= ':'))) } + ("$" "TyCls" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TyCls . ((tail . dropWhile (/= ':'))) } + ("$" "ModId" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ModId . ((tail . dropWhile (/= ':'))) } + ("$" "TyCon" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TyCon . ((tail . dropWhile (/= ':'))) } + ("$" "TyVar" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TyVar . ((tail . dropWhile (/= ':'))) } + ([a-zA-Z_] [a-zA-Z_0-9]*) { simple1 $ Tk__varid . (id) } + ([A-Z] [a-zA-Z_0-9]*) { simple1 $ Tk__conid . (id) } + ("$" "TyVars" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TyVars . ((tail . dropWhile (/= ':'))) } + ("$" "SimpleType" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_SimpleType . ((tail . dropWhile (/= ':'))) } + ("$" "TypeList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TypeList . ((tail . dropWhile (/= ':'))) } + ("$" "GTyCon" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_GTyCon . ((tail . dropWhile (/= ':'))) } + ("$" "AType" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_AType . ((tail . dropWhile (/= ':'))) } + ("$" "ATypeList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ATypeList . ((tail . dropWhile (/= ':'))) } + ("$" "BType" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_BType . ((tail . dropWhile (/= ':'))) } + ("$" "Type" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Type . ((tail . dropWhile (/= ':'))) } + ("$" "Class" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Class . ((tail . dropWhile (/= ':'))) } + ("$" "ClassList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ClassList . ((tail . dropWhile (/= ':'))) } + ("$" "Context" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Context . ((tail . dropWhile (/= ':'))) } + ("$" "DClass" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_DClass . ((tail . dropWhile (/= ':'))) } + ("$" "DClassList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_DClassList . ((tail . dropWhile (/= ':'))) } + ("$" "Deriving" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Deriving . ((tail . dropWhile (/= ':'))) } + ("$" "OptDeriving" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptDeriving . ((tail . dropWhile (/= ':'))) } + ("$" "Vars" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Vars . ((tail . dropWhile (/= ':'))) } + ("$" "FieldDecl" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_FieldDecl . ((tail . dropWhile (/= ':'))) } + ("$" "FieldDeclList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_FieldDeclList . ((tail . dropWhile (/= ':'))) } + ("$" "Constr" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Constr . ((tail . dropWhile (/= ':'))) } + ("$" "Constrs" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Constrs . ((tail . dropWhile (/= ':'))) } + ("$" "GdRhs" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_GdRhs . ((tail . dropWhile (/= ':'))) } + ("$" "ExpI" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ExpI . ((tail . dropWhile (/= ':'))) } + ("$" "Exp" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Exp . ((tail . dropWhile (/= ':'))) } + ("$" "OptExpTypeSignature" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptExpTypeSignature . ((tail . dropWhile (/= ':'))) } + ("$" "Gd" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Gd . ((tail . dropWhile (/= ':'))) } + ("$" "OptGdRhs" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptGdRhs . ((tail . dropWhile (/= ':'))) } + ("$" "Rhs" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Rhs . ((tail . dropWhile (/= ':'))) } + ("$" "Decls" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Decls . ((tail . dropWhile (/= ':'))) } + ("$" "DeclList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_DeclList . ((tail . dropWhile (/= ':'))) } + ("$" "OptWhere" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptWhere . ((tail . dropWhile (/= ':'))) } + ("$" "Pat" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Pat . ((tail . dropWhile (/= ':'))) } + ("$" "FunLhs" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_FunLhs . ((tail . dropWhile (/= ':'))) } + ("$" "Fixity" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Fixity . ((tail . dropWhile (/= ':'))) } + ("$" "Ops" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Ops . ((tail . dropWhile (/= ':'))) } + ("$" "OptInteger" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptInteger . ((tail . dropWhile (/= ':'))) } + ("$" "GenDecl" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_GenDecl . ((tail . dropWhile (/= ':'))) } + ("$" "OptContext" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptContext . ((tail . dropWhile (/= ':'))) } + ("$" "Decl" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Decl . ((tail . dropWhile (/= ':'))) } + ("$" "TopDecl" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TopDecl . ((tail . dropWhile (/= ':'))) } + ("$" "TopDecls" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TopDecls . ((tail . dropWhile (/= ':'))) } + ("$" "ImpDecl" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ImpDecl . ((tail . dropWhile (/= ':'))) } + ("$" "OptImpSpec" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptImpSpec . ((tail . dropWhile (/= ':'))) } + ("$" "OptQualifiedAs" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptQualifiedAs . ((tail . dropWhile (/= ':'))) } + ("$" "OptQualified" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptQualified . ((tail . dropWhile (/= ':'))) } + ("$" "Import" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Import . ((tail . dropWhile (/= ':'))) } + ("$" "QVarList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_QVarList . ((tail . dropWhile (/= ':'))) } + ("$" "CNameList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_CNameList . ((tail . dropWhile (/= ':'))) } + ("$" "CName" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_CName . ((tail . dropWhile (/= ':'))) } + ("$" "QTyCon" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_QTyCon . ((tail . dropWhile (/= ':'))) } + ("$" "QTyCls" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_QTyCls . ((tail . dropWhile (/= ':'))) } + ("$" "QVar" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_QVar . ((tail . dropWhile (/= ':'))) } + ("$" "QVarId" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_QVarId . ((tail . dropWhile (/= ':'))) } + ("$" "ModIdList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ModIdList . ((tail . dropWhile (/= ':'))) } + ("$" "Con" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Con . ((tail . dropWhile (/= ':'))) } + ("$" "Var" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Var . ((tail . dropWhile (/= ':'))) } + ("$" "ImportList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ImportList . ((tail . dropWhile (/= ':'))) } + ("$" "ImpDeclList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ImpDeclList . ((tail . dropWhile (/= ':'))) } + ("$" "Body" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Body . ((tail . dropWhile (/= ':'))) } + ("$" "Export" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Export . ((tail . dropWhile (/= ':'))) } + ("$" "ExportsList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ExportsList . ((tail . dropWhile (/= ':'))) } + ("$" "ExportsOpt" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ExportsOpt . ((tail . dropWhile (/= ':'))) } + ("$" "Module" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Module . ((tail . dropWhile (/= ':'))) } + ("$" "Haskell" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Haskell . ((tail . dropWhile (/= ':'))) } + . { rtkError } + +{ +data Token = EndOfFile | + Tk__tok_AType_dummy_111 | + Tk__tok_ATypeList_dummy_110 | + Tk__tok_BType_dummy_109 | + Tk__tok_Body_dummy_108 | + Tk__tok_CName_dummy_107 | + Tk__tok_CNameList_dummy_106 | + Tk__tok_Class_dummy_105 | + Tk__tok_ClassList_dummy_104 | + Tk__tok_Con_dummy_103 | + Tk__tok_Constr_dummy_102 | + Tk__tok_Constrs_dummy_101 | + Tk__tok_Context_dummy_100 | + Tk__tok_DClass_dummy_99 | + Tk__tok_DClassList_dummy_98 | + Tk__tok_Decl_dummy_97 | + Tk__tok_DeclList_dummy_96 | + Tk__tok_Decls_dummy_95 | + Tk__tok_Deriving_dummy_94 | + Tk__tok_Exp_dummy_93 | + Tk__tok_ExpI_dummy_92 | + Tk__tok_Export_dummy_91 | + Tk__tok_ExportsList_dummy_90 | + Tk__tok_ExportsOpt_dummy_89 | + Tk__tok_FieldDecl_dummy_88 | + Tk__tok_FieldDeclList_dummy_87 | + Tk__tok_Fixity_dummy_86 | + Tk__tok_FunLhs_dummy_85 | + Tk__tok_GTyCon_dummy_84 | + Tk__tok_Gd_dummy_83 | + Tk__tok_GdRhs_dummy_82 | + Tk__tok_GenDecl_dummy_81 | + Tk__tok_Haskell_dummy_112 | + Tk__tok_ImpDecl_dummy_80 | + Tk__tok_ImpDeclList_dummy_79 | + Tk__tok_Import_dummy_78 | + Tk__tok_ImportList_dummy_77 | + Tk__tok_ModId_dummy_76 | + Tk__tok_ModIdList_dummy_75 | + Tk__tok_Module_dummy_74 | + Tk__tok_Op_dummy_73 | + Tk__tok_Ops_dummy_72 | + Tk__tok_OptContext_dummy_71 | + Tk__tok_OptDeriving_dummy_70 | + Tk__tok_OptExpTypeSignature_dummy_69 | + Tk__tok_OptGdRhs_dummy_68 | + Tk__tok_OptImpSpec_dummy_67 | + Tk__tok_OptInteger_dummy_66 | + Tk__tok_OptQualified_dummy_65 | + Tk__tok_OptQualifiedAs_dummy_64 | + Tk__tok_OptWhere_dummy_63 | + Tk__tok_Pat_dummy_62 | + Tk__tok_QOp_dummy_61 | + Tk__tok_QTyCls_dummy_60 | + Tk__tok_QTyCon_dummy_59 | + Tk__tok_QVar_dummy_58 | + Tk__tok_QVarId_dummy_57 | + Tk__tok_QVarList_dummy_56 | + Tk__tok_Rhs_dummy_55 | + Tk__tok_SimpleType_dummy_54 | + Tk__tok_TopDecl_dummy_53 | + Tk__tok_TopDecls_dummy_52 | + Tk__tok_TyCls_dummy_51 | + Tk__tok_TyCon_dummy_50 | + Tk__tok_TyVar_dummy_49 | + Tk__tok_TyVars_dummy_48 | + Tk__tok_Type_dummy_47 | + Tk__tok_TypeList_dummy_46 | + Tk__tok_Var_dummy_45 | + Tk__tok_Vars_dummy_44 | + Tk__tok__symbol__8 | + Tk__tok__pipe__21 | + Tk__tok__symbol__6 | + Tk__tok_where_1 | + Tk__tok_type_13 | + Tk__tok_qualified_10 | + Tk__tok_module_0 | + Tk__tok_infixr_19 | + Tk__tok_infixl_18 | + Tk__tok_infix_20 | + Tk__tok_import_12 | + Tk__tok_deriving_23 | + Tk__tok_data_15 | + Tk__tok_as_11 | + Tk__tok__sq_bkt_r__26 | + Tk__tok__sq_bkt_l__25 | + Tk__tok__eql__symbol__16 | + Tk__tok__eql__14 | + Tk__tok__semi__7 | + Tk__tok__colon__colon__17 | + Tk__tok__dot__dot__5 | + Tk__tok__dot__9 | + Tk__tok__minus__symbol__24 | + Tk__tok__coma__3 | + Tk__tok__rparen__4 | + Tk__tok__lparen__2 | + Tk__tok__exclamation__22 | + Tk__th String | + Tk__ncomment String | + Tk__whitespace String | + Tk__integer String | + Tk__hexadecimal String | + Tk__octal String | + Tk__decimal String | + Tk__qq_QOp String | + Tk__qq_Op String | + Tk__qq_TyCls String | + Tk__qq_ModId String | + Tk__qq_TyCon String | + Tk__qq_TyVar String | + Tk__varid String | + Tk__conid String | + Tk__qq_TyVars String | + Tk__qq_SimpleType String | + Tk__qq_TypeList String | + Tk__qq_GTyCon String | + Tk__qq_AType String | + Tk__qq_ATypeList String | + Tk__qq_BType String | + Tk__qq_Type String | + Tk__qq_Class String | + Tk__qq_ClassList String | + Tk__qq_Context String | + Tk__qq_DClass String | + Tk__qq_DClassList String | + Tk__qq_Deriving String | + Tk__qq_OptDeriving String | + Tk__qq_Vars String | + Tk__qq_FieldDecl String | + Tk__qq_FieldDeclList String | + Tk__qq_Constr String | + Tk__qq_Constrs String | + Tk__qq_GdRhs String | + Tk__qq_ExpI String | + Tk__qq_Exp String | + Tk__qq_OptExpTypeSignature String | + Tk__qq_Gd String | + Tk__qq_OptGdRhs String | + Tk__qq_Rhs String | + Tk__qq_Decls String | + Tk__qq_DeclList String | + Tk__qq_OptWhere String | + Tk__qq_Pat String | + Tk__qq_FunLhs String | + Tk__qq_Fixity String | + Tk__qq_Ops String | + Tk__qq_OptInteger String | + Tk__qq_GenDecl String | + Tk__qq_OptContext String | + Tk__qq_Decl String | + Tk__qq_TopDecl String | + Tk__qq_TopDecls String | + Tk__qq_ImpDecl String | + Tk__qq_OptImpSpec String | + Tk__qq_OptQualifiedAs String | + Tk__qq_OptQualified String | + Tk__qq_Import String | + Tk__qq_QVarList String | + Tk__qq_CNameList String | + Tk__qq_CName String | + Tk__qq_QTyCon String | + Tk__qq_QTyCls String | + Tk__qq_QVar String | + Tk__qq_QVarId String | + Tk__qq_ModIdList String | + Tk__qq_Con String | + Tk__qq_Var String | + Tk__qq_ImportList String | + Tk__qq_ImpDeclList String | + Tk__qq_Body String | + Tk__qq_Export String | + Tk__qq_ExportsList String | + Tk__qq_ExportsOpt String | + Tk__qq_Module String | + Tk__qq_Haskell String + deriving (Show) + +-- AlexPosn is defined by the alex wrapper, so the Data instance (required by +-- the parser's RtkPos position type) can only be attached via standalone +-- deriving - the same solution as the hand-written Lexer.x +deriving instance Data AlexPosn + +-- A token together with the source position where it starts +data PosToken = PosToken { ptPos :: AlexPosn, ptToken :: Token } + deriving (Show) + +alexEOF = do + (pos, _, _, _) <- alexGetInput + return $ PosToken pos EndOfFile + +-- Lex the input into a token stream, returning the positioned error message +-- on a lexical error (encoded as "LINE:COL:message", see rtkError below). +-- The returned list always ends with an EndOfFile token that carries the +-- position of the end of input, so parse errors at end of input can be +-- reported with a position too +scanTokens :: String -> Either String [PosToken] +scanTokens str = runAlex str $ do + let loop toks = do tok <- alexMonadScan + case tok of + PosToken _ EndOfFile -> return $ reverse (tok : toks) + _ -> let toks' = tok : toks + in toks' `seq` loop toks' + loop [] + +-- Thin compatibility wrapper: callers that have not switched to 'scanTokens' +-- get the error message thrown instead +alexScanTokens :: String -> [PosToken] +alexScanTokens str = + case scanTokens str of + Right toks -> toks + Left err -> errorWithoutStackTrace err + +simple1 :: (String -> Token) -> AlexInput -> Int -> Alex PosToken +simple1 t (pos, _, _, str) len = return $ PosToken pos (t (take len str)) + +simple :: Token -> AlexInput -> Int -> Alex PosToken +simple t (pos, _, _, _) len = return $ PosToken pos t + +-- Encode the position as "LINE:COL:message" so callers can split it back out +-- into a structured position - the same encoding the rtk grammar lexer uses +rtkError ((AlexPn _ line column), _, _, str) len = alexError $ (show line) ++ ":" ++ (show column) ++ ":lexical error. Following chars: " ++ (take 10 str) + +} diff --git a/test/golden/haskell/HaskellParser.y b/test/golden/haskell/HaskellParser.y new file mode 100644 --- /dev/null +++ b/test/golden/haskell/HaskellParser.y @@ -0,0 +1,1823 @@ +-- Generated by RTK from grammar 'Haskell'. Do not edit by hand. +{ +{-# LANGUAGE DeriveDataTypeable #-} +module HaskellParser where +import qualified Data.Generics as Gen +import qualified HaskellLexer as L (Token(..), PosToken(..), AlexPosn(..), alexScanTokens) +} + +%name parseHaskell +%tokentype { L.PosToken } +%monad { Either String } +%error { parseError } + +%token + +rtk__eof { L.PosToken _ L.EndOfFile } +tok_AType_dummy_111 { L.PosToken _ L.Tk__tok_AType_dummy_111 } +tok_ATypeList_dummy_110 { L.PosToken _ L.Tk__tok_ATypeList_dummy_110 } +tok_BType_dummy_109 { L.PosToken _ L.Tk__tok_BType_dummy_109 } +tok_Body_dummy_108 { L.PosToken _ L.Tk__tok_Body_dummy_108 } +tok_CName_dummy_107 { L.PosToken _ L.Tk__tok_CName_dummy_107 } +tok_CNameList_dummy_106 { L.PosToken _ L.Tk__tok_CNameList_dummy_106 } +tok_Class_dummy_105 { L.PosToken _ L.Tk__tok_Class_dummy_105 } +tok_ClassList_dummy_104 { L.PosToken _ L.Tk__tok_ClassList_dummy_104 } +tok_Con_dummy_103 { L.PosToken _ L.Tk__tok_Con_dummy_103 } +tok_Constr_dummy_102 { L.PosToken _ L.Tk__tok_Constr_dummy_102 } +tok_Constrs_dummy_101 { L.PosToken _ L.Tk__tok_Constrs_dummy_101 } +tok_Context_dummy_100 { L.PosToken _ L.Tk__tok_Context_dummy_100 } +tok_DClass_dummy_99 { L.PosToken _ L.Tk__tok_DClass_dummy_99 } +tok_DClassList_dummy_98 { L.PosToken _ L.Tk__tok_DClassList_dummy_98 } +tok_Decl_dummy_97 { L.PosToken _ L.Tk__tok_Decl_dummy_97 } +tok_DeclList_dummy_96 { L.PosToken _ L.Tk__tok_DeclList_dummy_96 } +tok_Decls_dummy_95 { L.PosToken _ L.Tk__tok_Decls_dummy_95 } +tok_Deriving_dummy_94 { L.PosToken _ L.Tk__tok_Deriving_dummy_94 } +tok_Exp_dummy_93 { L.PosToken _ L.Tk__tok_Exp_dummy_93 } +tok_ExpI_dummy_92 { L.PosToken _ L.Tk__tok_ExpI_dummy_92 } +tok_Export_dummy_91 { L.PosToken _ L.Tk__tok_Export_dummy_91 } +tok_ExportsList_dummy_90 { L.PosToken _ L.Tk__tok_ExportsList_dummy_90 } +tok_ExportsOpt_dummy_89 { L.PosToken _ L.Tk__tok_ExportsOpt_dummy_89 } +tok_FieldDecl_dummy_88 { L.PosToken _ L.Tk__tok_FieldDecl_dummy_88 } +tok_FieldDeclList_dummy_87 { L.PosToken _ L.Tk__tok_FieldDeclList_dummy_87 } +tok_Fixity_dummy_86 { L.PosToken _ L.Tk__tok_Fixity_dummy_86 } +tok_FunLhs_dummy_85 { L.PosToken _ L.Tk__tok_FunLhs_dummy_85 } +tok_GTyCon_dummy_84 { L.PosToken _ L.Tk__tok_GTyCon_dummy_84 } +tok_Gd_dummy_83 { L.PosToken _ L.Tk__tok_Gd_dummy_83 } +tok_GdRhs_dummy_82 { L.PosToken _ L.Tk__tok_GdRhs_dummy_82 } +tok_GenDecl_dummy_81 { L.PosToken _ L.Tk__tok_GenDecl_dummy_81 } +tok_Haskell_dummy_112 { L.PosToken _ L.Tk__tok_Haskell_dummy_112 } +tok_ImpDecl_dummy_80 { L.PosToken _ L.Tk__tok_ImpDecl_dummy_80 } +tok_ImpDeclList_dummy_79 { L.PosToken _ L.Tk__tok_ImpDeclList_dummy_79 } +tok_Import_dummy_78 { L.PosToken _ L.Tk__tok_Import_dummy_78 } +tok_ImportList_dummy_77 { L.PosToken _ L.Tk__tok_ImportList_dummy_77 } +tok_ModId_dummy_76 { L.PosToken _ L.Tk__tok_ModId_dummy_76 } +tok_ModIdList_dummy_75 { L.PosToken _ L.Tk__tok_ModIdList_dummy_75 } +tok_Module_dummy_74 { L.PosToken _ L.Tk__tok_Module_dummy_74 } +tok_Op_dummy_73 { L.PosToken _ L.Tk__tok_Op_dummy_73 } +tok_Ops_dummy_72 { L.PosToken _ L.Tk__tok_Ops_dummy_72 } +tok_OptContext_dummy_71 { L.PosToken _ L.Tk__tok_OptContext_dummy_71 } +tok_OptDeriving_dummy_70 { L.PosToken _ L.Tk__tok_OptDeriving_dummy_70 } +tok_OptExpTypeSignature_dummy_69 { L.PosToken _ L.Tk__tok_OptExpTypeSignature_dummy_69 } +tok_OptGdRhs_dummy_68 { L.PosToken _ L.Tk__tok_OptGdRhs_dummy_68 } +tok_OptImpSpec_dummy_67 { L.PosToken _ L.Tk__tok_OptImpSpec_dummy_67 } +tok_OptInteger_dummy_66 { L.PosToken _ L.Tk__tok_OptInteger_dummy_66 } +tok_OptQualified_dummy_65 { L.PosToken _ L.Tk__tok_OptQualified_dummy_65 } +tok_OptQualifiedAs_dummy_64 { L.PosToken _ L.Tk__tok_OptQualifiedAs_dummy_64 } +tok_OptWhere_dummy_63 { L.PosToken _ L.Tk__tok_OptWhere_dummy_63 } +tok_Pat_dummy_62 { L.PosToken _ L.Tk__tok_Pat_dummy_62 } +tok_QOp_dummy_61 { L.PosToken _ L.Tk__tok_QOp_dummy_61 } +tok_QTyCls_dummy_60 { L.PosToken _ L.Tk__tok_QTyCls_dummy_60 } +tok_QTyCon_dummy_59 { L.PosToken _ L.Tk__tok_QTyCon_dummy_59 } +tok_QVar_dummy_58 { L.PosToken _ L.Tk__tok_QVar_dummy_58 } +tok_QVarId_dummy_57 { L.PosToken _ L.Tk__tok_QVarId_dummy_57 } +tok_QVarList_dummy_56 { L.PosToken _ L.Tk__tok_QVarList_dummy_56 } +tok_Rhs_dummy_55 { L.PosToken _ L.Tk__tok_Rhs_dummy_55 } +tok_SimpleType_dummy_54 { L.PosToken _ L.Tk__tok_SimpleType_dummy_54 } +tok_TopDecl_dummy_53 { L.PosToken _ L.Tk__tok_TopDecl_dummy_53 } +tok_TopDecls_dummy_52 { L.PosToken _ L.Tk__tok_TopDecls_dummy_52 } +tok_TyCls_dummy_51 { L.PosToken _ L.Tk__tok_TyCls_dummy_51 } +tok_TyCon_dummy_50 { L.PosToken _ L.Tk__tok_TyCon_dummy_50 } +tok_TyVar_dummy_49 { L.PosToken _ L.Tk__tok_TyVar_dummy_49 } +tok_TyVars_dummy_48 { L.PosToken _ L.Tk__tok_TyVars_dummy_48 } +tok_Type_dummy_47 { L.PosToken _ L.Tk__tok_Type_dummy_47 } +tok_TypeList_dummy_46 { L.PosToken _ L.Tk__tok_TypeList_dummy_46 } +tok_Var_dummy_45 { L.PosToken _ L.Tk__tok_Var_dummy_45 } +tok_Vars_dummy_44 { L.PosToken _ L.Tk__tok_Vars_dummy_44 } +tok__symbol__8 { L.PosToken _ L.Tk__tok__symbol__8 } +tok__pipe__21 { L.PosToken _ L.Tk__tok__pipe__21 } +tok__symbol__6 { L.PosToken _ L.Tk__tok__symbol__6 } +tok_where_1 { L.PosToken _ L.Tk__tok_where_1 } +tok_type_13 { L.PosToken _ L.Tk__tok_type_13 } +tok_qualified_10 { L.PosToken _ L.Tk__tok_qualified_10 } +tok_module_0 { L.PosToken _ L.Tk__tok_module_0 } +tok_infixr_19 { L.PosToken _ L.Tk__tok_infixr_19 } +tok_infixl_18 { L.PosToken _ L.Tk__tok_infixl_18 } +tok_infix_20 { L.PosToken _ L.Tk__tok_infix_20 } +tok_import_12 { L.PosToken _ L.Tk__tok_import_12 } +tok_deriving_23 { L.PosToken _ L.Tk__tok_deriving_23 } +tok_data_15 { L.PosToken _ L.Tk__tok_data_15 } +tok_as_11 { L.PosToken _ L.Tk__tok_as_11 } +tok__sq_bkt_r__26 { L.PosToken _ L.Tk__tok__sq_bkt_r__26 } +tok__sq_bkt_l__25 { L.PosToken _ L.Tk__tok__sq_bkt_l__25 } +tok__eql__symbol__16 { L.PosToken _ L.Tk__tok__eql__symbol__16 } +tok__eql__14 { L.PosToken _ L.Tk__tok__eql__14 } +tok__semi__7 { L.PosToken _ L.Tk__tok__semi__7 } +tok__colon__colon__17 { L.PosToken _ L.Tk__tok__colon__colon__17 } +tok__dot__dot__5 { L.PosToken _ L.Tk__tok__dot__dot__5 } +tok__dot__9 { L.PosToken _ L.Tk__tok__dot__9 } +tok__minus__symbol__24 { L.PosToken _ L.Tk__tok__minus__symbol__24 } +tok__coma__3 { L.PosToken _ L.Tk__tok__coma__3 } +tok__rparen__4 { L.PosToken _ L.Tk__tok__rparen__4 } +tok__lparen__2 { L.PosToken _ L.Tk__tok__lparen__2 } +tok__exclamation__22 { L.PosToken _ L.Tk__tok__exclamation__22 } +th { L.PosToken _ (L.Tk__th _) } +ncomment { L.PosToken _ (L.Tk__ncomment _) } +whitespace { L.PosToken _ (L.Tk__whitespace _) } +integer { L.PosToken _ (L.Tk__integer _) } +hexadecimal { L.PosToken _ (L.Tk__hexadecimal _) } +octal { L.PosToken _ (L.Tk__octal _) } +decimal { L.PosToken _ (L.Tk__decimal _) } +qq_QOp { L.PosToken _ (L.Tk__qq_QOp _) } +qq_Op { L.PosToken _ (L.Tk__qq_Op _) } +qq_TyCls { L.PosToken _ (L.Tk__qq_TyCls _) } +qq_ModId { L.PosToken _ (L.Tk__qq_ModId _) } +qq_TyCon { L.PosToken _ (L.Tk__qq_TyCon _) } +qq_TyVar { L.PosToken _ (L.Tk__qq_TyVar _) } +varid { L.PosToken _ (L.Tk__varid _) } +conid { L.PosToken _ (L.Tk__conid _) } +qq_TyVars { L.PosToken _ (L.Tk__qq_TyVars _) } +qq_SimpleType { L.PosToken _ (L.Tk__qq_SimpleType _) } +qq_TypeList { L.PosToken _ (L.Tk__qq_TypeList _) } +qq_GTyCon { L.PosToken _ (L.Tk__qq_GTyCon _) } +qq_AType { L.PosToken _ (L.Tk__qq_AType _) } +qq_ATypeList { L.PosToken _ (L.Tk__qq_ATypeList _) } +qq_BType { L.PosToken _ (L.Tk__qq_BType _) } +qq_Type { L.PosToken _ (L.Tk__qq_Type _) } +qq_Class { L.PosToken _ (L.Tk__qq_Class _) } +qq_ClassList { L.PosToken _ (L.Tk__qq_ClassList _) } +qq_Context { L.PosToken _ (L.Tk__qq_Context _) } +qq_DClass { L.PosToken _ (L.Tk__qq_DClass _) } +qq_DClassList { L.PosToken _ (L.Tk__qq_DClassList _) } +qq_Deriving { L.PosToken _ (L.Tk__qq_Deriving _) } +qq_OptDeriving { L.PosToken _ (L.Tk__qq_OptDeriving _) } +qq_Vars { L.PosToken _ (L.Tk__qq_Vars _) } +qq_FieldDecl { L.PosToken _ (L.Tk__qq_FieldDecl _) } +qq_FieldDeclList { L.PosToken _ (L.Tk__qq_FieldDeclList _) } +qq_Constr { L.PosToken _ (L.Tk__qq_Constr _) } +qq_Constrs { L.PosToken _ (L.Tk__qq_Constrs _) } +qq_GdRhs { L.PosToken _ (L.Tk__qq_GdRhs _) } +qq_ExpI { L.PosToken _ (L.Tk__qq_ExpI _) } +qq_Exp { L.PosToken _ (L.Tk__qq_Exp _) } +qq_OptExpTypeSignature { L.PosToken _ (L.Tk__qq_OptExpTypeSignature _) } +qq_Gd { L.PosToken _ (L.Tk__qq_Gd _) } +qq_OptGdRhs { L.PosToken _ (L.Tk__qq_OptGdRhs _) } +qq_Rhs { L.PosToken _ (L.Tk__qq_Rhs _) } +qq_Decls { L.PosToken _ (L.Tk__qq_Decls _) } +qq_DeclList { L.PosToken _ (L.Tk__qq_DeclList _) } +qq_OptWhere { L.PosToken _ (L.Tk__qq_OptWhere _) } +qq_Pat { L.PosToken _ (L.Tk__qq_Pat _) } +qq_FunLhs { L.PosToken _ (L.Tk__qq_FunLhs _) } +qq_Fixity { L.PosToken _ (L.Tk__qq_Fixity _) } +qq_Ops { L.PosToken _ (L.Tk__qq_Ops _) } +qq_OptInteger { L.PosToken _ (L.Tk__qq_OptInteger _) } +qq_GenDecl { L.PosToken _ (L.Tk__qq_GenDecl _) } +qq_OptContext { L.PosToken _ (L.Tk__qq_OptContext _) } +qq_Decl { L.PosToken _ (L.Tk__qq_Decl _) } +qq_TopDecl { L.PosToken _ (L.Tk__qq_TopDecl _) } +qq_TopDecls { L.PosToken _ (L.Tk__qq_TopDecls _) } +qq_ImpDecl { L.PosToken _ (L.Tk__qq_ImpDecl _) } +qq_OptImpSpec { L.PosToken _ (L.Tk__qq_OptImpSpec _) } +qq_OptQualifiedAs { L.PosToken _ (L.Tk__qq_OptQualifiedAs _) } +qq_OptQualified { L.PosToken _ (L.Tk__qq_OptQualified _) } +qq_Import { L.PosToken _ (L.Tk__qq_Import _) } +qq_QVarList { L.PosToken _ (L.Tk__qq_QVarList _) } +qq_CNameList { L.PosToken _ (L.Tk__qq_CNameList _) } +qq_CName { L.PosToken _ (L.Tk__qq_CName _) } +qq_QTyCon { L.PosToken _ (L.Tk__qq_QTyCon _) } +qq_QTyCls { L.PosToken _ (L.Tk__qq_QTyCls _) } +qq_QVar { L.PosToken _ (L.Tk__qq_QVar _) } +qq_QVarId { L.PosToken _ (L.Tk__qq_QVarId _) } +qq_ModIdList { L.PosToken _ (L.Tk__qq_ModIdList _) } +qq_Con { L.PosToken _ (L.Tk__qq_Con _) } +qq_Var { L.PosToken _ (L.Tk__qq_Var _) } +qq_ImportList { L.PosToken _ (L.Tk__qq_ImportList _) } +qq_ImpDeclList { L.PosToken _ (L.Tk__qq_ImpDeclList _) } +qq_Body { L.PosToken _ (L.Tk__qq_Body _) } +qq_Export { L.PosToken _ (L.Tk__qq_Export _) } +qq_ExportsList { L.PosToken _ (L.Tk__qq_ExportsList _) } +qq_ExportsOpt { L.PosToken _ (L.Tk__qq_ExportsOpt _) } +qq_Module { L.PosToken _ (L.Tk__qq_Module _) } +qq_Haskell { L.PosToken _ (L.Tk__qq_Haskell _) } + +%% + +Haskell__top : Haskell rtk__eof { $1 } + +Haskell : tok_Haskell_dummy_112 Haskell tok_Haskell_dummy_112 { Ctr__Haskell__0 (rtkPosOf $1) $2 } | + tok_AType_dummy_111 AType tok_AType_dummy_111 { Ctr__Haskell__1 (rtkPosOf $1) $2 } | + tok_ATypeList_dummy_110 ATypeList tok_ATypeList_dummy_110 { Ctr__Haskell__2 (rtkPosOf $1) (reverse $2) } | + tok_BType_dummy_109 BType tok_BType_dummy_109 { Ctr__Haskell__3 (rtkPosOf $1) $2 } | + tok_Body_dummy_108 Body tok_Body_dummy_108 { Ctr__Haskell__4 (rtkPosOf $1) $2 } | + tok_CName_dummy_107 CName tok_CName_dummy_107 { Ctr__Haskell__5 (rtkPosOf $1) $2 } | + tok_CNameList_dummy_106 CNameList tok_CNameList_dummy_106 { Ctr__Haskell__6 (rtkPosOf $1) $2 } | + tok_Class_dummy_105 Class tok_Class_dummy_105 { Ctr__Haskell__7 (rtkPosOf $1) $2 } | + tok_ClassList_dummy_104 ClassList tok_ClassList_dummy_104 { Ctr__Haskell__8 (rtkPosOf $1) $2 } | + tok_Con_dummy_103 Con tok_Con_dummy_103 { Ctr__Haskell__9 (rtkPosOf $1) $2 } | + tok_Constr_dummy_102 Constr tok_Constr_dummy_102 { Ctr__Haskell__10 (rtkPosOf $1) $2 } | + tok_Constrs_dummy_101 Constrs tok_Constrs_dummy_101 { Ctr__Haskell__11 (rtkPosOf $1) $2 } | + tok_Context_dummy_100 Context tok_Context_dummy_100 { Ctr__Haskell__12 (rtkPosOf $1) $2 } | + tok_DClass_dummy_99 DClass tok_DClass_dummy_99 { Ctr__Haskell__13 (rtkPosOf $1) $2 } | + tok_DClassList_dummy_98 DClassList tok_DClassList_dummy_98 { Ctr__Haskell__14 (rtkPosOf $1) $2 } | + tok_Decl_dummy_97 Decl tok_Decl_dummy_97 { Ctr__Haskell__15 (rtkPosOf $1) $2 } | + tok_DeclList_dummy_96 DeclList tok_DeclList_dummy_96 { Ctr__Haskell__16 (rtkPosOf $1) $2 } | + tok_Decls_dummy_95 Decls tok_Decls_dummy_95 { Ctr__Haskell__17 (rtkPosOf $1) $2 } | + tok_Deriving_dummy_94 Deriving tok_Deriving_dummy_94 { Ctr__Haskell__18 (rtkPosOf $1) $2 } | + tok_Exp_dummy_93 Exp tok_Exp_dummy_93 { Ctr__Haskell__19 (rtkPosOf $1) $2 } | + tok_ExpI_dummy_92 ExpI tok_ExpI_dummy_92 { Ctr__Haskell__20 (rtkPosOf $1) $2 } | + tok_Export_dummy_91 Export tok_Export_dummy_91 { Ctr__Haskell__21 (rtkPosOf $1) $2 } | + tok_ExportsList_dummy_90 ExportsList tok_ExportsList_dummy_90 { Ctr__Haskell__22 (rtkPosOf $1) $2 } | + tok_ExportsOpt_dummy_89 ExportsOpt tok_ExportsOpt_dummy_89 { Ctr__Haskell__23 (rtkPosOf $1) $2 } | + tok_FieldDecl_dummy_88 FieldDecl tok_FieldDecl_dummy_88 { Ctr__Haskell__24 (rtkPosOf $1) $2 } | + tok_FieldDeclList_dummy_87 FieldDeclList tok_FieldDeclList_dummy_87 { Ctr__Haskell__25 (rtkPosOf $1) $2 } | + tok_Fixity_dummy_86 Fixity tok_Fixity_dummy_86 { Ctr__Haskell__26 (rtkPosOf $1) $2 } | + tok_FunLhs_dummy_85 FunLhs tok_FunLhs_dummy_85 { Ctr__Haskell__27 (rtkPosOf $1) $2 } | + tok_GTyCon_dummy_84 GTyCon tok_GTyCon_dummy_84 { Ctr__Haskell__28 (rtkPosOf $1) $2 } | + tok_Gd_dummy_83 Gd tok_Gd_dummy_83 { Ctr__Haskell__29 (rtkPosOf $1) $2 } | + tok_GdRhs_dummy_82 GdRhs tok_GdRhs_dummy_82 { Ctr__Haskell__30 (rtkPosOf $1) $2 } | + tok_GenDecl_dummy_81 GenDecl tok_GenDecl_dummy_81 { Ctr__Haskell__31 (rtkPosOf $1) $2 } | + tok_ImpDecl_dummy_80 ImpDecl tok_ImpDecl_dummy_80 { Ctr__Haskell__32 (rtkPosOf $1) $2 } | + tok_ImpDeclList_dummy_79 ImpDeclList tok_ImpDeclList_dummy_79 { Ctr__Haskell__33 (rtkPosOf $1) $2 } | + tok_Import_dummy_78 Import tok_Import_dummy_78 { Ctr__Haskell__34 (rtkPosOf $1) $2 } | + tok_ImportList_dummy_77 ImportList tok_ImportList_dummy_77 { Ctr__Haskell__35 (rtkPosOf $1) $2 } | + tok_ModId_dummy_76 ModId tok_ModId_dummy_76 { Ctr__Haskell__36 (rtkPosOf $1) $2 } | + tok_ModIdList_dummy_75 ModIdList tok_ModIdList_dummy_75 { Ctr__Haskell__37 (rtkPosOf $1) (reverse $2) } | + tok_Module_dummy_74 Module tok_Module_dummy_74 { Ctr__Haskell__38 (rtkPosOf $1) $2 } | + tok_Op_dummy_73 Op tok_Op_dummy_73 { Ctr__Haskell__39 (rtkPosOf $1) $2 } | + tok_Ops_dummy_72 Ops tok_Ops_dummy_72 { Ctr__Haskell__40 (rtkPosOf $1) $2 } | + tok_OptContext_dummy_71 OptContext tok_OptContext_dummy_71 { Ctr__Haskell__41 (rtkPosOf $1) $2 } | + tok_OptDeriving_dummy_70 OptDeriving tok_OptDeriving_dummy_70 { Ctr__Haskell__42 (rtkPosOf $1) $2 } | + tok_OptExpTypeSignature_dummy_69 OptExpTypeSignature tok_OptExpTypeSignature_dummy_69 { Ctr__Haskell__43 (rtkPosOf $1) $2 } | + tok_OptGdRhs_dummy_68 OptGdRhs tok_OptGdRhs_dummy_68 { Ctr__Haskell__44 (rtkPosOf $1) $2 } | + tok_OptImpSpec_dummy_67 OptImpSpec tok_OptImpSpec_dummy_67 { Ctr__Haskell__45 (rtkPosOf $1) $2 } | + tok_OptInteger_dummy_66 OptInteger tok_OptInteger_dummy_66 { Ctr__Haskell__46 (rtkPosOf $1) $2 } | + tok_OptQualified_dummy_65 OptQualified tok_OptQualified_dummy_65 { Ctr__Haskell__47 (rtkPosOf $1) $2 } | + tok_OptQualifiedAs_dummy_64 OptQualifiedAs tok_OptQualifiedAs_dummy_64 { Ctr__Haskell__48 (rtkPosOf $1) $2 } | + tok_OptWhere_dummy_63 OptWhere tok_OptWhere_dummy_63 { Ctr__Haskell__49 (rtkPosOf $1) $2 } | + tok_Pat_dummy_62 Pat tok_Pat_dummy_62 { Ctr__Haskell__50 (rtkPosOf $1) $2 } | + tok_QOp_dummy_61 QOp tok_QOp_dummy_61 { Ctr__Haskell__51 (rtkPosOf $1) $2 } | + tok_QTyCls_dummy_60 QTyCls tok_QTyCls_dummy_60 { Ctr__Haskell__52 (rtkPosOf $1) $2 } | + tok_QTyCon_dummy_59 QTyCon tok_QTyCon_dummy_59 { Ctr__Haskell__53 (rtkPosOf $1) $2 } | + tok_QVar_dummy_58 QVar tok_QVar_dummy_58 { Ctr__Haskell__54 (rtkPosOf $1) $2 } | + tok_QVarId_dummy_57 QVarId tok_QVarId_dummy_57 { Ctr__Haskell__55 (rtkPosOf $1) $2 } | + tok_QVarList_dummy_56 QVarList tok_QVarList_dummy_56 { Ctr__Haskell__56 (rtkPosOf $1) $2 } | + tok_Rhs_dummy_55 Rhs tok_Rhs_dummy_55 { Ctr__Haskell__57 (rtkPosOf $1) $2 } | + tok_SimpleType_dummy_54 SimpleType tok_SimpleType_dummy_54 { Ctr__Haskell__58 (rtkPosOf $1) $2 } | + tok_TopDecl_dummy_53 TopDecl tok_TopDecl_dummy_53 { Ctr__Haskell__59 (rtkPosOf $1) $2 } | + tok_TopDecls_dummy_52 TopDecls tok_TopDecls_dummy_52 { Ctr__Haskell__60 (rtkPosOf $1) $2 } | + tok_TyCls_dummy_51 TyCls tok_TyCls_dummy_51 { Ctr__Haskell__61 (rtkPosOf $1) $2 } | + tok_TyCon_dummy_50 TyCon tok_TyCon_dummy_50 { Ctr__Haskell__62 (rtkPosOf $1) $2 } | + tok_TyVar_dummy_49 TyVar tok_TyVar_dummy_49 { Ctr__Haskell__63 (rtkPosOf $1) $2 } | + tok_TyVars_dummy_48 TyVars tok_TyVars_dummy_48 { Ctr__Haskell__64 (rtkPosOf $1) (reverse $2) } | + tok_Type_dummy_47 Type tok_Type_dummy_47 { Ctr__Haskell__65 (rtkPosOf $1) $2 } | + tok_TypeList_dummy_46 TypeList tok_TypeList_dummy_46 { Ctr__Haskell__66 (rtkPosOf $1) $2 } | + tok_Var_dummy_45 Var tok_Var_dummy_45 { Ctr__Haskell__67 (rtkPosOf $1) $2 } | + tok_Vars_dummy_44 Vars tok_Vars_dummy_44 { Ctr__Haskell__68 (rtkPosOf $1) $2 } + +Haskell : qq_Haskell { Anti_Haskell (tkVal_qq_Haskell $1) } | + Module { Ctr__Haskell__69 (rtkPosOf $1) $1 } + +AType : qq_AType { Anti_AType (tkVal_qq_AType $1) } | + TyVar { Ctr__AType__0 (rtkPosOf $1) $1 } | + GTyCon { Ctr__AType__1 (rtkPosOf $1) $1 } | + tok__lparen__2 TypeList tok__rparen__4 { Ctr__AType__2 (rtkPosOf $1) $2 } | + tok__sq_bkt_l__25 Rule_41 tok__sq_bkt_r__26 { Ctr__AType__3 (rtkPosOf $1) $2 } + +ListElem_ATypeList40 : qq_ATypeList { Anti_AType (tkVal_qq_ATypeList $1) } | + AType { $1 } + +ATypeList : {- empty -} { [] } | + ATypeList ListElem_ATypeList40 { $2 : $1 } + +BType : qq_BType { Anti_BType (tkVal_qq_BType $1) } | + Rule_39 AType { Ctr__BType__0 (rtkPosOf $1) $1 $2 } + +Body : qq_Body { Anti_Body (tkVal_qq_Body $1) } | + tok__symbol__6 Rule_7 tok__symbol__8 { Ctr__Body__0 (rtkPosOf $1) $2 } + +CName : qq_CName { Anti_CName (tkVal_qq_CName $1) } | + Var { Ctr__CName__0 (rtkPosOf $1) $1 } | + Con { Ctr__CName__1 (rtkPosOf $1) $1 } + +CNameList : qq_CNameList { Anti_CNameList (tkVal_qq_CNameList $1) } | + Rule_14 tok__coma__3 { Ctr__CNameList__0 (rtkPosOf (reverse $1)) (reverse $1) } + +Class : qq_Class { Anti_Class (tkVal_qq_Class $1) } | + QTyCls TyVar { Ctr__Class__0 (rtkPosOf $1) $1 $2 } | + QTyCls tok__lparen__2 TyVar ATypeList tok__rparen__4 { Ctr__Class__1 (rtkPosOf $1) $1 $3 (reverse $4) } + +ClassList : qq_ClassList { Anti_ClassList (tkVal_qq_ClassList $1) } | + Rule_36 tok__coma__3 { Ctr__ClassList__0 (rtkPosOf (reverse $1)) (reverse $1) } + +Con : qq_Con { Anti_Con (tkVal_qq_Con $1) } | + conid { Ctr__Con__0 (rtkPosOf $1) (tkVal_conid $1) } + +Constr : qq_Constr { Anti_Constr (tkVal_qq_Constr $1) } | + Con tok__symbol__6 FieldDeclList tok__symbol__8 { Ctr__Constr__0 (rtkPosOf $1) $1 $3 } + +Constrs : qq_Constrs { Anti_Constrs (tkVal_qq_Constrs $1) } | + Rule_30 tok__pipe__21 { Ctr__Constrs__0 (rtkPosOf (reverse $1)) (reverse $1) } + +Context : qq_Context { Anti_Context (tkVal_qq_Context $1) } | + Class { Ctr__Context__0 (rtkPosOf $1) $1 } | + tok__lparen__2 ClassList tok__rparen__4 { Ctr__Context__1 (rtkPosOf $1) $2 } + +DClass : qq_DClass { Anti_DClass (tkVal_qq_DClass $1) } | + QTyCls { Ctr__DClass__0 (rtkPosOf $1) $1 } + +DClassList : qq_DClassList { Anti_DClassList (tkVal_qq_DClassList $1) } | + Rule_35 tok__coma__3 { Ctr__DClassList__0 (rtkPosOf (reverse $1)) (reverse $1) } + +Decl : qq_Decl { Anti_Decl (tkVal_qq_Decl $1) } | + GenDecl { Ctr__Decl__0 (rtkPosOf $1) $1 } | + Rule_22 Rhs { Ctr__Decl__1 (rtkPosOf $1) $1 $2 } + +DeclList : qq_DeclList { Anti_DeclList (tkVal_qq_DeclList $1) } | + Rule_26 tok__semi__7 { Ctr__DeclList__0 (rtkPosOf (reverse $1)) (reverse $1) } + +Decls : qq_Decls { Anti_Decls (tkVal_qq_Decls $1) } | + tok__symbol__6 DeclList tok__symbol__8 { Ctr__Decls__0 (rtkPosOf $1) $2 } + +Deriving : qq_Deriving { Anti_Deriving (tkVal_qq_Deriving $1) } | + tok_deriving_23 Rule_34 { Ctr__Deriving__0 (rtkPosOf $1) $2 } + +Exp : qq_Exp { Anti_Exp (tkVal_qq_Exp $1) } | + ExpI OptExpTypeSignature { Ctr__Exp__0 (rtkPosOf $1) $1 $2 } + +ExpI : qq_ExpI { Anti_ExpI (tkVal_qq_ExpI $1) } | + ExpI Rule_28 { Ctr__ExpI__0 (rtkPosOf $1) $1 (reverse $2) } + +Export : qq_Export { Anti_Export (tkVal_qq_Export $1) } | + tok_module_0 ModId { Ctr__Export__0 (rtkPosOf $1) $2 } | + QVar { Ctr__Export__1 (rtkPosOf $1) $1 } | + QTyCon Rule_3 { Ctr__Export__2 (rtkPosOf $1) $1 $2 } | + QTyCls Rule_5 { Ctr__Export__3 (rtkPosOf $1) $1 $2 } + +ExportsList : qq_ExportsList { Anti_ExportsList (tkVal_qq_ExportsList $1) } | + Rule_2 tok__coma__3 { Ctr__ExportsList__0 (rtkPosOf (reverse $1)) (reverse $1) } + +ExportsOpt : qq_ExportsOpt { Anti_ExportsOpt (tkVal_qq_ExportsOpt $1) } | + { Ctr__ExportsOpt__0 rtkNoPos } | + Rule_0 { Ctr__ExportsOpt__1 (rtkPosOf $1) $1 } + +FieldDecl : qq_FieldDecl { Anti_FieldDecl (tkVal_qq_FieldDecl $1) } | + Vars tok__colon__colon__17 Rule_32 { Ctr__FieldDecl__0 (rtkPosOf $1) $1 $3 } + +FieldDeclList : qq_FieldDeclList { Anti_FieldDeclList (tkVal_qq_FieldDeclList $1) } | + Rule_31 tok__coma__3 { Ctr__FieldDeclList__0 (rtkPosOf (reverse $1)) (reverse $1) } + +Fixity : qq_Fixity { Anti_Fixity (tkVal_qq_Fixity $1) } | + tok_infixl_18 { Ctr__Fixity__0 (rtkPosOf $1) } | + tok_infixr_19 { Ctr__Fixity__1 (rtkPosOf $1) } | + tok_infix_20 { Ctr__Fixity__2 (rtkPosOf $1) } + +FunLhs : qq_FunLhs { Anti_FunLhs (tkVal_qq_FunLhs $1) } | + Var { Ctr__FunLhs__0 (rtkPosOf $1) $1 } + +GTyCon : qq_GTyCon { Anti_GTyCon (tkVal_qq_GTyCon $1) } | + QTyCon { Ctr__GTyCon__0 (rtkPosOf $1) $1 } | + tok__lparen__2 tok__minus__symbol__24 tok__rparen__4 { Ctr__GTyCon__1 (rtkPosOf $1) } + +Gd : qq_Gd { Anti_Gd (tkVal_qq_Gd $1) } | + { Ctr__Gd__0 rtkNoPos } | + ExpI { Ctr__Gd__1 (rtkPosOf $1) $1 } + +GdRhs : qq_GdRhs { Anti_GdRhs (tkVal_qq_GdRhs $1) } | + Gd tok__eql__14 Exp OptGdRhs { Ctr__GdRhs__0 (rtkPosOf $1) $1 $3 $4 } + +GenDecl : qq_GenDecl { Anti_GenDecl (tkVal_qq_GenDecl $1) } | + Vars tok__colon__colon__17 OptContext Type { Ctr__GenDecl__0 (rtkPosOf $1) $1 $3 $4 } | + Fixity OptInteger Ops { Ctr__GenDecl__1 (rtkPosOf $1) $1 $2 $3 } + +ImpDecl : qq_ImpDecl { Anti_ImpDecl (tkVal_qq_ImpDecl $1) } | + tok_import_12 OptQualified ModId OptQualifiedAs Rule_20 { Ctr__ImpDecl__0 (rtkPosOf $1) $2 $3 $4 $5 } + +ImpDeclList : qq_ImpDeclList { Anti_ImpDeclList (tkVal_qq_ImpDeclList $1) } | + Rule_10 tok__semi__7 { Ctr__ImpDeclList__0 (rtkPosOf (reverse $1)) (reverse $1) } + +Import : qq_Import { Anti_Import (tkVal_qq_Import $1) } | + Var { Ctr__Import__0 (rtkPosOf $1) $1 } | + TyCon Rule_16 { Ctr__Import__1 (rtkPosOf $1) $1 $2 } + +ImportList : qq_ImportList { Anti_ImportList (tkVal_qq_ImportList $1) } | + Rule_11 tok__coma__3 { Ctr__ImportList__0 (rtkPosOf (reverse $1)) (reverse $1) } + +ModId : qq_ModId { Anti_ModId (tkVal_qq_ModId $1) } | + conid { Ctr__ModId__0 (rtkPosOf $1) (tkVal_conid $1) } + +ModIdList : {- empty -} { [] } | + ModIdList ListElem_ModIdList13 { $2 : $1 } + +Module : qq_Module { Anti_Module (tkVal_qq_Module $1) } | + tok_module_0 ModId ExportsOpt tok_where_1 Body { Ctr__Module__0 (rtkPosOf $1) $2 $3 $5 } | + Body { Ctr__Module__1 (rtkPosOf $1) $1 } + +Op : qq_Op { Anti_Op (tkVal_qq_Op $1) } | + varid { Ctr__Op__0 (rtkPosOf $1) (tkVal_varid $1) } | + conid { Ctr__Op__1 (rtkPosOf $1) (tkVal_conid $1) } + +Ops : qq_Ops { Anti_Ops (tkVal_qq_Ops $1) } | + Rule_24 tok__coma__3 { Ctr__Ops__0 (rtkPosOf (reverse $1)) (reverse $1) } + +OptContext : qq_OptContext { Anti_OptContext (tkVal_qq_OptContext $1) } | + { Ctr__OptContext__0 rtkNoPos } | + Rule_23 { Ctr__OptContext__1 (rtkPosOf $1) $1 } + +OptDeriving : qq_OptDeriving { Anti_OptDeriving (tkVal_qq_OptDeriving $1) } | + { Ctr__OptDeriving__0 rtkNoPos } | + Deriving { Ctr__OptDeriving__1 (rtkPosOf $1) $1 } + +OptExpTypeSignature : qq_OptExpTypeSignature { Anti_OptExpTypeSignature (tkVal_qq_OptExpTypeSignature $1) } | + { Ctr__OptExpTypeSignature__0 rtkNoPos } | + Rule_27 { Ctr__OptExpTypeSignature__1 (rtkPosOf $1) $1 } + +OptGdRhs : qq_OptGdRhs { Anti_OptGdRhs (tkVal_qq_OptGdRhs $1) } | + { Ctr__OptGdRhs__0 rtkNoPos } | + GdRhs { Ctr__OptGdRhs__1 (rtkPosOf $1) $1 } + +OptImpSpec : qq_OptImpSpec { Anti_OptImpSpec (tkVal_qq_OptImpSpec $1) } | + tok__lparen__2 ImportList Rule_19 tok__rparen__4 { Ctr__OptImpSpec__0 (rtkPosOf $1) $2 $3 } + +OptInteger : qq_OptInteger { Anti_OptInteger (tkVal_qq_OptInteger $1) } | + { Ctr__OptInteger__0 rtkNoPos } | + integer { Ctr__OptInteger__1 (rtkPosOf $1) (tkVal_integer $1) } + +OptQualified : qq_OptQualified { Anti_OptQualified (tkVal_qq_OptQualified $1) } | + { Ctr__OptQualified__0 rtkNoPos } | + tok_qualified_10 { Ctr__OptQualified__1 (rtkPosOf $1) } + +OptQualifiedAs : qq_OptQualifiedAs { Anti_OptQualifiedAs (tkVal_qq_OptQualifiedAs $1) } | + { Ctr__OptQualifiedAs__0 rtkNoPos } | + Rule_18 { Ctr__OptQualifiedAs__1 (rtkPosOf $1) $1 } + +OptWhere : qq_OptWhere { Anti_OptWhere (tkVal_qq_OptWhere $1) } | + tok_where_1 Decls { Ctr__OptWhere__0 (rtkPosOf $1) $2 } + +Pat : qq_Pat { Anti_Pat (tkVal_qq_Pat $1) } | + Con Rule_25 { Ctr__Pat__0 (rtkPosOf $1) $1 (reverse $2) } + +QOp : qq_QOp { Anti_QOp (tkVal_qq_QOp $1) } | + ModIdList Op { Ctr__QOp__0 (rtkPosOf (reverse $1)) (reverse $1) $2 } + +QTyCls : qq_QTyCls { Anti_QTyCls (tkVal_qq_QTyCls $1) } | + ModIdList TyCls { Ctr__QTyCls__0 (rtkPosOf (reverse $1)) (reverse $1) $2 } + +QTyCon : qq_QTyCon { Anti_QTyCon (tkVal_qq_QTyCon $1) } | + ModIdList TyCon { Ctr__QTyCon__0 (rtkPosOf (reverse $1)) (reverse $1) $2 } + +QVar : qq_QVar { Anti_QVar (tkVal_qq_QVar $1) } | + QVarId { Ctr__QVar__0 (rtkPosOf $1) $1 } + +QVarId : qq_QVarId { Anti_QVarId (tkVal_qq_QVarId $1) } | + ModIdList varid { Ctr__QVarId__0 (rtkPosOf (reverse $1)) (reverse $1) (tkVal_varid $2) } + +QVarList : qq_QVarList { Anti_QVarList (tkVal_qq_QVarList $1) } | + Rule_15 tok__coma__3 { Ctr__QVarList__0 (rtkPosOf (reverse $1)) (reverse $1) } + +Rhs : qq_Rhs { Anti_Rhs (tkVal_qq_Rhs $1) } | + tok__eql__14 Exp OptWhere { Ctr__Rhs__0 (rtkPosOf $1) $2 $3 } | + GdRhs OptWhere { Ctr__Rhs__1 (rtkPosOf $1) $1 $2 } + +Rule_0 : tok__lparen__2 ExportsList Rule_1 tok__rparen__4 { Ctr__Rule_0__0 (rtkPosOf $1) $2 $3 } + +Rule_1 : { Ctr__Rule_1__0 rtkNoPos } | + tok__coma__3 { Ctr__Rule_1__1 (rtkPosOf $1) } + +Rule_10 : ImpDecl { [$1] } | + Rule_10 ImpDecl { $2 : $1 } + +Rule_11 : {- empty -} { [] } | + Rule_11 Import { $2 : $1 } + +ListElem_ModIdList13 : qq_ModIdList { Anti_Rule_12 (tkVal_qq_ModIdList $1) } | + Rule_12 { $1 } + +Rule_12 : ModId tok__dot__9 { Ctr__Rule_12__1 (rtkPosOf $1) $1 } + +Rule_14 : {- empty -} { [] } | + Rule_14 CName { $2 : $1 } + +Rule_15 : {- empty -} { [] } | + Rule_15 QVar { $2 : $1 } + +Rule_16 : { Ctr__Rule_16__0 rtkNoPos } | + Rule_17 { Ctr__Rule_16__1 (rtkPosOf $1) $1 } + +Rule_17 : tok__lparen__2 tok__dot__dot__5 tok__rparen__4 { Ctr__Rule_17__0 (rtkPosOf $1) } | + tok__lparen__2 CNameList tok__rparen__4 { Ctr__Rule_17__1 (rtkPosOf $1) $2 } + +Rule_18 : tok_as_11 ModId { Ctr__Rule_18__0 (rtkPosOf $1) $2 } + +Rule_19 : { Ctr__Rule_19__0 rtkNoPos } | + tok__coma__3 { Ctr__Rule_19__1 (rtkPosOf $1) } + +Rule_2 : {- empty -} { [] } | + Rule_2 Export { $2 : $1 } + +Rule_20 : { Ctr__Rule_20__0 rtkNoPos } | + OptImpSpec { Ctr__Rule_20__1 (rtkPosOf $1) $1 } + +Rule_21 : {- empty -} { [] } | + Rule_21 TopDecl { $2 : $1 } + +Rule_22 : FunLhs { Ctr__Rule_22__0 (rtkPosOf $1) $1 } | + Pat { Ctr__Rule_22__1 (rtkPosOf $1) $1 } + +Rule_23 : Context tok__eql__symbol__16 { Ctr__Rule_23__0 (rtkPosOf $1) $1 } + +Rule_24 : {- empty -} { [] } | + Rule_24 Op { $2 : $1 } + +Rule_25 : {- empty -} { [] } | + Rule_25 Var { $2 : $1 } + +Rule_26 : {- empty -} { [] } | + Rule_26 Decl { $2 : $1 } + +Rule_27 : tok__colon__colon__17 OptContext Type { Ctr__Rule_27__0 (rtkPosOf $1) $2 $3 } + +Rule_28 : {- empty -} { [] } | + Rule_28 Rule_29 { $2 : $1 } + +Rule_29 : QOp ExpI { Ctr__Rule_29__0 (rtkPosOf $1) $1 $2 } + +Rule_3 : { Ctr__Rule_3__0 rtkNoPos } | + Rule_4 { Ctr__Rule_3__1 (rtkPosOf $1) $1 } + +Rule_30 : {- empty -} { [] } | + Rule_30 Constr { $2 : $1 } + +Rule_31 : {- empty -} { [] } | + Rule_31 FieldDecl { $2 : $1 } + +Rule_32 : Type { Ctr__Rule_32__0 (rtkPosOf $1) $1 } | + tok__exclamation__22 AType { Ctr__Rule_32__1 (rtkPosOf $1) $2 } + +Rule_33 : {- empty -} { [] } | + Rule_33 Var { $2 : $1 } + +Rule_34 : DClass { Ctr__Rule_34__0 (rtkPosOf $1) $1 } | + tok__lparen__2 DClassList tok__rparen__4 { Ctr__Rule_34__1 (rtkPosOf $1) $2 } + +Rule_35 : {- empty -} { [] } | + Rule_35 DClass { $2 : $1 } + +Rule_36 : {- empty -} { [] } | + Rule_36 Class { $2 : $1 } + +Rule_37 : { Ctr__Rule_37__0 rtkNoPos } | + Rule_38 { Ctr__Rule_37__1 (rtkPosOf $1) $1 } + +Rule_38 : tok__minus__symbol__24 Type { Ctr__Rule_38__0 (rtkPosOf $1) $2 } + +Rule_39 : { Ctr__Rule_39__0 rtkNoPos } | + BType { Ctr__Rule_39__1 (rtkPosOf $1) $1 } + +Rule_4 : tok__lparen__2 tok__dot__dot__5 tok__rparen__4 { Ctr__Rule_4__0 (rtkPosOf $1) } | + tok__lparen__2 CNameList tok__rparen__4 { Ctr__Rule_4__1 (rtkPosOf $1) $2 } + +Rule_41 : { Ctr__Rule_41__0 rtkNoPos } | + Type { Ctr__Rule_41__1 (rtkPosOf $1) $1 } + +Rule_42 : {- empty -} { [] } | + Rule_42 Type { $2 : $1 } + +Rule_5 : { Ctr__Rule_5__0 rtkNoPos } | + Rule_6 { Ctr__Rule_5__1 (rtkPosOf $1) $1 } + +Rule_6 : tok__lparen__2 tok__dot__dot__5 tok__rparen__4 { Ctr__Rule_6__0 (rtkPosOf $1) } | + tok__lparen__2 QVarList tok__rparen__4 { Ctr__Rule_6__1 (rtkPosOf $1) $2 } + +Rule_7 : ImpDeclList Rule_8 { Ctr__Rule_7__0 (rtkPosOf $1) $1 $2 } | + ImpDeclList { Ctr__Rule_7__1 (rtkPosOf $1) $1 } + +Rule_8 : { Ctr__Rule_8__0 rtkNoPos } | + Rule_9 { Ctr__Rule_8__1 (rtkPosOf $1) $1 } + +Rule_9 : tok__semi__7 TopDecls { Ctr__Rule_9__0 (rtkPosOf $1) $2 } + +SimpleType : qq_SimpleType { Anti_SimpleType (tkVal_qq_SimpleType $1) } | + TyCon TyVars { Ctr__SimpleType__0 (rtkPosOf $1) $1 (reverse $2) } + +TopDecl : qq_TopDecl { Anti_TopDecl (tkVal_qq_TopDecl $1) } | + tok_type_13 SimpleType tok__eql__14 Type { Ctr__TopDecl__0 (rtkPosOf $1) $2 $4 } | + tok_data_15 OptContext SimpleType tok__eql__14 Constrs OptDeriving { Ctr__TopDecl__1 (rtkPosOf $1) $2 $3 $5 $6 } | + Decl { Ctr__TopDecl__2 (rtkPosOf $1) $1 } + +TopDecls : qq_TopDecls { Anti_TopDecls (tkVal_qq_TopDecls $1) } | + Rule_21 tok__semi__7 { Ctr__TopDecls__0 (rtkPosOf (reverse $1)) (reverse $1) } + +TyCls : qq_TyCls { Anti_TyCls (tkVal_qq_TyCls $1) } | + conid { Ctr__TyCls__0 (rtkPosOf $1) (tkVal_conid $1) } + +TyCon : qq_TyCon { Anti_TyCon (tkVal_qq_TyCon $1) } | + conid { Ctr__TyCon__0 (rtkPosOf $1) (tkVal_conid $1) } + +TyVar : qq_TyVar { Anti_TyVar (tkVal_qq_TyVar $1) } | + varid { Ctr__TyVar__0 (rtkPosOf $1) (tkVal_varid $1) } + +ListElem_TyVars43 : qq_TyVars { Anti_TyVar (tkVal_qq_TyVars $1) } | + TyVar { $1 } + +TyVars : {- empty -} { [] } | + TyVars ListElem_TyVars43 { $2 : $1 } + +Type : qq_Type { Anti_Type (tkVal_qq_Type $1) } | + BType Rule_37 { Ctr__Type__0 (rtkPosOf $1) $1 $2 } + +TypeList : qq_TypeList { Anti_TypeList (tkVal_qq_TypeList $1) } | + Rule_42 tok__coma__3 { Ctr__TypeList__0 (rtkPosOf (reverse $1)) (reverse $1) } + +Var : qq_Var { Anti_Var (tkVal_qq_Var $1) } | + varid { Ctr__Var__0 (rtkPosOf $1) (tkVal_varid $1) } + +Vars : qq_Vars { Anti_Vars (tkVal_qq_Vars $1) } | + Rule_33 tok__coma__3 { Ctr__Vars__0 (rtkPosOf (reverse $1)) (reverse $1) } + + +{ +parseError :: [L.PosToken] -> Either String a +parseError [] = Left "unexpected end of input" +parseError (L.PosToken (L.AlexPn _ line col) tok : _) = + Left $ show line ++ ":" ++ show col ++ ":unexpected " ++ showRtkToken tok + +-- Render a token the way it appears in the source, for error messages +showRtkToken :: L.Token -> String +showRtkToken L.EndOfFile = "end of input" +showRtkToken L.Tk__tok_AType_dummy_111 = "'tok_AType_dummy_111'" +showRtkToken L.Tk__tok_ATypeList_dummy_110 = "'tok_ATypeList_dummy_110'" +showRtkToken L.Tk__tok_BType_dummy_109 = "'tok_BType_dummy_109'" +showRtkToken L.Tk__tok_Body_dummy_108 = "'tok_Body_dummy_108'" +showRtkToken L.Tk__tok_CName_dummy_107 = "'tok_CName_dummy_107'" +showRtkToken L.Tk__tok_CNameList_dummy_106 = "'tok_CNameList_dummy_106'" +showRtkToken L.Tk__tok_Class_dummy_105 = "'tok_Class_dummy_105'" +showRtkToken L.Tk__tok_ClassList_dummy_104 = "'tok_ClassList_dummy_104'" +showRtkToken L.Tk__tok_Con_dummy_103 = "'tok_Con_dummy_103'" +showRtkToken L.Tk__tok_Constr_dummy_102 = "'tok_Constr_dummy_102'" +showRtkToken L.Tk__tok_Constrs_dummy_101 = "'tok_Constrs_dummy_101'" +showRtkToken L.Tk__tok_Context_dummy_100 = "'tok_Context_dummy_100'" +showRtkToken L.Tk__tok_DClass_dummy_99 = "'tok_DClass_dummy_99'" +showRtkToken L.Tk__tok_DClassList_dummy_98 = "'tok_DClassList_dummy_98'" +showRtkToken L.Tk__tok_Decl_dummy_97 = "'tok_Decl_dummy_97'" +showRtkToken L.Tk__tok_DeclList_dummy_96 = "'tok_DeclList_dummy_96'" +showRtkToken L.Tk__tok_Decls_dummy_95 = "'tok_Decls_dummy_95'" +showRtkToken L.Tk__tok_Deriving_dummy_94 = "'tok_Deriving_dummy_94'" +showRtkToken L.Tk__tok_Exp_dummy_93 = "'tok_Exp_dummy_93'" +showRtkToken L.Tk__tok_ExpI_dummy_92 = "'tok_ExpI_dummy_92'" +showRtkToken L.Tk__tok_Export_dummy_91 = "'tok_Export_dummy_91'" +showRtkToken L.Tk__tok_ExportsList_dummy_90 = "'tok_ExportsList_dummy_90'" +showRtkToken L.Tk__tok_ExportsOpt_dummy_89 = "'tok_ExportsOpt_dummy_89'" +showRtkToken L.Tk__tok_FieldDecl_dummy_88 = "'tok_FieldDecl_dummy_88'" +showRtkToken L.Tk__tok_FieldDeclList_dummy_87 = "'tok_FieldDeclList_dummy_87'" +showRtkToken L.Tk__tok_Fixity_dummy_86 = "'tok_Fixity_dummy_86'" +showRtkToken L.Tk__tok_FunLhs_dummy_85 = "'tok_FunLhs_dummy_85'" +showRtkToken L.Tk__tok_GTyCon_dummy_84 = "'tok_GTyCon_dummy_84'" +showRtkToken L.Tk__tok_Gd_dummy_83 = "'tok_Gd_dummy_83'" +showRtkToken L.Tk__tok_GdRhs_dummy_82 = "'tok_GdRhs_dummy_82'" +showRtkToken L.Tk__tok_GenDecl_dummy_81 = "'tok_GenDecl_dummy_81'" +showRtkToken L.Tk__tok_Haskell_dummy_112 = "'tok_Haskell_dummy_112'" +showRtkToken L.Tk__tok_ImpDecl_dummy_80 = "'tok_ImpDecl_dummy_80'" +showRtkToken L.Tk__tok_ImpDeclList_dummy_79 = "'tok_ImpDeclList_dummy_79'" +showRtkToken L.Tk__tok_Import_dummy_78 = "'tok_Import_dummy_78'" +showRtkToken L.Tk__tok_ImportList_dummy_77 = "'tok_ImportList_dummy_77'" +showRtkToken L.Tk__tok_ModId_dummy_76 = "'tok_ModId_dummy_76'" +showRtkToken L.Tk__tok_ModIdList_dummy_75 = "'tok_ModIdList_dummy_75'" +showRtkToken L.Tk__tok_Module_dummy_74 = "'tok_Module_dummy_74'" +showRtkToken L.Tk__tok_Op_dummy_73 = "'tok_Op_dummy_73'" +showRtkToken L.Tk__tok_Ops_dummy_72 = "'tok_Ops_dummy_72'" +showRtkToken L.Tk__tok_OptContext_dummy_71 = "'tok_OptContext_dummy_71'" +showRtkToken L.Tk__tok_OptDeriving_dummy_70 = "'tok_OptDeriving_dummy_70'" +showRtkToken L.Tk__tok_OptExpTypeSignature_dummy_69 = "'tok_OptExpTypeSignature_dummy_69'" +showRtkToken L.Tk__tok_OptGdRhs_dummy_68 = "'tok_OptGdRhs_dummy_68'" +showRtkToken L.Tk__tok_OptImpSpec_dummy_67 = "'tok_OptImpSpec_dummy_67'" +showRtkToken L.Tk__tok_OptInteger_dummy_66 = "'tok_OptInteger_dummy_66'" +showRtkToken L.Tk__tok_OptQualified_dummy_65 = "'tok_OptQualified_dummy_65'" +showRtkToken L.Tk__tok_OptQualifiedAs_dummy_64 = "'tok_OptQualifiedAs_dummy_64'" +showRtkToken L.Tk__tok_OptWhere_dummy_63 = "'tok_OptWhere_dummy_63'" +showRtkToken L.Tk__tok_Pat_dummy_62 = "'tok_Pat_dummy_62'" +showRtkToken L.Tk__tok_QOp_dummy_61 = "'tok_QOp_dummy_61'" +showRtkToken L.Tk__tok_QTyCls_dummy_60 = "'tok_QTyCls_dummy_60'" +showRtkToken L.Tk__tok_QTyCon_dummy_59 = "'tok_QTyCon_dummy_59'" +showRtkToken L.Tk__tok_QVar_dummy_58 = "'tok_QVar_dummy_58'" +showRtkToken L.Tk__tok_QVarId_dummy_57 = "'tok_QVarId_dummy_57'" +showRtkToken L.Tk__tok_QVarList_dummy_56 = "'tok_QVarList_dummy_56'" +showRtkToken L.Tk__tok_Rhs_dummy_55 = "'tok_Rhs_dummy_55'" +showRtkToken L.Tk__tok_SimpleType_dummy_54 = "'tok_SimpleType_dummy_54'" +showRtkToken L.Tk__tok_TopDecl_dummy_53 = "'tok_TopDecl_dummy_53'" +showRtkToken L.Tk__tok_TopDecls_dummy_52 = "'tok_TopDecls_dummy_52'" +showRtkToken L.Tk__tok_TyCls_dummy_51 = "'tok_TyCls_dummy_51'" +showRtkToken L.Tk__tok_TyCon_dummy_50 = "'tok_TyCon_dummy_50'" +showRtkToken L.Tk__tok_TyVar_dummy_49 = "'tok_TyVar_dummy_49'" +showRtkToken L.Tk__tok_TyVars_dummy_48 = "'tok_TyVars_dummy_48'" +showRtkToken L.Tk__tok_Type_dummy_47 = "'tok_Type_dummy_47'" +showRtkToken L.Tk__tok_TypeList_dummy_46 = "'tok_TypeList_dummy_46'" +showRtkToken L.Tk__tok_Var_dummy_45 = "'tok_Var_dummy_45'" +showRtkToken L.Tk__tok_Vars_dummy_44 = "'tok_Vars_dummy_44'" +showRtkToken L.Tk__tok__symbol__8 = "'}'" +showRtkToken L.Tk__tok__pipe__21 = "'|'" +showRtkToken L.Tk__tok__symbol__6 = "'{'" +showRtkToken L.Tk__tok_where_1 = "'where'" +showRtkToken L.Tk__tok_type_13 = "'type'" +showRtkToken L.Tk__tok_qualified_10 = "'qualified'" +showRtkToken L.Tk__tok_module_0 = "'module'" +showRtkToken L.Tk__tok_infixr_19 = "'infixr'" +showRtkToken L.Tk__tok_infixl_18 = "'infixl'" +showRtkToken L.Tk__tok_infix_20 = "'infix'" +showRtkToken L.Tk__tok_import_12 = "'import'" +showRtkToken L.Tk__tok_deriving_23 = "'deriving'" +showRtkToken L.Tk__tok_data_15 = "'data'" +showRtkToken L.Tk__tok_as_11 = "'as'" +showRtkToken L.Tk__tok__sq_bkt_r__26 = "']'" +showRtkToken L.Tk__tok__sq_bkt_l__25 = "'['" +showRtkToken L.Tk__tok__eql__symbol__16 = "'=>'" +showRtkToken L.Tk__tok__eql__14 = "'='" +showRtkToken L.Tk__tok__semi__7 = "';'" +showRtkToken L.Tk__tok__colon__colon__17 = "'::'" +showRtkToken L.Tk__tok__dot__dot__5 = "'..'" +showRtkToken L.Tk__tok__dot__9 = "'.'" +showRtkToken L.Tk__tok__minus__symbol__24 = "'->'" +showRtkToken L.Tk__tok__coma__3 = "','" +showRtkToken L.Tk__tok__rparen__4 = "')'" +showRtkToken L.Tk__tok__lparen__2 = "'('" +showRtkToken L.Tk__tok__exclamation__22 = "'!'" +showRtkToken (L.Tk__th v) = "th " ++ show v +showRtkToken (L.Tk__ncomment v) = "ncomment " ++ show v +showRtkToken (L.Tk__whitespace v) = "whitespace " ++ show v +showRtkToken (L.Tk__integer v) = "integer " ++ show v +showRtkToken (L.Tk__hexadecimal v) = "hexadecimal " ++ show v +showRtkToken (L.Tk__octal v) = "octal " ++ show v +showRtkToken (L.Tk__decimal v) = "decimal " ++ show v +showRtkToken (L.Tk__qq_QOp v) = "qq_QOp " ++ show v +showRtkToken (L.Tk__qq_Op v) = "qq_Op " ++ show v +showRtkToken (L.Tk__qq_TyCls v) = "qq_TyCls " ++ show v +showRtkToken (L.Tk__qq_ModId v) = "qq_ModId " ++ show v +showRtkToken (L.Tk__qq_TyCon v) = "qq_TyCon " ++ show v +showRtkToken (L.Tk__qq_TyVar v) = "qq_TyVar " ++ show v +showRtkToken (L.Tk__varid v) = "varid " ++ show v +showRtkToken (L.Tk__conid v) = "conid " ++ show v +showRtkToken (L.Tk__qq_TyVars v) = "qq_TyVars " ++ show v +showRtkToken (L.Tk__qq_SimpleType v) = "qq_SimpleType " ++ show v +showRtkToken (L.Tk__qq_TypeList v) = "qq_TypeList " ++ show v +showRtkToken (L.Tk__qq_GTyCon v) = "qq_GTyCon " ++ show v +showRtkToken (L.Tk__qq_AType v) = "qq_AType " ++ show v +showRtkToken (L.Tk__qq_ATypeList v) = "qq_ATypeList " ++ show v +showRtkToken (L.Tk__qq_BType v) = "qq_BType " ++ show v +showRtkToken (L.Tk__qq_Type v) = "qq_Type " ++ show v +showRtkToken (L.Tk__qq_Class v) = "qq_Class " ++ show v +showRtkToken (L.Tk__qq_ClassList v) = "qq_ClassList " ++ show v +showRtkToken (L.Tk__qq_Context v) = "qq_Context " ++ show v +showRtkToken (L.Tk__qq_DClass v) = "qq_DClass " ++ show v +showRtkToken (L.Tk__qq_DClassList v) = "qq_DClassList " ++ show v +showRtkToken (L.Tk__qq_Deriving v) = "qq_Deriving " ++ show v +showRtkToken (L.Tk__qq_OptDeriving v) = "qq_OptDeriving " ++ show v +showRtkToken (L.Tk__qq_Vars v) = "qq_Vars " ++ show v +showRtkToken (L.Tk__qq_FieldDecl v) = "qq_FieldDecl " ++ show v +showRtkToken (L.Tk__qq_FieldDeclList v) = "qq_FieldDeclList " ++ show v +showRtkToken (L.Tk__qq_Constr v) = "qq_Constr " ++ show v +showRtkToken (L.Tk__qq_Constrs v) = "qq_Constrs " ++ show v +showRtkToken (L.Tk__qq_GdRhs v) = "qq_GdRhs " ++ show v +showRtkToken (L.Tk__qq_ExpI v) = "qq_ExpI " ++ show v +showRtkToken (L.Tk__qq_Exp v) = "qq_Exp " ++ show v +showRtkToken (L.Tk__qq_OptExpTypeSignature v) = "qq_OptExpTypeSignature " ++ show v +showRtkToken (L.Tk__qq_Gd v) = "qq_Gd " ++ show v +showRtkToken (L.Tk__qq_OptGdRhs v) = "qq_OptGdRhs " ++ show v +showRtkToken (L.Tk__qq_Rhs v) = "qq_Rhs " ++ show v +showRtkToken (L.Tk__qq_Decls v) = "qq_Decls " ++ show v +showRtkToken (L.Tk__qq_DeclList v) = "qq_DeclList " ++ show v +showRtkToken (L.Tk__qq_OptWhere v) = "qq_OptWhere " ++ show v +showRtkToken (L.Tk__qq_Pat v) = "qq_Pat " ++ show v +showRtkToken (L.Tk__qq_FunLhs v) = "qq_FunLhs " ++ show v +showRtkToken (L.Tk__qq_Fixity v) = "qq_Fixity " ++ show v +showRtkToken (L.Tk__qq_Ops v) = "qq_Ops " ++ show v +showRtkToken (L.Tk__qq_OptInteger v) = "qq_OptInteger " ++ show v +showRtkToken (L.Tk__qq_GenDecl v) = "qq_GenDecl " ++ show v +showRtkToken (L.Tk__qq_OptContext v) = "qq_OptContext " ++ show v +showRtkToken (L.Tk__qq_Decl v) = "qq_Decl " ++ show v +showRtkToken (L.Tk__qq_TopDecl v) = "qq_TopDecl " ++ show v +showRtkToken (L.Tk__qq_TopDecls v) = "qq_TopDecls " ++ show v +showRtkToken (L.Tk__qq_ImpDecl v) = "qq_ImpDecl " ++ show v +showRtkToken (L.Tk__qq_OptImpSpec v) = "qq_OptImpSpec " ++ show v +showRtkToken (L.Tk__qq_OptQualifiedAs v) = "qq_OptQualifiedAs " ++ show v +showRtkToken (L.Tk__qq_OptQualified v) = "qq_OptQualified " ++ show v +showRtkToken (L.Tk__qq_Import v) = "qq_Import " ++ show v +showRtkToken (L.Tk__qq_QVarList v) = "qq_QVarList " ++ show v +showRtkToken (L.Tk__qq_CNameList v) = "qq_CNameList " ++ show v +showRtkToken (L.Tk__qq_CName v) = "qq_CName " ++ show v +showRtkToken (L.Tk__qq_QTyCon v) = "qq_QTyCon " ++ show v +showRtkToken (L.Tk__qq_QTyCls v) = "qq_QTyCls " ++ show v +showRtkToken (L.Tk__qq_QVar v) = "qq_QVar " ++ show v +showRtkToken (L.Tk__qq_QVarId v) = "qq_QVarId " ++ show v +showRtkToken (L.Tk__qq_ModIdList v) = "qq_ModIdList " ++ show v +showRtkToken (L.Tk__qq_Con v) = "qq_Con " ++ show v +showRtkToken (L.Tk__qq_Var v) = "qq_Var " ++ show v +showRtkToken (L.Tk__qq_ImportList v) = "qq_ImportList " ++ show v +showRtkToken (L.Tk__qq_ImpDeclList v) = "qq_ImpDeclList " ++ show v +showRtkToken (L.Tk__qq_Body v) = "qq_Body " ++ show v +showRtkToken (L.Tk__qq_Export v) = "qq_Export " ++ show v +showRtkToken (L.Tk__qq_ExportsList v) = "qq_ExportsList " ++ show v +showRtkToken (L.Tk__qq_ExportsOpt v) = "qq_ExportsOpt " ++ show v +showRtkToken (L.Tk__qq_Module v) = "qq_Module " ++ show v +showRtkToken (L.Tk__qq_Haskell v) = "qq_Haskell " ++ show v + +-- Source position of a node: every constructor except the Anti_* splice +-- artifacts stores the position of its alternative's first symbol in its +-- first field. Positions are transparent for equality and ordering, so two +-- ASTs that differ only in source positions (e.g. a quasi-quote parsed at +-- compile time vs the same construct parsed at run time) compare equal. +newtype RtkPos = RtkPos L.AlexPosn deriving (Show, Gen.Data, Gen.Typeable) +instance Eq RtkPos where _ == _ = True +instance Ord RtkPos where compare _ _ = EQ + +-- The position used where no source token exists: empty productions, empty +-- lists, absent optionals and Anti_* quasi-quote splices +rtkNoPos :: RtkPos +rtkNoPos = RtkPos (L.AlexPn 0 0 0) + +class RtkPosOf a where + rtkPosOf :: a -> RtkPos +instance RtkPosOf L.PosToken where + rtkPosOf (L.PosToken p _) = RtkPos p +instance RtkPosOf a => RtkPosOf [a] where + rtkPosOf (x : _) = rtkPosOf x + rtkPosOf [] = rtkNoPos +instance RtkPosOf a => RtkPosOf (Maybe a) where + rtkPosOf (Just x) = rtkPosOf x + rtkPosOf Nothing = rtkNoPos +-- A Char carries no position; this also covers String token payloads +instance RtkPosOf Char where + rtkPosOf _ = rtkNoPos + +-- Recover a token's payload from the whole positioned token: %token +-- bindings keep the L.PosToken so semantic actions can read its position +tkVal_th :: L.PosToken -> String +tkVal_th (L.PosToken _ (L.Tk__th v)) = v +tkVal_th t = error ("rtk internal error: token th expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_ncomment :: L.PosToken -> String +tkVal_ncomment (L.PosToken _ (L.Tk__ncomment v)) = v +tkVal_ncomment t = error ("rtk internal error: token ncomment expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_whitespace :: L.PosToken -> String +tkVal_whitespace (L.PosToken _ (L.Tk__whitespace v)) = v +tkVal_whitespace t = error ("rtk internal error: token whitespace expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_integer :: L.PosToken -> String +tkVal_integer (L.PosToken _ (L.Tk__integer v)) = v +tkVal_integer t = error ("rtk internal error: token integer expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_hexadecimal :: L.PosToken -> String +tkVal_hexadecimal (L.PosToken _ (L.Tk__hexadecimal v)) = v +tkVal_hexadecimal t = error ("rtk internal error: token hexadecimal expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_octal :: L.PosToken -> String +tkVal_octal (L.PosToken _ (L.Tk__octal v)) = v +tkVal_octal t = error ("rtk internal error: token octal expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_decimal :: L.PosToken -> String +tkVal_decimal (L.PosToken _ (L.Tk__decimal v)) = v +tkVal_decimal t = error ("rtk internal error: token decimal expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_QOp :: L.PosToken -> String +tkVal_qq_QOp (L.PosToken _ (L.Tk__qq_QOp v)) = v +tkVal_qq_QOp t = error ("rtk internal error: token qq_QOp expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Op :: L.PosToken -> String +tkVal_qq_Op (L.PosToken _ (L.Tk__qq_Op v)) = v +tkVal_qq_Op t = error ("rtk internal error: token qq_Op expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TyCls :: L.PosToken -> String +tkVal_qq_TyCls (L.PosToken _ (L.Tk__qq_TyCls v)) = v +tkVal_qq_TyCls t = error ("rtk internal error: token qq_TyCls expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ModId :: L.PosToken -> String +tkVal_qq_ModId (L.PosToken _ (L.Tk__qq_ModId v)) = v +tkVal_qq_ModId t = error ("rtk internal error: token qq_ModId expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TyCon :: L.PosToken -> String +tkVal_qq_TyCon (L.PosToken _ (L.Tk__qq_TyCon v)) = v +tkVal_qq_TyCon t = error ("rtk internal error: token qq_TyCon expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TyVar :: L.PosToken -> String +tkVal_qq_TyVar (L.PosToken _ (L.Tk__qq_TyVar v)) = v +tkVal_qq_TyVar t = error ("rtk internal error: token qq_TyVar expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_varid :: L.PosToken -> String +tkVal_varid (L.PosToken _ (L.Tk__varid v)) = v +tkVal_varid t = error ("rtk internal error: token varid expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_conid :: L.PosToken -> String +tkVal_conid (L.PosToken _ (L.Tk__conid v)) = v +tkVal_conid t = error ("rtk internal error: token conid expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TyVars :: L.PosToken -> String +tkVal_qq_TyVars (L.PosToken _ (L.Tk__qq_TyVars v)) = v +tkVal_qq_TyVars t = error ("rtk internal error: token qq_TyVars expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_SimpleType :: L.PosToken -> String +tkVal_qq_SimpleType (L.PosToken _ (L.Tk__qq_SimpleType v)) = v +tkVal_qq_SimpleType t = error ("rtk internal error: token qq_SimpleType expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TypeList :: L.PosToken -> String +tkVal_qq_TypeList (L.PosToken _ (L.Tk__qq_TypeList v)) = v +tkVal_qq_TypeList t = error ("rtk internal error: token qq_TypeList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_GTyCon :: L.PosToken -> String +tkVal_qq_GTyCon (L.PosToken _ (L.Tk__qq_GTyCon v)) = v +tkVal_qq_GTyCon t = error ("rtk internal error: token qq_GTyCon expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_AType :: L.PosToken -> String +tkVal_qq_AType (L.PosToken _ (L.Tk__qq_AType v)) = v +tkVal_qq_AType t = error ("rtk internal error: token qq_AType expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ATypeList :: L.PosToken -> String +tkVal_qq_ATypeList (L.PosToken _ (L.Tk__qq_ATypeList v)) = v +tkVal_qq_ATypeList t = error ("rtk internal error: token qq_ATypeList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_BType :: L.PosToken -> String +tkVal_qq_BType (L.PosToken _ (L.Tk__qq_BType v)) = v +tkVal_qq_BType t = error ("rtk internal error: token qq_BType expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Type :: L.PosToken -> String +tkVal_qq_Type (L.PosToken _ (L.Tk__qq_Type v)) = v +tkVal_qq_Type t = error ("rtk internal error: token qq_Type expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Class :: L.PosToken -> String +tkVal_qq_Class (L.PosToken _ (L.Tk__qq_Class v)) = v +tkVal_qq_Class t = error ("rtk internal error: token qq_Class expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ClassList :: L.PosToken -> String +tkVal_qq_ClassList (L.PosToken _ (L.Tk__qq_ClassList v)) = v +tkVal_qq_ClassList t = error ("rtk internal error: token qq_ClassList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Context :: L.PosToken -> String +tkVal_qq_Context (L.PosToken _ (L.Tk__qq_Context v)) = v +tkVal_qq_Context t = error ("rtk internal error: token qq_Context expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_DClass :: L.PosToken -> String +tkVal_qq_DClass (L.PosToken _ (L.Tk__qq_DClass v)) = v +tkVal_qq_DClass t = error ("rtk internal error: token qq_DClass expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_DClassList :: L.PosToken -> String +tkVal_qq_DClassList (L.PosToken _ (L.Tk__qq_DClassList v)) = v +tkVal_qq_DClassList t = error ("rtk internal error: token qq_DClassList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Deriving :: L.PosToken -> String +tkVal_qq_Deriving (L.PosToken _ (L.Tk__qq_Deriving v)) = v +tkVal_qq_Deriving t = error ("rtk internal error: token qq_Deriving expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptDeriving :: L.PosToken -> String +tkVal_qq_OptDeriving (L.PosToken _ (L.Tk__qq_OptDeriving v)) = v +tkVal_qq_OptDeriving t = error ("rtk internal error: token qq_OptDeriving expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Vars :: L.PosToken -> String +tkVal_qq_Vars (L.PosToken _ (L.Tk__qq_Vars v)) = v +tkVal_qq_Vars t = error ("rtk internal error: token qq_Vars expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_FieldDecl :: L.PosToken -> String +tkVal_qq_FieldDecl (L.PosToken _ (L.Tk__qq_FieldDecl v)) = v +tkVal_qq_FieldDecl t = error ("rtk internal error: token qq_FieldDecl expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_FieldDeclList :: L.PosToken -> String +tkVal_qq_FieldDeclList (L.PosToken _ (L.Tk__qq_FieldDeclList v)) = v +tkVal_qq_FieldDeclList t = error ("rtk internal error: token qq_FieldDeclList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Constr :: L.PosToken -> String +tkVal_qq_Constr (L.PosToken _ (L.Tk__qq_Constr v)) = v +tkVal_qq_Constr t = error ("rtk internal error: token qq_Constr expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Constrs :: L.PosToken -> String +tkVal_qq_Constrs (L.PosToken _ (L.Tk__qq_Constrs v)) = v +tkVal_qq_Constrs t = error ("rtk internal error: token qq_Constrs expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_GdRhs :: L.PosToken -> String +tkVal_qq_GdRhs (L.PosToken _ (L.Tk__qq_GdRhs v)) = v +tkVal_qq_GdRhs t = error ("rtk internal error: token qq_GdRhs expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ExpI :: L.PosToken -> String +tkVal_qq_ExpI (L.PosToken _ (L.Tk__qq_ExpI v)) = v +tkVal_qq_ExpI t = error ("rtk internal error: token qq_ExpI expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Exp :: L.PosToken -> String +tkVal_qq_Exp (L.PosToken _ (L.Tk__qq_Exp v)) = v +tkVal_qq_Exp t = error ("rtk internal error: token qq_Exp expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptExpTypeSignature :: L.PosToken -> String +tkVal_qq_OptExpTypeSignature (L.PosToken _ (L.Tk__qq_OptExpTypeSignature v)) = v +tkVal_qq_OptExpTypeSignature t = error ("rtk internal error: token qq_OptExpTypeSignature expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Gd :: L.PosToken -> String +tkVal_qq_Gd (L.PosToken _ (L.Tk__qq_Gd v)) = v +tkVal_qq_Gd t = error ("rtk internal error: token qq_Gd expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptGdRhs :: L.PosToken -> String +tkVal_qq_OptGdRhs (L.PosToken _ (L.Tk__qq_OptGdRhs v)) = v +tkVal_qq_OptGdRhs t = error ("rtk internal error: token qq_OptGdRhs expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Rhs :: L.PosToken -> String +tkVal_qq_Rhs (L.PosToken _ (L.Tk__qq_Rhs v)) = v +tkVal_qq_Rhs t = error ("rtk internal error: token qq_Rhs expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Decls :: L.PosToken -> String +tkVal_qq_Decls (L.PosToken _ (L.Tk__qq_Decls v)) = v +tkVal_qq_Decls t = error ("rtk internal error: token qq_Decls expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_DeclList :: L.PosToken -> String +tkVal_qq_DeclList (L.PosToken _ (L.Tk__qq_DeclList v)) = v +tkVal_qq_DeclList t = error ("rtk internal error: token qq_DeclList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptWhere :: L.PosToken -> String +tkVal_qq_OptWhere (L.PosToken _ (L.Tk__qq_OptWhere v)) = v +tkVal_qq_OptWhere t = error ("rtk internal error: token qq_OptWhere expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Pat :: L.PosToken -> String +tkVal_qq_Pat (L.PosToken _ (L.Tk__qq_Pat v)) = v +tkVal_qq_Pat t = error ("rtk internal error: token qq_Pat expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_FunLhs :: L.PosToken -> String +tkVal_qq_FunLhs (L.PosToken _ (L.Tk__qq_FunLhs v)) = v +tkVal_qq_FunLhs t = error ("rtk internal error: token qq_FunLhs expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Fixity :: L.PosToken -> String +tkVal_qq_Fixity (L.PosToken _ (L.Tk__qq_Fixity v)) = v +tkVal_qq_Fixity t = error ("rtk internal error: token qq_Fixity expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Ops :: L.PosToken -> String +tkVal_qq_Ops (L.PosToken _ (L.Tk__qq_Ops v)) = v +tkVal_qq_Ops t = error ("rtk internal error: token qq_Ops expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptInteger :: L.PosToken -> String +tkVal_qq_OptInteger (L.PosToken _ (L.Tk__qq_OptInteger v)) = v +tkVal_qq_OptInteger t = error ("rtk internal error: token qq_OptInteger expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_GenDecl :: L.PosToken -> String +tkVal_qq_GenDecl (L.PosToken _ (L.Tk__qq_GenDecl v)) = v +tkVal_qq_GenDecl t = error ("rtk internal error: token qq_GenDecl expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptContext :: L.PosToken -> String +tkVal_qq_OptContext (L.PosToken _ (L.Tk__qq_OptContext v)) = v +tkVal_qq_OptContext t = error ("rtk internal error: token qq_OptContext expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Decl :: L.PosToken -> String +tkVal_qq_Decl (L.PosToken _ (L.Tk__qq_Decl v)) = v +tkVal_qq_Decl t = error ("rtk internal error: token qq_Decl expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TopDecl :: L.PosToken -> String +tkVal_qq_TopDecl (L.PosToken _ (L.Tk__qq_TopDecl v)) = v +tkVal_qq_TopDecl t = error ("rtk internal error: token qq_TopDecl expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TopDecls :: L.PosToken -> String +tkVal_qq_TopDecls (L.PosToken _ (L.Tk__qq_TopDecls v)) = v +tkVal_qq_TopDecls t = error ("rtk internal error: token qq_TopDecls expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ImpDecl :: L.PosToken -> String +tkVal_qq_ImpDecl (L.PosToken _ (L.Tk__qq_ImpDecl v)) = v +tkVal_qq_ImpDecl t = error ("rtk internal error: token qq_ImpDecl expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptImpSpec :: L.PosToken -> String +tkVal_qq_OptImpSpec (L.PosToken _ (L.Tk__qq_OptImpSpec v)) = v +tkVal_qq_OptImpSpec t = error ("rtk internal error: token qq_OptImpSpec expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptQualifiedAs :: L.PosToken -> String +tkVal_qq_OptQualifiedAs (L.PosToken _ (L.Tk__qq_OptQualifiedAs v)) = v +tkVal_qq_OptQualifiedAs t = error ("rtk internal error: token qq_OptQualifiedAs expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptQualified :: L.PosToken -> String +tkVal_qq_OptQualified (L.PosToken _ (L.Tk__qq_OptQualified v)) = v +tkVal_qq_OptQualified t = error ("rtk internal error: token qq_OptQualified expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Import :: L.PosToken -> String +tkVal_qq_Import (L.PosToken _ (L.Tk__qq_Import v)) = v +tkVal_qq_Import t = error ("rtk internal error: token qq_Import expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_QVarList :: L.PosToken -> String +tkVal_qq_QVarList (L.PosToken _ (L.Tk__qq_QVarList v)) = v +tkVal_qq_QVarList t = error ("rtk internal error: token qq_QVarList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_CNameList :: L.PosToken -> String +tkVal_qq_CNameList (L.PosToken _ (L.Tk__qq_CNameList v)) = v +tkVal_qq_CNameList t = error ("rtk internal error: token qq_CNameList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_CName :: L.PosToken -> String +tkVal_qq_CName (L.PosToken _ (L.Tk__qq_CName v)) = v +tkVal_qq_CName t = error ("rtk internal error: token qq_CName expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_QTyCon :: L.PosToken -> String +tkVal_qq_QTyCon (L.PosToken _ (L.Tk__qq_QTyCon v)) = v +tkVal_qq_QTyCon t = error ("rtk internal error: token qq_QTyCon expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_QTyCls :: L.PosToken -> String +tkVal_qq_QTyCls (L.PosToken _ (L.Tk__qq_QTyCls v)) = v +tkVal_qq_QTyCls t = error ("rtk internal error: token qq_QTyCls expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_QVar :: L.PosToken -> String +tkVal_qq_QVar (L.PosToken _ (L.Tk__qq_QVar v)) = v +tkVal_qq_QVar t = error ("rtk internal error: token qq_QVar expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_QVarId :: L.PosToken -> String +tkVal_qq_QVarId (L.PosToken _ (L.Tk__qq_QVarId v)) = v +tkVal_qq_QVarId t = error ("rtk internal error: token qq_QVarId expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ModIdList :: L.PosToken -> String +tkVal_qq_ModIdList (L.PosToken _ (L.Tk__qq_ModIdList v)) = v +tkVal_qq_ModIdList t = error ("rtk internal error: token qq_ModIdList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Con :: L.PosToken -> String +tkVal_qq_Con (L.PosToken _ (L.Tk__qq_Con v)) = v +tkVal_qq_Con t = error ("rtk internal error: token qq_Con expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Var :: L.PosToken -> String +tkVal_qq_Var (L.PosToken _ (L.Tk__qq_Var v)) = v +tkVal_qq_Var t = error ("rtk internal error: token qq_Var expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ImportList :: L.PosToken -> String +tkVal_qq_ImportList (L.PosToken _ (L.Tk__qq_ImportList v)) = v +tkVal_qq_ImportList t = error ("rtk internal error: token qq_ImportList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ImpDeclList :: L.PosToken -> String +tkVal_qq_ImpDeclList (L.PosToken _ (L.Tk__qq_ImpDeclList v)) = v +tkVal_qq_ImpDeclList t = error ("rtk internal error: token qq_ImpDeclList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Body :: L.PosToken -> String +tkVal_qq_Body (L.PosToken _ (L.Tk__qq_Body v)) = v +tkVal_qq_Body t = error ("rtk internal error: token qq_Body expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Export :: L.PosToken -> String +tkVal_qq_Export (L.PosToken _ (L.Tk__qq_Export v)) = v +tkVal_qq_Export t = error ("rtk internal error: token qq_Export expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ExportsList :: L.PosToken -> String +tkVal_qq_ExportsList (L.PosToken _ (L.Tk__qq_ExportsList v)) = v +tkVal_qq_ExportsList t = error ("rtk internal error: token qq_ExportsList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ExportsOpt :: L.PosToken -> String +tkVal_qq_ExportsOpt (L.PosToken _ (L.Tk__qq_ExportsOpt v)) = v +tkVal_qq_ExportsOpt t = error ("rtk internal error: token qq_ExportsOpt expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Module :: L.PosToken -> String +tkVal_qq_Module (L.PosToken _ (L.Tk__qq_Module v)) = v +tkVal_qq_Module t = error ("rtk internal error: token qq_Module expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Haskell :: L.PosToken -> String +tkVal_qq_Haskell (L.PosToken _ (L.Tk__qq_Haskell v)) = v +tkVal_qq_Haskell t = error ("rtk internal error: token qq_Haskell expected, got " ++ showRtkToken (L.ptToken t)) + +data Haskell = Ctr__Haskell__0 RtkPos Haskell | + Ctr__Haskell__1 RtkPos AType | + Ctr__Haskell__2 RtkPos ATypeList | + Ctr__Haskell__3 RtkPos BType | + Ctr__Haskell__4 RtkPos Body | + Ctr__Haskell__5 RtkPos CName | + Ctr__Haskell__6 RtkPos CNameList | + Ctr__Haskell__7 RtkPos Class | + Ctr__Haskell__8 RtkPos ClassList | + Ctr__Haskell__9 RtkPos Con | + Ctr__Haskell__10 RtkPos Constr | + Ctr__Haskell__11 RtkPos Constrs | + Ctr__Haskell__12 RtkPos Context | + Ctr__Haskell__13 RtkPos DClass | + Ctr__Haskell__14 RtkPos DClassList | + Ctr__Haskell__15 RtkPos Decl | + Ctr__Haskell__16 RtkPos DeclList | + Ctr__Haskell__17 RtkPos Decls | + Ctr__Haskell__18 RtkPos Deriving | + Ctr__Haskell__19 RtkPos Exp | + Ctr__Haskell__20 RtkPos ExpI | + Ctr__Haskell__21 RtkPos Export | + Ctr__Haskell__22 RtkPos ExportsList | + Ctr__Haskell__23 RtkPos ExportsOpt | + Ctr__Haskell__24 RtkPos FieldDecl | + Ctr__Haskell__25 RtkPos FieldDeclList | + Ctr__Haskell__26 RtkPos Fixity | + Ctr__Haskell__27 RtkPos FunLhs | + Ctr__Haskell__28 RtkPos GTyCon | + Ctr__Haskell__29 RtkPos Gd | + Ctr__Haskell__30 RtkPos GdRhs | + Ctr__Haskell__31 RtkPos GenDecl | + Ctr__Haskell__32 RtkPos ImpDecl | + Ctr__Haskell__33 RtkPos ImpDeclList | + Ctr__Haskell__34 RtkPos Import | + Ctr__Haskell__35 RtkPos ImportList | + Ctr__Haskell__36 RtkPos ModId | + Ctr__Haskell__37 RtkPos ModIdList | + Ctr__Haskell__38 RtkPos Module | + Ctr__Haskell__39 RtkPos Op | + Ctr__Haskell__40 RtkPos Ops | + Ctr__Haskell__41 RtkPos OptContext | + Ctr__Haskell__42 RtkPos OptDeriving | + Ctr__Haskell__43 RtkPos OptExpTypeSignature | + Ctr__Haskell__44 RtkPos OptGdRhs | + Ctr__Haskell__45 RtkPos OptImpSpec | + Ctr__Haskell__46 RtkPos OptInteger | + Ctr__Haskell__47 RtkPos OptQualified | + Ctr__Haskell__48 RtkPos OptQualifiedAs | + Ctr__Haskell__49 RtkPos OptWhere | + Ctr__Haskell__50 RtkPos Pat | + Ctr__Haskell__51 RtkPos QOp | + Ctr__Haskell__52 RtkPos QTyCls | + Ctr__Haskell__53 RtkPos QTyCon | + Ctr__Haskell__54 RtkPos QVar | + Ctr__Haskell__55 RtkPos QVarId | + Ctr__Haskell__56 RtkPos QVarList | + Ctr__Haskell__57 RtkPos Rhs | + Ctr__Haskell__58 RtkPos SimpleType | + Ctr__Haskell__59 RtkPos TopDecl | + Ctr__Haskell__60 RtkPos TopDecls | + Ctr__Haskell__61 RtkPos TyCls | + Ctr__Haskell__62 RtkPos TyCon | + Ctr__Haskell__63 RtkPos TyVar | + Ctr__Haskell__64 RtkPos TyVars | + Ctr__Haskell__65 RtkPos Type | + Ctr__Haskell__66 RtkPos TypeList | + Ctr__Haskell__67 RtkPos Var | + Ctr__Haskell__68 RtkPos Vars | + Anti_Haskell String | + Ctr__Haskell__69 RtkPos Module + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Haskell where + rtkPosOf (Ctr__Haskell__0 p _) = p + rtkPosOf (Ctr__Haskell__1 p _) = p + rtkPosOf (Ctr__Haskell__2 p _) = p + rtkPosOf (Ctr__Haskell__3 p _) = p + rtkPosOf (Ctr__Haskell__4 p _) = p + rtkPosOf (Ctr__Haskell__5 p _) = p + rtkPosOf (Ctr__Haskell__6 p _) = p + rtkPosOf (Ctr__Haskell__7 p _) = p + rtkPosOf (Ctr__Haskell__8 p _) = p + rtkPosOf (Ctr__Haskell__9 p _) = p + rtkPosOf (Ctr__Haskell__10 p _) = p + rtkPosOf (Ctr__Haskell__11 p _) = p + rtkPosOf (Ctr__Haskell__12 p _) = p + rtkPosOf (Ctr__Haskell__13 p _) = p + rtkPosOf (Ctr__Haskell__14 p _) = p + rtkPosOf (Ctr__Haskell__15 p _) = p + rtkPosOf (Ctr__Haskell__16 p _) = p + rtkPosOf (Ctr__Haskell__17 p _) = p + rtkPosOf (Ctr__Haskell__18 p _) = p + rtkPosOf (Ctr__Haskell__19 p _) = p + rtkPosOf (Ctr__Haskell__20 p _) = p + rtkPosOf (Ctr__Haskell__21 p _) = p + rtkPosOf (Ctr__Haskell__22 p _) = p + rtkPosOf (Ctr__Haskell__23 p _) = p + rtkPosOf (Ctr__Haskell__24 p _) = p + rtkPosOf (Ctr__Haskell__25 p _) = p + rtkPosOf (Ctr__Haskell__26 p _) = p + rtkPosOf (Ctr__Haskell__27 p _) = p + rtkPosOf (Ctr__Haskell__28 p _) = p + rtkPosOf (Ctr__Haskell__29 p _) = p + rtkPosOf (Ctr__Haskell__30 p _) = p + rtkPosOf (Ctr__Haskell__31 p _) = p + rtkPosOf (Ctr__Haskell__32 p _) = p + rtkPosOf (Ctr__Haskell__33 p _) = p + rtkPosOf (Ctr__Haskell__34 p _) = p + rtkPosOf (Ctr__Haskell__35 p _) = p + rtkPosOf (Ctr__Haskell__36 p _) = p + rtkPosOf (Ctr__Haskell__37 p _) = p + rtkPosOf (Ctr__Haskell__38 p _) = p + rtkPosOf (Ctr__Haskell__39 p _) = p + rtkPosOf (Ctr__Haskell__40 p _) = p + rtkPosOf (Ctr__Haskell__41 p _) = p + rtkPosOf (Ctr__Haskell__42 p _) = p + rtkPosOf (Ctr__Haskell__43 p _) = p + rtkPosOf (Ctr__Haskell__44 p _) = p + rtkPosOf (Ctr__Haskell__45 p _) = p + rtkPosOf (Ctr__Haskell__46 p _) = p + rtkPosOf (Ctr__Haskell__47 p _) = p + rtkPosOf (Ctr__Haskell__48 p _) = p + rtkPosOf (Ctr__Haskell__49 p _) = p + rtkPosOf (Ctr__Haskell__50 p _) = p + rtkPosOf (Ctr__Haskell__51 p _) = p + rtkPosOf (Ctr__Haskell__52 p _) = p + rtkPosOf (Ctr__Haskell__53 p _) = p + rtkPosOf (Ctr__Haskell__54 p _) = p + rtkPosOf (Ctr__Haskell__55 p _) = p + rtkPosOf (Ctr__Haskell__56 p _) = p + rtkPosOf (Ctr__Haskell__57 p _) = p + rtkPosOf (Ctr__Haskell__58 p _) = p + rtkPosOf (Ctr__Haskell__59 p _) = p + rtkPosOf (Ctr__Haskell__60 p _) = p + rtkPosOf (Ctr__Haskell__61 p _) = p + rtkPosOf (Ctr__Haskell__62 p _) = p + rtkPosOf (Ctr__Haskell__63 p _) = p + rtkPosOf (Ctr__Haskell__64 p _) = p + rtkPosOf (Ctr__Haskell__65 p _) = p + rtkPosOf (Ctr__Haskell__66 p _) = p + rtkPosOf (Ctr__Haskell__67 p _) = p + rtkPosOf (Ctr__Haskell__68 p _) = p + rtkPosOf (Anti_Haskell _) = rtkNoPos + rtkPosOf (Ctr__Haskell__69 p _) = p +data AType = Anti_AType String | + Ctr__AType__0 RtkPos TyVar | + Ctr__AType__1 RtkPos GTyCon | + Ctr__AType__2 RtkPos TypeList | + Ctr__AType__3 RtkPos Rule_41 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf AType where + rtkPosOf (Anti_AType _) = rtkNoPos + rtkPosOf (Ctr__AType__0 p _) = p + rtkPosOf (Ctr__AType__1 p _) = p + rtkPosOf (Ctr__AType__2 p _) = p + rtkPosOf (Ctr__AType__3 p _) = p +type ATypeList = [AType] +data BType = Anti_BType String | + Ctr__BType__0 RtkPos Rule_39 AType + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf BType where + rtkPosOf (Anti_BType _) = rtkNoPos + rtkPosOf (Ctr__BType__0 p _ _) = p +data Body = Anti_Body String | + Ctr__Body__0 RtkPos Rule_7 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Body where + rtkPosOf (Anti_Body _) = rtkNoPos + rtkPosOf (Ctr__Body__0 p _) = p +data CName = Anti_CName String | + Ctr__CName__0 RtkPos Var | + Ctr__CName__1 RtkPos Con + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf CName where + rtkPosOf (Anti_CName _) = rtkNoPos + rtkPosOf (Ctr__CName__0 p _) = p + rtkPosOf (Ctr__CName__1 p _) = p +data CNameList = Anti_CNameList String | + Ctr__CNameList__0 RtkPos Rule_14 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf CNameList where + rtkPosOf (Anti_CNameList _) = rtkNoPos + rtkPosOf (Ctr__CNameList__0 p _) = p +data Class = Anti_Class String | + Ctr__Class__0 RtkPos QTyCls TyVar | + Ctr__Class__1 RtkPos QTyCls TyVar ATypeList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Class where + rtkPosOf (Anti_Class _) = rtkNoPos + rtkPosOf (Ctr__Class__0 p _ _) = p + rtkPosOf (Ctr__Class__1 p _ _ _) = p +data ClassList = Anti_ClassList String | + Ctr__ClassList__0 RtkPos Rule_36 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ClassList where + rtkPosOf (Anti_ClassList _) = rtkNoPos + rtkPosOf (Ctr__ClassList__0 p _) = p +data Con = Anti_Con String | + Ctr__Con__0 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Con where + rtkPosOf (Anti_Con _) = rtkNoPos + rtkPosOf (Ctr__Con__0 p _) = p +data Constr = Anti_Constr String | + Ctr__Constr__0 RtkPos Con FieldDeclList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Constr where + rtkPosOf (Anti_Constr _) = rtkNoPos + rtkPosOf (Ctr__Constr__0 p _ _) = p +data Constrs = Anti_Constrs String | + Ctr__Constrs__0 RtkPos Rule_30 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Constrs where + rtkPosOf (Anti_Constrs _) = rtkNoPos + rtkPosOf (Ctr__Constrs__0 p _) = p +data Context = Anti_Context String | + Ctr__Context__0 RtkPos Class | + Ctr__Context__1 RtkPos ClassList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Context where + rtkPosOf (Anti_Context _) = rtkNoPos + rtkPosOf (Ctr__Context__0 p _) = p + rtkPosOf (Ctr__Context__1 p _) = p +data DClass = Anti_DClass String | + Ctr__DClass__0 RtkPos QTyCls + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf DClass where + rtkPosOf (Anti_DClass _) = rtkNoPos + rtkPosOf (Ctr__DClass__0 p _) = p +data DClassList = Anti_DClassList String | + Ctr__DClassList__0 RtkPos Rule_35 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf DClassList where + rtkPosOf (Anti_DClassList _) = rtkNoPos + rtkPosOf (Ctr__DClassList__0 p _) = p +data Decl = Anti_Decl String | + Ctr__Decl__0 RtkPos GenDecl | + Ctr__Decl__1 RtkPos Rule_22 Rhs + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Decl where + rtkPosOf (Anti_Decl _) = rtkNoPos + rtkPosOf (Ctr__Decl__0 p _) = p + rtkPosOf (Ctr__Decl__1 p _ _) = p +data DeclList = Anti_DeclList String | + Ctr__DeclList__0 RtkPos Rule_26 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf DeclList where + rtkPosOf (Anti_DeclList _) = rtkNoPos + rtkPosOf (Ctr__DeclList__0 p _) = p +data Decls = Anti_Decls String | + Ctr__Decls__0 RtkPos DeclList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Decls where + rtkPosOf (Anti_Decls _) = rtkNoPos + rtkPosOf (Ctr__Decls__0 p _) = p +data Deriving = Anti_Deriving String | + Ctr__Deriving__0 RtkPos Rule_34 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Deriving where + rtkPosOf (Anti_Deriving _) = rtkNoPos + rtkPosOf (Ctr__Deriving__0 p _) = p +data Exp = Anti_Exp String | + Ctr__Exp__0 RtkPos ExpI OptExpTypeSignature + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Exp where + rtkPosOf (Anti_Exp _) = rtkNoPos + rtkPosOf (Ctr__Exp__0 p _ _) = p +data ExpI = Anti_ExpI String | + Ctr__ExpI__0 RtkPos ExpI Rule_28 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ExpI where + rtkPosOf (Anti_ExpI _) = rtkNoPos + rtkPosOf (Ctr__ExpI__0 p _ _) = p +data Export = Anti_Export String | + Ctr__Export__0 RtkPos ModId | + Ctr__Export__1 RtkPos QVar | + Ctr__Export__2 RtkPos QTyCon Rule_3 | + Ctr__Export__3 RtkPos QTyCls Rule_5 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Export where + rtkPosOf (Anti_Export _) = rtkNoPos + rtkPosOf (Ctr__Export__0 p _) = p + rtkPosOf (Ctr__Export__1 p _) = p + rtkPosOf (Ctr__Export__2 p _ _) = p + rtkPosOf (Ctr__Export__3 p _ _) = p +data ExportsList = Anti_ExportsList String | + Ctr__ExportsList__0 RtkPos Rule_2 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ExportsList where + rtkPosOf (Anti_ExportsList _) = rtkNoPos + rtkPosOf (Ctr__ExportsList__0 p _) = p +data ExportsOpt = Anti_ExportsOpt String | + Ctr__ExportsOpt__0 RtkPos | + Ctr__ExportsOpt__1 RtkPos Rule_0 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ExportsOpt where + rtkPosOf (Anti_ExportsOpt _) = rtkNoPos + rtkPosOf (Ctr__ExportsOpt__0 p) = p + rtkPosOf (Ctr__ExportsOpt__1 p _) = p +data FieldDecl = Anti_FieldDecl String | + Ctr__FieldDecl__0 RtkPos Vars Rule_32 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf FieldDecl where + rtkPosOf (Anti_FieldDecl _) = rtkNoPos + rtkPosOf (Ctr__FieldDecl__0 p _ _) = p +data FieldDeclList = Anti_FieldDeclList String | + Ctr__FieldDeclList__0 RtkPos Rule_31 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf FieldDeclList where + rtkPosOf (Anti_FieldDeclList _) = rtkNoPos + rtkPosOf (Ctr__FieldDeclList__0 p _) = p +data Fixity = Anti_Fixity String | + Ctr__Fixity__0 RtkPos | + Ctr__Fixity__1 RtkPos | + Ctr__Fixity__2 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Fixity where + rtkPosOf (Anti_Fixity _) = rtkNoPos + rtkPosOf (Ctr__Fixity__0 p) = p + rtkPosOf (Ctr__Fixity__1 p) = p + rtkPosOf (Ctr__Fixity__2 p) = p +data FunLhs = Anti_FunLhs String | + Ctr__FunLhs__0 RtkPos Var + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf FunLhs where + rtkPosOf (Anti_FunLhs _) = rtkNoPos + rtkPosOf (Ctr__FunLhs__0 p _) = p +data GTyCon = Anti_GTyCon String | + Ctr__GTyCon__0 RtkPos QTyCon | + Ctr__GTyCon__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf GTyCon where + rtkPosOf (Anti_GTyCon _) = rtkNoPos + rtkPosOf (Ctr__GTyCon__0 p _) = p + rtkPosOf (Ctr__GTyCon__1 p) = p +data Gd = Anti_Gd String | + Ctr__Gd__0 RtkPos | + Ctr__Gd__1 RtkPos ExpI + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Gd where + rtkPosOf (Anti_Gd _) = rtkNoPos + rtkPosOf (Ctr__Gd__0 p) = p + rtkPosOf (Ctr__Gd__1 p _) = p +data GdRhs = Anti_GdRhs String | + Ctr__GdRhs__0 RtkPos Gd Exp OptGdRhs + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf GdRhs where + rtkPosOf (Anti_GdRhs _) = rtkNoPos + rtkPosOf (Ctr__GdRhs__0 p _ _ _) = p +data GenDecl = Anti_GenDecl String | + Ctr__GenDecl__0 RtkPos Vars OptContext Type | + Ctr__GenDecl__1 RtkPos Fixity OptInteger Ops + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf GenDecl where + rtkPosOf (Anti_GenDecl _) = rtkNoPos + rtkPosOf (Ctr__GenDecl__0 p _ _ _) = p + rtkPosOf (Ctr__GenDecl__1 p _ _ _) = p +data ImpDecl = Anti_ImpDecl String | + Ctr__ImpDecl__0 RtkPos OptQualified ModId OptQualifiedAs Rule_20 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ImpDecl where + rtkPosOf (Anti_ImpDecl _) = rtkNoPos + rtkPosOf (Ctr__ImpDecl__0 p _ _ _ _) = p +data ImpDeclList = Anti_ImpDeclList String | + Ctr__ImpDeclList__0 RtkPos Rule_10 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ImpDeclList where + rtkPosOf (Anti_ImpDeclList _) = rtkNoPos + rtkPosOf (Ctr__ImpDeclList__0 p _) = p +data Import = Anti_Import String | + Ctr__Import__0 RtkPos Var | + Ctr__Import__1 RtkPos TyCon Rule_16 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Import where + rtkPosOf (Anti_Import _) = rtkNoPos + rtkPosOf (Ctr__Import__0 p _) = p + rtkPosOf (Ctr__Import__1 p _ _) = p +data ImportList = Anti_ImportList String | + Ctr__ImportList__0 RtkPos Rule_11 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ImportList where + rtkPosOf (Anti_ImportList _) = rtkNoPos + rtkPosOf (Ctr__ImportList__0 p _) = p +data ModId = Anti_ModId String | + Ctr__ModId__0 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ModId where + rtkPosOf (Anti_ModId _) = rtkNoPos + rtkPosOf (Ctr__ModId__0 p _) = p +type ModIdList = [Rule_12] +data Module = Anti_Module String | + Ctr__Module__0 RtkPos ModId ExportsOpt Body | + Ctr__Module__1 RtkPos Body + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Module where + rtkPosOf (Anti_Module _) = rtkNoPos + rtkPosOf (Ctr__Module__0 p _ _ _) = p + rtkPosOf (Ctr__Module__1 p _) = p +data Op = Anti_Op String | + Ctr__Op__0 RtkPos String | + Ctr__Op__1 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Op where + rtkPosOf (Anti_Op _) = rtkNoPos + rtkPosOf (Ctr__Op__0 p _) = p + rtkPosOf (Ctr__Op__1 p _) = p +data Ops = Anti_Ops String | + Ctr__Ops__0 RtkPos Rule_24 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Ops where + rtkPosOf (Anti_Ops _) = rtkNoPos + rtkPosOf (Ctr__Ops__0 p _) = p +data OptContext = Anti_OptContext String | + Ctr__OptContext__0 RtkPos | + Ctr__OptContext__1 RtkPos Rule_23 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptContext where + rtkPosOf (Anti_OptContext _) = rtkNoPos + rtkPosOf (Ctr__OptContext__0 p) = p + rtkPosOf (Ctr__OptContext__1 p _) = p +data OptDeriving = Anti_OptDeriving String | + Ctr__OptDeriving__0 RtkPos | + Ctr__OptDeriving__1 RtkPos Deriving + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptDeriving where + rtkPosOf (Anti_OptDeriving _) = rtkNoPos + rtkPosOf (Ctr__OptDeriving__0 p) = p + rtkPosOf (Ctr__OptDeriving__1 p _) = p +data OptExpTypeSignature = Anti_OptExpTypeSignature String | + Ctr__OptExpTypeSignature__0 RtkPos | + Ctr__OptExpTypeSignature__1 RtkPos Rule_27 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptExpTypeSignature where + rtkPosOf (Anti_OptExpTypeSignature _) = rtkNoPos + rtkPosOf (Ctr__OptExpTypeSignature__0 p) = p + rtkPosOf (Ctr__OptExpTypeSignature__1 p _) = p +data OptGdRhs = Anti_OptGdRhs String | + Ctr__OptGdRhs__0 RtkPos | + Ctr__OptGdRhs__1 RtkPos GdRhs + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptGdRhs where + rtkPosOf (Anti_OptGdRhs _) = rtkNoPos + rtkPosOf (Ctr__OptGdRhs__0 p) = p + rtkPosOf (Ctr__OptGdRhs__1 p _) = p +data OptImpSpec = Anti_OptImpSpec String | + Ctr__OptImpSpec__0 RtkPos ImportList Rule_19 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptImpSpec where + rtkPosOf (Anti_OptImpSpec _) = rtkNoPos + rtkPosOf (Ctr__OptImpSpec__0 p _ _) = p +data OptInteger = Anti_OptInteger String | + Ctr__OptInteger__0 RtkPos | + Ctr__OptInteger__1 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptInteger where + rtkPosOf (Anti_OptInteger _) = rtkNoPos + rtkPosOf (Ctr__OptInteger__0 p) = p + rtkPosOf (Ctr__OptInteger__1 p _) = p +data OptQualified = Anti_OptQualified String | + Ctr__OptQualified__0 RtkPos | + Ctr__OptQualified__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptQualified where + rtkPosOf (Anti_OptQualified _) = rtkNoPos + rtkPosOf (Ctr__OptQualified__0 p) = p + rtkPosOf (Ctr__OptQualified__1 p) = p +data OptQualifiedAs = Anti_OptQualifiedAs String | + Ctr__OptQualifiedAs__0 RtkPos | + Ctr__OptQualifiedAs__1 RtkPos Rule_18 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptQualifiedAs where + rtkPosOf (Anti_OptQualifiedAs _) = rtkNoPos + rtkPosOf (Ctr__OptQualifiedAs__0 p) = p + rtkPosOf (Ctr__OptQualifiedAs__1 p _) = p +data OptWhere = Anti_OptWhere String | + Ctr__OptWhere__0 RtkPos Decls + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptWhere where + rtkPosOf (Anti_OptWhere _) = rtkNoPos + rtkPosOf (Ctr__OptWhere__0 p _) = p +data Pat = Anti_Pat String | + Ctr__Pat__0 RtkPos Con Rule_25 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Pat where + rtkPosOf (Anti_Pat _) = rtkNoPos + rtkPosOf (Ctr__Pat__0 p _ _) = p +data QOp = Anti_QOp String | + Ctr__QOp__0 RtkPos ModIdList Op + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf QOp where + rtkPosOf (Anti_QOp _) = rtkNoPos + rtkPosOf (Ctr__QOp__0 p _ _) = p +data QTyCls = Anti_QTyCls String | + Ctr__QTyCls__0 RtkPos ModIdList TyCls + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf QTyCls where + rtkPosOf (Anti_QTyCls _) = rtkNoPos + rtkPosOf (Ctr__QTyCls__0 p _ _) = p +data QTyCon = Anti_QTyCon String | + Ctr__QTyCon__0 RtkPos ModIdList TyCon + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf QTyCon where + rtkPosOf (Anti_QTyCon _) = rtkNoPos + rtkPosOf (Ctr__QTyCon__0 p _ _) = p +data QVar = Anti_QVar String | + Ctr__QVar__0 RtkPos QVarId + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf QVar where + rtkPosOf (Anti_QVar _) = rtkNoPos + rtkPosOf (Ctr__QVar__0 p _) = p +data QVarId = Anti_QVarId String | + Ctr__QVarId__0 RtkPos ModIdList String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf QVarId where + rtkPosOf (Anti_QVarId _) = rtkNoPos + rtkPosOf (Ctr__QVarId__0 p _ _) = p +data QVarList = Anti_QVarList String | + Ctr__QVarList__0 RtkPos Rule_15 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf QVarList where + rtkPosOf (Anti_QVarList _) = rtkNoPos + rtkPosOf (Ctr__QVarList__0 p _) = p +data Rhs = Anti_Rhs String | + Ctr__Rhs__0 RtkPos Exp OptWhere | + Ctr__Rhs__1 RtkPos GdRhs OptWhere + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rhs where + rtkPosOf (Anti_Rhs _) = rtkNoPos + rtkPosOf (Ctr__Rhs__0 p _ _) = p + rtkPosOf (Ctr__Rhs__1 p _ _) = p +data Rule_0 = Ctr__Rule_0__0 RtkPos ExportsList Rule_1 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_0 where + rtkPosOf (Ctr__Rule_0__0 p _ _) = p +data Rule_1 = Ctr__Rule_1__0 RtkPos | + Ctr__Rule_1__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_1 where + rtkPosOf (Ctr__Rule_1__0 p) = p + rtkPosOf (Ctr__Rule_1__1 p) = p +type Rule_10 = [ImpDecl] +type Rule_11 = [Import] +data Rule_12 = Anti_Rule_12 String | + Ctr__Rule_12__1 RtkPos ModId + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_12 where + rtkPosOf (Anti_Rule_12 _) = rtkNoPos + rtkPosOf (Ctr__Rule_12__1 p _) = p +type Rule_14 = [CName] +type Rule_15 = [QVar] +data Rule_16 = Ctr__Rule_16__0 RtkPos | + Ctr__Rule_16__1 RtkPos Rule_17 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_16 where + rtkPosOf (Ctr__Rule_16__0 p) = p + rtkPosOf (Ctr__Rule_16__1 p _) = p +data Rule_17 = Ctr__Rule_17__0 RtkPos | + Ctr__Rule_17__1 RtkPos CNameList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_17 where + rtkPosOf (Ctr__Rule_17__0 p) = p + rtkPosOf (Ctr__Rule_17__1 p _) = p +data Rule_18 = Ctr__Rule_18__0 RtkPos ModId + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_18 where + rtkPosOf (Ctr__Rule_18__0 p _) = p +data Rule_19 = Ctr__Rule_19__0 RtkPos | + Ctr__Rule_19__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_19 where + rtkPosOf (Ctr__Rule_19__0 p) = p + rtkPosOf (Ctr__Rule_19__1 p) = p +type Rule_2 = [Export] +data Rule_20 = Ctr__Rule_20__0 RtkPos | + Ctr__Rule_20__1 RtkPos OptImpSpec + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_20 where + rtkPosOf (Ctr__Rule_20__0 p) = p + rtkPosOf (Ctr__Rule_20__1 p _) = p +type Rule_21 = [TopDecl] +data Rule_22 = Ctr__Rule_22__0 RtkPos FunLhs | + Ctr__Rule_22__1 RtkPos Pat + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_22 where + rtkPosOf (Ctr__Rule_22__0 p _) = p + rtkPosOf (Ctr__Rule_22__1 p _) = p +data Rule_23 = Ctr__Rule_23__0 RtkPos Context + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_23 where + rtkPosOf (Ctr__Rule_23__0 p _) = p +type Rule_24 = [Op] +type Rule_25 = [Var] +type Rule_26 = [Decl] +data Rule_27 = Ctr__Rule_27__0 RtkPos OptContext Type + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_27 where + rtkPosOf (Ctr__Rule_27__0 p _ _) = p +type Rule_28 = [Rule_29] +data Rule_29 = Ctr__Rule_29__0 RtkPos QOp ExpI + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_29 where + rtkPosOf (Ctr__Rule_29__0 p _ _) = p +data Rule_3 = Ctr__Rule_3__0 RtkPos | + Ctr__Rule_3__1 RtkPos Rule_4 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_3 where + rtkPosOf (Ctr__Rule_3__0 p) = p + rtkPosOf (Ctr__Rule_3__1 p _) = p +type Rule_30 = [Constr] +type Rule_31 = [FieldDecl] +data Rule_32 = Ctr__Rule_32__0 RtkPos Type | + Ctr__Rule_32__1 RtkPos AType + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_32 where + rtkPosOf (Ctr__Rule_32__0 p _) = p + rtkPosOf (Ctr__Rule_32__1 p _) = p +type Rule_33 = [Var] +data Rule_34 = Ctr__Rule_34__0 RtkPos DClass | + Ctr__Rule_34__1 RtkPos DClassList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_34 where + rtkPosOf (Ctr__Rule_34__0 p _) = p + rtkPosOf (Ctr__Rule_34__1 p _) = p +type Rule_35 = [DClass] +type Rule_36 = [Class] +data Rule_37 = Ctr__Rule_37__0 RtkPos | + Ctr__Rule_37__1 RtkPos Rule_38 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_37 where + rtkPosOf (Ctr__Rule_37__0 p) = p + rtkPosOf (Ctr__Rule_37__1 p _) = p +data Rule_38 = Ctr__Rule_38__0 RtkPos Type + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_38 where + rtkPosOf (Ctr__Rule_38__0 p _) = p +data Rule_39 = Ctr__Rule_39__0 RtkPos | + Ctr__Rule_39__1 RtkPos BType + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_39 where + rtkPosOf (Ctr__Rule_39__0 p) = p + rtkPosOf (Ctr__Rule_39__1 p _) = p +data Rule_4 = Ctr__Rule_4__0 RtkPos | + Ctr__Rule_4__1 RtkPos CNameList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_4 where + rtkPosOf (Ctr__Rule_4__0 p) = p + rtkPosOf (Ctr__Rule_4__1 p _) = p +data Rule_41 = Ctr__Rule_41__0 RtkPos | + Ctr__Rule_41__1 RtkPos Type + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_41 where + rtkPosOf (Ctr__Rule_41__0 p) = p + rtkPosOf (Ctr__Rule_41__1 p _) = p +type Rule_42 = [Type] +data Rule_5 = Ctr__Rule_5__0 RtkPos | + Ctr__Rule_5__1 RtkPos Rule_6 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_5 where + rtkPosOf (Ctr__Rule_5__0 p) = p + rtkPosOf (Ctr__Rule_5__1 p _) = p +data Rule_6 = Ctr__Rule_6__0 RtkPos | + Ctr__Rule_6__1 RtkPos QVarList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_6 where + rtkPosOf (Ctr__Rule_6__0 p) = p + rtkPosOf (Ctr__Rule_6__1 p _) = p +data Rule_7 = Ctr__Rule_7__0 RtkPos ImpDeclList Rule_8 | + Ctr__Rule_7__1 RtkPos ImpDeclList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_7 where + rtkPosOf (Ctr__Rule_7__0 p _ _) = p + rtkPosOf (Ctr__Rule_7__1 p _) = p +data Rule_8 = Ctr__Rule_8__0 RtkPos | + Ctr__Rule_8__1 RtkPos Rule_9 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_8 where + rtkPosOf (Ctr__Rule_8__0 p) = p + rtkPosOf (Ctr__Rule_8__1 p _) = p +data Rule_9 = Ctr__Rule_9__0 RtkPos TopDecls + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_9 where + rtkPosOf (Ctr__Rule_9__0 p _) = p +data SimpleType = Anti_SimpleType String | + Ctr__SimpleType__0 RtkPos TyCon TyVars + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf SimpleType where + rtkPosOf (Anti_SimpleType _) = rtkNoPos + rtkPosOf (Ctr__SimpleType__0 p _ _) = p +data TopDecl = Anti_TopDecl String | + Ctr__TopDecl__0 RtkPos SimpleType Type | + Ctr__TopDecl__1 RtkPos OptContext SimpleType Constrs OptDeriving | + Ctr__TopDecl__2 RtkPos Decl + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf TopDecl where + rtkPosOf (Anti_TopDecl _) = rtkNoPos + rtkPosOf (Ctr__TopDecl__0 p _ _) = p + rtkPosOf (Ctr__TopDecl__1 p _ _ _ _) = p + rtkPosOf (Ctr__TopDecl__2 p _) = p +data TopDecls = Anti_TopDecls String | + Ctr__TopDecls__0 RtkPos Rule_21 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf TopDecls where + rtkPosOf (Anti_TopDecls _) = rtkNoPos + rtkPosOf (Ctr__TopDecls__0 p _) = p +data TyCls = Anti_TyCls String | + Ctr__TyCls__0 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf TyCls where + rtkPosOf (Anti_TyCls _) = rtkNoPos + rtkPosOf (Ctr__TyCls__0 p _) = p +data TyCon = Anti_TyCon String | + Ctr__TyCon__0 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf TyCon where + rtkPosOf (Anti_TyCon _) = rtkNoPos + rtkPosOf (Ctr__TyCon__0 p _) = p +data TyVar = Anti_TyVar String | + Ctr__TyVar__0 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf TyVar where + rtkPosOf (Anti_TyVar _) = rtkNoPos + rtkPosOf (Ctr__TyVar__0 p _) = p +type TyVars = [TyVar] +data Type = Anti_Type String | + Ctr__Type__0 RtkPos BType Rule_37 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Type where + rtkPosOf (Anti_Type _) = rtkNoPos + rtkPosOf (Ctr__Type__0 p _ _) = p +data TypeList = Anti_TypeList String | + Ctr__TypeList__0 RtkPos Rule_42 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf TypeList where + rtkPosOf (Anti_TypeList _) = rtkNoPos + rtkPosOf (Ctr__TypeList__0 p _) = p +data Var = Anti_Var String | + Ctr__Var__0 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Var where + rtkPosOf (Anti_Var _) = rtkNoPos + rtkPosOf (Ctr__Var__0 p _) = p +data Vars = Anti_Vars String | + Ctr__Vars__0 RtkPos Rule_33 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Vars where + rtkPosOf (Anti_Vars _) = rtkNoPos + rtkPosOf (Ctr__Vars__0 p _) = p +} diff --git a/test/golden/haskell/HaskellQQ.hs b/test/golden/haskell/HaskellQQ.hs new file mode 100644 --- /dev/null +++ b/test/golden/haskell/HaskellQQ.hs @@ -0,0 +1,1123 @@ +-- Generated by RTK from grammar 'Haskell'. Do not edit by hand. +{-# LANGUAGE TemplateHaskell #-} +module HaskellQQ +where + +import qualified Data.Char as C +import qualified Data.Map as M +import Data.List +import Data.Maybe +import qualified Data.Generics as Generics +import qualified Data.Data as Data +import qualified Language.Haskell.TH as TH +import Language.Haskell.TH.Quote +import HaskellLexer +import HaskellParser + +qqShortcuts :: M.Map String String + +-- A $name metavariable is rewritten to $Type:name using the qqShortcuts +-- table below. The rewrite is purely textual, so it would also fire inside +-- the quoted language's own string literals: write $$name there to escape +-- it and get the literal text $name. Each '$$' pair directly before a +-- metavariable stands for one literal '$' (so $$$x is a literal '$' +-- followed by the metavariable $x). A '$' not followed by an identifier is +-- never rewritten and needs no escape, and an explicit $Type:name antiquote +-- (the character after the name is ':') passes through untouched. +-- A plain character scan rather than a regex: metavariables are recognized +-- regardless of what follows the name - including a newline or the end of +-- the quote, which the previous regex's terminator class missed. +replaceAllPatterns :: String -> Either String String +replaceAllPatterns [] = Right [] +replaceAllPatterns s@('$' : _) = + let (dollars, rest) = span (== '$') s + in case rest of + (c1 : _) | C.isAlpha c1 || c1 == '_' -> + let (varName, post) = span (\ ch -> C.isAlphaNum ch || ch == '_') rest + escCount = length dollars - 1 + keptPre = replicate (div escCount 2) '$' + in case post of + (':' : _) -> ((dollars ++ varName) ++) <$> replaceAllPatterns post + _ | odd escCount -> ((keptPre ++ '$' : varName) ++) <$> replaceAllPatterns post + _ -> case catMaybes $ map (\ prefix -> M.lookup prefix qqShortcuts) $ reverse $ inits varName of + [] -> Left $ unlines + [ "Unknown metavariable $" ++ varName ++ " in quasi-quote:" + , "no prefix of '" ++ varName ++ "' is a known shortcut. Known shortcuts:" + , " " ++ intercalate ", " (M.keys qqShortcuts) + , "To include the literal text $" ++ varName ++ " in the quoted code" + , "(e.g. inside a string literal), escape it as $$" ++ varName ++ "." ] + (rule : _) -> ((keptPre ++ '$' : rule ++ ":" ++ varName) ++) <$> replaceAllPatterns post + _ -> (dollars ++) <$> replaceAllPatterns rest +replaceAllPatterns (c : rest) = (c :) <$> replaceAllPatterns rest + +-- The generated lexer and parser encode error positions as "LINE:COL:message" +-- so structured-diagnostic callers can split them; render them back +-- human-readably for quasi-quote compile errors. Positions refer to the quote +-- body (padded with a start token in front). +rtkRenderError :: String -> String +rtkRenderError err = + case span (/= ':') err of + (l, ':' : rest1) | [(line, "")] <- (reads l :: [(Int, String)]) -> + case span (/= ':') rest1 of + (c, ':' : msg) | [(col, "")] <- (reads c :: [(Int, String)]) -> + "line " ++ show line ++ ", column " ++ show col ++ ": " ++ msg + _ -> err + _ -> err + +qqShortcuts = M.fromList [ ("haskell","Haskell"),("aType","AType"),("aTypeList","ATypeList"),("bType","BType"),("body","Body"),("cName","CName"),("cNameList","CNameList"),("class","Class"),("classList","ClassList"),("con","Con"),("constr","Constr"),("constrs","Constrs"),("context","Context"),("dClass","DClass"),("dClassList","DClassList"),("decl","Decl"),("declList","DeclList"),("decls","Decls"),("deriving","Deriving"),("exp","Exp"),("expI","ExpI"),("export","Export"),("exportsList","ExportsList"),("exportsOpt","ExportsOpt"),("fieldDecl","FieldDecl"),("fieldDeclList","FieldDeclList"),("fixity","Fixity"),("funLhs","FunLhs"),("gTyCon","GTyCon"),("gd","Gd"),("gdRhs","GdRhs"),("genDecl","GenDecl"),("impDecl","ImpDecl"),("impDeclList","ImpDeclList"),("import","Import"),("importList","ImportList"),("modId","ModId"),("modIdList","ModIdList"),("module","Module"),("op","Op"),("ops","Ops"),("optContext","OptContext"),("optDeriving","OptDeriving"),("optExpTypeSignature","OptExpTypeSignature"),("optGdRhs","OptGdRhs"),("optImpSpec","OptImpSpec"),("optInteger","OptInteger"),("optQualified","OptQualified"),("optQualifiedAs","OptQualifiedAs"),("optWhere","OptWhere"),("pat","Pat"),("qOp","QOp"),("qTyCls","QTyCls"),("qTyCon","QTyCon"),("qVar","QVar"),("qVarId","QVarId"),("qVarList","QVarList"),("rhs","Rhs"),("simpleType","SimpleType"),("topDecl","TopDecl"),("topDecls","TopDecls"),("tyCls","TyCls"),("tyCon","TyCon"),("tyVar","TyVar"),("tyVars","TyVars"),("type","Type"),("typeList","TypeList"),("var","Var"),("vars","Vars")] + +-- A quasi-quote pattern must match an AST parsed from anywhere in a source +-- file, while the pattern itself was parsed from the quote body - so every +-- RtkPos position field becomes a wildcard in generated patterns. +-- (Expressions need no special case: the compile-time position they embed +-- is equality-transparent.) +rtkPosWildPat :: RtkPos -> Maybe (TH.Q TH.Pat) +rtkPosWildPat _ = Just TH.wildP + +quoteHaskellExp :: Data.Data a => String -> (Haskell -> a) -> String -> TH.ExpQ +quoteHaskellExp dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseHaskell of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToExpQ (const Nothing `Generics.extQ` antiHaskellExp `Generics.extQ` antiModuleExp `Generics.extQ` antiExportsOptExp `Generics.extQ` antiExportsListExp `Generics.extQ` antiExportExp `Generics.extQ` antiBodyExp `Generics.extQ` antiImpDeclListExp `Generics.extQ` antiImportListExp `Generics.extQ` antiVarExp `Generics.extQ` antiConExp `Generics.extQ` antiRule_12Exp `Generics.extQ` antiQVarIdExp `Generics.extQ` antiQVarExp `Generics.extQ` antiQTyClsExp `Generics.extQ` antiQTyConExp `Generics.extQ` antiCNameExp `Generics.extQ` antiCNameListExp `Generics.extQ` antiQVarListExp `Generics.extQ` antiImportExp `Generics.extQ` antiOptQualifiedExp `Generics.extQ` antiOptQualifiedAsExp `Generics.extQ` antiOptImpSpecExp `Generics.extQ` antiImpDeclExp `Generics.extQ` antiTopDeclsExp `Generics.extQ` antiTopDeclExp `Generics.extQ` antiDeclExp `Generics.extQ` antiOptContextExp `Generics.extQ` antiGenDeclExp `Generics.extQ` antiOptIntegerExp `Generics.extQ` antiOpsExp `Generics.extQ` antiFixityExp `Generics.extQ` antiFunLhsExp `Generics.extQ` antiPatExp `Generics.extQ` antiOptWhereExp `Generics.extQ` antiDeclListExp `Generics.extQ` antiDeclsExp `Generics.extQ` antiRhsExp `Generics.extQ` antiOptGdRhsExp `Generics.extQ` antiGdExp `Generics.extQ` antiOptExpTypeSignatureExp `Generics.extQ` antiExpExp `Generics.extQ` antiExpIExp `Generics.extQ` antiGdRhsExp `Generics.extQ` antiConstrsExp `Generics.extQ` antiConstrExp `Generics.extQ` antiFieldDeclListExp `Generics.extQ` antiFieldDeclExp `Generics.extQ` antiVarsExp `Generics.extQ` antiOptDerivingExp `Generics.extQ` antiDerivingExp `Generics.extQ` antiDClassListExp `Generics.extQ` antiDClassExp `Generics.extQ` antiContextExp `Generics.extQ` antiClassListExp `Generics.extQ` antiClassExp `Generics.extQ` antiTypeExp `Generics.extQ` antiBTypeExp `Generics.extQ` antiATypeExp `Generics.extQ` antiGTyConExp `Generics.extQ` antiTypeListExp `Generics.extQ` antiSimpleTypeExp `Generics.extQ` antiTyVarExp `Generics.extQ` antiTyConExp `Generics.extQ` antiModIdExp `Generics.extQ` antiTyClsExp `Generics.extQ` antiOpExp `Generics.extQ` antiQOpExp) expr +quoteHaskellPat :: Data.Data a => String -> (Haskell -> a) -> String -> TH.PatQ +quoteHaskellPat dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseHaskell of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToPatQ (const Nothing `Generics.extQ` rtkPosWildPat `Generics.extQ` antiHaskellPat `Generics.extQ` antiModulePat `Generics.extQ` antiExportsOptPat `Generics.extQ` antiExportsListPat `Generics.extQ` antiExportPat `Generics.extQ` antiBodyPat `Generics.extQ` antiImpDeclListPat `Generics.extQ` antiImportListPat `Generics.extQ` antiVarPat `Generics.extQ` antiConPat `Generics.extQ` antiRule_12Pat `Generics.extQ` antiQVarIdPat `Generics.extQ` antiQVarPat `Generics.extQ` antiQTyClsPat `Generics.extQ` antiQTyConPat `Generics.extQ` antiCNamePat `Generics.extQ` antiCNameListPat `Generics.extQ` antiQVarListPat `Generics.extQ` antiImportPat `Generics.extQ` antiOptQualifiedPat `Generics.extQ` antiOptQualifiedAsPat `Generics.extQ` antiOptImpSpecPat `Generics.extQ` antiImpDeclPat `Generics.extQ` antiTopDeclsPat `Generics.extQ` antiTopDeclPat `Generics.extQ` antiDeclPat `Generics.extQ` antiOptContextPat `Generics.extQ` antiGenDeclPat `Generics.extQ` antiOptIntegerPat `Generics.extQ` antiOpsPat `Generics.extQ` antiFixityPat `Generics.extQ` antiFunLhsPat `Generics.extQ` antiPatPat `Generics.extQ` antiOptWherePat `Generics.extQ` antiDeclListPat `Generics.extQ` antiDeclsPat `Generics.extQ` antiRhsPat `Generics.extQ` antiOptGdRhsPat `Generics.extQ` antiGdPat `Generics.extQ` antiOptExpTypeSignaturePat `Generics.extQ` antiExpPat `Generics.extQ` antiExpIPat `Generics.extQ` antiGdRhsPat `Generics.extQ` antiConstrsPat `Generics.extQ` antiConstrPat `Generics.extQ` antiFieldDeclListPat `Generics.extQ` antiFieldDeclPat `Generics.extQ` antiVarsPat `Generics.extQ` antiOptDerivingPat `Generics.extQ` antiDerivingPat `Generics.extQ` antiDClassListPat `Generics.extQ` antiDClassPat `Generics.extQ` antiContextPat `Generics.extQ` antiClassListPat `Generics.extQ` antiClassPat `Generics.extQ` antiTypePat `Generics.extQ` antiBTypePat `Generics.extQ` antiATypePat `Generics.extQ` antiGTyConPat `Generics.extQ` antiTypeListPat `Generics.extQ` antiSimpleTypePat `Generics.extQ` antiTyVarPat `Generics.extQ` antiTyConPat `Generics.extQ` antiModIdPat `Generics.extQ` antiTyClsPat `Generics.extQ` antiOpPat `Generics.extQ` antiQOpPat) expr + +antiQOpExp :: QOp -> Maybe (TH.Q TH.Exp ) +antiQOpExp ( Anti_QOp v) = Just $ TH.varE (TH.mkName v) +antiQOpExp _ = Nothing + + +antiOpExp :: Op -> Maybe (TH.Q TH.Exp ) +antiOpExp ( Anti_Op v) = Just $ TH.varE (TH.mkName v) +antiOpExp _ = Nothing + + +antiTyClsExp :: TyCls -> Maybe (TH.Q TH.Exp ) +antiTyClsExp ( Anti_TyCls v) = Just $ TH.varE (TH.mkName v) +antiTyClsExp _ = Nothing + + +antiModIdExp :: ModId -> Maybe (TH.Q TH.Exp ) +antiModIdExp ( Anti_ModId v) = Just $ TH.varE (TH.mkName v) +antiModIdExp _ = Nothing + + +antiTyConExp :: TyCon -> Maybe (TH.Q TH.Exp ) +antiTyConExp ( Anti_TyCon v) = Just $ TH.varE (TH.mkName v) +antiTyConExp _ = Nothing + + +antiTyVarExp :: [ TyVar ] -> Maybe (TH.Q TH.Exp) +antiTyVarExp ((Anti_TyVar v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiHaskellExp `Generics.extQ` antiModuleExp `Generics.extQ` antiExportsOptExp `Generics.extQ` antiExportsListExp `Generics.extQ` antiExportExp `Generics.extQ` antiBodyExp `Generics.extQ` antiImpDeclListExp `Generics.extQ` antiImportListExp `Generics.extQ` antiVarExp `Generics.extQ` antiConExp `Generics.extQ` antiRule_12Exp `Generics.extQ` antiQVarIdExp `Generics.extQ` antiQVarExp `Generics.extQ` antiQTyClsExp `Generics.extQ` antiQTyConExp `Generics.extQ` antiCNameExp `Generics.extQ` antiCNameListExp `Generics.extQ` antiQVarListExp `Generics.extQ` antiImportExp `Generics.extQ` antiOptQualifiedExp `Generics.extQ` antiOptQualifiedAsExp `Generics.extQ` antiOptImpSpecExp `Generics.extQ` antiImpDeclExp `Generics.extQ` antiTopDeclsExp `Generics.extQ` antiTopDeclExp `Generics.extQ` antiDeclExp `Generics.extQ` antiOptContextExp `Generics.extQ` antiGenDeclExp `Generics.extQ` antiOptIntegerExp `Generics.extQ` antiOpsExp `Generics.extQ` antiFixityExp `Generics.extQ` antiFunLhsExp `Generics.extQ` antiPatExp `Generics.extQ` antiOptWhereExp `Generics.extQ` antiDeclListExp `Generics.extQ` antiDeclsExp `Generics.extQ` antiRhsExp `Generics.extQ` antiOptGdRhsExp `Generics.extQ` antiGdExp `Generics.extQ` antiOptExpTypeSignatureExp `Generics.extQ` antiExpExp `Generics.extQ` antiExpIExp `Generics.extQ` antiGdRhsExp `Generics.extQ` antiConstrsExp `Generics.extQ` antiConstrExp `Generics.extQ` antiFieldDeclListExp `Generics.extQ` antiFieldDeclExp `Generics.extQ` antiVarsExp `Generics.extQ` antiOptDerivingExp `Generics.extQ` antiDerivingExp `Generics.extQ` antiDClassListExp `Generics.extQ` antiDClassExp `Generics.extQ` antiContextExp `Generics.extQ` antiClassListExp `Generics.extQ` antiClassExp `Generics.extQ` antiTypeExp `Generics.extQ` antiBTypeExp `Generics.extQ` antiATypeExp `Generics.extQ` antiGTyConExp `Generics.extQ` antiTypeListExp `Generics.extQ` antiSimpleTypeExp `Generics.extQ` antiTyVarExp `Generics.extQ` antiTyConExp `Generics.extQ` antiModIdExp `Generics.extQ` antiTyClsExp `Generics.extQ` antiOpExp `Generics.extQ` antiQOpExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiTyVarExp _ = Nothing + + +antiSimpleTypeExp :: SimpleType -> Maybe (TH.Q TH.Exp ) +antiSimpleTypeExp ( Anti_SimpleType v) = Just $ TH.varE (TH.mkName v) +antiSimpleTypeExp _ = Nothing + + +antiTypeListExp :: TypeList -> Maybe (TH.Q TH.Exp ) +antiTypeListExp ( Anti_TypeList v) = Just $ TH.varE (TH.mkName v) +antiTypeListExp _ = Nothing + + +antiGTyConExp :: GTyCon -> Maybe (TH.Q TH.Exp ) +antiGTyConExp ( Anti_GTyCon v) = Just $ TH.varE (TH.mkName v) +antiGTyConExp _ = Nothing + + +antiATypeExp :: [ AType ] -> Maybe (TH.Q TH.Exp) +antiATypeExp ((Anti_AType v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiHaskellExp `Generics.extQ` antiModuleExp `Generics.extQ` antiExportsOptExp `Generics.extQ` antiExportsListExp `Generics.extQ` antiExportExp `Generics.extQ` antiBodyExp `Generics.extQ` antiImpDeclListExp `Generics.extQ` antiImportListExp `Generics.extQ` antiVarExp `Generics.extQ` antiConExp `Generics.extQ` antiRule_12Exp `Generics.extQ` antiQVarIdExp `Generics.extQ` antiQVarExp `Generics.extQ` antiQTyClsExp `Generics.extQ` antiQTyConExp `Generics.extQ` antiCNameExp `Generics.extQ` antiCNameListExp `Generics.extQ` antiQVarListExp `Generics.extQ` antiImportExp `Generics.extQ` antiOptQualifiedExp `Generics.extQ` antiOptQualifiedAsExp `Generics.extQ` antiOptImpSpecExp `Generics.extQ` antiImpDeclExp `Generics.extQ` antiTopDeclsExp `Generics.extQ` antiTopDeclExp `Generics.extQ` antiDeclExp `Generics.extQ` antiOptContextExp `Generics.extQ` antiGenDeclExp `Generics.extQ` antiOptIntegerExp `Generics.extQ` antiOpsExp `Generics.extQ` antiFixityExp `Generics.extQ` antiFunLhsExp `Generics.extQ` antiPatExp `Generics.extQ` antiOptWhereExp `Generics.extQ` antiDeclListExp `Generics.extQ` antiDeclsExp `Generics.extQ` antiRhsExp `Generics.extQ` antiOptGdRhsExp `Generics.extQ` antiGdExp `Generics.extQ` antiOptExpTypeSignatureExp `Generics.extQ` antiExpExp `Generics.extQ` antiExpIExp `Generics.extQ` antiGdRhsExp `Generics.extQ` antiConstrsExp `Generics.extQ` antiConstrExp `Generics.extQ` antiFieldDeclListExp `Generics.extQ` antiFieldDeclExp `Generics.extQ` antiVarsExp `Generics.extQ` antiOptDerivingExp `Generics.extQ` antiDerivingExp `Generics.extQ` antiDClassListExp `Generics.extQ` antiDClassExp `Generics.extQ` antiContextExp `Generics.extQ` antiClassListExp `Generics.extQ` antiClassExp `Generics.extQ` antiTypeExp `Generics.extQ` antiBTypeExp `Generics.extQ` antiATypeExp `Generics.extQ` antiGTyConExp `Generics.extQ` antiTypeListExp `Generics.extQ` antiSimpleTypeExp `Generics.extQ` antiTyVarExp `Generics.extQ` antiTyConExp `Generics.extQ` antiModIdExp `Generics.extQ` antiTyClsExp `Generics.extQ` antiOpExp `Generics.extQ` antiQOpExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiATypeExp _ = Nothing + + +antiBTypeExp :: BType -> Maybe (TH.Q TH.Exp ) +antiBTypeExp ( Anti_BType v) = Just $ TH.varE (TH.mkName v) +antiBTypeExp _ = Nothing + + +antiTypeExp :: Type -> Maybe (TH.Q TH.Exp ) +antiTypeExp ( Anti_Type v) = Just $ TH.varE (TH.mkName v) +antiTypeExp _ = Nothing + + +antiClassExp :: Class -> Maybe (TH.Q TH.Exp ) +antiClassExp ( Anti_Class v) = Just $ TH.varE (TH.mkName v) +antiClassExp _ = Nothing + + +antiClassListExp :: ClassList -> Maybe (TH.Q TH.Exp ) +antiClassListExp ( Anti_ClassList v) = Just $ TH.varE (TH.mkName v) +antiClassListExp _ = Nothing + + +antiContextExp :: Context -> Maybe (TH.Q TH.Exp ) +antiContextExp ( Anti_Context v) = Just $ TH.varE (TH.mkName v) +antiContextExp _ = Nothing + + +antiDClassExp :: DClass -> Maybe (TH.Q TH.Exp ) +antiDClassExp ( Anti_DClass v) = Just $ TH.varE (TH.mkName v) +antiDClassExp _ = Nothing + + +antiDClassListExp :: DClassList -> Maybe (TH.Q TH.Exp ) +antiDClassListExp ( Anti_DClassList v) = Just $ TH.varE (TH.mkName v) +antiDClassListExp _ = Nothing + + +antiDerivingExp :: Deriving -> Maybe (TH.Q TH.Exp ) +antiDerivingExp ( Anti_Deriving v) = Just $ TH.varE (TH.mkName v) +antiDerivingExp _ = Nothing + + +antiOptDerivingExp :: OptDeriving -> Maybe (TH.Q TH.Exp ) +antiOptDerivingExp ( Anti_OptDeriving v) = Just $ TH.varE (TH.mkName v) +antiOptDerivingExp _ = Nothing + + +antiVarsExp :: Vars -> Maybe (TH.Q TH.Exp ) +antiVarsExp ( Anti_Vars v) = Just $ TH.varE (TH.mkName v) +antiVarsExp _ = Nothing + + +antiFieldDeclExp :: FieldDecl -> Maybe (TH.Q TH.Exp ) +antiFieldDeclExp ( Anti_FieldDecl v) = Just $ TH.varE (TH.mkName v) +antiFieldDeclExp _ = Nothing + + +antiFieldDeclListExp :: FieldDeclList -> Maybe (TH.Q TH.Exp ) +antiFieldDeclListExp ( Anti_FieldDeclList v) = Just $ TH.varE (TH.mkName v) +antiFieldDeclListExp _ = Nothing + + +antiConstrExp :: Constr -> Maybe (TH.Q TH.Exp ) +antiConstrExp ( Anti_Constr v) = Just $ TH.varE (TH.mkName v) +antiConstrExp _ = Nothing + + +antiConstrsExp :: Constrs -> Maybe (TH.Q TH.Exp ) +antiConstrsExp ( Anti_Constrs v) = Just $ TH.varE (TH.mkName v) +antiConstrsExp _ = Nothing + + +antiGdRhsExp :: GdRhs -> Maybe (TH.Q TH.Exp ) +antiGdRhsExp ( Anti_GdRhs v) = Just $ TH.varE (TH.mkName v) +antiGdRhsExp _ = Nothing + + +antiExpIExp :: ExpI -> Maybe (TH.Q TH.Exp ) +antiExpIExp ( Anti_ExpI v) = Just $ TH.varE (TH.mkName v) +antiExpIExp _ = Nothing + + +antiExpExp :: Exp -> Maybe (TH.Q TH.Exp ) +antiExpExp ( Anti_Exp v) = Just $ TH.varE (TH.mkName v) +antiExpExp _ = Nothing + + +antiOptExpTypeSignatureExp :: OptExpTypeSignature -> Maybe (TH.Q TH.Exp ) +antiOptExpTypeSignatureExp ( Anti_OptExpTypeSignature v) = Just $ TH.varE (TH.mkName v) +antiOptExpTypeSignatureExp _ = Nothing + + +antiGdExp :: Gd -> Maybe (TH.Q TH.Exp ) +antiGdExp ( Anti_Gd v) = Just $ TH.varE (TH.mkName v) +antiGdExp _ = Nothing + + +antiOptGdRhsExp :: OptGdRhs -> Maybe (TH.Q TH.Exp ) +antiOptGdRhsExp ( Anti_OptGdRhs v) = Just $ TH.varE (TH.mkName v) +antiOptGdRhsExp _ = Nothing + + +antiRhsExp :: Rhs -> Maybe (TH.Q TH.Exp ) +antiRhsExp ( Anti_Rhs v) = Just $ TH.varE (TH.mkName v) +antiRhsExp _ = Nothing + + +antiDeclsExp :: Decls -> Maybe (TH.Q TH.Exp ) +antiDeclsExp ( Anti_Decls v) = Just $ TH.varE (TH.mkName v) +antiDeclsExp _ = Nothing + + +antiDeclListExp :: DeclList -> Maybe (TH.Q TH.Exp ) +antiDeclListExp ( Anti_DeclList v) = Just $ TH.varE (TH.mkName v) +antiDeclListExp _ = Nothing + + +antiOptWhereExp :: OptWhere -> Maybe (TH.Q TH.Exp ) +antiOptWhereExp ( Anti_OptWhere v) = Just $ TH.varE (TH.mkName v) +antiOptWhereExp _ = Nothing + + +antiPatExp :: Pat -> Maybe (TH.Q TH.Exp ) +antiPatExp ( Anti_Pat v) = Just $ TH.varE (TH.mkName v) +antiPatExp _ = Nothing + + +antiFunLhsExp :: FunLhs -> Maybe (TH.Q TH.Exp ) +antiFunLhsExp ( Anti_FunLhs v) = Just $ TH.varE (TH.mkName v) +antiFunLhsExp _ = Nothing + + +antiFixityExp :: Fixity -> Maybe (TH.Q TH.Exp ) +antiFixityExp ( Anti_Fixity v) = Just $ TH.varE (TH.mkName v) +antiFixityExp _ = Nothing + + +antiOpsExp :: Ops -> Maybe (TH.Q TH.Exp ) +antiOpsExp ( Anti_Ops v) = Just $ TH.varE (TH.mkName v) +antiOpsExp _ = Nothing + + +antiOptIntegerExp :: OptInteger -> Maybe (TH.Q TH.Exp ) +antiOptIntegerExp ( Anti_OptInteger v) = Just $ TH.varE (TH.mkName v) +antiOptIntegerExp _ = Nothing + + +antiGenDeclExp :: GenDecl -> Maybe (TH.Q TH.Exp ) +antiGenDeclExp ( Anti_GenDecl v) = Just $ TH.varE (TH.mkName v) +antiGenDeclExp _ = Nothing + + +antiOptContextExp :: OptContext -> Maybe (TH.Q TH.Exp ) +antiOptContextExp ( Anti_OptContext v) = Just $ TH.varE (TH.mkName v) +antiOptContextExp _ = Nothing + + +antiDeclExp :: Decl -> Maybe (TH.Q TH.Exp ) +antiDeclExp ( Anti_Decl v) = Just $ TH.varE (TH.mkName v) +antiDeclExp _ = Nothing + + +antiTopDeclExp :: TopDecl -> Maybe (TH.Q TH.Exp ) +antiTopDeclExp ( Anti_TopDecl v) = Just $ TH.varE (TH.mkName v) +antiTopDeclExp _ = Nothing + + +antiTopDeclsExp :: TopDecls -> Maybe (TH.Q TH.Exp ) +antiTopDeclsExp ( Anti_TopDecls v) = Just $ TH.varE (TH.mkName v) +antiTopDeclsExp _ = Nothing + + +antiImpDeclExp :: ImpDecl -> Maybe (TH.Q TH.Exp ) +antiImpDeclExp ( Anti_ImpDecl v) = Just $ TH.varE (TH.mkName v) +antiImpDeclExp _ = Nothing + + +antiOptImpSpecExp :: OptImpSpec -> Maybe (TH.Q TH.Exp ) +antiOptImpSpecExp ( Anti_OptImpSpec v) = Just $ TH.varE (TH.mkName v) +antiOptImpSpecExp _ = Nothing + + +antiOptQualifiedAsExp :: OptQualifiedAs -> Maybe (TH.Q TH.Exp ) +antiOptQualifiedAsExp ( Anti_OptQualifiedAs v) = Just $ TH.varE (TH.mkName v) +antiOptQualifiedAsExp _ = Nothing + + +antiOptQualifiedExp :: OptQualified -> Maybe (TH.Q TH.Exp ) +antiOptQualifiedExp ( Anti_OptQualified v) = Just $ TH.varE (TH.mkName v) +antiOptQualifiedExp _ = Nothing + + +antiImportExp :: Import -> Maybe (TH.Q TH.Exp ) +antiImportExp ( Anti_Import v) = Just $ TH.varE (TH.mkName v) +antiImportExp _ = Nothing + + +antiQVarListExp :: QVarList -> Maybe (TH.Q TH.Exp ) +antiQVarListExp ( Anti_QVarList v) = Just $ TH.varE (TH.mkName v) +antiQVarListExp _ = Nothing + + +antiCNameListExp :: CNameList -> Maybe (TH.Q TH.Exp ) +antiCNameListExp ( Anti_CNameList v) = Just $ TH.varE (TH.mkName v) +antiCNameListExp _ = Nothing + + +antiCNameExp :: CName -> Maybe (TH.Q TH.Exp ) +antiCNameExp ( Anti_CName v) = Just $ TH.varE (TH.mkName v) +antiCNameExp _ = Nothing + + +antiQTyConExp :: QTyCon -> Maybe (TH.Q TH.Exp ) +antiQTyConExp ( Anti_QTyCon v) = Just $ TH.varE (TH.mkName v) +antiQTyConExp _ = Nothing + + +antiQTyClsExp :: QTyCls -> Maybe (TH.Q TH.Exp ) +antiQTyClsExp ( Anti_QTyCls v) = Just $ TH.varE (TH.mkName v) +antiQTyClsExp _ = Nothing + + +antiQVarExp :: QVar -> Maybe (TH.Q TH.Exp ) +antiQVarExp ( Anti_QVar v) = Just $ TH.varE (TH.mkName v) +antiQVarExp _ = Nothing + + +antiQVarIdExp :: QVarId -> Maybe (TH.Q TH.Exp ) +antiQVarIdExp ( Anti_QVarId v) = Just $ TH.varE (TH.mkName v) +antiQVarIdExp _ = Nothing + + +antiRule_12Exp :: [ Rule_12 ] -> Maybe (TH.Q TH.Exp) +antiRule_12Exp ((Anti_Rule_12 v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiHaskellExp `Generics.extQ` antiModuleExp `Generics.extQ` antiExportsOptExp `Generics.extQ` antiExportsListExp `Generics.extQ` antiExportExp `Generics.extQ` antiBodyExp `Generics.extQ` antiImpDeclListExp `Generics.extQ` antiImportListExp `Generics.extQ` antiVarExp `Generics.extQ` antiConExp `Generics.extQ` antiRule_12Exp `Generics.extQ` antiQVarIdExp `Generics.extQ` antiQVarExp `Generics.extQ` antiQTyClsExp `Generics.extQ` antiQTyConExp `Generics.extQ` antiCNameExp `Generics.extQ` antiCNameListExp `Generics.extQ` antiQVarListExp `Generics.extQ` antiImportExp `Generics.extQ` antiOptQualifiedExp `Generics.extQ` antiOptQualifiedAsExp `Generics.extQ` antiOptImpSpecExp `Generics.extQ` antiImpDeclExp `Generics.extQ` antiTopDeclsExp `Generics.extQ` antiTopDeclExp `Generics.extQ` antiDeclExp `Generics.extQ` antiOptContextExp `Generics.extQ` antiGenDeclExp `Generics.extQ` antiOptIntegerExp `Generics.extQ` antiOpsExp `Generics.extQ` antiFixityExp `Generics.extQ` antiFunLhsExp `Generics.extQ` antiPatExp `Generics.extQ` antiOptWhereExp `Generics.extQ` antiDeclListExp `Generics.extQ` antiDeclsExp `Generics.extQ` antiRhsExp `Generics.extQ` antiOptGdRhsExp `Generics.extQ` antiGdExp `Generics.extQ` antiOptExpTypeSignatureExp `Generics.extQ` antiExpExp `Generics.extQ` antiExpIExp `Generics.extQ` antiGdRhsExp `Generics.extQ` antiConstrsExp `Generics.extQ` antiConstrExp `Generics.extQ` antiFieldDeclListExp `Generics.extQ` antiFieldDeclExp `Generics.extQ` antiVarsExp `Generics.extQ` antiOptDerivingExp `Generics.extQ` antiDerivingExp `Generics.extQ` antiDClassListExp `Generics.extQ` antiDClassExp `Generics.extQ` antiContextExp `Generics.extQ` antiClassListExp `Generics.extQ` antiClassExp `Generics.extQ` antiTypeExp `Generics.extQ` antiBTypeExp `Generics.extQ` antiATypeExp `Generics.extQ` antiGTyConExp `Generics.extQ` antiTypeListExp `Generics.extQ` antiSimpleTypeExp `Generics.extQ` antiTyVarExp `Generics.extQ` antiTyConExp `Generics.extQ` antiModIdExp `Generics.extQ` antiTyClsExp `Generics.extQ` antiOpExp `Generics.extQ` antiQOpExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiRule_12Exp _ = Nothing + + +antiConExp :: Con -> Maybe (TH.Q TH.Exp ) +antiConExp ( Anti_Con v) = Just $ TH.varE (TH.mkName v) +antiConExp _ = Nothing + + +antiVarExp :: Var -> Maybe (TH.Q TH.Exp ) +antiVarExp ( Anti_Var v) = Just $ TH.varE (TH.mkName v) +antiVarExp _ = Nothing + + +antiImportListExp :: ImportList -> Maybe (TH.Q TH.Exp ) +antiImportListExp ( Anti_ImportList v) = Just $ TH.varE (TH.mkName v) +antiImportListExp _ = Nothing + + +antiImpDeclListExp :: ImpDeclList -> Maybe (TH.Q TH.Exp ) +antiImpDeclListExp ( Anti_ImpDeclList v) = Just $ TH.varE (TH.mkName v) +antiImpDeclListExp _ = Nothing + + +antiBodyExp :: Body -> Maybe (TH.Q TH.Exp ) +antiBodyExp ( Anti_Body v) = Just $ TH.varE (TH.mkName v) +antiBodyExp _ = Nothing + + +antiExportExp :: Export -> Maybe (TH.Q TH.Exp ) +antiExportExp ( Anti_Export v) = Just $ TH.varE (TH.mkName v) +antiExportExp _ = Nothing + + +antiExportsListExp :: ExportsList -> Maybe (TH.Q TH.Exp ) +antiExportsListExp ( Anti_ExportsList v) = Just $ TH.varE (TH.mkName v) +antiExportsListExp _ = Nothing + + +antiExportsOptExp :: ExportsOpt -> Maybe (TH.Q TH.Exp ) +antiExportsOptExp ( Anti_ExportsOpt v) = Just $ TH.varE (TH.mkName v) +antiExportsOptExp _ = Nothing + + +antiModuleExp :: Module -> Maybe (TH.Q TH.Exp ) +antiModuleExp ( Anti_Module v) = Just $ TH.varE (TH.mkName v) +antiModuleExp _ = Nothing + + +antiHaskellExp :: Haskell -> Maybe (TH.Q TH.Exp ) +antiHaskellExp ( Anti_Haskell v) = Just $ TH.varE (TH.mkName v) +antiHaskellExp _ = Nothing + + + +antiQOpPat :: QOp -> Maybe (TH.Q TH.Pat ) +antiQOpPat ( Anti_QOp v) = Just $ TH.varP (TH.mkName v) +antiQOpPat _ = Nothing + + +antiOpPat :: Op -> Maybe (TH.Q TH.Pat ) +antiOpPat ( Anti_Op v) = Just $ TH.varP (TH.mkName v) +antiOpPat _ = Nothing + + +antiTyClsPat :: TyCls -> Maybe (TH.Q TH.Pat ) +antiTyClsPat ( Anti_TyCls v) = Just $ TH.varP (TH.mkName v) +antiTyClsPat _ = Nothing + + +antiModIdPat :: ModId -> Maybe (TH.Q TH.Pat ) +antiModIdPat ( Anti_ModId v) = Just $ TH.varP (TH.mkName v) +antiModIdPat _ = Nothing + + +antiTyConPat :: TyCon -> Maybe (TH.Q TH.Pat ) +antiTyConPat ( Anti_TyCon v) = Just $ TH.varP (TH.mkName v) +antiTyConPat _ = Nothing + + +antiTyVarPat :: [ TyVar ] -> Maybe (TH.Q TH.Pat) +antiTyVarPat [Anti_TyVar v] = Just $ TH.varP (TH.mkName v) +antiTyVarPat _ = Nothing + + +antiSimpleTypePat :: SimpleType -> Maybe (TH.Q TH.Pat ) +antiSimpleTypePat ( Anti_SimpleType v) = Just $ TH.varP (TH.mkName v) +antiSimpleTypePat _ = Nothing + + +antiTypeListPat :: TypeList -> Maybe (TH.Q TH.Pat ) +antiTypeListPat ( Anti_TypeList v) = Just $ TH.varP (TH.mkName v) +antiTypeListPat _ = Nothing + + +antiGTyConPat :: GTyCon -> Maybe (TH.Q TH.Pat ) +antiGTyConPat ( Anti_GTyCon v) = Just $ TH.varP (TH.mkName v) +antiGTyConPat _ = Nothing + + +antiATypePat :: [ AType ] -> Maybe (TH.Q TH.Pat) +antiATypePat [Anti_AType v] = Just $ TH.varP (TH.mkName v) +antiATypePat _ = Nothing + + +antiBTypePat :: BType -> Maybe (TH.Q TH.Pat ) +antiBTypePat ( Anti_BType v) = Just $ TH.varP (TH.mkName v) +antiBTypePat _ = Nothing + + +antiTypePat :: Type -> Maybe (TH.Q TH.Pat ) +antiTypePat ( Anti_Type v) = Just $ TH.varP (TH.mkName v) +antiTypePat _ = Nothing + + +antiClassPat :: Class -> Maybe (TH.Q TH.Pat ) +antiClassPat ( Anti_Class v) = Just $ TH.varP (TH.mkName v) +antiClassPat _ = Nothing + + +antiClassListPat :: ClassList -> Maybe (TH.Q TH.Pat ) +antiClassListPat ( Anti_ClassList v) = Just $ TH.varP (TH.mkName v) +antiClassListPat _ = Nothing + + +antiContextPat :: Context -> Maybe (TH.Q TH.Pat ) +antiContextPat ( Anti_Context v) = Just $ TH.varP (TH.mkName v) +antiContextPat _ = Nothing + + +antiDClassPat :: DClass -> Maybe (TH.Q TH.Pat ) +antiDClassPat ( Anti_DClass v) = Just $ TH.varP (TH.mkName v) +antiDClassPat _ = Nothing + + +antiDClassListPat :: DClassList -> Maybe (TH.Q TH.Pat ) +antiDClassListPat ( Anti_DClassList v) = Just $ TH.varP (TH.mkName v) +antiDClassListPat _ = Nothing + + +antiDerivingPat :: Deriving -> Maybe (TH.Q TH.Pat ) +antiDerivingPat ( Anti_Deriving v) = Just $ TH.varP (TH.mkName v) +antiDerivingPat _ = Nothing + + +antiOptDerivingPat :: OptDeriving -> Maybe (TH.Q TH.Pat ) +antiOptDerivingPat ( Anti_OptDeriving v) = Just $ TH.varP (TH.mkName v) +antiOptDerivingPat _ = Nothing + + +antiVarsPat :: Vars -> Maybe (TH.Q TH.Pat ) +antiVarsPat ( Anti_Vars v) = Just $ TH.varP (TH.mkName v) +antiVarsPat _ = Nothing + + +antiFieldDeclPat :: FieldDecl -> Maybe (TH.Q TH.Pat ) +antiFieldDeclPat ( Anti_FieldDecl v) = Just $ TH.varP (TH.mkName v) +antiFieldDeclPat _ = Nothing + + +antiFieldDeclListPat :: FieldDeclList -> Maybe (TH.Q TH.Pat ) +antiFieldDeclListPat ( Anti_FieldDeclList v) = Just $ TH.varP (TH.mkName v) +antiFieldDeclListPat _ = Nothing + + +antiConstrPat :: Constr -> Maybe (TH.Q TH.Pat ) +antiConstrPat ( Anti_Constr v) = Just $ TH.varP (TH.mkName v) +antiConstrPat _ = Nothing + + +antiConstrsPat :: Constrs -> Maybe (TH.Q TH.Pat ) +antiConstrsPat ( Anti_Constrs v) = Just $ TH.varP (TH.mkName v) +antiConstrsPat _ = Nothing + + +antiGdRhsPat :: GdRhs -> Maybe (TH.Q TH.Pat ) +antiGdRhsPat ( Anti_GdRhs v) = Just $ TH.varP (TH.mkName v) +antiGdRhsPat _ = Nothing + + +antiExpIPat :: ExpI -> Maybe (TH.Q TH.Pat ) +antiExpIPat ( Anti_ExpI v) = Just $ TH.varP (TH.mkName v) +antiExpIPat _ = Nothing + + +antiExpPat :: Exp -> Maybe (TH.Q TH.Pat ) +antiExpPat ( Anti_Exp v) = Just $ TH.varP (TH.mkName v) +antiExpPat _ = Nothing + + +antiOptExpTypeSignaturePat :: OptExpTypeSignature -> Maybe (TH.Q TH.Pat ) +antiOptExpTypeSignaturePat ( Anti_OptExpTypeSignature v) = Just $ TH.varP (TH.mkName v) +antiOptExpTypeSignaturePat _ = Nothing + + +antiGdPat :: Gd -> Maybe (TH.Q TH.Pat ) +antiGdPat ( Anti_Gd v) = Just $ TH.varP (TH.mkName v) +antiGdPat _ = Nothing + + +antiOptGdRhsPat :: OptGdRhs -> Maybe (TH.Q TH.Pat ) +antiOptGdRhsPat ( Anti_OptGdRhs v) = Just $ TH.varP (TH.mkName v) +antiOptGdRhsPat _ = Nothing + + +antiRhsPat :: Rhs -> Maybe (TH.Q TH.Pat ) +antiRhsPat ( Anti_Rhs v) = Just $ TH.varP (TH.mkName v) +antiRhsPat _ = Nothing + + +antiDeclsPat :: Decls -> Maybe (TH.Q TH.Pat ) +antiDeclsPat ( Anti_Decls v) = Just $ TH.varP (TH.mkName v) +antiDeclsPat _ = Nothing + + +antiDeclListPat :: DeclList -> Maybe (TH.Q TH.Pat ) +antiDeclListPat ( Anti_DeclList v) = Just $ TH.varP (TH.mkName v) +antiDeclListPat _ = Nothing + + +antiOptWherePat :: OptWhere -> Maybe (TH.Q TH.Pat ) +antiOptWherePat ( Anti_OptWhere v) = Just $ TH.varP (TH.mkName v) +antiOptWherePat _ = Nothing + + +antiPatPat :: Pat -> Maybe (TH.Q TH.Pat ) +antiPatPat ( Anti_Pat v) = Just $ TH.varP (TH.mkName v) +antiPatPat _ = Nothing + + +antiFunLhsPat :: FunLhs -> Maybe (TH.Q TH.Pat ) +antiFunLhsPat ( Anti_FunLhs v) = Just $ TH.varP (TH.mkName v) +antiFunLhsPat _ = Nothing + + +antiFixityPat :: Fixity -> Maybe (TH.Q TH.Pat ) +antiFixityPat ( Anti_Fixity v) = Just $ TH.varP (TH.mkName v) +antiFixityPat _ = Nothing + + +antiOpsPat :: Ops -> Maybe (TH.Q TH.Pat ) +antiOpsPat ( Anti_Ops v) = Just $ TH.varP (TH.mkName v) +antiOpsPat _ = Nothing + + +antiOptIntegerPat :: OptInteger -> Maybe (TH.Q TH.Pat ) +antiOptIntegerPat ( Anti_OptInteger v) = Just $ TH.varP (TH.mkName v) +antiOptIntegerPat _ = Nothing + + +antiGenDeclPat :: GenDecl -> Maybe (TH.Q TH.Pat ) +antiGenDeclPat ( Anti_GenDecl v) = Just $ TH.varP (TH.mkName v) +antiGenDeclPat _ = Nothing + + +antiOptContextPat :: OptContext -> Maybe (TH.Q TH.Pat ) +antiOptContextPat ( Anti_OptContext v) = Just $ TH.varP (TH.mkName v) +antiOptContextPat _ = Nothing + + +antiDeclPat :: Decl -> Maybe (TH.Q TH.Pat ) +antiDeclPat ( Anti_Decl v) = Just $ TH.varP (TH.mkName v) +antiDeclPat _ = Nothing + + +antiTopDeclPat :: TopDecl -> Maybe (TH.Q TH.Pat ) +antiTopDeclPat ( Anti_TopDecl v) = Just $ TH.varP (TH.mkName v) +antiTopDeclPat _ = Nothing + + +antiTopDeclsPat :: TopDecls -> Maybe (TH.Q TH.Pat ) +antiTopDeclsPat ( Anti_TopDecls v) = Just $ TH.varP (TH.mkName v) +antiTopDeclsPat _ = Nothing + + +antiImpDeclPat :: ImpDecl -> Maybe (TH.Q TH.Pat ) +antiImpDeclPat ( Anti_ImpDecl v) = Just $ TH.varP (TH.mkName v) +antiImpDeclPat _ = Nothing + + +antiOptImpSpecPat :: OptImpSpec -> Maybe (TH.Q TH.Pat ) +antiOptImpSpecPat ( Anti_OptImpSpec v) = Just $ TH.varP (TH.mkName v) +antiOptImpSpecPat _ = Nothing + + +antiOptQualifiedAsPat :: OptQualifiedAs -> Maybe (TH.Q TH.Pat ) +antiOptQualifiedAsPat ( Anti_OptQualifiedAs v) = Just $ TH.varP (TH.mkName v) +antiOptQualifiedAsPat _ = Nothing + + +antiOptQualifiedPat :: OptQualified -> Maybe (TH.Q TH.Pat ) +antiOptQualifiedPat ( Anti_OptQualified v) = Just $ TH.varP (TH.mkName v) +antiOptQualifiedPat _ = Nothing + + +antiImportPat :: Import -> Maybe (TH.Q TH.Pat ) +antiImportPat ( Anti_Import v) = Just $ TH.varP (TH.mkName v) +antiImportPat _ = Nothing + + +antiQVarListPat :: QVarList -> Maybe (TH.Q TH.Pat ) +antiQVarListPat ( Anti_QVarList v) = Just $ TH.varP (TH.mkName v) +antiQVarListPat _ = Nothing + + +antiCNameListPat :: CNameList -> Maybe (TH.Q TH.Pat ) +antiCNameListPat ( Anti_CNameList v) = Just $ TH.varP (TH.mkName v) +antiCNameListPat _ = Nothing + + +antiCNamePat :: CName -> Maybe (TH.Q TH.Pat ) +antiCNamePat ( Anti_CName v) = Just $ TH.varP (TH.mkName v) +antiCNamePat _ = Nothing + + +antiQTyConPat :: QTyCon -> Maybe (TH.Q TH.Pat ) +antiQTyConPat ( Anti_QTyCon v) = Just $ TH.varP (TH.mkName v) +antiQTyConPat _ = Nothing + + +antiQTyClsPat :: QTyCls -> Maybe (TH.Q TH.Pat ) +antiQTyClsPat ( Anti_QTyCls v) = Just $ TH.varP (TH.mkName v) +antiQTyClsPat _ = Nothing + + +antiQVarPat :: QVar -> Maybe (TH.Q TH.Pat ) +antiQVarPat ( Anti_QVar v) = Just $ TH.varP (TH.mkName v) +antiQVarPat _ = Nothing + + +antiQVarIdPat :: QVarId -> Maybe (TH.Q TH.Pat ) +antiQVarIdPat ( Anti_QVarId v) = Just $ TH.varP (TH.mkName v) +antiQVarIdPat _ = Nothing + + +antiRule_12Pat :: [ Rule_12 ] -> Maybe (TH.Q TH.Pat) +antiRule_12Pat [Anti_Rule_12 v] = Just $ TH.varP (TH.mkName v) +antiRule_12Pat _ = Nothing + + +antiConPat :: Con -> Maybe (TH.Q TH.Pat ) +antiConPat ( Anti_Con v) = Just $ TH.varP (TH.mkName v) +antiConPat _ = Nothing + + +antiVarPat :: Var -> Maybe (TH.Q TH.Pat ) +antiVarPat ( Anti_Var v) = Just $ TH.varP (TH.mkName v) +antiVarPat _ = Nothing + + +antiImportListPat :: ImportList -> Maybe (TH.Q TH.Pat ) +antiImportListPat ( Anti_ImportList v) = Just $ TH.varP (TH.mkName v) +antiImportListPat _ = Nothing + + +antiImpDeclListPat :: ImpDeclList -> Maybe (TH.Q TH.Pat ) +antiImpDeclListPat ( Anti_ImpDeclList v) = Just $ TH.varP (TH.mkName v) +antiImpDeclListPat _ = Nothing + + +antiBodyPat :: Body -> Maybe (TH.Q TH.Pat ) +antiBodyPat ( Anti_Body v) = Just $ TH.varP (TH.mkName v) +antiBodyPat _ = Nothing + + +antiExportPat :: Export -> Maybe (TH.Q TH.Pat ) +antiExportPat ( Anti_Export v) = Just $ TH.varP (TH.mkName v) +antiExportPat _ = Nothing + + +antiExportsListPat :: ExportsList -> Maybe (TH.Q TH.Pat ) +antiExportsListPat ( Anti_ExportsList v) = Just $ TH.varP (TH.mkName v) +antiExportsListPat _ = Nothing + + +antiExportsOptPat :: ExportsOpt -> Maybe (TH.Q TH.Pat ) +antiExportsOptPat ( Anti_ExportsOpt v) = Just $ TH.varP (TH.mkName v) +antiExportsOptPat _ = Nothing + + +antiModulePat :: Module -> Maybe (TH.Q TH.Pat ) +antiModulePat ( Anti_Module v) = Just $ TH.varP (TH.mkName v) +antiModulePat _ = Nothing + + +antiHaskellPat :: Haskell -> Maybe (TH.Q TH.Pat ) +antiHaskellPat ( Anti_Haskell v) = Just $ TH.varP (TH.mkName v) +antiHaskellPat _ = Nothing + + + +-- This grammar's quasi-quoters work in expression and pattern contexts only +quoteHaskellType _ = fail "this quasi-quoter cannot be used in a type context" +quoteHaskellDecs _ = fail "this quasi-quoter cannot be used in a declaration context" + +getHaskell ( Ctr__Haskell__0 _ s) = s + +haskell :: QuasiQuoter +haskell = QuasiQuoter (quoteHaskellExp "tok_Haskell_dummy_112" getHaskell ) (quoteHaskellPat "tok_Haskell_dummy_112" getHaskell ) quoteHaskellType quoteHaskellDecs + +getAType ( Ctr__Haskell__1 _ s) = s + +aType :: QuasiQuoter +aType = QuasiQuoter (quoteHaskellExp "tok_AType_dummy_111" getAType ) (quoteHaskellPat "tok_AType_dummy_111" getAType ) quoteHaskellType quoteHaskellDecs + +getATypeList ( Ctr__Haskell__2 _ s) = s + +aTypeList :: QuasiQuoter +aTypeList = QuasiQuoter (quoteHaskellExp "tok_ATypeList_dummy_110" getATypeList ) (quoteHaskellPat "tok_ATypeList_dummy_110" getATypeList ) quoteHaskellType quoteHaskellDecs + +getBType ( Ctr__Haskell__3 _ s) = s + +bType :: QuasiQuoter +bType = QuasiQuoter (quoteHaskellExp "tok_BType_dummy_109" getBType ) (quoteHaskellPat "tok_BType_dummy_109" getBType ) quoteHaskellType quoteHaskellDecs + +getBody ( Ctr__Haskell__4 _ s) = s + +body :: QuasiQuoter +body = QuasiQuoter (quoteHaskellExp "tok_Body_dummy_108" getBody ) (quoteHaskellPat "tok_Body_dummy_108" getBody ) quoteHaskellType quoteHaskellDecs + +getCName ( Ctr__Haskell__5 _ s) = s + +cName :: QuasiQuoter +cName = QuasiQuoter (quoteHaskellExp "tok_CName_dummy_107" getCName ) (quoteHaskellPat "tok_CName_dummy_107" getCName ) quoteHaskellType quoteHaskellDecs + +getCNameList ( Ctr__Haskell__6 _ s) = s + +cNameList :: QuasiQuoter +cNameList = QuasiQuoter (quoteHaskellExp "tok_CNameList_dummy_106" getCNameList ) (quoteHaskellPat "tok_CNameList_dummy_106" getCNameList ) quoteHaskellType quoteHaskellDecs + +getClass ( Ctr__Haskell__7 _ s) = s + +__class :: QuasiQuoter +__class = QuasiQuoter (quoteHaskellExp "tok_Class_dummy_105" getClass ) (quoteHaskellPat "tok_Class_dummy_105" getClass ) quoteHaskellType quoteHaskellDecs + +getClassList ( Ctr__Haskell__8 _ s) = s + +classList :: QuasiQuoter +classList = QuasiQuoter (quoteHaskellExp "tok_ClassList_dummy_104" getClassList ) (quoteHaskellPat "tok_ClassList_dummy_104" getClassList ) quoteHaskellType quoteHaskellDecs + +getCon ( Ctr__Haskell__9 _ s) = s + +con :: QuasiQuoter +con = QuasiQuoter (quoteHaskellExp "tok_Con_dummy_103" getCon ) (quoteHaskellPat "tok_Con_dummy_103" getCon ) quoteHaskellType quoteHaskellDecs + +getConstr ( Ctr__Haskell__10 _ s) = s + +constr :: QuasiQuoter +constr = QuasiQuoter (quoteHaskellExp "tok_Constr_dummy_102" getConstr ) (quoteHaskellPat "tok_Constr_dummy_102" getConstr ) quoteHaskellType quoteHaskellDecs + +getConstrs ( Ctr__Haskell__11 _ s) = s + +constrs :: QuasiQuoter +constrs = QuasiQuoter (quoteHaskellExp "tok_Constrs_dummy_101" getConstrs ) (quoteHaskellPat "tok_Constrs_dummy_101" getConstrs ) quoteHaskellType quoteHaskellDecs + +getContext ( Ctr__Haskell__12 _ s) = s + +context :: QuasiQuoter +context = QuasiQuoter (quoteHaskellExp "tok_Context_dummy_100" getContext ) (quoteHaskellPat "tok_Context_dummy_100" getContext ) quoteHaskellType quoteHaskellDecs + +getDClass ( Ctr__Haskell__13 _ s) = s + +dClass :: QuasiQuoter +dClass = QuasiQuoter (quoteHaskellExp "tok_DClass_dummy_99" getDClass ) (quoteHaskellPat "tok_DClass_dummy_99" getDClass ) quoteHaskellType quoteHaskellDecs + +getDClassList ( Ctr__Haskell__14 _ s) = s + +dClassList :: QuasiQuoter +dClassList = QuasiQuoter (quoteHaskellExp "tok_DClassList_dummy_98" getDClassList ) (quoteHaskellPat "tok_DClassList_dummy_98" getDClassList ) quoteHaskellType quoteHaskellDecs + +getDecl ( Ctr__Haskell__15 _ s) = s + +decl :: QuasiQuoter +decl = QuasiQuoter (quoteHaskellExp "tok_Decl_dummy_97" getDecl ) (quoteHaskellPat "tok_Decl_dummy_97" getDecl ) quoteHaskellType quoteHaskellDecs + +getDeclList ( Ctr__Haskell__16 _ s) = s + +declList :: QuasiQuoter +declList = QuasiQuoter (quoteHaskellExp "tok_DeclList_dummy_96" getDeclList ) (quoteHaskellPat "tok_DeclList_dummy_96" getDeclList ) quoteHaskellType quoteHaskellDecs + +getDecls ( Ctr__Haskell__17 _ s) = s + +decls :: QuasiQuoter +decls = QuasiQuoter (quoteHaskellExp "tok_Decls_dummy_95" getDecls ) (quoteHaskellPat "tok_Decls_dummy_95" getDecls ) quoteHaskellType quoteHaskellDecs + +getDeriving ( Ctr__Haskell__18 _ s) = s + +__deriving :: QuasiQuoter +__deriving = QuasiQuoter (quoteHaskellExp "tok_Deriving_dummy_94" getDeriving ) (quoteHaskellPat "tok_Deriving_dummy_94" getDeriving ) quoteHaskellType quoteHaskellDecs + +getExp ( Ctr__Haskell__19 _ s) = s + +exp :: QuasiQuoter +exp = QuasiQuoter (quoteHaskellExp "tok_Exp_dummy_93" getExp ) (quoteHaskellPat "tok_Exp_dummy_93" getExp ) quoteHaskellType quoteHaskellDecs + +getExpI ( Ctr__Haskell__20 _ s) = s + +expI :: QuasiQuoter +expI = QuasiQuoter (quoteHaskellExp "tok_ExpI_dummy_92" getExpI ) (quoteHaskellPat "tok_ExpI_dummy_92" getExpI ) quoteHaskellType quoteHaskellDecs + +getExport ( Ctr__Haskell__21 _ s) = s + +export :: QuasiQuoter +export = QuasiQuoter (quoteHaskellExp "tok_Export_dummy_91" getExport ) (quoteHaskellPat "tok_Export_dummy_91" getExport ) quoteHaskellType quoteHaskellDecs + +getExportsList ( Ctr__Haskell__22 _ s) = s + +exportsList :: QuasiQuoter +exportsList = QuasiQuoter (quoteHaskellExp "tok_ExportsList_dummy_90" getExportsList ) (quoteHaskellPat "tok_ExportsList_dummy_90" getExportsList ) quoteHaskellType quoteHaskellDecs + +getExportsOpt ( Ctr__Haskell__23 _ s) = s + +exportsOpt :: QuasiQuoter +exportsOpt = QuasiQuoter (quoteHaskellExp "tok_ExportsOpt_dummy_89" getExportsOpt ) (quoteHaskellPat "tok_ExportsOpt_dummy_89" getExportsOpt ) quoteHaskellType quoteHaskellDecs + +getFieldDecl ( Ctr__Haskell__24 _ s) = s + +fieldDecl :: QuasiQuoter +fieldDecl = QuasiQuoter (quoteHaskellExp "tok_FieldDecl_dummy_88" getFieldDecl ) (quoteHaskellPat "tok_FieldDecl_dummy_88" getFieldDecl ) quoteHaskellType quoteHaskellDecs + +getFieldDeclList ( Ctr__Haskell__25 _ s) = s + +fieldDeclList :: QuasiQuoter +fieldDeclList = QuasiQuoter (quoteHaskellExp "tok_FieldDeclList_dummy_87" getFieldDeclList ) (quoteHaskellPat "tok_FieldDeclList_dummy_87" getFieldDeclList ) quoteHaskellType quoteHaskellDecs + +getFixity ( Ctr__Haskell__26 _ s) = s + +fixity :: QuasiQuoter +fixity = QuasiQuoter (quoteHaskellExp "tok_Fixity_dummy_86" getFixity ) (quoteHaskellPat "tok_Fixity_dummy_86" getFixity ) quoteHaskellType quoteHaskellDecs + +getFunLhs ( Ctr__Haskell__27 _ s) = s + +funLhs :: QuasiQuoter +funLhs = QuasiQuoter (quoteHaskellExp "tok_FunLhs_dummy_85" getFunLhs ) (quoteHaskellPat "tok_FunLhs_dummy_85" getFunLhs ) quoteHaskellType quoteHaskellDecs + +getGTyCon ( Ctr__Haskell__28 _ s) = s + +gTyCon :: QuasiQuoter +gTyCon = QuasiQuoter (quoteHaskellExp "tok_GTyCon_dummy_84" getGTyCon ) (quoteHaskellPat "tok_GTyCon_dummy_84" getGTyCon ) quoteHaskellType quoteHaskellDecs + +getGd ( Ctr__Haskell__29 _ s) = s + +gd :: QuasiQuoter +gd = QuasiQuoter (quoteHaskellExp "tok_Gd_dummy_83" getGd ) (quoteHaskellPat "tok_Gd_dummy_83" getGd ) quoteHaskellType quoteHaskellDecs + +getGdRhs ( Ctr__Haskell__30 _ s) = s + +gdRhs :: QuasiQuoter +gdRhs = QuasiQuoter (quoteHaskellExp "tok_GdRhs_dummy_82" getGdRhs ) (quoteHaskellPat "tok_GdRhs_dummy_82" getGdRhs ) quoteHaskellType quoteHaskellDecs + +getGenDecl ( Ctr__Haskell__31 _ s) = s + +genDecl :: QuasiQuoter +genDecl = QuasiQuoter (quoteHaskellExp "tok_GenDecl_dummy_81" getGenDecl ) (quoteHaskellPat "tok_GenDecl_dummy_81" getGenDecl ) quoteHaskellType quoteHaskellDecs + +getImpDecl ( Ctr__Haskell__32 _ s) = s + +impDecl :: QuasiQuoter +impDecl = QuasiQuoter (quoteHaskellExp "tok_ImpDecl_dummy_80" getImpDecl ) (quoteHaskellPat "tok_ImpDecl_dummy_80" getImpDecl ) quoteHaskellType quoteHaskellDecs + +getImpDeclList ( Ctr__Haskell__33 _ s) = s + +impDeclList :: QuasiQuoter +impDeclList = QuasiQuoter (quoteHaskellExp "tok_ImpDeclList_dummy_79" getImpDeclList ) (quoteHaskellPat "tok_ImpDeclList_dummy_79" getImpDeclList ) quoteHaskellType quoteHaskellDecs + +getImport ( Ctr__Haskell__34 _ s) = s + +__import :: QuasiQuoter +__import = QuasiQuoter (quoteHaskellExp "tok_Import_dummy_78" getImport ) (quoteHaskellPat "tok_Import_dummy_78" getImport ) quoteHaskellType quoteHaskellDecs + +getImportList ( Ctr__Haskell__35 _ s) = s + +importList :: QuasiQuoter +importList = QuasiQuoter (quoteHaskellExp "tok_ImportList_dummy_77" getImportList ) (quoteHaskellPat "tok_ImportList_dummy_77" getImportList ) quoteHaskellType quoteHaskellDecs + +getModId ( Ctr__Haskell__36 _ s) = s + +modId :: QuasiQuoter +modId = QuasiQuoter (quoteHaskellExp "tok_ModId_dummy_76" getModId ) (quoteHaskellPat "tok_ModId_dummy_76" getModId ) quoteHaskellType quoteHaskellDecs + +getModIdList ( Ctr__Haskell__37 _ s) = s + +modIdList :: QuasiQuoter +modIdList = QuasiQuoter (quoteHaskellExp "tok_ModIdList_dummy_75" getModIdList ) (quoteHaskellPat "tok_ModIdList_dummy_75" getModIdList ) quoteHaskellType quoteHaskellDecs + +getModule ( Ctr__Haskell__38 _ s) = s + +__module :: QuasiQuoter +__module = QuasiQuoter (quoteHaskellExp "tok_Module_dummy_74" getModule ) (quoteHaskellPat "tok_Module_dummy_74" getModule ) quoteHaskellType quoteHaskellDecs + +getOp ( Ctr__Haskell__39 _ s) = s + +op :: QuasiQuoter +op = QuasiQuoter (quoteHaskellExp "tok_Op_dummy_73" getOp ) (quoteHaskellPat "tok_Op_dummy_73" getOp ) quoteHaskellType quoteHaskellDecs + +getOps ( Ctr__Haskell__40 _ s) = s + +ops :: QuasiQuoter +ops = QuasiQuoter (quoteHaskellExp "tok_Ops_dummy_72" getOps ) (quoteHaskellPat "tok_Ops_dummy_72" getOps ) quoteHaskellType quoteHaskellDecs + +getOptContext ( Ctr__Haskell__41 _ s) = s + +optContext :: QuasiQuoter +optContext = QuasiQuoter (quoteHaskellExp "tok_OptContext_dummy_71" getOptContext ) (quoteHaskellPat "tok_OptContext_dummy_71" getOptContext ) quoteHaskellType quoteHaskellDecs + +getOptDeriving ( Ctr__Haskell__42 _ s) = s + +optDeriving :: QuasiQuoter +optDeriving = QuasiQuoter (quoteHaskellExp "tok_OptDeriving_dummy_70" getOptDeriving ) (quoteHaskellPat "tok_OptDeriving_dummy_70" getOptDeriving ) quoteHaskellType quoteHaskellDecs + +getOptExpTypeSignature ( Ctr__Haskell__43 _ s) = s + +optExpTypeSignature :: QuasiQuoter +optExpTypeSignature = QuasiQuoter (quoteHaskellExp "tok_OptExpTypeSignature_dummy_69" getOptExpTypeSignature ) (quoteHaskellPat "tok_OptExpTypeSignature_dummy_69" getOptExpTypeSignature ) quoteHaskellType quoteHaskellDecs + +getOptGdRhs ( Ctr__Haskell__44 _ s) = s + +optGdRhs :: QuasiQuoter +optGdRhs = QuasiQuoter (quoteHaskellExp "tok_OptGdRhs_dummy_68" getOptGdRhs ) (quoteHaskellPat "tok_OptGdRhs_dummy_68" getOptGdRhs ) quoteHaskellType quoteHaskellDecs + +getOptImpSpec ( Ctr__Haskell__45 _ s) = s + +optImpSpec :: QuasiQuoter +optImpSpec = QuasiQuoter (quoteHaskellExp "tok_OptImpSpec_dummy_67" getOptImpSpec ) (quoteHaskellPat "tok_OptImpSpec_dummy_67" getOptImpSpec ) quoteHaskellType quoteHaskellDecs + +getOptInteger ( Ctr__Haskell__46 _ s) = s + +optInteger :: QuasiQuoter +optInteger = QuasiQuoter (quoteHaskellExp "tok_OptInteger_dummy_66" getOptInteger ) (quoteHaskellPat "tok_OptInteger_dummy_66" getOptInteger ) quoteHaskellType quoteHaskellDecs + +getOptQualified ( Ctr__Haskell__47 _ s) = s + +optQualified :: QuasiQuoter +optQualified = QuasiQuoter (quoteHaskellExp "tok_OptQualified_dummy_65" getOptQualified ) (quoteHaskellPat "tok_OptQualified_dummy_65" getOptQualified ) quoteHaskellType quoteHaskellDecs + +getOptQualifiedAs ( Ctr__Haskell__48 _ s) = s + +optQualifiedAs :: QuasiQuoter +optQualifiedAs = QuasiQuoter (quoteHaskellExp "tok_OptQualifiedAs_dummy_64" getOptQualifiedAs ) (quoteHaskellPat "tok_OptQualifiedAs_dummy_64" getOptQualifiedAs ) quoteHaskellType quoteHaskellDecs + +getOptWhere ( Ctr__Haskell__49 _ s) = s + +optWhere :: QuasiQuoter +optWhere = QuasiQuoter (quoteHaskellExp "tok_OptWhere_dummy_63" getOptWhere ) (quoteHaskellPat "tok_OptWhere_dummy_63" getOptWhere ) quoteHaskellType quoteHaskellDecs + +getPat ( Ctr__Haskell__50 _ s) = s + +pat :: QuasiQuoter +pat = QuasiQuoter (quoteHaskellExp "tok_Pat_dummy_62" getPat ) (quoteHaskellPat "tok_Pat_dummy_62" getPat ) quoteHaskellType quoteHaskellDecs + +getQOp ( Ctr__Haskell__51 _ s) = s + +qOp :: QuasiQuoter +qOp = QuasiQuoter (quoteHaskellExp "tok_QOp_dummy_61" getQOp ) (quoteHaskellPat "tok_QOp_dummy_61" getQOp ) quoteHaskellType quoteHaskellDecs + +getQTyCls ( Ctr__Haskell__52 _ s) = s + +qTyCls :: QuasiQuoter +qTyCls = QuasiQuoter (quoteHaskellExp "tok_QTyCls_dummy_60" getQTyCls ) (quoteHaskellPat "tok_QTyCls_dummy_60" getQTyCls ) quoteHaskellType quoteHaskellDecs + +getQTyCon ( Ctr__Haskell__53 _ s) = s + +qTyCon :: QuasiQuoter +qTyCon = QuasiQuoter (quoteHaskellExp "tok_QTyCon_dummy_59" getQTyCon ) (quoteHaskellPat "tok_QTyCon_dummy_59" getQTyCon ) quoteHaskellType quoteHaskellDecs + +getQVar ( Ctr__Haskell__54 _ s) = s + +qVar :: QuasiQuoter +qVar = QuasiQuoter (quoteHaskellExp "tok_QVar_dummy_58" getQVar ) (quoteHaskellPat "tok_QVar_dummy_58" getQVar ) quoteHaskellType quoteHaskellDecs + +getQVarId ( Ctr__Haskell__55 _ s) = s + +qVarId :: QuasiQuoter +qVarId = QuasiQuoter (quoteHaskellExp "tok_QVarId_dummy_57" getQVarId ) (quoteHaskellPat "tok_QVarId_dummy_57" getQVarId ) quoteHaskellType quoteHaskellDecs + +getQVarList ( Ctr__Haskell__56 _ s) = s + +qVarList :: QuasiQuoter +qVarList = QuasiQuoter (quoteHaskellExp "tok_QVarList_dummy_56" getQVarList ) (quoteHaskellPat "tok_QVarList_dummy_56" getQVarList ) quoteHaskellType quoteHaskellDecs + +getRhs ( Ctr__Haskell__57 _ s) = s + +rhs :: QuasiQuoter +rhs = QuasiQuoter (quoteHaskellExp "tok_Rhs_dummy_55" getRhs ) (quoteHaskellPat "tok_Rhs_dummy_55" getRhs ) quoteHaskellType quoteHaskellDecs + +getSimpleType ( Ctr__Haskell__58 _ s) = s + +simpleType :: QuasiQuoter +simpleType = QuasiQuoter (quoteHaskellExp "tok_SimpleType_dummy_54" getSimpleType ) (quoteHaskellPat "tok_SimpleType_dummy_54" getSimpleType ) quoteHaskellType quoteHaskellDecs + +getTopDecl ( Ctr__Haskell__59 _ s) = s + +topDecl :: QuasiQuoter +topDecl = QuasiQuoter (quoteHaskellExp "tok_TopDecl_dummy_53" getTopDecl ) (quoteHaskellPat "tok_TopDecl_dummy_53" getTopDecl ) quoteHaskellType quoteHaskellDecs + +getTopDecls ( Ctr__Haskell__60 _ s) = s + +topDecls :: QuasiQuoter +topDecls = QuasiQuoter (quoteHaskellExp "tok_TopDecls_dummy_52" getTopDecls ) (quoteHaskellPat "tok_TopDecls_dummy_52" getTopDecls ) quoteHaskellType quoteHaskellDecs + +getTyCls ( Ctr__Haskell__61 _ s) = s + +tyCls :: QuasiQuoter +tyCls = QuasiQuoter (quoteHaskellExp "tok_TyCls_dummy_51" getTyCls ) (quoteHaskellPat "tok_TyCls_dummy_51" getTyCls ) quoteHaskellType quoteHaskellDecs + +getTyCon ( Ctr__Haskell__62 _ s) = s + +tyCon :: QuasiQuoter +tyCon = QuasiQuoter (quoteHaskellExp "tok_TyCon_dummy_50" getTyCon ) (quoteHaskellPat "tok_TyCon_dummy_50" getTyCon ) quoteHaskellType quoteHaskellDecs + +getTyVar ( Ctr__Haskell__63 _ s) = s + +tyVar :: QuasiQuoter +tyVar = QuasiQuoter (quoteHaskellExp "tok_TyVar_dummy_49" getTyVar ) (quoteHaskellPat "tok_TyVar_dummy_49" getTyVar ) quoteHaskellType quoteHaskellDecs + +getTyVars ( Ctr__Haskell__64 _ s) = s + +tyVars :: QuasiQuoter +tyVars = QuasiQuoter (quoteHaskellExp "tok_TyVars_dummy_48" getTyVars ) (quoteHaskellPat "tok_TyVars_dummy_48" getTyVars ) quoteHaskellType quoteHaskellDecs + +getType ( Ctr__Haskell__65 _ s) = s + +__type :: QuasiQuoter +__type = QuasiQuoter (quoteHaskellExp "tok_Type_dummy_47" getType ) (quoteHaskellPat "tok_Type_dummy_47" getType ) quoteHaskellType quoteHaskellDecs + +getTypeList ( Ctr__Haskell__66 _ s) = s + +typeList :: QuasiQuoter +typeList = QuasiQuoter (quoteHaskellExp "tok_TypeList_dummy_46" getTypeList ) (quoteHaskellPat "tok_TypeList_dummy_46" getTypeList ) quoteHaskellType quoteHaskellDecs + +getVar ( Ctr__Haskell__67 _ s) = s + +var :: QuasiQuoter +var = QuasiQuoter (quoteHaskellExp "tok_Var_dummy_45" getVar ) (quoteHaskellPat "tok_Var_dummy_45" getVar ) quoteHaskellType quoteHaskellDecs + +getVars ( Ctr__Haskell__68 _ s) = s + +vars :: QuasiQuoter +vars = QuasiQuoter (quoteHaskellExp "tok_Vars_dummy_44" getVars ) (quoteHaskellPat "tok_Vars_dummy_44" getVars ) quoteHaskellType quoteHaskellDecs + diff --git a/test/golden/i14/I14Lexer.x b/test/golden/i14/I14Lexer.x new file mode 100644 --- /dev/null +++ b/test/golden/i14/I14Lexer.x @@ -0,0 +1,90 @@ +-- Generated by RTK from grammar 'I14'. Do not edit by hand. +{ +{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} +module I14Lexer(scanTokens, alexScanTokens, Token(..), PosToken(..), AlexPosn(..)) +where +import Data.Data (Data) + + } +%wrapper "monad" + + +tokens :- "tok_Items_dummy_3" { simple Tk__tok_Items_dummy_3 } + "tok_Label_dummy_2" { simple Tk__tok_Label_dummy_2 } + "tok_Shape_dummy_1" { simple Tk__tok_Shape_dummy_1 } + "tok_Start_dummy_4" { simple Tk__tok_Start_dummy_4 } + "square" { simple Tk__tok_square_1 } + "note" { simple Tk__tok_note_3 } + "circle" { simple Tk__tok_circle_0 } + "," { simple Tk__tok__coma__2 } + ([\ \t\n]+) ; + ([0-9]+) { simple1 $ Tk__num . (id) } + ("$" "Label" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Label . ((tail . dropWhile (/= ':'))) } + ("$" "Items" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Items . ((tail . dropWhile (/= ':'))) } + ("$" "Shape" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Shape . ((tail . dropWhile (/= ':'))) } + ("$" "Start" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Start . ((tail . dropWhile (/= ':'))) } + . { rtkError } + +{ +data Token = EndOfFile | + Tk__tok_Items_dummy_3 | + Tk__tok_Label_dummy_2 | + Tk__tok_Shape_dummy_1 | + Tk__tok_Start_dummy_4 | + Tk__tok_square_1 | + Tk__tok_note_3 | + Tk__tok_circle_0 | + Tk__tok__coma__2 | + Tk__num String | + Tk__qq_Label String | + Tk__qq_Items String | + Tk__qq_Shape String | + Tk__qq_Start String + deriving (Show) + +-- AlexPosn is defined by the alex wrapper, so the Data instance (required by +-- the parser's RtkPos position type) can only be attached via standalone +-- deriving - the same solution as the hand-written Lexer.x +deriving instance Data AlexPosn + +-- A token together with the source position where it starts +data PosToken = PosToken { ptPos :: AlexPosn, ptToken :: Token } + deriving (Show) + +alexEOF = do + (pos, _, _, _) <- alexGetInput + return $ PosToken pos EndOfFile + +-- Lex the input into a token stream, returning the positioned error message +-- on a lexical error (encoded as "LINE:COL:message", see rtkError below). +-- The returned list always ends with an EndOfFile token that carries the +-- position of the end of input, so parse errors at end of input can be +-- reported with a position too +scanTokens :: String -> Either String [PosToken] +scanTokens str = runAlex str $ do + let loop toks = do tok <- alexMonadScan + case tok of + PosToken _ EndOfFile -> return $ reverse (tok : toks) + _ -> let toks' = tok : toks + in toks' `seq` loop toks' + loop [] + +-- Thin compatibility wrapper: callers that have not switched to 'scanTokens' +-- get the error message thrown instead +alexScanTokens :: String -> [PosToken] +alexScanTokens str = + case scanTokens str of + Right toks -> toks + Left err -> errorWithoutStackTrace err + +simple1 :: (String -> Token) -> AlexInput -> Int -> Alex PosToken +simple1 t (pos, _, _, str) len = return $ PosToken pos (t (take len str)) + +simple :: Token -> AlexInput -> Int -> Alex PosToken +simple t (pos, _, _, _) len = return $ PosToken pos t + +-- Encode the position as "LINE:COL:message" so callers can split it back out +-- into a structured position - the same encoding the rtk grammar lexer uses +rtkError ((AlexPn _ line column), _, _, str) len = alexError $ (show line) ++ ":" ++ (show column) ++ ":lexical error. Following chars: " ++ (take 10 str) + +} diff --git a/test/golden/i14/I14Parser.y b/test/golden/i14/I14Parser.y new file mode 100644 --- /dev/null +++ b/test/golden/i14/I14Parser.y @@ -0,0 +1,164 @@ +-- Generated by RTK from grammar 'I14'. Do not edit by hand. +{ +{-# LANGUAGE DeriveDataTypeable #-} +module I14Parser where +import qualified Data.Generics as Gen +import qualified I14Lexer as L (Token(..), PosToken(..), AlexPosn(..), alexScanTokens) +} + +%name parseI14 +%tokentype { L.PosToken } +%monad { Either String } +%error { parseError } + +%token + +rtk__eof { L.PosToken _ L.EndOfFile } +tok_Items_dummy_3 { L.PosToken _ L.Tk__tok_Items_dummy_3 } +tok_Label_dummy_2 { L.PosToken _ L.Tk__tok_Label_dummy_2 } +tok_Shape_dummy_1 { L.PosToken _ L.Tk__tok_Shape_dummy_1 } +tok_Start_dummy_4 { L.PosToken _ L.Tk__tok_Start_dummy_4 } +tok_square_1 { L.PosToken _ L.Tk__tok_square_1 } +tok_note_3 { L.PosToken _ L.Tk__tok_note_3 } +tok_circle_0 { L.PosToken _ L.Tk__tok_circle_0 } +tok__coma__2 { L.PosToken _ L.Tk__tok__coma__2 } +num { L.PosToken _ (L.Tk__num _) } +qq_Label { L.PosToken _ (L.Tk__qq_Label _) } +qq_Items { L.PosToken _ (L.Tk__qq_Items _) } +qq_Shape { L.PosToken _ (L.Tk__qq_Shape _) } +qq_Start { L.PosToken _ (L.Tk__qq_Start _) } + +%% + +I14__top : Start rtk__eof { $1 } + +Start : tok_Start_dummy_4 Start tok_Start_dummy_4 { Ctr__Start__0 (rtkPosOf $1) $2 } | + tok_Items_dummy_3 Items tok_Items_dummy_3 { Ctr__Start__1 (rtkPosOf $1) (reverse $2) } | + tok_Label_dummy_2 Label tok_Label_dummy_2 { Ctr__Start__2 (rtkPosOf $1) $2 } | + tok_Shape_dummy_1 Shape tok_Shape_dummy_1 { Ctr__Start__3 (rtkPosOf $1) $2 } + +Start : qq_Start { Anti_Start (tkVal_qq_Start $1) } | + Shape Items { Ctr__Start__4 (rtkPosOf $1) $1 (reverse $2) } + +Items__plus_list_ : ListElem_Items0 { [$1] } | + Items__plus_list_ tok__coma__2 ListElem_Items0 { $3 : $1 } + +Items : Items__plus_list_ { $1 } | + {- empty -} { [] } + +Label : Note { $1 } + +Note : qq_Label { Anti_Label (tkVal_qq_Label $1) } | + tok_note_3 num { Ctr__Label__1 (rtkPosOf $1) (tkVal_num $2) } + +Shape : Circle { $1 } | + Square { $1 } + +ListElem_Items0 : qq_Items { Anti_Shape (tkVal_qq_Items $1) } | + Shape { $1 } + +Square : tok_square_1 num { Ctr__Shape__3 (rtkPosOf $1) (tkVal_num $2) } + +Circle : qq_Shape { Anti_Shape (tkVal_qq_Shape $1) } | + tok_circle_0 num { Ctr__Shape__4 (rtkPosOf $1) (tkVal_num $2) } + + +{ +parseError :: [L.PosToken] -> Either String a +parseError [] = Left "unexpected end of input" +parseError (L.PosToken (L.AlexPn _ line col) tok : _) = + Left $ show line ++ ":" ++ show col ++ ":unexpected " ++ showRtkToken tok + +-- Render a token the way it appears in the source, for error messages +showRtkToken :: L.Token -> String +showRtkToken L.EndOfFile = "end of input" +showRtkToken L.Tk__tok_Items_dummy_3 = "'tok_Items_dummy_3'" +showRtkToken L.Tk__tok_Label_dummy_2 = "'tok_Label_dummy_2'" +showRtkToken L.Tk__tok_Shape_dummy_1 = "'tok_Shape_dummy_1'" +showRtkToken L.Tk__tok_Start_dummy_4 = "'tok_Start_dummy_4'" +showRtkToken L.Tk__tok_square_1 = "'square'" +showRtkToken L.Tk__tok_note_3 = "'note'" +showRtkToken L.Tk__tok_circle_0 = "'circle'" +showRtkToken L.Tk__tok__coma__2 = "','" +showRtkToken (L.Tk__num v) = "num " ++ show v +showRtkToken (L.Tk__qq_Label v) = "qq_Label " ++ show v +showRtkToken (L.Tk__qq_Items v) = "qq_Items " ++ show v +showRtkToken (L.Tk__qq_Shape v) = "qq_Shape " ++ show v +showRtkToken (L.Tk__qq_Start v) = "qq_Start " ++ show v + +-- Source position of a node: every constructor except the Anti_* splice +-- artifacts stores the position of its alternative's first symbol in its +-- first field. Positions are transparent for equality and ordering, so two +-- ASTs that differ only in source positions (e.g. a quasi-quote parsed at +-- compile time vs the same construct parsed at run time) compare equal. +newtype RtkPos = RtkPos L.AlexPosn deriving (Show, Gen.Data, Gen.Typeable) +instance Eq RtkPos where _ == _ = True +instance Ord RtkPos where compare _ _ = EQ + +-- The position used where no source token exists: empty productions, empty +-- lists, absent optionals and Anti_* quasi-quote splices +rtkNoPos :: RtkPos +rtkNoPos = RtkPos (L.AlexPn 0 0 0) + +class RtkPosOf a where + rtkPosOf :: a -> RtkPos +instance RtkPosOf L.PosToken where + rtkPosOf (L.PosToken p _) = RtkPos p +instance RtkPosOf a => RtkPosOf [a] where + rtkPosOf (x : _) = rtkPosOf x + rtkPosOf [] = rtkNoPos +instance RtkPosOf a => RtkPosOf (Maybe a) where + rtkPosOf (Just x) = rtkPosOf x + rtkPosOf Nothing = rtkNoPos +-- A Char carries no position; this also covers String token payloads +instance RtkPosOf Char where + rtkPosOf _ = rtkNoPos + +-- Recover a token's payload from the whole positioned token: %token +-- bindings keep the L.PosToken so semantic actions can read its position +tkVal_num :: L.PosToken -> String +tkVal_num (L.PosToken _ (L.Tk__num v)) = v +tkVal_num t = error ("rtk internal error: token num expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Label :: L.PosToken -> String +tkVal_qq_Label (L.PosToken _ (L.Tk__qq_Label v)) = v +tkVal_qq_Label t = error ("rtk internal error: token qq_Label expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Items :: L.PosToken -> String +tkVal_qq_Items (L.PosToken _ (L.Tk__qq_Items v)) = v +tkVal_qq_Items t = error ("rtk internal error: token qq_Items expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Shape :: L.PosToken -> String +tkVal_qq_Shape (L.PosToken _ (L.Tk__qq_Shape v)) = v +tkVal_qq_Shape t = error ("rtk internal error: token qq_Shape expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Start :: L.PosToken -> String +tkVal_qq_Start (L.PosToken _ (L.Tk__qq_Start v)) = v +tkVal_qq_Start t = error ("rtk internal error: token qq_Start expected, got " ++ showRtkToken (L.ptToken t)) + +data Start = Ctr__Start__0 RtkPos Start | + Ctr__Start__1 RtkPos Items | + Ctr__Start__2 RtkPos Label | + Ctr__Start__3 RtkPos Shape | + Anti_Start String | + Ctr__Start__4 RtkPos Shape Items + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Start where + rtkPosOf (Ctr__Start__0 p _) = p + rtkPosOf (Ctr__Start__1 p _) = p + rtkPosOf (Ctr__Start__2 p _) = p + rtkPosOf (Ctr__Start__3 p _) = p + rtkPosOf (Anti_Start _) = rtkNoPos + rtkPosOf (Ctr__Start__4 p _ _) = p +type Items = [Shape] +data Label = Anti_Label String | + Ctr__Label__1 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Label where + rtkPosOf (Anti_Label _) = rtkNoPos + rtkPosOf (Ctr__Label__1 p _) = p +data Shape = Anti_Shape String | + Ctr__Shape__3 RtkPos String | + Ctr__Shape__4 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Shape where + rtkPosOf (Anti_Shape _) = rtkNoPos + rtkPosOf (Ctr__Shape__3 p _) = p + rtkPosOf (Ctr__Shape__4 p _) = p +} diff --git a/test/golden/i14/I14QQ.hs b/test/golden/i14/I14QQ.hs new file mode 100644 --- /dev/null +++ b/test/golden/i14/I14QQ.hs @@ -0,0 +1,149 @@ +-- Generated by RTK from grammar 'I14'. Do not edit by hand. +{-# LANGUAGE TemplateHaskell #-} +module I14QQ +where + +import qualified Data.Char as C +import qualified Data.Map as M +import Data.List +import Data.Maybe +import qualified Data.Generics as Generics +import qualified Data.Data as Data +import qualified Language.Haskell.TH as TH +import Language.Haskell.TH.Quote +import I14Lexer +import I14Parser + +qqShortcuts :: M.Map String String + +-- A $name metavariable is rewritten to $Type:name using the qqShortcuts +-- table below. The rewrite is purely textual, so it would also fire inside +-- the quoted language's own string literals: write $$name there to escape +-- it and get the literal text $name. Each '$$' pair directly before a +-- metavariable stands for one literal '$' (so $$$x is a literal '$' +-- followed by the metavariable $x). A '$' not followed by an identifier is +-- never rewritten and needs no escape, and an explicit $Type:name antiquote +-- (the character after the name is ':') passes through untouched. +-- A plain character scan rather than a regex: metavariables are recognized +-- regardless of what follows the name - including a newline or the end of +-- the quote, which the previous regex's terminator class missed. +replaceAllPatterns :: String -> Either String String +replaceAllPatterns [] = Right [] +replaceAllPatterns s@('$' : _) = + let (dollars, rest) = span (== '$') s + in case rest of + (c1 : _) | C.isAlpha c1 || c1 == '_' -> + let (varName, post) = span (\ ch -> C.isAlphaNum ch || ch == '_') rest + escCount = length dollars - 1 + keptPre = replicate (div escCount 2) '$' + in case post of + (':' : _) -> ((dollars ++ varName) ++) <$> replaceAllPatterns post + _ | odd escCount -> ((keptPre ++ '$' : varName) ++) <$> replaceAllPatterns post + _ -> case catMaybes $ map (\ prefix -> M.lookup prefix qqShortcuts) $ reverse $ inits varName of + [] -> Left $ unlines + [ "Unknown metavariable $" ++ varName ++ " in quasi-quote:" + , "no prefix of '" ++ varName ++ "' is a known shortcut. Known shortcuts:" + , " " ++ intercalate ", " (M.keys qqShortcuts) + , "To include the literal text $" ++ varName ++ " in the quoted code" + , "(e.g. inside a string literal), escape it as $$" ++ varName ++ "." ] + (rule : _) -> ((keptPre ++ '$' : rule ++ ":" ++ varName) ++) <$> replaceAllPatterns post + _ -> (dollars ++) <$> replaceAllPatterns rest +replaceAllPatterns (c : rest) = (c :) <$> replaceAllPatterns rest + +-- The generated lexer and parser encode error positions as "LINE:COL:message" +-- so structured-diagnostic callers can split them; render them back +-- human-readably for quasi-quote compile errors. Positions refer to the quote +-- body (padded with a start token in front). +rtkRenderError :: String -> String +rtkRenderError err = + case span (/= ':') err of + (l, ':' : rest1) | [(line, "")] <- (reads l :: [(Int, String)]) -> + case span (/= ':') rest1 of + (c, ':' : msg) | [(col, "")] <- (reads c :: [(Int, String)]) -> + "line " ++ show line ++ ", column " ++ show col ++ ": " ++ msg + _ -> err + _ -> err + +qqShortcuts = M.fromList [ ("start","Start"),("items","Items"),("label","Label"),("shape","Shape")] + +-- A quasi-quote pattern must match an AST parsed from anywhere in a source +-- file, while the pattern itself was parsed from the quote body - so every +-- RtkPos position field becomes a wildcard in generated patterns. +-- (Expressions need no special case: the compile-time position they embed +-- is equality-transparent.) +rtkPosWildPat :: RtkPos -> Maybe (TH.Q TH.Pat) +rtkPosWildPat _ = Just TH.wildP + +quoteI14Exp :: Data.Data a => String -> (Start -> a) -> String -> TH.ExpQ +quoteI14Exp dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseI14 of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToExpQ (const Nothing `Generics.extQ` antiStartExp `Generics.extQ` antiShapeExp `Generics.extQ` antiLabelExp) expr +quoteI14Pat :: Data.Data a => String -> (Start -> a) -> String -> TH.PatQ +quoteI14Pat dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseI14 of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToPatQ (const Nothing `Generics.extQ` rtkPosWildPat `Generics.extQ` antiStartPat `Generics.extQ` antiShapePat `Generics.extQ` antiLabelPat) expr + +antiLabelExp :: Label -> Maybe (TH.Q TH.Exp ) +antiLabelExp ( Anti_Label v) = Just $ TH.varE (TH.mkName v) +antiLabelExp _ = Nothing + + +antiShapeExp :: Shape -> Maybe (TH.Q TH.Exp ) +antiShapeExp ( Anti_Shape v) = Just $ TH.varE (TH.mkName v) +antiShapeExp _ = Nothing + + +antiStartExp :: Start -> Maybe (TH.Q TH.Exp ) +antiStartExp ( Anti_Start v) = Just $ TH.varE (TH.mkName v) +antiStartExp _ = Nothing + + + +antiLabelPat :: Label -> Maybe (TH.Q TH.Pat ) +antiLabelPat ( Anti_Label v) = Just $ TH.varP (TH.mkName v) +antiLabelPat _ = Nothing + + +antiShapePat :: Shape -> Maybe (TH.Q TH.Pat ) +antiShapePat ( Anti_Shape v) = Just $ TH.varP (TH.mkName v) +antiShapePat _ = Nothing + + +antiStartPat :: Start -> Maybe (TH.Q TH.Pat ) +antiStartPat ( Anti_Start v) = Just $ TH.varP (TH.mkName v) +antiStartPat _ = Nothing + + + +-- This grammar's quasi-quoters work in expression and pattern contexts only +quoteI14Type _ = fail "this quasi-quoter cannot be used in a type context" +quoteI14Decs _ = fail "this quasi-quoter cannot be used in a declaration context" + +getStart ( Ctr__Start__0 _ s) = s + +start :: QuasiQuoter +start = QuasiQuoter (quoteI14Exp "tok_Start_dummy_4" getStart ) (quoteI14Pat "tok_Start_dummy_4" getStart ) quoteI14Type quoteI14Decs + +getItems ( Ctr__Start__1 _ s) = s + +items :: QuasiQuoter +items = QuasiQuoter (quoteI14Exp "tok_Items_dummy_3" getItems ) (quoteI14Pat "tok_Items_dummy_3" getItems ) quoteI14Type quoteI14Decs + +getLabel ( Ctr__Start__2 _ s) = s + +label :: QuasiQuoter +label = QuasiQuoter (quoteI14Exp "tok_Label_dummy_2" getLabel ) (quoteI14Pat "tok_Label_dummy_2" getLabel ) quoteI14Type quoteI14Decs + +getShape ( Ctr__Start__3 _ s) = s + +shape :: QuasiQuoter +shape = QuasiQuoter (quoteI14Exp "tok_Shape_dummy_1" getShape ) (quoteI14Pat "tok_Shape_dummy_1" getShape ) quoteI14Type quoteI14Decs + diff --git a/test/golden/java-simple/JavaSimpleLexer.x b/test/golden/java-simple/JavaSimpleLexer.x new file mode 100644 --- /dev/null +++ b/test/golden/java-simple/JavaSimpleLexer.x @@ -0,0 +1,116 @@ +-- Generated by RTK from grammar 'JavaSimple'. Do not edit by hand. +{ +{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} +module JavaSimpleLexer(scanTokens, alexScanTokens, Token(..), PosToken(..), AlexPosn(..)) +where +import Data.Data (Data) + + } +%wrapper "monad" + + +tokens :- "tok_ClassDeclaration_dummy_10" { simple Tk__tok_ClassDeclaration_dummy_10 } + "tok_CompilationUnit_dummy_9" { simple Tk__tok_CompilationUnit_dummy_9 } + "tok_CompoundName_dummy_8" { simple Tk__tok_CompoundName_dummy_8 } + "tok_Field_dummy_7" { simple Tk__tok_Field_dummy_7 } + "tok_FieldList_dummy_6" { simple Tk__tok_FieldList_dummy_6 } + "tok_JavaSimple_dummy_11" { simple Tk__tok_JavaSimple_dummy_11 } + "tok_Package_dummy_5" { simple Tk__tok_Package_dummy_5 } + "tok_Type_dummy_4" { simple Tk__tok_Type_dummy_4 } + "}" { simple Tk__tok__symbol__5 } + "{" { simple Tk__tok__symbol__4 } + "public" { simple Tk__tok_public_2 } + "package" { simple Tk__tok_package_0 } + "int" { simple Tk__tok_int_6 } + "class" { simple Tk__tok_class_3 } + "String" { simple Tk__tok_String_7 } + ";" { simple Tk__tok__semi__1 } + "." { simple Tk__tok__dot__8 } + ([\ \t\n\r]+) ; + ([a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__id . (id) } + ("$" "CompoundName" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_CompoundName . ((tail . dropWhile (/= ':'))) } + ("$" "Type" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Type . ((tail . dropWhile (/= ':'))) } + ("$" "Field" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Field . ((tail . dropWhile (/= ':'))) } + ("$" "FieldList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_FieldList . ((tail . dropWhile (/= ':'))) } + ("$" "ClassDeclaration" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ClassDeclaration . ((tail . dropWhile (/= ':'))) } + ("$" "Package" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Package . ((tail . dropWhile (/= ':'))) } + ("$" "CompilationUnit" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_CompilationUnit . ((tail . dropWhile (/= ':'))) } + ("$" "JavaSimple" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_JavaSimple . ((tail . dropWhile (/= ':'))) } + . { rtkError } + +{ +data Token = EndOfFile | + Tk__tok_ClassDeclaration_dummy_10 | + Tk__tok_CompilationUnit_dummy_9 | + Tk__tok_CompoundName_dummy_8 | + Tk__tok_Field_dummy_7 | + Tk__tok_FieldList_dummy_6 | + Tk__tok_JavaSimple_dummy_11 | + Tk__tok_Package_dummy_5 | + Tk__tok_Type_dummy_4 | + Tk__tok__symbol__5 | + Tk__tok__symbol__4 | + Tk__tok_public_2 | + Tk__tok_package_0 | + Tk__tok_int_6 | + Tk__tok_class_3 | + Tk__tok_String_7 | + Tk__tok__semi__1 | + Tk__tok__dot__8 | + Tk__id String | + Tk__qq_CompoundName String | + Tk__qq_Type String | + Tk__qq_Field String | + Tk__qq_FieldList String | + Tk__qq_ClassDeclaration String | + Tk__qq_Package String | + Tk__qq_CompilationUnit String | + Tk__qq_JavaSimple String + deriving (Show) + +-- AlexPosn is defined by the alex wrapper, so the Data instance (required by +-- the parser's RtkPos position type) can only be attached via standalone +-- deriving - the same solution as the hand-written Lexer.x +deriving instance Data AlexPosn + +-- A token together with the source position where it starts +data PosToken = PosToken { ptPos :: AlexPosn, ptToken :: Token } + deriving (Show) + +alexEOF = do + (pos, _, _, _) <- alexGetInput + return $ PosToken pos EndOfFile + +-- Lex the input into a token stream, returning the positioned error message +-- on a lexical error (encoded as "LINE:COL:message", see rtkError below). +-- The returned list always ends with an EndOfFile token that carries the +-- position of the end of input, so parse errors at end of input can be +-- reported with a position too +scanTokens :: String -> Either String [PosToken] +scanTokens str = runAlex str $ do + let loop toks = do tok <- alexMonadScan + case tok of + PosToken _ EndOfFile -> return $ reverse (tok : toks) + _ -> let toks' = tok : toks + in toks' `seq` loop toks' + loop [] + +-- Thin compatibility wrapper: callers that have not switched to 'scanTokens' +-- get the error message thrown instead +alexScanTokens :: String -> [PosToken] +alexScanTokens str = + case scanTokens str of + Right toks -> toks + Left err -> errorWithoutStackTrace err + +simple1 :: (String -> Token) -> AlexInput -> Int -> Alex PosToken +simple1 t (pos, _, _, str) len = return $ PosToken pos (t (take len str)) + +simple :: Token -> AlexInput -> Int -> Alex PosToken +simple t (pos, _, _, _) len = return $ PosToken pos t + +-- Encode the position as "LINE:COL:message" so callers can split it back out +-- into a structured position - the same encoding the rtk grammar lexer uses +rtkError ((AlexPn _ line column), _, _, str) len = alexError $ (show line) ++ ":" ++ (show column) ++ ":lexical error. Following chars: " ++ (take 10 str) + +} diff --git a/test/golden/java-simple/JavaSimpleParser.y b/test/golden/java-simple/JavaSimpleParser.y new file mode 100644 --- /dev/null +++ b/test/golden/java-simple/JavaSimpleParser.y @@ -0,0 +1,274 @@ +-- Generated by RTK from grammar 'JavaSimple'. Do not edit by hand. +{ +{-# LANGUAGE DeriveDataTypeable #-} +module JavaSimpleParser where +import qualified Data.Generics as Gen +import qualified JavaSimpleLexer as L (Token(..), PosToken(..), AlexPosn(..), alexScanTokens) +} + +%name parseJavaSimple +%tokentype { L.PosToken } +%monad { Either String } +%error { parseError } + +%token + +rtk__eof { L.PosToken _ L.EndOfFile } +tok_ClassDeclaration_dummy_10 { L.PosToken _ L.Tk__tok_ClassDeclaration_dummy_10 } +tok_CompilationUnit_dummy_9 { L.PosToken _ L.Tk__tok_CompilationUnit_dummy_9 } +tok_CompoundName_dummy_8 { L.PosToken _ L.Tk__tok_CompoundName_dummy_8 } +tok_Field_dummy_7 { L.PosToken _ L.Tk__tok_Field_dummy_7 } +tok_FieldList_dummy_6 { L.PosToken _ L.Tk__tok_FieldList_dummy_6 } +tok_JavaSimple_dummy_11 { L.PosToken _ L.Tk__tok_JavaSimple_dummy_11 } +tok_Package_dummy_5 { L.PosToken _ L.Tk__tok_Package_dummy_5 } +tok_Type_dummy_4 { L.PosToken _ L.Tk__tok_Type_dummy_4 } +tok__symbol__5 { L.PosToken _ L.Tk__tok__symbol__5 } +tok__symbol__4 { L.PosToken _ L.Tk__tok__symbol__4 } +tok_public_2 { L.PosToken _ L.Tk__tok_public_2 } +tok_package_0 { L.PosToken _ L.Tk__tok_package_0 } +tok_int_6 { L.PosToken _ L.Tk__tok_int_6 } +tok_class_3 { L.PosToken _ L.Tk__tok_class_3 } +tok_String_7 { L.PosToken _ L.Tk__tok_String_7 } +tok__semi__1 { L.PosToken _ L.Tk__tok__semi__1 } +tok__dot__8 { L.PosToken _ L.Tk__tok__dot__8 } +id { L.PosToken _ (L.Tk__id _) } +qq_CompoundName { L.PosToken _ (L.Tk__qq_CompoundName _) } +qq_Type { L.PosToken _ (L.Tk__qq_Type _) } +qq_Field { L.PosToken _ (L.Tk__qq_Field _) } +qq_FieldList { L.PosToken _ (L.Tk__qq_FieldList _) } +qq_ClassDeclaration { L.PosToken _ (L.Tk__qq_ClassDeclaration _) } +qq_Package { L.PosToken _ (L.Tk__qq_Package _) } +qq_CompilationUnit { L.PosToken _ (L.Tk__qq_CompilationUnit _) } +qq_JavaSimple { L.PosToken _ (L.Tk__qq_JavaSimple _) } + +%% + +JavaSimple__top : JavaSimple rtk__eof { $1 } + +JavaSimple : tok_JavaSimple_dummy_11 JavaSimple tok_JavaSimple_dummy_11 { Ctr__JavaSimple__0 (rtkPosOf $1) $2 } | + tok_ClassDeclaration_dummy_10 ClassDeclaration tok_ClassDeclaration_dummy_10 { Ctr__JavaSimple__1 (rtkPosOf $1) $2 } | + tok_CompilationUnit_dummy_9 CompilationUnit tok_CompilationUnit_dummy_9 { Ctr__JavaSimple__2 (rtkPosOf $1) $2 } | + tok_CompoundName_dummy_8 CompoundName tok_CompoundName_dummy_8 { Ctr__JavaSimple__3 (rtkPosOf $1) $2 } | + tok_Field_dummy_7 Field tok_Field_dummy_7 { Ctr__JavaSimple__4 (rtkPosOf $1) $2 } | + tok_FieldList_dummy_6 FieldList tok_FieldList_dummy_6 { Ctr__JavaSimple__5 (rtkPosOf $1) (reverse $2) } | + tok_Package_dummy_5 Package tok_Package_dummy_5 { Ctr__JavaSimple__6 (rtkPosOf $1) $2 } | + tok_Type_dummy_4 Type tok_Type_dummy_4 { Ctr__JavaSimple__7 (rtkPosOf $1) $2 } + +JavaSimple : qq_JavaSimple { Anti_JavaSimple (tkVal_qq_JavaSimple $1) } | + CompilationUnit { Ctr__JavaSimple__8 (rtkPosOf $1) $1 } + +ClassDeclaration : qq_ClassDeclaration { Anti_ClassDeclaration (tkVal_qq_ClassDeclaration $1) } | + Rule_2 tok_class_3 id tok__symbol__4 FieldList tok__symbol__5 { Ctr__ClassDeclaration__0 (rtkPosOf $1) $1 (tkVal_id $3) (reverse $5) } + +CompilationUnit : qq_CompilationUnit { Anti_CompilationUnit (tkVal_qq_CompilationUnit $1) } | + Rule_0 Rule_1 { Ctr__CompilationUnit__0 (rtkPosOf $1) $1 $2 } + +CompoundName : qq_CompoundName { Anti_CompoundName (tkVal_qq_CompoundName $1) } | + id { Ctr__CompoundName__0 (rtkPosOf $1) (tkVal_id $1) } | + CompoundName tok__dot__8 id { Ctr__CompoundName__1 (rtkPosOf $1) $1 (tkVal_id $3) } + +Field : qq_Field { Anti_Field (tkVal_qq_Field $1) } | + Type id tok__semi__1 { Ctr__Field__0 (rtkPosOf $1) $1 (tkVal_id $2) } + +ListElem_FieldList3 : qq_FieldList { Anti_Field (tkVal_qq_FieldList $1) } | + Field { $1 } + +FieldList : {- empty -} { [] } | + FieldList ListElem_FieldList3 { $2 : $1 } + +Package : qq_Package { Anti_Package (tkVal_qq_Package $1) } | + tok_package_0 CompoundName tok__semi__1 { Ctr__Package__0 (rtkPosOf $1) $2 } + +Rule_0 : { Ctr__Rule_0__0 rtkNoPos } | + Package { Ctr__Rule_0__1 (rtkPosOf $1) $1 } + +Rule_1 : { Ctr__Rule_1__0 rtkNoPos } | + ClassDeclaration { Ctr__Rule_1__1 (rtkPosOf $1) $1 } + +Rule_2 : { Ctr__Rule_2__0 rtkNoPos } | + tok_public_2 { Ctr__Rule_2__1 (rtkPosOf $1) } + +Type : qq_Type { Anti_Type (tkVal_qq_Type $1) } | + tok_int_6 { Ctr__Type__0 (rtkPosOf $1) } | + tok_String_7 { Ctr__Type__1 (rtkPosOf $1) } | + id { Ctr__Type__2 (rtkPosOf $1) (tkVal_id $1) } + + +{ +parseError :: [L.PosToken] -> Either String a +parseError [] = Left "unexpected end of input" +parseError (L.PosToken (L.AlexPn _ line col) tok : _) = + Left $ show line ++ ":" ++ show col ++ ":unexpected " ++ showRtkToken tok + +-- Render a token the way it appears in the source, for error messages +showRtkToken :: L.Token -> String +showRtkToken L.EndOfFile = "end of input" +showRtkToken L.Tk__tok_ClassDeclaration_dummy_10 = "'tok_ClassDeclaration_dummy_10'" +showRtkToken L.Tk__tok_CompilationUnit_dummy_9 = "'tok_CompilationUnit_dummy_9'" +showRtkToken L.Tk__tok_CompoundName_dummy_8 = "'tok_CompoundName_dummy_8'" +showRtkToken L.Tk__tok_Field_dummy_7 = "'tok_Field_dummy_7'" +showRtkToken L.Tk__tok_FieldList_dummy_6 = "'tok_FieldList_dummy_6'" +showRtkToken L.Tk__tok_JavaSimple_dummy_11 = "'tok_JavaSimple_dummy_11'" +showRtkToken L.Tk__tok_Package_dummy_5 = "'tok_Package_dummy_5'" +showRtkToken L.Tk__tok_Type_dummy_4 = "'tok_Type_dummy_4'" +showRtkToken L.Tk__tok__symbol__5 = "'}'" +showRtkToken L.Tk__tok__symbol__4 = "'{'" +showRtkToken L.Tk__tok_public_2 = "'public'" +showRtkToken L.Tk__tok_package_0 = "'package'" +showRtkToken L.Tk__tok_int_6 = "'int'" +showRtkToken L.Tk__tok_class_3 = "'class'" +showRtkToken L.Tk__tok_String_7 = "'String'" +showRtkToken L.Tk__tok__semi__1 = "';'" +showRtkToken L.Tk__tok__dot__8 = "'.'" +showRtkToken (L.Tk__id v) = "id " ++ show v +showRtkToken (L.Tk__qq_CompoundName v) = "qq_CompoundName " ++ show v +showRtkToken (L.Tk__qq_Type v) = "qq_Type " ++ show v +showRtkToken (L.Tk__qq_Field v) = "qq_Field " ++ show v +showRtkToken (L.Tk__qq_FieldList v) = "qq_FieldList " ++ show v +showRtkToken (L.Tk__qq_ClassDeclaration v) = "qq_ClassDeclaration " ++ show v +showRtkToken (L.Tk__qq_Package v) = "qq_Package " ++ show v +showRtkToken (L.Tk__qq_CompilationUnit v) = "qq_CompilationUnit " ++ show v +showRtkToken (L.Tk__qq_JavaSimple v) = "qq_JavaSimple " ++ show v + +-- Source position of a node: every constructor except the Anti_* splice +-- artifacts stores the position of its alternative's first symbol in its +-- first field. Positions are transparent for equality and ordering, so two +-- ASTs that differ only in source positions (e.g. a quasi-quote parsed at +-- compile time vs the same construct parsed at run time) compare equal. +newtype RtkPos = RtkPos L.AlexPosn deriving (Show, Gen.Data, Gen.Typeable) +instance Eq RtkPos where _ == _ = True +instance Ord RtkPos where compare _ _ = EQ + +-- The position used where no source token exists: empty productions, empty +-- lists, absent optionals and Anti_* quasi-quote splices +rtkNoPos :: RtkPos +rtkNoPos = RtkPos (L.AlexPn 0 0 0) + +class RtkPosOf a where + rtkPosOf :: a -> RtkPos +instance RtkPosOf L.PosToken where + rtkPosOf (L.PosToken p _) = RtkPos p +instance RtkPosOf a => RtkPosOf [a] where + rtkPosOf (x : _) = rtkPosOf x + rtkPosOf [] = rtkNoPos +instance RtkPosOf a => RtkPosOf (Maybe a) where + rtkPosOf (Just x) = rtkPosOf x + rtkPosOf Nothing = rtkNoPos +-- A Char carries no position; this also covers String token payloads +instance RtkPosOf Char where + rtkPosOf _ = rtkNoPos + +-- Recover a token's payload from the whole positioned token: %token +-- bindings keep the L.PosToken so semantic actions can read its position +tkVal_id :: L.PosToken -> String +tkVal_id (L.PosToken _ (L.Tk__id v)) = v +tkVal_id t = error ("rtk internal error: token id expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_CompoundName :: L.PosToken -> String +tkVal_qq_CompoundName (L.PosToken _ (L.Tk__qq_CompoundName v)) = v +tkVal_qq_CompoundName t = error ("rtk internal error: token qq_CompoundName expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Type :: L.PosToken -> String +tkVal_qq_Type (L.PosToken _ (L.Tk__qq_Type v)) = v +tkVal_qq_Type t = error ("rtk internal error: token qq_Type expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Field :: L.PosToken -> String +tkVal_qq_Field (L.PosToken _ (L.Tk__qq_Field v)) = v +tkVal_qq_Field t = error ("rtk internal error: token qq_Field expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_FieldList :: L.PosToken -> String +tkVal_qq_FieldList (L.PosToken _ (L.Tk__qq_FieldList v)) = v +tkVal_qq_FieldList t = error ("rtk internal error: token qq_FieldList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ClassDeclaration :: L.PosToken -> String +tkVal_qq_ClassDeclaration (L.PosToken _ (L.Tk__qq_ClassDeclaration v)) = v +tkVal_qq_ClassDeclaration t = error ("rtk internal error: token qq_ClassDeclaration expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Package :: L.PosToken -> String +tkVal_qq_Package (L.PosToken _ (L.Tk__qq_Package v)) = v +tkVal_qq_Package t = error ("rtk internal error: token qq_Package expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_CompilationUnit :: L.PosToken -> String +tkVal_qq_CompilationUnit (L.PosToken _ (L.Tk__qq_CompilationUnit v)) = v +tkVal_qq_CompilationUnit t = error ("rtk internal error: token qq_CompilationUnit expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_JavaSimple :: L.PosToken -> String +tkVal_qq_JavaSimple (L.PosToken _ (L.Tk__qq_JavaSimple v)) = v +tkVal_qq_JavaSimple t = error ("rtk internal error: token qq_JavaSimple expected, got " ++ showRtkToken (L.ptToken t)) + +data JavaSimple = Ctr__JavaSimple__0 RtkPos JavaSimple | + Ctr__JavaSimple__1 RtkPos ClassDeclaration | + Ctr__JavaSimple__2 RtkPos CompilationUnit | + Ctr__JavaSimple__3 RtkPos CompoundName | + Ctr__JavaSimple__4 RtkPos Field | + Ctr__JavaSimple__5 RtkPos FieldList | + Ctr__JavaSimple__6 RtkPos Package | + Ctr__JavaSimple__7 RtkPos Type | + Anti_JavaSimple String | + Ctr__JavaSimple__8 RtkPos CompilationUnit + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf JavaSimple where + rtkPosOf (Ctr__JavaSimple__0 p _) = p + rtkPosOf (Ctr__JavaSimple__1 p _) = p + rtkPosOf (Ctr__JavaSimple__2 p _) = p + rtkPosOf (Ctr__JavaSimple__3 p _) = p + rtkPosOf (Ctr__JavaSimple__4 p _) = p + rtkPosOf (Ctr__JavaSimple__5 p _) = p + rtkPosOf (Ctr__JavaSimple__6 p _) = p + rtkPosOf (Ctr__JavaSimple__7 p _) = p + rtkPosOf (Anti_JavaSimple _) = rtkNoPos + rtkPosOf (Ctr__JavaSimple__8 p _) = p +data ClassDeclaration = Anti_ClassDeclaration String | + Ctr__ClassDeclaration__0 RtkPos Rule_2 String FieldList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ClassDeclaration where + rtkPosOf (Anti_ClassDeclaration _) = rtkNoPos + rtkPosOf (Ctr__ClassDeclaration__0 p _ _ _) = p +data CompilationUnit = Anti_CompilationUnit String | + Ctr__CompilationUnit__0 RtkPos Rule_0 Rule_1 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf CompilationUnit where + rtkPosOf (Anti_CompilationUnit _) = rtkNoPos + rtkPosOf (Ctr__CompilationUnit__0 p _ _) = p +data CompoundName = Anti_CompoundName String | + Ctr__CompoundName__0 RtkPos String | + Ctr__CompoundName__1 RtkPos CompoundName String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf CompoundName where + rtkPosOf (Anti_CompoundName _) = rtkNoPos + rtkPosOf (Ctr__CompoundName__0 p _) = p + rtkPosOf (Ctr__CompoundName__1 p _ _) = p +data Field = Anti_Field String | + Ctr__Field__0 RtkPos Type String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Field where + rtkPosOf (Anti_Field _) = rtkNoPos + rtkPosOf (Ctr__Field__0 p _ _) = p +type FieldList = [Field] +data Package = Anti_Package String | + Ctr__Package__0 RtkPos CompoundName + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Package where + rtkPosOf (Anti_Package _) = rtkNoPos + rtkPosOf (Ctr__Package__0 p _) = p +data Rule_0 = Ctr__Rule_0__0 RtkPos | + Ctr__Rule_0__1 RtkPos Package + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_0 where + rtkPosOf (Ctr__Rule_0__0 p) = p + rtkPosOf (Ctr__Rule_0__1 p _) = p +data Rule_1 = Ctr__Rule_1__0 RtkPos | + Ctr__Rule_1__1 RtkPos ClassDeclaration + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_1 where + rtkPosOf (Ctr__Rule_1__0 p) = p + rtkPosOf (Ctr__Rule_1__1 p _) = p +data Rule_2 = Ctr__Rule_2__0 RtkPos | + Ctr__Rule_2__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_2 where + rtkPosOf (Ctr__Rule_2__0 p) = p + rtkPosOf (Ctr__Rule_2__1 p) = p +data Type = Anti_Type String | + Ctr__Type__0 RtkPos | + Ctr__Type__1 RtkPos | + Ctr__Type__2 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Type where + rtkPosOf (Anti_Type _) = rtkNoPos + rtkPosOf (Ctr__Type__0 p) = p + rtkPosOf (Ctr__Type__1 p) = p + rtkPosOf (Ctr__Type__2 p _) = p +} diff --git a/test/golden/java-simple/JavaSimpleQQ.hs b/test/golden/java-simple/JavaSimpleQQ.hs new file mode 100644 --- /dev/null +++ b/test/golden/java-simple/JavaSimpleQQ.hs @@ -0,0 +1,212 @@ +-- Generated by RTK from grammar 'JavaSimple'. Do not edit by hand. +{-# LANGUAGE TemplateHaskell #-} +module JavaSimpleQQ +where + +import qualified Data.Char as C +import qualified Data.Map as M +import Data.List +import Data.Maybe +import qualified Data.Generics as Generics +import qualified Data.Data as Data +import qualified Language.Haskell.TH as TH +import Language.Haskell.TH.Quote +import JavaSimpleLexer +import JavaSimpleParser + +qqShortcuts :: M.Map String String + +-- A $name metavariable is rewritten to $Type:name using the qqShortcuts +-- table below. The rewrite is purely textual, so it would also fire inside +-- the quoted language's own string literals: write $$name there to escape +-- it and get the literal text $name. Each '$$' pair directly before a +-- metavariable stands for one literal '$' (so $$$x is a literal '$' +-- followed by the metavariable $x). A '$' not followed by an identifier is +-- never rewritten and needs no escape, and an explicit $Type:name antiquote +-- (the character after the name is ':') passes through untouched. +-- A plain character scan rather than a regex: metavariables are recognized +-- regardless of what follows the name - including a newline or the end of +-- the quote, which the previous regex's terminator class missed. +replaceAllPatterns :: String -> Either String String +replaceAllPatterns [] = Right [] +replaceAllPatterns s@('$' : _) = + let (dollars, rest) = span (== '$') s + in case rest of + (c1 : _) | C.isAlpha c1 || c1 == '_' -> + let (varName, post) = span (\ ch -> C.isAlphaNum ch || ch == '_') rest + escCount = length dollars - 1 + keptPre = replicate (div escCount 2) '$' + in case post of + (':' : _) -> ((dollars ++ varName) ++) <$> replaceAllPatterns post + _ | odd escCount -> ((keptPre ++ '$' : varName) ++) <$> replaceAllPatterns post + _ -> case catMaybes $ map (\ prefix -> M.lookup prefix qqShortcuts) $ reverse $ inits varName of + [] -> Left $ unlines + [ "Unknown metavariable $" ++ varName ++ " in quasi-quote:" + , "no prefix of '" ++ varName ++ "' is a known shortcut. Known shortcuts:" + , " " ++ intercalate ", " (M.keys qqShortcuts) + , "To include the literal text $" ++ varName ++ " in the quoted code" + , "(e.g. inside a string literal), escape it as $$" ++ varName ++ "." ] + (rule : _) -> ((keptPre ++ '$' : rule ++ ":" ++ varName) ++) <$> replaceAllPatterns post + _ -> (dollars ++) <$> replaceAllPatterns rest +replaceAllPatterns (c : rest) = (c :) <$> replaceAllPatterns rest + +-- The generated lexer and parser encode error positions as "LINE:COL:message" +-- so structured-diagnostic callers can split them; render them back +-- human-readably for quasi-quote compile errors. Positions refer to the quote +-- body (padded with a start token in front). +rtkRenderError :: String -> String +rtkRenderError err = + case span (/= ':') err of + (l, ':' : rest1) | [(line, "")] <- (reads l :: [(Int, String)]) -> + case span (/= ':') rest1 of + (c, ':' : msg) | [(col, "")] <- (reads c :: [(Int, String)]) -> + "line " ++ show line ++ ", column " ++ show col ++ ": " ++ msg + _ -> err + _ -> err + +qqShortcuts = M.fromList [ ("javaSimple","JavaSimple"),("classDeclaration","ClassDeclaration"),("compilationUnit","CompilationUnit"),("compoundName","CompoundName"),("field","Field"),("fieldList","FieldList"),("package","Package"),("type","Type")] + +-- A quasi-quote pattern must match an AST parsed from anywhere in a source +-- file, while the pattern itself was parsed from the quote body - so every +-- RtkPos position field becomes a wildcard in generated patterns. +-- (Expressions need no special case: the compile-time position they embed +-- is equality-transparent.) +rtkPosWildPat :: RtkPos -> Maybe (TH.Q TH.Pat) +rtkPosWildPat _ = Just TH.wildP + +quoteJavaSimpleExp :: Data.Data a => String -> (JavaSimple -> a) -> String -> TH.ExpQ +quoteJavaSimpleExp dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseJavaSimple of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToExpQ (const Nothing `Generics.extQ` antiJavaSimpleExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiFieldExp `Generics.extQ` antiTypeExp `Generics.extQ` antiCompoundNameExp) expr +quoteJavaSimplePat :: Data.Data a => String -> (JavaSimple -> a) -> String -> TH.PatQ +quoteJavaSimplePat dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseJavaSimple of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToPatQ (const Nothing `Generics.extQ` rtkPosWildPat `Generics.extQ` antiJavaSimplePat `Generics.extQ` antiCompilationUnitPat `Generics.extQ` antiPackagePat `Generics.extQ` antiClassDeclarationPat `Generics.extQ` antiFieldPat `Generics.extQ` antiTypePat `Generics.extQ` antiCompoundNamePat) expr + +antiCompoundNameExp :: CompoundName -> Maybe (TH.Q TH.Exp ) +antiCompoundNameExp ( Anti_CompoundName v) = Just $ TH.varE (TH.mkName v) +antiCompoundNameExp _ = Nothing + + +antiTypeExp :: Type -> Maybe (TH.Q TH.Exp ) +antiTypeExp ( Anti_Type v) = Just $ TH.varE (TH.mkName v) +antiTypeExp _ = Nothing + + +antiFieldExp :: [ Field ] -> Maybe (TH.Q TH.Exp) +antiFieldExp ((Anti_Field v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaSimpleExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiFieldExp `Generics.extQ` antiTypeExp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiFieldExp _ = Nothing + + +antiClassDeclarationExp :: ClassDeclaration -> Maybe (TH.Q TH.Exp ) +antiClassDeclarationExp ( Anti_ClassDeclaration v) = Just $ TH.varE (TH.mkName v) +antiClassDeclarationExp _ = Nothing + + +antiPackageExp :: Package -> Maybe (TH.Q TH.Exp ) +antiPackageExp ( Anti_Package v) = Just $ TH.varE (TH.mkName v) +antiPackageExp _ = Nothing + + +antiCompilationUnitExp :: CompilationUnit -> Maybe (TH.Q TH.Exp ) +antiCompilationUnitExp ( Anti_CompilationUnit v) = Just $ TH.varE (TH.mkName v) +antiCompilationUnitExp _ = Nothing + + +antiJavaSimpleExp :: JavaSimple -> Maybe (TH.Q TH.Exp ) +antiJavaSimpleExp ( Anti_JavaSimple v) = Just $ TH.varE (TH.mkName v) +antiJavaSimpleExp _ = Nothing + + + +antiCompoundNamePat :: CompoundName -> Maybe (TH.Q TH.Pat ) +antiCompoundNamePat ( Anti_CompoundName v) = Just $ TH.varP (TH.mkName v) +antiCompoundNamePat _ = Nothing + + +antiTypePat :: Type -> Maybe (TH.Q TH.Pat ) +antiTypePat ( Anti_Type v) = Just $ TH.varP (TH.mkName v) +antiTypePat _ = Nothing + + +antiFieldPat :: [ Field ] -> Maybe (TH.Q TH.Pat) +antiFieldPat [Anti_Field v] = Just $ TH.varP (TH.mkName v) +antiFieldPat _ = Nothing + + +antiClassDeclarationPat :: ClassDeclaration -> Maybe (TH.Q TH.Pat ) +antiClassDeclarationPat ( Anti_ClassDeclaration v) = Just $ TH.varP (TH.mkName v) +antiClassDeclarationPat _ = Nothing + + +antiPackagePat :: Package -> Maybe (TH.Q TH.Pat ) +antiPackagePat ( Anti_Package v) = Just $ TH.varP (TH.mkName v) +antiPackagePat _ = Nothing + + +antiCompilationUnitPat :: CompilationUnit -> Maybe (TH.Q TH.Pat ) +antiCompilationUnitPat ( Anti_CompilationUnit v) = Just $ TH.varP (TH.mkName v) +antiCompilationUnitPat _ = Nothing + + +antiJavaSimplePat :: JavaSimple -> Maybe (TH.Q TH.Pat ) +antiJavaSimplePat ( Anti_JavaSimple v) = Just $ TH.varP (TH.mkName v) +antiJavaSimplePat _ = Nothing + + + +-- This grammar's quasi-quoters work in expression and pattern contexts only +quoteJavaSimpleType _ = fail "this quasi-quoter cannot be used in a type context" +quoteJavaSimpleDecs _ = fail "this quasi-quoter cannot be used in a declaration context" + +getJavaSimple ( Ctr__JavaSimple__0 _ s) = s + +javaSimple :: QuasiQuoter +javaSimple = QuasiQuoter (quoteJavaSimpleExp "tok_JavaSimple_dummy_11" getJavaSimple ) (quoteJavaSimplePat "tok_JavaSimple_dummy_11" getJavaSimple ) quoteJavaSimpleType quoteJavaSimpleDecs + +getClassDeclaration ( Ctr__JavaSimple__1 _ s) = s + +classDeclaration :: QuasiQuoter +classDeclaration = QuasiQuoter (quoteJavaSimpleExp "tok_ClassDeclaration_dummy_10" getClassDeclaration ) (quoteJavaSimplePat "tok_ClassDeclaration_dummy_10" getClassDeclaration ) quoteJavaSimpleType quoteJavaSimpleDecs + +getCompilationUnit ( Ctr__JavaSimple__2 _ s) = s + +compilationUnit :: QuasiQuoter +compilationUnit = QuasiQuoter (quoteJavaSimpleExp "tok_CompilationUnit_dummy_9" getCompilationUnit ) (quoteJavaSimplePat "tok_CompilationUnit_dummy_9" getCompilationUnit ) quoteJavaSimpleType quoteJavaSimpleDecs + +getCompoundName ( Ctr__JavaSimple__3 _ s) = s + +compoundName :: QuasiQuoter +compoundName = QuasiQuoter (quoteJavaSimpleExp "tok_CompoundName_dummy_8" getCompoundName ) (quoteJavaSimplePat "tok_CompoundName_dummy_8" getCompoundName ) quoteJavaSimpleType quoteJavaSimpleDecs + +getField ( Ctr__JavaSimple__4 _ s) = s + +field :: QuasiQuoter +field = QuasiQuoter (quoteJavaSimpleExp "tok_Field_dummy_7" getField ) (quoteJavaSimplePat "tok_Field_dummy_7" getField ) quoteJavaSimpleType quoteJavaSimpleDecs + +getFieldList ( Ctr__JavaSimple__5 _ s) = s + +fieldList :: QuasiQuoter +fieldList = QuasiQuoter (quoteJavaSimpleExp "tok_FieldList_dummy_6" getFieldList ) (quoteJavaSimplePat "tok_FieldList_dummy_6" getFieldList ) quoteJavaSimpleType quoteJavaSimpleDecs + +getPackage ( Ctr__JavaSimple__6 _ s) = s + +package :: QuasiQuoter +package = QuasiQuoter (quoteJavaSimpleExp "tok_Package_dummy_5" getPackage ) (quoteJavaSimplePat "tok_Package_dummy_5" getPackage ) quoteJavaSimpleType quoteJavaSimpleDecs + +getType ( Ctr__JavaSimple__7 _ s) = s + +__type :: QuasiQuoter +__type = QuasiQuoter (quoteJavaSimpleExp "tok_Type_dummy_4" getType ) (quoteJavaSimplePat "tok_Type_dummy_4" getType ) quoteJavaSimpleType quoteJavaSimpleDecs + diff --git a/test/golden/java/JavaLexer.x b/test/golden/java/JavaLexer.x new file mode 100644 --- /dev/null +++ b/test/golden/java/JavaLexer.x @@ -0,0 +1,627 @@ +-- Generated by RTK from grammar 'Java'. Do not edit by hand. +{ +{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} +module JavaLexer(scanTokens, alexScanTokens, Token(..), PosToken(..), AlexPosn(..)) +where +import Data.Data (Data) + + } +%wrapper "monad" + +@exponentPart = ([eE] ("+"| "-") ? [0-9] ([0-9_]* [0-9]) ?) +@floatTypeSuffix = ([fFdD]) +$backslash = [\\] + +tokens :- "tok_AdditiveOp_dummy_178" { simple Tk__tok_AdditiveOp_dummy_178 } + "tok_Annotation_dummy_177" { simple Tk__tok_Annotation_dummy_177 } + "tok_AnnotationArguments_dummy_176" { simple Tk__tok_AnnotationArguments_dummy_176 } + "tok_AnnotationDeclaration_dummy_175" { simple Tk__tok_AnnotationDeclaration_dummy_175 } + "tok_AnnotationElement_dummy_174" { simple Tk__tok_AnnotationElement_dummy_174 } + "tok_AnnotationList_dummy_173" { simple Tk__tok_AnnotationList_dummy_173 } + "tok_AnnotationTypeElement_dummy_172" { simple Tk__tok_AnnotationTypeElement_dummy_172 } + "tok_AnnotationTypeElementList_dummy_171" { simple Tk__tok_AnnotationTypeElementList_dummy_171 } + "tok_Arglist_dummy_170" { simple Tk__tok_Arglist_dummy_170 } + "tok_AssignmentOp_dummy_169" { simple Tk__tok_AssignmentOp_dummy_169 } + "tok_CatchList_dummy_168" { simple Tk__tok_CatchList_dummy_168 } + "tok_ClassDeclaration_dummy_167" { simple Tk__tok_ClassDeclaration_dummy_167 } + "tok_ClassOrInterfaceType_dummy_166" { simple Tk__tok_ClassOrInterfaceType_dummy_166 } + "tok_CompilationUnit_dummy_165" { simple Tk__tok_CompilationUnit_dummy_165 } + "tok_CompoundName_dummy_164" { simple Tk__tok_CompoundName_dummy_164 } + "tok_CompoundNameTail_dummy_163" { simple Tk__tok_CompoundNameTail_dummy_163 } + "tok_CreationExpression_dummy_162" { simple Tk__tok_CreationExpression_dummy_162 } + "tok_DimExprs_dummy_161" { simple Tk__tok_DimExprs_dummy_161 } + "tok_Dims_dummy_160" { simple Tk__tok_Dims_dummy_160 } + "tok_DoStatement_dummy_159" { simple Tk__tok_DoStatement_dummy_159 } + "tok_DocComment_dummy_158" { simple Tk__tok_DocComment_dummy_158 } + "tok_EnumConstant_dummy_157" { simple Tk__tok_EnumConstant_dummy_157 } + "tok_EnumConstantList_dummy_156" { simple Tk__tok_EnumConstantList_dummy_156 } + "tok_EnumDeclaration_dummy_155" { simple Tk__tok_EnumDeclaration_dummy_155 } + "tok_EqualityOp_dummy_154" { simple Tk__tok_EqualityOp_dummy_154 } + "tok_Expression_dummy_153" { simple Tk__tok_Expression_dummy_153 } + "tok_ExtendsList_dummy_152" { simple Tk__tok_ExtendsList_dummy_152 } + "tok_FieldDeclaration_dummy_151" { simple Tk__tok_FieldDeclaration_dummy_151 } + "tok_FieldDeclarationList_dummy_150" { simple Tk__tok_FieldDeclarationList_dummy_150 } + "tok_ForStatement_dummy_149" { simple Tk__tok_ForStatement_dummy_149 } + "tok_IfStatement_dummy_148" { simple Tk__tok_IfStatement_dummy_148 } + "tok_ImplementsList_dummy_147" { simple Tk__tok_ImplementsList_dummy_147 } + "tok_ImportHead_dummy_146" { simple Tk__tok_ImportHead_dummy_146 } + "tok_ImportList_dummy_145" { simple Tk__tok_ImportList_dummy_145 } + "tok_ImportName_dummy_144" { simple Tk__tok_ImportName_dummy_144 } + "tok_ImportStatement_dummy_143" { simple Tk__tok_ImportStatement_dummy_143 } + "tok_InterfaceDeclaration_dummy_142" { simple Tk__tok_InterfaceDeclaration_dummy_142 } + "tok_Java_dummy_179" { simple Tk__tok_Java_dummy_179 } + "tok_Literal_dummy_141" { simple Tk__tok_Literal_dummy_141 } + "tok_LocalModifierList1_dummy_140" { simple Tk__tok_LocalModifierList1_dummy_140 } + "tok_MemberAfterFirstId_dummy_139" { simple Tk__tok_MemberAfterFirstId_dummy_139 } + "tok_MemberDeclaration_dummy_138" { simple Tk__tok_MemberDeclaration_dummy_138 } + "tok_MemberRest_dummy_137" { simple Tk__tok_MemberRest_dummy_137 } + "tok_Modifier_dummy_136" { simple Tk__tok_Modifier_dummy_136 } + "tok_ModifierList_dummy_135" { simple Tk__tok_ModifierList_dummy_135 } + "tok_MoreTypeSpecifier_dummy_134" { simple Tk__tok_MoreTypeSpecifier_dummy_134 } + "tok_MoreVariableDeclarators_dummy_133" { simple Tk__tok_MoreVariableDeclarators_dummy_133 } + "tok_MultiplicativeOp_dummy_132" { simple Tk__tok_MultiplicativeOp_dummy_132 } + "tok_NonEmptyDims_dummy_131" { simple Tk__tok_NonEmptyDims_dummy_131 } + "tok_NonEmptyTypeArguments_dummy_130" { simple Tk__tok_NonEmptyTypeArguments_dummy_130 } + "tok_OptDocComment_dummy_129" { simple Tk__tok_OptDocComment_dummy_129 } + "tok_OptElsePart_dummy_128" { simple Tk__tok_OptElsePart_dummy_128 } + "tok_OptExpression_dummy_127" { simple Tk__tok_OptExpression_dummy_127 } + "tok_OptFinally_dummy_126" { simple Tk__tok_OptFinally_dummy_126 } + "tok_OptId_dummy_125" { simple Tk__tok_OptId_dummy_125 } + "tok_OptVariableInitializer_dummy_124" { simple Tk__tok_OptVariableInitializer_dummy_124 } + "tok_Package_dummy_123" { simple Tk__tok_Package_dummy_123 } + "tok_ParamModifierList_dummy_122" { simple Tk__tok_ParamModifierList_dummy_122 } + "tok_Parameter_dummy_121" { simple Tk__tok_Parameter_dummy_121 } + "tok_ParameterList_dummy_120" { simple Tk__tok_ParameterList_dummy_120 } + "tok_PostfixOp_dummy_119" { simple Tk__tok_PostfixOp_dummy_119 } + "tok_PrefixOp_dummy_118" { simple Tk__tok_PrefixOp_dummy_118 } + "tok_PrimitiveTypeKeyword_dummy_117" { simple Tk__tok_PrimitiveTypeKeyword_dummy_117 } + "tok_RelationalOp_dummy_116" { simple Tk__tok_RelationalOp_dummy_116 } + "tok_ShiftOp_dummy_115" { simple Tk__tok_ShiftOp_dummy_115 } + "tok_Statement_dummy_114" { simple Tk__tok_Statement_dummy_114 } + "tok_StatementBlock_dummy_113" { simple Tk__tok_StatementBlock_dummy_113 } + "tok_StatementList_dummy_112" { simple Tk__tok_StatementList_dummy_112 } + "tok_StaticInitializer_dummy_111" { simple Tk__tok_StaticInitializer_dummy_111 } + "tok_SwitchCaseList_dummy_110" { simple Tk__tok_SwitchCaseList_dummy_110 } + "tok_SwitchStatement_dummy_109" { simple Tk__tok_SwitchStatement_dummy_109 } + "tok_ThrowsClause_dummy_108" { simple Tk__tok_ThrowsClause_dummy_108 } + "tok_TryStatement_dummy_107" { simple Tk__tok_TryStatement_dummy_107 } + "tok_Type_dummy_106" { simple Tk__tok_Type_dummy_106 } + "tok_TypeArgument_dummy_105" { simple Tk__tok_TypeArgument_dummy_105 } + "tok_TypeArguments_dummy_104" { simple Tk__tok_TypeArguments_dummy_104 } + "tok_TypeDeclRest_dummy_103" { simple Tk__tok_TypeDeclRest_dummy_103 } + "tok_TypeDeclaration_dummy_102" { simple Tk__tok_TypeDeclaration_dummy_102 } + "tok_TypeParameter_dummy_101" { simple Tk__tok_TypeParameter_dummy_101 } + "tok_TypeParameters_dummy_100" { simple Tk__tok_TypeParameters_dummy_100 } + "tok_TypeSpecifier_dummy_99" { simple Tk__tok_TypeSpecifier_dummy_99 } + "tok_VariableDeclaration_dummy_98" { simple Tk__tok_VariableDeclaration_dummy_98 } + "tok_VariableDeclarator_dummy_97" { simple Tk__tok_VariableDeclarator_dummy_97 } + "tok_VariableDeclaratorList_dummy_96" { simple Tk__tok_VariableDeclaratorList_dummy_96 } + "tok_VariableInitializer_dummy_95" { simple Tk__tok_VariableInitializer_dummy_95 } + "tok_VariableInitializerList_dummy_94" { simple Tk__tok_VariableInitializerList_dummy_94 } + "tok_WhileStatement_dummy_93" { simple Tk__tok_WhileStatement_dummy_93 } + "tok_WildcardType_dummy_92" { simple Tk__tok_WildcardType_dummy_92 } + "~" { simple Tk__tok__tilde__82 } + "}" { simple Tk__tok__symbol__15 } + "||" { simple Tk__tok__pipe__pipe__63 } + "|=" { simple Tk__tok__pipe__eql__55 } + "|" { simple Tk__tok__pipe__65 } + "{" { simple Tk__tok__symbol__14 } + "while" { simple Tk__tok_while_44 } + "void" { simple Tk__tok_void_28 } + "try" { simple Tk__tok_try_48 } + "true" { simple Tk__tok_true_85 } + "transient" { simple Tk__tok_transient_94 } + "throws" { simple Tk__tok_throws_29 } + "throw" { simple Tk__tok_throw_35 } + "threadsafe" { simple Tk__tok_threadsafe_93 } + "this" { simple Tk__tok_this_40 } + "synchronized" { simple Tk__tok_synchronized_34 } + "switch" { simple Tk__tok_switch_50 } + "super" { simple Tk__tok_super_39 } + "static" { simple Tk__tok_static_3 } + "short" { simple Tk__tok_short_23 } + "return" { simple Tk__tok_return_33 } + "public" { simple Tk__tok_public_88 } + "protected" { simple Tk__tok_protected_90 } + "private" { simple Tk__tok_private_89 } + "package" { simple Tk__tok_package_0 } + "null" { simple Tk__tok_null_87 } + "new" { simple Tk__tok_new_84 } + "native" { simple Tk__tok_native_91 } + "long" { simple Tk__tok_long_26 } + "interface" { simple Tk__tok_interface_16 } + "int" { simple Tk__tok_int_24 } + "instanceof" { simple Tk__tok_instanceof_74 } + "import" { simple Tk__tok_import_2 } + "implements" { simple Tk__tok_implements_12 } + "if" { simple Tk__tok_if_42 } + "for" { simple Tk__tok_for_45 } + "float" { simple Tk__tok_float_25 } + "finally" { simple Tk__tok_finally_47 } + "final" { simple Tk__tok_final_31 } + "false" { simple Tk__tok_false_86 } + "extends" { simple Tk__tok_extends_11 } + "enum" { simple Tk__tok_enum_17 } + "else" { simple Tk__tok_else_41 } + "double" { simple Tk__tok_double_27 } + "do" { simple Tk__tok_do_43 } + "default" { simple Tk__tok_default_30 } + "continue" { simple Tk__tok_continue_38 } + "class" { simple Tk__tok_class_13 } + "char" { simple Tk__tok_char_22 } + "catch" { simple Tk__tok_catch_46 } + "case" { simple Tk__tok_case_49 } + "byte" { simple Tk__tok_byte_21 } + "break" { simple Tk__tok_break_37 } + "boolean" { simple Tk__tok_boolean_20 } + "abstract" { simple Tk__tok_abstract_92 } + "^=" { simple Tk__tok__symbol__eql__57 } + "^" { simple Tk__tok__symbol__66 } + "]" { simple Tk__tok__sq_bkt_r__19 } + "[" { simple Tk__tok__sq_bkt_l__18 } + "@" { simple Tk__tok__symbol__6 } + "?" { simple Tk__tok__symbol__62 } + ">>>=" { simple Tk__tok__symbol__symbol__symbol__eql__61 } + ">>=" { simple Tk__tok__symbol__symbol__eql__60 } + ">=" { simple Tk__tok__symbol__eql__73 } + ">" { simple Tk__tok__symbol__71 } + "==" { simple Tk__tok__eql__eql__68 } + "=" { simple Tk__tok__eql__10 } + "<=" { simple Tk__tok__symbol__eql__72 } + "<<=" { simple Tk__tok__symbol__symbol__eql__59 } + "<<" { simple Tk__tok__symbol__symbol__75 } + "<" { simple Tk__tok__symbol__70 } + ";" { simple Tk__tok__semi__1 } + ":" { simple Tk__tok__colon__36 } + "/=" { simple Tk__tok__symbol__eql__54 } + "/" { simple Tk__tok__symbol__78 } + "..." { simple Tk__tok__dot__dot__dot__32 } + "." { simple Tk__tok__dot__4 } + "-=" { simple Tk__tok__minus__eql__52 } + "--" { simple Tk__tok__minus__minus__81 } + "-" { simple Tk__tok__minus__77 } + "," { simple Tk__tok__coma__9 } + "+=" { simple Tk__tok__plus__eql__51 } + "++" { simple Tk__tok__plus__plus__80 } + "+" { simple Tk__tok__plus__76 } + "*=" { simple Tk__tok__star__eql__53 } + "*" { simple Tk__tok__star__5 } + ")" { simple Tk__tok__rparen__8 } + "(" { simple Tk__tok__lparen__7 } + "&=" { simple Tk__tok__symbol__eql__56 } + "&&" { simple Tk__tok__symbol__symbol__64 } + "&" { simple Tk__tok__symbol__67 } + "%=" { simple Tk__tok__symbol__eql__58 } + "%" { simple Tk__tok__symbol__79 } + "!=" { simple Tk__tok__exclamation__eql__69 } + "!" { simple Tk__tok__exclamation__83 } + ("/*" ([^\*\n]| [\n]) ([\n]| [^\*\n]| [\*] [^\/\n]| [\*] [\n])* "*/") ; + ("//" [^\n]* \n) ; + ([\ \t\n\r]+) ; + ("/**" ([\n]| [^\*\n]| [\*] [^\/\n]| [\*] [\n])* "*/") { simple1 $ Tk__doccomment . (id) } + ([a-zA-Z\$_] [a-zA-Z\$_0-9]*) { simple1 $ Tk__id . (id) } + ([\"] ([^\"\\\n\r]| $backslash .)* [\"]) { simple1 $ Tk__string . (id) } + ("'" . "'"| "'" $backslash . "'"| "'" $backslash [0-7] [0-7] "'"| "'" $backslash [0-3] [0-7] [0-7] "'"| "'" $backslash "u" [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] "'") { simple1 $ Tk__char . (id) } + ([fFdD]) { simple1 $ Tk__floatTypeSuffix . (id) } + ([eE] ("+"| "-") ? [0-9] ([0-9_]* [0-9]) ?) { simple1 $ Tk__exponentPart . (id) } + ([0-9] ([0-9_]* [0-9]) ? "." ([0-9] ([0-9_]* [0-9]) ?) ? @exponentPart ? @floatTypeSuffix ?| "." [0-9] ([0-9_]* [0-9]) ? @exponentPart ? @floatTypeSuffix ?| [0-9] ([0-9_]* [0-9]) ? @exponentPart @floatTypeSuffix ?| [0-9] ([0-9_]* [0-9]) ? @floatTypeSuffix) { simple1 $ Tk__floatLiteral . (id) } + (([0-9] ([0-9_]* [0-9]) ?| "0" [xX] [0-9a-fA-F] ([0-9a-fA-F_]* [0-9a-fA-F]) ?| "0" [bB] [01] ([01_]* [01]) ?) [lL] ?) { simple1 $ Tk__integerLiteral . (id) } + ("$" "CompoundName" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_CompoundName . ((tail . dropWhile (/= ':'))) } + ("$" "CompoundNameTail" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_CompoundNameTail . ((tail . dropWhile (/= ':'))) } + ("$" "Modifier" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Modifier . ((tail . dropWhile (/= ':'))) } + ("$" "TypeSpecifier" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TypeSpecifier . ((tail . dropWhile (/= ':'))) } + ("$" "Type" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Type . ((tail . dropWhile (/= ':'))) } + ("$" "TypeParameter" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TypeParameter . ((tail . dropWhile (/= ':'))) } + ("$" "TypeParameters" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TypeParameters . ((tail . dropWhile (/= ':'))) } + ("$" "WildcardType" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_WildcardType . ((tail . dropWhile (/= ':'))) } + ("$" "TypeArgument" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TypeArgument . ((tail . dropWhile (/= ':'))) } + ("$" "NonEmptyTypeArguments" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_NonEmptyTypeArguments . ((tail . dropWhile (/= ':'))) } + ("$" "TypeArguments" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TypeArguments . ((tail . dropWhile (/= ':'))) } + ("$" "Arglist" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Arglist . ((tail . dropWhile (/= ':'))) } + ("$" "Literal" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Literal . ((tail . dropWhile (/= ':'))) } + ("$" "DimExprs" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_DimExprs . ((tail . dropWhile (/= ':'))) } + ("$" "CreationExpression" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_CreationExpression . ((tail . dropWhile (/= ':'))) } + ("$" "PostfixOp" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_PostfixOp . ((tail . dropWhile (/= ':'))) } + ("$" "PrefixOp" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_PrefixOp . ((tail . dropWhile (/= ':'))) } + ("$" "MultiplicativeOp" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_MultiplicativeOp . ((tail . dropWhile (/= ':'))) } + ("$" "AdditiveOp" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_AdditiveOp . ((tail . dropWhile (/= ':'))) } + ("$" "ShiftOp" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ShiftOp . ((tail . dropWhile (/= ':'))) } + ("$" "RelationalOp" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_RelationalOp . ((tail . dropWhile (/= ':'))) } + ("$" "EqualityOp" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_EqualityOp . ((tail . dropWhile (/= ':'))) } + ("$" "AssignmentOp" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_AssignmentOp . ((tail . dropWhile (/= ':'))) } + ("$" "Expression" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Expression . ((tail . dropWhile (/= ':'))) } + ("$" "SwitchStatement" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_SwitchStatement . ((tail . dropWhile (/= ':'))) } + ("$" "SwitchCaseList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_SwitchCaseList . ((tail . dropWhile (/= ':'))) } + ("$" "TryStatement" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TryStatement . ((tail . dropWhile (/= ':'))) } + ("$" "OptFinally" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptFinally . ((tail . dropWhile (/= ':'))) } + ("$" "CatchList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_CatchList . ((tail . dropWhile (/= ':'))) } + ("$" "ForStatement" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ForStatement . ((tail . dropWhile (/= ':'))) } + ("$" "WhileStatement" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_WhileStatement . ((tail . dropWhile (/= ':'))) } + ("$" "DoStatement" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_DoStatement . ((tail . dropWhile (/= ':'))) } + ("$" "IfStatement" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_IfStatement . ((tail . dropWhile (/= ':'))) } + ("$" "OptElsePart" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptElsePart . ((tail . dropWhile (/= ':'))) } + ("$" "Statement" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Statement . ((tail . dropWhile (/= ':'))) } + ("$" "OptId" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptId . ((tail . dropWhile (/= ':'))) } + ("$" "OptExpression" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptExpression . ((tail . dropWhile (/= ':'))) } + ("$" "StatementList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_StatementList . ((tail . dropWhile (/= ':'))) } + ("$" "Parameter" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Parameter . ((tail . dropWhile (/= ':'))) } + ("$" "ParamModifierList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ParamModifierList . ((tail . dropWhile (/= ':'))) } + ("$" "ParameterList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ParameterList . ((tail . dropWhile (/= ':'))) } + ("$" "StaticInitializer" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_StaticInitializer . ((tail . dropWhile (/= ':'))) } + ("$" "VariableInitializer" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_VariableInitializer . ((tail . dropWhile (/= ':'))) } + ("$" "VariableInitializerList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_VariableInitializerList . ((tail . dropWhile (/= ':'))) } + ("$" "VariableDeclarator" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_VariableDeclarator . ((tail . dropWhile (/= ':'))) } + ("$" "OptVariableInitializer" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptVariableInitializer . ((tail . dropWhile (/= ':'))) } + ("$" "LocalModifierList1" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_LocalModifierList1 . ((tail . dropWhile (/= ':'))) } + ("$" "VariableDeclaration" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_VariableDeclaration . ((tail . dropWhile (/= ':'))) } + ("$" "VariableDeclaratorList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_VariableDeclaratorList . ((tail . dropWhile (/= ':'))) } + ("$" "StatementBlock" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_StatementBlock . ((tail . dropWhile (/= ':'))) } + ("$" "MoreVariableDeclarators" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_MoreVariableDeclarators . ((tail . dropWhile (/= ':'))) } + ("$" "MemberRest" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_MemberRest . ((tail . dropWhile (/= ':'))) } + ("$" "ThrowsClause" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ThrowsClause . ((tail . dropWhile (/= ':'))) } + ("$" "MoreTypeSpecifier" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_MoreTypeSpecifier . ((tail . dropWhile (/= ':'))) } + ("$" "MemberAfterFirstId" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_MemberAfterFirstId . ((tail . dropWhile (/= ':'))) } + ("$" "PrimitiveTypeKeyword" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_PrimitiveTypeKeyword . ((tail . dropWhile (/= ':'))) } + ("$" "MemberDeclaration" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_MemberDeclaration . ((tail . dropWhile (/= ':'))) } + ("$" "NonEmptyDims" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_NonEmptyDims . ((tail . dropWhile (/= ':'))) } + ("$" "Dims" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Dims . ((tail . dropWhile (/= ':'))) } + ("$" "FieldDeclaration" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_FieldDeclaration . ((tail . dropWhile (/= ':'))) } + ("$" "TypeDeclRest" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TypeDeclRest . ((tail . dropWhile (/= ':'))) } + ("$" "EnumDeclaration" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_EnumDeclaration . ((tail . dropWhile (/= ':'))) } + ("$" "EnumConstantList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_EnumConstantList . ((tail . dropWhile (/= ':'))) } + ("$" "EnumConstant" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_EnumConstant . ((tail . dropWhile (/= ':'))) } + ("$" "AnnotationTypeElement" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_AnnotationTypeElement . ((tail . dropWhile (/= ':'))) } + ("$" "AnnotationTypeElementList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_AnnotationTypeElementList . ((tail . dropWhile (/= ':'))) } + ("$" "AnnotationDeclaration" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_AnnotationDeclaration . ((tail . dropWhile (/= ':'))) } + ("$" "InterfaceDeclaration" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_InterfaceDeclaration . ((tail . dropWhile (/= ':'))) } + ("$" "ClassDeclaration" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ClassDeclaration . ((tail . dropWhile (/= ':'))) } + ("$" "FieldDeclarationList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_FieldDeclarationList . ((tail . dropWhile (/= ':'))) } + ("$" "ImplementsList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ImplementsList . ((tail . dropWhile (/= ':'))) } + ("$" "ExtendsList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ExtendsList . ((tail . dropWhile (/= ':'))) } + ("$" "ClassOrInterfaceType" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ClassOrInterfaceType . ((tail . dropWhile (/= ':'))) } + ("$" "ModifierList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ModifierList . ((tail . dropWhile (/= ':'))) } + ("$" "AnnotationList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_AnnotationList . ((tail . dropWhile (/= ':'))) } + ("$" "AnnotationElement" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_AnnotationElement . ((tail . dropWhile (/= ':'))) } + ("$" "AnnotationArguments" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_AnnotationArguments . ((tail . dropWhile (/= ':'))) } + ("$" "Annotation" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Annotation . ((tail . dropWhile (/= ':'))) } + ("$" "DocComment" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_DocComment . ((tail . dropWhile (/= ':'))) } + ("$" "ImportHead" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ImportHead . ((tail . dropWhile (/= ':'))) } + ("$" "ImportName" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ImportName . ((tail . dropWhile (/= ':'))) } + ("$" "ImportStatement" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ImportStatement . ((tail . dropWhile (/= ':'))) } + ("$" "Package" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Package . ((tail . dropWhile (/= ':'))) } + ("$" "CompilationUnit" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_CompilationUnit . ((tail . dropWhile (/= ':'))) } + ("$" "ImportList" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_ImportList . ((tail . dropWhile (/= ':'))) } + ("$" "TypeDeclaration" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_TypeDeclaration . ((tail . dropWhile (/= ':'))) } + ("$" "OptDocComment" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_OptDocComment . ((tail . dropWhile (/= ':'))) } + ("$" "Java" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Java . ((tail . dropWhile (/= ':'))) } + . { rtkError } + +{ +data Token = EndOfFile | + Tk__tok_AdditiveOp_dummy_178 | + Tk__tok_Annotation_dummy_177 | + Tk__tok_AnnotationArguments_dummy_176 | + Tk__tok_AnnotationDeclaration_dummy_175 | + Tk__tok_AnnotationElement_dummy_174 | + Tk__tok_AnnotationList_dummy_173 | + Tk__tok_AnnotationTypeElement_dummy_172 | + Tk__tok_AnnotationTypeElementList_dummy_171 | + Tk__tok_Arglist_dummy_170 | + Tk__tok_AssignmentOp_dummy_169 | + Tk__tok_CatchList_dummy_168 | + Tk__tok_ClassDeclaration_dummy_167 | + Tk__tok_ClassOrInterfaceType_dummy_166 | + Tk__tok_CompilationUnit_dummy_165 | + Tk__tok_CompoundName_dummy_164 | + Tk__tok_CompoundNameTail_dummy_163 | + Tk__tok_CreationExpression_dummy_162 | + Tk__tok_DimExprs_dummy_161 | + Tk__tok_Dims_dummy_160 | + Tk__tok_DoStatement_dummy_159 | + Tk__tok_DocComment_dummy_158 | + Tk__tok_EnumConstant_dummy_157 | + Tk__tok_EnumConstantList_dummy_156 | + Tk__tok_EnumDeclaration_dummy_155 | + Tk__tok_EqualityOp_dummy_154 | + Tk__tok_Expression_dummy_153 | + Tk__tok_ExtendsList_dummy_152 | + Tk__tok_FieldDeclaration_dummy_151 | + Tk__tok_FieldDeclarationList_dummy_150 | + Tk__tok_ForStatement_dummy_149 | + Tk__tok_IfStatement_dummy_148 | + Tk__tok_ImplementsList_dummy_147 | + Tk__tok_ImportHead_dummy_146 | + Tk__tok_ImportList_dummy_145 | + Tk__tok_ImportName_dummy_144 | + Tk__tok_ImportStatement_dummy_143 | + Tk__tok_InterfaceDeclaration_dummy_142 | + Tk__tok_Java_dummy_179 | + Tk__tok_Literal_dummy_141 | + Tk__tok_LocalModifierList1_dummy_140 | + Tk__tok_MemberAfterFirstId_dummy_139 | + Tk__tok_MemberDeclaration_dummy_138 | + Tk__tok_MemberRest_dummy_137 | + Tk__tok_Modifier_dummy_136 | + Tk__tok_ModifierList_dummy_135 | + Tk__tok_MoreTypeSpecifier_dummy_134 | + Tk__tok_MoreVariableDeclarators_dummy_133 | + Tk__tok_MultiplicativeOp_dummy_132 | + Tk__tok_NonEmptyDims_dummy_131 | + Tk__tok_NonEmptyTypeArguments_dummy_130 | + Tk__tok_OptDocComment_dummy_129 | + Tk__tok_OptElsePart_dummy_128 | + Tk__tok_OptExpression_dummy_127 | + Tk__tok_OptFinally_dummy_126 | + Tk__tok_OptId_dummy_125 | + Tk__tok_OptVariableInitializer_dummy_124 | + Tk__tok_Package_dummy_123 | + Tk__tok_ParamModifierList_dummy_122 | + Tk__tok_Parameter_dummy_121 | + Tk__tok_ParameterList_dummy_120 | + Tk__tok_PostfixOp_dummy_119 | + Tk__tok_PrefixOp_dummy_118 | + Tk__tok_PrimitiveTypeKeyword_dummy_117 | + Tk__tok_RelationalOp_dummy_116 | + Tk__tok_ShiftOp_dummy_115 | + Tk__tok_Statement_dummy_114 | + Tk__tok_StatementBlock_dummy_113 | + Tk__tok_StatementList_dummy_112 | + Tk__tok_StaticInitializer_dummy_111 | + Tk__tok_SwitchCaseList_dummy_110 | + Tk__tok_SwitchStatement_dummy_109 | + Tk__tok_ThrowsClause_dummy_108 | + Tk__tok_TryStatement_dummy_107 | + Tk__tok_Type_dummy_106 | + Tk__tok_TypeArgument_dummy_105 | + Tk__tok_TypeArguments_dummy_104 | + Tk__tok_TypeDeclRest_dummy_103 | + Tk__tok_TypeDeclaration_dummy_102 | + Tk__tok_TypeParameter_dummy_101 | + Tk__tok_TypeParameters_dummy_100 | + Tk__tok_TypeSpecifier_dummy_99 | + Tk__tok_VariableDeclaration_dummy_98 | + Tk__tok_VariableDeclarator_dummy_97 | + Tk__tok_VariableDeclaratorList_dummy_96 | + Tk__tok_VariableInitializer_dummy_95 | + Tk__tok_VariableInitializerList_dummy_94 | + Tk__tok_WhileStatement_dummy_93 | + Tk__tok_WildcardType_dummy_92 | + Tk__tok__tilde__82 | + Tk__tok__symbol__15 | + Tk__tok__pipe__pipe__63 | + Tk__tok__pipe__eql__55 | + Tk__tok__pipe__65 | + Tk__tok__symbol__14 | + Tk__tok_while_44 | + Tk__tok_void_28 | + Tk__tok_try_48 | + Tk__tok_true_85 | + Tk__tok_transient_94 | + Tk__tok_throws_29 | + Tk__tok_throw_35 | + Tk__tok_threadsafe_93 | + Tk__tok_this_40 | + Tk__tok_synchronized_34 | + Tk__tok_switch_50 | + Tk__tok_super_39 | + Tk__tok_static_3 | + Tk__tok_short_23 | + Tk__tok_return_33 | + Tk__tok_public_88 | + Tk__tok_protected_90 | + Tk__tok_private_89 | + Tk__tok_package_0 | + Tk__tok_null_87 | + Tk__tok_new_84 | + Tk__tok_native_91 | + Tk__tok_long_26 | + Tk__tok_interface_16 | + Tk__tok_int_24 | + Tk__tok_instanceof_74 | + Tk__tok_import_2 | + Tk__tok_implements_12 | + Tk__tok_if_42 | + Tk__tok_for_45 | + Tk__tok_float_25 | + Tk__tok_finally_47 | + Tk__tok_final_31 | + Tk__tok_false_86 | + Tk__tok_extends_11 | + Tk__tok_enum_17 | + Tk__tok_else_41 | + Tk__tok_double_27 | + Tk__tok_do_43 | + Tk__tok_default_30 | + Tk__tok_continue_38 | + Tk__tok_class_13 | + Tk__tok_char_22 | + Tk__tok_catch_46 | + Tk__tok_case_49 | + Tk__tok_byte_21 | + Tk__tok_break_37 | + Tk__tok_boolean_20 | + Tk__tok_abstract_92 | + Tk__tok__symbol__eql__57 | + Tk__tok__symbol__66 | + Tk__tok__sq_bkt_r__19 | + Tk__tok__sq_bkt_l__18 | + Tk__tok__symbol__6 | + Tk__tok__symbol__62 | + Tk__tok__symbol__symbol__symbol__eql__61 | + Tk__tok__symbol__symbol__eql__60 | + Tk__tok__symbol__eql__73 | + Tk__tok__symbol__71 | + Tk__tok__eql__eql__68 | + Tk__tok__eql__10 | + Tk__tok__symbol__eql__72 | + Tk__tok__symbol__symbol__eql__59 | + Tk__tok__symbol__symbol__75 | + Tk__tok__symbol__70 | + Tk__tok__semi__1 | + Tk__tok__colon__36 | + Tk__tok__symbol__eql__54 | + Tk__tok__symbol__78 | + Tk__tok__dot__dot__dot__32 | + Tk__tok__dot__4 | + Tk__tok__minus__eql__52 | + Tk__tok__minus__minus__81 | + Tk__tok__minus__77 | + Tk__tok__coma__9 | + Tk__tok__plus__eql__51 | + Tk__tok__plus__plus__80 | + Tk__tok__plus__76 | + Tk__tok__star__eql__53 | + Tk__tok__star__5 | + Tk__tok__rparen__8 | + Tk__tok__lparen__7 | + Tk__tok__symbol__eql__56 | + Tk__tok__symbol__symbol__64 | + Tk__tok__symbol__67 | + Tk__tok__symbol__eql__58 | + Tk__tok__symbol__79 | + Tk__tok__exclamation__eql__69 | + Tk__tok__exclamation__83 | + Tk__doccomment String | + Tk__id String | + Tk__string String | + Tk__char String | + Tk__floatTypeSuffix String | + Tk__exponentPart String | + Tk__floatLiteral String | + Tk__integerLiteral String | + Tk__qq_CompoundName String | + Tk__qq_CompoundNameTail String | + Tk__qq_Modifier String | + Tk__qq_TypeSpecifier String | + Tk__qq_Type String | + Tk__qq_TypeParameter String | + Tk__qq_TypeParameters String | + Tk__qq_WildcardType String | + Tk__qq_TypeArgument String | + Tk__qq_NonEmptyTypeArguments String | + Tk__qq_TypeArguments String | + Tk__qq_Arglist String | + Tk__qq_Literal String | + Tk__qq_DimExprs String | + Tk__qq_CreationExpression String | + Tk__qq_PostfixOp String | + Tk__qq_PrefixOp String | + Tk__qq_MultiplicativeOp String | + Tk__qq_AdditiveOp String | + Tk__qq_ShiftOp String | + Tk__qq_RelationalOp String | + Tk__qq_EqualityOp String | + Tk__qq_AssignmentOp String | + Tk__qq_Expression String | + Tk__qq_SwitchStatement String | + Tk__qq_SwitchCaseList String | + Tk__qq_TryStatement String | + Tk__qq_OptFinally String | + Tk__qq_CatchList String | + Tk__qq_ForStatement String | + Tk__qq_WhileStatement String | + Tk__qq_DoStatement String | + Tk__qq_IfStatement String | + Tk__qq_OptElsePart String | + Tk__qq_Statement String | + Tk__qq_OptId String | + Tk__qq_OptExpression String | + Tk__qq_StatementList String | + Tk__qq_Parameter String | + Tk__qq_ParamModifierList String | + Tk__qq_ParameterList String | + Tk__qq_StaticInitializer String | + Tk__qq_VariableInitializer String | + Tk__qq_VariableInitializerList String | + Tk__qq_VariableDeclarator String | + Tk__qq_OptVariableInitializer String | + Tk__qq_LocalModifierList1 String | + Tk__qq_VariableDeclaration String | + Tk__qq_VariableDeclaratorList String | + Tk__qq_StatementBlock String | + Tk__qq_MoreVariableDeclarators String | + Tk__qq_MemberRest String | + Tk__qq_ThrowsClause String | + Tk__qq_MoreTypeSpecifier String | + Tk__qq_MemberAfterFirstId String | + Tk__qq_PrimitiveTypeKeyword String | + Tk__qq_MemberDeclaration String | + Tk__qq_NonEmptyDims String | + Tk__qq_Dims String | + Tk__qq_FieldDeclaration String | + Tk__qq_TypeDeclRest String | + Tk__qq_EnumDeclaration String | + Tk__qq_EnumConstantList String | + Tk__qq_EnumConstant String | + Tk__qq_AnnotationTypeElement String | + Tk__qq_AnnotationTypeElementList String | + Tk__qq_AnnotationDeclaration String | + Tk__qq_InterfaceDeclaration String | + Tk__qq_ClassDeclaration String | + Tk__qq_FieldDeclarationList String | + Tk__qq_ImplementsList String | + Tk__qq_ExtendsList String | + Tk__qq_ClassOrInterfaceType String | + Tk__qq_ModifierList String | + Tk__qq_AnnotationList String | + Tk__qq_AnnotationElement String | + Tk__qq_AnnotationArguments String | + Tk__qq_Annotation String | + Tk__qq_DocComment String | + Tk__qq_ImportHead String | + Tk__qq_ImportName String | + Tk__qq_ImportStatement String | + Tk__qq_Package String | + Tk__qq_CompilationUnit String | + Tk__qq_ImportList String | + Tk__qq_TypeDeclaration String | + Tk__qq_OptDocComment String | + Tk__qq_Java String + deriving (Show) + +-- AlexPosn is defined by the alex wrapper, so the Data instance (required by +-- the parser's RtkPos position type) can only be attached via standalone +-- deriving - the same solution as the hand-written Lexer.x +deriving instance Data AlexPosn + +-- A token together with the source position where it starts +data PosToken = PosToken { ptPos :: AlexPosn, ptToken :: Token } + deriving (Show) + +alexEOF = do + (pos, _, _, _) <- alexGetInput + return $ PosToken pos EndOfFile + +-- Lex the input into a token stream, returning the positioned error message +-- on a lexical error (encoded as "LINE:COL:message", see rtkError below). +-- The returned list always ends with an EndOfFile token that carries the +-- position of the end of input, so parse errors at end of input can be +-- reported with a position too +scanTokens :: String -> Either String [PosToken] +scanTokens str = runAlex str $ do + let loop toks = do tok <- alexMonadScan + case tok of + PosToken _ EndOfFile -> return $ reverse (tok : toks) + _ -> let toks' = tok : toks + in toks' `seq` loop toks' + loop [] + +-- Thin compatibility wrapper: callers that have not switched to 'scanTokens' +-- get the error message thrown instead +alexScanTokens :: String -> [PosToken] +alexScanTokens str = + case scanTokens str of + Right toks -> toks + Left err -> errorWithoutStackTrace err + +simple1 :: (String -> Token) -> AlexInput -> Int -> Alex PosToken +simple1 t (pos, _, _, str) len = return $ PosToken pos (t (take len str)) + +simple :: Token -> AlexInput -> Int -> Alex PosToken +simple t (pos, _, _, _) len = return $ PosToken pos t + +-- Encode the position as "LINE:COL:message" so callers can split it back out +-- into a structured position - the same encoding the rtk grammar lexer uses +rtkError ((AlexPn _ line column), _, _, str) len = alexError $ (show line) ++ ":" ++ (show column) ++ ":lexical error. Following chars: " ++ (take 10 str) + +} diff --git a/test/golden/java/JavaParser.y b/test/golden/java/JavaParser.y new file mode 100644 --- /dev/null +++ b/test/golden/java/JavaParser.y @@ -0,0 +1,2985 @@ +-- Generated by RTK from grammar 'Java'. Do not edit by hand. +{ +{-# LANGUAGE DeriveDataTypeable #-} +module JavaParser where +import qualified Data.Generics as Gen +import qualified JavaLexer as L (Token(..), PosToken(..), AlexPosn(..), alexScanTokens) +} + +%name parseJava +%tokentype { L.PosToken } +%monad { Either String } +%error { parseError } + +%token + +rtk__eof { L.PosToken _ L.EndOfFile } +tok_AdditiveOp_dummy_178 { L.PosToken _ L.Tk__tok_AdditiveOp_dummy_178 } +tok_Annotation_dummy_177 { L.PosToken _ L.Tk__tok_Annotation_dummy_177 } +tok_AnnotationArguments_dummy_176 { L.PosToken _ L.Tk__tok_AnnotationArguments_dummy_176 } +tok_AnnotationDeclaration_dummy_175 { L.PosToken _ L.Tk__tok_AnnotationDeclaration_dummy_175 } +tok_AnnotationElement_dummy_174 { L.PosToken _ L.Tk__tok_AnnotationElement_dummy_174 } +tok_AnnotationList_dummy_173 { L.PosToken _ L.Tk__tok_AnnotationList_dummy_173 } +tok_AnnotationTypeElement_dummy_172 { L.PosToken _ L.Tk__tok_AnnotationTypeElement_dummy_172 } +tok_AnnotationTypeElementList_dummy_171 { L.PosToken _ L.Tk__tok_AnnotationTypeElementList_dummy_171 } +tok_Arglist_dummy_170 { L.PosToken _ L.Tk__tok_Arglist_dummy_170 } +tok_AssignmentOp_dummy_169 { L.PosToken _ L.Tk__tok_AssignmentOp_dummy_169 } +tok_CatchList_dummy_168 { L.PosToken _ L.Tk__tok_CatchList_dummy_168 } +tok_ClassDeclaration_dummy_167 { L.PosToken _ L.Tk__tok_ClassDeclaration_dummy_167 } +tok_ClassOrInterfaceType_dummy_166 { L.PosToken _ L.Tk__tok_ClassOrInterfaceType_dummy_166 } +tok_CompilationUnit_dummy_165 { L.PosToken _ L.Tk__tok_CompilationUnit_dummy_165 } +tok_CompoundName_dummy_164 { L.PosToken _ L.Tk__tok_CompoundName_dummy_164 } +tok_CompoundNameTail_dummy_163 { L.PosToken _ L.Tk__tok_CompoundNameTail_dummy_163 } +tok_CreationExpression_dummy_162 { L.PosToken _ L.Tk__tok_CreationExpression_dummy_162 } +tok_DimExprs_dummy_161 { L.PosToken _ L.Tk__tok_DimExprs_dummy_161 } +tok_Dims_dummy_160 { L.PosToken _ L.Tk__tok_Dims_dummy_160 } +tok_DoStatement_dummy_159 { L.PosToken _ L.Tk__tok_DoStatement_dummy_159 } +tok_DocComment_dummy_158 { L.PosToken _ L.Tk__tok_DocComment_dummy_158 } +tok_EnumConstant_dummy_157 { L.PosToken _ L.Tk__tok_EnumConstant_dummy_157 } +tok_EnumConstantList_dummy_156 { L.PosToken _ L.Tk__tok_EnumConstantList_dummy_156 } +tok_EnumDeclaration_dummy_155 { L.PosToken _ L.Tk__tok_EnumDeclaration_dummy_155 } +tok_EqualityOp_dummy_154 { L.PosToken _ L.Tk__tok_EqualityOp_dummy_154 } +tok_Expression_dummy_153 { L.PosToken _ L.Tk__tok_Expression_dummy_153 } +tok_ExtendsList_dummy_152 { L.PosToken _ L.Tk__tok_ExtendsList_dummy_152 } +tok_FieldDeclaration_dummy_151 { L.PosToken _ L.Tk__tok_FieldDeclaration_dummy_151 } +tok_FieldDeclarationList_dummy_150 { L.PosToken _ L.Tk__tok_FieldDeclarationList_dummy_150 } +tok_ForStatement_dummy_149 { L.PosToken _ L.Tk__tok_ForStatement_dummy_149 } +tok_IfStatement_dummy_148 { L.PosToken _ L.Tk__tok_IfStatement_dummy_148 } +tok_ImplementsList_dummy_147 { L.PosToken _ L.Tk__tok_ImplementsList_dummy_147 } +tok_ImportHead_dummy_146 { L.PosToken _ L.Tk__tok_ImportHead_dummy_146 } +tok_ImportList_dummy_145 { L.PosToken _ L.Tk__tok_ImportList_dummy_145 } +tok_ImportName_dummy_144 { L.PosToken _ L.Tk__tok_ImportName_dummy_144 } +tok_ImportStatement_dummy_143 { L.PosToken _ L.Tk__tok_ImportStatement_dummy_143 } +tok_InterfaceDeclaration_dummy_142 { L.PosToken _ L.Tk__tok_InterfaceDeclaration_dummy_142 } +tok_Java_dummy_179 { L.PosToken _ L.Tk__tok_Java_dummy_179 } +tok_Literal_dummy_141 { L.PosToken _ L.Tk__tok_Literal_dummy_141 } +tok_LocalModifierList1_dummy_140 { L.PosToken _ L.Tk__tok_LocalModifierList1_dummy_140 } +tok_MemberAfterFirstId_dummy_139 { L.PosToken _ L.Tk__tok_MemberAfterFirstId_dummy_139 } +tok_MemberDeclaration_dummy_138 { L.PosToken _ L.Tk__tok_MemberDeclaration_dummy_138 } +tok_MemberRest_dummy_137 { L.PosToken _ L.Tk__tok_MemberRest_dummy_137 } +tok_Modifier_dummy_136 { L.PosToken _ L.Tk__tok_Modifier_dummy_136 } +tok_ModifierList_dummy_135 { L.PosToken _ L.Tk__tok_ModifierList_dummy_135 } +tok_MoreTypeSpecifier_dummy_134 { L.PosToken _ L.Tk__tok_MoreTypeSpecifier_dummy_134 } +tok_MoreVariableDeclarators_dummy_133 { L.PosToken _ L.Tk__tok_MoreVariableDeclarators_dummy_133 } +tok_MultiplicativeOp_dummy_132 { L.PosToken _ L.Tk__tok_MultiplicativeOp_dummy_132 } +tok_NonEmptyDims_dummy_131 { L.PosToken _ L.Tk__tok_NonEmptyDims_dummy_131 } +tok_NonEmptyTypeArguments_dummy_130 { L.PosToken _ L.Tk__tok_NonEmptyTypeArguments_dummy_130 } +tok_OptDocComment_dummy_129 { L.PosToken _ L.Tk__tok_OptDocComment_dummy_129 } +tok_OptElsePart_dummy_128 { L.PosToken _ L.Tk__tok_OptElsePart_dummy_128 } +tok_OptExpression_dummy_127 { L.PosToken _ L.Tk__tok_OptExpression_dummy_127 } +tok_OptFinally_dummy_126 { L.PosToken _ L.Tk__tok_OptFinally_dummy_126 } +tok_OptId_dummy_125 { L.PosToken _ L.Tk__tok_OptId_dummy_125 } +tok_OptVariableInitializer_dummy_124 { L.PosToken _ L.Tk__tok_OptVariableInitializer_dummy_124 } +tok_Package_dummy_123 { L.PosToken _ L.Tk__tok_Package_dummy_123 } +tok_ParamModifierList_dummy_122 { L.PosToken _ L.Tk__tok_ParamModifierList_dummy_122 } +tok_Parameter_dummy_121 { L.PosToken _ L.Tk__tok_Parameter_dummy_121 } +tok_ParameterList_dummy_120 { L.PosToken _ L.Tk__tok_ParameterList_dummy_120 } +tok_PostfixOp_dummy_119 { L.PosToken _ L.Tk__tok_PostfixOp_dummy_119 } +tok_PrefixOp_dummy_118 { L.PosToken _ L.Tk__tok_PrefixOp_dummy_118 } +tok_PrimitiveTypeKeyword_dummy_117 { L.PosToken _ L.Tk__tok_PrimitiveTypeKeyword_dummy_117 } +tok_RelationalOp_dummy_116 { L.PosToken _ L.Tk__tok_RelationalOp_dummy_116 } +tok_ShiftOp_dummy_115 { L.PosToken _ L.Tk__tok_ShiftOp_dummy_115 } +tok_Statement_dummy_114 { L.PosToken _ L.Tk__tok_Statement_dummy_114 } +tok_StatementBlock_dummy_113 { L.PosToken _ L.Tk__tok_StatementBlock_dummy_113 } +tok_StatementList_dummy_112 { L.PosToken _ L.Tk__tok_StatementList_dummy_112 } +tok_StaticInitializer_dummy_111 { L.PosToken _ L.Tk__tok_StaticInitializer_dummy_111 } +tok_SwitchCaseList_dummy_110 { L.PosToken _ L.Tk__tok_SwitchCaseList_dummy_110 } +tok_SwitchStatement_dummy_109 { L.PosToken _ L.Tk__tok_SwitchStatement_dummy_109 } +tok_ThrowsClause_dummy_108 { L.PosToken _ L.Tk__tok_ThrowsClause_dummy_108 } +tok_TryStatement_dummy_107 { L.PosToken _ L.Tk__tok_TryStatement_dummy_107 } +tok_Type_dummy_106 { L.PosToken _ L.Tk__tok_Type_dummy_106 } +tok_TypeArgument_dummy_105 { L.PosToken _ L.Tk__tok_TypeArgument_dummy_105 } +tok_TypeArguments_dummy_104 { L.PosToken _ L.Tk__tok_TypeArguments_dummy_104 } +tok_TypeDeclRest_dummy_103 { L.PosToken _ L.Tk__tok_TypeDeclRest_dummy_103 } +tok_TypeDeclaration_dummy_102 { L.PosToken _ L.Tk__tok_TypeDeclaration_dummy_102 } +tok_TypeParameter_dummy_101 { L.PosToken _ L.Tk__tok_TypeParameter_dummy_101 } +tok_TypeParameters_dummy_100 { L.PosToken _ L.Tk__tok_TypeParameters_dummy_100 } +tok_TypeSpecifier_dummy_99 { L.PosToken _ L.Tk__tok_TypeSpecifier_dummy_99 } +tok_VariableDeclaration_dummy_98 { L.PosToken _ L.Tk__tok_VariableDeclaration_dummy_98 } +tok_VariableDeclarator_dummy_97 { L.PosToken _ L.Tk__tok_VariableDeclarator_dummy_97 } +tok_VariableDeclaratorList_dummy_96 { L.PosToken _ L.Tk__tok_VariableDeclaratorList_dummy_96 } +tok_VariableInitializer_dummy_95 { L.PosToken _ L.Tk__tok_VariableInitializer_dummy_95 } +tok_VariableInitializerList_dummy_94 { L.PosToken _ L.Tk__tok_VariableInitializerList_dummy_94 } +tok_WhileStatement_dummy_93 { L.PosToken _ L.Tk__tok_WhileStatement_dummy_93 } +tok_WildcardType_dummy_92 { L.PosToken _ L.Tk__tok_WildcardType_dummy_92 } +tok__tilde__82 { L.PosToken _ L.Tk__tok__tilde__82 } +tok__symbol__15 { L.PosToken _ L.Tk__tok__symbol__15 } +tok__pipe__pipe__63 { L.PosToken _ L.Tk__tok__pipe__pipe__63 } +tok__pipe__eql__55 { L.PosToken _ L.Tk__tok__pipe__eql__55 } +tok__pipe__65 { L.PosToken _ L.Tk__tok__pipe__65 } +tok__symbol__14 { L.PosToken _ L.Tk__tok__symbol__14 } +tok_while_44 { L.PosToken _ L.Tk__tok_while_44 } +tok_void_28 { L.PosToken _ L.Tk__tok_void_28 } +tok_try_48 { L.PosToken _ L.Tk__tok_try_48 } +tok_true_85 { L.PosToken _ L.Tk__tok_true_85 } +tok_transient_94 { L.PosToken _ L.Tk__tok_transient_94 } +tok_throws_29 { L.PosToken _ L.Tk__tok_throws_29 } +tok_throw_35 { L.PosToken _ L.Tk__tok_throw_35 } +tok_threadsafe_93 { L.PosToken _ L.Tk__tok_threadsafe_93 } +tok_this_40 { L.PosToken _ L.Tk__tok_this_40 } +tok_synchronized_34 { L.PosToken _ L.Tk__tok_synchronized_34 } +tok_switch_50 { L.PosToken _ L.Tk__tok_switch_50 } +tok_super_39 { L.PosToken _ L.Tk__tok_super_39 } +tok_static_3 { L.PosToken _ L.Tk__tok_static_3 } +tok_short_23 { L.PosToken _ L.Tk__tok_short_23 } +tok_return_33 { L.PosToken _ L.Tk__tok_return_33 } +tok_public_88 { L.PosToken _ L.Tk__tok_public_88 } +tok_protected_90 { L.PosToken _ L.Tk__tok_protected_90 } +tok_private_89 { L.PosToken _ L.Tk__tok_private_89 } +tok_package_0 { L.PosToken _ L.Tk__tok_package_0 } +tok_null_87 { L.PosToken _ L.Tk__tok_null_87 } +tok_new_84 { L.PosToken _ L.Tk__tok_new_84 } +tok_native_91 { L.PosToken _ L.Tk__tok_native_91 } +tok_long_26 { L.PosToken _ L.Tk__tok_long_26 } +tok_interface_16 { L.PosToken _ L.Tk__tok_interface_16 } +tok_int_24 { L.PosToken _ L.Tk__tok_int_24 } +tok_instanceof_74 { L.PosToken _ L.Tk__tok_instanceof_74 } +tok_import_2 { L.PosToken _ L.Tk__tok_import_2 } +tok_implements_12 { L.PosToken _ L.Tk__tok_implements_12 } +tok_if_42 { L.PosToken _ L.Tk__tok_if_42 } +tok_for_45 { L.PosToken _ L.Tk__tok_for_45 } +tok_float_25 { L.PosToken _ L.Tk__tok_float_25 } +tok_finally_47 { L.PosToken _ L.Tk__tok_finally_47 } +tok_final_31 { L.PosToken _ L.Tk__tok_final_31 } +tok_false_86 { L.PosToken _ L.Tk__tok_false_86 } +tok_extends_11 { L.PosToken _ L.Tk__tok_extends_11 } +tok_enum_17 { L.PosToken _ L.Tk__tok_enum_17 } +tok_else_41 { L.PosToken _ L.Tk__tok_else_41 } +tok_double_27 { L.PosToken _ L.Tk__tok_double_27 } +tok_do_43 { L.PosToken _ L.Tk__tok_do_43 } +tok_default_30 { L.PosToken _ L.Tk__tok_default_30 } +tok_continue_38 { L.PosToken _ L.Tk__tok_continue_38 } +tok_class_13 { L.PosToken _ L.Tk__tok_class_13 } +tok_char_22 { L.PosToken _ L.Tk__tok_char_22 } +tok_catch_46 { L.PosToken _ L.Tk__tok_catch_46 } +tok_case_49 { L.PosToken _ L.Tk__tok_case_49 } +tok_byte_21 { L.PosToken _ L.Tk__tok_byte_21 } +tok_break_37 { L.PosToken _ L.Tk__tok_break_37 } +tok_boolean_20 { L.PosToken _ L.Tk__tok_boolean_20 } +tok_abstract_92 { L.PosToken _ L.Tk__tok_abstract_92 } +tok__symbol__eql__57 { L.PosToken _ L.Tk__tok__symbol__eql__57 } +tok__symbol__66 { L.PosToken _ L.Tk__tok__symbol__66 } +tok__sq_bkt_r__19 { L.PosToken _ L.Tk__tok__sq_bkt_r__19 } +tok__sq_bkt_l__18 { L.PosToken _ L.Tk__tok__sq_bkt_l__18 } +tok__symbol__6 { L.PosToken _ L.Tk__tok__symbol__6 } +tok__symbol__62 { L.PosToken _ L.Tk__tok__symbol__62 } +tok__symbol__symbol__symbol__eql__61 { L.PosToken _ L.Tk__tok__symbol__symbol__symbol__eql__61 } +tok__symbol__symbol__eql__60 { L.PosToken _ L.Tk__tok__symbol__symbol__eql__60 } +tok__symbol__eql__73 { L.PosToken _ L.Tk__tok__symbol__eql__73 } +tok__symbol__71 { L.PosToken _ L.Tk__tok__symbol__71 } +tok__eql__eql__68 { L.PosToken _ L.Tk__tok__eql__eql__68 } +tok__eql__10 { L.PosToken _ L.Tk__tok__eql__10 } +tok__symbol__eql__72 { L.PosToken _ L.Tk__tok__symbol__eql__72 } +tok__symbol__symbol__eql__59 { L.PosToken _ L.Tk__tok__symbol__symbol__eql__59 } +tok__symbol__symbol__75 { L.PosToken _ L.Tk__tok__symbol__symbol__75 } +tok__symbol__70 { L.PosToken _ L.Tk__tok__symbol__70 } +tok__semi__1 { L.PosToken _ L.Tk__tok__semi__1 } +tok__colon__36 { L.PosToken _ L.Tk__tok__colon__36 } +tok__symbol__eql__54 { L.PosToken _ L.Tk__tok__symbol__eql__54 } +tok__symbol__78 { L.PosToken _ L.Tk__tok__symbol__78 } +tok__dot__dot__dot__32 { L.PosToken _ L.Tk__tok__dot__dot__dot__32 } +tok__dot__4 { L.PosToken _ L.Tk__tok__dot__4 } +tok__minus__eql__52 { L.PosToken _ L.Tk__tok__minus__eql__52 } +tok__minus__minus__81 { L.PosToken _ L.Tk__tok__minus__minus__81 } +tok__minus__77 { L.PosToken _ L.Tk__tok__minus__77 } +tok__coma__9 { L.PosToken _ L.Tk__tok__coma__9 } +tok__plus__eql__51 { L.PosToken _ L.Tk__tok__plus__eql__51 } +tok__plus__plus__80 { L.PosToken _ L.Tk__tok__plus__plus__80 } +tok__plus__76 { L.PosToken _ L.Tk__tok__plus__76 } +tok__star__eql__53 { L.PosToken _ L.Tk__tok__star__eql__53 } +tok__star__5 { L.PosToken _ L.Tk__tok__star__5 } +tok__rparen__8 { L.PosToken _ L.Tk__tok__rparen__8 } +tok__lparen__7 { L.PosToken _ L.Tk__tok__lparen__7 } +tok__symbol__eql__56 { L.PosToken _ L.Tk__tok__symbol__eql__56 } +tok__symbol__symbol__64 { L.PosToken _ L.Tk__tok__symbol__symbol__64 } +tok__symbol__67 { L.PosToken _ L.Tk__tok__symbol__67 } +tok__symbol__eql__58 { L.PosToken _ L.Tk__tok__symbol__eql__58 } +tok__symbol__79 { L.PosToken _ L.Tk__tok__symbol__79 } +tok__exclamation__eql__69 { L.PosToken _ L.Tk__tok__exclamation__eql__69 } +tok__exclamation__83 { L.PosToken _ L.Tk__tok__exclamation__83 } +doccomment { L.PosToken _ (L.Tk__doccomment _) } +id { L.PosToken _ (L.Tk__id _) } +string { L.PosToken _ (L.Tk__string _) } +char { L.PosToken _ (L.Tk__char _) } +floatTypeSuffix { L.PosToken _ (L.Tk__floatTypeSuffix _) } +exponentPart { L.PosToken _ (L.Tk__exponentPart _) } +floatLiteral { L.PosToken _ (L.Tk__floatLiteral _) } +integerLiteral { L.PosToken _ (L.Tk__integerLiteral _) } +qq_CompoundName { L.PosToken _ (L.Tk__qq_CompoundName _) } +qq_CompoundNameTail { L.PosToken _ (L.Tk__qq_CompoundNameTail _) } +qq_Modifier { L.PosToken _ (L.Tk__qq_Modifier _) } +qq_TypeSpecifier { L.PosToken _ (L.Tk__qq_TypeSpecifier _) } +qq_Type { L.PosToken _ (L.Tk__qq_Type _) } +qq_TypeParameter { L.PosToken _ (L.Tk__qq_TypeParameter _) } +qq_TypeParameters { L.PosToken _ (L.Tk__qq_TypeParameters _) } +qq_WildcardType { L.PosToken _ (L.Tk__qq_WildcardType _) } +qq_TypeArgument { L.PosToken _ (L.Tk__qq_TypeArgument _) } +qq_NonEmptyTypeArguments { L.PosToken _ (L.Tk__qq_NonEmptyTypeArguments _) } +qq_TypeArguments { L.PosToken _ (L.Tk__qq_TypeArguments _) } +qq_Arglist { L.PosToken _ (L.Tk__qq_Arglist _) } +qq_Literal { L.PosToken _ (L.Tk__qq_Literal _) } +qq_DimExprs { L.PosToken _ (L.Tk__qq_DimExprs _) } +qq_CreationExpression { L.PosToken _ (L.Tk__qq_CreationExpression _) } +qq_PostfixOp { L.PosToken _ (L.Tk__qq_PostfixOp _) } +qq_PrefixOp { L.PosToken _ (L.Tk__qq_PrefixOp _) } +qq_MultiplicativeOp { L.PosToken _ (L.Tk__qq_MultiplicativeOp _) } +qq_AdditiveOp { L.PosToken _ (L.Tk__qq_AdditiveOp _) } +qq_ShiftOp { L.PosToken _ (L.Tk__qq_ShiftOp _) } +qq_RelationalOp { L.PosToken _ (L.Tk__qq_RelationalOp _) } +qq_EqualityOp { L.PosToken _ (L.Tk__qq_EqualityOp _) } +qq_AssignmentOp { L.PosToken _ (L.Tk__qq_AssignmentOp _) } +qq_Expression { L.PosToken _ (L.Tk__qq_Expression _) } +qq_SwitchStatement { L.PosToken _ (L.Tk__qq_SwitchStatement _) } +qq_SwitchCaseList { L.PosToken _ (L.Tk__qq_SwitchCaseList _) } +qq_TryStatement { L.PosToken _ (L.Tk__qq_TryStatement _) } +qq_OptFinally { L.PosToken _ (L.Tk__qq_OptFinally _) } +qq_CatchList { L.PosToken _ (L.Tk__qq_CatchList _) } +qq_ForStatement { L.PosToken _ (L.Tk__qq_ForStatement _) } +qq_WhileStatement { L.PosToken _ (L.Tk__qq_WhileStatement _) } +qq_DoStatement { L.PosToken _ (L.Tk__qq_DoStatement _) } +qq_IfStatement { L.PosToken _ (L.Tk__qq_IfStatement _) } +qq_OptElsePart { L.PosToken _ (L.Tk__qq_OptElsePart _) } +qq_Statement { L.PosToken _ (L.Tk__qq_Statement _) } +qq_OptId { L.PosToken _ (L.Tk__qq_OptId _) } +qq_OptExpression { L.PosToken _ (L.Tk__qq_OptExpression _) } +qq_StatementList { L.PosToken _ (L.Tk__qq_StatementList _) } +qq_Parameter { L.PosToken _ (L.Tk__qq_Parameter _) } +qq_ParamModifierList { L.PosToken _ (L.Tk__qq_ParamModifierList _) } +qq_ParameterList { L.PosToken _ (L.Tk__qq_ParameterList _) } +qq_StaticInitializer { L.PosToken _ (L.Tk__qq_StaticInitializer _) } +qq_VariableInitializer { L.PosToken _ (L.Tk__qq_VariableInitializer _) } +qq_VariableInitializerList { L.PosToken _ (L.Tk__qq_VariableInitializerList _) } +qq_VariableDeclarator { L.PosToken _ (L.Tk__qq_VariableDeclarator _) } +qq_OptVariableInitializer { L.PosToken _ (L.Tk__qq_OptVariableInitializer _) } +qq_LocalModifierList1 { L.PosToken _ (L.Tk__qq_LocalModifierList1 _) } +qq_VariableDeclaration { L.PosToken _ (L.Tk__qq_VariableDeclaration _) } +qq_VariableDeclaratorList { L.PosToken _ (L.Tk__qq_VariableDeclaratorList _) } +qq_StatementBlock { L.PosToken _ (L.Tk__qq_StatementBlock _) } +qq_MoreVariableDeclarators { L.PosToken _ (L.Tk__qq_MoreVariableDeclarators _) } +qq_MemberRest { L.PosToken _ (L.Tk__qq_MemberRest _) } +qq_ThrowsClause { L.PosToken _ (L.Tk__qq_ThrowsClause _) } +qq_MoreTypeSpecifier { L.PosToken _ (L.Tk__qq_MoreTypeSpecifier _) } +qq_MemberAfterFirstId { L.PosToken _ (L.Tk__qq_MemberAfterFirstId _) } +qq_PrimitiveTypeKeyword { L.PosToken _ (L.Tk__qq_PrimitiveTypeKeyword _) } +qq_MemberDeclaration { L.PosToken _ (L.Tk__qq_MemberDeclaration _) } +qq_NonEmptyDims { L.PosToken _ (L.Tk__qq_NonEmptyDims _) } +qq_Dims { L.PosToken _ (L.Tk__qq_Dims _) } +qq_FieldDeclaration { L.PosToken _ (L.Tk__qq_FieldDeclaration _) } +qq_TypeDeclRest { L.PosToken _ (L.Tk__qq_TypeDeclRest _) } +qq_EnumDeclaration { L.PosToken _ (L.Tk__qq_EnumDeclaration _) } +qq_EnumConstantList { L.PosToken _ (L.Tk__qq_EnumConstantList _) } +qq_EnumConstant { L.PosToken _ (L.Tk__qq_EnumConstant _) } +qq_AnnotationTypeElement { L.PosToken _ (L.Tk__qq_AnnotationTypeElement _) } +qq_AnnotationTypeElementList { L.PosToken _ (L.Tk__qq_AnnotationTypeElementList _) } +qq_AnnotationDeclaration { L.PosToken _ (L.Tk__qq_AnnotationDeclaration _) } +qq_InterfaceDeclaration { L.PosToken _ (L.Tk__qq_InterfaceDeclaration _) } +qq_ClassDeclaration { L.PosToken _ (L.Tk__qq_ClassDeclaration _) } +qq_FieldDeclarationList { L.PosToken _ (L.Tk__qq_FieldDeclarationList _) } +qq_ImplementsList { L.PosToken _ (L.Tk__qq_ImplementsList _) } +qq_ExtendsList { L.PosToken _ (L.Tk__qq_ExtendsList _) } +qq_ClassOrInterfaceType { L.PosToken _ (L.Tk__qq_ClassOrInterfaceType _) } +qq_ModifierList { L.PosToken _ (L.Tk__qq_ModifierList _) } +qq_AnnotationList { L.PosToken _ (L.Tk__qq_AnnotationList _) } +qq_AnnotationElement { L.PosToken _ (L.Tk__qq_AnnotationElement _) } +qq_AnnotationArguments { L.PosToken _ (L.Tk__qq_AnnotationArguments _) } +qq_Annotation { L.PosToken _ (L.Tk__qq_Annotation _) } +qq_DocComment { L.PosToken _ (L.Tk__qq_DocComment _) } +qq_ImportHead { L.PosToken _ (L.Tk__qq_ImportHead _) } +qq_ImportName { L.PosToken _ (L.Tk__qq_ImportName _) } +qq_ImportStatement { L.PosToken _ (L.Tk__qq_ImportStatement _) } +qq_Package { L.PosToken _ (L.Tk__qq_Package _) } +qq_CompilationUnit { L.PosToken _ (L.Tk__qq_CompilationUnit _) } +qq_ImportList { L.PosToken _ (L.Tk__qq_ImportList _) } +qq_TypeDeclaration { L.PosToken _ (L.Tk__qq_TypeDeclaration _) } +qq_OptDocComment { L.PosToken _ (L.Tk__qq_OptDocComment _) } +qq_Java { L.PosToken _ (L.Tk__qq_Java _) } + +%% + +Java__top : Java rtk__eof { $1 } + +Java : tok_Java_dummy_179 Java tok_Java_dummy_179 { Ctr__Java__0 (rtkPosOf $1) $2 } | + tok_AdditiveOp_dummy_178 AdditiveOp tok_AdditiveOp_dummy_178 { Ctr__Java__1 (rtkPosOf $1) $2 } | + tok_Annotation_dummy_177 Annotation tok_Annotation_dummy_177 { Ctr__Java__2 (rtkPosOf $1) $2 } | + tok_AnnotationArguments_dummy_176 AnnotationArguments tok_AnnotationArguments_dummy_176 { Ctr__Java__3 (rtkPosOf $1) $2 } | + tok_AnnotationDeclaration_dummy_175 AnnotationDeclaration tok_AnnotationDeclaration_dummy_175 { Ctr__Java__4 (rtkPosOf $1) $2 } | + tok_AnnotationElement_dummy_174 AnnotationElement tok_AnnotationElement_dummy_174 { Ctr__Java__5 (rtkPosOf $1) $2 } | + tok_AnnotationList_dummy_173 AnnotationList tok_AnnotationList_dummy_173 { Ctr__Java__6 (rtkPosOf $1) (reverse $2) } | + tok_AnnotationTypeElement_dummy_172 AnnotationTypeElement tok_AnnotationTypeElement_dummy_172 { Ctr__Java__7 (rtkPosOf $1) $2 } | + tok_AnnotationTypeElementList_dummy_171 AnnotationTypeElementList tok_AnnotationTypeElementList_dummy_171 { Ctr__Java__8 (rtkPosOf $1) (reverse $2) } | + tok_Arglist_dummy_170 Arglist tok_Arglist_dummy_170 { Ctr__Java__9 (rtkPosOf $1) $2 } | + tok_AssignmentOp_dummy_169 AssignmentOp tok_AssignmentOp_dummy_169 { Ctr__Java__10 (rtkPosOf $1) $2 } | + tok_CatchList_dummy_168 CatchList tok_CatchList_dummy_168 { Ctr__Java__11 (rtkPosOf $1) (reverse $2) } | + tok_ClassDeclaration_dummy_167 ClassDeclaration tok_ClassDeclaration_dummy_167 { Ctr__Java__12 (rtkPosOf $1) $2 } | + tok_ClassOrInterfaceType_dummy_166 ClassOrInterfaceType tok_ClassOrInterfaceType_dummy_166 { Ctr__Java__13 (rtkPosOf $1) $2 } | + tok_CompilationUnit_dummy_165 CompilationUnit tok_CompilationUnit_dummy_165 { Ctr__Java__14 (rtkPosOf $1) $2 } | + tok_CompoundName_dummy_164 CompoundName tok_CompoundName_dummy_164 { Ctr__Java__15 (rtkPosOf $1) $2 } | + tok_CompoundNameTail_dummy_163 CompoundNameTail tok_CompoundNameTail_dummy_163 { Ctr__Java__16 (rtkPosOf $1) (reverse $2) } | + tok_CreationExpression_dummy_162 CreationExpression tok_CreationExpression_dummy_162 { Ctr__Java__17 (rtkPosOf $1) $2 } | + tok_DimExprs_dummy_161 DimExprs tok_DimExprs_dummy_161 { Ctr__Java__18 (rtkPosOf $1) (reverse $2) } | + tok_Dims_dummy_160 Dims tok_Dims_dummy_160 { Ctr__Java__19 (rtkPosOf $1) (reverse $2) } | + tok_DoStatement_dummy_159 DoStatement tok_DoStatement_dummy_159 { Ctr__Java__20 (rtkPosOf $1) $2 } | + tok_DocComment_dummy_158 DocComment tok_DocComment_dummy_158 { Ctr__Java__21 (rtkPosOf $1) $2 } | + tok_EnumConstant_dummy_157 EnumConstant tok_EnumConstant_dummy_157 { Ctr__Java__22 (rtkPosOf $1) $2 } | + tok_EnumConstantList_dummy_156 EnumConstantList tok_EnumConstantList_dummy_156 { Ctr__Java__23 (rtkPosOf $1) $2 } | + tok_EnumDeclaration_dummy_155 EnumDeclaration tok_EnumDeclaration_dummy_155 { Ctr__Java__24 (rtkPosOf $1) $2 } | + tok_EqualityOp_dummy_154 EqualityOp tok_EqualityOp_dummy_154 { Ctr__Java__25 (rtkPosOf $1) $2 } | + tok_Expression_dummy_153 Expression tok_Expression_dummy_153 { Ctr__Java__26 (rtkPosOf $1) $2 } | + tok_ExtendsList_dummy_152 ExtendsList tok_ExtendsList_dummy_152 { Ctr__Java__27 (rtkPosOf $1) $2 } | + tok_FieldDeclaration_dummy_151 FieldDeclaration tok_FieldDeclaration_dummy_151 { Ctr__Java__28 (rtkPosOf $1) $2 } | + tok_FieldDeclarationList_dummy_150 FieldDeclarationList tok_FieldDeclarationList_dummy_150 { Ctr__Java__29 (rtkPosOf $1) (reverse $2) } | + tok_ForStatement_dummy_149 ForStatement tok_ForStatement_dummy_149 { Ctr__Java__30 (rtkPosOf $1) $2 } | + tok_IfStatement_dummy_148 IfStatement tok_IfStatement_dummy_148 { Ctr__Java__31 (rtkPosOf $1) $2 } | + tok_ImplementsList_dummy_147 ImplementsList tok_ImplementsList_dummy_147 { Ctr__Java__32 (rtkPosOf $1) $2 } | + tok_ImportHead_dummy_146 ImportHead tok_ImportHead_dummy_146 { Ctr__Java__33 (rtkPosOf $1) $2 } | + tok_ImportList_dummy_145 ImportList tok_ImportList_dummy_145 { Ctr__Java__34 (rtkPosOf $1) (reverse $2) } | + tok_ImportName_dummy_144 ImportName tok_ImportName_dummy_144 { Ctr__Java__35 (rtkPosOf $1) $2 } | + tok_ImportStatement_dummy_143 ImportStatement tok_ImportStatement_dummy_143 { Ctr__Java__36 (rtkPosOf $1) $2 } | + tok_InterfaceDeclaration_dummy_142 InterfaceDeclaration tok_InterfaceDeclaration_dummy_142 { Ctr__Java__37 (rtkPosOf $1) $2 } | + tok_Literal_dummy_141 Literal tok_Literal_dummy_141 { Ctr__Java__38 (rtkPosOf $1) $2 } | + tok_LocalModifierList1_dummy_140 LocalModifierList1 tok_LocalModifierList1_dummy_140 { Ctr__Java__39 (rtkPosOf $1) (reverse $2) } | + tok_MemberAfterFirstId_dummy_139 MemberAfterFirstId tok_MemberAfterFirstId_dummy_139 { Ctr__Java__40 (rtkPosOf $1) $2 } | + tok_MemberDeclaration_dummy_138 MemberDeclaration tok_MemberDeclaration_dummy_138 { Ctr__Java__41 (rtkPosOf $1) $2 } | + tok_MemberRest_dummy_137 MemberRest tok_MemberRest_dummy_137 { Ctr__Java__42 (rtkPosOf $1) $2 } | + tok_Modifier_dummy_136 Modifier tok_Modifier_dummy_136 { Ctr__Java__43 (rtkPosOf $1) $2 } | + tok_ModifierList_dummy_135 ModifierList tok_ModifierList_dummy_135 { Ctr__Java__44 (rtkPosOf $1) (reverse $2) } | + tok_MoreTypeSpecifier_dummy_134 MoreTypeSpecifier tok_MoreTypeSpecifier_dummy_134 { Ctr__Java__45 (rtkPosOf $1) $2 } | + tok_MoreVariableDeclarators_dummy_133 MoreVariableDeclarators tok_MoreVariableDeclarators_dummy_133 { Ctr__Java__46 (rtkPosOf $1) (reverse $2) } | + tok_MultiplicativeOp_dummy_132 MultiplicativeOp tok_MultiplicativeOp_dummy_132 { Ctr__Java__47 (rtkPosOf $1) $2 } | + tok_NonEmptyDims_dummy_131 NonEmptyDims tok_NonEmptyDims_dummy_131 { Ctr__Java__48 (rtkPosOf $1) (reverse $2) } | + tok_NonEmptyTypeArguments_dummy_130 NonEmptyTypeArguments tok_NonEmptyTypeArguments_dummy_130 { Ctr__Java__49 (rtkPosOf $1) $2 } | + tok_OptDocComment_dummy_129 OptDocComment tok_OptDocComment_dummy_129 { Ctr__Java__50 (rtkPosOf $1) $2 } | + tok_OptElsePart_dummy_128 OptElsePart tok_OptElsePart_dummy_128 { Ctr__Java__51 (rtkPosOf $1) $2 } | + tok_OptExpression_dummy_127 OptExpression tok_OptExpression_dummy_127 { Ctr__Java__52 (rtkPosOf $1) $2 } | + tok_OptFinally_dummy_126 OptFinally tok_OptFinally_dummy_126 { Ctr__Java__53 (rtkPosOf $1) $2 } | + tok_OptId_dummy_125 OptId tok_OptId_dummy_125 { Ctr__Java__54 (rtkPosOf $1) $2 } | + tok_OptVariableInitializer_dummy_124 OptVariableInitializer tok_OptVariableInitializer_dummy_124 { Ctr__Java__55 (rtkPosOf $1) $2 } | + tok_Package_dummy_123 Package tok_Package_dummy_123 { Ctr__Java__56 (rtkPosOf $1) $2 } | + tok_ParamModifierList_dummy_122 ParamModifierList tok_ParamModifierList_dummy_122 { Ctr__Java__57 (rtkPosOf $1) (reverse $2) } | + tok_Parameter_dummy_121 Parameter tok_Parameter_dummy_121 { Ctr__Java__58 (rtkPosOf $1) $2 } | + tok_ParameterList_dummy_120 ParameterList tok_ParameterList_dummy_120 { Ctr__Java__59 (rtkPosOf $1) $2 } | + tok_PostfixOp_dummy_119 PostfixOp tok_PostfixOp_dummy_119 { Ctr__Java__60 (rtkPosOf $1) $2 } | + tok_PrefixOp_dummy_118 PrefixOp tok_PrefixOp_dummy_118 { Ctr__Java__61 (rtkPosOf $1) $2 } | + tok_PrimitiveTypeKeyword_dummy_117 PrimitiveTypeKeyword tok_PrimitiveTypeKeyword_dummy_117 { Ctr__Java__62 (rtkPosOf $1) $2 } | + tok_RelationalOp_dummy_116 RelationalOp tok_RelationalOp_dummy_116 { Ctr__Java__63 (rtkPosOf $1) $2 } | + tok_ShiftOp_dummy_115 ShiftOp tok_ShiftOp_dummy_115 { Ctr__Java__64 (rtkPosOf $1) $2 } | + tok_Statement_dummy_114 Statement tok_Statement_dummy_114 { Ctr__Java__65 (rtkPosOf $1) $2 } | + tok_StatementBlock_dummy_113 StatementBlock tok_StatementBlock_dummy_113 { Ctr__Java__66 (rtkPosOf $1) $2 } | + tok_StatementList_dummy_112 StatementList tok_StatementList_dummy_112 { Ctr__Java__67 (rtkPosOf $1) (reverse $2) } | + tok_StaticInitializer_dummy_111 StaticInitializer tok_StaticInitializer_dummy_111 { Ctr__Java__68 (rtkPosOf $1) $2 } | + tok_SwitchCaseList_dummy_110 SwitchCaseList tok_SwitchCaseList_dummy_110 { Ctr__Java__69 (rtkPosOf $1) (reverse $2) } | + tok_SwitchStatement_dummy_109 SwitchStatement tok_SwitchStatement_dummy_109 { Ctr__Java__70 (rtkPosOf $1) $2 } | + tok_ThrowsClause_dummy_108 ThrowsClause tok_ThrowsClause_dummy_108 { Ctr__Java__71 (rtkPosOf $1) $2 } | + tok_TryStatement_dummy_107 TryStatement tok_TryStatement_dummy_107 { Ctr__Java__72 (rtkPosOf $1) $2 } | + tok_Type_dummy_106 Type tok_Type_dummy_106 { Ctr__Java__73 (rtkPosOf $1) $2 } | + tok_TypeArgument_dummy_105 TypeArgument tok_TypeArgument_dummy_105 { Ctr__Java__74 (rtkPosOf $1) $2 } | + tok_TypeArguments_dummy_104 TypeArguments tok_TypeArguments_dummy_104 { Ctr__Java__75 (rtkPosOf $1) $2 } | + tok_TypeDeclRest_dummy_103 TypeDeclRest tok_TypeDeclRest_dummy_103 { Ctr__Java__76 (rtkPosOf $1) $2 } | + tok_TypeDeclaration_dummy_102 TypeDeclaration tok_TypeDeclaration_dummy_102 { Ctr__Java__77 (rtkPosOf $1) $2 } | + tok_TypeParameter_dummy_101 TypeParameter tok_TypeParameter_dummy_101 { Ctr__Java__78 (rtkPosOf $1) $2 } | + tok_TypeParameters_dummy_100 TypeParameters tok_TypeParameters_dummy_100 { Ctr__Java__79 (rtkPosOf $1) $2 } | + tok_TypeSpecifier_dummy_99 TypeSpecifier tok_TypeSpecifier_dummy_99 { Ctr__Java__80 (rtkPosOf $1) $2 } | + tok_VariableDeclaration_dummy_98 VariableDeclaration tok_VariableDeclaration_dummy_98 { Ctr__Java__81 (rtkPosOf $1) $2 } | + tok_VariableDeclarator_dummy_97 VariableDeclarator tok_VariableDeclarator_dummy_97 { Ctr__Java__82 (rtkPosOf $1) $2 } | + tok_VariableDeclaratorList_dummy_96 VariableDeclaratorList tok_VariableDeclaratorList_dummy_96 { Ctr__Java__83 (rtkPosOf $1) $2 } | + tok_VariableInitializer_dummy_95 VariableInitializer tok_VariableInitializer_dummy_95 { Ctr__Java__84 (rtkPosOf $1) $2 } | + tok_VariableInitializerList_dummy_94 VariableInitializerList tok_VariableInitializerList_dummy_94 { Ctr__Java__85 (rtkPosOf $1) $2 } | + tok_WhileStatement_dummy_93 WhileStatement tok_WhileStatement_dummy_93 { Ctr__Java__86 (rtkPosOf $1) $2 } | + tok_WildcardType_dummy_92 WildcardType tok_WildcardType_dummy_92 { Ctr__Java__87 (rtkPosOf $1) $2 } + +Java : qq_Java { Anti_Java (tkVal_qq_Java $1) } | + CompilationUnit { Ctr__Java__88 (rtkPosOf $1) $1 } + +AdditiveOp : qq_AdditiveOp { Anti_AdditiveOp (tkVal_qq_AdditiveOp $1) } | + tok__plus__76 { Ctr__AdditiveOp__0 (rtkPosOf $1) } | + tok__minus__77 { Ctr__AdditiveOp__1 (rtkPosOf $1) } + +ListElem_AnnotationList9 : qq_AnnotationList { Anti_Annotation (tkVal_qq_AnnotationList $1) } | + Annotation { $1 } + +Annotation : qq_Annotation { Anti_Annotation (tkVal_qq_Annotation $1) } | + tok__symbol__6 CompoundName Rule_4 { Ctr__Annotation__1 (rtkPosOf $1) $2 $3 } + +AnnotationArguments : qq_AnnotationArguments { Anti_AnnotationArguments (tkVal_qq_AnnotationArguments $1) } | + AnnotationElement Rule_7 { Ctr__AnnotationArguments__0 (rtkPosOf $1) $1 (reverse $2) } + +AnnotationDeclaration : qq_AnnotationDeclaration { Anti_AnnotationDeclaration (tkVal_qq_AnnotationDeclaration $1) } | + tok__symbol__6 tok_interface_16 id tok__symbol__14 AnnotationTypeElementList tok__symbol__15 { Ctr__AnnotationDeclaration__0 (rtkPosOf $1) (tkVal_id $3) (reverse $5) } + +AnnotationElement : qq_AnnotationElement { Anti_AnnotationElement (tkVal_qq_AnnotationElement $1) } | + id tok__eql__10 ConditionalExpression { Ctr__AnnotationElement__0 (rtkPosOf $1) (tkVal_id $1) $3 } | + ConditionalExpression { Ctr__AnnotationElement__1 (rtkPosOf $1) $1 } + +AnnotationList : {- empty -} { [] } | + AnnotationList ListElem_AnnotationList9 { $2 : $1 } + +AnnotationTypeElement : qq_AnnotationTypeElement { Anti_AnnotationTypeElement (tkVal_qq_AnnotationTypeElement $1) } | + FieldDeclaration { Ctr__AnnotationTypeElement__0 (rtkPosOf $1) $1 } + +ListElem_AnnotationTypeElementList19 : qq_AnnotationTypeElementList { Anti_AnnotationTypeElement (tkVal_qq_AnnotationTypeElementList $1) } | + AnnotationTypeElement { $1 } + +AnnotationTypeElementList : {- empty -} { [] } | + AnnotationTypeElementList ListElem_AnnotationTypeElementList19 { $2 : $1 } + +Arglist : qq_Arglist { Anti_Arglist (tkVal_qq_Arglist $1) } | + { Ctr__Arglist__0 rtkNoPos } | + Rule_78 { Ctr__Arglist__1 (rtkPosOf $1) $1 } + +AssignmentOp : qq_AssignmentOp { Anti_AssignmentOp (tkVal_qq_AssignmentOp $1) } | + tok__eql__10 { Ctr__AssignmentOp__0 (rtkPosOf $1) } | + tok__plus__eql__51 { Ctr__AssignmentOp__1 (rtkPosOf $1) } | + tok__minus__eql__52 { Ctr__AssignmentOp__2 (rtkPosOf $1) } | + tok__star__eql__53 { Ctr__AssignmentOp__3 (rtkPosOf $1) } | + tok__symbol__eql__54 { Ctr__AssignmentOp__4 (rtkPosOf $1) } | + tok__pipe__eql__55 { Ctr__AssignmentOp__5 (rtkPosOf $1) } | + tok__symbol__eql__56 { Ctr__AssignmentOp__6 (rtkPosOf $1) } | + tok__symbol__eql__57 { Ctr__AssignmentOp__7 (rtkPosOf $1) } | + tok__symbol__eql__58 { Ctr__AssignmentOp__8 (rtkPosOf $1) } | + tok__symbol__symbol__eql__59 { Ctr__AssignmentOp__9 (rtkPosOf $1) } | + tok__symbol__symbol__eql__60 { Ctr__AssignmentOp__10 (rtkPosOf $1) } | + tok__symbol__symbol__symbol__eql__61 { Ctr__AssignmentOp__11 (rtkPosOf $1) } + +CatchList : {- empty -} { [] } | + CatchList ListElem_CatchList64 { $2 : $1 } + +ClassDeclaration : qq_ClassDeclaration { Anti_ClassDeclaration (tkVal_qq_ClassDeclaration $1) } | + tok_class_13 id TypeParameters Rule_16 Rule_17 tok__symbol__14 FieldDeclarationList tok__symbol__15 { Ctr__ClassDeclaration__0 (rtkPosOf $1) (tkVal_id $2) $3 $4 $5 (reverse $7) } + +ClassOrInterfaceType : qq_ClassOrInterfaceType { Anti_ClassOrInterfaceType (tkVal_qq_ClassOrInterfaceType $1) } | + CompoundName TypeArguments { Ctr__ClassOrInterfaceType__0 (rtkPosOf $1) $1 $2 } + +CompilationUnit : qq_CompilationUnit { Anti_CompilationUnit (tkVal_qq_CompilationUnit $1) } | + Rule_1 ImportList Rule_2 { Ctr__CompilationUnit__0 (rtkPosOf $1) $1 (reverse $2) $3 } + +CompoundName : qq_CompoundName { Anti_CompoundName (tkVal_qq_CompoundName $1) } | + id CompoundNameTail { Ctr__CompoundName__0 (rtkPosOf $1) (tkVal_id $1) (reverse $2) } + +CompoundNameTail : {- empty -} { [] } | + CompoundNameTail ListElem_CompoundNameTail91 { $2 : $1 } + +CreationExpression : qq_CreationExpression { Anti_CreationExpression (tkVal_qq_CreationExpression $1) } | + tok_new_84 TypeSpecifier Rule_74 { Ctr__CreationExpression__0 (rtkPosOf $1) $2 $3 } + +DimExprs : ListElem_DimExprs77 { [$1] } | + DimExprs ListElem_DimExprs77 { $2 : $1 } + +Dims : {- empty -} { [] } | + Dims ListElem_Dims32 { $2 : $1 } + +DoStatement : qq_DoStatement { Anti_DoStatement (tkVal_qq_DoStatement $1) } | + tok_do_43 Statement tok_while_44 tok__lparen__7 Expression tok__rparen__8 tok__semi__1 { Ctr__DoStatement__0 (rtkPosOf $1) $2 $5 } + +DocComment : qq_DocComment { Anti_DocComment (tkVal_qq_DocComment $1) } | + doccomment { Ctr__DocComment__0 (rtkPosOf $1) (tkVal_doccomment $1) } + +EnumConstant : qq_EnumConstant { Anti_EnumConstant (tkVal_qq_EnumConstant $1) } | + AnnotationList id Rule_20 Rule_22 { Ctr__EnumConstant__0 (rtkPosOf (reverse $1)) (reverse $1) (tkVal_id $2) $3 $4 } + +EnumConstantList : qq_EnumConstantList { Anti_EnumConstantList (tkVal_qq_EnumConstantList $1) } | + EnumConstant Rule_24 Rule_26 { Ctr__EnumConstantList__0 (rtkPosOf $1) $1 (reverse $2) $3 } + +EnumDeclaration : qq_EnumDeclaration { Anti_EnumDeclaration (tkVal_qq_EnumDeclaration $1) } | + tok_enum_17 id Rule_27 tok__symbol__14 EnumConstantList Rule_28 tok__symbol__15 { Ctr__EnumDeclaration__0 (rtkPosOf $1) (tkVal_id $2) $3 $5 $6 } + +EqualityOp : qq_EqualityOp { Anti_EqualityOp (tkVal_qq_EqualityOp $1) } | + tok__eql__eql__68 { Ctr__EqualityOp__0 (rtkPosOf $1) } | + tok__exclamation__eql__69 { Ctr__EqualityOp__1 (rtkPosOf $1) } + +PrimaryNoPostfix : qq_Expression { Anti_Expression (tkVal_qq_Expression $1) } | + Literal { Ctr__Expression__0 (rtkPosOf $1) $1 } | + tok_this_40 { Ctr__Expression__1 (rtkPosOf $1) } | + tok__lparen__7 Expression tok__rparen__8 { Ctr__Expression__2 (rtkPosOf $1) $2 } | + CreationExpression { Ctr__Expression__3 (rtkPosOf $1) $1 } | + CompoundName Rule_70 { Ctr__Expression__4 (rtkPosOf $1) $1 $2 } | + CompoundName tok__sq_bkt_l__18 Expression tok__sq_bkt_r__19 { Ctr__Expression__5 (rtkPosOf $1) $1 $3 } | + tok_super_39 tok__dot__4 id Rule_72 { Ctr__Expression__6 (rtkPosOf $1) (tkVal_id $3) $4 } | + id CompoundNameTail tok__dot__4 tok_class_13 { Ctr__Expression__7 (rtkPosOf $1) (tkVal_id $1) (reverse $2) } | + id CompoundNameTail tok__dot__4 tok_this_40 { Ctr__Expression__8 (rtkPosOf $1) (tkVal_id $1) (reverse $2) } | + id CompoundNameTail tok__dot__4 NonEmptyTypeArguments id tok__lparen__7 Arglist tok__rparen__8 { Ctr__Expression__9 (rtkPosOf $1) (tkVal_id $1) (reverse $2) $4 (tkVal_id $5) $7 } | + PrimitiveTypeKeyword tok__dot__4 tok_class_13 { Ctr__Expression__10 (rtkPosOf $1) $1 } + +PostfixExpression : PrimaryNoPostfix { Ctr__Expression__11 (rtkPosOf $1) $1 } | + PostfixExpression PostfixOp { Ctr__Expression__12 (rtkPosOf $1) $1 $2 } | + PostfixExpression tok__dot__4 id { Ctr__Expression__13 (rtkPosOf $1) $1 (tkVal_id $3) } | + PostfixExpression tok__dot__4 id tok__lparen__7 Arglist tok__rparen__8 { Ctr__Expression__14 (rtkPosOf $1) $1 (tkVal_id $3) $5 } | + PostfixExpression tok__dot__4 NonEmptyTypeArguments id tok__lparen__7 Arglist tok__rparen__8 { Ctr__Expression__15 (rtkPosOf $1) $1 $3 (tkVal_id $4) $6 } | + PostfixExpression tok__sq_bkt_l__18 Expression tok__sq_bkt_r__19 { Ctr__Expression__16 (rtkPosOf $1) $1 $3 } + +UnaryExpressionNotPlusMinus : PostfixExpression { Ctr__Expression__17 (rtkPosOf $1) $1 } | + tok__tilde__82 UnaryExpression { Ctr__Expression__18 (rtkPosOf $1) $2 } | + tok__exclamation__83 UnaryExpression { Ctr__Expression__19 (rtkPosOf $1) $2 } | + CastExpression { Ctr__Expression__20 (rtkPosOf $1) $1 } + +UnaryExpression : PrefixOp UnaryExpression { Ctr__Expression__21 (rtkPosOf $1) $1 $2 } | + UnaryExpressionNotPlusMinus { Ctr__Expression__22 (rtkPosOf $1) $1 } + +CastExpression : tok__lparen__7 PrimitiveTypeKeyword Dims tok__rparen__8 UnaryExpression { Ctr__Expression__23 (rtkPosOf $1) $2 (reverse $3) $5 } | + tok__lparen__7 CompoundName NonEmptyTypeArguments Dims tok__rparen__8 UnaryExpressionNotPlusMinus { Ctr__Expression__24 (rtkPosOf $1) $2 $3 (reverse $4) $6 } | + tok__lparen__7 CompoundName NonEmptyDims tok__rparen__8 UnaryExpressionNotPlusMinus { Ctr__Expression__25 (rtkPosOf $1) $2 (reverse $3) $5 } | + tok__lparen__7 Expression tok__rparen__8 UnaryExpressionNotPlusMinus { Ctr__Expression__26 (rtkPosOf $1) $2 $4 } + +MultiplicativeExpression : UnaryExpression { Ctr__Expression__27 (rtkPosOf $1) $1 } | + MultiplicativeExpression MultiplicativeOp UnaryExpression { Ctr__Expression__28 (rtkPosOf $1) $1 $2 $3 } + +AdditiveExpression : MultiplicativeExpression { Ctr__Expression__29 (rtkPosOf $1) $1 } | + AdditiveExpression AdditiveOp MultiplicativeExpression { Ctr__Expression__30 (rtkPosOf $1) $1 $2 $3 } + +ShiftExpression : AdditiveExpression { Ctr__Expression__31 (rtkPosOf $1) $1 } | + ShiftExpression ShiftOp AdditiveExpression { Ctr__Expression__32 (rtkPosOf $1) $1 $2 $3 } + +RelationalExpression : ShiftExpression { Ctr__Expression__33 (rtkPosOf $1) $1 } | + ShiftExpression RelationalOp ShiftExpression { Ctr__Expression__34 (rtkPosOf $1) $1 $2 $3 } | + RelationalExpression tok_instanceof_74 Type { Ctr__Expression__35 (rtkPosOf $1) $1 $3 } + +EqualityExpression : RelationalExpression { Ctr__Expression__36 (rtkPosOf $1) $1 } | + EqualityExpression EqualityOp RelationalExpression { Ctr__Expression__37 (rtkPosOf $1) $1 $2 $3 } + +AndExpression : EqualityExpression { Ctr__Expression__38 (rtkPosOf $1) $1 } | + AndExpression tok__symbol__67 EqualityExpression { Ctr__Expression__39 (rtkPosOf $1) $1 $3 } + +ExclusiveOrExpression : AndExpression { Ctr__Expression__40 (rtkPosOf $1) $1 } | + ExclusiveOrExpression tok__symbol__66 AndExpression { Ctr__Expression__41 (rtkPosOf $1) $1 $3 } + +InclusiveOrEpression : ExclusiveOrExpression { Ctr__Expression__42 (rtkPosOf $1) $1 } | + InclusiveOrEpression tok__pipe__65 ExclusiveOrExpression { Ctr__Expression__43 (rtkPosOf $1) $1 $3 } + +ConditionalAndExpression : InclusiveOrEpression { Ctr__Expression__44 (rtkPosOf $1) $1 } | + ConditionalAndExpression tok__symbol__symbol__64 InclusiveOrEpression { Ctr__Expression__45 (rtkPosOf $1) $1 $3 } + +ConditionalOrExpression : ConditionalAndExpression { Ctr__Expression__46 (rtkPosOf $1) $1 } | + ConditionalOrExpression tok__pipe__pipe__63 ConditionalAndExpression { Ctr__Expression__47 (rtkPosOf $1) $1 $3 } + +ConditionalExpression : ConditionalOrExpression { Ctr__Expression__48 (rtkPosOf $1) $1 } | + ConditionalOrExpression tok__symbol__62 Expression tok__colon__36 ConditionalExpression { Ctr__Expression__49 (rtkPosOf $1) $1 $3 $5 } + +AssignmentExpression : ConditionalExpression Rule_68 { Ctr__Expression__50 (rtkPosOf $1) $1 $2 } + +Expression : AssignmentExpression { Ctr__Expression__51 (rtkPosOf $1) $1 } + +ExtendsList : qq_ExtendsList { Anti_ExtendsList (tkVal_qq_ExtendsList $1) } | + tok_extends_11 ClassOrInterfaceType Rule_12 { Ctr__ExtendsList__0 (rtkPosOf $1) $2 (reverse $3) } + +FieldDeclaration : qq_FieldDeclaration { Anti_FieldDeclaration (tkVal_qq_FieldDeclaration $1) } | + OptDocComment ModifierList Rule_30 { Ctr__FieldDeclaration__0 (rtkPosOf $1) $1 (reverse $2) $3 } | + tok__semi__1 { Ctr__FieldDeclaration__1 (rtkPosOf $1) } + +ListElem_FieldDeclarationList15 : qq_FieldDeclarationList { Anti_FieldDeclaration (tkVal_qq_FieldDeclarationList $1) } | + FieldDeclaration { $1 } + +FieldDeclarationList : {- empty -} { [] } | + FieldDeclarationList ListElem_FieldDeclarationList15 { $2 : $1 } + +ForStatement : qq_ForStatement { Anti_ForStatement (tkVal_qq_ForStatement $1) } | + tok_for_45 tok__lparen__7 Rule_62 OptExpression tok__semi__1 OptExpression tok__rparen__8 Statement { Ctr__ForStatement__0 (rtkPosOf $1) $3 $4 $6 $8 } + +IfStatement : qq_IfStatement { Anti_IfStatement (tkVal_qq_IfStatement $1) } | + tok_if_42 tok__lparen__7 Expression tok__rparen__8 Statement OptElsePart { Ctr__IfStatement__0 (rtkPosOf $1) $3 $5 $6 } + +ImplementsList : qq_ImplementsList { Anti_ImplementsList (tkVal_qq_ImplementsList $1) } | + tok_implements_12 Rule_14 { Ctr__ImplementsList__0 (rtkPosOf $1) (reverse $2) } + +ImportHead : qq_ImportHead { Anti_ImportHead (tkVal_qq_ImportHead $1) } | + id { Ctr__ImportHead__0 (rtkPosOf $1) (tkVal_id $1) } | + ImportHead tok__dot__4 id { Ctr__ImportHead__1 (rtkPosOf $1) $1 (tkVal_id $3) } + +ImportList : {- empty -} { [] } | + ImportList ListElem_ImportList0 { $2 : $1 } + +ImportName : qq_ImportName { Anti_ImportName (tkVal_qq_ImportName $1) } | + ImportHead { Ctr__ImportName__0 (rtkPosOf $1) $1 } | + ImportHead tok__dot__4 tok__star__5 { Ctr__ImportName__1 (rtkPosOf $1) $1 } + +ImportStatement : qq_ImportStatement { Anti_ImportStatement (tkVal_qq_ImportStatement $1) } | + tok_import_2 Rule_3 ImportName tok__semi__1 { Ctr__ImportStatement__0 (rtkPosOf $1) $2 $3 } + +ListElem_ImportList0 : qq_ImportList { Anti_ImportStatement (tkVal_qq_ImportList $1) } | + ImportStatement { $1 } + +InterfaceDeclaration : qq_InterfaceDeclaration { Anti_InterfaceDeclaration (tkVal_qq_InterfaceDeclaration $1) } | + tok_interface_16 id TypeParameters Rule_18 tok__symbol__14 FieldDeclarationList tok__symbol__15 { Ctr__InterfaceDeclaration__0 (rtkPosOf $1) (tkVal_id $2) $3 $4 (reverse $6) } + +Literal : qq_Literal { Anti_Literal (tkVal_qq_Literal $1) } | + integerLiteral { Ctr__Literal__0 (rtkPosOf $1) (tkVal_integerLiteral $1) } | + floatLiteral { Ctr__Literal__1 (rtkPosOf $1) (tkVal_floatLiteral $1) } | + tok_true_85 { Ctr__Literal__2 (rtkPosOf $1) } | + tok_false_86 { Ctr__Literal__3 (rtkPosOf $1) } | + char { Ctr__Literal__4 (rtkPosOf $1) (tkVal_char $1) } | + string { Ctr__Literal__5 (rtkPosOf $1) (tkVal_string $1) } | + tok_null_87 { Ctr__Literal__6 (rtkPosOf $1) } + +LocalModifierList1 : ListElem_LocalModifierList149 { [$1] } | + LocalModifierList1 ListElem_LocalModifierList149 { $2 : $1 } + +MemberAfterFirstId : qq_MemberAfterFirstId { Anti_MemberAfterFirstId (tkVal_qq_MemberAfterFirstId $1) } | + tok__lparen__7 Rule_35 tok__rparen__8 Rule_36 StatementBlock { Ctr__MemberAfterFirstId__0 (rtkPosOf $1) $2 $4 $5 } | + MoreTypeSpecifier id MemberRest { Ctr__MemberAfterFirstId__1 (rtkPosOf $1) $1 (tkVal_id $2) $3 } + +MemberDeclaration : qq_MemberDeclaration { Anti_MemberDeclaration (tkVal_qq_MemberDeclaration $1) } | + PrimitiveTypeKeyword Dims id MemberRest { Ctr__MemberDeclaration__0 (rtkPosOf $1) $1 (reverse $2) (tkVal_id $3) $4 } | + TypeParameters id MoreTypeSpecifier id MemberRest { Ctr__MemberDeclaration__1 (rtkPosOf $1) $1 (tkVal_id $2) $3 (tkVal_id $4) $5 } | + id MemberAfterFirstId { Ctr__MemberDeclaration__2 (rtkPosOf $1) (tkVal_id $1) $2 } + +MemberRest : qq_MemberRest { Anti_MemberRest (tkVal_qq_MemberRest $1) } | + tok__lparen__7 Rule_39 tok__rparen__8 Dims Rule_40 Rule_41 { Ctr__MemberRest__0 (rtkPosOf $1) $2 (reverse $4) $5 $6 } | + Dims OptVariableInitializer MoreVariableDeclarators tok__semi__1 { Ctr__MemberRest__1 (rtkPosOf (reverse $1)) (reverse $1) $2 (reverse $3) } + +Modifier : qq_Modifier { Anti_Modifier (tkVal_qq_Modifier $1) } | + tok_public_88 { Ctr__Modifier__0 (rtkPosOf $1) } | + tok_private_89 { Ctr__Modifier__1 (rtkPosOf $1) } | + tok_protected_90 { Ctr__Modifier__2 (rtkPosOf $1) } | + tok_static_3 { Ctr__Modifier__3 (rtkPosOf $1) } | + tok_final_31 { Ctr__Modifier__4 (rtkPosOf $1) } | + tok_native_91 { Ctr__Modifier__5 (rtkPosOf $1) } | + tok_synchronized_34 { Ctr__Modifier__6 (rtkPosOf $1) } | + tok_abstract_92 { Ctr__Modifier__7 (rtkPosOf $1) } | + tok_threadsafe_93 { Ctr__Modifier__8 (rtkPosOf $1) } | + tok_transient_94 { Ctr__Modifier__9 (rtkPosOf $1) } + +ModifierList : {- empty -} { [] } | + ModifierList ListElem_ModifierList11 { $2 : $1 } + +MoreTypeSpecifier : qq_MoreTypeSpecifier { Anti_MoreTypeSpecifier (tkVal_qq_MoreTypeSpecifier $1) } | + tok__dot__4 id MoreTypeSpecifier { Ctr__MoreTypeSpecifier__0 (rtkPosOf $1) (tkVal_id $2) $3 } | + TypeArguments Dims { Ctr__MoreTypeSpecifier__1 (rtkPosOf $1) $1 (reverse $2) } + +MoreVariableDeclarators : {- empty -} { [] } | + MoreVariableDeclarators ListElem_MoreVariableDeclarators45 { $2 : $1 } + +MultiplicativeOp : qq_MultiplicativeOp { Anti_MultiplicativeOp (tkVal_qq_MultiplicativeOp $1) } | + tok__star__5 { Ctr__MultiplicativeOp__0 (rtkPosOf $1) } | + tok__symbol__78 { Ctr__MultiplicativeOp__1 (rtkPosOf $1) } | + tok__symbol__79 { Ctr__MultiplicativeOp__2 (rtkPosOf $1) } + +NonEmptyDims : ListElem_NonEmptyDims34 { [$1] } | + NonEmptyDims ListElem_NonEmptyDims34 { $2 : $1 } + +NonEmptyTypeArguments : qq_NonEmptyTypeArguments { Anti_NonEmptyTypeArguments (tkVal_qq_NonEmptyTypeArguments $1) } | + tok__symbol__70 TypeArgument Rule_81 tok__symbol__71 { Ctr__NonEmptyTypeArguments__0 (rtkPosOf $1) $2 (reverse $3) } | + tok__symbol__70 tok__symbol__71 { Ctr__NonEmptyTypeArguments__1 (rtkPosOf $1) } + +OptDocComment : qq_OptDocComment { Anti_OptDocComment (tkVal_qq_OptDocComment $1) } | + { Ctr__OptDocComment__0 rtkNoPos } | + DocComment { Ctr__OptDocComment__1 (rtkPosOf $1) $1 } + +OptElsePart : qq_OptElsePart { Anti_OptElsePart (tkVal_qq_OptElsePart $1) } | + { Ctr__OptElsePart__0 rtkNoPos } | + Rule_61 { Ctr__OptElsePart__1 (rtkPosOf $1) $1 } + +OptExpression : qq_OptExpression { Anti_OptExpression (tkVal_qq_OptExpression $1) } | + { Ctr__OptExpression__0 rtkNoPos } | + Expression { Ctr__OptExpression__1 (rtkPosOf $1) $1 } + +OptFinally : qq_OptFinally { Anti_OptFinally (tkVal_qq_OptFinally $1) } | + { Ctr__OptFinally__0 rtkNoPos } | + Rule_65 { Ctr__OptFinally__1 (rtkPosOf $1) $1 } + +OptId : qq_OptId { Anti_OptId (tkVal_qq_OptId $1) } | + { Ctr__OptId__0 rtkNoPos } | + id { Ctr__OptId__1 (rtkPosOf $1) (tkVal_id $1) } + +OptVariableInitializer : qq_OptVariableInitializer { Anti_OptVariableInitializer (tkVal_qq_OptVariableInitializer $1) } | + { Ctr__OptVariableInitializer__0 rtkNoPos } | + Rule_50 { Ctr__OptVariableInitializer__1 (rtkPosOf $1) $1 } + +Package : qq_Package { Anti_Package (tkVal_qq_Package $1) } | + tok_package_0 CompoundName tok__semi__1 { Ctr__Package__0 (rtkPosOf $1) $2 } + +ParamModifierList : {- empty -} { [] } | + ParamModifierList ListElem_ParamModifierList58 { $2 : $1 } + +Parameter : qq_Parameter { Anti_Parameter (tkVal_qq_Parameter $1) } | + ParamModifierList Type Rule_59 id Dims { Ctr__Parameter__0 (rtkPosOf (reverse $1)) (reverse $1) $2 $3 (tkVal_id $4) (reverse $5) } + +ParameterList : qq_ParameterList { Anti_ParameterList (tkVal_qq_ParameterList $1) } | + Parameter Rule_55 { Ctr__ParameterList__0 (rtkPosOf $1) $1 (reverse $2) } + +PostfixOp : qq_PostfixOp { Anti_PostfixOp (tkVal_qq_PostfixOp $1) } | + tok__plus__plus__80 { Ctr__PostfixOp__0 (rtkPosOf $1) } | + tok__minus__minus__81 { Ctr__PostfixOp__1 (rtkPosOf $1) } + +PrefixOp : qq_PrefixOp { Anti_PrefixOp (tkVal_qq_PrefixOp $1) } | + tok__plus__plus__80 { Ctr__PrefixOp__0 (rtkPosOf $1) } | + tok__minus__minus__81 { Ctr__PrefixOp__1 (rtkPosOf $1) } | + tok__plus__76 { Ctr__PrefixOp__2 (rtkPosOf $1) } | + tok__minus__77 { Ctr__PrefixOp__3 (rtkPosOf $1) } + +PrimitiveTypeKeyword : qq_PrimitiveTypeKeyword { Anti_PrimitiveTypeKeyword (tkVal_qq_PrimitiveTypeKeyword $1) } | + tok_boolean_20 { Ctr__PrimitiveTypeKeyword__0 (rtkPosOf $1) } | + tok_byte_21 { Ctr__PrimitiveTypeKeyword__1 (rtkPosOf $1) } | + tok_char_22 { Ctr__PrimitiveTypeKeyword__2 (rtkPosOf $1) } | + tok_short_23 { Ctr__PrimitiveTypeKeyword__3 (rtkPosOf $1) } | + tok_int_24 { Ctr__PrimitiveTypeKeyword__4 (rtkPosOf $1) } | + tok_float_25 { Ctr__PrimitiveTypeKeyword__5 (rtkPosOf $1) } | + tok_long_26 { Ctr__PrimitiveTypeKeyword__6 (rtkPosOf $1) } | + tok_double_27 { Ctr__PrimitiveTypeKeyword__7 (rtkPosOf $1) } | + tok_void_28 { Ctr__PrimitiveTypeKeyword__8 (rtkPosOf $1) } + +RelationalOp : qq_RelationalOp { Anti_RelationalOp (tkVal_qq_RelationalOp $1) } | + tok__symbol__70 { Ctr__RelationalOp__0 (rtkPosOf $1) } | + tok__symbol__71 { Ctr__RelationalOp__1 (rtkPosOf $1) } | + tok__symbol__eql__72 { Ctr__RelationalOp__2 (rtkPosOf $1) } | + tok__symbol__eql__73 { Ctr__RelationalOp__3 (rtkPosOf $1) } + +Rule_1 : { Ctr__Rule_1__0 rtkNoPos } | + Package { Ctr__Rule_1__1 (rtkPosOf $1) $1 } + +ListElem_ModifierList11 : qq_ModifierList { Anti_Rule_10 (tkVal_qq_ModifierList $1) } | + Rule_10 { $1 } + +Rule_10 : Modifier { Ctr__Rule_10__1 (rtkPosOf $1) $1 } | + Annotation { Ctr__Rule_10__2 (rtkPosOf $1) $1 } + +Rule_12 : {- empty -} { [] } | + Rule_12 Rule_13 { $2 : $1 } + +Rule_13 : tok__coma__9 ClassOrInterfaceType { Ctr__Rule_13__0 (rtkPosOf $1) $2 } + +Rule_14 : ClassOrInterfaceType { [$1] } | + Rule_14 tok__coma__9 ClassOrInterfaceType { $3 : $1 } + +Rule_16 : { Ctr__Rule_16__0 rtkNoPos } | + ExtendsList { Ctr__Rule_16__1 (rtkPosOf $1) $1 } + +Rule_17 : { Ctr__Rule_17__0 rtkNoPos } | + ImplementsList { Ctr__Rule_17__1 (rtkPosOf $1) $1 } + +Rule_18 : { Ctr__Rule_18__0 rtkNoPos } | + ExtendsList { Ctr__Rule_18__1 (rtkPosOf $1) $1 } + +Rule_2 : { Ctr__Rule_2__0 rtkNoPos } | + TypeDeclaration { Ctr__Rule_2__1 (rtkPosOf $1) $1 } + +Rule_20 : { Ctr__Rule_20__0 rtkNoPos } | + Rule_21 { Ctr__Rule_20__1 (rtkPosOf $1) $1 } + +Rule_21 : tok__lparen__7 Arglist tok__rparen__8 { Ctr__Rule_21__0 (rtkPosOf $1) $2 } + +Rule_22 : { Ctr__Rule_22__0 rtkNoPos } | + Rule_23 { Ctr__Rule_22__1 (rtkPosOf $1) $1 } + +Rule_23 : tok__symbol__14 FieldDeclarationList tok__symbol__15 { Ctr__Rule_23__0 (rtkPosOf $1) (reverse $2) } + +Rule_24 : {- empty -} { [] } | + Rule_24 Rule_25 { $2 : $1 } + +Rule_25 : tok__coma__9 EnumConstant { Ctr__Rule_25__0 (rtkPosOf $1) $2 } + +Rule_26 : { Ctr__Rule_26__0 rtkNoPos } | + tok__coma__9 { Ctr__Rule_26__1 (rtkPosOf $1) } + +Rule_27 : { Ctr__Rule_27__0 rtkNoPos } | + ImplementsList { Ctr__Rule_27__1 (rtkPosOf $1) $1 } + +Rule_28 : { Ctr__Rule_28__0 rtkNoPos } | + Rule_29 { Ctr__Rule_28__1 (rtkPosOf $1) $1 } + +Rule_29 : tok__semi__1 FieldDeclarationList { Ctr__Rule_29__0 (rtkPosOf $1) (reverse $2) } + +Rule_3 : { Ctr__Rule_3__0 rtkNoPos } | + tok_static_3 { Ctr__Rule_3__1 (rtkPosOf $1) } + +Rule_30 : MemberDeclaration { Ctr__Rule_30__0 (rtkPosOf $1) $1 } | + TypeDeclRest { Ctr__Rule_30__1 (rtkPosOf $1) $1 } | + StaticInitializer { Ctr__Rule_30__2 (rtkPosOf $1) $1 } + +ListElem_Dims32 : qq_Dims { Anti_Rule_31 (tkVal_qq_Dims $1) } | + Rule_31 { $1 } + +Rule_31 : tok__sq_bkt_l__18 tok__sq_bkt_r__19 { Ctr__Rule_31__1 (rtkPosOf $1) } + +ListElem_NonEmptyDims34 : qq_NonEmptyDims { Anti_Rule_33 (tkVal_qq_NonEmptyDims $1) } | + Rule_33 { $1 } + +Rule_33 : tok__sq_bkt_l__18 tok__sq_bkt_r__19 { Ctr__Rule_33__1 (rtkPosOf $1) } + +Rule_35 : { Ctr__Rule_35__0 rtkNoPos } | + ParameterList { Ctr__Rule_35__1 (rtkPosOf $1) $1 } + +Rule_36 : { Ctr__Rule_36__0 rtkNoPos } | + ThrowsClause { Ctr__Rule_36__1 (rtkPosOf $1) $1 } + +Rule_37 : {- empty -} { [] } | + Rule_37 Rule_38 { $2 : $1 } + +Rule_38 : tok__coma__9 CompoundName { Ctr__Rule_38__0 (rtkPosOf $1) $2 } + +Rule_39 : { Ctr__Rule_39__0 rtkNoPos } | + ParameterList { Ctr__Rule_39__1 (rtkPosOf $1) $1 } + +Rule_4 : { Ctr__Rule_4__0 rtkNoPos } | + Rule_5 { Ctr__Rule_4__1 (rtkPosOf $1) $1 } + +Rule_40 : { Ctr__Rule_40__0 rtkNoPos } | + ThrowsClause { Ctr__Rule_40__1 (rtkPosOf $1) $1 } + +Rule_41 : StatementBlock { Ctr__Rule_41__0 (rtkPosOf $1) $1 } | + Rule_42 tok__semi__1 { Ctr__Rule_41__1 (rtkPosOf $1) $1 } + +Rule_42 : { Ctr__Rule_42__0 rtkNoPos } | + Rule_43 { Ctr__Rule_42__1 (rtkPosOf $1) $1 } + +Rule_43 : tok_default_30 Expression { Ctr__Rule_43__0 (rtkPosOf $1) $2 } + +ListElem_MoreVariableDeclarators45 : qq_MoreVariableDeclarators { Anti_Rule_44 (tkVal_qq_MoreVariableDeclarators $1) } | + Rule_44 { $1 } + +Rule_44 : tok__coma__9 VariableDeclarator { Ctr__Rule_44__1 (rtkPosOf $1) $2 } + +Rule_46 : {- empty -} { [] } | + Rule_46 Rule_47 { $2 : $1 } + +Rule_47 : tok__coma__9 VariableDeclarator { Ctr__Rule_47__0 (rtkPosOf $1) $2 } + +ListElem_LocalModifierList149 : qq_LocalModifierList1 { Anti_Rule_48 (tkVal_qq_LocalModifierList1 $1) } | + Rule_48 { $1 } + +Rule_48 : tok_final_31 { Ctr__Rule_48__1 (rtkPosOf $1) } | + Annotation { Ctr__Rule_48__2 (rtkPosOf $1) $1 } + +Rule_5 : tok__lparen__7 Rule_6 tok__rparen__8 { Ctr__Rule_5__0 (rtkPosOf $1) $2 } + +Rule_50 : tok__eql__10 VariableInitializer { Ctr__Rule_50__0 (rtkPosOf $1) $2 } + +Rule_51 : VariableInitializer Rule_52 Rule_54 { Ctr__Rule_51__0 (rtkPosOf $1) $1 (reverse $2) $3 } + +Rule_52 : {- empty -} { [] } | + Rule_52 Rule_53 { $2 : $1 } + +Rule_53 : tok__coma__9 VariableInitializer { Ctr__Rule_53__0 (rtkPosOf $1) $2 } + +Rule_54 : { Ctr__Rule_54__0 rtkNoPos } | + tok__coma__9 { Ctr__Rule_54__1 (rtkPosOf $1) } + +Rule_55 : {- empty -} { [] } | + Rule_55 Rule_56 { $2 : $1 } + +Rule_56 : tok__coma__9 Parameter { Ctr__Rule_56__0 (rtkPosOf $1) $2 } + +ListElem_ParamModifierList58 : qq_ParamModifierList { Anti_Rule_57 (tkVal_qq_ParamModifierList $1) } | + Rule_57 { $1 } + +Rule_57 : tok_final_31 { Ctr__Rule_57__1 (rtkPosOf $1) } | + Annotation { Ctr__Rule_57__2 (rtkPosOf $1) $1 } + +Rule_59 : { Ctr__Rule_59__0 rtkNoPos } | + tok__dot__dot__dot__32 { Ctr__Rule_59__1 (rtkPosOf $1) } + +Rule_6 : { Ctr__Rule_6__0 rtkNoPos } | + AnnotationArguments { Ctr__Rule_6__1 (rtkPosOf $1) $1 } + +Rule_61 : tok_else_41 Statement { Ctr__Rule_61__0 (rtkPosOf $1) $2 } + +Rule_62 : VariableDeclaration { Ctr__Rule_62__0 (rtkPosOf $1) $1 } | + Expression tok__semi__1 { Ctr__Rule_62__1 (rtkPosOf $1) $1 } | + tok__semi__1 { Ctr__Rule_62__2 (rtkPosOf $1) } + +ListElem_CatchList64 : qq_CatchList { Anti_Rule_63 (tkVal_qq_CatchList $1) } | + Rule_63 { $1 } + +Rule_63 : tok_catch_46 tok__lparen__7 Parameter tok__rparen__8 Statement { Ctr__Rule_63__1 (rtkPosOf $1) $3 $5 } + +Rule_65 : tok_finally_47 Statement { Ctr__Rule_65__0 (rtkPosOf $1) $2 } + +ListElem_SwitchCaseList67 : qq_SwitchCaseList { Anti_Rule_66 (tkVal_qq_SwitchCaseList $1) } | + Rule_66 { $1 } + +Rule_66 : tok_case_49 Expression tok__colon__36 { Ctr__Rule_66__1 (rtkPosOf $1) $2 } | + tok_default_30 tok__colon__36 { Ctr__Rule_66__2 (rtkPosOf $1) } | + Statement { Ctr__Rule_66__3 (rtkPosOf $1) $1 } + +Rule_68 : { Ctr__Rule_68__0 rtkNoPos } | + Rule_69 { Ctr__Rule_68__1 (rtkPosOf $1) $1 } + +Rule_69 : AssignmentOp AssignmentExpression { Ctr__Rule_69__0 (rtkPosOf $1) $1 $2 } + +Rule_7 : {- empty -} { [] } | + Rule_7 Rule_8 { $2 : $1 } + +Rule_70 : { Ctr__Rule_70__0 rtkNoPos } | + Rule_71 { Ctr__Rule_70__1 (rtkPosOf $1) $1 } + +Rule_71 : tok__lparen__7 Arglist tok__rparen__8 { Ctr__Rule_71__0 (rtkPosOf $1) $2 } + +Rule_72 : { Ctr__Rule_72__0 rtkNoPos } | + Rule_73 { Ctr__Rule_72__1 (rtkPosOf $1) $1 } + +Rule_73 : tok__lparen__7 Arglist tok__rparen__8 { Ctr__Rule_73__0 (rtkPosOf $1) $2 } + +Rule_74 : tok__lparen__7 Arglist tok__rparen__8 { Ctr__Rule_74__0 (rtkPosOf $1) $2 } | + DimExprs Rule_75 { Ctr__Rule_74__1 (rtkPosOf (reverse $1)) (reverse $1) $2 } + +Rule_75 : { Ctr__Rule_75__0 rtkNoPos } | + NonEmptyDims { Ctr__Rule_75__1 (rtkPosOf (reverse $1)) (reverse $1) } + +ListElem_DimExprs77 : qq_DimExprs { Anti_Rule_76 (tkVal_qq_DimExprs $1) } | + Rule_76 { $1 } + +Rule_76 : tok__sq_bkt_l__18 Expression tok__sq_bkt_r__19 { Ctr__Rule_76__1 (rtkPosOf $1) $2 } + +Rule_78 : Expression Rule_79 { Ctr__Rule_78__0 (rtkPosOf $1) $1 (reverse $2) } + +Rule_79 : {- empty -} { [] } | + Rule_79 Rule_80 { $2 : $1 } + +Rule_8 : tok__coma__9 AnnotationElement { Ctr__Rule_8__0 (rtkPosOf $1) $2 } + +Rule_80 : tok__coma__9 Expression { Ctr__Rule_80__0 (rtkPosOf $1) $2 } + +Rule_81 : {- empty -} { [] } | + Rule_81 Rule_82 { $2 : $1 } + +Rule_82 : tok__coma__9 TypeArgument { Ctr__Rule_82__0 (rtkPosOf $1) $2 } + +Rule_83 : tok__symbol__70 TypeParameter Rule_84 tok__symbol__71 { Ctr__Rule_83__0 (rtkPosOf $1) $2 (reverse $3) } + +Rule_84 : {- empty -} { [] } | + Rule_84 Rule_85 { $2 : $1 } + +Rule_85 : tok__coma__9 TypeParameter { Ctr__Rule_85__0 (rtkPosOf $1) $2 } + +Rule_86 : { Ctr__Rule_86__0 rtkNoPos } | + Rule_87 { Ctr__Rule_86__1 (rtkPosOf $1) $1 } + +Rule_87 : tok_extends_11 Type Rule_88 { Ctr__Rule_87__0 (rtkPosOf $1) $2 (reverse $3) } + +Rule_88 : {- empty -} { [] } | + Rule_88 Rule_89 { $2 : $1 } + +Rule_89 : tok__symbol__67 Type { Ctr__Rule_89__0 (rtkPosOf $1) $2 } + +ListElem_CompoundNameTail91 : qq_CompoundNameTail { Anti_Rule_90 (tkVal_qq_CompoundNameTail $1) } | + Rule_90 { $1 } + +Rule_90 : tok__dot__4 id { Ctr__Rule_90__1 (rtkPosOf $1) (tkVal_id $2) } + +ShiftOp : qq_ShiftOp { Anti_ShiftOp (tkVal_qq_ShiftOp $1) } | + tok__symbol__symbol__75 { Ctr__ShiftOp__0 (rtkPosOf $1) } | + tok__symbol__71 tok__symbol__71 { Ctr__ShiftOp__1 (rtkPosOf $1) } | + tok__symbol__71 tok__symbol__71 tok__symbol__71 { Ctr__ShiftOp__2 (rtkPosOf $1) } + +Statement : qq_Statement { Anti_Statement (tkVal_qq_Statement $1) } | + VariableDeclaration { Ctr__Statement__0 (rtkPosOf $1) $1 } | + tok_return_33 OptExpression tok__semi__1 { Ctr__Statement__1 (rtkPosOf $1) $2 } | + Expression tok__semi__1 { Ctr__Statement__2 (rtkPosOf $1) $1 } | + StatementBlock { Ctr__Statement__3 (rtkPosOf $1) $1 } | + IfStatement { Ctr__Statement__4 (rtkPosOf $1) $1 } | + DoStatement { Ctr__Statement__5 (rtkPosOf $1) $1 } | + WhileStatement { Ctr__Statement__6 (rtkPosOf $1) $1 } | + ForStatement { Ctr__Statement__7 (rtkPosOf $1) $1 } | + TryStatement { Ctr__Statement__8 (rtkPosOf $1) $1 } | + SwitchStatement { Ctr__Statement__9 (rtkPosOf $1) $1 } | + tok_synchronized_34 tok__lparen__7 Expression tok__rparen__8 Statement { Ctr__Statement__10 (rtkPosOf $1) $3 $5 } | + tok_throw_35 Expression tok__semi__1 { Ctr__Statement__11 (rtkPosOf $1) $2 } | + id tok__colon__36 Statement { Ctr__Statement__12 (rtkPosOf $1) (tkVal_id $1) $3 } | + tok_break_37 OptId tok__semi__1 { Ctr__Statement__13 (rtkPosOf $1) $2 } | + tok_continue_38 OptId tok__semi__1 { Ctr__Statement__14 (rtkPosOf $1) $2 } | + tok_super_39 tok__lparen__7 Arglist tok__rparen__8 tok__semi__1 { Ctr__Statement__15 (rtkPosOf $1) $3 } | + tok_this_40 tok__lparen__7 Arglist tok__rparen__8 tok__semi__1 { Ctr__Statement__16 (rtkPosOf $1) $3 } | + tok__semi__1 { Ctr__Statement__17 (rtkPosOf $1) } + +ListElem_StatementList60 : qq_StatementList { Anti_Statement (tkVal_qq_StatementList $1) } | + Statement { $1 } + +StatementBlock : qq_StatementBlock { Anti_StatementBlock (tkVal_qq_StatementBlock $1) } | + tok__symbol__14 StatementList tok__symbol__15 { Ctr__StatementBlock__0 (rtkPosOf $1) (reverse $2) } + +StatementList : {- empty -} { [] } | + StatementList ListElem_StatementList60 { $2 : $1 } + +StaticInitializer : qq_StaticInitializer { Anti_StaticInitializer (tkVal_qq_StaticInitializer $1) } | + StatementBlock { Ctr__StaticInitializer__0 (rtkPosOf $1) $1 } + +SwitchCaseList : {- empty -} { [] } | + SwitchCaseList ListElem_SwitchCaseList67 { $2 : $1 } + +SwitchStatement : qq_SwitchStatement { Anti_SwitchStatement (tkVal_qq_SwitchStatement $1) } | + tok_switch_50 tok__lparen__7 Expression tok__rparen__8 tok__symbol__14 SwitchCaseList tok__symbol__15 { Ctr__SwitchStatement__0 (rtkPosOf $1) $3 (reverse $6) } + +ThrowsClause : qq_ThrowsClause { Anti_ThrowsClause (tkVal_qq_ThrowsClause $1) } | + tok_throws_29 CompoundName Rule_37 { Ctr__ThrowsClause__0 (rtkPosOf $1) $2 (reverse $3) } + +TryStatement : qq_TryStatement { Anti_TryStatement (tkVal_qq_TryStatement $1) } | + tok_try_48 Statement CatchList OptFinally { Ctr__TryStatement__0 (rtkPosOf $1) $2 (reverse $3) $4 } + +Type : qq_Type { Anti_Type (tkVal_qq_Type $1) } | + PrimitiveTypeKeyword Dims { Ctr__Type__0 (rtkPosOf $1) $1 (reverse $2) } | + CompoundName NonEmptyTypeArguments Dims { Ctr__Type__1 (rtkPosOf $1) $1 $2 (reverse $3) } | + CompoundName NonEmptyDims { Ctr__Type__2 (rtkPosOf $1) $1 (reverse $2) } | + CompoundName { Ctr__Type__3 (rtkPosOf $1) $1 } + +TypeArgument : qq_TypeArgument { Anti_TypeArgument (tkVal_qq_TypeArgument $1) } | + Type { Ctr__TypeArgument__0 (rtkPosOf $1) $1 } | + WildcardType { Ctr__TypeArgument__1 (rtkPosOf $1) $1 } + +TypeArguments : qq_TypeArguments { Anti_TypeArguments (tkVal_qq_TypeArguments $1) } | + { Ctr__TypeArguments__0 rtkNoPos } | + NonEmptyTypeArguments { Ctr__TypeArguments__1 (rtkPosOf $1) $1 } + +TypeDeclRest : qq_TypeDeclRest { Anti_TypeDeclRest (tkVal_qq_TypeDeclRest $1) } | + ClassDeclaration { Ctr__TypeDeclRest__0 (rtkPosOf $1) $1 } | + InterfaceDeclaration { Ctr__TypeDeclRest__1 (rtkPosOf $1) $1 } | + EnumDeclaration { Ctr__TypeDeclRest__2 (rtkPosOf $1) $1 } | + AnnotationDeclaration { Ctr__TypeDeclRest__3 (rtkPosOf $1) $1 } + +TypeDeclaration : qq_TypeDeclaration { Anti_TypeDeclaration (tkVal_qq_TypeDeclaration $1) } | + OptDocComment ModifierList TypeDeclRest { Ctr__TypeDeclaration__0 (rtkPosOf $1) $1 (reverse $2) $3 } + +TypeParameter : qq_TypeParameter { Anti_TypeParameter (tkVal_qq_TypeParameter $1) } | + id Rule_86 { Ctr__TypeParameter__0 (rtkPosOf $1) (tkVal_id $1) $2 } + +TypeParameters : qq_TypeParameters { Anti_TypeParameters (tkVal_qq_TypeParameters $1) } | + { Ctr__TypeParameters__0 rtkNoPos } | + Rule_83 { Ctr__TypeParameters__1 (rtkPosOf $1) $1 } + +TypeSpecifier : qq_TypeSpecifier { Anti_TypeSpecifier (tkVal_qq_TypeSpecifier $1) } | + tok_boolean_20 { Ctr__TypeSpecifier__0 (rtkPosOf $1) } | + tok_byte_21 { Ctr__TypeSpecifier__1 (rtkPosOf $1) } | + tok_char_22 { Ctr__TypeSpecifier__2 (rtkPosOf $1) } | + tok_short_23 { Ctr__TypeSpecifier__3 (rtkPosOf $1) } | + tok_int_24 { Ctr__TypeSpecifier__4 (rtkPosOf $1) } | + tok_float_25 { Ctr__TypeSpecifier__5 (rtkPosOf $1) } | + tok_long_26 { Ctr__TypeSpecifier__6 (rtkPosOf $1) } | + tok_double_27 { Ctr__TypeSpecifier__7 (rtkPosOf $1) } | + tok_void_28 { Ctr__TypeSpecifier__8 (rtkPosOf $1) } | + CompoundName TypeArguments { Ctr__TypeSpecifier__9 (rtkPosOf $1) $1 $2 } + +VariableDeclaration : qq_VariableDeclaration { Anti_VariableDeclaration (tkVal_qq_VariableDeclaration $1) } | + Type VariableDeclaratorList tok__semi__1 { Ctr__VariableDeclaration__0 (rtkPosOf $1) $1 $2 } | + LocalModifierList1 Type VariableDeclaratorList tok__semi__1 { Ctr__VariableDeclaration__1 (rtkPosOf (reverse $1)) (reverse $1) $2 $3 } + +VariableDeclarator : qq_VariableDeclarator { Anti_VariableDeclarator (tkVal_qq_VariableDeclarator $1) } | + id Dims OptVariableInitializer { Ctr__VariableDeclarator__0 (rtkPosOf $1) (tkVal_id $1) (reverse $2) $3 } + +VariableDeclaratorList : qq_VariableDeclaratorList { Anti_VariableDeclaratorList (tkVal_qq_VariableDeclaratorList $1) } | + VariableDeclarator Rule_46 { Ctr__VariableDeclaratorList__0 (rtkPosOf $1) $1 (reverse $2) } + +VariableInitializer : qq_VariableInitializer { Anti_VariableInitializer (tkVal_qq_VariableInitializer $1) } | + Expression { Ctr__VariableInitializer__0 (rtkPosOf $1) $1 } | + tok__symbol__14 VariableInitializerList tok__symbol__15 { Ctr__VariableInitializer__1 (rtkPosOf $1) $2 } + +VariableInitializerList : qq_VariableInitializerList { Anti_VariableInitializerList (tkVal_qq_VariableInitializerList $1) } | + { Ctr__VariableInitializerList__0 rtkNoPos } | + Rule_51 { Ctr__VariableInitializerList__1 (rtkPosOf $1) $1 } + +WhileStatement : qq_WhileStatement { Anti_WhileStatement (tkVal_qq_WhileStatement $1) } | + tok_while_44 tok__lparen__7 Expression tok__rparen__8 Statement { Ctr__WhileStatement__0 (rtkPosOf $1) $3 $5 } + +WildcardType : qq_WildcardType { Anti_WildcardType (tkVal_qq_WildcardType $1) } | + tok__symbol__62 { Ctr__WildcardType__0 (rtkPosOf $1) } | + tok__symbol__62 tok_extends_11 Type { Ctr__WildcardType__1 (rtkPosOf $1) $3 } | + tok__symbol__62 tok_super_39 Type { Ctr__WildcardType__2 (rtkPosOf $1) $3 } + + +{ +parseError :: [L.PosToken] -> Either String a +parseError [] = Left "unexpected end of input" +parseError (L.PosToken (L.AlexPn _ line col) tok : _) = + Left $ show line ++ ":" ++ show col ++ ":unexpected " ++ showRtkToken tok + +-- Render a token the way it appears in the source, for error messages +showRtkToken :: L.Token -> String +showRtkToken L.EndOfFile = "end of input" +showRtkToken L.Tk__tok_AdditiveOp_dummy_178 = "'tok_AdditiveOp_dummy_178'" +showRtkToken L.Tk__tok_Annotation_dummy_177 = "'tok_Annotation_dummy_177'" +showRtkToken L.Tk__tok_AnnotationArguments_dummy_176 = "'tok_AnnotationArguments_dummy_176'" +showRtkToken L.Tk__tok_AnnotationDeclaration_dummy_175 = "'tok_AnnotationDeclaration_dummy_175'" +showRtkToken L.Tk__tok_AnnotationElement_dummy_174 = "'tok_AnnotationElement_dummy_174'" +showRtkToken L.Tk__tok_AnnotationList_dummy_173 = "'tok_AnnotationList_dummy_173'" +showRtkToken L.Tk__tok_AnnotationTypeElement_dummy_172 = "'tok_AnnotationTypeElement_dummy_172'" +showRtkToken L.Tk__tok_AnnotationTypeElementList_dummy_171 = "'tok_AnnotationTypeElementList_dummy_171'" +showRtkToken L.Tk__tok_Arglist_dummy_170 = "'tok_Arglist_dummy_170'" +showRtkToken L.Tk__tok_AssignmentOp_dummy_169 = "'tok_AssignmentOp_dummy_169'" +showRtkToken L.Tk__tok_CatchList_dummy_168 = "'tok_CatchList_dummy_168'" +showRtkToken L.Tk__tok_ClassDeclaration_dummy_167 = "'tok_ClassDeclaration_dummy_167'" +showRtkToken L.Tk__tok_ClassOrInterfaceType_dummy_166 = "'tok_ClassOrInterfaceType_dummy_166'" +showRtkToken L.Tk__tok_CompilationUnit_dummy_165 = "'tok_CompilationUnit_dummy_165'" +showRtkToken L.Tk__tok_CompoundName_dummy_164 = "'tok_CompoundName_dummy_164'" +showRtkToken L.Tk__tok_CompoundNameTail_dummy_163 = "'tok_CompoundNameTail_dummy_163'" +showRtkToken L.Tk__tok_CreationExpression_dummy_162 = "'tok_CreationExpression_dummy_162'" +showRtkToken L.Tk__tok_DimExprs_dummy_161 = "'tok_DimExprs_dummy_161'" +showRtkToken L.Tk__tok_Dims_dummy_160 = "'tok_Dims_dummy_160'" +showRtkToken L.Tk__tok_DoStatement_dummy_159 = "'tok_DoStatement_dummy_159'" +showRtkToken L.Tk__tok_DocComment_dummy_158 = "'tok_DocComment_dummy_158'" +showRtkToken L.Tk__tok_EnumConstant_dummy_157 = "'tok_EnumConstant_dummy_157'" +showRtkToken L.Tk__tok_EnumConstantList_dummy_156 = "'tok_EnumConstantList_dummy_156'" +showRtkToken L.Tk__tok_EnumDeclaration_dummy_155 = "'tok_EnumDeclaration_dummy_155'" +showRtkToken L.Tk__tok_EqualityOp_dummy_154 = "'tok_EqualityOp_dummy_154'" +showRtkToken L.Tk__tok_Expression_dummy_153 = "'tok_Expression_dummy_153'" +showRtkToken L.Tk__tok_ExtendsList_dummy_152 = "'tok_ExtendsList_dummy_152'" +showRtkToken L.Tk__tok_FieldDeclaration_dummy_151 = "'tok_FieldDeclaration_dummy_151'" +showRtkToken L.Tk__tok_FieldDeclarationList_dummy_150 = "'tok_FieldDeclarationList_dummy_150'" +showRtkToken L.Tk__tok_ForStatement_dummy_149 = "'tok_ForStatement_dummy_149'" +showRtkToken L.Tk__tok_IfStatement_dummy_148 = "'tok_IfStatement_dummy_148'" +showRtkToken L.Tk__tok_ImplementsList_dummy_147 = "'tok_ImplementsList_dummy_147'" +showRtkToken L.Tk__tok_ImportHead_dummy_146 = "'tok_ImportHead_dummy_146'" +showRtkToken L.Tk__tok_ImportList_dummy_145 = "'tok_ImportList_dummy_145'" +showRtkToken L.Tk__tok_ImportName_dummy_144 = "'tok_ImportName_dummy_144'" +showRtkToken L.Tk__tok_ImportStatement_dummy_143 = "'tok_ImportStatement_dummy_143'" +showRtkToken L.Tk__tok_InterfaceDeclaration_dummy_142 = "'tok_InterfaceDeclaration_dummy_142'" +showRtkToken L.Tk__tok_Java_dummy_179 = "'tok_Java_dummy_179'" +showRtkToken L.Tk__tok_Literal_dummy_141 = "'tok_Literal_dummy_141'" +showRtkToken L.Tk__tok_LocalModifierList1_dummy_140 = "'tok_LocalModifierList1_dummy_140'" +showRtkToken L.Tk__tok_MemberAfterFirstId_dummy_139 = "'tok_MemberAfterFirstId_dummy_139'" +showRtkToken L.Tk__tok_MemberDeclaration_dummy_138 = "'tok_MemberDeclaration_dummy_138'" +showRtkToken L.Tk__tok_MemberRest_dummy_137 = "'tok_MemberRest_dummy_137'" +showRtkToken L.Tk__tok_Modifier_dummy_136 = "'tok_Modifier_dummy_136'" +showRtkToken L.Tk__tok_ModifierList_dummy_135 = "'tok_ModifierList_dummy_135'" +showRtkToken L.Tk__tok_MoreTypeSpecifier_dummy_134 = "'tok_MoreTypeSpecifier_dummy_134'" +showRtkToken L.Tk__tok_MoreVariableDeclarators_dummy_133 = "'tok_MoreVariableDeclarators_dummy_133'" +showRtkToken L.Tk__tok_MultiplicativeOp_dummy_132 = "'tok_MultiplicativeOp_dummy_132'" +showRtkToken L.Tk__tok_NonEmptyDims_dummy_131 = "'tok_NonEmptyDims_dummy_131'" +showRtkToken L.Tk__tok_NonEmptyTypeArguments_dummy_130 = "'tok_NonEmptyTypeArguments_dummy_130'" +showRtkToken L.Tk__tok_OptDocComment_dummy_129 = "'tok_OptDocComment_dummy_129'" +showRtkToken L.Tk__tok_OptElsePart_dummy_128 = "'tok_OptElsePart_dummy_128'" +showRtkToken L.Tk__tok_OptExpression_dummy_127 = "'tok_OptExpression_dummy_127'" +showRtkToken L.Tk__tok_OptFinally_dummy_126 = "'tok_OptFinally_dummy_126'" +showRtkToken L.Tk__tok_OptId_dummy_125 = "'tok_OptId_dummy_125'" +showRtkToken L.Tk__tok_OptVariableInitializer_dummy_124 = "'tok_OptVariableInitializer_dummy_124'" +showRtkToken L.Tk__tok_Package_dummy_123 = "'tok_Package_dummy_123'" +showRtkToken L.Tk__tok_ParamModifierList_dummy_122 = "'tok_ParamModifierList_dummy_122'" +showRtkToken L.Tk__tok_Parameter_dummy_121 = "'tok_Parameter_dummy_121'" +showRtkToken L.Tk__tok_ParameterList_dummy_120 = "'tok_ParameterList_dummy_120'" +showRtkToken L.Tk__tok_PostfixOp_dummy_119 = "'tok_PostfixOp_dummy_119'" +showRtkToken L.Tk__tok_PrefixOp_dummy_118 = "'tok_PrefixOp_dummy_118'" +showRtkToken L.Tk__tok_PrimitiveTypeKeyword_dummy_117 = "'tok_PrimitiveTypeKeyword_dummy_117'" +showRtkToken L.Tk__tok_RelationalOp_dummy_116 = "'tok_RelationalOp_dummy_116'" +showRtkToken L.Tk__tok_ShiftOp_dummy_115 = "'tok_ShiftOp_dummy_115'" +showRtkToken L.Tk__tok_Statement_dummy_114 = "'tok_Statement_dummy_114'" +showRtkToken L.Tk__tok_StatementBlock_dummy_113 = "'tok_StatementBlock_dummy_113'" +showRtkToken L.Tk__tok_StatementList_dummy_112 = "'tok_StatementList_dummy_112'" +showRtkToken L.Tk__tok_StaticInitializer_dummy_111 = "'tok_StaticInitializer_dummy_111'" +showRtkToken L.Tk__tok_SwitchCaseList_dummy_110 = "'tok_SwitchCaseList_dummy_110'" +showRtkToken L.Tk__tok_SwitchStatement_dummy_109 = "'tok_SwitchStatement_dummy_109'" +showRtkToken L.Tk__tok_ThrowsClause_dummy_108 = "'tok_ThrowsClause_dummy_108'" +showRtkToken L.Tk__tok_TryStatement_dummy_107 = "'tok_TryStatement_dummy_107'" +showRtkToken L.Tk__tok_Type_dummy_106 = "'tok_Type_dummy_106'" +showRtkToken L.Tk__tok_TypeArgument_dummy_105 = "'tok_TypeArgument_dummy_105'" +showRtkToken L.Tk__tok_TypeArguments_dummy_104 = "'tok_TypeArguments_dummy_104'" +showRtkToken L.Tk__tok_TypeDeclRest_dummy_103 = "'tok_TypeDeclRest_dummy_103'" +showRtkToken L.Tk__tok_TypeDeclaration_dummy_102 = "'tok_TypeDeclaration_dummy_102'" +showRtkToken L.Tk__tok_TypeParameter_dummy_101 = "'tok_TypeParameter_dummy_101'" +showRtkToken L.Tk__tok_TypeParameters_dummy_100 = "'tok_TypeParameters_dummy_100'" +showRtkToken L.Tk__tok_TypeSpecifier_dummy_99 = "'tok_TypeSpecifier_dummy_99'" +showRtkToken L.Tk__tok_VariableDeclaration_dummy_98 = "'tok_VariableDeclaration_dummy_98'" +showRtkToken L.Tk__tok_VariableDeclarator_dummy_97 = "'tok_VariableDeclarator_dummy_97'" +showRtkToken L.Tk__tok_VariableDeclaratorList_dummy_96 = "'tok_VariableDeclaratorList_dummy_96'" +showRtkToken L.Tk__tok_VariableInitializer_dummy_95 = "'tok_VariableInitializer_dummy_95'" +showRtkToken L.Tk__tok_VariableInitializerList_dummy_94 = "'tok_VariableInitializerList_dummy_94'" +showRtkToken L.Tk__tok_WhileStatement_dummy_93 = "'tok_WhileStatement_dummy_93'" +showRtkToken L.Tk__tok_WildcardType_dummy_92 = "'tok_WildcardType_dummy_92'" +showRtkToken L.Tk__tok__tilde__82 = "'~'" +showRtkToken L.Tk__tok__symbol__15 = "'}'" +showRtkToken L.Tk__tok__pipe__pipe__63 = "'||'" +showRtkToken L.Tk__tok__pipe__eql__55 = "'|='" +showRtkToken L.Tk__tok__pipe__65 = "'|'" +showRtkToken L.Tk__tok__symbol__14 = "'{'" +showRtkToken L.Tk__tok_while_44 = "'while'" +showRtkToken L.Tk__tok_void_28 = "'void'" +showRtkToken L.Tk__tok_try_48 = "'try'" +showRtkToken L.Tk__tok_true_85 = "'true'" +showRtkToken L.Tk__tok_transient_94 = "'transient'" +showRtkToken L.Tk__tok_throws_29 = "'throws'" +showRtkToken L.Tk__tok_throw_35 = "'throw'" +showRtkToken L.Tk__tok_threadsafe_93 = "'threadsafe'" +showRtkToken L.Tk__tok_this_40 = "'this'" +showRtkToken L.Tk__tok_synchronized_34 = "'synchronized'" +showRtkToken L.Tk__tok_switch_50 = "'switch'" +showRtkToken L.Tk__tok_super_39 = "'super'" +showRtkToken L.Tk__tok_static_3 = "'static'" +showRtkToken L.Tk__tok_short_23 = "'short'" +showRtkToken L.Tk__tok_return_33 = "'return'" +showRtkToken L.Tk__tok_public_88 = "'public'" +showRtkToken L.Tk__tok_protected_90 = "'protected'" +showRtkToken L.Tk__tok_private_89 = "'private'" +showRtkToken L.Tk__tok_package_0 = "'package'" +showRtkToken L.Tk__tok_null_87 = "'null'" +showRtkToken L.Tk__tok_new_84 = "'new'" +showRtkToken L.Tk__tok_native_91 = "'native'" +showRtkToken L.Tk__tok_long_26 = "'long'" +showRtkToken L.Tk__tok_interface_16 = "'interface'" +showRtkToken L.Tk__tok_int_24 = "'int'" +showRtkToken L.Tk__tok_instanceof_74 = "'instanceof'" +showRtkToken L.Tk__tok_import_2 = "'import'" +showRtkToken L.Tk__tok_implements_12 = "'implements'" +showRtkToken L.Tk__tok_if_42 = "'if'" +showRtkToken L.Tk__tok_for_45 = "'for'" +showRtkToken L.Tk__tok_float_25 = "'float'" +showRtkToken L.Tk__tok_finally_47 = "'finally'" +showRtkToken L.Tk__tok_final_31 = "'final'" +showRtkToken L.Tk__tok_false_86 = "'false'" +showRtkToken L.Tk__tok_extends_11 = "'extends'" +showRtkToken L.Tk__tok_enum_17 = "'enum'" +showRtkToken L.Tk__tok_else_41 = "'else'" +showRtkToken L.Tk__tok_double_27 = "'double'" +showRtkToken L.Tk__tok_do_43 = "'do'" +showRtkToken L.Tk__tok_default_30 = "'default'" +showRtkToken L.Tk__tok_continue_38 = "'continue'" +showRtkToken L.Tk__tok_class_13 = "'class'" +showRtkToken L.Tk__tok_char_22 = "'char'" +showRtkToken L.Tk__tok_catch_46 = "'catch'" +showRtkToken L.Tk__tok_case_49 = "'case'" +showRtkToken L.Tk__tok_byte_21 = "'byte'" +showRtkToken L.Tk__tok_break_37 = "'break'" +showRtkToken L.Tk__tok_boolean_20 = "'boolean'" +showRtkToken L.Tk__tok_abstract_92 = "'abstract'" +showRtkToken L.Tk__tok__symbol__eql__57 = "'^='" +showRtkToken L.Tk__tok__symbol__66 = "'^'" +showRtkToken L.Tk__tok__sq_bkt_r__19 = "']'" +showRtkToken L.Tk__tok__sq_bkt_l__18 = "'['" +showRtkToken L.Tk__tok__symbol__6 = "'@'" +showRtkToken L.Tk__tok__symbol__62 = "'?'" +showRtkToken L.Tk__tok__symbol__symbol__symbol__eql__61 = "'>>>='" +showRtkToken L.Tk__tok__symbol__symbol__eql__60 = "'>>='" +showRtkToken L.Tk__tok__symbol__eql__73 = "'>='" +showRtkToken L.Tk__tok__symbol__71 = "'>'" +showRtkToken L.Tk__tok__eql__eql__68 = "'=='" +showRtkToken L.Tk__tok__eql__10 = "'='" +showRtkToken L.Tk__tok__symbol__eql__72 = "'<='" +showRtkToken L.Tk__tok__symbol__symbol__eql__59 = "'<<='" +showRtkToken L.Tk__tok__symbol__symbol__75 = "'<<'" +showRtkToken L.Tk__tok__symbol__70 = "'<'" +showRtkToken L.Tk__tok__semi__1 = "';'" +showRtkToken L.Tk__tok__colon__36 = "':'" +showRtkToken L.Tk__tok__symbol__eql__54 = "'/='" +showRtkToken L.Tk__tok__symbol__78 = "'/'" +showRtkToken L.Tk__tok__dot__dot__dot__32 = "'...'" +showRtkToken L.Tk__tok__dot__4 = "'.'" +showRtkToken L.Tk__tok__minus__eql__52 = "'-='" +showRtkToken L.Tk__tok__minus__minus__81 = "'--'" +showRtkToken L.Tk__tok__minus__77 = "'-'" +showRtkToken L.Tk__tok__coma__9 = "','" +showRtkToken L.Tk__tok__plus__eql__51 = "'+='" +showRtkToken L.Tk__tok__plus__plus__80 = "'++'" +showRtkToken L.Tk__tok__plus__76 = "'+'" +showRtkToken L.Tk__tok__star__eql__53 = "'*='" +showRtkToken L.Tk__tok__star__5 = "'*'" +showRtkToken L.Tk__tok__rparen__8 = "')'" +showRtkToken L.Tk__tok__lparen__7 = "'('" +showRtkToken L.Tk__tok__symbol__eql__56 = "'&='" +showRtkToken L.Tk__tok__symbol__symbol__64 = "'&&'" +showRtkToken L.Tk__tok__symbol__67 = "'&'" +showRtkToken L.Tk__tok__symbol__eql__58 = "'%='" +showRtkToken L.Tk__tok__symbol__79 = "'%'" +showRtkToken L.Tk__tok__exclamation__eql__69 = "'!='" +showRtkToken L.Tk__tok__exclamation__83 = "'!'" +showRtkToken (L.Tk__doccomment v) = "doccomment " ++ show v +showRtkToken (L.Tk__id v) = "id " ++ show v +showRtkToken (L.Tk__string v) = "string " ++ show v +showRtkToken (L.Tk__char v) = "char " ++ show v +showRtkToken (L.Tk__floatTypeSuffix v) = "floatTypeSuffix " ++ show v +showRtkToken (L.Tk__exponentPart v) = "exponentPart " ++ show v +showRtkToken (L.Tk__floatLiteral v) = "floatLiteral " ++ show v +showRtkToken (L.Tk__integerLiteral v) = "integerLiteral " ++ show v +showRtkToken (L.Tk__qq_CompoundName v) = "qq_CompoundName " ++ show v +showRtkToken (L.Tk__qq_CompoundNameTail v) = "qq_CompoundNameTail " ++ show v +showRtkToken (L.Tk__qq_Modifier v) = "qq_Modifier " ++ show v +showRtkToken (L.Tk__qq_TypeSpecifier v) = "qq_TypeSpecifier " ++ show v +showRtkToken (L.Tk__qq_Type v) = "qq_Type " ++ show v +showRtkToken (L.Tk__qq_TypeParameter v) = "qq_TypeParameter " ++ show v +showRtkToken (L.Tk__qq_TypeParameters v) = "qq_TypeParameters " ++ show v +showRtkToken (L.Tk__qq_WildcardType v) = "qq_WildcardType " ++ show v +showRtkToken (L.Tk__qq_TypeArgument v) = "qq_TypeArgument " ++ show v +showRtkToken (L.Tk__qq_NonEmptyTypeArguments v) = "qq_NonEmptyTypeArguments " ++ show v +showRtkToken (L.Tk__qq_TypeArguments v) = "qq_TypeArguments " ++ show v +showRtkToken (L.Tk__qq_Arglist v) = "qq_Arglist " ++ show v +showRtkToken (L.Tk__qq_Literal v) = "qq_Literal " ++ show v +showRtkToken (L.Tk__qq_DimExprs v) = "qq_DimExprs " ++ show v +showRtkToken (L.Tk__qq_CreationExpression v) = "qq_CreationExpression " ++ show v +showRtkToken (L.Tk__qq_PostfixOp v) = "qq_PostfixOp " ++ show v +showRtkToken (L.Tk__qq_PrefixOp v) = "qq_PrefixOp " ++ show v +showRtkToken (L.Tk__qq_MultiplicativeOp v) = "qq_MultiplicativeOp " ++ show v +showRtkToken (L.Tk__qq_AdditiveOp v) = "qq_AdditiveOp " ++ show v +showRtkToken (L.Tk__qq_ShiftOp v) = "qq_ShiftOp " ++ show v +showRtkToken (L.Tk__qq_RelationalOp v) = "qq_RelationalOp " ++ show v +showRtkToken (L.Tk__qq_EqualityOp v) = "qq_EqualityOp " ++ show v +showRtkToken (L.Tk__qq_AssignmentOp v) = "qq_AssignmentOp " ++ show v +showRtkToken (L.Tk__qq_Expression v) = "qq_Expression " ++ show v +showRtkToken (L.Tk__qq_SwitchStatement v) = "qq_SwitchStatement " ++ show v +showRtkToken (L.Tk__qq_SwitchCaseList v) = "qq_SwitchCaseList " ++ show v +showRtkToken (L.Tk__qq_TryStatement v) = "qq_TryStatement " ++ show v +showRtkToken (L.Tk__qq_OptFinally v) = "qq_OptFinally " ++ show v +showRtkToken (L.Tk__qq_CatchList v) = "qq_CatchList " ++ show v +showRtkToken (L.Tk__qq_ForStatement v) = "qq_ForStatement " ++ show v +showRtkToken (L.Tk__qq_WhileStatement v) = "qq_WhileStatement " ++ show v +showRtkToken (L.Tk__qq_DoStatement v) = "qq_DoStatement " ++ show v +showRtkToken (L.Tk__qq_IfStatement v) = "qq_IfStatement " ++ show v +showRtkToken (L.Tk__qq_OptElsePart v) = "qq_OptElsePart " ++ show v +showRtkToken (L.Tk__qq_Statement v) = "qq_Statement " ++ show v +showRtkToken (L.Tk__qq_OptId v) = "qq_OptId " ++ show v +showRtkToken (L.Tk__qq_OptExpression v) = "qq_OptExpression " ++ show v +showRtkToken (L.Tk__qq_StatementList v) = "qq_StatementList " ++ show v +showRtkToken (L.Tk__qq_Parameter v) = "qq_Parameter " ++ show v +showRtkToken (L.Tk__qq_ParamModifierList v) = "qq_ParamModifierList " ++ show v +showRtkToken (L.Tk__qq_ParameterList v) = "qq_ParameterList " ++ show v +showRtkToken (L.Tk__qq_StaticInitializer v) = "qq_StaticInitializer " ++ show v +showRtkToken (L.Tk__qq_VariableInitializer v) = "qq_VariableInitializer " ++ show v +showRtkToken (L.Tk__qq_VariableInitializerList v) = "qq_VariableInitializerList " ++ show v +showRtkToken (L.Tk__qq_VariableDeclarator v) = "qq_VariableDeclarator " ++ show v +showRtkToken (L.Tk__qq_OptVariableInitializer v) = "qq_OptVariableInitializer " ++ show v +showRtkToken (L.Tk__qq_LocalModifierList1 v) = "qq_LocalModifierList1 " ++ show v +showRtkToken (L.Tk__qq_VariableDeclaration v) = "qq_VariableDeclaration " ++ show v +showRtkToken (L.Tk__qq_VariableDeclaratorList v) = "qq_VariableDeclaratorList " ++ show v +showRtkToken (L.Tk__qq_StatementBlock v) = "qq_StatementBlock " ++ show v +showRtkToken (L.Tk__qq_MoreVariableDeclarators v) = "qq_MoreVariableDeclarators " ++ show v +showRtkToken (L.Tk__qq_MemberRest v) = "qq_MemberRest " ++ show v +showRtkToken (L.Tk__qq_ThrowsClause v) = "qq_ThrowsClause " ++ show v +showRtkToken (L.Tk__qq_MoreTypeSpecifier v) = "qq_MoreTypeSpecifier " ++ show v +showRtkToken (L.Tk__qq_MemberAfterFirstId v) = "qq_MemberAfterFirstId " ++ show v +showRtkToken (L.Tk__qq_PrimitiveTypeKeyword v) = "qq_PrimitiveTypeKeyword " ++ show v +showRtkToken (L.Tk__qq_MemberDeclaration v) = "qq_MemberDeclaration " ++ show v +showRtkToken (L.Tk__qq_NonEmptyDims v) = "qq_NonEmptyDims " ++ show v +showRtkToken (L.Tk__qq_Dims v) = "qq_Dims " ++ show v +showRtkToken (L.Tk__qq_FieldDeclaration v) = "qq_FieldDeclaration " ++ show v +showRtkToken (L.Tk__qq_TypeDeclRest v) = "qq_TypeDeclRest " ++ show v +showRtkToken (L.Tk__qq_EnumDeclaration v) = "qq_EnumDeclaration " ++ show v +showRtkToken (L.Tk__qq_EnumConstantList v) = "qq_EnumConstantList " ++ show v +showRtkToken (L.Tk__qq_EnumConstant v) = "qq_EnumConstant " ++ show v +showRtkToken (L.Tk__qq_AnnotationTypeElement v) = "qq_AnnotationTypeElement " ++ show v +showRtkToken (L.Tk__qq_AnnotationTypeElementList v) = "qq_AnnotationTypeElementList " ++ show v +showRtkToken (L.Tk__qq_AnnotationDeclaration v) = "qq_AnnotationDeclaration " ++ show v +showRtkToken (L.Tk__qq_InterfaceDeclaration v) = "qq_InterfaceDeclaration " ++ show v +showRtkToken (L.Tk__qq_ClassDeclaration v) = "qq_ClassDeclaration " ++ show v +showRtkToken (L.Tk__qq_FieldDeclarationList v) = "qq_FieldDeclarationList " ++ show v +showRtkToken (L.Tk__qq_ImplementsList v) = "qq_ImplementsList " ++ show v +showRtkToken (L.Tk__qq_ExtendsList v) = "qq_ExtendsList " ++ show v +showRtkToken (L.Tk__qq_ClassOrInterfaceType v) = "qq_ClassOrInterfaceType " ++ show v +showRtkToken (L.Tk__qq_ModifierList v) = "qq_ModifierList " ++ show v +showRtkToken (L.Tk__qq_AnnotationList v) = "qq_AnnotationList " ++ show v +showRtkToken (L.Tk__qq_AnnotationElement v) = "qq_AnnotationElement " ++ show v +showRtkToken (L.Tk__qq_AnnotationArguments v) = "qq_AnnotationArguments " ++ show v +showRtkToken (L.Tk__qq_Annotation v) = "qq_Annotation " ++ show v +showRtkToken (L.Tk__qq_DocComment v) = "qq_DocComment " ++ show v +showRtkToken (L.Tk__qq_ImportHead v) = "qq_ImportHead " ++ show v +showRtkToken (L.Tk__qq_ImportName v) = "qq_ImportName " ++ show v +showRtkToken (L.Tk__qq_ImportStatement v) = "qq_ImportStatement " ++ show v +showRtkToken (L.Tk__qq_Package v) = "qq_Package " ++ show v +showRtkToken (L.Tk__qq_CompilationUnit v) = "qq_CompilationUnit " ++ show v +showRtkToken (L.Tk__qq_ImportList v) = "qq_ImportList " ++ show v +showRtkToken (L.Tk__qq_TypeDeclaration v) = "qq_TypeDeclaration " ++ show v +showRtkToken (L.Tk__qq_OptDocComment v) = "qq_OptDocComment " ++ show v +showRtkToken (L.Tk__qq_Java v) = "qq_Java " ++ show v + +-- Source position of a node: every constructor except the Anti_* splice +-- artifacts stores the position of its alternative's first symbol in its +-- first field. Positions are transparent for equality and ordering, so two +-- ASTs that differ only in source positions (e.g. a quasi-quote parsed at +-- compile time vs the same construct parsed at run time) compare equal. +newtype RtkPos = RtkPos L.AlexPosn deriving (Show, Gen.Data, Gen.Typeable) +instance Eq RtkPos where _ == _ = True +instance Ord RtkPos where compare _ _ = EQ + +-- The position used where no source token exists: empty productions, empty +-- lists, absent optionals and Anti_* quasi-quote splices +rtkNoPos :: RtkPos +rtkNoPos = RtkPos (L.AlexPn 0 0 0) + +class RtkPosOf a where + rtkPosOf :: a -> RtkPos +instance RtkPosOf L.PosToken where + rtkPosOf (L.PosToken p _) = RtkPos p +instance RtkPosOf a => RtkPosOf [a] where + rtkPosOf (x : _) = rtkPosOf x + rtkPosOf [] = rtkNoPos +instance RtkPosOf a => RtkPosOf (Maybe a) where + rtkPosOf (Just x) = rtkPosOf x + rtkPosOf Nothing = rtkNoPos +-- A Char carries no position; this also covers String token payloads +instance RtkPosOf Char where + rtkPosOf _ = rtkNoPos + +-- Recover a token's payload from the whole positioned token: %token +-- bindings keep the L.PosToken so semantic actions can read its position +tkVal_doccomment :: L.PosToken -> String +tkVal_doccomment (L.PosToken _ (L.Tk__doccomment v)) = v +tkVal_doccomment t = error ("rtk internal error: token doccomment expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_id :: L.PosToken -> String +tkVal_id (L.PosToken _ (L.Tk__id v)) = v +tkVal_id t = error ("rtk internal error: token id expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_string :: L.PosToken -> String +tkVal_string (L.PosToken _ (L.Tk__string v)) = v +tkVal_string t = error ("rtk internal error: token string expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_char :: L.PosToken -> String +tkVal_char (L.PosToken _ (L.Tk__char v)) = v +tkVal_char t = error ("rtk internal error: token char expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_floatTypeSuffix :: L.PosToken -> String +tkVal_floatTypeSuffix (L.PosToken _ (L.Tk__floatTypeSuffix v)) = v +tkVal_floatTypeSuffix t = error ("rtk internal error: token floatTypeSuffix expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_exponentPart :: L.PosToken -> String +tkVal_exponentPart (L.PosToken _ (L.Tk__exponentPart v)) = v +tkVal_exponentPart t = error ("rtk internal error: token exponentPart expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_floatLiteral :: L.PosToken -> String +tkVal_floatLiteral (L.PosToken _ (L.Tk__floatLiteral v)) = v +tkVal_floatLiteral t = error ("rtk internal error: token floatLiteral expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_integerLiteral :: L.PosToken -> String +tkVal_integerLiteral (L.PosToken _ (L.Tk__integerLiteral v)) = v +tkVal_integerLiteral t = error ("rtk internal error: token integerLiteral expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_CompoundName :: L.PosToken -> String +tkVal_qq_CompoundName (L.PosToken _ (L.Tk__qq_CompoundName v)) = v +tkVal_qq_CompoundName t = error ("rtk internal error: token qq_CompoundName expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_CompoundNameTail :: L.PosToken -> String +tkVal_qq_CompoundNameTail (L.PosToken _ (L.Tk__qq_CompoundNameTail v)) = v +tkVal_qq_CompoundNameTail t = error ("rtk internal error: token qq_CompoundNameTail expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Modifier :: L.PosToken -> String +tkVal_qq_Modifier (L.PosToken _ (L.Tk__qq_Modifier v)) = v +tkVal_qq_Modifier t = error ("rtk internal error: token qq_Modifier expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TypeSpecifier :: L.PosToken -> String +tkVal_qq_TypeSpecifier (L.PosToken _ (L.Tk__qq_TypeSpecifier v)) = v +tkVal_qq_TypeSpecifier t = error ("rtk internal error: token qq_TypeSpecifier expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Type :: L.PosToken -> String +tkVal_qq_Type (L.PosToken _ (L.Tk__qq_Type v)) = v +tkVal_qq_Type t = error ("rtk internal error: token qq_Type expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TypeParameter :: L.PosToken -> String +tkVal_qq_TypeParameter (L.PosToken _ (L.Tk__qq_TypeParameter v)) = v +tkVal_qq_TypeParameter t = error ("rtk internal error: token qq_TypeParameter expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TypeParameters :: L.PosToken -> String +tkVal_qq_TypeParameters (L.PosToken _ (L.Tk__qq_TypeParameters v)) = v +tkVal_qq_TypeParameters t = error ("rtk internal error: token qq_TypeParameters expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_WildcardType :: L.PosToken -> String +tkVal_qq_WildcardType (L.PosToken _ (L.Tk__qq_WildcardType v)) = v +tkVal_qq_WildcardType t = error ("rtk internal error: token qq_WildcardType expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TypeArgument :: L.PosToken -> String +tkVal_qq_TypeArgument (L.PosToken _ (L.Tk__qq_TypeArgument v)) = v +tkVal_qq_TypeArgument t = error ("rtk internal error: token qq_TypeArgument expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_NonEmptyTypeArguments :: L.PosToken -> String +tkVal_qq_NonEmptyTypeArguments (L.PosToken _ (L.Tk__qq_NonEmptyTypeArguments v)) = v +tkVal_qq_NonEmptyTypeArguments t = error ("rtk internal error: token qq_NonEmptyTypeArguments expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TypeArguments :: L.PosToken -> String +tkVal_qq_TypeArguments (L.PosToken _ (L.Tk__qq_TypeArguments v)) = v +tkVal_qq_TypeArguments t = error ("rtk internal error: token qq_TypeArguments expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Arglist :: L.PosToken -> String +tkVal_qq_Arglist (L.PosToken _ (L.Tk__qq_Arglist v)) = v +tkVal_qq_Arglist t = error ("rtk internal error: token qq_Arglist expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Literal :: L.PosToken -> String +tkVal_qq_Literal (L.PosToken _ (L.Tk__qq_Literal v)) = v +tkVal_qq_Literal t = error ("rtk internal error: token qq_Literal expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_DimExprs :: L.PosToken -> String +tkVal_qq_DimExprs (L.PosToken _ (L.Tk__qq_DimExprs v)) = v +tkVal_qq_DimExprs t = error ("rtk internal error: token qq_DimExprs expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_CreationExpression :: L.PosToken -> String +tkVal_qq_CreationExpression (L.PosToken _ (L.Tk__qq_CreationExpression v)) = v +tkVal_qq_CreationExpression t = error ("rtk internal error: token qq_CreationExpression expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_PostfixOp :: L.PosToken -> String +tkVal_qq_PostfixOp (L.PosToken _ (L.Tk__qq_PostfixOp v)) = v +tkVal_qq_PostfixOp t = error ("rtk internal error: token qq_PostfixOp expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_PrefixOp :: L.PosToken -> String +tkVal_qq_PrefixOp (L.PosToken _ (L.Tk__qq_PrefixOp v)) = v +tkVal_qq_PrefixOp t = error ("rtk internal error: token qq_PrefixOp expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_MultiplicativeOp :: L.PosToken -> String +tkVal_qq_MultiplicativeOp (L.PosToken _ (L.Tk__qq_MultiplicativeOp v)) = v +tkVal_qq_MultiplicativeOp t = error ("rtk internal error: token qq_MultiplicativeOp expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_AdditiveOp :: L.PosToken -> String +tkVal_qq_AdditiveOp (L.PosToken _ (L.Tk__qq_AdditiveOp v)) = v +tkVal_qq_AdditiveOp t = error ("rtk internal error: token qq_AdditiveOp expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ShiftOp :: L.PosToken -> String +tkVal_qq_ShiftOp (L.PosToken _ (L.Tk__qq_ShiftOp v)) = v +tkVal_qq_ShiftOp t = error ("rtk internal error: token qq_ShiftOp expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_RelationalOp :: L.PosToken -> String +tkVal_qq_RelationalOp (L.PosToken _ (L.Tk__qq_RelationalOp v)) = v +tkVal_qq_RelationalOp t = error ("rtk internal error: token qq_RelationalOp expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_EqualityOp :: L.PosToken -> String +tkVal_qq_EqualityOp (L.PosToken _ (L.Tk__qq_EqualityOp v)) = v +tkVal_qq_EqualityOp t = error ("rtk internal error: token qq_EqualityOp expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_AssignmentOp :: L.PosToken -> String +tkVal_qq_AssignmentOp (L.PosToken _ (L.Tk__qq_AssignmentOp v)) = v +tkVal_qq_AssignmentOp t = error ("rtk internal error: token qq_AssignmentOp expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Expression :: L.PosToken -> String +tkVal_qq_Expression (L.PosToken _ (L.Tk__qq_Expression v)) = v +tkVal_qq_Expression t = error ("rtk internal error: token qq_Expression expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_SwitchStatement :: L.PosToken -> String +tkVal_qq_SwitchStatement (L.PosToken _ (L.Tk__qq_SwitchStatement v)) = v +tkVal_qq_SwitchStatement t = error ("rtk internal error: token qq_SwitchStatement expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_SwitchCaseList :: L.PosToken -> String +tkVal_qq_SwitchCaseList (L.PosToken _ (L.Tk__qq_SwitchCaseList v)) = v +tkVal_qq_SwitchCaseList t = error ("rtk internal error: token qq_SwitchCaseList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TryStatement :: L.PosToken -> String +tkVal_qq_TryStatement (L.PosToken _ (L.Tk__qq_TryStatement v)) = v +tkVal_qq_TryStatement t = error ("rtk internal error: token qq_TryStatement expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptFinally :: L.PosToken -> String +tkVal_qq_OptFinally (L.PosToken _ (L.Tk__qq_OptFinally v)) = v +tkVal_qq_OptFinally t = error ("rtk internal error: token qq_OptFinally expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_CatchList :: L.PosToken -> String +tkVal_qq_CatchList (L.PosToken _ (L.Tk__qq_CatchList v)) = v +tkVal_qq_CatchList t = error ("rtk internal error: token qq_CatchList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ForStatement :: L.PosToken -> String +tkVal_qq_ForStatement (L.PosToken _ (L.Tk__qq_ForStatement v)) = v +tkVal_qq_ForStatement t = error ("rtk internal error: token qq_ForStatement expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_WhileStatement :: L.PosToken -> String +tkVal_qq_WhileStatement (L.PosToken _ (L.Tk__qq_WhileStatement v)) = v +tkVal_qq_WhileStatement t = error ("rtk internal error: token qq_WhileStatement expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_DoStatement :: L.PosToken -> String +tkVal_qq_DoStatement (L.PosToken _ (L.Tk__qq_DoStatement v)) = v +tkVal_qq_DoStatement t = error ("rtk internal error: token qq_DoStatement expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_IfStatement :: L.PosToken -> String +tkVal_qq_IfStatement (L.PosToken _ (L.Tk__qq_IfStatement v)) = v +tkVal_qq_IfStatement t = error ("rtk internal error: token qq_IfStatement expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptElsePart :: L.PosToken -> String +tkVal_qq_OptElsePart (L.PosToken _ (L.Tk__qq_OptElsePart v)) = v +tkVal_qq_OptElsePart t = error ("rtk internal error: token qq_OptElsePart expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Statement :: L.PosToken -> String +tkVal_qq_Statement (L.PosToken _ (L.Tk__qq_Statement v)) = v +tkVal_qq_Statement t = error ("rtk internal error: token qq_Statement expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptId :: L.PosToken -> String +tkVal_qq_OptId (L.PosToken _ (L.Tk__qq_OptId v)) = v +tkVal_qq_OptId t = error ("rtk internal error: token qq_OptId expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptExpression :: L.PosToken -> String +tkVal_qq_OptExpression (L.PosToken _ (L.Tk__qq_OptExpression v)) = v +tkVal_qq_OptExpression t = error ("rtk internal error: token qq_OptExpression expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_StatementList :: L.PosToken -> String +tkVal_qq_StatementList (L.PosToken _ (L.Tk__qq_StatementList v)) = v +tkVal_qq_StatementList t = error ("rtk internal error: token qq_StatementList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Parameter :: L.PosToken -> String +tkVal_qq_Parameter (L.PosToken _ (L.Tk__qq_Parameter v)) = v +tkVal_qq_Parameter t = error ("rtk internal error: token qq_Parameter expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ParamModifierList :: L.PosToken -> String +tkVal_qq_ParamModifierList (L.PosToken _ (L.Tk__qq_ParamModifierList v)) = v +tkVal_qq_ParamModifierList t = error ("rtk internal error: token qq_ParamModifierList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ParameterList :: L.PosToken -> String +tkVal_qq_ParameterList (L.PosToken _ (L.Tk__qq_ParameterList v)) = v +tkVal_qq_ParameterList t = error ("rtk internal error: token qq_ParameterList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_StaticInitializer :: L.PosToken -> String +tkVal_qq_StaticInitializer (L.PosToken _ (L.Tk__qq_StaticInitializer v)) = v +tkVal_qq_StaticInitializer t = error ("rtk internal error: token qq_StaticInitializer expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_VariableInitializer :: L.PosToken -> String +tkVal_qq_VariableInitializer (L.PosToken _ (L.Tk__qq_VariableInitializer v)) = v +tkVal_qq_VariableInitializer t = error ("rtk internal error: token qq_VariableInitializer expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_VariableInitializerList :: L.PosToken -> String +tkVal_qq_VariableInitializerList (L.PosToken _ (L.Tk__qq_VariableInitializerList v)) = v +tkVal_qq_VariableInitializerList t = error ("rtk internal error: token qq_VariableInitializerList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_VariableDeclarator :: L.PosToken -> String +tkVal_qq_VariableDeclarator (L.PosToken _ (L.Tk__qq_VariableDeclarator v)) = v +tkVal_qq_VariableDeclarator t = error ("rtk internal error: token qq_VariableDeclarator expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptVariableInitializer :: L.PosToken -> String +tkVal_qq_OptVariableInitializer (L.PosToken _ (L.Tk__qq_OptVariableInitializer v)) = v +tkVal_qq_OptVariableInitializer t = error ("rtk internal error: token qq_OptVariableInitializer expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_LocalModifierList1 :: L.PosToken -> String +tkVal_qq_LocalModifierList1 (L.PosToken _ (L.Tk__qq_LocalModifierList1 v)) = v +tkVal_qq_LocalModifierList1 t = error ("rtk internal error: token qq_LocalModifierList1 expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_VariableDeclaration :: L.PosToken -> String +tkVal_qq_VariableDeclaration (L.PosToken _ (L.Tk__qq_VariableDeclaration v)) = v +tkVal_qq_VariableDeclaration t = error ("rtk internal error: token qq_VariableDeclaration expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_VariableDeclaratorList :: L.PosToken -> String +tkVal_qq_VariableDeclaratorList (L.PosToken _ (L.Tk__qq_VariableDeclaratorList v)) = v +tkVal_qq_VariableDeclaratorList t = error ("rtk internal error: token qq_VariableDeclaratorList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_StatementBlock :: L.PosToken -> String +tkVal_qq_StatementBlock (L.PosToken _ (L.Tk__qq_StatementBlock v)) = v +tkVal_qq_StatementBlock t = error ("rtk internal error: token qq_StatementBlock expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_MoreVariableDeclarators :: L.PosToken -> String +tkVal_qq_MoreVariableDeclarators (L.PosToken _ (L.Tk__qq_MoreVariableDeclarators v)) = v +tkVal_qq_MoreVariableDeclarators t = error ("rtk internal error: token qq_MoreVariableDeclarators expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_MemberRest :: L.PosToken -> String +tkVal_qq_MemberRest (L.PosToken _ (L.Tk__qq_MemberRest v)) = v +tkVal_qq_MemberRest t = error ("rtk internal error: token qq_MemberRest expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ThrowsClause :: L.PosToken -> String +tkVal_qq_ThrowsClause (L.PosToken _ (L.Tk__qq_ThrowsClause v)) = v +tkVal_qq_ThrowsClause t = error ("rtk internal error: token qq_ThrowsClause expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_MoreTypeSpecifier :: L.PosToken -> String +tkVal_qq_MoreTypeSpecifier (L.PosToken _ (L.Tk__qq_MoreTypeSpecifier v)) = v +tkVal_qq_MoreTypeSpecifier t = error ("rtk internal error: token qq_MoreTypeSpecifier expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_MemberAfterFirstId :: L.PosToken -> String +tkVal_qq_MemberAfterFirstId (L.PosToken _ (L.Tk__qq_MemberAfterFirstId v)) = v +tkVal_qq_MemberAfterFirstId t = error ("rtk internal error: token qq_MemberAfterFirstId expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_PrimitiveTypeKeyword :: L.PosToken -> String +tkVal_qq_PrimitiveTypeKeyword (L.PosToken _ (L.Tk__qq_PrimitiveTypeKeyword v)) = v +tkVal_qq_PrimitiveTypeKeyword t = error ("rtk internal error: token qq_PrimitiveTypeKeyword expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_MemberDeclaration :: L.PosToken -> String +tkVal_qq_MemberDeclaration (L.PosToken _ (L.Tk__qq_MemberDeclaration v)) = v +tkVal_qq_MemberDeclaration t = error ("rtk internal error: token qq_MemberDeclaration expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_NonEmptyDims :: L.PosToken -> String +tkVal_qq_NonEmptyDims (L.PosToken _ (L.Tk__qq_NonEmptyDims v)) = v +tkVal_qq_NonEmptyDims t = error ("rtk internal error: token qq_NonEmptyDims expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Dims :: L.PosToken -> String +tkVal_qq_Dims (L.PosToken _ (L.Tk__qq_Dims v)) = v +tkVal_qq_Dims t = error ("rtk internal error: token qq_Dims expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_FieldDeclaration :: L.PosToken -> String +tkVal_qq_FieldDeclaration (L.PosToken _ (L.Tk__qq_FieldDeclaration v)) = v +tkVal_qq_FieldDeclaration t = error ("rtk internal error: token qq_FieldDeclaration expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TypeDeclRest :: L.PosToken -> String +tkVal_qq_TypeDeclRest (L.PosToken _ (L.Tk__qq_TypeDeclRest v)) = v +tkVal_qq_TypeDeclRest t = error ("rtk internal error: token qq_TypeDeclRest expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_EnumDeclaration :: L.PosToken -> String +tkVal_qq_EnumDeclaration (L.PosToken _ (L.Tk__qq_EnumDeclaration v)) = v +tkVal_qq_EnumDeclaration t = error ("rtk internal error: token qq_EnumDeclaration expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_EnumConstantList :: L.PosToken -> String +tkVal_qq_EnumConstantList (L.PosToken _ (L.Tk__qq_EnumConstantList v)) = v +tkVal_qq_EnumConstantList t = error ("rtk internal error: token qq_EnumConstantList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_EnumConstant :: L.PosToken -> String +tkVal_qq_EnumConstant (L.PosToken _ (L.Tk__qq_EnumConstant v)) = v +tkVal_qq_EnumConstant t = error ("rtk internal error: token qq_EnumConstant expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_AnnotationTypeElement :: L.PosToken -> String +tkVal_qq_AnnotationTypeElement (L.PosToken _ (L.Tk__qq_AnnotationTypeElement v)) = v +tkVal_qq_AnnotationTypeElement t = error ("rtk internal error: token qq_AnnotationTypeElement expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_AnnotationTypeElementList :: L.PosToken -> String +tkVal_qq_AnnotationTypeElementList (L.PosToken _ (L.Tk__qq_AnnotationTypeElementList v)) = v +tkVal_qq_AnnotationTypeElementList t = error ("rtk internal error: token qq_AnnotationTypeElementList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_AnnotationDeclaration :: L.PosToken -> String +tkVal_qq_AnnotationDeclaration (L.PosToken _ (L.Tk__qq_AnnotationDeclaration v)) = v +tkVal_qq_AnnotationDeclaration t = error ("rtk internal error: token qq_AnnotationDeclaration expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_InterfaceDeclaration :: L.PosToken -> String +tkVal_qq_InterfaceDeclaration (L.PosToken _ (L.Tk__qq_InterfaceDeclaration v)) = v +tkVal_qq_InterfaceDeclaration t = error ("rtk internal error: token qq_InterfaceDeclaration expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ClassDeclaration :: L.PosToken -> String +tkVal_qq_ClassDeclaration (L.PosToken _ (L.Tk__qq_ClassDeclaration v)) = v +tkVal_qq_ClassDeclaration t = error ("rtk internal error: token qq_ClassDeclaration expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_FieldDeclarationList :: L.PosToken -> String +tkVal_qq_FieldDeclarationList (L.PosToken _ (L.Tk__qq_FieldDeclarationList v)) = v +tkVal_qq_FieldDeclarationList t = error ("rtk internal error: token qq_FieldDeclarationList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ImplementsList :: L.PosToken -> String +tkVal_qq_ImplementsList (L.PosToken _ (L.Tk__qq_ImplementsList v)) = v +tkVal_qq_ImplementsList t = error ("rtk internal error: token qq_ImplementsList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ExtendsList :: L.PosToken -> String +tkVal_qq_ExtendsList (L.PosToken _ (L.Tk__qq_ExtendsList v)) = v +tkVal_qq_ExtendsList t = error ("rtk internal error: token qq_ExtendsList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ClassOrInterfaceType :: L.PosToken -> String +tkVal_qq_ClassOrInterfaceType (L.PosToken _ (L.Tk__qq_ClassOrInterfaceType v)) = v +tkVal_qq_ClassOrInterfaceType t = error ("rtk internal error: token qq_ClassOrInterfaceType expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ModifierList :: L.PosToken -> String +tkVal_qq_ModifierList (L.PosToken _ (L.Tk__qq_ModifierList v)) = v +tkVal_qq_ModifierList t = error ("rtk internal error: token qq_ModifierList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_AnnotationList :: L.PosToken -> String +tkVal_qq_AnnotationList (L.PosToken _ (L.Tk__qq_AnnotationList v)) = v +tkVal_qq_AnnotationList t = error ("rtk internal error: token qq_AnnotationList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_AnnotationElement :: L.PosToken -> String +tkVal_qq_AnnotationElement (L.PosToken _ (L.Tk__qq_AnnotationElement v)) = v +tkVal_qq_AnnotationElement t = error ("rtk internal error: token qq_AnnotationElement expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_AnnotationArguments :: L.PosToken -> String +tkVal_qq_AnnotationArguments (L.PosToken _ (L.Tk__qq_AnnotationArguments v)) = v +tkVal_qq_AnnotationArguments t = error ("rtk internal error: token qq_AnnotationArguments expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Annotation :: L.PosToken -> String +tkVal_qq_Annotation (L.PosToken _ (L.Tk__qq_Annotation v)) = v +tkVal_qq_Annotation t = error ("rtk internal error: token qq_Annotation expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_DocComment :: L.PosToken -> String +tkVal_qq_DocComment (L.PosToken _ (L.Tk__qq_DocComment v)) = v +tkVal_qq_DocComment t = error ("rtk internal error: token qq_DocComment expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ImportHead :: L.PosToken -> String +tkVal_qq_ImportHead (L.PosToken _ (L.Tk__qq_ImportHead v)) = v +tkVal_qq_ImportHead t = error ("rtk internal error: token qq_ImportHead expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ImportName :: L.PosToken -> String +tkVal_qq_ImportName (L.PosToken _ (L.Tk__qq_ImportName v)) = v +tkVal_qq_ImportName t = error ("rtk internal error: token qq_ImportName expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ImportStatement :: L.PosToken -> String +tkVal_qq_ImportStatement (L.PosToken _ (L.Tk__qq_ImportStatement v)) = v +tkVal_qq_ImportStatement t = error ("rtk internal error: token qq_ImportStatement expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Package :: L.PosToken -> String +tkVal_qq_Package (L.PosToken _ (L.Tk__qq_Package v)) = v +tkVal_qq_Package t = error ("rtk internal error: token qq_Package expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_CompilationUnit :: L.PosToken -> String +tkVal_qq_CompilationUnit (L.PosToken _ (L.Tk__qq_CompilationUnit v)) = v +tkVal_qq_CompilationUnit t = error ("rtk internal error: token qq_CompilationUnit expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_ImportList :: L.PosToken -> String +tkVal_qq_ImportList (L.PosToken _ (L.Tk__qq_ImportList v)) = v +tkVal_qq_ImportList t = error ("rtk internal error: token qq_ImportList expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_TypeDeclaration :: L.PosToken -> String +tkVal_qq_TypeDeclaration (L.PosToken _ (L.Tk__qq_TypeDeclaration v)) = v +tkVal_qq_TypeDeclaration t = error ("rtk internal error: token qq_TypeDeclaration expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_OptDocComment :: L.PosToken -> String +tkVal_qq_OptDocComment (L.PosToken _ (L.Tk__qq_OptDocComment v)) = v +tkVal_qq_OptDocComment t = error ("rtk internal error: token qq_OptDocComment expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Java :: L.PosToken -> String +tkVal_qq_Java (L.PosToken _ (L.Tk__qq_Java v)) = v +tkVal_qq_Java t = error ("rtk internal error: token qq_Java expected, got " ++ showRtkToken (L.ptToken t)) + +data Java = Ctr__Java__0 RtkPos Java | + Ctr__Java__1 RtkPos AdditiveOp | + Ctr__Java__2 RtkPos Annotation | + Ctr__Java__3 RtkPos AnnotationArguments | + Ctr__Java__4 RtkPos AnnotationDeclaration | + Ctr__Java__5 RtkPos AnnotationElement | + Ctr__Java__6 RtkPos AnnotationList | + Ctr__Java__7 RtkPos AnnotationTypeElement | + Ctr__Java__8 RtkPos AnnotationTypeElementList | + Ctr__Java__9 RtkPos Arglist | + Ctr__Java__10 RtkPos AssignmentOp | + Ctr__Java__11 RtkPos CatchList | + Ctr__Java__12 RtkPos ClassDeclaration | + Ctr__Java__13 RtkPos ClassOrInterfaceType | + Ctr__Java__14 RtkPos CompilationUnit | + Ctr__Java__15 RtkPos CompoundName | + Ctr__Java__16 RtkPos CompoundNameTail | + Ctr__Java__17 RtkPos CreationExpression | + Ctr__Java__18 RtkPos DimExprs | + Ctr__Java__19 RtkPos Dims | + Ctr__Java__20 RtkPos DoStatement | + Ctr__Java__21 RtkPos DocComment | + Ctr__Java__22 RtkPos EnumConstant | + Ctr__Java__23 RtkPos EnumConstantList | + Ctr__Java__24 RtkPos EnumDeclaration | + Ctr__Java__25 RtkPos EqualityOp | + Ctr__Java__26 RtkPos Expression | + Ctr__Java__27 RtkPos ExtendsList | + Ctr__Java__28 RtkPos FieldDeclaration | + Ctr__Java__29 RtkPos FieldDeclarationList | + Ctr__Java__30 RtkPos ForStatement | + Ctr__Java__31 RtkPos IfStatement | + Ctr__Java__32 RtkPos ImplementsList | + Ctr__Java__33 RtkPos ImportHead | + Ctr__Java__34 RtkPos ImportList | + Ctr__Java__35 RtkPos ImportName | + Ctr__Java__36 RtkPos ImportStatement | + Ctr__Java__37 RtkPos InterfaceDeclaration | + Ctr__Java__38 RtkPos Literal | + Ctr__Java__39 RtkPos LocalModifierList1 | + Ctr__Java__40 RtkPos MemberAfterFirstId | + Ctr__Java__41 RtkPos MemberDeclaration | + Ctr__Java__42 RtkPos MemberRest | + Ctr__Java__43 RtkPos Modifier | + Ctr__Java__44 RtkPos ModifierList | + Ctr__Java__45 RtkPos MoreTypeSpecifier | + Ctr__Java__46 RtkPos MoreVariableDeclarators | + Ctr__Java__47 RtkPos MultiplicativeOp | + Ctr__Java__48 RtkPos NonEmptyDims | + Ctr__Java__49 RtkPos NonEmptyTypeArguments | + Ctr__Java__50 RtkPos OptDocComment | + Ctr__Java__51 RtkPos OptElsePart | + Ctr__Java__52 RtkPos OptExpression | + Ctr__Java__53 RtkPos OptFinally | + Ctr__Java__54 RtkPos OptId | + Ctr__Java__55 RtkPos OptVariableInitializer | + Ctr__Java__56 RtkPos Package | + Ctr__Java__57 RtkPos ParamModifierList | + Ctr__Java__58 RtkPos Parameter | + Ctr__Java__59 RtkPos ParameterList | + Ctr__Java__60 RtkPos PostfixOp | + Ctr__Java__61 RtkPos PrefixOp | + Ctr__Java__62 RtkPos PrimitiveTypeKeyword | + Ctr__Java__63 RtkPos RelationalOp | + Ctr__Java__64 RtkPos ShiftOp | + Ctr__Java__65 RtkPos Statement | + Ctr__Java__66 RtkPos StatementBlock | + Ctr__Java__67 RtkPos StatementList | + Ctr__Java__68 RtkPos StaticInitializer | + Ctr__Java__69 RtkPos SwitchCaseList | + Ctr__Java__70 RtkPos SwitchStatement | + Ctr__Java__71 RtkPos ThrowsClause | + Ctr__Java__72 RtkPos TryStatement | + Ctr__Java__73 RtkPos Type | + Ctr__Java__74 RtkPos TypeArgument | + Ctr__Java__75 RtkPos TypeArguments | + Ctr__Java__76 RtkPos TypeDeclRest | + Ctr__Java__77 RtkPos TypeDeclaration | + Ctr__Java__78 RtkPos TypeParameter | + Ctr__Java__79 RtkPos TypeParameters | + Ctr__Java__80 RtkPos TypeSpecifier | + Ctr__Java__81 RtkPos VariableDeclaration | + Ctr__Java__82 RtkPos VariableDeclarator | + Ctr__Java__83 RtkPos VariableDeclaratorList | + Ctr__Java__84 RtkPos VariableInitializer | + Ctr__Java__85 RtkPos VariableInitializerList | + Ctr__Java__86 RtkPos WhileStatement | + Ctr__Java__87 RtkPos WildcardType | + Anti_Java String | + Ctr__Java__88 RtkPos CompilationUnit + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Java where + rtkPosOf (Ctr__Java__0 p _) = p + rtkPosOf (Ctr__Java__1 p _) = p + rtkPosOf (Ctr__Java__2 p _) = p + rtkPosOf (Ctr__Java__3 p _) = p + rtkPosOf (Ctr__Java__4 p _) = p + rtkPosOf (Ctr__Java__5 p _) = p + rtkPosOf (Ctr__Java__6 p _) = p + rtkPosOf (Ctr__Java__7 p _) = p + rtkPosOf (Ctr__Java__8 p _) = p + rtkPosOf (Ctr__Java__9 p _) = p + rtkPosOf (Ctr__Java__10 p _) = p + rtkPosOf (Ctr__Java__11 p _) = p + rtkPosOf (Ctr__Java__12 p _) = p + rtkPosOf (Ctr__Java__13 p _) = p + rtkPosOf (Ctr__Java__14 p _) = p + rtkPosOf (Ctr__Java__15 p _) = p + rtkPosOf (Ctr__Java__16 p _) = p + rtkPosOf (Ctr__Java__17 p _) = p + rtkPosOf (Ctr__Java__18 p _) = p + rtkPosOf (Ctr__Java__19 p _) = p + rtkPosOf (Ctr__Java__20 p _) = p + rtkPosOf (Ctr__Java__21 p _) = p + rtkPosOf (Ctr__Java__22 p _) = p + rtkPosOf (Ctr__Java__23 p _) = p + rtkPosOf (Ctr__Java__24 p _) = p + rtkPosOf (Ctr__Java__25 p _) = p + rtkPosOf (Ctr__Java__26 p _) = p + rtkPosOf (Ctr__Java__27 p _) = p + rtkPosOf (Ctr__Java__28 p _) = p + rtkPosOf (Ctr__Java__29 p _) = p + rtkPosOf (Ctr__Java__30 p _) = p + rtkPosOf (Ctr__Java__31 p _) = p + rtkPosOf (Ctr__Java__32 p _) = p + rtkPosOf (Ctr__Java__33 p _) = p + rtkPosOf (Ctr__Java__34 p _) = p + rtkPosOf (Ctr__Java__35 p _) = p + rtkPosOf (Ctr__Java__36 p _) = p + rtkPosOf (Ctr__Java__37 p _) = p + rtkPosOf (Ctr__Java__38 p _) = p + rtkPosOf (Ctr__Java__39 p _) = p + rtkPosOf (Ctr__Java__40 p _) = p + rtkPosOf (Ctr__Java__41 p _) = p + rtkPosOf (Ctr__Java__42 p _) = p + rtkPosOf (Ctr__Java__43 p _) = p + rtkPosOf (Ctr__Java__44 p _) = p + rtkPosOf (Ctr__Java__45 p _) = p + rtkPosOf (Ctr__Java__46 p _) = p + rtkPosOf (Ctr__Java__47 p _) = p + rtkPosOf (Ctr__Java__48 p _) = p + rtkPosOf (Ctr__Java__49 p _) = p + rtkPosOf (Ctr__Java__50 p _) = p + rtkPosOf (Ctr__Java__51 p _) = p + rtkPosOf (Ctr__Java__52 p _) = p + rtkPosOf (Ctr__Java__53 p _) = p + rtkPosOf (Ctr__Java__54 p _) = p + rtkPosOf (Ctr__Java__55 p _) = p + rtkPosOf (Ctr__Java__56 p _) = p + rtkPosOf (Ctr__Java__57 p _) = p + rtkPosOf (Ctr__Java__58 p _) = p + rtkPosOf (Ctr__Java__59 p _) = p + rtkPosOf (Ctr__Java__60 p _) = p + rtkPosOf (Ctr__Java__61 p _) = p + rtkPosOf (Ctr__Java__62 p _) = p + rtkPosOf (Ctr__Java__63 p _) = p + rtkPosOf (Ctr__Java__64 p _) = p + rtkPosOf (Ctr__Java__65 p _) = p + rtkPosOf (Ctr__Java__66 p _) = p + rtkPosOf (Ctr__Java__67 p _) = p + rtkPosOf (Ctr__Java__68 p _) = p + rtkPosOf (Ctr__Java__69 p _) = p + rtkPosOf (Ctr__Java__70 p _) = p + rtkPosOf (Ctr__Java__71 p _) = p + rtkPosOf (Ctr__Java__72 p _) = p + rtkPosOf (Ctr__Java__73 p _) = p + rtkPosOf (Ctr__Java__74 p _) = p + rtkPosOf (Ctr__Java__75 p _) = p + rtkPosOf (Ctr__Java__76 p _) = p + rtkPosOf (Ctr__Java__77 p _) = p + rtkPosOf (Ctr__Java__78 p _) = p + rtkPosOf (Ctr__Java__79 p _) = p + rtkPosOf (Ctr__Java__80 p _) = p + rtkPosOf (Ctr__Java__81 p _) = p + rtkPosOf (Ctr__Java__82 p _) = p + rtkPosOf (Ctr__Java__83 p _) = p + rtkPosOf (Ctr__Java__84 p _) = p + rtkPosOf (Ctr__Java__85 p _) = p + rtkPosOf (Ctr__Java__86 p _) = p + rtkPosOf (Ctr__Java__87 p _) = p + rtkPosOf (Anti_Java _) = rtkNoPos + rtkPosOf (Ctr__Java__88 p _) = p +data AdditiveOp = Anti_AdditiveOp String | + Ctr__AdditiveOp__0 RtkPos | + Ctr__AdditiveOp__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf AdditiveOp where + rtkPosOf (Anti_AdditiveOp _) = rtkNoPos + rtkPosOf (Ctr__AdditiveOp__0 p) = p + rtkPosOf (Ctr__AdditiveOp__1 p) = p +data Annotation = Anti_Annotation String | + Ctr__Annotation__1 RtkPos CompoundName Rule_4 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Annotation where + rtkPosOf (Anti_Annotation _) = rtkNoPos + rtkPosOf (Ctr__Annotation__1 p _ _) = p +data AnnotationArguments = Anti_AnnotationArguments String | + Ctr__AnnotationArguments__0 RtkPos AnnotationElement Rule_7 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf AnnotationArguments where + rtkPosOf (Anti_AnnotationArguments _) = rtkNoPos + rtkPosOf (Ctr__AnnotationArguments__0 p _ _) = p +data AnnotationDeclaration = Anti_AnnotationDeclaration String | + Ctr__AnnotationDeclaration__0 RtkPos String AnnotationTypeElementList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf AnnotationDeclaration where + rtkPosOf (Anti_AnnotationDeclaration _) = rtkNoPos + rtkPosOf (Ctr__AnnotationDeclaration__0 p _ _) = p +data AnnotationElement = Anti_AnnotationElement String | + Ctr__AnnotationElement__0 RtkPos String Expression | + Ctr__AnnotationElement__1 RtkPos Expression + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf AnnotationElement where + rtkPosOf (Anti_AnnotationElement _) = rtkNoPos + rtkPosOf (Ctr__AnnotationElement__0 p _ _) = p + rtkPosOf (Ctr__AnnotationElement__1 p _) = p +type AnnotationList = [Annotation] +data AnnotationTypeElement = Anti_AnnotationTypeElement String | + Ctr__AnnotationTypeElement__0 RtkPos FieldDeclaration + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf AnnotationTypeElement where + rtkPosOf (Anti_AnnotationTypeElement _) = rtkNoPos + rtkPosOf (Ctr__AnnotationTypeElement__0 p _) = p +type AnnotationTypeElementList = [AnnotationTypeElement] +data Arglist = Anti_Arglist String | + Ctr__Arglist__0 RtkPos | + Ctr__Arglist__1 RtkPos Rule_78 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Arglist where + rtkPosOf (Anti_Arglist _) = rtkNoPos + rtkPosOf (Ctr__Arglist__0 p) = p + rtkPosOf (Ctr__Arglist__1 p _) = p +data AssignmentOp = Anti_AssignmentOp String | + Ctr__AssignmentOp__0 RtkPos | + Ctr__AssignmentOp__1 RtkPos | + Ctr__AssignmentOp__2 RtkPos | + Ctr__AssignmentOp__3 RtkPos | + Ctr__AssignmentOp__4 RtkPos | + Ctr__AssignmentOp__5 RtkPos | + Ctr__AssignmentOp__6 RtkPos | + Ctr__AssignmentOp__7 RtkPos | + Ctr__AssignmentOp__8 RtkPos | + Ctr__AssignmentOp__9 RtkPos | + Ctr__AssignmentOp__10 RtkPos | + Ctr__AssignmentOp__11 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf AssignmentOp where + rtkPosOf (Anti_AssignmentOp _) = rtkNoPos + rtkPosOf (Ctr__AssignmentOp__0 p) = p + rtkPosOf (Ctr__AssignmentOp__1 p) = p + rtkPosOf (Ctr__AssignmentOp__2 p) = p + rtkPosOf (Ctr__AssignmentOp__3 p) = p + rtkPosOf (Ctr__AssignmentOp__4 p) = p + rtkPosOf (Ctr__AssignmentOp__5 p) = p + rtkPosOf (Ctr__AssignmentOp__6 p) = p + rtkPosOf (Ctr__AssignmentOp__7 p) = p + rtkPosOf (Ctr__AssignmentOp__8 p) = p + rtkPosOf (Ctr__AssignmentOp__9 p) = p + rtkPosOf (Ctr__AssignmentOp__10 p) = p + rtkPosOf (Ctr__AssignmentOp__11 p) = p +type CatchList = [Rule_63] +data ClassDeclaration = Anti_ClassDeclaration String | + Ctr__ClassDeclaration__0 RtkPos String TypeParameters Rule_16 Rule_17 FieldDeclarationList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ClassDeclaration where + rtkPosOf (Anti_ClassDeclaration _) = rtkNoPos + rtkPosOf (Ctr__ClassDeclaration__0 p _ _ _ _ _) = p +data ClassOrInterfaceType = Anti_ClassOrInterfaceType String | + Ctr__ClassOrInterfaceType__0 RtkPos CompoundName TypeArguments + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ClassOrInterfaceType where + rtkPosOf (Anti_ClassOrInterfaceType _) = rtkNoPos + rtkPosOf (Ctr__ClassOrInterfaceType__0 p _ _) = p +data CompilationUnit = Anti_CompilationUnit String | + Ctr__CompilationUnit__0 RtkPos Rule_1 ImportList Rule_2 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf CompilationUnit where + rtkPosOf (Anti_CompilationUnit _) = rtkNoPos + rtkPosOf (Ctr__CompilationUnit__0 p _ _ _) = p +data CompoundName = Anti_CompoundName String | + Ctr__CompoundName__0 RtkPos String CompoundNameTail + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf CompoundName where + rtkPosOf (Anti_CompoundName _) = rtkNoPos + rtkPosOf (Ctr__CompoundName__0 p _ _) = p +type CompoundNameTail = [Rule_90] +data CreationExpression = Anti_CreationExpression String | + Ctr__CreationExpression__0 RtkPos TypeSpecifier Rule_74 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf CreationExpression where + rtkPosOf (Anti_CreationExpression _) = rtkNoPos + rtkPosOf (Ctr__CreationExpression__0 p _ _) = p +type DimExprs = [Rule_76] +type Dims = [Rule_31] +data DoStatement = Anti_DoStatement String | + Ctr__DoStatement__0 RtkPos Statement Expression + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf DoStatement where + rtkPosOf (Anti_DoStatement _) = rtkNoPos + rtkPosOf (Ctr__DoStatement__0 p _ _) = p +data DocComment = Anti_DocComment String | + Ctr__DocComment__0 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf DocComment where + rtkPosOf (Anti_DocComment _) = rtkNoPos + rtkPosOf (Ctr__DocComment__0 p _) = p +data EnumConstant = Anti_EnumConstant String | + Ctr__EnumConstant__0 RtkPos AnnotationList String Rule_20 Rule_22 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf EnumConstant where + rtkPosOf (Anti_EnumConstant _) = rtkNoPos + rtkPosOf (Ctr__EnumConstant__0 p _ _ _ _) = p +data EnumConstantList = Anti_EnumConstantList String | + Ctr__EnumConstantList__0 RtkPos EnumConstant Rule_24 Rule_26 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf EnumConstantList where + rtkPosOf (Anti_EnumConstantList _) = rtkNoPos + rtkPosOf (Ctr__EnumConstantList__0 p _ _ _) = p +data EnumDeclaration = Anti_EnumDeclaration String | + Ctr__EnumDeclaration__0 RtkPos String Rule_27 EnumConstantList Rule_28 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf EnumDeclaration where + rtkPosOf (Anti_EnumDeclaration _) = rtkNoPos + rtkPosOf (Ctr__EnumDeclaration__0 p _ _ _ _) = p +data EqualityOp = Anti_EqualityOp String | + Ctr__EqualityOp__0 RtkPos | + Ctr__EqualityOp__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf EqualityOp where + rtkPosOf (Anti_EqualityOp _) = rtkNoPos + rtkPosOf (Ctr__EqualityOp__0 p) = p + rtkPosOf (Ctr__EqualityOp__1 p) = p +data Expression = Anti_Expression String | + Ctr__Expression__0 RtkPos Literal | + Ctr__Expression__1 RtkPos | + Ctr__Expression__2 RtkPos Expression | + Ctr__Expression__3 RtkPos CreationExpression | + Ctr__Expression__4 RtkPos CompoundName Rule_70 | + Ctr__Expression__5 RtkPos CompoundName Expression | + Ctr__Expression__6 RtkPos String Rule_72 | + Ctr__Expression__7 RtkPos String CompoundNameTail | + Ctr__Expression__8 RtkPos String CompoundNameTail | + Ctr__Expression__9 RtkPos String CompoundNameTail NonEmptyTypeArguments String Arglist | + Ctr__Expression__10 RtkPos PrimitiveTypeKeyword | + Ctr__Expression__11 RtkPos Expression | + Ctr__Expression__12 RtkPos Expression PostfixOp | + Ctr__Expression__13 RtkPos Expression String | + Ctr__Expression__14 RtkPos Expression String Arglist | + Ctr__Expression__15 RtkPos Expression NonEmptyTypeArguments String Arglist | + Ctr__Expression__16 RtkPos Expression Expression | + Ctr__Expression__17 RtkPos Expression | + Ctr__Expression__18 RtkPos Expression | + Ctr__Expression__19 RtkPos Expression | + Ctr__Expression__20 RtkPos Expression | + Ctr__Expression__21 RtkPos PrefixOp Expression | + Ctr__Expression__22 RtkPos Expression | + Ctr__Expression__23 RtkPos PrimitiveTypeKeyword Dims Expression | + Ctr__Expression__24 RtkPos CompoundName NonEmptyTypeArguments Dims Expression | + Ctr__Expression__25 RtkPos CompoundName NonEmptyDims Expression | + Ctr__Expression__26 RtkPos Expression Expression | + Ctr__Expression__27 RtkPos Expression | + Ctr__Expression__28 RtkPos Expression MultiplicativeOp Expression | + Ctr__Expression__29 RtkPos Expression | + Ctr__Expression__30 RtkPos Expression AdditiveOp Expression | + Ctr__Expression__31 RtkPos Expression | + Ctr__Expression__32 RtkPos Expression ShiftOp Expression | + Ctr__Expression__33 RtkPos Expression | + Ctr__Expression__34 RtkPos Expression RelationalOp Expression | + Ctr__Expression__35 RtkPos Expression Type | + Ctr__Expression__36 RtkPos Expression | + Ctr__Expression__37 RtkPos Expression EqualityOp Expression | + Ctr__Expression__38 RtkPos Expression | + Ctr__Expression__39 RtkPos Expression Expression | + Ctr__Expression__40 RtkPos Expression | + Ctr__Expression__41 RtkPos Expression Expression | + Ctr__Expression__42 RtkPos Expression | + Ctr__Expression__43 RtkPos Expression Expression | + Ctr__Expression__44 RtkPos Expression | + Ctr__Expression__45 RtkPos Expression Expression | + Ctr__Expression__46 RtkPos Expression | + Ctr__Expression__47 RtkPos Expression Expression | + Ctr__Expression__48 RtkPos Expression | + Ctr__Expression__49 RtkPos Expression Expression Expression | + Ctr__Expression__50 RtkPos Expression Rule_68 | + Ctr__Expression__51 RtkPos Expression + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Expression where + rtkPosOf (Anti_Expression _) = rtkNoPos + rtkPosOf (Ctr__Expression__0 p _) = p + rtkPosOf (Ctr__Expression__1 p) = p + rtkPosOf (Ctr__Expression__2 p _) = p + rtkPosOf (Ctr__Expression__3 p _) = p + rtkPosOf (Ctr__Expression__4 p _ _) = p + rtkPosOf (Ctr__Expression__5 p _ _) = p + rtkPosOf (Ctr__Expression__6 p _ _) = p + rtkPosOf (Ctr__Expression__7 p _ _) = p + rtkPosOf (Ctr__Expression__8 p _ _) = p + rtkPosOf (Ctr__Expression__9 p _ _ _ _ _) = p + rtkPosOf (Ctr__Expression__10 p _) = p + rtkPosOf (Ctr__Expression__11 p _) = p + rtkPosOf (Ctr__Expression__12 p _ _) = p + rtkPosOf (Ctr__Expression__13 p _ _) = p + rtkPosOf (Ctr__Expression__14 p _ _ _) = p + rtkPosOf (Ctr__Expression__15 p _ _ _ _) = p + rtkPosOf (Ctr__Expression__16 p _ _) = p + rtkPosOf (Ctr__Expression__17 p _) = p + rtkPosOf (Ctr__Expression__18 p _) = p + rtkPosOf (Ctr__Expression__19 p _) = p + rtkPosOf (Ctr__Expression__20 p _) = p + rtkPosOf (Ctr__Expression__21 p _ _) = p + rtkPosOf (Ctr__Expression__22 p _) = p + rtkPosOf (Ctr__Expression__23 p _ _ _) = p + rtkPosOf (Ctr__Expression__24 p _ _ _ _) = p + rtkPosOf (Ctr__Expression__25 p _ _ _) = p + rtkPosOf (Ctr__Expression__26 p _ _) = p + rtkPosOf (Ctr__Expression__27 p _) = p + rtkPosOf (Ctr__Expression__28 p _ _ _) = p + rtkPosOf (Ctr__Expression__29 p _) = p + rtkPosOf (Ctr__Expression__30 p _ _ _) = p + rtkPosOf (Ctr__Expression__31 p _) = p + rtkPosOf (Ctr__Expression__32 p _ _ _) = p + rtkPosOf (Ctr__Expression__33 p _) = p + rtkPosOf (Ctr__Expression__34 p _ _ _) = p + rtkPosOf (Ctr__Expression__35 p _ _) = p + rtkPosOf (Ctr__Expression__36 p _) = p + rtkPosOf (Ctr__Expression__37 p _ _ _) = p + rtkPosOf (Ctr__Expression__38 p _) = p + rtkPosOf (Ctr__Expression__39 p _ _) = p + rtkPosOf (Ctr__Expression__40 p _) = p + rtkPosOf (Ctr__Expression__41 p _ _) = p + rtkPosOf (Ctr__Expression__42 p _) = p + rtkPosOf (Ctr__Expression__43 p _ _) = p + rtkPosOf (Ctr__Expression__44 p _) = p + rtkPosOf (Ctr__Expression__45 p _ _) = p + rtkPosOf (Ctr__Expression__46 p _) = p + rtkPosOf (Ctr__Expression__47 p _ _) = p + rtkPosOf (Ctr__Expression__48 p _) = p + rtkPosOf (Ctr__Expression__49 p _ _ _) = p + rtkPosOf (Ctr__Expression__50 p _ _) = p + rtkPosOf (Ctr__Expression__51 p _) = p +data ExtendsList = Anti_ExtendsList String | + Ctr__ExtendsList__0 RtkPos ClassOrInterfaceType Rule_12 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ExtendsList where + rtkPosOf (Anti_ExtendsList _) = rtkNoPos + rtkPosOf (Ctr__ExtendsList__0 p _ _) = p +data FieldDeclaration = Anti_FieldDeclaration String | + Ctr__FieldDeclaration__0 RtkPos OptDocComment ModifierList Rule_30 | + Ctr__FieldDeclaration__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf FieldDeclaration where + rtkPosOf (Anti_FieldDeclaration _) = rtkNoPos + rtkPosOf (Ctr__FieldDeclaration__0 p _ _ _) = p + rtkPosOf (Ctr__FieldDeclaration__1 p) = p +type FieldDeclarationList = [FieldDeclaration] +data ForStatement = Anti_ForStatement String | + Ctr__ForStatement__0 RtkPos Rule_62 OptExpression OptExpression Statement + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ForStatement where + rtkPosOf (Anti_ForStatement _) = rtkNoPos + rtkPosOf (Ctr__ForStatement__0 p _ _ _ _) = p +data IfStatement = Anti_IfStatement String | + Ctr__IfStatement__0 RtkPos Expression Statement OptElsePart + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf IfStatement where + rtkPosOf (Anti_IfStatement _) = rtkNoPos + rtkPosOf (Ctr__IfStatement__0 p _ _ _) = p +data ImplementsList = Anti_ImplementsList String | + Ctr__ImplementsList__0 RtkPos Rule_14 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ImplementsList where + rtkPosOf (Anti_ImplementsList _) = rtkNoPos + rtkPosOf (Ctr__ImplementsList__0 p _) = p +data ImportHead = Anti_ImportHead String | + Ctr__ImportHead__0 RtkPos String | + Ctr__ImportHead__1 RtkPos ImportHead String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ImportHead where + rtkPosOf (Anti_ImportHead _) = rtkNoPos + rtkPosOf (Ctr__ImportHead__0 p _) = p + rtkPosOf (Ctr__ImportHead__1 p _ _) = p +type ImportList = [ImportStatement] +data ImportName = Anti_ImportName String | + Ctr__ImportName__0 RtkPos ImportHead | + Ctr__ImportName__1 RtkPos ImportHead + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ImportName where + rtkPosOf (Anti_ImportName _) = rtkNoPos + rtkPosOf (Ctr__ImportName__0 p _) = p + rtkPosOf (Ctr__ImportName__1 p _) = p +data ImportStatement = Anti_ImportStatement String | + Ctr__ImportStatement__0 RtkPos Rule_3 ImportName + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ImportStatement where + rtkPosOf (Anti_ImportStatement _) = rtkNoPos + rtkPosOf (Ctr__ImportStatement__0 p _ _) = p +data InterfaceDeclaration = Anti_InterfaceDeclaration String | + Ctr__InterfaceDeclaration__0 RtkPos String TypeParameters Rule_18 FieldDeclarationList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf InterfaceDeclaration where + rtkPosOf (Anti_InterfaceDeclaration _) = rtkNoPos + rtkPosOf (Ctr__InterfaceDeclaration__0 p _ _ _ _) = p +data Literal = Anti_Literal String | + Ctr__Literal__0 RtkPos String | + Ctr__Literal__1 RtkPos String | + Ctr__Literal__2 RtkPos | + Ctr__Literal__3 RtkPos | + Ctr__Literal__4 RtkPos String | + Ctr__Literal__5 RtkPos String | + Ctr__Literal__6 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Literal where + rtkPosOf (Anti_Literal _) = rtkNoPos + rtkPosOf (Ctr__Literal__0 p _) = p + rtkPosOf (Ctr__Literal__1 p _) = p + rtkPosOf (Ctr__Literal__2 p) = p + rtkPosOf (Ctr__Literal__3 p) = p + rtkPosOf (Ctr__Literal__4 p _) = p + rtkPosOf (Ctr__Literal__5 p _) = p + rtkPosOf (Ctr__Literal__6 p) = p +type LocalModifierList1 = [Rule_48] +data MemberAfterFirstId = Anti_MemberAfterFirstId String | + Ctr__MemberAfterFirstId__0 RtkPos Rule_35 Rule_36 StatementBlock | + Ctr__MemberAfterFirstId__1 RtkPos MoreTypeSpecifier String MemberRest + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf MemberAfterFirstId where + rtkPosOf (Anti_MemberAfterFirstId _) = rtkNoPos + rtkPosOf (Ctr__MemberAfterFirstId__0 p _ _ _) = p + rtkPosOf (Ctr__MemberAfterFirstId__1 p _ _ _) = p +data MemberDeclaration = Anti_MemberDeclaration String | + Ctr__MemberDeclaration__0 RtkPos PrimitiveTypeKeyword Dims String MemberRest | + Ctr__MemberDeclaration__1 RtkPos TypeParameters String MoreTypeSpecifier String MemberRest | + Ctr__MemberDeclaration__2 RtkPos String MemberAfterFirstId + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf MemberDeclaration where + rtkPosOf (Anti_MemberDeclaration _) = rtkNoPos + rtkPosOf (Ctr__MemberDeclaration__0 p _ _ _ _) = p + rtkPosOf (Ctr__MemberDeclaration__1 p _ _ _ _ _) = p + rtkPosOf (Ctr__MemberDeclaration__2 p _ _) = p +data MemberRest = Anti_MemberRest String | + Ctr__MemberRest__0 RtkPos Rule_39 Dims Rule_40 Rule_41 | + Ctr__MemberRest__1 RtkPos Dims OptVariableInitializer MoreVariableDeclarators + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf MemberRest where + rtkPosOf (Anti_MemberRest _) = rtkNoPos + rtkPosOf (Ctr__MemberRest__0 p _ _ _ _) = p + rtkPosOf (Ctr__MemberRest__1 p _ _ _) = p +data Modifier = Anti_Modifier String | + Ctr__Modifier__0 RtkPos | + Ctr__Modifier__1 RtkPos | + Ctr__Modifier__2 RtkPos | + Ctr__Modifier__3 RtkPos | + Ctr__Modifier__4 RtkPos | + Ctr__Modifier__5 RtkPos | + Ctr__Modifier__6 RtkPos | + Ctr__Modifier__7 RtkPos | + Ctr__Modifier__8 RtkPos | + Ctr__Modifier__9 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Modifier where + rtkPosOf (Anti_Modifier _) = rtkNoPos + rtkPosOf (Ctr__Modifier__0 p) = p + rtkPosOf (Ctr__Modifier__1 p) = p + rtkPosOf (Ctr__Modifier__2 p) = p + rtkPosOf (Ctr__Modifier__3 p) = p + rtkPosOf (Ctr__Modifier__4 p) = p + rtkPosOf (Ctr__Modifier__5 p) = p + rtkPosOf (Ctr__Modifier__6 p) = p + rtkPosOf (Ctr__Modifier__7 p) = p + rtkPosOf (Ctr__Modifier__8 p) = p + rtkPosOf (Ctr__Modifier__9 p) = p +type ModifierList = [Rule_10] +data MoreTypeSpecifier = Anti_MoreTypeSpecifier String | + Ctr__MoreTypeSpecifier__0 RtkPos String MoreTypeSpecifier | + Ctr__MoreTypeSpecifier__1 RtkPos TypeArguments Dims + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf MoreTypeSpecifier where + rtkPosOf (Anti_MoreTypeSpecifier _) = rtkNoPos + rtkPosOf (Ctr__MoreTypeSpecifier__0 p _ _) = p + rtkPosOf (Ctr__MoreTypeSpecifier__1 p _ _) = p +type MoreVariableDeclarators = [Rule_44] +data MultiplicativeOp = Anti_MultiplicativeOp String | + Ctr__MultiplicativeOp__0 RtkPos | + Ctr__MultiplicativeOp__1 RtkPos | + Ctr__MultiplicativeOp__2 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf MultiplicativeOp where + rtkPosOf (Anti_MultiplicativeOp _) = rtkNoPos + rtkPosOf (Ctr__MultiplicativeOp__0 p) = p + rtkPosOf (Ctr__MultiplicativeOp__1 p) = p + rtkPosOf (Ctr__MultiplicativeOp__2 p) = p +type NonEmptyDims = [Rule_33] +data NonEmptyTypeArguments = Anti_NonEmptyTypeArguments String | + Ctr__NonEmptyTypeArguments__0 RtkPos TypeArgument Rule_81 | + Ctr__NonEmptyTypeArguments__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf NonEmptyTypeArguments where + rtkPosOf (Anti_NonEmptyTypeArguments _) = rtkNoPos + rtkPosOf (Ctr__NonEmptyTypeArguments__0 p _ _) = p + rtkPosOf (Ctr__NonEmptyTypeArguments__1 p) = p +data OptDocComment = Anti_OptDocComment String | + Ctr__OptDocComment__0 RtkPos | + Ctr__OptDocComment__1 RtkPos DocComment + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptDocComment where + rtkPosOf (Anti_OptDocComment _) = rtkNoPos + rtkPosOf (Ctr__OptDocComment__0 p) = p + rtkPosOf (Ctr__OptDocComment__1 p _) = p +data OptElsePart = Anti_OptElsePart String | + Ctr__OptElsePart__0 RtkPos | + Ctr__OptElsePart__1 RtkPos Rule_61 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptElsePart where + rtkPosOf (Anti_OptElsePart _) = rtkNoPos + rtkPosOf (Ctr__OptElsePart__0 p) = p + rtkPosOf (Ctr__OptElsePart__1 p _) = p +data OptExpression = Anti_OptExpression String | + Ctr__OptExpression__0 RtkPos | + Ctr__OptExpression__1 RtkPos Expression + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptExpression where + rtkPosOf (Anti_OptExpression _) = rtkNoPos + rtkPosOf (Ctr__OptExpression__0 p) = p + rtkPosOf (Ctr__OptExpression__1 p _) = p +data OptFinally = Anti_OptFinally String | + Ctr__OptFinally__0 RtkPos | + Ctr__OptFinally__1 RtkPos Rule_65 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptFinally where + rtkPosOf (Anti_OptFinally _) = rtkNoPos + rtkPosOf (Ctr__OptFinally__0 p) = p + rtkPosOf (Ctr__OptFinally__1 p _) = p +data OptId = Anti_OptId String | + Ctr__OptId__0 RtkPos | + Ctr__OptId__1 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptId where + rtkPosOf (Anti_OptId _) = rtkNoPos + rtkPosOf (Ctr__OptId__0 p) = p + rtkPosOf (Ctr__OptId__1 p _) = p +data OptVariableInitializer = Anti_OptVariableInitializer String | + Ctr__OptVariableInitializer__0 RtkPos | + Ctr__OptVariableInitializer__1 RtkPos Rule_50 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf OptVariableInitializer where + rtkPosOf (Anti_OptVariableInitializer _) = rtkNoPos + rtkPosOf (Ctr__OptVariableInitializer__0 p) = p + rtkPosOf (Ctr__OptVariableInitializer__1 p _) = p +data Package = Anti_Package String | + Ctr__Package__0 RtkPos CompoundName + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Package where + rtkPosOf (Anti_Package _) = rtkNoPos + rtkPosOf (Ctr__Package__0 p _) = p +type ParamModifierList = [Rule_57] +data Parameter = Anti_Parameter String | + Ctr__Parameter__0 RtkPos ParamModifierList Type Rule_59 String Dims + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Parameter where + rtkPosOf (Anti_Parameter _) = rtkNoPos + rtkPosOf (Ctr__Parameter__0 p _ _ _ _ _) = p +data ParameterList = Anti_ParameterList String | + Ctr__ParameterList__0 RtkPos Parameter Rule_55 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ParameterList where + rtkPosOf (Anti_ParameterList _) = rtkNoPos + rtkPosOf (Ctr__ParameterList__0 p _ _) = p +data PostfixOp = Anti_PostfixOp String | + Ctr__PostfixOp__0 RtkPos | + Ctr__PostfixOp__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf PostfixOp where + rtkPosOf (Anti_PostfixOp _) = rtkNoPos + rtkPosOf (Ctr__PostfixOp__0 p) = p + rtkPosOf (Ctr__PostfixOp__1 p) = p +data PrefixOp = Anti_PrefixOp String | + Ctr__PrefixOp__0 RtkPos | + Ctr__PrefixOp__1 RtkPos | + Ctr__PrefixOp__2 RtkPos | + Ctr__PrefixOp__3 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf PrefixOp where + rtkPosOf (Anti_PrefixOp _) = rtkNoPos + rtkPosOf (Ctr__PrefixOp__0 p) = p + rtkPosOf (Ctr__PrefixOp__1 p) = p + rtkPosOf (Ctr__PrefixOp__2 p) = p + rtkPosOf (Ctr__PrefixOp__3 p) = p +data PrimitiveTypeKeyword = Anti_PrimitiveTypeKeyword String | + Ctr__PrimitiveTypeKeyword__0 RtkPos | + Ctr__PrimitiveTypeKeyword__1 RtkPos | + Ctr__PrimitiveTypeKeyword__2 RtkPos | + Ctr__PrimitiveTypeKeyword__3 RtkPos | + Ctr__PrimitiveTypeKeyword__4 RtkPos | + Ctr__PrimitiveTypeKeyword__5 RtkPos | + Ctr__PrimitiveTypeKeyword__6 RtkPos | + Ctr__PrimitiveTypeKeyword__7 RtkPos | + Ctr__PrimitiveTypeKeyword__8 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf PrimitiveTypeKeyword where + rtkPosOf (Anti_PrimitiveTypeKeyword _) = rtkNoPos + rtkPosOf (Ctr__PrimitiveTypeKeyword__0 p) = p + rtkPosOf (Ctr__PrimitiveTypeKeyword__1 p) = p + rtkPosOf (Ctr__PrimitiveTypeKeyword__2 p) = p + rtkPosOf (Ctr__PrimitiveTypeKeyword__3 p) = p + rtkPosOf (Ctr__PrimitiveTypeKeyword__4 p) = p + rtkPosOf (Ctr__PrimitiveTypeKeyword__5 p) = p + rtkPosOf (Ctr__PrimitiveTypeKeyword__6 p) = p + rtkPosOf (Ctr__PrimitiveTypeKeyword__7 p) = p + rtkPosOf (Ctr__PrimitiveTypeKeyword__8 p) = p +data RelationalOp = Anti_RelationalOp String | + Ctr__RelationalOp__0 RtkPos | + Ctr__RelationalOp__1 RtkPos | + Ctr__RelationalOp__2 RtkPos | + Ctr__RelationalOp__3 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf RelationalOp where + rtkPosOf (Anti_RelationalOp _) = rtkNoPos + rtkPosOf (Ctr__RelationalOp__0 p) = p + rtkPosOf (Ctr__RelationalOp__1 p) = p + rtkPosOf (Ctr__RelationalOp__2 p) = p + rtkPosOf (Ctr__RelationalOp__3 p) = p +data Rule_1 = Ctr__Rule_1__0 RtkPos | + Ctr__Rule_1__1 RtkPos Package + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_1 where + rtkPosOf (Ctr__Rule_1__0 p) = p + rtkPosOf (Ctr__Rule_1__1 p _) = p +data Rule_10 = Anti_Rule_10 String | + Ctr__Rule_10__1 RtkPos Modifier | + Ctr__Rule_10__2 RtkPos Annotation + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_10 where + rtkPosOf (Anti_Rule_10 _) = rtkNoPos + rtkPosOf (Ctr__Rule_10__1 p _) = p + rtkPosOf (Ctr__Rule_10__2 p _) = p +type Rule_12 = [Rule_13] +data Rule_13 = Ctr__Rule_13__0 RtkPos ClassOrInterfaceType + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_13 where + rtkPosOf (Ctr__Rule_13__0 p _) = p +type Rule_14 = [ClassOrInterfaceType] +data Rule_16 = Ctr__Rule_16__0 RtkPos | + Ctr__Rule_16__1 RtkPos ExtendsList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_16 where + rtkPosOf (Ctr__Rule_16__0 p) = p + rtkPosOf (Ctr__Rule_16__1 p _) = p +data Rule_17 = Ctr__Rule_17__0 RtkPos | + Ctr__Rule_17__1 RtkPos ImplementsList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_17 where + rtkPosOf (Ctr__Rule_17__0 p) = p + rtkPosOf (Ctr__Rule_17__1 p _) = p +data Rule_18 = Ctr__Rule_18__0 RtkPos | + Ctr__Rule_18__1 RtkPos ExtendsList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_18 where + rtkPosOf (Ctr__Rule_18__0 p) = p + rtkPosOf (Ctr__Rule_18__1 p _) = p +data Rule_2 = Ctr__Rule_2__0 RtkPos | + Ctr__Rule_2__1 RtkPos TypeDeclaration + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_2 where + rtkPosOf (Ctr__Rule_2__0 p) = p + rtkPosOf (Ctr__Rule_2__1 p _) = p +data Rule_20 = Ctr__Rule_20__0 RtkPos | + Ctr__Rule_20__1 RtkPos Rule_21 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_20 where + rtkPosOf (Ctr__Rule_20__0 p) = p + rtkPosOf (Ctr__Rule_20__1 p _) = p +data Rule_21 = Ctr__Rule_21__0 RtkPos Arglist + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_21 where + rtkPosOf (Ctr__Rule_21__0 p _) = p +data Rule_22 = Ctr__Rule_22__0 RtkPos | + Ctr__Rule_22__1 RtkPos Rule_23 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_22 where + rtkPosOf (Ctr__Rule_22__0 p) = p + rtkPosOf (Ctr__Rule_22__1 p _) = p +data Rule_23 = Ctr__Rule_23__0 RtkPos FieldDeclarationList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_23 where + rtkPosOf (Ctr__Rule_23__0 p _) = p +type Rule_24 = [Rule_25] +data Rule_25 = Ctr__Rule_25__0 RtkPos EnumConstant + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_25 where + rtkPosOf (Ctr__Rule_25__0 p _) = p +data Rule_26 = Ctr__Rule_26__0 RtkPos | + Ctr__Rule_26__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_26 where + rtkPosOf (Ctr__Rule_26__0 p) = p + rtkPosOf (Ctr__Rule_26__1 p) = p +data Rule_27 = Ctr__Rule_27__0 RtkPos | + Ctr__Rule_27__1 RtkPos ImplementsList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_27 where + rtkPosOf (Ctr__Rule_27__0 p) = p + rtkPosOf (Ctr__Rule_27__1 p _) = p +data Rule_28 = Ctr__Rule_28__0 RtkPos | + Ctr__Rule_28__1 RtkPos Rule_29 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_28 where + rtkPosOf (Ctr__Rule_28__0 p) = p + rtkPosOf (Ctr__Rule_28__1 p _) = p +data Rule_29 = Ctr__Rule_29__0 RtkPos FieldDeclarationList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_29 where + rtkPosOf (Ctr__Rule_29__0 p _) = p +data Rule_3 = Ctr__Rule_3__0 RtkPos | + Ctr__Rule_3__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_3 where + rtkPosOf (Ctr__Rule_3__0 p) = p + rtkPosOf (Ctr__Rule_3__1 p) = p +data Rule_30 = Ctr__Rule_30__0 RtkPos MemberDeclaration | + Ctr__Rule_30__1 RtkPos TypeDeclRest | + Ctr__Rule_30__2 RtkPos StaticInitializer + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_30 where + rtkPosOf (Ctr__Rule_30__0 p _) = p + rtkPosOf (Ctr__Rule_30__1 p _) = p + rtkPosOf (Ctr__Rule_30__2 p _) = p +data Rule_31 = Anti_Rule_31 String | + Ctr__Rule_31__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_31 where + rtkPosOf (Anti_Rule_31 _) = rtkNoPos + rtkPosOf (Ctr__Rule_31__1 p) = p +data Rule_33 = Anti_Rule_33 String | + Ctr__Rule_33__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_33 where + rtkPosOf (Anti_Rule_33 _) = rtkNoPos + rtkPosOf (Ctr__Rule_33__1 p) = p +data Rule_35 = Ctr__Rule_35__0 RtkPos | + Ctr__Rule_35__1 RtkPos ParameterList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_35 where + rtkPosOf (Ctr__Rule_35__0 p) = p + rtkPosOf (Ctr__Rule_35__1 p _) = p +data Rule_36 = Ctr__Rule_36__0 RtkPos | + Ctr__Rule_36__1 RtkPos ThrowsClause + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_36 where + rtkPosOf (Ctr__Rule_36__0 p) = p + rtkPosOf (Ctr__Rule_36__1 p _) = p +type Rule_37 = [Rule_38] +data Rule_38 = Ctr__Rule_38__0 RtkPos CompoundName + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_38 where + rtkPosOf (Ctr__Rule_38__0 p _) = p +data Rule_39 = Ctr__Rule_39__0 RtkPos | + Ctr__Rule_39__1 RtkPos ParameterList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_39 where + rtkPosOf (Ctr__Rule_39__0 p) = p + rtkPosOf (Ctr__Rule_39__1 p _) = p +data Rule_4 = Ctr__Rule_4__0 RtkPos | + Ctr__Rule_4__1 RtkPos Rule_5 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_4 where + rtkPosOf (Ctr__Rule_4__0 p) = p + rtkPosOf (Ctr__Rule_4__1 p _) = p +data Rule_40 = Ctr__Rule_40__0 RtkPos | + Ctr__Rule_40__1 RtkPos ThrowsClause + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_40 where + rtkPosOf (Ctr__Rule_40__0 p) = p + rtkPosOf (Ctr__Rule_40__1 p _) = p +data Rule_41 = Ctr__Rule_41__0 RtkPos StatementBlock | + Ctr__Rule_41__1 RtkPos Rule_42 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_41 where + rtkPosOf (Ctr__Rule_41__0 p _) = p + rtkPosOf (Ctr__Rule_41__1 p _) = p +data Rule_42 = Ctr__Rule_42__0 RtkPos | + Ctr__Rule_42__1 RtkPos Rule_43 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_42 where + rtkPosOf (Ctr__Rule_42__0 p) = p + rtkPosOf (Ctr__Rule_42__1 p _) = p +data Rule_43 = Ctr__Rule_43__0 RtkPos Expression + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_43 where + rtkPosOf (Ctr__Rule_43__0 p _) = p +data Rule_44 = Anti_Rule_44 String | + Ctr__Rule_44__1 RtkPos VariableDeclarator + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_44 where + rtkPosOf (Anti_Rule_44 _) = rtkNoPos + rtkPosOf (Ctr__Rule_44__1 p _) = p +type Rule_46 = [Rule_47] +data Rule_47 = Ctr__Rule_47__0 RtkPos VariableDeclarator + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_47 where + rtkPosOf (Ctr__Rule_47__0 p _) = p +data Rule_48 = Anti_Rule_48 String | + Ctr__Rule_48__1 RtkPos | + Ctr__Rule_48__2 RtkPos Annotation + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_48 where + rtkPosOf (Anti_Rule_48 _) = rtkNoPos + rtkPosOf (Ctr__Rule_48__1 p) = p + rtkPosOf (Ctr__Rule_48__2 p _) = p +data Rule_5 = Ctr__Rule_5__0 RtkPos Rule_6 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_5 where + rtkPosOf (Ctr__Rule_5__0 p _) = p +data Rule_50 = Ctr__Rule_50__0 RtkPos VariableInitializer + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_50 where + rtkPosOf (Ctr__Rule_50__0 p _) = p +data Rule_51 = Ctr__Rule_51__0 RtkPos VariableInitializer Rule_52 Rule_54 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_51 where + rtkPosOf (Ctr__Rule_51__0 p _ _ _) = p +type Rule_52 = [Rule_53] +data Rule_53 = Ctr__Rule_53__0 RtkPos VariableInitializer + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_53 where + rtkPosOf (Ctr__Rule_53__0 p _) = p +data Rule_54 = Ctr__Rule_54__0 RtkPos | + Ctr__Rule_54__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_54 where + rtkPosOf (Ctr__Rule_54__0 p) = p + rtkPosOf (Ctr__Rule_54__1 p) = p +type Rule_55 = [Rule_56] +data Rule_56 = Ctr__Rule_56__0 RtkPos Parameter + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_56 where + rtkPosOf (Ctr__Rule_56__0 p _) = p +data Rule_57 = Anti_Rule_57 String | + Ctr__Rule_57__1 RtkPos | + Ctr__Rule_57__2 RtkPos Annotation + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_57 where + rtkPosOf (Anti_Rule_57 _) = rtkNoPos + rtkPosOf (Ctr__Rule_57__1 p) = p + rtkPosOf (Ctr__Rule_57__2 p _) = p +data Rule_59 = Ctr__Rule_59__0 RtkPos | + Ctr__Rule_59__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_59 where + rtkPosOf (Ctr__Rule_59__0 p) = p + rtkPosOf (Ctr__Rule_59__1 p) = p +data Rule_6 = Ctr__Rule_6__0 RtkPos | + Ctr__Rule_6__1 RtkPos AnnotationArguments + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_6 where + rtkPosOf (Ctr__Rule_6__0 p) = p + rtkPosOf (Ctr__Rule_6__1 p _) = p +data Rule_61 = Ctr__Rule_61__0 RtkPos Statement + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_61 where + rtkPosOf (Ctr__Rule_61__0 p _) = p +data Rule_62 = Ctr__Rule_62__0 RtkPos VariableDeclaration | + Ctr__Rule_62__1 RtkPos Expression | + Ctr__Rule_62__2 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_62 where + rtkPosOf (Ctr__Rule_62__0 p _) = p + rtkPosOf (Ctr__Rule_62__1 p _) = p + rtkPosOf (Ctr__Rule_62__2 p) = p +data Rule_63 = Anti_Rule_63 String | + Ctr__Rule_63__1 RtkPos Parameter Statement + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_63 where + rtkPosOf (Anti_Rule_63 _) = rtkNoPos + rtkPosOf (Ctr__Rule_63__1 p _ _) = p +data Rule_65 = Ctr__Rule_65__0 RtkPos Statement + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_65 where + rtkPosOf (Ctr__Rule_65__0 p _) = p +data Rule_66 = Anti_Rule_66 String | + Ctr__Rule_66__1 RtkPos Expression | + Ctr__Rule_66__2 RtkPos | + Ctr__Rule_66__3 RtkPos Statement + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_66 where + rtkPosOf (Anti_Rule_66 _) = rtkNoPos + rtkPosOf (Ctr__Rule_66__1 p _) = p + rtkPosOf (Ctr__Rule_66__2 p) = p + rtkPosOf (Ctr__Rule_66__3 p _) = p +data Rule_68 = Ctr__Rule_68__0 RtkPos | + Ctr__Rule_68__1 RtkPos Rule_69 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_68 where + rtkPosOf (Ctr__Rule_68__0 p) = p + rtkPosOf (Ctr__Rule_68__1 p _) = p +data Rule_69 = Ctr__Rule_69__0 RtkPos AssignmentOp Expression + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_69 where + rtkPosOf (Ctr__Rule_69__0 p _ _) = p +type Rule_7 = [Rule_8] +data Rule_70 = Ctr__Rule_70__0 RtkPos | + Ctr__Rule_70__1 RtkPos Rule_71 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_70 where + rtkPosOf (Ctr__Rule_70__0 p) = p + rtkPosOf (Ctr__Rule_70__1 p _) = p +data Rule_71 = Ctr__Rule_71__0 RtkPos Arglist + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_71 where + rtkPosOf (Ctr__Rule_71__0 p _) = p +data Rule_72 = Ctr__Rule_72__0 RtkPos | + Ctr__Rule_72__1 RtkPos Rule_73 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_72 where + rtkPosOf (Ctr__Rule_72__0 p) = p + rtkPosOf (Ctr__Rule_72__1 p _) = p +data Rule_73 = Ctr__Rule_73__0 RtkPos Arglist + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_73 where + rtkPosOf (Ctr__Rule_73__0 p _) = p +data Rule_74 = Ctr__Rule_74__0 RtkPos Arglist | + Ctr__Rule_74__1 RtkPos DimExprs Rule_75 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_74 where + rtkPosOf (Ctr__Rule_74__0 p _) = p + rtkPosOf (Ctr__Rule_74__1 p _ _) = p +data Rule_75 = Ctr__Rule_75__0 RtkPos | + Ctr__Rule_75__1 RtkPos NonEmptyDims + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_75 where + rtkPosOf (Ctr__Rule_75__0 p) = p + rtkPosOf (Ctr__Rule_75__1 p _) = p +data Rule_76 = Anti_Rule_76 String | + Ctr__Rule_76__1 RtkPos Expression + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_76 where + rtkPosOf (Anti_Rule_76 _) = rtkNoPos + rtkPosOf (Ctr__Rule_76__1 p _) = p +data Rule_78 = Ctr__Rule_78__0 RtkPos Expression Rule_79 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_78 where + rtkPosOf (Ctr__Rule_78__0 p _ _) = p +type Rule_79 = [Rule_80] +data Rule_8 = Ctr__Rule_8__0 RtkPos AnnotationElement + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_8 where + rtkPosOf (Ctr__Rule_8__0 p _) = p +data Rule_80 = Ctr__Rule_80__0 RtkPos Expression + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_80 where + rtkPosOf (Ctr__Rule_80__0 p _) = p +type Rule_81 = [Rule_82] +data Rule_82 = Ctr__Rule_82__0 RtkPos TypeArgument + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_82 where + rtkPosOf (Ctr__Rule_82__0 p _) = p +data Rule_83 = Ctr__Rule_83__0 RtkPos TypeParameter Rule_84 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_83 where + rtkPosOf (Ctr__Rule_83__0 p _ _) = p +type Rule_84 = [Rule_85] +data Rule_85 = Ctr__Rule_85__0 RtkPos TypeParameter + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_85 where + rtkPosOf (Ctr__Rule_85__0 p _) = p +data Rule_86 = Ctr__Rule_86__0 RtkPos | + Ctr__Rule_86__1 RtkPos Rule_87 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_86 where + rtkPosOf (Ctr__Rule_86__0 p) = p + rtkPosOf (Ctr__Rule_86__1 p _) = p +data Rule_87 = Ctr__Rule_87__0 RtkPos Type Rule_88 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_87 where + rtkPosOf (Ctr__Rule_87__0 p _ _) = p +type Rule_88 = [Rule_89] +data Rule_89 = Ctr__Rule_89__0 RtkPos Type + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_89 where + rtkPosOf (Ctr__Rule_89__0 p _) = p +data Rule_90 = Anti_Rule_90 String | + Ctr__Rule_90__1 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_90 where + rtkPosOf (Anti_Rule_90 _) = rtkNoPos + rtkPosOf (Ctr__Rule_90__1 p _) = p +data ShiftOp = Anti_ShiftOp String | + Ctr__ShiftOp__0 RtkPos | + Ctr__ShiftOp__1 RtkPos | + Ctr__ShiftOp__2 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ShiftOp where + rtkPosOf (Anti_ShiftOp _) = rtkNoPos + rtkPosOf (Ctr__ShiftOp__0 p) = p + rtkPosOf (Ctr__ShiftOp__1 p) = p + rtkPosOf (Ctr__ShiftOp__2 p) = p +data Statement = Anti_Statement String | + Ctr__Statement__0 RtkPos VariableDeclaration | + Ctr__Statement__1 RtkPos OptExpression | + Ctr__Statement__2 RtkPos Expression | + Ctr__Statement__3 RtkPos StatementBlock | + Ctr__Statement__4 RtkPos IfStatement | + Ctr__Statement__5 RtkPos DoStatement | + Ctr__Statement__6 RtkPos WhileStatement | + Ctr__Statement__7 RtkPos ForStatement | + Ctr__Statement__8 RtkPos TryStatement | + Ctr__Statement__9 RtkPos SwitchStatement | + Ctr__Statement__10 RtkPos Expression Statement | + Ctr__Statement__11 RtkPos Expression | + Ctr__Statement__12 RtkPos String Statement | + Ctr__Statement__13 RtkPos OptId | + Ctr__Statement__14 RtkPos OptId | + Ctr__Statement__15 RtkPos Arglist | + Ctr__Statement__16 RtkPos Arglist | + Ctr__Statement__17 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Statement where + rtkPosOf (Anti_Statement _) = rtkNoPos + rtkPosOf (Ctr__Statement__0 p _) = p + rtkPosOf (Ctr__Statement__1 p _) = p + rtkPosOf (Ctr__Statement__2 p _) = p + rtkPosOf (Ctr__Statement__3 p _) = p + rtkPosOf (Ctr__Statement__4 p _) = p + rtkPosOf (Ctr__Statement__5 p _) = p + rtkPosOf (Ctr__Statement__6 p _) = p + rtkPosOf (Ctr__Statement__7 p _) = p + rtkPosOf (Ctr__Statement__8 p _) = p + rtkPosOf (Ctr__Statement__9 p _) = p + rtkPosOf (Ctr__Statement__10 p _ _) = p + rtkPosOf (Ctr__Statement__11 p _) = p + rtkPosOf (Ctr__Statement__12 p _ _) = p + rtkPosOf (Ctr__Statement__13 p _) = p + rtkPosOf (Ctr__Statement__14 p _) = p + rtkPosOf (Ctr__Statement__15 p _) = p + rtkPosOf (Ctr__Statement__16 p _) = p + rtkPosOf (Ctr__Statement__17 p) = p +data StatementBlock = Anti_StatementBlock String | + Ctr__StatementBlock__0 RtkPos StatementList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf StatementBlock where + rtkPosOf (Anti_StatementBlock _) = rtkNoPos + rtkPosOf (Ctr__StatementBlock__0 p _) = p +type StatementList = [Statement] +data StaticInitializer = Anti_StaticInitializer String | + Ctr__StaticInitializer__0 RtkPos StatementBlock + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf StaticInitializer where + rtkPosOf (Anti_StaticInitializer _) = rtkNoPos + rtkPosOf (Ctr__StaticInitializer__0 p _) = p +type SwitchCaseList = [Rule_66] +data SwitchStatement = Anti_SwitchStatement String | + Ctr__SwitchStatement__0 RtkPos Expression SwitchCaseList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf SwitchStatement where + rtkPosOf (Anti_SwitchStatement _) = rtkNoPos + rtkPosOf (Ctr__SwitchStatement__0 p _ _) = p +data ThrowsClause = Anti_ThrowsClause String | + Ctr__ThrowsClause__0 RtkPos CompoundName Rule_37 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf ThrowsClause where + rtkPosOf (Anti_ThrowsClause _) = rtkNoPos + rtkPosOf (Ctr__ThrowsClause__0 p _ _) = p +data TryStatement = Anti_TryStatement String | + Ctr__TryStatement__0 RtkPos Statement CatchList OptFinally + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf TryStatement where + rtkPosOf (Anti_TryStatement _) = rtkNoPos + rtkPosOf (Ctr__TryStatement__0 p _ _ _) = p +data Type = Anti_Type String | + Ctr__Type__0 RtkPos PrimitiveTypeKeyword Dims | + Ctr__Type__1 RtkPos CompoundName NonEmptyTypeArguments Dims | + Ctr__Type__2 RtkPos CompoundName NonEmptyDims | + Ctr__Type__3 RtkPos CompoundName + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Type where + rtkPosOf (Anti_Type _) = rtkNoPos + rtkPosOf (Ctr__Type__0 p _ _) = p + rtkPosOf (Ctr__Type__1 p _ _ _) = p + rtkPosOf (Ctr__Type__2 p _ _) = p + rtkPosOf (Ctr__Type__3 p _) = p +data TypeArgument = Anti_TypeArgument String | + Ctr__TypeArgument__0 RtkPos Type | + Ctr__TypeArgument__1 RtkPos WildcardType + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf TypeArgument where + rtkPosOf (Anti_TypeArgument _) = rtkNoPos + rtkPosOf (Ctr__TypeArgument__0 p _) = p + rtkPosOf (Ctr__TypeArgument__1 p _) = p +data TypeArguments = Anti_TypeArguments String | + Ctr__TypeArguments__0 RtkPos | + Ctr__TypeArguments__1 RtkPos NonEmptyTypeArguments + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf TypeArguments where + rtkPosOf (Anti_TypeArguments _) = rtkNoPos + rtkPosOf (Ctr__TypeArguments__0 p) = p + rtkPosOf (Ctr__TypeArguments__1 p _) = p +data TypeDeclRest = Anti_TypeDeclRest String | + Ctr__TypeDeclRest__0 RtkPos ClassDeclaration | + Ctr__TypeDeclRest__1 RtkPos InterfaceDeclaration | + Ctr__TypeDeclRest__2 RtkPos EnumDeclaration | + Ctr__TypeDeclRest__3 RtkPos AnnotationDeclaration + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf TypeDeclRest where + rtkPosOf (Anti_TypeDeclRest _) = rtkNoPos + rtkPosOf (Ctr__TypeDeclRest__0 p _) = p + rtkPosOf (Ctr__TypeDeclRest__1 p _) = p + rtkPosOf (Ctr__TypeDeclRest__2 p _) = p + rtkPosOf (Ctr__TypeDeclRest__3 p _) = p +data TypeDeclaration = Anti_TypeDeclaration String | + Ctr__TypeDeclaration__0 RtkPos OptDocComment ModifierList TypeDeclRest + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf TypeDeclaration where + rtkPosOf (Anti_TypeDeclaration _) = rtkNoPos + rtkPosOf (Ctr__TypeDeclaration__0 p _ _ _) = p +data TypeParameter = Anti_TypeParameter String | + Ctr__TypeParameter__0 RtkPos String Rule_86 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf TypeParameter where + rtkPosOf (Anti_TypeParameter _) = rtkNoPos + rtkPosOf (Ctr__TypeParameter__0 p _ _) = p +data TypeParameters = Anti_TypeParameters String | + Ctr__TypeParameters__0 RtkPos | + Ctr__TypeParameters__1 RtkPos Rule_83 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf TypeParameters where + rtkPosOf (Anti_TypeParameters _) = rtkNoPos + rtkPosOf (Ctr__TypeParameters__0 p) = p + rtkPosOf (Ctr__TypeParameters__1 p _) = p +data TypeSpecifier = Anti_TypeSpecifier String | + Ctr__TypeSpecifier__0 RtkPos | + Ctr__TypeSpecifier__1 RtkPos | + Ctr__TypeSpecifier__2 RtkPos | + Ctr__TypeSpecifier__3 RtkPos | + Ctr__TypeSpecifier__4 RtkPos | + Ctr__TypeSpecifier__5 RtkPos | + Ctr__TypeSpecifier__6 RtkPos | + Ctr__TypeSpecifier__7 RtkPos | + Ctr__TypeSpecifier__8 RtkPos | + Ctr__TypeSpecifier__9 RtkPos CompoundName TypeArguments + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf TypeSpecifier where + rtkPosOf (Anti_TypeSpecifier _) = rtkNoPos + rtkPosOf (Ctr__TypeSpecifier__0 p) = p + rtkPosOf (Ctr__TypeSpecifier__1 p) = p + rtkPosOf (Ctr__TypeSpecifier__2 p) = p + rtkPosOf (Ctr__TypeSpecifier__3 p) = p + rtkPosOf (Ctr__TypeSpecifier__4 p) = p + rtkPosOf (Ctr__TypeSpecifier__5 p) = p + rtkPosOf (Ctr__TypeSpecifier__6 p) = p + rtkPosOf (Ctr__TypeSpecifier__7 p) = p + rtkPosOf (Ctr__TypeSpecifier__8 p) = p + rtkPosOf (Ctr__TypeSpecifier__9 p _ _) = p +data VariableDeclaration = Anti_VariableDeclaration String | + Ctr__VariableDeclaration__0 RtkPos Type VariableDeclaratorList | + Ctr__VariableDeclaration__1 RtkPos LocalModifierList1 Type VariableDeclaratorList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf VariableDeclaration where + rtkPosOf (Anti_VariableDeclaration _) = rtkNoPos + rtkPosOf (Ctr__VariableDeclaration__0 p _ _) = p + rtkPosOf (Ctr__VariableDeclaration__1 p _ _ _) = p +data VariableDeclarator = Anti_VariableDeclarator String | + Ctr__VariableDeclarator__0 RtkPos String Dims OptVariableInitializer + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf VariableDeclarator where + rtkPosOf (Anti_VariableDeclarator _) = rtkNoPos + rtkPosOf (Ctr__VariableDeclarator__0 p _ _ _) = p +data VariableDeclaratorList = Anti_VariableDeclaratorList String | + Ctr__VariableDeclaratorList__0 RtkPos VariableDeclarator Rule_46 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf VariableDeclaratorList where + rtkPosOf (Anti_VariableDeclaratorList _) = rtkNoPos + rtkPosOf (Ctr__VariableDeclaratorList__0 p _ _) = p +data VariableInitializer = Anti_VariableInitializer String | + Ctr__VariableInitializer__0 RtkPos Expression | + Ctr__VariableInitializer__1 RtkPos VariableInitializerList + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf VariableInitializer where + rtkPosOf (Anti_VariableInitializer _) = rtkNoPos + rtkPosOf (Ctr__VariableInitializer__0 p _) = p + rtkPosOf (Ctr__VariableInitializer__1 p _) = p +data VariableInitializerList = Anti_VariableInitializerList String | + Ctr__VariableInitializerList__0 RtkPos | + Ctr__VariableInitializerList__1 RtkPos Rule_51 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf VariableInitializerList where + rtkPosOf (Anti_VariableInitializerList _) = rtkNoPos + rtkPosOf (Ctr__VariableInitializerList__0 p) = p + rtkPosOf (Ctr__VariableInitializerList__1 p _) = p +data WhileStatement = Anti_WhileStatement String | + Ctr__WhileStatement__0 RtkPos Expression Statement + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf WhileStatement where + rtkPosOf (Anti_WhileStatement _) = rtkNoPos + rtkPosOf (Ctr__WhileStatement__0 p _ _) = p +data WildcardType = Anti_WildcardType String | + Ctr__WildcardType__0 RtkPos | + Ctr__WildcardType__1 RtkPos Type | + Ctr__WildcardType__2 RtkPos Type + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf WildcardType where + rtkPosOf (Anti_WildcardType _) = rtkNoPos + rtkPosOf (Ctr__WildcardType__0 p) = p + rtkPosOf (Ctr__WildcardType__1 p _) = p + rtkPosOf (Ctr__WildcardType__2 p _) = p +} diff --git a/test/golden/java/JavaQQ.hs b/test/golden/java/JavaQQ.hs new file mode 100644 --- /dev/null +++ b/test/golden/java/JavaQQ.hs @@ -0,0 +1,1411 @@ +-- Generated by RTK from grammar 'Java'. Do not edit by hand. +{-# LANGUAGE TemplateHaskell #-} +module JavaQQ +where + +import qualified Data.Char as C +import qualified Data.Map as M +import Data.List +import Data.Maybe +import qualified Data.Generics as Generics +import qualified Data.Data as Data +import qualified Language.Haskell.TH as TH +import Language.Haskell.TH.Quote +import JavaLexer +import JavaParser + +qqShortcuts :: M.Map String String + +-- A $name metavariable is rewritten to $Type:name using the qqShortcuts +-- table below. The rewrite is purely textual, so it would also fire inside +-- the quoted language's own string literals: write $$name there to escape +-- it and get the literal text $name. Each '$$' pair directly before a +-- metavariable stands for one literal '$' (so $$$x is a literal '$' +-- followed by the metavariable $x). A '$' not followed by an identifier is +-- never rewritten and needs no escape, and an explicit $Type:name antiquote +-- (the character after the name is ':') passes through untouched. +-- A plain character scan rather than a regex: metavariables are recognized +-- regardless of what follows the name - including a newline or the end of +-- the quote, which the previous regex's terminator class missed. +replaceAllPatterns :: String -> Either String String +replaceAllPatterns [] = Right [] +replaceAllPatterns s@('$' : _) = + let (dollars, rest) = span (== '$') s + in case rest of + (c1 : _) | C.isAlpha c1 || c1 == '_' -> + let (varName, post) = span (\ ch -> C.isAlphaNum ch || ch == '_') rest + escCount = length dollars - 1 + keptPre = replicate (div escCount 2) '$' + in case post of + (':' : _) -> ((dollars ++ varName) ++) <$> replaceAllPatterns post + _ | odd escCount -> ((keptPre ++ '$' : varName) ++) <$> replaceAllPatterns post + _ -> case catMaybes $ map (\ prefix -> M.lookup prefix qqShortcuts) $ reverse $ inits varName of + [] -> Left $ unlines + [ "Unknown metavariable $" ++ varName ++ " in quasi-quote:" + , "no prefix of '" ++ varName ++ "' is a known shortcut. Known shortcuts:" + , " " ++ intercalate ", " (M.keys qqShortcuts) + , "To include the literal text $" ++ varName ++ " in the quoted code" + , "(e.g. inside a string literal), escape it as $$" ++ varName ++ "." ] + (rule : _) -> ((keptPre ++ '$' : rule ++ ":" ++ varName) ++) <$> replaceAllPatterns post + _ -> (dollars ++) <$> replaceAllPatterns rest +replaceAllPatterns (c : rest) = (c :) <$> replaceAllPatterns rest + +-- The generated lexer and parser encode error positions as "LINE:COL:message" +-- so structured-diagnostic callers can split them; render them back +-- human-readably for quasi-quote compile errors. Positions refer to the quote +-- body (padded with a start token in front). +rtkRenderError :: String -> String +rtkRenderError err = + case span (/= ':') err of + (l, ':' : rest1) | [(line, "")] <- (reads l :: [(Int, String)]) -> + case span (/= ':') rest1 of + (c, ':' : msg) | [(col, "")] <- (reads c :: [(Int, String)]) -> + "line " ++ show line ++ ", column " ++ show col ++ ": " ++ msg + _ -> err + _ -> err + +qqShortcuts = M.fromList [ ("java","Java"),("additiveOp","AdditiveOp"),("annotation","Annotation"),("annotationArguments","AnnotationArguments"),("annotationDeclaration","AnnotationDeclaration"),("annotationElement","AnnotationElement"),("annotationList","AnnotationList"),("annotationTypeElement","AnnotationTypeElement"),("annotationTypeElementList","AnnotationTypeElementList"),("arglist","Arglist"),("assignmentOp","AssignmentOp"),("catchList","CatchList"),("classDeclaration","ClassDeclaration"),("classOrInterfaceType","ClassOrInterfaceType"),("compilationUnit","CompilationUnit"),("compoundName","CompoundName"),("compoundNameTail","CompoundNameTail"),("creationExpression","CreationExpression"),("dimExprs","DimExprs"),("dims","Dims"),("doStatement","DoStatement"),("docComment","DocComment"),("enumConstant","EnumConstant"),("enumConstantList","EnumConstantList"),("enumDeclaration","EnumDeclaration"),("equalityOp","EqualityOp"),("expression","Expression"),("extendsList","ExtendsList"),("fieldDeclaration","FieldDeclaration"),("fieldDeclarationList","FieldDeclarationList"),("forStatement","ForStatement"),("ifStatement","IfStatement"),("implementsList","ImplementsList"),("importHead","ImportHead"),("importList","ImportList"),("importName","ImportName"),("importStatement","ImportStatement"),("interfaceDeclaration","InterfaceDeclaration"),("literal","Literal"),("localModifierList1","LocalModifierList1"),("memberAfterFirstId","MemberAfterFirstId"),("memberDeclaration","MemberDeclaration"),("memberRest","MemberRest"),("modifier","Modifier"),("modifierList","ModifierList"),("moreTypeSpecifier","MoreTypeSpecifier"),("moreVariableDeclarators","MoreVariableDeclarators"),("multiplicativeOp","MultiplicativeOp"),("nonEmptyDims","NonEmptyDims"),("nonEmptyTypeArguments","NonEmptyTypeArguments"),("optDocComment","OptDocComment"),("optElsePart","OptElsePart"),("optExpression","OptExpression"),("optFinally","OptFinally"),("optId","OptId"),("optVariableInitializer","OptVariableInitializer"),("package","Package"),("paramModifierList","ParamModifierList"),("parameter","Parameter"),("parameterList","ParameterList"),("postfixOp","PostfixOp"),("prefixOp","PrefixOp"),("primitiveTypeKeyword","PrimitiveTypeKeyword"),("relationalOp","RelationalOp"),("shiftOp","ShiftOp"),("statement","Statement"),("statementBlock","StatementBlock"),("statementList","StatementList"),("staticInitializer","StaticInitializer"),("switchCaseList","SwitchCaseList"),("switchStatement","SwitchStatement"),("throwsClause","ThrowsClause"),("tryStatement","TryStatement"),("type","Type"),("typeArgument","TypeArgument"),("typeArguments","TypeArguments"),("typeDeclRest","TypeDeclRest"),("typeDeclaration","TypeDeclaration"),("typeParameter","TypeParameter"),("typeParameters","TypeParameters"),("typeSpecifier","TypeSpecifier"),("variableDeclaration","VariableDeclaration"),("variableDeclarator","VariableDeclarator"),("variableDeclaratorList","VariableDeclaratorList"),("variableInitializer","VariableInitializer"),("variableInitializerList","VariableInitializerList"),("whileStatement","WhileStatement"),("wildcardType","WildcardType")] + +-- A quasi-quote pattern must match an AST parsed from anywhere in a source +-- file, while the pattern itself was parsed from the quote body - so every +-- RtkPos position field becomes a wildcard in generated patterns. +-- (Expressions need no special case: the compile-time position they embed +-- is equality-transparent.) +rtkPosWildPat :: RtkPos -> Maybe (TH.Q TH.Pat) +rtkPosWildPat _ = Just TH.wildP + +quoteJavaExp :: Data.Data a => String -> (Java -> a) -> String -> TH.ExpQ +quoteJavaExp dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseJava of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) expr +quoteJavaPat :: Data.Data a => String -> (Java -> a) -> String -> TH.PatQ +quoteJavaPat dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseJava of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToPatQ (const Nothing `Generics.extQ` rtkPosWildPat `Generics.extQ` antiJavaPat `Generics.extQ` antiOptDocCommentPat `Generics.extQ` antiTypeDeclarationPat `Generics.extQ` antiImportStatementPat `Generics.extQ` antiCompilationUnitPat `Generics.extQ` antiPackagePat `Generics.extQ` antiImportNamePat `Generics.extQ` antiImportHeadPat `Generics.extQ` antiDocCommentPat `Generics.extQ` antiAnnotationPat `Generics.extQ` antiAnnotationArgumentsPat `Generics.extQ` antiAnnotationElementPat `Generics.extQ` antiRule_10Pat `Generics.extQ` antiClassOrInterfaceTypePat `Generics.extQ` antiExtendsListPat `Generics.extQ` antiImplementsListPat `Generics.extQ` antiFieldDeclarationPat `Generics.extQ` antiClassDeclarationPat `Generics.extQ` antiInterfaceDeclarationPat `Generics.extQ` antiAnnotationDeclarationPat `Generics.extQ` antiAnnotationTypeElementPat `Generics.extQ` antiEnumConstantPat `Generics.extQ` antiEnumConstantListPat `Generics.extQ` antiEnumDeclarationPat `Generics.extQ` antiTypeDeclRestPat `Generics.extQ` antiRule_31Pat `Generics.extQ` antiRule_33Pat `Generics.extQ` antiMemberDeclarationPat `Generics.extQ` antiPrimitiveTypeKeywordPat `Generics.extQ` antiMemberAfterFirstIdPat `Generics.extQ` antiMoreTypeSpecifierPat `Generics.extQ` antiThrowsClausePat `Generics.extQ` antiMemberRestPat `Generics.extQ` antiRule_44Pat `Generics.extQ` antiStatementBlockPat `Generics.extQ` antiVariableDeclaratorListPat `Generics.extQ` antiVariableDeclarationPat `Generics.extQ` antiRule_48Pat `Generics.extQ` antiOptVariableInitializerPat `Generics.extQ` antiVariableDeclaratorPat `Generics.extQ` antiVariableInitializerListPat `Generics.extQ` antiVariableInitializerPat `Generics.extQ` antiStaticInitializerPat `Generics.extQ` antiParameterListPat `Generics.extQ` antiRule_57Pat `Generics.extQ` antiParameterPat `Generics.extQ` antiStatementPat `Generics.extQ` antiOptExpressionPat `Generics.extQ` antiOptIdPat `Generics.extQ` antiOptElsePartPat `Generics.extQ` antiIfStatementPat `Generics.extQ` antiDoStatementPat `Generics.extQ` antiWhileStatementPat `Generics.extQ` antiForStatementPat `Generics.extQ` antiRule_63Pat `Generics.extQ` antiOptFinallyPat `Generics.extQ` antiTryStatementPat `Generics.extQ` antiRule_66Pat `Generics.extQ` antiSwitchStatementPat `Generics.extQ` antiExpressionPat `Generics.extQ` antiAssignmentOpPat `Generics.extQ` antiEqualityOpPat `Generics.extQ` antiRelationalOpPat `Generics.extQ` antiShiftOpPat `Generics.extQ` antiAdditiveOpPat `Generics.extQ` antiMultiplicativeOpPat `Generics.extQ` antiPrefixOpPat `Generics.extQ` antiPostfixOpPat `Generics.extQ` antiCreationExpressionPat `Generics.extQ` antiRule_76Pat `Generics.extQ` antiLiteralPat `Generics.extQ` antiArglistPat `Generics.extQ` antiTypeArgumentsPat `Generics.extQ` antiNonEmptyTypeArgumentsPat `Generics.extQ` antiTypeArgumentPat `Generics.extQ` antiWildcardTypePat `Generics.extQ` antiTypeParametersPat `Generics.extQ` antiTypeParameterPat `Generics.extQ` antiTypePat `Generics.extQ` antiTypeSpecifierPat `Generics.extQ` antiModifierPat `Generics.extQ` antiRule_90Pat `Generics.extQ` antiCompoundNamePat) expr + +antiCompoundNameExp :: CompoundName -> Maybe (TH.Q TH.Exp ) +antiCompoundNameExp ( Anti_CompoundName v) = Just $ TH.varE (TH.mkName v) +antiCompoundNameExp _ = Nothing + + +antiRule_90Exp :: [ Rule_90 ] -> Maybe (TH.Q TH.Exp) +antiRule_90Exp ((Anti_Rule_90 v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiRule_90Exp _ = Nothing + + +antiModifierExp :: Modifier -> Maybe (TH.Q TH.Exp ) +antiModifierExp ( Anti_Modifier v) = Just $ TH.varE (TH.mkName v) +antiModifierExp _ = Nothing + + +antiTypeSpecifierExp :: TypeSpecifier -> Maybe (TH.Q TH.Exp ) +antiTypeSpecifierExp ( Anti_TypeSpecifier v) = Just $ TH.varE (TH.mkName v) +antiTypeSpecifierExp _ = Nothing + + +antiTypeExp :: Type -> Maybe (TH.Q TH.Exp ) +antiTypeExp ( Anti_Type v) = Just $ TH.varE (TH.mkName v) +antiTypeExp _ = Nothing + + +antiTypeParameterExp :: TypeParameter -> Maybe (TH.Q TH.Exp ) +antiTypeParameterExp ( Anti_TypeParameter v) = Just $ TH.varE (TH.mkName v) +antiTypeParameterExp _ = Nothing + + +antiTypeParametersExp :: TypeParameters -> Maybe (TH.Q TH.Exp ) +antiTypeParametersExp ( Anti_TypeParameters v) = Just $ TH.varE (TH.mkName v) +antiTypeParametersExp _ = Nothing + + +antiWildcardTypeExp :: WildcardType -> Maybe (TH.Q TH.Exp ) +antiWildcardTypeExp ( Anti_WildcardType v) = Just $ TH.varE (TH.mkName v) +antiWildcardTypeExp _ = Nothing + + +antiTypeArgumentExp :: TypeArgument -> Maybe (TH.Q TH.Exp ) +antiTypeArgumentExp ( Anti_TypeArgument v) = Just $ TH.varE (TH.mkName v) +antiTypeArgumentExp _ = Nothing + + +antiNonEmptyTypeArgumentsExp :: NonEmptyTypeArguments -> Maybe (TH.Q TH.Exp ) +antiNonEmptyTypeArgumentsExp ( Anti_NonEmptyTypeArguments v) = Just $ TH.varE (TH.mkName v) +antiNonEmptyTypeArgumentsExp _ = Nothing + + +antiTypeArgumentsExp :: TypeArguments -> Maybe (TH.Q TH.Exp ) +antiTypeArgumentsExp ( Anti_TypeArguments v) = Just $ TH.varE (TH.mkName v) +antiTypeArgumentsExp _ = Nothing + + +antiArglistExp :: Arglist -> Maybe (TH.Q TH.Exp ) +antiArglistExp ( Anti_Arglist v) = Just $ TH.varE (TH.mkName v) +antiArglistExp _ = Nothing + + +antiLiteralExp :: Literal -> Maybe (TH.Q TH.Exp ) +antiLiteralExp ( Anti_Literal v) = Just $ TH.varE (TH.mkName v) +antiLiteralExp _ = Nothing + + +antiRule_76Exp :: [ Rule_76 ] -> Maybe (TH.Q TH.Exp) +antiRule_76Exp ((Anti_Rule_76 v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiRule_76Exp _ = Nothing + + +antiCreationExpressionExp :: CreationExpression -> Maybe (TH.Q TH.Exp ) +antiCreationExpressionExp ( Anti_CreationExpression v) = Just $ TH.varE (TH.mkName v) +antiCreationExpressionExp _ = Nothing + + +antiPostfixOpExp :: PostfixOp -> Maybe (TH.Q TH.Exp ) +antiPostfixOpExp ( Anti_PostfixOp v) = Just $ TH.varE (TH.mkName v) +antiPostfixOpExp _ = Nothing + + +antiPrefixOpExp :: PrefixOp -> Maybe (TH.Q TH.Exp ) +antiPrefixOpExp ( Anti_PrefixOp v) = Just $ TH.varE (TH.mkName v) +antiPrefixOpExp _ = Nothing + + +antiMultiplicativeOpExp :: MultiplicativeOp -> Maybe (TH.Q TH.Exp ) +antiMultiplicativeOpExp ( Anti_MultiplicativeOp v) = Just $ TH.varE (TH.mkName v) +antiMultiplicativeOpExp _ = Nothing + + +antiAdditiveOpExp :: AdditiveOp -> Maybe (TH.Q TH.Exp ) +antiAdditiveOpExp ( Anti_AdditiveOp v) = Just $ TH.varE (TH.mkName v) +antiAdditiveOpExp _ = Nothing + + +antiShiftOpExp :: ShiftOp -> Maybe (TH.Q TH.Exp ) +antiShiftOpExp ( Anti_ShiftOp v) = Just $ TH.varE (TH.mkName v) +antiShiftOpExp _ = Nothing + + +antiRelationalOpExp :: RelationalOp -> Maybe (TH.Q TH.Exp ) +antiRelationalOpExp ( Anti_RelationalOp v) = Just $ TH.varE (TH.mkName v) +antiRelationalOpExp _ = Nothing + + +antiEqualityOpExp :: EqualityOp -> Maybe (TH.Q TH.Exp ) +antiEqualityOpExp ( Anti_EqualityOp v) = Just $ TH.varE (TH.mkName v) +antiEqualityOpExp _ = Nothing + + +antiAssignmentOpExp :: AssignmentOp -> Maybe (TH.Q TH.Exp ) +antiAssignmentOpExp ( Anti_AssignmentOp v) = Just $ TH.varE (TH.mkName v) +antiAssignmentOpExp _ = Nothing + + +antiExpressionExp :: Expression -> Maybe (TH.Q TH.Exp ) +antiExpressionExp ( Anti_Expression v) = Just $ TH.varE (TH.mkName v) +antiExpressionExp _ = Nothing + + +antiSwitchStatementExp :: SwitchStatement -> Maybe (TH.Q TH.Exp ) +antiSwitchStatementExp ( Anti_SwitchStatement v) = Just $ TH.varE (TH.mkName v) +antiSwitchStatementExp _ = Nothing + + +antiRule_66Exp :: [ Rule_66 ] -> Maybe (TH.Q TH.Exp) +antiRule_66Exp ((Anti_Rule_66 v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiRule_66Exp _ = Nothing + + +antiTryStatementExp :: TryStatement -> Maybe (TH.Q TH.Exp ) +antiTryStatementExp ( Anti_TryStatement v) = Just $ TH.varE (TH.mkName v) +antiTryStatementExp _ = Nothing + + +antiOptFinallyExp :: OptFinally -> Maybe (TH.Q TH.Exp ) +antiOptFinallyExp ( Anti_OptFinally v) = Just $ TH.varE (TH.mkName v) +antiOptFinallyExp _ = Nothing + + +antiRule_63Exp :: [ Rule_63 ] -> Maybe (TH.Q TH.Exp) +antiRule_63Exp ((Anti_Rule_63 v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiRule_63Exp _ = Nothing + + +antiForStatementExp :: ForStatement -> Maybe (TH.Q TH.Exp ) +antiForStatementExp ( Anti_ForStatement v) = Just $ TH.varE (TH.mkName v) +antiForStatementExp _ = Nothing + + +antiWhileStatementExp :: WhileStatement -> Maybe (TH.Q TH.Exp ) +antiWhileStatementExp ( Anti_WhileStatement v) = Just $ TH.varE (TH.mkName v) +antiWhileStatementExp _ = Nothing + + +antiDoStatementExp :: DoStatement -> Maybe (TH.Q TH.Exp ) +antiDoStatementExp ( Anti_DoStatement v) = Just $ TH.varE (TH.mkName v) +antiDoStatementExp _ = Nothing + + +antiIfStatementExp :: IfStatement -> Maybe (TH.Q TH.Exp ) +antiIfStatementExp ( Anti_IfStatement v) = Just $ TH.varE (TH.mkName v) +antiIfStatementExp _ = Nothing + + +antiOptElsePartExp :: OptElsePart -> Maybe (TH.Q TH.Exp ) +antiOptElsePartExp ( Anti_OptElsePart v) = Just $ TH.varE (TH.mkName v) +antiOptElsePartExp _ = Nothing + + +antiOptIdExp :: OptId -> Maybe (TH.Q TH.Exp ) +antiOptIdExp ( Anti_OptId v) = Just $ TH.varE (TH.mkName v) +antiOptIdExp _ = Nothing + + +antiOptExpressionExp :: OptExpression -> Maybe (TH.Q TH.Exp ) +antiOptExpressionExp ( Anti_OptExpression v) = Just $ TH.varE (TH.mkName v) +antiOptExpressionExp _ = Nothing + + +antiStatementExp :: [ Statement ] -> Maybe (TH.Q TH.Exp) +antiStatementExp ((Anti_Statement v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiStatementExp _ = Nothing + + +antiParameterExp :: Parameter -> Maybe (TH.Q TH.Exp ) +antiParameterExp ( Anti_Parameter v) = Just $ TH.varE (TH.mkName v) +antiParameterExp _ = Nothing + + +antiRule_57Exp :: [ Rule_57 ] -> Maybe (TH.Q TH.Exp) +antiRule_57Exp ((Anti_Rule_57 v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiRule_57Exp _ = Nothing + + +antiParameterListExp :: ParameterList -> Maybe (TH.Q TH.Exp ) +antiParameterListExp ( Anti_ParameterList v) = Just $ TH.varE (TH.mkName v) +antiParameterListExp _ = Nothing + + +antiStaticInitializerExp :: StaticInitializer -> Maybe (TH.Q TH.Exp ) +antiStaticInitializerExp ( Anti_StaticInitializer v) = Just $ TH.varE (TH.mkName v) +antiStaticInitializerExp _ = Nothing + + +antiVariableInitializerExp :: VariableInitializer -> Maybe (TH.Q TH.Exp ) +antiVariableInitializerExp ( Anti_VariableInitializer v) = Just $ TH.varE (TH.mkName v) +antiVariableInitializerExp _ = Nothing + + +antiVariableInitializerListExp :: VariableInitializerList -> Maybe (TH.Q TH.Exp ) +antiVariableInitializerListExp ( Anti_VariableInitializerList v) = Just $ TH.varE (TH.mkName v) +antiVariableInitializerListExp _ = Nothing + + +antiVariableDeclaratorExp :: VariableDeclarator -> Maybe (TH.Q TH.Exp ) +antiVariableDeclaratorExp ( Anti_VariableDeclarator v) = Just $ TH.varE (TH.mkName v) +antiVariableDeclaratorExp _ = Nothing + + +antiOptVariableInitializerExp :: OptVariableInitializer -> Maybe (TH.Q TH.Exp ) +antiOptVariableInitializerExp ( Anti_OptVariableInitializer v) = Just $ TH.varE (TH.mkName v) +antiOptVariableInitializerExp _ = Nothing + + +antiRule_48Exp :: [ Rule_48 ] -> Maybe (TH.Q TH.Exp) +antiRule_48Exp ((Anti_Rule_48 v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiRule_48Exp _ = Nothing + + +antiVariableDeclarationExp :: VariableDeclaration -> Maybe (TH.Q TH.Exp ) +antiVariableDeclarationExp ( Anti_VariableDeclaration v) = Just $ TH.varE (TH.mkName v) +antiVariableDeclarationExp _ = Nothing + + +antiVariableDeclaratorListExp :: VariableDeclaratorList -> Maybe (TH.Q TH.Exp ) +antiVariableDeclaratorListExp ( Anti_VariableDeclaratorList v) = Just $ TH.varE (TH.mkName v) +antiVariableDeclaratorListExp _ = Nothing + + +antiStatementBlockExp :: StatementBlock -> Maybe (TH.Q TH.Exp ) +antiStatementBlockExp ( Anti_StatementBlock v) = Just $ TH.varE (TH.mkName v) +antiStatementBlockExp _ = Nothing + + +antiRule_44Exp :: [ Rule_44 ] -> Maybe (TH.Q TH.Exp) +antiRule_44Exp ((Anti_Rule_44 v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiRule_44Exp _ = Nothing + + +antiMemberRestExp :: MemberRest -> Maybe (TH.Q TH.Exp ) +antiMemberRestExp ( Anti_MemberRest v) = Just $ TH.varE (TH.mkName v) +antiMemberRestExp _ = Nothing + + +antiThrowsClauseExp :: ThrowsClause -> Maybe (TH.Q TH.Exp ) +antiThrowsClauseExp ( Anti_ThrowsClause v) = Just $ TH.varE (TH.mkName v) +antiThrowsClauseExp _ = Nothing + + +antiMoreTypeSpecifierExp :: MoreTypeSpecifier -> Maybe (TH.Q TH.Exp ) +antiMoreTypeSpecifierExp ( Anti_MoreTypeSpecifier v) = Just $ TH.varE (TH.mkName v) +antiMoreTypeSpecifierExp _ = Nothing + + +antiMemberAfterFirstIdExp :: MemberAfterFirstId -> Maybe (TH.Q TH.Exp ) +antiMemberAfterFirstIdExp ( Anti_MemberAfterFirstId v) = Just $ TH.varE (TH.mkName v) +antiMemberAfterFirstIdExp _ = Nothing + + +antiPrimitiveTypeKeywordExp :: PrimitiveTypeKeyword -> Maybe (TH.Q TH.Exp ) +antiPrimitiveTypeKeywordExp ( Anti_PrimitiveTypeKeyword v) = Just $ TH.varE (TH.mkName v) +antiPrimitiveTypeKeywordExp _ = Nothing + + +antiMemberDeclarationExp :: MemberDeclaration -> Maybe (TH.Q TH.Exp ) +antiMemberDeclarationExp ( Anti_MemberDeclaration v) = Just $ TH.varE (TH.mkName v) +antiMemberDeclarationExp _ = Nothing + + +antiRule_33Exp :: [ Rule_33 ] -> Maybe (TH.Q TH.Exp) +antiRule_33Exp ((Anti_Rule_33 v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiRule_33Exp _ = Nothing + + +antiRule_31Exp :: [ Rule_31 ] -> Maybe (TH.Q TH.Exp) +antiRule_31Exp ((Anti_Rule_31 v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiRule_31Exp _ = Nothing + + +antiTypeDeclRestExp :: TypeDeclRest -> Maybe (TH.Q TH.Exp ) +antiTypeDeclRestExp ( Anti_TypeDeclRest v) = Just $ TH.varE (TH.mkName v) +antiTypeDeclRestExp _ = Nothing + + +antiEnumDeclarationExp :: EnumDeclaration -> Maybe (TH.Q TH.Exp ) +antiEnumDeclarationExp ( Anti_EnumDeclaration v) = Just $ TH.varE (TH.mkName v) +antiEnumDeclarationExp _ = Nothing + + +antiEnumConstantListExp :: EnumConstantList -> Maybe (TH.Q TH.Exp ) +antiEnumConstantListExp ( Anti_EnumConstantList v) = Just $ TH.varE (TH.mkName v) +antiEnumConstantListExp _ = Nothing + + +antiEnumConstantExp :: EnumConstant -> Maybe (TH.Q TH.Exp ) +antiEnumConstantExp ( Anti_EnumConstant v) = Just $ TH.varE (TH.mkName v) +antiEnumConstantExp _ = Nothing + + +antiAnnotationTypeElementExp :: [ AnnotationTypeElement ] -> Maybe (TH.Q TH.Exp) +antiAnnotationTypeElementExp ((Anti_AnnotationTypeElement v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiAnnotationTypeElementExp _ = Nothing + + +antiAnnotationDeclarationExp :: AnnotationDeclaration -> Maybe (TH.Q TH.Exp ) +antiAnnotationDeclarationExp ( Anti_AnnotationDeclaration v) = Just $ TH.varE (TH.mkName v) +antiAnnotationDeclarationExp _ = Nothing + + +antiInterfaceDeclarationExp :: InterfaceDeclaration -> Maybe (TH.Q TH.Exp ) +antiInterfaceDeclarationExp ( Anti_InterfaceDeclaration v) = Just $ TH.varE (TH.mkName v) +antiInterfaceDeclarationExp _ = Nothing + + +antiClassDeclarationExp :: ClassDeclaration -> Maybe (TH.Q TH.Exp ) +antiClassDeclarationExp ( Anti_ClassDeclaration v) = Just $ TH.varE (TH.mkName v) +antiClassDeclarationExp _ = Nothing + + +antiFieldDeclarationExp :: [ FieldDeclaration ] -> Maybe (TH.Q TH.Exp) +antiFieldDeclarationExp ((Anti_FieldDeclaration v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiFieldDeclarationExp _ = Nothing + + +antiImplementsListExp :: ImplementsList -> Maybe (TH.Q TH.Exp ) +antiImplementsListExp ( Anti_ImplementsList v) = Just $ TH.varE (TH.mkName v) +antiImplementsListExp _ = Nothing + + +antiExtendsListExp :: ExtendsList -> Maybe (TH.Q TH.Exp ) +antiExtendsListExp ( Anti_ExtendsList v) = Just $ TH.varE (TH.mkName v) +antiExtendsListExp _ = Nothing + + +antiClassOrInterfaceTypeExp :: ClassOrInterfaceType -> Maybe (TH.Q TH.Exp ) +antiClassOrInterfaceTypeExp ( Anti_ClassOrInterfaceType v) = Just $ TH.varE (TH.mkName v) +antiClassOrInterfaceTypeExp _ = Nothing + + +antiRule_10Exp :: [ Rule_10 ] -> Maybe (TH.Q TH.Exp) +antiRule_10Exp ((Anti_Rule_10 v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiRule_10Exp _ = Nothing + + +antiAnnotationElementExp :: AnnotationElement -> Maybe (TH.Q TH.Exp ) +antiAnnotationElementExp ( Anti_AnnotationElement v) = Just $ TH.varE (TH.mkName v) +antiAnnotationElementExp _ = Nothing + + +antiAnnotationArgumentsExp :: AnnotationArguments -> Maybe (TH.Q TH.Exp ) +antiAnnotationArgumentsExp ( Anti_AnnotationArguments v) = Just $ TH.varE (TH.mkName v) +antiAnnotationArgumentsExp _ = Nothing + + +antiAnnotationExp :: Annotation -> Maybe (TH.Q TH.Exp ) +antiAnnotationExp ( Anti_Annotation v) = Just $ TH.varE (TH.mkName v) +antiAnnotationExp _ = Nothing + + +antiDocCommentExp :: DocComment -> Maybe (TH.Q TH.Exp ) +antiDocCommentExp ( Anti_DocComment v) = Just $ TH.varE (TH.mkName v) +antiDocCommentExp _ = Nothing + + +antiImportHeadExp :: ImportHead -> Maybe (TH.Q TH.Exp ) +antiImportHeadExp ( Anti_ImportHead v) = Just $ TH.varE (TH.mkName v) +antiImportHeadExp _ = Nothing + + +antiImportNameExp :: ImportName -> Maybe (TH.Q TH.Exp ) +antiImportNameExp ( Anti_ImportName v) = Just $ TH.varE (TH.mkName v) +antiImportNameExp _ = Nothing + + +antiPackageExp :: Package -> Maybe (TH.Q TH.Exp ) +antiPackageExp ( Anti_Package v) = Just $ TH.varE (TH.mkName v) +antiPackageExp _ = Nothing + + +antiCompilationUnitExp :: CompilationUnit -> Maybe (TH.Q TH.Exp ) +antiCompilationUnitExp ( Anti_CompilationUnit v) = Just $ TH.varE (TH.mkName v) +antiCompilationUnitExp _ = Nothing + + +antiImportStatementExp :: [ ImportStatement ] -> Maybe (TH.Q TH.Exp) +antiImportStatementExp ((Anti_ImportStatement v):rest) = + let restExp = dataToExpQ (const Nothing `Generics.extQ` antiJavaExp `Generics.extQ` antiOptDocCommentExp `Generics.extQ` antiTypeDeclarationExp `Generics.extQ` antiImportStatementExp `Generics.extQ` antiCompilationUnitExp `Generics.extQ` antiPackageExp `Generics.extQ` antiImportNameExp `Generics.extQ` antiImportHeadExp `Generics.extQ` antiDocCommentExp `Generics.extQ` antiAnnotationExp `Generics.extQ` antiAnnotationArgumentsExp `Generics.extQ` antiAnnotationElementExp `Generics.extQ` antiRule_10Exp `Generics.extQ` antiClassOrInterfaceTypeExp `Generics.extQ` antiExtendsListExp `Generics.extQ` antiImplementsListExp `Generics.extQ` antiFieldDeclarationExp `Generics.extQ` antiClassDeclarationExp `Generics.extQ` antiInterfaceDeclarationExp `Generics.extQ` antiAnnotationDeclarationExp `Generics.extQ` antiAnnotationTypeElementExp `Generics.extQ` antiEnumConstantExp `Generics.extQ` antiEnumConstantListExp `Generics.extQ` antiEnumDeclarationExp `Generics.extQ` antiTypeDeclRestExp `Generics.extQ` antiRule_31Exp `Generics.extQ` antiRule_33Exp `Generics.extQ` antiMemberDeclarationExp `Generics.extQ` antiPrimitiveTypeKeywordExp `Generics.extQ` antiMemberAfterFirstIdExp `Generics.extQ` antiMoreTypeSpecifierExp `Generics.extQ` antiThrowsClauseExp `Generics.extQ` antiMemberRestExp `Generics.extQ` antiRule_44Exp `Generics.extQ` antiStatementBlockExp `Generics.extQ` antiVariableDeclaratorListExp `Generics.extQ` antiVariableDeclarationExp `Generics.extQ` antiRule_48Exp `Generics.extQ` antiOptVariableInitializerExp `Generics.extQ` antiVariableDeclaratorExp `Generics.extQ` antiVariableInitializerListExp `Generics.extQ` antiVariableInitializerExp `Generics.extQ` antiStaticInitializerExp `Generics.extQ` antiParameterListExp `Generics.extQ` antiRule_57Exp `Generics.extQ` antiParameterExp `Generics.extQ` antiStatementExp `Generics.extQ` antiOptExpressionExp `Generics.extQ` antiOptIdExp `Generics.extQ` antiOptElsePartExp `Generics.extQ` antiIfStatementExp `Generics.extQ` antiDoStatementExp `Generics.extQ` antiWhileStatementExp `Generics.extQ` antiForStatementExp `Generics.extQ` antiRule_63Exp `Generics.extQ` antiOptFinallyExp `Generics.extQ` antiTryStatementExp `Generics.extQ` antiRule_66Exp `Generics.extQ` antiSwitchStatementExp `Generics.extQ` antiExpressionExp `Generics.extQ` antiAssignmentOpExp `Generics.extQ` antiEqualityOpExp `Generics.extQ` antiRelationalOpExp `Generics.extQ` antiShiftOpExp `Generics.extQ` antiAdditiveOpExp `Generics.extQ` antiMultiplicativeOpExp `Generics.extQ` antiPrefixOpExp `Generics.extQ` antiPostfixOpExp `Generics.extQ` antiCreationExpressionExp `Generics.extQ` antiRule_76Exp `Generics.extQ` antiLiteralExp `Generics.extQ` antiArglistExp `Generics.extQ` antiTypeArgumentsExp `Generics.extQ` antiNonEmptyTypeArgumentsExp `Generics.extQ` antiTypeArgumentExp `Generics.extQ` antiWildcardTypeExp `Generics.extQ` antiTypeParametersExp `Generics.extQ` antiTypeParameterExp `Generics.extQ` antiTypeExp `Generics.extQ` antiTypeSpecifierExp `Generics.extQ` antiModifierExp `Generics.extQ` antiRule_90Exp `Generics.extQ` antiCompoundNameExp) rest + lvar = TH.varE $ TH.mkName v + in Just [| $lvar ++ $restExp |] +antiImportStatementExp _ = Nothing + + +antiTypeDeclarationExp :: TypeDeclaration -> Maybe (TH.Q TH.Exp ) +antiTypeDeclarationExp ( Anti_TypeDeclaration v) = Just $ TH.varE (TH.mkName v) +antiTypeDeclarationExp _ = Nothing + + +antiOptDocCommentExp :: OptDocComment -> Maybe (TH.Q TH.Exp ) +antiOptDocCommentExp ( Anti_OptDocComment v) = Just $ TH.varE (TH.mkName v) +antiOptDocCommentExp _ = Nothing + + +antiJavaExp :: Java -> Maybe (TH.Q TH.Exp ) +antiJavaExp ( Anti_Java v) = Just $ TH.varE (TH.mkName v) +antiJavaExp _ = Nothing + + + +antiCompoundNamePat :: CompoundName -> Maybe (TH.Q TH.Pat ) +antiCompoundNamePat ( Anti_CompoundName v) = Just $ TH.varP (TH.mkName v) +antiCompoundNamePat _ = Nothing + + +antiRule_90Pat :: [ Rule_90 ] -> Maybe (TH.Q TH.Pat) +antiRule_90Pat [Anti_Rule_90 v] = Just $ TH.varP (TH.mkName v) +antiRule_90Pat _ = Nothing + + +antiModifierPat :: Modifier -> Maybe (TH.Q TH.Pat ) +antiModifierPat ( Anti_Modifier v) = Just $ TH.varP (TH.mkName v) +antiModifierPat _ = Nothing + + +antiTypeSpecifierPat :: TypeSpecifier -> Maybe (TH.Q TH.Pat ) +antiTypeSpecifierPat ( Anti_TypeSpecifier v) = Just $ TH.varP (TH.mkName v) +antiTypeSpecifierPat _ = Nothing + + +antiTypePat :: Type -> Maybe (TH.Q TH.Pat ) +antiTypePat ( Anti_Type v) = Just $ TH.varP (TH.mkName v) +antiTypePat _ = Nothing + + +antiTypeParameterPat :: TypeParameter -> Maybe (TH.Q TH.Pat ) +antiTypeParameterPat ( Anti_TypeParameter v) = Just $ TH.varP (TH.mkName v) +antiTypeParameterPat _ = Nothing + + +antiTypeParametersPat :: TypeParameters -> Maybe (TH.Q TH.Pat ) +antiTypeParametersPat ( Anti_TypeParameters v) = Just $ TH.varP (TH.mkName v) +antiTypeParametersPat _ = Nothing + + +antiWildcardTypePat :: WildcardType -> Maybe (TH.Q TH.Pat ) +antiWildcardTypePat ( Anti_WildcardType v) = Just $ TH.varP (TH.mkName v) +antiWildcardTypePat _ = Nothing + + +antiTypeArgumentPat :: TypeArgument -> Maybe (TH.Q TH.Pat ) +antiTypeArgumentPat ( Anti_TypeArgument v) = Just $ TH.varP (TH.mkName v) +antiTypeArgumentPat _ = Nothing + + +antiNonEmptyTypeArgumentsPat :: NonEmptyTypeArguments -> Maybe (TH.Q TH.Pat ) +antiNonEmptyTypeArgumentsPat ( Anti_NonEmptyTypeArguments v) = Just $ TH.varP (TH.mkName v) +antiNonEmptyTypeArgumentsPat _ = Nothing + + +antiTypeArgumentsPat :: TypeArguments -> Maybe (TH.Q TH.Pat ) +antiTypeArgumentsPat ( Anti_TypeArguments v) = Just $ TH.varP (TH.mkName v) +antiTypeArgumentsPat _ = Nothing + + +antiArglistPat :: Arglist -> Maybe (TH.Q TH.Pat ) +antiArglistPat ( Anti_Arglist v) = Just $ TH.varP (TH.mkName v) +antiArglistPat _ = Nothing + + +antiLiteralPat :: Literal -> Maybe (TH.Q TH.Pat ) +antiLiteralPat ( Anti_Literal v) = Just $ TH.varP (TH.mkName v) +antiLiteralPat _ = Nothing + + +antiRule_76Pat :: [ Rule_76 ] -> Maybe (TH.Q TH.Pat) +antiRule_76Pat [Anti_Rule_76 v] = Just $ TH.varP (TH.mkName v) +antiRule_76Pat _ = Nothing + + +antiCreationExpressionPat :: CreationExpression -> Maybe (TH.Q TH.Pat ) +antiCreationExpressionPat ( Anti_CreationExpression v) = Just $ TH.varP (TH.mkName v) +antiCreationExpressionPat _ = Nothing + + +antiPostfixOpPat :: PostfixOp -> Maybe (TH.Q TH.Pat ) +antiPostfixOpPat ( Anti_PostfixOp v) = Just $ TH.varP (TH.mkName v) +antiPostfixOpPat _ = Nothing + + +antiPrefixOpPat :: PrefixOp -> Maybe (TH.Q TH.Pat ) +antiPrefixOpPat ( Anti_PrefixOp v) = Just $ TH.varP (TH.mkName v) +antiPrefixOpPat _ = Nothing + + +antiMultiplicativeOpPat :: MultiplicativeOp -> Maybe (TH.Q TH.Pat ) +antiMultiplicativeOpPat ( Anti_MultiplicativeOp v) = Just $ TH.varP (TH.mkName v) +antiMultiplicativeOpPat _ = Nothing + + +antiAdditiveOpPat :: AdditiveOp -> Maybe (TH.Q TH.Pat ) +antiAdditiveOpPat ( Anti_AdditiveOp v) = Just $ TH.varP (TH.mkName v) +antiAdditiveOpPat _ = Nothing + + +antiShiftOpPat :: ShiftOp -> Maybe (TH.Q TH.Pat ) +antiShiftOpPat ( Anti_ShiftOp v) = Just $ TH.varP (TH.mkName v) +antiShiftOpPat _ = Nothing + + +antiRelationalOpPat :: RelationalOp -> Maybe (TH.Q TH.Pat ) +antiRelationalOpPat ( Anti_RelationalOp v) = Just $ TH.varP (TH.mkName v) +antiRelationalOpPat _ = Nothing + + +antiEqualityOpPat :: EqualityOp -> Maybe (TH.Q TH.Pat ) +antiEqualityOpPat ( Anti_EqualityOp v) = Just $ TH.varP (TH.mkName v) +antiEqualityOpPat _ = Nothing + + +antiAssignmentOpPat :: AssignmentOp -> Maybe (TH.Q TH.Pat ) +antiAssignmentOpPat ( Anti_AssignmentOp v) = Just $ TH.varP (TH.mkName v) +antiAssignmentOpPat _ = Nothing + + +antiExpressionPat :: Expression -> Maybe (TH.Q TH.Pat ) +antiExpressionPat ( Anti_Expression v) = Just $ TH.varP (TH.mkName v) +antiExpressionPat _ = Nothing + + +antiSwitchStatementPat :: SwitchStatement -> Maybe (TH.Q TH.Pat ) +antiSwitchStatementPat ( Anti_SwitchStatement v) = Just $ TH.varP (TH.mkName v) +antiSwitchStatementPat _ = Nothing + + +antiRule_66Pat :: [ Rule_66 ] -> Maybe (TH.Q TH.Pat) +antiRule_66Pat [Anti_Rule_66 v] = Just $ TH.varP (TH.mkName v) +antiRule_66Pat _ = Nothing + + +antiTryStatementPat :: TryStatement -> Maybe (TH.Q TH.Pat ) +antiTryStatementPat ( Anti_TryStatement v) = Just $ TH.varP (TH.mkName v) +antiTryStatementPat _ = Nothing + + +antiOptFinallyPat :: OptFinally -> Maybe (TH.Q TH.Pat ) +antiOptFinallyPat ( Anti_OptFinally v) = Just $ TH.varP (TH.mkName v) +antiOptFinallyPat _ = Nothing + + +antiRule_63Pat :: [ Rule_63 ] -> Maybe (TH.Q TH.Pat) +antiRule_63Pat [Anti_Rule_63 v] = Just $ TH.varP (TH.mkName v) +antiRule_63Pat _ = Nothing + + +antiForStatementPat :: ForStatement -> Maybe (TH.Q TH.Pat ) +antiForStatementPat ( Anti_ForStatement v) = Just $ TH.varP (TH.mkName v) +antiForStatementPat _ = Nothing + + +antiWhileStatementPat :: WhileStatement -> Maybe (TH.Q TH.Pat ) +antiWhileStatementPat ( Anti_WhileStatement v) = Just $ TH.varP (TH.mkName v) +antiWhileStatementPat _ = Nothing + + +antiDoStatementPat :: DoStatement -> Maybe (TH.Q TH.Pat ) +antiDoStatementPat ( Anti_DoStatement v) = Just $ TH.varP (TH.mkName v) +antiDoStatementPat _ = Nothing + + +antiIfStatementPat :: IfStatement -> Maybe (TH.Q TH.Pat ) +antiIfStatementPat ( Anti_IfStatement v) = Just $ TH.varP (TH.mkName v) +antiIfStatementPat _ = Nothing + + +antiOptElsePartPat :: OptElsePart -> Maybe (TH.Q TH.Pat ) +antiOptElsePartPat ( Anti_OptElsePart v) = Just $ TH.varP (TH.mkName v) +antiOptElsePartPat _ = Nothing + + +antiOptIdPat :: OptId -> Maybe (TH.Q TH.Pat ) +antiOptIdPat ( Anti_OptId v) = Just $ TH.varP (TH.mkName v) +antiOptIdPat _ = Nothing + + +antiOptExpressionPat :: OptExpression -> Maybe (TH.Q TH.Pat ) +antiOptExpressionPat ( Anti_OptExpression v) = Just $ TH.varP (TH.mkName v) +antiOptExpressionPat _ = Nothing + + +antiStatementPat :: [ Statement ] -> Maybe (TH.Q TH.Pat) +antiStatementPat [Anti_Statement v] = Just $ TH.varP (TH.mkName v) +antiStatementPat _ = Nothing + + +antiParameterPat :: Parameter -> Maybe (TH.Q TH.Pat ) +antiParameterPat ( Anti_Parameter v) = Just $ TH.varP (TH.mkName v) +antiParameterPat _ = Nothing + + +antiRule_57Pat :: [ Rule_57 ] -> Maybe (TH.Q TH.Pat) +antiRule_57Pat [Anti_Rule_57 v] = Just $ TH.varP (TH.mkName v) +antiRule_57Pat _ = Nothing + + +antiParameterListPat :: ParameterList -> Maybe (TH.Q TH.Pat ) +antiParameterListPat ( Anti_ParameterList v) = Just $ TH.varP (TH.mkName v) +antiParameterListPat _ = Nothing + + +antiStaticInitializerPat :: StaticInitializer -> Maybe (TH.Q TH.Pat ) +antiStaticInitializerPat ( Anti_StaticInitializer v) = Just $ TH.varP (TH.mkName v) +antiStaticInitializerPat _ = Nothing + + +antiVariableInitializerPat :: VariableInitializer -> Maybe (TH.Q TH.Pat ) +antiVariableInitializerPat ( Anti_VariableInitializer v) = Just $ TH.varP (TH.mkName v) +antiVariableInitializerPat _ = Nothing + + +antiVariableInitializerListPat :: VariableInitializerList -> Maybe (TH.Q TH.Pat ) +antiVariableInitializerListPat ( Anti_VariableInitializerList v) = Just $ TH.varP (TH.mkName v) +antiVariableInitializerListPat _ = Nothing + + +antiVariableDeclaratorPat :: VariableDeclarator -> Maybe (TH.Q TH.Pat ) +antiVariableDeclaratorPat ( Anti_VariableDeclarator v) = Just $ TH.varP (TH.mkName v) +antiVariableDeclaratorPat _ = Nothing + + +antiOptVariableInitializerPat :: OptVariableInitializer -> Maybe (TH.Q TH.Pat ) +antiOptVariableInitializerPat ( Anti_OptVariableInitializer v) = Just $ TH.varP (TH.mkName v) +antiOptVariableInitializerPat _ = Nothing + + +antiRule_48Pat :: [ Rule_48 ] -> Maybe (TH.Q TH.Pat) +antiRule_48Pat [Anti_Rule_48 v] = Just $ TH.varP (TH.mkName v) +antiRule_48Pat _ = Nothing + + +antiVariableDeclarationPat :: VariableDeclaration -> Maybe (TH.Q TH.Pat ) +antiVariableDeclarationPat ( Anti_VariableDeclaration v) = Just $ TH.varP (TH.mkName v) +antiVariableDeclarationPat _ = Nothing + + +antiVariableDeclaratorListPat :: VariableDeclaratorList -> Maybe (TH.Q TH.Pat ) +antiVariableDeclaratorListPat ( Anti_VariableDeclaratorList v) = Just $ TH.varP (TH.mkName v) +antiVariableDeclaratorListPat _ = Nothing + + +antiStatementBlockPat :: StatementBlock -> Maybe (TH.Q TH.Pat ) +antiStatementBlockPat ( Anti_StatementBlock v) = Just $ TH.varP (TH.mkName v) +antiStatementBlockPat _ = Nothing + + +antiRule_44Pat :: [ Rule_44 ] -> Maybe (TH.Q TH.Pat) +antiRule_44Pat [Anti_Rule_44 v] = Just $ TH.varP (TH.mkName v) +antiRule_44Pat _ = Nothing + + +antiMemberRestPat :: MemberRest -> Maybe (TH.Q TH.Pat ) +antiMemberRestPat ( Anti_MemberRest v) = Just $ TH.varP (TH.mkName v) +antiMemberRestPat _ = Nothing + + +antiThrowsClausePat :: ThrowsClause -> Maybe (TH.Q TH.Pat ) +antiThrowsClausePat ( Anti_ThrowsClause v) = Just $ TH.varP (TH.mkName v) +antiThrowsClausePat _ = Nothing + + +antiMoreTypeSpecifierPat :: MoreTypeSpecifier -> Maybe (TH.Q TH.Pat ) +antiMoreTypeSpecifierPat ( Anti_MoreTypeSpecifier v) = Just $ TH.varP (TH.mkName v) +antiMoreTypeSpecifierPat _ = Nothing + + +antiMemberAfterFirstIdPat :: MemberAfterFirstId -> Maybe (TH.Q TH.Pat ) +antiMemberAfterFirstIdPat ( Anti_MemberAfterFirstId v) = Just $ TH.varP (TH.mkName v) +antiMemberAfterFirstIdPat _ = Nothing + + +antiPrimitiveTypeKeywordPat :: PrimitiveTypeKeyword -> Maybe (TH.Q TH.Pat ) +antiPrimitiveTypeKeywordPat ( Anti_PrimitiveTypeKeyword v) = Just $ TH.varP (TH.mkName v) +antiPrimitiveTypeKeywordPat _ = Nothing + + +antiMemberDeclarationPat :: MemberDeclaration -> Maybe (TH.Q TH.Pat ) +antiMemberDeclarationPat ( Anti_MemberDeclaration v) = Just $ TH.varP (TH.mkName v) +antiMemberDeclarationPat _ = Nothing + + +antiRule_33Pat :: [ Rule_33 ] -> Maybe (TH.Q TH.Pat) +antiRule_33Pat [Anti_Rule_33 v] = Just $ TH.varP (TH.mkName v) +antiRule_33Pat _ = Nothing + + +antiRule_31Pat :: [ Rule_31 ] -> Maybe (TH.Q TH.Pat) +antiRule_31Pat [Anti_Rule_31 v] = Just $ TH.varP (TH.mkName v) +antiRule_31Pat _ = Nothing + + +antiTypeDeclRestPat :: TypeDeclRest -> Maybe (TH.Q TH.Pat ) +antiTypeDeclRestPat ( Anti_TypeDeclRest v) = Just $ TH.varP (TH.mkName v) +antiTypeDeclRestPat _ = Nothing + + +antiEnumDeclarationPat :: EnumDeclaration -> Maybe (TH.Q TH.Pat ) +antiEnumDeclarationPat ( Anti_EnumDeclaration v) = Just $ TH.varP (TH.mkName v) +antiEnumDeclarationPat _ = Nothing + + +antiEnumConstantListPat :: EnumConstantList -> Maybe (TH.Q TH.Pat ) +antiEnumConstantListPat ( Anti_EnumConstantList v) = Just $ TH.varP (TH.mkName v) +antiEnumConstantListPat _ = Nothing + + +antiEnumConstantPat :: EnumConstant -> Maybe (TH.Q TH.Pat ) +antiEnumConstantPat ( Anti_EnumConstant v) = Just $ TH.varP (TH.mkName v) +antiEnumConstantPat _ = Nothing + + +antiAnnotationTypeElementPat :: [ AnnotationTypeElement ] -> Maybe (TH.Q TH.Pat) +antiAnnotationTypeElementPat [Anti_AnnotationTypeElement v] = Just $ TH.varP (TH.mkName v) +antiAnnotationTypeElementPat _ = Nothing + + +antiAnnotationDeclarationPat :: AnnotationDeclaration -> Maybe (TH.Q TH.Pat ) +antiAnnotationDeclarationPat ( Anti_AnnotationDeclaration v) = Just $ TH.varP (TH.mkName v) +antiAnnotationDeclarationPat _ = Nothing + + +antiInterfaceDeclarationPat :: InterfaceDeclaration -> Maybe (TH.Q TH.Pat ) +antiInterfaceDeclarationPat ( Anti_InterfaceDeclaration v) = Just $ TH.varP (TH.mkName v) +antiInterfaceDeclarationPat _ = Nothing + + +antiClassDeclarationPat :: ClassDeclaration -> Maybe (TH.Q TH.Pat ) +antiClassDeclarationPat ( Anti_ClassDeclaration v) = Just $ TH.varP (TH.mkName v) +antiClassDeclarationPat _ = Nothing + + +antiFieldDeclarationPat :: [ FieldDeclaration ] -> Maybe (TH.Q TH.Pat) +antiFieldDeclarationPat [Anti_FieldDeclaration v] = Just $ TH.varP (TH.mkName v) +antiFieldDeclarationPat _ = Nothing + + +antiImplementsListPat :: ImplementsList -> Maybe (TH.Q TH.Pat ) +antiImplementsListPat ( Anti_ImplementsList v) = Just $ TH.varP (TH.mkName v) +antiImplementsListPat _ = Nothing + + +antiExtendsListPat :: ExtendsList -> Maybe (TH.Q TH.Pat ) +antiExtendsListPat ( Anti_ExtendsList v) = Just $ TH.varP (TH.mkName v) +antiExtendsListPat _ = Nothing + + +antiClassOrInterfaceTypePat :: ClassOrInterfaceType -> Maybe (TH.Q TH.Pat ) +antiClassOrInterfaceTypePat ( Anti_ClassOrInterfaceType v) = Just $ TH.varP (TH.mkName v) +antiClassOrInterfaceTypePat _ = Nothing + + +antiRule_10Pat :: [ Rule_10 ] -> Maybe (TH.Q TH.Pat) +antiRule_10Pat [Anti_Rule_10 v] = Just $ TH.varP (TH.mkName v) +antiRule_10Pat _ = Nothing + + +antiAnnotationElementPat :: AnnotationElement -> Maybe (TH.Q TH.Pat ) +antiAnnotationElementPat ( Anti_AnnotationElement v) = Just $ TH.varP (TH.mkName v) +antiAnnotationElementPat _ = Nothing + + +antiAnnotationArgumentsPat :: AnnotationArguments -> Maybe (TH.Q TH.Pat ) +antiAnnotationArgumentsPat ( Anti_AnnotationArguments v) = Just $ TH.varP (TH.mkName v) +antiAnnotationArgumentsPat _ = Nothing + + +antiAnnotationPat :: Annotation -> Maybe (TH.Q TH.Pat ) +antiAnnotationPat ( Anti_Annotation v) = Just $ TH.varP (TH.mkName v) +antiAnnotationPat _ = Nothing + + +antiDocCommentPat :: DocComment -> Maybe (TH.Q TH.Pat ) +antiDocCommentPat ( Anti_DocComment v) = Just $ TH.varP (TH.mkName v) +antiDocCommentPat _ = Nothing + + +antiImportHeadPat :: ImportHead -> Maybe (TH.Q TH.Pat ) +antiImportHeadPat ( Anti_ImportHead v) = Just $ TH.varP (TH.mkName v) +antiImportHeadPat _ = Nothing + + +antiImportNamePat :: ImportName -> Maybe (TH.Q TH.Pat ) +antiImportNamePat ( Anti_ImportName v) = Just $ TH.varP (TH.mkName v) +antiImportNamePat _ = Nothing + + +antiPackagePat :: Package -> Maybe (TH.Q TH.Pat ) +antiPackagePat ( Anti_Package v) = Just $ TH.varP (TH.mkName v) +antiPackagePat _ = Nothing + + +antiCompilationUnitPat :: CompilationUnit -> Maybe (TH.Q TH.Pat ) +antiCompilationUnitPat ( Anti_CompilationUnit v) = Just $ TH.varP (TH.mkName v) +antiCompilationUnitPat _ = Nothing + + +antiImportStatementPat :: [ ImportStatement ] -> Maybe (TH.Q TH.Pat) +antiImportStatementPat [Anti_ImportStatement v] = Just $ TH.varP (TH.mkName v) +antiImportStatementPat _ = Nothing + + +antiTypeDeclarationPat :: TypeDeclaration -> Maybe (TH.Q TH.Pat ) +antiTypeDeclarationPat ( Anti_TypeDeclaration v) = Just $ TH.varP (TH.mkName v) +antiTypeDeclarationPat _ = Nothing + + +antiOptDocCommentPat :: OptDocComment -> Maybe (TH.Q TH.Pat ) +antiOptDocCommentPat ( Anti_OptDocComment v) = Just $ TH.varP (TH.mkName v) +antiOptDocCommentPat _ = Nothing + + +antiJavaPat :: Java -> Maybe (TH.Q TH.Pat ) +antiJavaPat ( Anti_Java v) = Just $ TH.varP (TH.mkName v) +antiJavaPat _ = Nothing + + + +-- This grammar's quasi-quoters work in expression and pattern contexts only +quoteJavaType _ = fail "this quasi-quoter cannot be used in a type context" +quoteJavaDecs _ = fail "this quasi-quoter cannot be used in a declaration context" + +getJava ( Ctr__Java__0 _ s) = s + +java :: QuasiQuoter +java = QuasiQuoter (quoteJavaExp "tok_Java_dummy_179" getJava ) (quoteJavaPat "tok_Java_dummy_179" getJava ) quoteJavaType quoteJavaDecs + +getAdditiveOp ( Ctr__Java__1 _ s) = s + +additiveOp :: QuasiQuoter +additiveOp = QuasiQuoter (quoteJavaExp "tok_AdditiveOp_dummy_178" getAdditiveOp ) (quoteJavaPat "tok_AdditiveOp_dummy_178" getAdditiveOp ) quoteJavaType quoteJavaDecs + +getAnnotation ( Ctr__Java__2 _ s) = s + +annotation :: QuasiQuoter +annotation = QuasiQuoter (quoteJavaExp "tok_Annotation_dummy_177" getAnnotation ) (quoteJavaPat "tok_Annotation_dummy_177" getAnnotation ) quoteJavaType quoteJavaDecs + +getAnnotationArguments ( Ctr__Java__3 _ s) = s + +annotationArguments :: QuasiQuoter +annotationArguments = QuasiQuoter (quoteJavaExp "tok_AnnotationArguments_dummy_176" getAnnotationArguments ) (quoteJavaPat "tok_AnnotationArguments_dummy_176" getAnnotationArguments ) quoteJavaType quoteJavaDecs + +getAnnotationDeclaration ( Ctr__Java__4 _ s) = s + +annotationDeclaration :: QuasiQuoter +annotationDeclaration = QuasiQuoter (quoteJavaExp "tok_AnnotationDeclaration_dummy_175" getAnnotationDeclaration ) (quoteJavaPat "tok_AnnotationDeclaration_dummy_175" getAnnotationDeclaration ) quoteJavaType quoteJavaDecs + +getAnnotationElement ( Ctr__Java__5 _ s) = s + +annotationElement :: QuasiQuoter +annotationElement = QuasiQuoter (quoteJavaExp "tok_AnnotationElement_dummy_174" getAnnotationElement ) (quoteJavaPat "tok_AnnotationElement_dummy_174" getAnnotationElement ) quoteJavaType quoteJavaDecs + +getAnnotationList ( Ctr__Java__6 _ s) = s + +annotationList :: QuasiQuoter +annotationList = QuasiQuoter (quoteJavaExp "tok_AnnotationList_dummy_173" getAnnotationList ) (quoteJavaPat "tok_AnnotationList_dummy_173" getAnnotationList ) quoteJavaType quoteJavaDecs + +getAnnotationTypeElement ( Ctr__Java__7 _ s) = s + +annotationTypeElement :: QuasiQuoter +annotationTypeElement = QuasiQuoter (quoteJavaExp "tok_AnnotationTypeElement_dummy_172" getAnnotationTypeElement ) (quoteJavaPat "tok_AnnotationTypeElement_dummy_172" getAnnotationTypeElement ) quoteJavaType quoteJavaDecs + +getAnnotationTypeElementList ( Ctr__Java__8 _ s) = s + +annotationTypeElementList :: QuasiQuoter +annotationTypeElementList = QuasiQuoter (quoteJavaExp "tok_AnnotationTypeElementList_dummy_171" getAnnotationTypeElementList ) (quoteJavaPat "tok_AnnotationTypeElementList_dummy_171" getAnnotationTypeElementList ) quoteJavaType quoteJavaDecs + +getArglist ( Ctr__Java__9 _ s) = s + +arglist :: QuasiQuoter +arglist = QuasiQuoter (quoteJavaExp "tok_Arglist_dummy_170" getArglist ) (quoteJavaPat "tok_Arglist_dummy_170" getArglist ) quoteJavaType quoteJavaDecs + +getAssignmentOp ( Ctr__Java__10 _ s) = s + +assignmentOp :: QuasiQuoter +assignmentOp = QuasiQuoter (quoteJavaExp "tok_AssignmentOp_dummy_169" getAssignmentOp ) (quoteJavaPat "tok_AssignmentOp_dummy_169" getAssignmentOp ) quoteJavaType quoteJavaDecs + +getCatchList ( Ctr__Java__11 _ s) = s + +catchList :: QuasiQuoter +catchList = QuasiQuoter (quoteJavaExp "tok_CatchList_dummy_168" getCatchList ) (quoteJavaPat "tok_CatchList_dummy_168" getCatchList ) quoteJavaType quoteJavaDecs + +getClassDeclaration ( Ctr__Java__12 _ s) = s + +classDeclaration :: QuasiQuoter +classDeclaration = QuasiQuoter (quoteJavaExp "tok_ClassDeclaration_dummy_167" getClassDeclaration ) (quoteJavaPat "tok_ClassDeclaration_dummy_167" getClassDeclaration ) quoteJavaType quoteJavaDecs + +getClassOrInterfaceType ( Ctr__Java__13 _ s) = s + +classOrInterfaceType :: QuasiQuoter +classOrInterfaceType = QuasiQuoter (quoteJavaExp "tok_ClassOrInterfaceType_dummy_166" getClassOrInterfaceType ) (quoteJavaPat "tok_ClassOrInterfaceType_dummy_166" getClassOrInterfaceType ) quoteJavaType quoteJavaDecs + +getCompilationUnit ( Ctr__Java__14 _ s) = s + +compilationUnit :: QuasiQuoter +compilationUnit = QuasiQuoter (quoteJavaExp "tok_CompilationUnit_dummy_165" getCompilationUnit ) (quoteJavaPat "tok_CompilationUnit_dummy_165" getCompilationUnit ) quoteJavaType quoteJavaDecs + +getCompoundName ( Ctr__Java__15 _ s) = s + +compoundName :: QuasiQuoter +compoundName = QuasiQuoter (quoteJavaExp "tok_CompoundName_dummy_164" getCompoundName ) (quoteJavaPat "tok_CompoundName_dummy_164" getCompoundName ) quoteJavaType quoteJavaDecs + +getCompoundNameTail ( Ctr__Java__16 _ s) = s + +compoundNameTail :: QuasiQuoter +compoundNameTail = QuasiQuoter (quoteJavaExp "tok_CompoundNameTail_dummy_163" getCompoundNameTail ) (quoteJavaPat "tok_CompoundNameTail_dummy_163" getCompoundNameTail ) quoteJavaType quoteJavaDecs + +getCreationExpression ( Ctr__Java__17 _ s) = s + +creationExpression :: QuasiQuoter +creationExpression = QuasiQuoter (quoteJavaExp "tok_CreationExpression_dummy_162" getCreationExpression ) (quoteJavaPat "tok_CreationExpression_dummy_162" getCreationExpression ) quoteJavaType quoteJavaDecs + +getDimExprs ( Ctr__Java__18 _ s) = s + +dimExprs :: QuasiQuoter +dimExprs = QuasiQuoter (quoteJavaExp "tok_DimExprs_dummy_161" getDimExprs ) (quoteJavaPat "tok_DimExprs_dummy_161" getDimExprs ) quoteJavaType quoteJavaDecs + +getDims ( Ctr__Java__19 _ s) = s + +dims :: QuasiQuoter +dims = QuasiQuoter (quoteJavaExp "tok_Dims_dummy_160" getDims ) (quoteJavaPat "tok_Dims_dummy_160" getDims ) quoteJavaType quoteJavaDecs + +getDoStatement ( Ctr__Java__20 _ s) = s + +doStatement :: QuasiQuoter +doStatement = QuasiQuoter (quoteJavaExp "tok_DoStatement_dummy_159" getDoStatement ) (quoteJavaPat "tok_DoStatement_dummy_159" getDoStatement ) quoteJavaType quoteJavaDecs + +getDocComment ( Ctr__Java__21 _ s) = s + +docComment :: QuasiQuoter +docComment = QuasiQuoter (quoteJavaExp "tok_DocComment_dummy_158" getDocComment ) (quoteJavaPat "tok_DocComment_dummy_158" getDocComment ) quoteJavaType quoteJavaDecs + +getEnumConstant ( Ctr__Java__22 _ s) = s + +enumConstant :: QuasiQuoter +enumConstant = QuasiQuoter (quoteJavaExp "tok_EnumConstant_dummy_157" getEnumConstant ) (quoteJavaPat "tok_EnumConstant_dummy_157" getEnumConstant ) quoteJavaType quoteJavaDecs + +getEnumConstantList ( Ctr__Java__23 _ s) = s + +enumConstantList :: QuasiQuoter +enumConstantList = QuasiQuoter (quoteJavaExp "tok_EnumConstantList_dummy_156" getEnumConstantList ) (quoteJavaPat "tok_EnumConstantList_dummy_156" getEnumConstantList ) quoteJavaType quoteJavaDecs + +getEnumDeclaration ( Ctr__Java__24 _ s) = s + +enumDeclaration :: QuasiQuoter +enumDeclaration = QuasiQuoter (quoteJavaExp "tok_EnumDeclaration_dummy_155" getEnumDeclaration ) (quoteJavaPat "tok_EnumDeclaration_dummy_155" getEnumDeclaration ) quoteJavaType quoteJavaDecs + +getEqualityOp ( Ctr__Java__25 _ s) = s + +equalityOp :: QuasiQuoter +equalityOp = QuasiQuoter (quoteJavaExp "tok_EqualityOp_dummy_154" getEqualityOp ) (quoteJavaPat "tok_EqualityOp_dummy_154" getEqualityOp ) quoteJavaType quoteJavaDecs + +getExpression ( Ctr__Java__26 _ s) = s + +expression :: QuasiQuoter +expression = QuasiQuoter (quoteJavaExp "tok_Expression_dummy_153" getExpression ) (quoteJavaPat "tok_Expression_dummy_153" getExpression ) quoteJavaType quoteJavaDecs + +getExtendsList ( Ctr__Java__27 _ s) = s + +extendsList :: QuasiQuoter +extendsList = QuasiQuoter (quoteJavaExp "tok_ExtendsList_dummy_152" getExtendsList ) (quoteJavaPat "tok_ExtendsList_dummy_152" getExtendsList ) quoteJavaType quoteJavaDecs + +getFieldDeclaration ( Ctr__Java__28 _ s) = s + +fieldDeclaration :: QuasiQuoter +fieldDeclaration = QuasiQuoter (quoteJavaExp "tok_FieldDeclaration_dummy_151" getFieldDeclaration ) (quoteJavaPat "tok_FieldDeclaration_dummy_151" getFieldDeclaration ) quoteJavaType quoteJavaDecs + +getFieldDeclarationList ( Ctr__Java__29 _ s) = s + +fieldDeclarationList :: QuasiQuoter +fieldDeclarationList = QuasiQuoter (quoteJavaExp "tok_FieldDeclarationList_dummy_150" getFieldDeclarationList ) (quoteJavaPat "tok_FieldDeclarationList_dummy_150" getFieldDeclarationList ) quoteJavaType quoteJavaDecs + +getForStatement ( Ctr__Java__30 _ s) = s + +forStatement :: QuasiQuoter +forStatement = QuasiQuoter (quoteJavaExp "tok_ForStatement_dummy_149" getForStatement ) (quoteJavaPat "tok_ForStatement_dummy_149" getForStatement ) quoteJavaType quoteJavaDecs + +getIfStatement ( Ctr__Java__31 _ s) = s + +ifStatement :: QuasiQuoter +ifStatement = QuasiQuoter (quoteJavaExp "tok_IfStatement_dummy_148" getIfStatement ) (quoteJavaPat "tok_IfStatement_dummy_148" getIfStatement ) quoteJavaType quoteJavaDecs + +getImplementsList ( Ctr__Java__32 _ s) = s + +implementsList :: QuasiQuoter +implementsList = QuasiQuoter (quoteJavaExp "tok_ImplementsList_dummy_147" getImplementsList ) (quoteJavaPat "tok_ImplementsList_dummy_147" getImplementsList ) quoteJavaType quoteJavaDecs + +getImportHead ( Ctr__Java__33 _ s) = s + +importHead :: QuasiQuoter +importHead = QuasiQuoter (quoteJavaExp "tok_ImportHead_dummy_146" getImportHead ) (quoteJavaPat "tok_ImportHead_dummy_146" getImportHead ) quoteJavaType quoteJavaDecs + +getImportList ( Ctr__Java__34 _ s) = s + +importList :: QuasiQuoter +importList = QuasiQuoter (quoteJavaExp "tok_ImportList_dummy_145" getImportList ) (quoteJavaPat "tok_ImportList_dummy_145" getImportList ) quoteJavaType quoteJavaDecs + +getImportName ( Ctr__Java__35 _ s) = s + +importName :: QuasiQuoter +importName = QuasiQuoter (quoteJavaExp "tok_ImportName_dummy_144" getImportName ) (quoteJavaPat "tok_ImportName_dummy_144" getImportName ) quoteJavaType quoteJavaDecs + +getImportStatement ( Ctr__Java__36 _ s) = s + +importStatement :: QuasiQuoter +importStatement = QuasiQuoter (quoteJavaExp "tok_ImportStatement_dummy_143" getImportStatement ) (quoteJavaPat "tok_ImportStatement_dummy_143" getImportStatement ) quoteJavaType quoteJavaDecs + +getInterfaceDeclaration ( Ctr__Java__37 _ s) = s + +interfaceDeclaration :: QuasiQuoter +interfaceDeclaration = QuasiQuoter (quoteJavaExp "tok_InterfaceDeclaration_dummy_142" getInterfaceDeclaration ) (quoteJavaPat "tok_InterfaceDeclaration_dummy_142" getInterfaceDeclaration ) quoteJavaType quoteJavaDecs + +getLiteral ( Ctr__Java__38 _ s) = s + +literal :: QuasiQuoter +literal = QuasiQuoter (quoteJavaExp "tok_Literal_dummy_141" getLiteral ) (quoteJavaPat "tok_Literal_dummy_141" getLiteral ) quoteJavaType quoteJavaDecs + +getLocalModifierList1 ( Ctr__Java__39 _ s) = s + +localModifierList1 :: QuasiQuoter +localModifierList1 = QuasiQuoter (quoteJavaExp "tok_LocalModifierList1_dummy_140" getLocalModifierList1 ) (quoteJavaPat "tok_LocalModifierList1_dummy_140" getLocalModifierList1 ) quoteJavaType quoteJavaDecs + +getMemberAfterFirstId ( Ctr__Java__40 _ s) = s + +memberAfterFirstId :: QuasiQuoter +memberAfterFirstId = QuasiQuoter (quoteJavaExp "tok_MemberAfterFirstId_dummy_139" getMemberAfterFirstId ) (quoteJavaPat "tok_MemberAfterFirstId_dummy_139" getMemberAfterFirstId ) quoteJavaType quoteJavaDecs + +getMemberDeclaration ( Ctr__Java__41 _ s) = s + +memberDeclaration :: QuasiQuoter +memberDeclaration = QuasiQuoter (quoteJavaExp "tok_MemberDeclaration_dummy_138" getMemberDeclaration ) (quoteJavaPat "tok_MemberDeclaration_dummy_138" getMemberDeclaration ) quoteJavaType quoteJavaDecs + +getMemberRest ( Ctr__Java__42 _ s) = s + +memberRest :: QuasiQuoter +memberRest = QuasiQuoter (quoteJavaExp "tok_MemberRest_dummy_137" getMemberRest ) (quoteJavaPat "tok_MemberRest_dummy_137" getMemberRest ) quoteJavaType quoteJavaDecs + +getModifier ( Ctr__Java__43 _ s) = s + +modifier :: QuasiQuoter +modifier = QuasiQuoter (quoteJavaExp "tok_Modifier_dummy_136" getModifier ) (quoteJavaPat "tok_Modifier_dummy_136" getModifier ) quoteJavaType quoteJavaDecs + +getModifierList ( Ctr__Java__44 _ s) = s + +modifierList :: QuasiQuoter +modifierList = QuasiQuoter (quoteJavaExp "tok_ModifierList_dummy_135" getModifierList ) (quoteJavaPat "tok_ModifierList_dummy_135" getModifierList ) quoteJavaType quoteJavaDecs + +getMoreTypeSpecifier ( Ctr__Java__45 _ s) = s + +moreTypeSpecifier :: QuasiQuoter +moreTypeSpecifier = QuasiQuoter (quoteJavaExp "tok_MoreTypeSpecifier_dummy_134" getMoreTypeSpecifier ) (quoteJavaPat "tok_MoreTypeSpecifier_dummy_134" getMoreTypeSpecifier ) quoteJavaType quoteJavaDecs + +getMoreVariableDeclarators ( Ctr__Java__46 _ s) = s + +moreVariableDeclarators :: QuasiQuoter +moreVariableDeclarators = QuasiQuoter (quoteJavaExp "tok_MoreVariableDeclarators_dummy_133" getMoreVariableDeclarators ) (quoteJavaPat "tok_MoreVariableDeclarators_dummy_133" getMoreVariableDeclarators ) quoteJavaType quoteJavaDecs + +getMultiplicativeOp ( Ctr__Java__47 _ s) = s + +multiplicativeOp :: QuasiQuoter +multiplicativeOp = QuasiQuoter (quoteJavaExp "tok_MultiplicativeOp_dummy_132" getMultiplicativeOp ) (quoteJavaPat "tok_MultiplicativeOp_dummy_132" getMultiplicativeOp ) quoteJavaType quoteJavaDecs + +getNonEmptyDims ( Ctr__Java__48 _ s) = s + +nonEmptyDims :: QuasiQuoter +nonEmptyDims = QuasiQuoter (quoteJavaExp "tok_NonEmptyDims_dummy_131" getNonEmptyDims ) (quoteJavaPat "tok_NonEmptyDims_dummy_131" getNonEmptyDims ) quoteJavaType quoteJavaDecs + +getNonEmptyTypeArguments ( Ctr__Java__49 _ s) = s + +nonEmptyTypeArguments :: QuasiQuoter +nonEmptyTypeArguments = QuasiQuoter (quoteJavaExp "tok_NonEmptyTypeArguments_dummy_130" getNonEmptyTypeArguments ) (quoteJavaPat "tok_NonEmptyTypeArguments_dummy_130" getNonEmptyTypeArguments ) quoteJavaType quoteJavaDecs + +getOptDocComment ( Ctr__Java__50 _ s) = s + +optDocComment :: QuasiQuoter +optDocComment = QuasiQuoter (quoteJavaExp "tok_OptDocComment_dummy_129" getOptDocComment ) (quoteJavaPat "tok_OptDocComment_dummy_129" getOptDocComment ) quoteJavaType quoteJavaDecs + +getOptElsePart ( Ctr__Java__51 _ s) = s + +optElsePart :: QuasiQuoter +optElsePart = QuasiQuoter (quoteJavaExp "tok_OptElsePart_dummy_128" getOptElsePart ) (quoteJavaPat "tok_OptElsePart_dummy_128" getOptElsePart ) quoteJavaType quoteJavaDecs + +getOptExpression ( Ctr__Java__52 _ s) = s + +optExpression :: QuasiQuoter +optExpression = QuasiQuoter (quoteJavaExp "tok_OptExpression_dummy_127" getOptExpression ) (quoteJavaPat "tok_OptExpression_dummy_127" getOptExpression ) quoteJavaType quoteJavaDecs + +getOptFinally ( Ctr__Java__53 _ s) = s + +optFinally :: QuasiQuoter +optFinally = QuasiQuoter (quoteJavaExp "tok_OptFinally_dummy_126" getOptFinally ) (quoteJavaPat "tok_OptFinally_dummy_126" getOptFinally ) quoteJavaType quoteJavaDecs + +getOptId ( Ctr__Java__54 _ s) = s + +optId :: QuasiQuoter +optId = QuasiQuoter (quoteJavaExp "tok_OptId_dummy_125" getOptId ) (quoteJavaPat "tok_OptId_dummy_125" getOptId ) quoteJavaType quoteJavaDecs + +getOptVariableInitializer ( Ctr__Java__55 _ s) = s + +optVariableInitializer :: QuasiQuoter +optVariableInitializer = QuasiQuoter (quoteJavaExp "tok_OptVariableInitializer_dummy_124" getOptVariableInitializer ) (quoteJavaPat "tok_OptVariableInitializer_dummy_124" getOptVariableInitializer ) quoteJavaType quoteJavaDecs + +getPackage ( Ctr__Java__56 _ s) = s + +package :: QuasiQuoter +package = QuasiQuoter (quoteJavaExp "tok_Package_dummy_123" getPackage ) (quoteJavaPat "tok_Package_dummy_123" getPackage ) quoteJavaType quoteJavaDecs + +getParamModifierList ( Ctr__Java__57 _ s) = s + +paramModifierList :: QuasiQuoter +paramModifierList = QuasiQuoter (quoteJavaExp "tok_ParamModifierList_dummy_122" getParamModifierList ) (quoteJavaPat "tok_ParamModifierList_dummy_122" getParamModifierList ) quoteJavaType quoteJavaDecs + +getParameter ( Ctr__Java__58 _ s) = s + +parameter :: QuasiQuoter +parameter = QuasiQuoter (quoteJavaExp "tok_Parameter_dummy_121" getParameter ) (quoteJavaPat "tok_Parameter_dummy_121" getParameter ) quoteJavaType quoteJavaDecs + +getParameterList ( Ctr__Java__59 _ s) = s + +parameterList :: QuasiQuoter +parameterList = QuasiQuoter (quoteJavaExp "tok_ParameterList_dummy_120" getParameterList ) (quoteJavaPat "tok_ParameterList_dummy_120" getParameterList ) quoteJavaType quoteJavaDecs + +getPostfixOp ( Ctr__Java__60 _ s) = s + +postfixOp :: QuasiQuoter +postfixOp = QuasiQuoter (quoteJavaExp "tok_PostfixOp_dummy_119" getPostfixOp ) (quoteJavaPat "tok_PostfixOp_dummy_119" getPostfixOp ) quoteJavaType quoteJavaDecs + +getPrefixOp ( Ctr__Java__61 _ s) = s + +prefixOp :: QuasiQuoter +prefixOp = QuasiQuoter (quoteJavaExp "tok_PrefixOp_dummy_118" getPrefixOp ) (quoteJavaPat "tok_PrefixOp_dummy_118" getPrefixOp ) quoteJavaType quoteJavaDecs + +getPrimitiveTypeKeyword ( Ctr__Java__62 _ s) = s + +primitiveTypeKeyword :: QuasiQuoter +primitiveTypeKeyword = QuasiQuoter (quoteJavaExp "tok_PrimitiveTypeKeyword_dummy_117" getPrimitiveTypeKeyword ) (quoteJavaPat "tok_PrimitiveTypeKeyword_dummy_117" getPrimitiveTypeKeyword ) quoteJavaType quoteJavaDecs + +getRelationalOp ( Ctr__Java__63 _ s) = s + +relationalOp :: QuasiQuoter +relationalOp = QuasiQuoter (quoteJavaExp "tok_RelationalOp_dummy_116" getRelationalOp ) (quoteJavaPat "tok_RelationalOp_dummy_116" getRelationalOp ) quoteJavaType quoteJavaDecs + +getShiftOp ( Ctr__Java__64 _ s) = s + +shiftOp :: QuasiQuoter +shiftOp = QuasiQuoter (quoteJavaExp "tok_ShiftOp_dummy_115" getShiftOp ) (quoteJavaPat "tok_ShiftOp_dummy_115" getShiftOp ) quoteJavaType quoteJavaDecs + +getStatement ( Ctr__Java__65 _ s) = s + +statement :: QuasiQuoter +statement = QuasiQuoter (quoteJavaExp "tok_Statement_dummy_114" getStatement ) (quoteJavaPat "tok_Statement_dummy_114" getStatement ) quoteJavaType quoteJavaDecs + +getStatementBlock ( Ctr__Java__66 _ s) = s + +statementBlock :: QuasiQuoter +statementBlock = QuasiQuoter (quoteJavaExp "tok_StatementBlock_dummy_113" getStatementBlock ) (quoteJavaPat "tok_StatementBlock_dummy_113" getStatementBlock ) quoteJavaType quoteJavaDecs + +getStatementList ( Ctr__Java__67 _ s) = s + +statementList :: QuasiQuoter +statementList = QuasiQuoter (quoteJavaExp "tok_StatementList_dummy_112" getStatementList ) (quoteJavaPat "tok_StatementList_dummy_112" getStatementList ) quoteJavaType quoteJavaDecs + +getStaticInitializer ( Ctr__Java__68 _ s) = s + +staticInitializer :: QuasiQuoter +staticInitializer = QuasiQuoter (quoteJavaExp "tok_StaticInitializer_dummy_111" getStaticInitializer ) (quoteJavaPat "tok_StaticInitializer_dummy_111" getStaticInitializer ) quoteJavaType quoteJavaDecs + +getSwitchCaseList ( Ctr__Java__69 _ s) = s + +switchCaseList :: QuasiQuoter +switchCaseList = QuasiQuoter (quoteJavaExp "tok_SwitchCaseList_dummy_110" getSwitchCaseList ) (quoteJavaPat "tok_SwitchCaseList_dummy_110" getSwitchCaseList ) quoteJavaType quoteJavaDecs + +getSwitchStatement ( Ctr__Java__70 _ s) = s + +switchStatement :: QuasiQuoter +switchStatement = QuasiQuoter (quoteJavaExp "tok_SwitchStatement_dummy_109" getSwitchStatement ) (quoteJavaPat "tok_SwitchStatement_dummy_109" getSwitchStatement ) quoteJavaType quoteJavaDecs + +getThrowsClause ( Ctr__Java__71 _ s) = s + +throwsClause :: QuasiQuoter +throwsClause = QuasiQuoter (quoteJavaExp "tok_ThrowsClause_dummy_108" getThrowsClause ) (quoteJavaPat "tok_ThrowsClause_dummy_108" getThrowsClause ) quoteJavaType quoteJavaDecs + +getTryStatement ( Ctr__Java__72 _ s) = s + +tryStatement :: QuasiQuoter +tryStatement = QuasiQuoter (quoteJavaExp "tok_TryStatement_dummy_107" getTryStatement ) (quoteJavaPat "tok_TryStatement_dummy_107" getTryStatement ) quoteJavaType quoteJavaDecs + +getType ( Ctr__Java__73 _ s) = s + +__type :: QuasiQuoter +__type = QuasiQuoter (quoteJavaExp "tok_Type_dummy_106" getType ) (quoteJavaPat "tok_Type_dummy_106" getType ) quoteJavaType quoteJavaDecs + +getTypeArgument ( Ctr__Java__74 _ s) = s + +typeArgument :: QuasiQuoter +typeArgument = QuasiQuoter (quoteJavaExp "tok_TypeArgument_dummy_105" getTypeArgument ) (quoteJavaPat "tok_TypeArgument_dummy_105" getTypeArgument ) quoteJavaType quoteJavaDecs + +getTypeArguments ( Ctr__Java__75 _ s) = s + +typeArguments :: QuasiQuoter +typeArguments = QuasiQuoter (quoteJavaExp "tok_TypeArguments_dummy_104" getTypeArguments ) (quoteJavaPat "tok_TypeArguments_dummy_104" getTypeArguments ) quoteJavaType quoteJavaDecs + +getTypeDeclRest ( Ctr__Java__76 _ s) = s + +typeDeclRest :: QuasiQuoter +typeDeclRest = QuasiQuoter (quoteJavaExp "tok_TypeDeclRest_dummy_103" getTypeDeclRest ) (quoteJavaPat "tok_TypeDeclRest_dummy_103" getTypeDeclRest ) quoteJavaType quoteJavaDecs + +getTypeDeclaration ( Ctr__Java__77 _ s) = s + +typeDeclaration :: QuasiQuoter +typeDeclaration = QuasiQuoter (quoteJavaExp "tok_TypeDeclaration_dummy_102" getTypeDeclaration ) (quoteJavaPat "tok_TypeDeclaration_dummy_102" getTypeDeclaration ) quoteJavaType quoteJavaDecs + +getTypeParameter ( Ctr__Java__78 _ s) = s + +typeParameter :: QuasiQuoter +typeParameter = QuasiQuoter (quoteJavaExp "tok_TypeParameter_dummy_101" getTypeParameter ) (quoteJavaPat "tok_TypeParameter_dummy_101" getTypeParameter ) quoteJavaType quoteJavaDecs + +getTypeParameters ( Ctr__Java__79 _ s) = s + +typeParameters :: QuasiQuoter +typeParameters = QuasiQuoter (quoteJavaExp "tok_TypeParameters_dummy_100" getTypeParameters ) (quoteJavaPat "tok_TypeParameters_dummy_100" getTypeParameters ) quoteJavaType quoteJavaDecs + +getTypeSpecifier ( Ctr__Java__80 _ s) = s + +typeSpecifier :: QuasiQuoter +typeSpecifier = QuasiQuoter (quoteJavaExp "tok_TypeSpecifier_dummy_99" getTypeSpecifier ) (quoteJavaPat "tok_TypeSpecifier_dummy_99" getTypeSpecifier ) quoteJavaType quoteJavaDecs + +getVariableDeclaration ( Ctr__Java__81 _ s) = s + +variableDeclaration :: QuasiQuoter +variableDeclaration = QuasiQuoter (quoteJavaExp "tok_VariableDeclaration_dummy_98" getVariableDeclaration ) (quoteJavaPat "tok_VariableDeclaration_dummy_98" getVariableDeclaration ) quoteJavaType quoteJavaDecs + +getVariableDeclarator ( Ctr__Java__82 _ s) = s + +variableDeclarator :: QuasiQuoter +variableDeclarator = QuasiQuoter (quoteJavaExp "tok_VariableDeclarator_dummy_97" getVariableDeclarator ) (quoteJavaPat "tok_VariableDeclarator_dummy_97" getVariableDeclarator ) quoteJavaType quoteJavaDecs + +getVariableDeclaratorList ( Ctr__Java__83 _ s) = s + +variableDeclaratorList :: QuasiQuoter +variableDeclaratorList = QuasiQuoter (quoteJavaExp "tok_VariableDeclaratorList_dummy_96" getVariableDeclaratorList ) (quoteJavaPat "tok_VariableDeclaratorList_dummy_96" getVariableDeclaratorList ) quoteJavaType quoteJavaDecs + +getVariableInitializer ( Ctr__Java__84 _ s) = s + +variableInitializer :: QuasiQuoter +variableInitializer = QuasiQuoter (quoteJavaExp "tok_VariableInitializer_dummy_95" getVariableInitializer ) (quoteJavaPat "tok_VariableInitializer_dummy_95" getVariableInitializer ) quoteJavaType quoteJavaDecs + +getVariableInitializerList ( Ctr__Java__85 _ s) = s + +variableInitializerList :: QuasiQuoter +variableInitializerList = QuasiQuoter (quoteJavaExp "tok_VariableInitializerList_dummy_94" getVariableInitializerList ) (quoteJavaPat "tok_VariableInitializerList_dummy_94" getVariableInitializerList ) quoteJavaType quoteJavaDecs + +getWhileStatement ( Ctr__Java__86 _ s) = s + +whileStatement :: QuasiQuoter +whileStatement = QuasiQuoter (quoteJavaExp "tok_WhileStatement_dummy_93" getWhileStatement ) (quoteJavaPat "tok_WhileStatement_dummy_93" getWhileStatement ) quoteJavaType quoteJavaDecs + +getWildcardType ( Ctr__Java__87 _ s) = s + +wildcardType :: QuasiQuoter +wildcardType = QuasiQuoter (quoteJavaExp "tok_WildcardType_dummy_92" getWildcardType ) (quoteJavaPat "tok_WildcardType_dummy_92" getWildcardType ) quoteJavaType quoteJavaDecs + diff --git a/test/golden/p/PLexer.x b/test/golden/p/PLexer.x new file mode 100644 --- /dev/null +++ b/test/golden/p/PLexer.x @@ -0,0 +1,118 @@ +-- Generated by RTK from grammar 'P'. Do not edit by hand. +{ +{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} +module PLexer(scanTokens, alexScanTokens, Token(..), PosToken(..), AlexPosn(..)) +where +import Data.Data (Data) + + } +%wrapper "monad" + + +tokens :- "tok_E_dummy_3" { simple Tk__tok_E_dummy_3 } + "tok_Id_dummy_2" { simple Tk__tok_Id_dummy_2 } + "tok_Op1_dummy_1" { simple Tk__tok_Op1_dummy_1 } + "tok_Op2_dummy_0" { simple Tk__tok_Op2_dummy_0 } + "tok_P_dummy_4" { simple Tk__tok_P_dummy_4 } + "xor" { simple Tk__tok_xor_14 } + "shr4" { simple Tk__tok_shr4_10 } + "shr16" { simple Tk__tok_shr16_11 } + "shr1" { simple Tk__tok_shr1_9 } + "shl1" { simple Tk__tok_shl1_8 } + "plus" { simple Tk__tok_plus_15 } + "or" { simple Tk__tok_or_13 } + "not" { simple Tk__tok_not_7 } + "lambda" { simple Tk__tok_lambda_1 } + "if0" { simple Tk__tok_if0_5 } + "fold" { simple Tk__tok_fold_6 } + "and" { simple Tk__tok_and_12 } + "1" { simple Tk__tok_1_4 } + "0" { simple Tk__tok_0_3 } + ")" { simple Tk__tok__rparen__2 } + "(" { simple Tk__tok__lparen__0 } + ([\ \t\n]+) ; + ([a-z] [a-z_0-9]*) { simple1 $ Tk__id . (id) } + ("$" "Id" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Id . ((tail . dropWhile (/= ':'))) } + ("$" "Op2" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Op2 . ((tail . dropWhile (/= ':'))) } + ("$" "Op1" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Op1 . ((tail . dropWhile (/= ':'))) } + ("$" "E" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_E . ((tail . dropWhile (/= ':'))) } + ("$" "P" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_P . ((tail . dropWhile (/= ':'))) } + . { rtkError } + +{ +data Token = EndOfFile | + Tk__tok_E_dummy_3 | + Tk__tok_Id_dummy_2 | + Tk__tok_Op1_dummy_1 | + Tk__tok_Op2_dummy_0 | + Tk__tok_P_dummy_4 | + Tk__tok_xor_14 | + Tk__tok_shr4_10 | + Tk__tok_shr16_11 | + Tk__tok_shr1_9 | + Tk__tok_shl1_8 | + Tk__tok_plus_15 | + Tk__tok_or_13 | + Tk__tok_not_7 | + Tk__tok_lambda_1 | + Tk__tok_if0_5 | + Tk__tok_fold_6 | + Tk__tok_and_12 | + Tk__tok_1_4 | + Tk__tok_0_3 | + Tk__tok__rparen__2 | + Tk__tok__lparen__0 | + Tk__id String | + Tk__qq_Id String | + Tk__qq_Op2 String | + Tk__qq_Op1 String | + Tk__qq_E String | + Tk__qq_P String + deriving (Show) + +-- AlexPosn is defined by the alex wrapper, so the Data instance (required by +-- the parser's RtkPos position type) can only be attached via standalone +-- deriving - the same solution as the hand-written Lexer.x +deriving instance Data AlexPosn + +-- A token together with the source position where it starts +data PosToken = PosToken { ptPos :: AlexPosn, ptToken :: Token } + deriving (Show) + +alexEOF = do + (pos, _, _, _) <- alexGetInput + return $ PosToken pos EndOfFile + +-- Lex the input into a token stream, returning the positioned error message +-- on a lexical error (encoded as "LINE:COL:message", see rtkError below). +-- The returned list always ends with an EndOfFile token that carries the +-- position of the end of input, so parse errors at end of input can be +-- reported with a position too +scanTokens :: String -> Either String [PosToken] +scanTokens str = runAlex str $ do + let loop toks = do tok <- alexMonadScan + case tok of + PosToken _ EndOfFile -> return $ reverse (tok : toks) + _ -> let toks' = tok : toks + in toks' `seq` loop toks' + loop [] + +-- Thin compatibility wrapper: callers that have not switched to 'scanTokens' +-- get the error message thrown instead +alexScanTokens :: String -> [PosToken] +alexScanTokens str = + case scanTokens str of + Right toks -> toks + Left err -> errorWithoutStackTrace err + +simple1 :: (String -> Token) -> AlexInput -> Int -> Alex PosToken +simple1 t (pos, _, _, str) len = return $ PosToken pos (t (take len str)) + +simple :: Token -> AlexInput -> Int -> Alex PosToken +simple t (pos, _, _, _) len = return $ PosToken pos t + +-- Encode the position as "LINE:COL:message" so callers can split it back out +-- into a structured position - the same encoding the rtk grammar lexer uses +rtkError ((AlexPn _ line column), _, _, str) len = alexError $ (show line) ++ ":" ++ (show column) ++ ":lexical error. Following chars: " ++ (take 10 str) + +} diff --git a/test/golden/p/PParser.y b/test/golden/p/PParser.y new file mode 100644 --- /dev/null +++ b/test/golden/p/PParser.y @@ -0,0 +1,236 @@ +-- Generated by RTK from grammar 'P'. Do not edit by hand. +{ +{-# LANGUAGE DeriveDataTypeable #-} +module PParser where +import qualified Data.Generics as Gen +import qualified PLexer as L (Token(..), PosToken(..), AlexPosn(..), alexScanTokens) +} + +%name parseP +%tokentype { L.PosToken } +%monad { Either String } +%error { parseError } + +%token + +rtk__eof { L.PosToken _ L.EndOfFile } +tok_E_dummy_3 { L.PosToken _ L.Tk__tok_E_dummy_3 } +tok_Id_dummy_2 { L.PosToken _ L.Tk__tok_Id_dummy_2 } +tok_Op1_dummy_1 { L.PosToken _ L.Tk__tok_Op1_dummy_1 } +tok_Op2_dummy_0 { L.PosToken _ L.Tk__tok_Op2_dummy_0 } +tok_P_dummy_4 { L.PosToken _ L.Tk__tok_P_dummy_4 } +tok_xor_14 { L.PosToken _ L.Tk__tok_xor_14 } +tok_shr4_10 { L.PosToken _ L.Tk__tok_shr4_10 } +tok_shr16_11 { L.PosToken _ L.Tk__tok_shr16_11 } +tok_shr1_9 { L.PosToken _ L.Tk__tok_shr1_9 } +tok_shl1_8 { L.PosToken _ L.Tk__tok_shl1_8 } +tok_plus_15 { L.PosToken _ L.Tk__tok_plus_15 } +tok_or_13 { L.PosToken _ L.Tk__tok_or_13 } +tok_not_7 { L.PosToken _ L.Tk__tok_not_7 } +tok_lambda_1 { L.PosToken _ L.Tk__tok_lambda_1 } +tok_if0_5 { L.PosToken _ L.Tk__tok_if0_5 } +tok_fold_6 { L.PosToken _ L.Tk__tok_fold_6 } +tok_and_12 { L.PosToken _ L.Tk__tok_and_12 } +tok_1_4 { L.PosToken _ L.Tk__tok_1_4 } +tok_0_3 { L.PosToken _ L.Tk__tok_0_3 } +tok__rparen__2 { L.PosToken _ L.Tk__tok__rparen__2 } +tok__lparen__0 { L.PosToken _ L.Tk__tok__lparen__0 } +id { L.PosToken _ (L.Tk__id _) } +qq_Id { L.PosToken _ (L.Tk__qq_Id _) } +qq_Op2 { L.PosToken _ (L.Tk__qq_Op2 _) } +qq_Op1 { L.PosToken _ (L.Tk__qq_Op1 _) } +qq_E { L.PosToken _ (L.Tk__qq_E _) } +qq_P { L.PosToken _ (L.Tk__qq_P _) } + +%% + +P__top : P rtk__eof { $1 } + +P : tok_P_dummy_4 P tok_P_dummy_4 { Ctr__P__0 (rtkPosOf $1) $2 } | + tok_E_dummy_3 E tok_E_dummy_3 { Ctr__P__1 (rtkPosOf $1) $2 } | + tok_Id_dummy_2 Id tok_Id_dummy_2 { Ctr__P__2 (rtkPosOf $1) $2 } | + tok_Op1_dummy_1 Op1 tok_Op1_dummy_1 { Ctr__P__3 (rtkPosOf $1) $2 } | + tok_Op2_dummy_0 Op2 tok_Op2_dummy_0 { Ctr__P__4 (rtkPosOf $1) $2 } + +P : qq_P { Anti_P (tkVal_qq_P $1) } | + tok__lparen__0 tok_lambda_1 tok__lparen__0 Id tok__rparen__2 E tok__rparen__2 { Ctr__P__5 (rtkPosOf $1) $4 $6 } + +E : qq_E { Anti_E (tkVal_qq_E $1) } | + tok_0_3 { Ctr__E__0 (rtkPosOf $1) } | + tok_1_4 { Ctr__E__1 (rtkPosOf $1) } | + Id { Ctr__E__2 (rtkPosOf $1) $1 } | + tok__lparen__0 tok_if0_5 E E E tok__rparen__2 { Ctr__E__3 (rtkPosOf $1) $3 $4 $5 } | + tok__lparen__0 tok_fold_6 E E tok__lparen__0 tok_lambda_1 tok__lparen__0 Id Id tok__rparen__2 E tok__rparen__2 tok__rparen__2 { Ctr__E__4 (rtkPosOf $1) $3 $4 $8 $9 $11 } | + tok__lparen__0 Op1 E tok__rparen__2 { Ctr__E__5 (rtkPosOf $1) $2 $3 } | + tok__lparen__0 Op2 E E tok__rparen__2 { Ctr__E__6 (rtkPosOf $1) $2 $3 $4 } + +Id : qq_Id { Anti_Id (tkVal_qq_Id $1) } | + id { Ctr__Id__0 (rtkPosOf $1) (tkVal_id $1) } + +Op1 : qq_Op1 { Anti_Op1 (tkVal_qq_Op1 $1) } | + tok_not_7 { Ctr__Op1__0 (rtkPosOf $1) } | + tok_shl1_8 { Ctr__Op1__1 (rtkPosOf $1) } | + tok_shr1_9 { Ctr__Op1__2 (rtkPosOf $1) } | + tok_shr4_10 { Ctr__Op1__3 (rtkPosOf $1) } | + tok_shr16_11 { Ctr__Op1__4 (rtkPosOf $1) } + +Op2 : qq_Op2 { Anti_Op2 (tkVal_qq_Op2 $1) } | + tok_and_12 { Ctr__Op2__0 (rtkPosOf $1) } | + tok_or_13 { Ctr__Op2__1 (rtkPosOf $1) } | + tok_xor_14 { Ctr__Op2__2 (rtkPosOf $1) } | + tok_plus_15 { Ctr__Op2__3 (rtkPosOf $1) } + + +{ +parseError :: [L.PosToken] -> Either String a +parseError [] = Left "unexpected end of input" +parseError (L.PosToken (L.AlexPn _ line col) tok : _) = + Left $ show line ++ ":" ++ show col ++ ":unexpected " ++ showRtkToken tok + +-- Render a token the way it appears in the source, for error messages +showRtkToken :: L.Token -> String +showRtkToken L.EndOfFile = "end of input" +showRtkToken L.Tk__tok_E_dummy_3 = "'tok_E_dummy_3'" +showRtkToken L.Tk__tok_Id_dummy_2 = "'tok_Id_dummy_2'" +showRtkToken L.Tk__tok_Op1_dummy_1 = "'tok_Op1_dummy_1'" +showRtkToken L.Tk__tok_Op2_dummy_0 = "'tok_Op2_dummy_0'" +showRtkToken L.Tk__tok_P_dummy_4 = "'tok_P_dummy_4'" +showRtkToken L.Tk__tok_xor_14 = "'xor'" +showRtkToken L.Tk__tok_shr4_10 = "'shr4'" +showRtkToken L.Tk__tok_shr16_11 = "'shr16'" +showRtkToken L.Tk__tok_shr1_9 = "'shr1'" +showRtkToken L.Tk__tok_shl1_8 = "'shl1'" +showRtkToken L.Tk__tok_plus_15 = "'plus'" +showRtkToken L.Tk__tok_or_13 = "'or'" +showRtkToken L.Tk__tok_not_7 = "'not'" +showRtkToken L.Tk__tok_lambda_1 = "'lambda'" +showRtkToken L.Tk__tok_if0_5 = "'if0'" +showRtkToken L.Tk__tok_fold_6 = "'fold'" +showRtkToken L.Tk__tok_and_12 = "'and'" +showRtkToken L.Tk__tok_1_4 = "'1'" +showRtkToken L.Tk__tok_0_3 = "'0'" +showRtkToken L.Tk__tok__rparen__2 = "')'" +showRtkToken L.Tk__tok__lparen__0 = "'('" +showRtkToken (L.Tk__id v) = "id " ++ show v +showRtkToken (L.Tk__qq_Id v) = "qq_Id " ++ show v +showRtkToken (L.Tk__qq_Op2 v) = "qq_Op2 " ++ show v +showRtkToken (L.Tk__qq_Op1 v) = "qq_Op1 " ++ show v +showRtkToken (L.Tk__qq_E v) = "qq_E " ++ show v +showRtkToken (L.Tk__qq_P v) = "qq_P " ++ show v + +-- Source position of a node: every constructor except the Anti_* splice +-- artifacts stores the position of its alternative's first symbol in its +-- first field. Positions are transparent for equality and ordering, so two +-- ASTs that differ only in source positions (e.g. a quasi-quote parsed at +-- compile time vs the same construct parsed at run time) compare equal. +newtype RtkPos = RtkPos L.AlexPosn deriving (Show, Gen.Data, Gen.Typeable) +instance Eq RtkPos where _ == _ = True +instance Ord RtkPos where compare _ _ = EQ + +-- The position used where no source token exists: empty productions, empty +-- lists, absent optionals and Anti_* quasi-quote splices +rtkNoPos :: RtkPos +rtkNoPos = RtkPos (L.AlexPn 0 0 0) + +class RtkPosOf a where + rtkPosOf :: a -> RtkPos +instance RtkPosOf L.PosToken where + rtkPosOf (L.PosToken p _) = RtkPos p +instance RtkPosOf a => RtkPosOf [a] where + rtkPosOf (x : _) = rtkPosOf x + rtkPosOf [] = rtkNoPos +instance RtkPosOf a => RtkPosOf (Maybe a) where + rtkPosOf (Just x) = rtkPosOf x + rtkPosOf Nothing = rtkNoPos +-- A Char carries no position; this also covers String token payloads +instance RtkPosOf Char where + rtkPosOf _ = rtkNoPos + +-- Recover a token's payload from the whole positioned token: %token +-- bindings keep the L.PosToken so semantic actions can read its position +tkVal_id :: L.PosToken -> String +tkVal_id (L.PosToken _ (L.Tk__id v)) = v +tkVal_id t = error ("rtk internal error: token id expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Id :: L.PosToken -> String +tkVal_qq_Id (L.PosToken _ (L.Tk__qq_Id v)) = v +tkVal_qq_Id t = error ("rtk internal error: token qq_Id expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Op2 :: L.PosToken -> String +tkVal_qq_Op2 (L.PosToken _ (L.Tk__qq_Op2 v)) = v +tkVal_qq_Op2 t = error ("rtk internal error: token qq_Op2 expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Op1 :: L.PosToken -> String +tkVal_qq_Op1 (L.PosToken _ (L.Tk__qq_Op1 v)) = v +tkVal_qq_Op1 t = error ("rtk internal error: token qq_Op1 expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_E :: L.PosToken -> String +tkVal_qq_E (L.PosToken _ (L.Tk__qq_E v)) = v +tkVal_qq_E t = error ("rtk internal error: token qq_E expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_P :: L.PosToken -> String +tkVal_qq_P (L.PosToken _ (L.Tk__qq_P v)) = v +tkVal_qq_P t = error ("rtk internal error: token qq_P expected, got " ++ showRtkToken (L.ptToken t)) + +data P = Ctr__P__0 RtkPos P | + Ctr__P__1 RtkPos E | + Ctr__P__2 RtkPos Id | + Ctr__P__3 RtkPos Op1 | + Ctr__P__4 RtkPos Op2 | + Anti_P String | + Ctr__P__5 RtkPos Id E + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf P where + rtkPosOf (Ctr__P__0 p _) = p + rtkPosOf (Ctr__P__1 p _) = p + rtkPosOf (Ctr__P__2 p _) = p + rtkPosOf (Ctr__P__3 p _) = p + rtkPosOf (Ctr__P__4 p _) = p + rtkPosOf (Anti_P _) = rtkNoPos + rtkPosOf (Ctr__P__5 p _ _) = p +data E = Anti_E String | + Ctr__E__0 RtkPos | + Ctr__E__1 RtkPos | + Ctr__E__2 RtkPos Id | + Ctr__E__3 RtkPos E E E | + Ctr__E__4 RtkPos E E Id Id E | + Ctr__E__5 RtkPos Op1 E | + Ctr__E__6 RtkPos Op2 E E + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf E where + rtkPosOf (Anti_E _) = rtkNoPos + rtkPosOf (Ctr__E__0 p) = p + rtkPosOf (Ctr__E__1 p) = p + rtkPosOf (Ctr__E__2 p _) = p + rtkPosOf (Ctr__E__3 p _ _ _) = p + rtkPosOf (Ctr__E__4 p _ _ _ _ _) = p + rtkPosOf (Ctr__E__5 p _ _) = p + rtkPosOf (Ctr__E__6 p _ _ _) = p +data Id = Anti_Id String | + Ctr__Id__0 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Id where + rtkPosOf (Anti_Id _) = rtkNoPos + rtkPosOf (Ctr__Id__0 p _) = p +data Op1 = Anti_Op1 String | + Ctr__Op1__0 RtkPos | + Ctr__Op1__1 RtkPos | + Ctr__Op1__2 RtkPos | + Ctr__Op1__3 RtkPos | + Ctr__Op1__4 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Op1 where + rtkPosOf (Anti_Op1 _) = rtkNoPos + rtkPosOf (Ctr__Op1__0 p) = p + rtkPosOf (Ctr__Op1__1 p) = p + rtkPosOf (Ctr__Op1__2 p) = p + rtkPosOf (Ctr__Op1__3 p) = p + rtkPosOf (Ctr__Op1__4 p) = p +data Op2 = Anti_Op2 String | + Ctr__Op2__0 RtkPos | + Ctr__Op2__1 RtkPos | + Ctr__Op2__2 RtkPos | + Ctr__Op2__3 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Op2 where + rtkPosOf (Anti_Op2 _) = rtkNoPos + rtkPosOf (Ctr__Op2__0 p) = p + rtkPosOf (Ctr__Op2__1 p) = p + rtkPosOf (Ctr__Op2__2 p) = p + rtkPosOf (Ctr__Op2__3 p) = p +} diff --git a/test/golden/p/PQQ.hs b/test/golden/p/PQQ.hs new file mode 100644 --- /dev/null +++ b/test/golden/p/PQQ.hs @@ -0,0 +1,174 @@ +-- Generated by RTK from grammar 'P'. Do not edit by hand. +{-# LANGUAGE TemplateHaskell #-} +module PQQ +where + +import qualified Data.Char as C +import qualified Data.Map as M +import Data.List +import Data.Maybe +import qualified Data.Generics as Generics +import qualified Data.Data as Data +import qualified Language.Haskell.TH as TH +import Language.Haskell.TH.Quote +import PLexer +import PParser + +qqShortcuts :: M.Map String String + +-- A $name metavariable is rewritten to $Type:name using the qqShortcuts +-- table below. The rewrite is purely textual, so it would also fire inside +-- the quoted language's own string literals: write $$name there to escape +-- it and get the literal text $name. Each '$$' pair directly before a +-- metavariable stands for one literal '$' (so $$$x is a literal '$' +-- followed by the metavariable $x). A '$' not followed by an identifier is +-- never rewritten and needs no escape, and an explicit $Type:name antiquote +-- (the character after the name is ':') passes through untouched. +-- A plain character scan rather than a regex: metavariables are recognized +-- regardless of what follows the name - including a newline or the end of +-- the quote, which the previous regex's terminator class missed. +replaceAllPatterns :: String -> Either String String +replaceAllPatterns [] = Right [] +replaceAllPatterns s@('$' : _) = + let (dollars, rest) = span (== '$') s + in case rest of + (c1 : _) | C.isAlpha c1 || c1 == '_' -> + let (varName, post) = span (\ ch -> C.isAlphaNum ch || ch == '_') rest + escCount = length dollars - 1 + keptPre = replicate (div escCount 2) '$' + in case post of + (':' : _) -> ((dollars ++ varName) ++) <$> replaceAllPatterns post + _ | odd escCount -> ((keptPre ++ '$' : varName) ++) <$> replaceAllPatterns post + _ -> case catMaybes $ map (\ prefix -> M.lookup prefix qqShortcuts) $ reverse $ inits varName of + [] -> Left $ unlines + [ "Unknown metavariable $" ++ varName ++ " in quasi-quote:" + , "no prefix of '" ++ varName ++ "' is a known shortcut. Known shortcuts:" + , " " ++ intercalate ", " (M.keys qqShortcuts) + , "To include the literal text $" ++ varName ++ " in the quoted code" + , "(e.g. inside a string literal), escape it as $$" ++ varName ++ "." ] + (rule : _) -> ((keptPre ++ '$' : rule ++ ":" ++ varName) ++) <$> replaceAllPatterns post + _ -> (dollars ++) <$> replaceAllPatterns rest +replaceAllPatterns (c : rest) = (c :) <$> replaceAllPatterns rest + +-- The generated lexer and parser encode error positions as "LINE:COL:message" +-- so structured-diagnostic callers can split them; render them back +-- human-readably for quasi-quote compile errors. Positions refer to the quote +-- body (padded with a start token in front). +rtkRenderError :: String -> String +rtkRenderError err = + case span (/= ':') err of + (l, ':' : rest1) | [(line, "")] <- (reads l :: [(Int, String)]) -> + case span (/= ':') rest1 of + (c, ':' : msg) | [(col, "")] <- (reads c :: [(Int, String)]) -> + "line " ++ show line ++ ", column " ++ show col ++ ": " ++ msg + _ -> err + _ -> err + +qqShortcuts = M.fromList [ ("p","P"),("e","E"),("id","Id"),("op1","Op1"),("op2","Op2")] + +-- A quasi-quote pattern must match an AST parsed from anywhere in a source +-- file, while the pattern itself was parsed from the quote body - so every +-- RtkPos position field becomes a wildcard in generated patterns. +-- (Expressions need no special case: the compile-time position they embed +-- is equality-transparent.) +rtkPosWildPat :: RtkPos -> Maybe (TH.Q TH.Pat) +rtkPosWildPat _ = Just TH.wildP + +quotePExp :: Data.Data a => String -> (P -> a) -> String -> TH.ExpQ +quotePExp dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseP of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToExpQ (const Nothing `Generics.extQ` antiPExp `Generics.extQ` antiEExp `Generics.extQ` antiOp1Exp `Generics.extQ` antiOp2Exp `Generics.extQ` antiIdExp) expr +quotePPat :: Data.Data a => String -> (P -> a) -> String -> TH.PatQ +quotePPat dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseP of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToPatQ (const Nothing `Generics.extQ` rtkPosWildPat `Generics.extQ` antiPPat `Generics.extQ` antiEPat `Generics.extQ` antiOp1Pat `Generics.extQ` antiOp2Pat `Generics.extQ` antiIdPat) expr + +antiIdExp :: Id -> Maybe (TH.Q TH.Exp ) +antiIdExp ( Anti_Id v) = Just $ TH.varE (TH.mkName v) +antiIdExp _ = Nothing + + +antiOp2Exp :: Op2 -> Maybe (TH.Q TH.Exp ) +antiOp2Exp ( Anti_Op2 v) = Just $ TH.varE (TH.mkName v) +antiOp2Exp _ = Nothing + + +antiOp1Exp :: Op1 -> Maybe (TH.Q TH.Exp ) +antiOp1Exp ( Anti_Op1 v) = Just $ TH.varE (TH.mkName v) +antiOp1Exp _ = Nothing + + +antiEExp :: E -> Maybe (TH.Q TH.Exp ) +antiEExp ( Anti_E v) = Just $ TH.varE (TH.mkName v) +antiEExp _ = Nothing + + +antiPExp :: P -> Maybe (TH.Q TH.Exp ) +antiPExp ( Anti_P v) = Just $ TH.varE (TH.mkName v) +antiPExp _ = Nothing + + + +antiIdPat :: Id -> Maybe (TH.Q TH.Pat ) +antiIdPat ( Anti_Id v) = Just $ TH.varP (TH.mkName v) +antiIdPat _ = Nothing + + +antiOp2Pat :: Op2 -> Maybe (TH.Q TH.Pat ) +antiOp2Pat ( Anti_Op2 v) = Just $ TH.varP (TH.mkName v) +antiOp2Pat _ = Nothing + + +antiOp1Pat :: Op1 -> Maybe (TH.Q TH.Pat ) +antiOp1Pat ( Anti_Op1 v) = Just $ TH.varP (TH.mkName v) +antiOp1Pat _ = Nothing + + +antiEPat :: E -> Maybe (TH.Q TH.Pat ) +antiEPat ( Anti_E v) = Just $ TH.varP (TH.mkName v) +antiEPat _ = Nothing + + +antiPPat :: P -> Maybe (TH.Q TH.Pat ) +antiPPat ( Anti_P v) = Just $ TH.varP (TH.mkName v) +antiPPat _ = Nothing + + + +-- This grammar's quasi-quoters work in expression and pattern contexts only +quotePType _ = fail "this quasi-quoter cannot be used in a type context" +quotePDecs _ = fail "this quasi-quoter cannot be used in a declaration context" + +getP ( Ctr__P__0 _ s) = s + +p :: QuasiQuoter +p = QuasiQuoter (quotePExp "tok_P_dummy_4" getP ) (quotePPat "tok_P_dummy_4" getP ) quotePType quotePDecs + +getE ( Ctr__P__1 _ s) = s + +e :: QuasiQuoter +e = QuasiQuoter (quotePExp "tok_E_dummy_3" getE ) (quotePPat "tok_E_dummy_3" getE ) quotePType quotePDecs + +getId ( Ctr__P__2 _ s) = s + +id :: QuasiQuoter +id = QuasiQuoter (quotePExp "tok_Id_dummy_2" getId ) (quotePPat "tok_Id_dummy_2" getId ) quotePType quotePDecs + +getOp1 ( Ctr__P__3 _ s) = s + +op1 :: QuasiQuoter +op1 = QuasiQuoter (quotePExp "tok_Op1_dummy_1" getOp1 ) (quotePPat "tok_Op1_dummy_1" getOp1 ) quotePType quotePDecs + +getOp2 ( Ctr__P__4 _ s) = s + +op2 :: QuasiQuoter +op2 = QuasiQuoter (quotePExp "tok_Op2_dummy_0" getOp2 ) (quotePPat "tok_Op2_dummy_0" getOp2 ) quotePType quotePDecs + diff --git a/test/golden/sandbox/SandboxLexer.x b/test/golden/sandbox/SandboxLexer.x new file mode 100644 --- /dev/null +++ b/test/golden/sandbox/SandboxLexer.x @@ -0,0 +1,72 @@ +-- Generated by RTK from grammar 'Sandbox'. Do not edit by hand. +{ +{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} +module SandboxLexer(scanTokens, alexScanTokens, Token(..), PosToken(..), AlexPosn(..)) +where +import Data.Data (Data) + + } +%wrapper "monad" + + +tokens :- "tok_Sandbox_dummy_0" { simple Tk__tok_Sandbox_dummy_0 } + ("/*" ([^\*]| [\*] [^\/]| [\n])* "*/") ; + ("//" .*) ; + ([\ \t\n\r]+) ; + ("/**" ([^\*]| [\*] [^\/]| [\n])* "*/") { simple1 $ Tk__doccomment . (id) } + ("$" "Sandbox" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_Sandbox . ((tail . dropWhile (/= ':'))) } + . { rtkError } + +{ +data Token = EndOfFile | + Tk__tok_Sandbox_dummy_0 | + Tk__doccomment String | + Tk__qq_Sandbox String + deriving (Show) + +-- AlexPosn is defined by the alex wrapper, so the Data instance (required by +-- the parser's RtkPos position type) can only be attached via standalone +-- deriving - the same solution as the hand-written Lexer.x +deriving instance Data AlexPosn + +-- A token together with the source position where it starts +data PosToken = PosToken { ptPos :: AlexPosn, ptToken :: Token } + deriving (Show) + +alexEOF = do + (pos, _, _, _) <- alexGetInput + return $ PosToken pos EndOfFile + +-- Lex the input into a token stream, returning the positioned error message +-- on a lexical error (encoded as "LINE:COL:message", see rtkError below). +-- The returned list always ends with an EndOfFile token that carries the +-- position of the end of input, so parse errors at end of input can be +-- reported with a position too +scanTokens :: String -> Either String [PosToken] +scanTokens str = runAlex str $ do + let loop toks = do tok <- alexMonadScan + case tok of + PosToken _ EndOfFile -> return $ reverse (tok : toks) + _ -> let toks' = tok : toks + in toks' `seq` loop toks' + loop [] + +-- Thin compatibility wrapper: callers that have not switched to 'scanTokens' +-- get the error message thrown instead +alexScanTokens :: String -> [PosToken] +alexScanTokens str = + case scanTokens str of + Right toks -> toks + Left err -> errorWithoutStackTrace err + +simple1 :: (String -> Token) -> AlexInput -> Int -> Alex PosToken +simple1 t (pos, _, _, str) len = return $ PosToken pos (t (take len str)) + +simple :: Token -> AlexInput -> Int -> Alex PosToken +simple t (pos, _, _, _) len = return $ PosToken pos t + +-- Encode the position as "LINE:COL:message" so callers can split it back out +-- into a structured position - the same encoding the rtk grammar lexer uses +rtkError ((AlexPn _ line column), _, _, str) len = alexError $ (show line) ++ ":" ++ (show column) ++ ":lexical error. Following chars: " ++ (take 10 str) + +} diff --git a/test/golden/sandbox/SandboxParser.y b/test/golden/sandbox/SandboxParser.y new file mode 100644 --- /dev/null +++ b/test/golden/sandbox/SandboxParser.y @@ -0,0 +1,89 @@ +-- Generated by RTK from grammar 'Sandbox'. Do not edit by hand. +{ +{-# LANGUAGE DeriveDataTypeable #-} +module SandboxParser where +import qualified Data.Generics as Gen +import qualified SandboxLexer as L (Token(..), PosToken(..), AlexPosn(..), alexScanTokens) +} + +%name parseSandbox +%tokentype { L.PosToken } +%monad { Either String } +%error { parseError } + +%token + +rtk__eof { L.PosToken _ L.EndOfFile } +tok_Sandbox_dummy_0 { L.PosToken _ L.Tk__tok_Sandbox_dummy_0 } +doccomment { L.PosToken _ (L.Tk__doccomment _) } +qq_Sandbox { L.PosToken _ (L.Tk__qq_Sandbox _) } + +%% + +Sandbox__top : Sandbox rtk__eof { $1 } + +Sandbox : tok_Sandbox_dummy_0 Sandbox tok_Sandbox_dummy_0 { Ctr__Sandbox__0 (rtkPosOf $1) $2 } + +Sandbox : qq_Sandbox { Anti_Sandbox (tkVal_qq_Sandbox $1) } | + doccomment { Ctr__Sandbox__1 (rtkPosOf $1) (tkVal_doccomment $1) } + + +{ +parseError :: [L.PosToken] -> Either String a +parseError [] = Left "unexpected end of input" +parseError (L.PosToken (L.AlexPn _ line col) tok : _) = + Left $ show line ++ ":" ++ show col ++ ":unexpected " ++ showRtkToken tok + +-- Render a token the way it appears in the source, for error messages +showRtkToken :: L.Token -> String +showRtkToken L.EndOfFile = "end of input" +showRtkToken L.Tk__tok_Sandbox_dummy_0 = "'tok_Sandbox_dummy_0'" +showRtkToken (L.Tk__doccomment v) = "doccomment " ++ show v +showRtkToken (L.Tk__qq_Sandbox v) = "qq_Sandbox " ++ show v + +-- Source position of a node: every constructor except the Anti_* splice +-- artifacts stores the position of its alternative's first symbol in its +-- first field. Positions are transparent for equality and ordering, so two +-- ASTs that differ only in source positions (e.g. a quasi-quote parsed at +-- compile time vs the same construct parsed at run time) compare equal. +newtype RtkPos = RtkPos L.AlexPosn deriving (Show, Gen.Data, Gen.Typeable) +instance Eq RtkPos where _ == _ = True +instance Ord RtkPos where compare _ _ = EQ + +-- The position used where no source token exists: empty productions, empty +-- lists, absent optionals and Anti_* quasi-quote splices +rtkNoPos :: RtkPos +rtkNoPos = RtkPos (L.AlexPn 0 0 0) + +class RtkPosOf a where + rtkPosOf :: a -> RtkPos +instance RtkPosOf L.PosToken where + rtkPosOf (L.PosToken p _) = RtkPos p +instance RtkPosOf a => RtkPosOf [a] where + rtkPosOf (x : _) = rtkPosOf x + rtkPosOf [] = rtkNoPos +instance RtkPosOf a => RtkPosOf (Maybe a) where + rtkPosOf (Just x) = rtkPosOf x + rtkPosOf Nothing = rtkNoPos +-- A Char carries no position; this also covers String token payloads +instance RtkPosOf Char where + rtkPosOf _ = rtkNoPos + +-- Recover a token's payload from the whole positioned token: %token +-- bindings keep the L.PosToken so semantic actions can read its position +tkVal_doccomment :: L.PosToken -> String +tkVal_doccomment (L.PosToken _ (L.Tk__doccomment v)) = v +tkVal_doccomment t = error ("rtk internal error: token doccomment expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_Sandbox :: L.PosToken -> String +tkVal_qq_Sandbox (L.PosToken _ (L.Tk__qq_Sandbox v)) = v +tkVal_qq_Sandbox t = error ("rtk internal error: token qq_Sandbox expected, got " ++ showRtkToken (L.ptToken t)) + +data Sandbox = Ctr__Sandbox__0 RtkPos Sandbox | + Anti_Sandbox String | + Ctr__Sandbox__1 RtkPos String + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Sandbox where + rtkPosOf (Ctr__Sandbox__0 p _) = p + rtkPosOf (Anti_Sandbox _) = rtkNoPos + rtkPosOf (Ctr__Sandbox__1 p _) = p +} diff --git a/test/golden/sandbox/SandboxQQ.hs b/test/golden/sandbox/SandboxQQ.hs new file mode 100644 --- /dev/null +++ b/test/golden/sandbox/SandboxQQ.hs @@ -0,0 +1,114 @@ +-- Generated by RTK from grammar 'Sandbox'. Do not edit by hand. +{-# LANGUAGE TemplateHaskell #-} +module SandboxQQ +where + +import qualified Data.Char as C +import qualified Data.Map as M +import Data.List +import Data.Maybe +import qualified Data.Generics as Generics +import qualified Data.Data as Data +import qualified Language.Haskell.TH as TH +import Language.Haskell.TH.Quote +import SandboxLexer +import SandboxParser + +qqShortcuts :: M.Map String String + +-- A $name metavariable is rewritten to $Type:name using the qqShortcuts +-- table below. The rewrite is purely textual, so it would also fire inside +-- the quoted language's own string literals: write $$name there to escape +-- it and get the literal text $name. Each '$$' pair directly before a +-- metavariable stands for one literal '$' (so $$$x is a literal '$' +-- followed by the metavariable $x). A '$' not followed by an identifier is +-- never rewritten and needs no escape, and an explicit $Type:name antiquote +-- (the character after the name is ':') passes through untouched. +-- A plain character scan rather than a regex: metavariables are recognized +-- regardless of what follows the name - including a newline or the end of +-- the quote, which the previous regex's terminator class missed. +replaceAllPatterns :: String -> Either String String +replaceAllPatterns [] = Right [] +replaceAllPatterns s@('$' : _) = + let (dollars, rest) = span (== '$') s + in case rest of + (c1 : _) | C.isAlpha c1 || c1 == '_' -> + let (varName, post) = span (\ ch -> C.isAlphaNum ch || ch == '_') rest + escCount = length dollars - 1 + keptPre = replicate (div escCount 2) '$' + in case post of + (':' : _) -> ((dollars ++ varName) ++) <$> replaceAllPatterns post + _ | odd escCount -> ((keptPre ++ '$' : varName) ++) <$> replaceAllPatterns post + _ -> case catMaybes $ map (\ prefix -> M.lookup prefix qqShortcuts) $ reverse $ inits varName of + [] -> Left $ unlines + [ "Unknown metavariable $" ++ varName ++ " in quasi-quote:" + , "no prefix of '" ++ varName ++ "' is a known shortcut. Known shortcuts:" + , " " ++ intercalate ", " (M.keys qqShortcuts) + , "To include the literal text $" ++ varName ++ " in the quoted code" + , "(e.g. inside a string literal), escape it as $$" ++ varName ++ "." ] + (rule : _) -> ((keptPre ++ '$' : rule ++ ":" ++ varName) ++) <$> replaceAllPatterns post + _ -> (dollars ++) <$> replaceAllPatterns rest +replaceAllPatterns (c : rest) = (c :) <$> replaceAllPatterns rest + +-- The generated lexer and parser encode error positions as "LINE:COL:message" +-- so structured-diagnostic callers can split them; render them back +-- human-readably for quasi-quote compile errors. Positions refer to the quote +-- body (padded with a start token in front). +rtkRenderError :: String -> String +rtkRenderError err = + case span (/= ':') err of + (l, ':' : rest1) | [(line, "")] <- (reads l :: [(Int, String)]) -> + case span (/= ':') rest1 of + (c, ':' : msg) | [(col, "")] <- (reads c :: [(Int, String)]) -> + "line " ++ show line ++ ", column " ++ show col ++ ": " ++ msg + _ -> err + _ -> err + +qqShortcuts = M.fromList [ ("sandbox","Sandbox")] + +-- A quasi-quote pattern must match an AST parsed from anywhere in a source +-- file, while the pattern itself was parsed from the quote body - so every +-- RtkPos position field becomes a wildcard in generated patterns. +-- (Expressions need no special case: the compile-time position they embed +-- is equality-transparent.) +rtkPosWildPat :: RtkPos -> Maybe (TH.Q TH.Pat) +rtkPosWildPat _ = Just TH.wildP + +quoteSandboxExp :: Data.Data a => String -> (Sandbox -> a) -> String -> TH.ExpQ +quoteSandboxExp dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseSandbox of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToExpQ (const Nothing `Generics.extQ` antiSandboxExp) expr +quoteSandboxPat :: Data.Data a => String -> (Sandbox -> a) -> String -> TH.PatQ +quoteSandboxPat dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseSandbox of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToPatQ (const Nothing `Generics.extQ` rtkPosWildPat `Generics.extQ` antiSandboxPat) expr + +antiSandboxExp :: Sandbox -> Maybe (TH.Q TH.Exp ) +antiSandboxExp ( Anti_Sandbox v) = Just $ TH.varE (TH.mkName v) +antiSandboxExp _ = Nothing + + + +antiSandboxPat :: Sandbox -> Maybe (TH.Q TH.Pat ) +antiSandboxPat ( Anti_Sandbox v) = Just $ TH.varP (TH.mkName v) +antiSandboxPat _ = Nothing + + + +-- This grammar's quasi-quoters work in expression and pattern contexts only +quoteSandboxType _ = fail "this quasi-quoter cannot be used in a type context" +quoteSandboxDecs _ = fail "this quasi-quoter cannot be used in a declaration context" + +getSandbox ( Ctr__Sandbox__0 _ s) = s + +sandbox :: QuasiQuoter +sandbox = QuasiQuoter (quoteSandboxExp "tok_Sandbox_dummy_0" getSandbox ) (quoteSandboxPat "tok_Sandbox_dummy_0" getSandbox ) quoteSandboxType quoteSandboxDecs + diff --git a/test/golden/t1/T1Lexer.x b/test/golden/t1/T1Lexer.x new file mode 100644 --- /dev/null +++ b/test/golden/t1/T1Lexer.x @@ -0,0 +1,113 @@ +-- Generated by RTK from grammar 'T1'. Do not edit by hand. +{ +{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} +module T1Lexer(scanTokens, alexScanTokens, Token(..), PosToken(..), AlexPosn(..)) +where +import Data.Data (Data) + + } +%wrapper "monad" + + +tokens :- "tok_A_dummy_17" { simple Tk__tok_A_dummy_17 } + "tok_B_dummy_16" { simple Tk__tok_B_dummy_16 } + "tok_C_dummy_15" { simple Tk__tok_C_dummy_15 } + "tok_D_dummy_14" { simple Tk__tok_D_dummy_14 } + "tok_E_dummy_13" { simple Tk__tok_E_dummy_13 } + "tok_F1_dummy_12" { simple Tk__tok_F1_dummy_12 } + "tok_F2_dummy_11" { simple Tk__tok_F2_dummy_11 } + "tok_F3_dummy_10" { simple Tk__tok_F3_dummy_10 } + "tok_F4_dummy_9" { simple Tk__tok_F4_dummy_9 } + "tok_F5_dummy_8" { simple Tk__tok_F5_dummy_8 } + "tok_G_dummy_7" { simple Tk__tok_G_dummy_7 } + "b" { simple Tk__tok_b_1 } + "a" { simple Tk__tok_a_0 } + "," { simple Tk__tok__coma__2 } + ("$" "G" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_G . ((tail . dropWhile (/= ':'))) } + ("$" "F5" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_F5 . ((tail . dropWhile (/= ':'))) } + ("$" "F4" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_F4 . ((tail . dropWhile (/= ':'))) } + ("$" "F3" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_F3 . ((tail . dropWhile (/= ':'))) } + ("$" "F2" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_F2 . ((tail . dropWhile (/= ':'))) } + ("$" "F1" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_F1 . ((tail . dropWhile (/= ':'))) } + ("$" "E" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_E . ((tail . dropWhile (/= ':'))) } + ("$" "D" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_D . ((tail . dropWhile (/= ':'))) } + ("$" "C" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_C . ((tail . dropWhile (/= ':'))) } + ("$" "B" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_B . ((tail . dropWhile (/= ':'))) } + ("$" "A" ":" [a-zA-Z_] [A-Za-z0-9_]*) { simple1 $ Tk__qq_A . ((tail . dropWhile (/= ':'))) } + . { rtkError } + +{ +data Token = EndOfFile | + Tk__tok_A_dummy_17 | + Tk__tok_B_dummy_16 | + Tk__tok_C_dummy_15 | + Tk__tok_D_dummy_14 | + Tk__tok_E_dummy_13 | + Tk__tok_F1_dummy_12 | + Tk__tok_F2_dummy_11 | + Tk__tok_F3_dummy_10 | + Tk__tok_F4_dummy_9 | + Tk__tok_F5_dummy_8 | + Tk__tok_G_dummy_7 | + Tk__tok_b_1 | + Tk__tok_a_0 | + Tk__tok__coma__2 | + Tk__qq_G String | + Tk__qq_F5 String | + Tk__qq_F4 String | + Tk__qq_F3 String | + Tk__qq_F2 String | + Tk__qq_F1 String | + Tk__qq_E String | + Tk__qq_D String | + Tk__qq_C String | + Tk__qq_B String | + Tk__qq_A String + deriving (Show) + +-- AlexPosn is defined by the alex wrapper, so the Data instance (required by +-- the parser's RtkPos position type) can only be attached via standalone +-- deriving - the same solution as the hand-written Lexer.x +deriving instance Data AlexPosn + +-- A token together with the source position where it starts +data PosToken = PosToken { ptPos :: AlexPosn, ptToken :: Token } + deriving (Show) + +alexEOF = do + (pos, _, _, _) <- alexGetInput + return $ PosToken pos EndOfFile + +-- Lex the input into a token stream, returning the positioned error message +-- on a lexical error (encoded as "LINE:COL:message", see rtkError below). +-- The returned list always ends with an EndOfFile token that carries the +-- position of the end of input, so parse errors at end of input can be +-- reported with a position too +scanTokens :: String -> Either String [PosToken] +scanTokens str = runAlex str $ do + let loop toks = do tok <- alexMonadScan + case tok of + PosToken _ EndOfFile -> return $ reverse (tok : toks) + _ -> let toks' = tok : toks + in toks' `seq` loop toks' + loop [] + +-- Thin compatibility wrapper: callers that have not switched to 'scanTokens' +-- get the error message thrown instead +alexScanTokens :: String -> [PosToken] +alexScanTokens str = + case scanTokens str of + Right toks -> toks + Left err -> errorWithoutStackTrace err + +simple1 :: (String -> Token) -> AlexInput -> Int -> Alex PosToken +simple1 t (pos, _, _, str) len = return $ PosToken pos (t (take len str)) + +simple :: Token -> AlexInput -> Int -> Alex PosToken +simple t (pos, _, _, _) len = return $ PosToken pos t + +-- Encode the position as "LINE:COL:message" so callers can split it back out +-- into a structured position - the same encoding the rtk grammar lexer uses +rtkError ((AlexPn _ line column), _, _, str) len = alexError $ (show line) ++ ":" ++ (show column) ++ ":lexical error. Following chars: " ++ (take 10 str) + +} diff --git a/test/golden/t1/T1Parser.y b/test/golden/t1/T1Parser.y new file mode 100644 --- /dev/null +++ b/test/golden/t1/T1Parser.y @@ -0,0 +1,294 @@ +-- Generated by RTK from grammar 'T1'. Do not edit by hand. +{ +{-# LANGUAGE DeriveDataTypeable #-} +module T1Parser where +import qualified Data.Generics as Gen +import qualified T1Lexer as L (Token(..), PosToken(..), AlexPosn(..), alexScanTokens) +} + +%name parseT1 +%tokentype { L.PosToken } +%monad { Either String } +%error { parseError } + +%token + +rtk__eof { L.PosToken _ L.EndOfFile } +tok_A_dummy_17 { L.PosToken _ L.Tk__tok_A_dummy_17 } +tok_B_dummy_16 { L.PosToken _ L.Tk__tok_B_dummy_16 } +tok_C_dummy_15 { L.PosToken _ L.Tk__tok_C_dummy_15 } +tok_D_dummy_14 { L.PosToken _ L.Tk__tok_D_dummy_14 } +tok_E_dummy_13 { L.PosToken _ L.Tk__tok_E_dummy_13 } +tok_F1_dummy_12 { L.PosToken _ L.Tk__tok_F1_dummy_12 } +tok_F2_dummy_11 { L.PosToken _ L.Tk__tok_F2_dummy_11 } +tok_F3_dummy_10 { L.PosToken _ L.Tk__tok_F3_dummy_10 } +tok_F4_dummy_9 { L.PosToken _ L.Tk__tok_F4_dummy_9 } +tok_F5_dummy_8 { L.PosToken _ L.Tk__tok_F5_dummy_8 } +tok_G_dummy_7 { L.PosToken _ L.Tk__tok_G_dummy_7 } +tok_b_1 { L.PosToken _ L.Tk__tok_b_1 } +tok_a_0 { L.PosToken _ L.Tk__tok_a_0 } +tok__coma__2 { L.PosToken _ L.Tk__tok__coma__2 } +qq_G { L.PosToken _ (L.Tk__qq_G _) } +qq_F5 { L.PosToken _ (L.Tk__qq_F5 _) } +qq_F4 { L.PosToken _ (L.Tk__qq_F4 _) } +qq_F3 { L.PosToken _ (L.Tk__qq_F3 _) } +qq_F2 { L.PosToken _ (L.Tk__qq_F2 _) } +qq_F1 { L.PosToken _ (L.Tk__qq_F1 _) } +qq_E { L.PosToken _ (L.Tk__qq_E _) } +qq_D { L.PosToken _ (L.Tk__qq_D _) } +qq_C { L.PosToken _ (L.Tk__qq_C _) } +qq_B { L.PosToken _ (L.Tk__qq_B _) } +qq_A { L.PosToken _ (L.Tk__qq_A _) } + +%% + +T1__top : A rtk__eof { $1 } + +A : tok_A_dummy_17 A tok_A_dummy_17 { Ctr__A__0 (rtkPosOf $1) $2 } | + tok_B_dummy_16 B tok_B_dummy_16 { Ctr__A__1 (rtkPosOf $1) $2 } | + tok_C_dummy_15 C tok_C_dummy_15 { Ctr__A__2 (rtkPosOf $1) (reverse $2) } | + tok_D_dummy_14 D tok_D_dummy_14 { Ctr__A__3 (rtkPosOf $1) $2 } | + tok_E_dummy_13 E tok_E_dummy_13 { Ctr__A__4 (rtkPosOf $1) $2 } | + tok_F1_dummy_12 F1 tok_F1_dummy_12 { Ctr__A__5 (rtkPosOf $1) (reverse $2) } | + tok_F2_dummy_11 F2 tok_F2_dummy_11 { Ctr__A__6 (rtkPosOf $1) (reverse $2) } | + tok_F3_dummy_10 F3 tok_F3_dummy_10 { Ctr__A__7 (rtkPosOf $1) (reverse $2) } | + tok_F4_dummy_9 F4 tok_F4_dummy_9 { Ctr__A__8 (rtkPosOf $1) $2 } | + tok_F5_dummy_8 F5 tok_F5_dummy_8 { Ctr__A__9 (rtkPosOf $1) (reverse $2) } | + tok_G_dummy_7 G tok_G_dummy_7 { Ctr__A__10 (rtkPosOf $1) $2 } + +A : qq_A { Anti_A (tkVal_qq_A $1) } | + tok_a_0 { Ctr__A__11 (rtkPosOf $1) } + +ListElem_F54 : qq_F5 { Anti_A (tkVal_qq_F5 $1) } | + A { $1 } + +ListElem_F33 : qq_F3 { Anti_A (tkVal_qq_F3 $1) } | + A { $1 } + +ListElem_F22 : qq_F2 { Anti_A (tkVal_qq_F2 $1) } | + A { $1 } + +ListElem_F11 : qq_F1 { Anti_A (tkVal_qq_F1 $1) } | + A { $1 } + +ListElem_C0 : qq_C { Anti_A (tkVal_qq_C $1) } | + A { $1 } + +B : qq_B { Anti_B (tkVal_qq_B $1) } | + tok_a_0 { Ctr__B__0 (rtkPosOf $1) } | + tok_b_1 { Ctr__B__1 (rtkPosOf $1) } + +C : {- empty -} { [] } | + C ListElem_C0 { $2 : $1 } + +D : qq_D { Anti_D (tkVal_qq_D $1) } | + A B C { Ctr__D__0 (rtkPosOf $1) $1 $2 (reverse $3) } + +E : qq_E { Anti_E (tkVal_qq_E $1) } | + A B { Ctr__E__0 (rtkPosOf $1) $1 $2 } | + C { Ctr__E__1 (rtkPosOf (reverse $1)) (reverse $1) } + +F1 : ListElem_F11 { [$1] } | + F1 ListElem_F11 { $2 : $1 } + +F2 : {- empty -} { [] } | + F2 ListElem_F22 { $2 : $1 } + +F3__plus_list_ : ListElem_F33 { [$1] } | + F3__plus_list_ tok__coma__2 ListElem_F33 { $3 : $1 } + +F3 : F3__plus_list_ { $1 } | + {- empty -} { [] } + +F4 : qq_F4 { Anti_F4 (tkVal_qq_F4 $1) } | + { Ctr__F4__0 rtkNoPos } | + A { Ctr__F4__1 (rtkPosOf $1) $1 } + +F5 : ListElem_F54 { [$1] } | + F5 tok__coma__2 ListElem_F54 { $3 : $1 } + +G : qq_G { Anti_G (tkVal_qq_G $1) } | + A Rule_5 { Ctr__G__0 (rtkPosOf $1) $1 $2 } + +Rule_5 : B C Rule_6 A { Ctr__Rule_5__0 (rtkPosOf $1) $1 (reverse $2) $3 $4 } + +Rule_6 : D E { Ctr__Rule_6__0 (rtkPosOf $1) $1 $2 } + + +{ +parseError :: [L.PosToken] -> Either String a +parseError [] = Left "unexpected end of input" +parseError (L.PosToken (L.AlexPn _ line col) tok : _) = + Left $ show line ++ ":" ++ show col ++ ":unexpected " ++ showRtkToken tok + +-- Render a token the way it appears in the source, for error messages +showRtkToken :: L.Token -> String +showRtkToken L.EndOfFile = "end of input" +showRtkToken L.Tk__tok_A_dummy_17 = "'tok_A_dummy_17'" +showRtkToken L.Tk__tok_B_dummy_16 = "'tok_B_dummy_16'" +showRtkToken L.Tk__tok_C_dummy_15 = "'tok_C_dummy_15'" +showRtkToken L.Tk__tok_D_dummy_14 = "'tok_D_dummy_14'" +showRtkToken L.Tk__tok_E_dummy_13 = "'tok_E_dummy_13'" +showRtkToken L.Tk__tok_F1_dummy_12 = "'tok_F1_dummy_12'" +showRtkToken L.Tk__tok_F2_dummy_11 = "'tok_F2_dummy_11'" +showRtkToken L.Tk__tok_F3_dummy_10 = "'tok_F3_dummy_10'" +showRtkToken L.Tk__tok_F4_dummy_9 = "'tok_F4_dummy_9'" +showRtkToken L.Tk__tok_F5_dummy_8 = "'tok_F5_dummy_8'" +showRtkToken L.Tk__tok_G_dummy_7 = "'tok_G_dummy_7'" +showRtkToken L.Tk__tok_b_1 = "'b'" +showRtkToken L.Tk__tok_a_0 = "'a'" +showRtkToken L.Tk__tok__coma__2 = "','" +showRtkToken (L.Tk__qq_G v) = "qq_G " ++ show v +showRtkToken (L.Tk__qq_F5 v) = "qq_F5 " ++ show v +showRtkToken (L.Tk__qq_F4 v) = "qq_F4 " ++ show v +showRtkToken (L.Tk__qq_F3 v) = "qq_F3 " ++ show v +showRtkToken (L.Tk__qq_F2 v) = "qq_F2 " ++ show v +showRtkToken (L.Tk__qq_F1 v) = "qq_F1 " ++ show v +showRtkToken (L.Tk__qq_E v) = "qq_E " ++ show v +showRtkToken (L.Tk__qq_D v) = "qq_D " ++ show v +showRtkToken (L.Tk__qq_C v) = "qq_C " ++ show v +showRtkToken (L.Tk__qq_B v) = "qq_B " ++ show v +showRtkToken (L.Tk__qq_A v) = "qq_A " ++ show v + +-- Source position of a node: every constructor except the Anti_* splice +-- artifacts stores the position of its alternative's first symbol in its +-- first field. Positions are transparent for equality and ordering, so two +-- ASTs that differ only in source positions (e.g. a quasi-quote parsed at +-- compile time vs the same construct parsed at run time) compare equal. +newtype RtkPos = RtkPos L.AlexPosn deriving (Show, Gen.Data, Gen.Typeable) +instance Eq RtkPos where _ == _ = True +instance Ord RtkPos where compare _ _ = EQ + +-- The position used where no source token exists: empty productions, empty +-- lists, absent optionals and Anti_* quasi-quote splices +rtkNoPos :: RtkPos +rtkNoPos = RtkPos (L.AlexPn 0 0 0) + +class RtkPosOf a where + rtkPosOf :: a -> RtkPos +instance RtkPosOf L.PosToken where + rtkPosOf (L.PosToken p _) = RtkPos p +instance RtkPosOf a => RtkPosOf [a] where + rtkPosOf (x : _) = rtkPosOf x + rtkPosOf [] = rtkNoPos +instance RtkPosOf a => RtkPosOf (Maybe a) where + rtkPosOf (Just x) = rtkPosOf x + rtkPosOf Nothing = rtkNoPos +-- A Char carries no position; this also covers String token payloads +instance RtkPosOf Char where + rtkPosOf _ = rtkNoPos + +-- Recover a token's payload from the whole positioned token: %token +-- bindings keep the L.PosToken so semantic actions can read its position +tkVal_qq_G :: L.PosToken -> String +tkVal_qq_G (L.PosToken _ (L.Tk__qq_G v)) = v +tkVal_qq_G t = error ("rtk internal error: token qq_G expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_F5 :: L.PosToken -> String +tkVal_qq_F5 (L.PosToken _ (L.Tk__qq_F5 v)) = v +tkVal_qq_F5 t = error ("rtk internal error: token qq_F5 expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_F4 :: L.PosToken -> String +tkVal_qq_F4 (L.PosToken _ (L.Tk__qq_F4 v)) = v +tkVal_qq_F4 t = error ("rtk internal error: token qq_F4 expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_F3 :: L.PosToken -> String +tkVal_qq_F3 (L.PosToken _ (L.Tk__qq_F3 v)) = v +tkVal_qq_F3 t = error ("rtk internal error: token qq_F3 expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_F2 :: L.PosToken -> String +tkVal_qq_F2 (L.PosToken _ (L.Tk__qq_F2 v)) = v +tkVal_qq_F2 t = error ("rtk internal error: token qq_F2 expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_F1 :: L.PosToken -> String +tkVal_qq_F1 (L.PosToken _ (L.Tk__qq_F1 v)) = v +tkVal_qq_F1 t = error ("rtk internal error: token qq_F1 expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_E :: L.PosToken -> String +tkVal_qq_E (L.PosToken _ (L.Tk__qq_E v)) = v +tkVal_qq_E t = error ("rtk internal error: token qq_E expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_D :: L.PosToken -> String +tkVal_qq_D (L.PosToken _ (L.Tk__qq_D v)) = v +tkVal_qq_D t = error ("rtk internal error: token qq_D expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_C :: L.PosToken -> String +tkVal_qq_C (L.PosToken _ (L.Tk__qq_C v)) = v +tkVal_qq_C t = error ("rtk internal error: token qq_C expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_B :: L.PosToken -> String +tkVal_qq_B (L.PosToken _ (L.Tk__qq_B v)) = v +tkVal_qq_B t = error ("rtk internal error: token qq_B expected, got " ++ showRtkToken (L.ptToken t)) +tkVal_qq_A :: L.PosToken -> String +tkVal_qq_A (L.PosToken _ (L.Tk__qq_A v)) = v +tkVal_qq_A t = error ("rtk internal error: token qq_A expected, got " ++ showRtkToken (L.ptToken t)) + +data A = Ctr__A__0 RtkPos A | + Ctr__A__1 RtkPos B | + Ctr__A__2 RtkPos C | + Ctr__A__3 RtkPos D | + Ctr__A__4 RtkPos E | + Ctr__A__5 RtkPos F1 | + Ctr__A__6 RtkPos F2 | + Ctr__A__7 RtkPos F3 | + Ctr__A__8 RtkPos F4 | + Ctr__A__9 RtkPos F5 | + Ctr__A__10 RtkPos G | + Anti_A String | + Ctr__A__11 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf A where + rtkPosOf (Ctr__A__0 p _) = p + rtkPosOf (Ctr__A__1 p _) = p + rtkPosOf (Ctr__A__2 p _) = p + rtkPosOf (Ctr__A__3 p _) = p + rtkPosOf (Ctr__A__4 p _) = p + rtkPosOf (Ctr__A__5 p _) = p + rtkPosOf (Ctr__A__6 p _) = p + rtkPosOf (Ctr__A__7 p _) = p + rtkPosOf (Ctr__A__8 p _) = p + rtkPosOf (Ctr__A__9 p _) = p + rtkPosOf (Ctr__A__10 p _) = p + rtkPosOf (Anti_A _) = rtkNoPos + rtkPosOf (Ctr__A__11 p) = p +data B = Anti_B String | + Ctr__B__0 RtkPos | + Ctr__B__1 RtkPos + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf B where + rtkPosOf (Anti_B _) = rtkNoPos + rtkPosOf (Ctr__B__0 p) = p + rtkPosOf (Ctr__B__1 p) = p +type C = [A] +data D = Anti_D String | + Ctr__D__0 RtkPos A B C + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf D where + rtkPosOf (Anti_D _) = rtkNoPos + rtkPosOf (Ctr__D__0 p _ _ _) = p +data E = Anti_E String | + Ctr__E__0 RtkPos A B | + Ctr__E__1 RtkPos C + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf E where + rtkPosOf (Anti_E _) = rtkNoPos + rtkPosOf (Ctr__E__0 p _ _) = p + rtkPosOf (Ctr__E__1 p _) = p +type F1 = [A] +type F2 = [A] +type F3 = [A] +data F4 = Anti_F4 String | + Ctr__F4__0 RtkPos | + Ctr__F4__1 RtkPos A + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf F4 where + rtkPosOf (Anti_F4 _) = rtkNoPos + rtkPosOf (Ctr__F4__0 p) = p + rtkPosOf (Ctr__F4__1 p _) = p +type F5 = [A] +data G = Anti_G String | + Ctr__G__0 RtkPos A Rule_5 + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf G where + rtkPosOf (Anti_G _) = rtkNoPos + rtkPosOf (Ctr__G__0 p _ _) = p +data Rule_5 = Ctr__Rule_5__0 RtkPos B C Rule_6 A + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_5 where + rtkPosOf (Ctr__Rule_5__0 p _ _ _ _) = p +data Rule_6 = Ctr__Rule_6__0 RtkPos D E + deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable) +instance RtkPosOf Rule_6 where + rtkPosOf (Ctr__Rule_6__0 p _ _) = p +} diff --git a/test/golden/t1/T1QQ.hs b/test/golden/t1/T1QQ.hs new file mode 100644 --- /dev/null +++ b/test/golden/t1/T1QQ.hs @@ -0,0 +1,214 @@ +-- Generated by RTK from grammar 'T1'. Do not edit by hand. +{-# LANGUAGE TemplateHaskell #-} +module T1QQ +where + +import qualified Data.Char as C +import qualified Data.Map as M +import Data.List +import Data.Maybe +import qualified Data.Generics as Generics +import qualified Data.Data as Data +import qualified Language.Haskell.TH as TH +import Language.Haskell.TH.Quote +import T1Lexer +import T1Parser + +qqShortcuts :: M.Map String String + +-- A $name metavariable is rewritten to $Type:name using the qqShortcuts +-- table below. The rewrite is purely textual, so it would also fire inside +-- the quoted language's own string literals: write $$name there to escape +-- it and get the literal text $name. Each '$$' pair directly before a +-- metavariable stands for one literal '$' (so $$$x is a literal '$' +-- followed by the metavariable $x). A '$' not followed by an identifier is +-- never rewritten and needs no escape, and an explicit $Type:name antiquote +-- (the character after the name is ':') passes through untouched. +-- A plain character scan rather than a regex: metavariables are recognized +-- regardless of what follows the name - including a newline or the end of +-- the quote, which the previous regex's terminator class missed. +replaceAllPatterns :: String -> Either String String +replaceAllPatterns [] = Right [] +replaceAllPatterns s@('$' : _) = + let (dollars, rest) = span (== '$') s + in case rest of + (c1 : _) | C.isAlpha c1 || c1 == '_' -> + let (varName, post) = span (\ ch -> C.isAlphaNum ch || ch == '_') rest + escCount = length dollars - 1 + keptPre = replicate (div escCount 2) '$' + in case post of + (':' : _) -> ((dollars ++ varName) ++) <$> replaceAllPatterns post + _ | odd escCount -> ((keptPre ++ '$' : varName) ++) <$> replaceAllPatterns post + _ -> case catMaybes $ map (\ prefix -> M.lookup prefix qqShortcuts) $ reverse $ inits varName of + [] -> Left $ unlines + [ "Unknown metavariable $" ++ varName ++ " in quasi-quote:" + , "no prefix of '" ++ varName ++ "' is a known shortcut. Known shortcuts:" + , " " ++ intercalate ", " (M.keys qqShortcuts) + , "To include the literal text $" ++ varName ++ " in the quoted code" + , "(e.g. inside a string literal), escape it as $$" ++ varName ++ "." ] + (rule : _) -> ((keptPre ++ '$' : rule ++ ":" ++ varName) ++) <$> replaceAllPatterns post + _ -> (dollars ++) <$> replaceAllPatterns rest +replaceAllPatterns (c : rest) = (c :) <$> replaceAllPatterns rest + +-- The generated lexer and parser encode error positions as "LINE:COL:message" +-- so structured-diagnostic callers can split them; render them back +-- human-readably for quasi-quote compile errors. Positions refer to the quote +-- body (padded with a start token in front). +rtkRenderError :: String -> String +rtkRenderError err = + case span (/= ':') err of + (l, ':' : rest1) | [(line, "")] <- (reads l :: [(Int, String)]) -> + case span (/= ':') rest1 of + (c, ':' : msg) | [(col, "")] <- (reads c :: [(Int, String)]) -> + "line " ++ show line ++ ", column " ++ show col ++ ": " ++ msg + _ -> err + _ -> err + +qqShortcuts = M.fromList [ ("a","A"),("b","B"),("c","C"),("d","D"),("e","E"),("f1","F1"),("f2","F2"),("f3","F3"),("f4","F4"),("f5","F5"),("g","G")] + +-- A quasi-quote pattern must match an AST parsed from anywhere in a source +-- file, while the pattern itself was parsed from the quote body - so every +-- RtkPos position field becomes a wildcard in generated patterns. +-- (Expressions need no special case: the compile-time position they embed +-- is equality-transparent.) +rtkPosWildPat :: RtkPos -> Maybe (TH.Q TH.Pat) +rtkPosWildPat _ = Just TH.wildP + +quoteT1Exp :: Data.Data a => String -> (A -> a) -> String -> TH.ExpQ +quoteT1Exp dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseT1 of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToExpQ (const Nothing `Generics.extQ` antiAExp `Generics.extQ` antiBExp `Generics.extQ` antiDExp `Generics.extQ` antiEExp `Generics.extQ` antiF4Exp `Generics.extQ` antiGExp) expr +quoteT1Pat :: Data.Data a => String -> (A -> a) -> String -> TH.PatQ +quoteT1Pat dummy func s = do + s1 <- either fail return (replaceAllPatterns s) + ast <- case scanTokens (dummy ++ " " ++ s1 ++ " " ++ dummy) >>= parseT1 of + Left err -> fail (rtkRenderError err) + Right a -> return a + let expr = func ast + dataToPatQ (const Nothing `Generics.extQ` rtkPosWildPat `Generics.extQ` antiAPat `Generics.extQ` antiBPat `Generics.extQ` antiDPat `Generics.extQ` antiEPat `Generics.extQ` antiF4Pat `Generics.extQ` antiGPat) expr + +antiGExp :: G -> Maybe (TH.Q TH.Exp ) +antiGExp ( Anti_G v) = Just $ TH.varE (TH.mkName v) +antiGExp _ = Nothing + + +antiF4Exp :: F4 -> Maybe (TH.Q TH.Exp ) +antiF4Exp ( Anti_F4 v) = Just $ TH.varE (TH.mkName v) +antiF4Exp _ = Nothing + + +antiEExp :: E -> Maybe (TH.Q TH.Exp ) +antiEExp ( Anti_E v) = Just $ TH.varE (TH.mkName v) +antiEExp _ = Nothing + + +antiDExp :: D -> Maybe (TH.Q TH.Exp ) +antiDExp ( Anti_D v) = Just $ TH.varE (TH.mkName v) +antiDExp _ = Nothing + + +antiBExp :: B -> Maybe (TH.Q TH.Exp ) +antiBExp ( Anti_B v) = Just $ TH.varE (TH.mkName v) +antiBExp _ = Nothing + + +antiAExp :: A -> Maybe (TH.Q TH.Exp ) +antiAExp ( Anti_A v) = Just $ TH.varE (TH.mkName v) +antiAExp _ = Nothing + + + +antiGPat :: G -> Maybe (TH.Q TH.Pat ) +antiGPat ( Anti_G v) = Just $ TH.varP (TH.mkName v) +antiGPat _ = Nothing + + +antiF4Pat :: F4 -> Maybe (TH.Q TH.Pat ) +antiF4Pat ( Anti_F4 v) = Just $ TH.varP (TH.mkName v) +antiF4Pat _ = Nothing + + +antiEPat :: E -> Maybe (TH.Q TH.Pat ) +antiEPat ( Anti_E v) = Just $ TH.varP (TH.mkName v) +antiEPat _ = Nothing + + +antiDPat :: D -> Maybe (TH.Q TH.Pat ) +antiDPat ( Anti_D v) = Just $ TH.varP (TH.mkName v) +antiDPat _ = Nothing + + +antiBPat :: B -> Maybe (TH.Q TH.Pat ) +antiBPat ( Anti_B v) = Just $ TH.varP (TH.mkName v) +antiBPat _ = Nothing + + +antiAPat :: A -> Maybe (TH.Q TH.Pat ) +antiAPat ( Anti_A v) = Just $ TH.varP (TH.mkName v) +antiAPat _ = Nothing + + + +-- This grammar's quasi-quoters work in expression and pattern contexts only +quoteT1Type _ = fail "this quasi-quoter cannot be used in a type context" +quoteT1Decs _ = fail "this quasi-quoter cannot be used in a declaration context" + +getA ( Ctr__A__0 _ s) = s + +a :: QuasiQuoter +a = QuasiQuoter (quoteT1Exp "tok_A_dummy_17" getA ) (quoteT1Pat "tok_A_dummy_17" getA ) quoteT1Type quoteT1Decs + +getB ( Ctr__A__1 _ s) = s + +b :: QuasiQuoter +b = QuasiQuoter (quoteT1Exp "tok_B_dummy_16" getB ) (quoteT1Pat "tok_B_dummy_16" getB ) quoteT1Type quoteT1Decs + +getC ( Ctr__A__2 _ s) = s + +c :: QuasiQuoter +c = QuasiQuoter (quoteT1Exp "tok_C_dummy_15" getC ) (quoteT1Pat "tok_C_dummy_15" getC ) quoteT1Type quoteT1Decs + +getD ( Ctr__A__3 _ s) = s + +d :: QuasiQuoter +d = QuasiQuoter (quoteT1Exp "tok_D_dummy_14" getD ) (quoteT1Pat "tok_D_dummy_14" getD ) quoteT1Type quoteT1Decs + +getE ( Ctr__A__4 _ s) = s + +e :: QuasiQuoter +e = QuasiQuoter (quoteT1Exp "tok_E_dummy_13" getE ) (quoteT1Pat "tok_E_dummy_13" getE ) quoteT1Type quoteT1Decs + +getF1 ( Ctr__A__5 _ s) = s + +f1 :: QuasiQuoter +f1 = QuasiQuoter (quoteT1Exp "tok_F1_dummy_12" getF1 ) (quoteT1Pat "tok_F1_dummy_12" getF1 ) quoteT1Type quoteT1Decs + +getF2 ( Ctr__A__6 _ s) = s + +f2 :: QuasiQuoter +f2 = QuasiQuoter (quoteT1Exp "tok_F2_dummy_11" getF2 ) (quoteT1Pat "tok_F2_dummy_11" getF2 ) quoteT1Type quoteT1Decs + +getF3 ( Ctr__A__7 _ s) = s + +f3 :: QuasiQuoter +f3 = QuasiQuoter (quoteT1Exp "tok_F3_dummy_10" getF3 ) (quoteT1Pat "tok_F3_dummy_10" getF3 ) quoteT1Type quoteT1Decs + +getF4 ( Ctr__A__8 _ s) = s + +f4 :: QuasiQuoter +f4 = QuasiQuoter (quoteT1Exp "tok_F4_dummy_9" getF4 ) (quoteT1Pat "tok_F4_dummy_9" getF4 ) quoteT1Type quoteT1Decs + +getF5 ( Ctr__A__9 _ s) = s + +f5 :: QuasiQuoter +f5 = QuasiQuoter (quoteT1Exp "tok_F5_dummy_8" getF5 ) (quoteT1Pat "tok_F5_dummy_8" getF5 ) quoteT1Type quoteT1Decs + +getG ( Ctr__A__10 _ s) = s + +g :: QuasiQuoter +g = QuasiQuoter (quoteT1Exp "tok_G_dummy_7" getG ) (quoteT1Pat "tok_G_dummy_7" getG ) quoteT1Type quoteT1Decs +