P4/P6/FreePascal validator pilots (repaired grammars, builds, tests)

grammars/FreePascal/README.md

@@ -0,0 +1,144 @@
+# FreePascal validator pilot
+
+`free_pascal.atg` describes Free Pascal / Delphi-dialect Object
+Pascal. It needed a full repair pass to build with Coco/R V1.53 (`CR`)
+and GNU Modula-2 (`gm2 -fiso`), all diagnosed against `fpc -Mdelphi`
+as oracle (default mode lacks classes; `-Miso` lacks units, strings
+and most extensions):
+
+1. Bare `;` is not a Coco/R literal — every separator is `";"`.
+2. Unterminated productions get their `.` (`Statement` ended with a
+   bare `;`).
+3. `""` is illegal — empty positions use tolerant list shapes
+   (`[ X { ";" [ X ] } ]`, progress-guaranteed so the parser cannot
+   hang).
+4. `ident` cannot be both token and production (literals renamed to
+   `pnumber`/`pstring`); junk `EndProgram`/`EOF` lines removed; the
+   start production matches `COMPILER`.
+5. Left-recursive `Primary "^"` rewritten as postfix.
+6. Undefined nonterminals filled in (`LabelDecl`, `PointerType`,
+   `ParDeclList`→`FormalParams`, `Stmts`→`Statements`, `noQuote1`,
+   `MethodSig`, `TypeName`-equivalents, `UsesClause`).
+7. Name collisions in generated `CASE` statements fixed by merging:
+   duplicate `for..to/downto`, duplicate `Type/StructType` and
+   `ArrayType/ParamType` entries, ident-led assignment-vs-call
+   (single `IdentTail` dispatch), `[class]`-prefixed routine twins.
+8. Grammar gaps closed to oracle level: `TypeIdent` (named types),
+   `Compound` program bodies, trailing-`;`-tolerant sections/fields/
+   case-items, `{}`/`//`/`{$}` comments (with `eol = CHR(10)` —
+   `CHR(13)` made `//` eat to EOF), `and`/`or`/`xor`/`shl`/`shr`/`sar`
+   words, bare parameterless calls, numeric statement labels + `goto`
+   (+`LabelSection`), enum labels, formal parameter groups (with
+   `var`/`out`/`const`, defaults), subrange/expression array bounds,
+   const expressions, `CASE` branches take a single statement,
+   multi-routine blocks, `preal` floats, `$`/`&`/`%` literals,
+   `#nn` char chains, enums, dotted names, units (top-level, with
+   interface/implementation/init/final + repeated uses-groups),
+   `library` headers, classes (sealed/abstract/parents/helpers,
+   visibility, fields, generic/static methods, properties with
+   positional accessors) and interfaces, `class`/`static` routine
+   implementations with owner dots, generics (`generic` prefix,
+   `<T>` params, `specialize`, `<>` args), `operator` declarations,
+   procedural/`of`-object types, `try`/`except`/`on`/`finally`,
+   `raise`, `exit`/`break`, `inherited`, `is`/`as`, `in`, `for..in`,
+   `threadvar`, `resourcestring`, `absolute`, `forward`/`abstract`/
+   `external` (all arities) + calling-convention/method directives as
+   a closed vocabulary, `on`-clauses by position (`var on` stays
+   legal), `case..else`, shortstrings, `packed`/`bitpacked`,
+   set literals with ranges, deref/call-then-select chains, `nil`.
+9. Contextual words probed against the oracle: `static`, `read`,
+   `write`, `message`, `assembler`, `nostackframe`, `register`,
+   `reference`, `object`, `weak`, `on`, `Supports` stay identifiers;
+   `overload`/`varargs`/`external`/`set`/`threadvar`/operator-words
+   are legal dotted unit-name parts.
+10. Corpus-driven round (fpcsrc): bare-`class` forwards, legacy
+    `object` types, `objcclass` with protocol parents, `class of`
+    references, `class var` blocks, `class`/`static` operators
+    (`Implicit`/`Explicit`, owner dots), `**` power, `+=`-family
+    assignments, `@` address-of, `inherited` calls in expressions,
+    write-width `:` params, `external` lib/name chains, GUID'd
+    interfaces, `const`-indexed properties, `array of const`,
+    `array[N]`/`(N)` string lengths, shortstring/enum/dotted case
+    labels, `case..of` in records (variants), nested
+    `const`/`type`/`var` blocks in records/classes, visibility in
+    records, record methods, empty `case` branches, juxtaposed record
+    fields (directive tails eat `;`), interface/implementation-level
+    `resourcestring`/`threadvar`, optional `implementation`,
+    comment-only fragments (driver skips `FPC` on immediate EOF),
+    BOM bytes ignored, `X_PACKED` packing macro (2 files, documented),
+    `XIdent` (`out`/`static`/`register`/`far`/`near` stay usable as
+    declaration names, statements and expressions — probed: `var`
+    /`const` as names are rejected by the oracle too), `public` as
+    unit-var directive vs class visibility (split `VarDecl`/
+    `VarDeclNoTail`), `far`/`near`/`static`/`assembler`/
+    `nostackframe`/`syscall`/`extdecl` routine directives, constrained
+    generic params (`<E: class>`), `>=`-tolerant generic closers
+    (`GClose`), generic parents (`class(specialize TBase<Integer>)`),
+    string-adjacent `#nn`/`^M` chains, paren const-lists with `:`/`;`/
+    trailing-`;`, enum `=`/`:=` values, `array[seg:ofs]`, initialized
+    `var x: T = V`, `absolute (expr)`, builtin-type casts
+    (`integer(x)`), deref-after-parens, `of object` procedural types,
+    `cdecl`-family type tails, `syscall` in interfaces, empty
+    `then`/`else`/`do` bodies, variant `case <type> of` via
+    `Type [":" Type]`, indexed `property ...[const i: T]`,
+    `...; deprecated;` property tails, `X_PACKED` packing macro
+    (2 files).
+11. Toolchain limits discovered: the grammar is at Coco/R V1.53's
+    reliable capacity — additions past a point silently degrade code
+    generation with no diagnostic beyond benign LL(1) notes. Two
+    failure modes seen: `IF FALSE`/`WHILE FALSE` conditions (a
+    `{...}` loop over ~10+ alternatives, or any `ANY`-complement
+    token), and silently pruned dispatch branches (even a minimal
+    `"asm" "end"` block broke array indexing with zero warnings).
+    All pilot `build.sh` scripts fail the build on the FALSE pattern,
+    and every rebuild is followed by the differential battery +
+    `tests/deep.pas` (the latter caught the pruning). Consequence:
+    `asm` bodies of any kind stay a documented gap. `{$define}`
+    macro expansion in general remains a documented gap, as do
+    conditional-define branch selection (`{$ifc}` units parse all
+    branches literally) and include-only test fragments the oracle
+    itself rejects.
+
+The generated parser gets a strict EOF check
+(`IF sym # 0 THEN SynError(0)` after the start symbol in `Parse`,
+patched in by `build.sh` with a loud assertion): without it, the
+Coco/R driver never scans past the program's final `.`, silently
+ignoring trailing garbage — and worse, masking any failure that
+leaves a `.` behind. This makes the validator marginally stricter
+than `fpc`, which accepts trailing junk after `END.` — degenerate
+input only, documented here.
+
+`if`/`while`/`for`/`with`/`on-do` branches take a single `Statement`
+(standard Pascal — plural branches greedily swallow the `;`
+separating `case` items, so `if..then begin..end;` inside a branch
+broke); `repeat`/`try`/`begin` bodies stay plural (terminator-closed).
+Declaration sections are order-free (`DeclPart` is a loop, since real
+units interleave `const` after routines).
+
+Known gaps (all documented, corpus-measured): `asm` bodies of any
+kind (toolchain capacity — even an empty-block production silently
+broke unrelated dispatches); `message N` with numeric args; `{$define}` macro expansion
+(`X_PACKED` packing prefix is accepted as a literal — 2 files);
+conditional-define branches are parsed literally, so multi-branch
+`{$ifc}` units can mismatch the oracle's selected branch.
+
+## Build
+
+```sh
+./build.sh        # -> build/FPC (build/ is git-ignored)
+```
+
+Needs `CR` (Coco/R), `gm2 -fiso`, the `parser.frm`/`scanner.frm`
+frames and `FileIO.def/.mod` — all resolved from the environment with
+sensible defaults (`CRFRAMES`, `M2LIB`, `CR`, `GM2`).
+
+## Differential results (FPC vs `fpc -Mdelphi`)
+
+Accept battery + `tests/deep.pas` + `tests/class.pas`: **0 false
+positives**. Broken mutants: **0 missed**, positions close. Full
+fpcsrc corpus (11,391 files, per-file `{$mode}` oracle, fail-tests
+excluded): 7,613 clean-agree, 2,287 validator-FP, 232
+validator-miss (nearly all headerless include-fragments the oracle
+rejects standalone — documented leniency), 567 oracle-parse-reject.
+FP is dominated by the documented gaps: `asm` bodies (~740 files)
+and conditional-define branches parsed literally.

grammars/FreePascal/build.sh

@@ -0,0 +1,46 @@
+#!/bin/bash
+# Build the Free Pascal syntax validator from free_pascal.atg.
+# Needs: CR (Coco/R V1.53), gm2 -fiso, parser/scanner frames, FileIO.
+# Note: link via the two-step module list; a single-step link trips
+# over pre-existing errors in this gm2 build's own ISO library .defs.
+set -e
+CR="${CR:-/home/eric/Projets/Projets-Modula2/MyWork/CocoGm2/CR}"
+GM2="${GM2:-/home/eric/bin/Modula2/Gm2/bin/gm2}"
+FRAMES="${CRFRAMES:-/home/eric/Projets/Projets-Modula2/MyWork/Theia/GNU-grammar/build}"
+M2LIB="${M2LIB:-/home/eric/Projets/Projets-Modula2/MyWork/Theia/GNU-grammar/build}"
+HERE="$(cd "$(dirname "$0")" && pwd)"
+B="$HERE/build"
+rm -rf "$B"
+mkdir -p "$B"
+cp "$HERE/free_pascal.atg" "$B/"
+cp "$M2LIB/FileIO.def" "$M2LIB/FileIO.mod" "$B/"
+cd "$B"
+echo "=== CR ==="; CRFRAMES="$FRAMES" "$CR" -m -C free_pascal.atg
+echo "=== patch: EOF check ==="
+python3 - "$B" <<'PYEOF'
+import sys
+b = sys.argv[1]
+s = open(b + '/FPCP.mod').read()
+old = '    FPCS.Reset; Get;\n    FPC;\n\n  END Parse;'
+assert old in s, 'EOF patch pattern missing'
+s = s.replace(old, '    FPCS.Reset; Get;\n    IF sym # 0 THEN FPC END;\n    IF sym # 0 THEN SynError(0) END;\n\n  END Parse;')
+open(b + '/FPCP.mod', 'w').write(s)
+print('patched')
+PYEOF
+echo "=== check: no degenerate code ==="
+if grep -q "IF FALSE\|WHILE FALSE" FPCP.mod; then echo "DEGENERATE GENERATION (IF/WHILE FALSE)"; exit 1; fi
+echo "=== compile ==="
+for m in FileIO FPCS FPCP FPC; do "$GM2" -fiso -I . -c "$m.mod"; done
+echo "=== link ==="
+# NOTE: the gen step exits 1 on pre-existing errors in gm2's own
+# ISO library .defs, but still writes a usable modules.lst.
+"$GM2" -fiso -I . -fgen-module-list=modules.lst -o /dev/null FileIO.o FPCS.o FPCP.o FPC.mod || true
+"$GM2" -fiso -I . -fuse-list=modules.lst -o FPC FileIO.o FPCS.o FPCP.o FPC.mod
+echo "=== smoke ==="
+printf 'PROGRAM Hello;\nBEGIN\n  WriteLn('"'"'hi'"'"');\nEND.\n' > Hello.pas
+./FPC Hello.pas
+printf 'PROGRAM T;\nBEGIN\nEND. GARBAGE\n' > Garbage.pas
+if ./FPC Garbage.pas 2>&1 | grep -q "Incorrect"; then echo "trailing-garbage rejected"; else echo "EOF CHECK FAILED"; exit 1; fi
+./FPC "$HERE/tests/deep.pas"
+./FPC "$HERE/tests/class.pas"
+rm -f Hello.pas Hello.LST Garbage.pas Garbage.LST "$HERE/tests/deep.LST" "$HERE/tests/class.LST"

grammars/FreePascal/free_pascal.atg

@@ -0,0 +1,252 @@
+(* Free Pascal ATG for Coco/R *)
+(* Adapted from the standard Pascal grammar *)
+
+(* Tags: FREEPASCAL, FP, FPC, DELPHI *)
+
+COMPILER FPC
+IGNORE CASE
+
+CHARACTERS
+  eol = CHR(10) .
+  letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
+  digit = "0123456789" .
+  hexDigit = digit + "ABCDEF" .
+  octDigit = "01234567" .
+  binDigit = "01" .
+  noQuote1 = ANY - "'" - eol .
+
+
+IGNORE CHR(9) .. CHR(13) + CHR(239) + CHR(187) + CHR(191)
+COMMENTS FROM "(*" TO "*)" NESTED
+COMMENTS FROM "{" TO "}"
+COMMENTS FROM "//" TO eol
+COMMENTS FROM "{$" TO "}"
+
+TOKENS
+  ident = ( letter | "_" ) { letter | digit | "_" } .
+  pnumber = digit { digit } | digit { digit } CONTEXT ( ".." )
+          | "$" hexDigit { hexDigit }
+          | "&" octDigit { octDigit }
+          | "%" binDigit { binDigit } .
+  preal = digit { digit } "." digit { digit } [ "E" [ "+" | "-" ] digit { digit } ] .
+  pstring = "'" { noQuote1 | "''" } "'" .
+
+
+
+PRODUCTIONS
+
+  FPC = program | library | Unit | Fragment .
+  Fragment = { LabelDecl | ConstDecl | TypeDecl | VarDecl | ProcDecl | Compound | UsesClause } [ "." ] .
+  library = "library" UnitId ";" [ UsesClause ] Block "." .
+  program = "program" UnitId ";" [ UsesClause ] Block "." .
+  Unit = "unit" UnitId ";" InterfaceSection [ ImplementationSection ]
+         [ [ InitializationSection ] [ FinalizationSection ] "end" | Compound ] "." .
+  InterfaceSection = "interface" [ UsesClause ] { ConstDecl | TypeDecl | VarDecl | ThreadVar | ResStr | MethodSig } .
+  ImplementationSection = "implementation" [ UsesClause ]
+                          { ConstDecl | TypeDecl | VarDecl | ThreadVar | ResStr | ProcDecl | Compound [";"] } .
+  InitializationSection = "initialization" Statements .
+  FinalizationSection = "finalization" Statements .
+  UsesClause = "uses" UnitName { [ "," ] UnitName } ";" .
+  UnitName = NameComp { "." NameComp } .
+  NameComp = ident | "overload" | "varargs" | "external" | "set" | "threadvar" | "static"
+             | "and" | "or" | "xor" | "div" | "mod" | "not" | "shl" | "shr" | "sar" | "in" | "is" | "as"
+             | "helper" | "far" | "near" | "cvar" | "public" | "export" | "register"
+             | "sealed" | "abstract" | "bitpacked" | "object" | "objcclass" .
+  UnitId = ident | "helper" | "far" | "near" | "cvar" | "public" | "export" | "register"
+           | "sealed" | "abstract" | "bitpacked" | "object" | "objcclass" .
+  MethodSig = [ "generic" ] ( "procedure" | "function" | "constructor" | "destructor" ) XIdent [ "<" TypeParamList GClose ] [ FormalParams ] [ ":" Type ] ";" { MethodDir ";" } .
+  TypeParamList = ConstrParam { "," ConstrParam } .
+  ConstrParam = ident [ ":" ( "class" | "record" | "constructor" | TypeIdent ) ] .
+  GClose = ">" | ">=" .
+  TypeArgList = Type { "," Type } .
+  GenericName = ident [ "<" TypeArgList GClose ] .
+
+  Block = DeclPart [ Compound ] .
+  Compound = "begin" Statements "end" .
+
+  DeclPart = { LabelDecl | ConstDecl | TypeDecl | VarDecl | ThreadVar | ResStr | ProcDecl } .
+  ResStr = "resourcestring" [ ResItem { ";" [ ResItem | JuxValue ] } ] .
+  ResItem = XIdent "=" ( pstring | CharLit ) { "+" | pstring | CharLit } .
+  ThreadVar = "threadvar" [ VDecl { ";" [ VDecl ] } ] .
+  LabelDecl = "label" Label { "," Label } ";" .
+
+  ConstDecl = "const" [ CDecl { ";" [ CDecl | JuxValue ] } ] .
+  JuxValue = pnumber | preal | StrChain | "nil" .
+  CDecl = XIdent [ ":" Type ] "=" Value .
+
+  Value = Expr .
+
+  TypeDecl = "type" [ TypeDef { ";" { TailDir ";" } [ TypeDef ] } ] .
+  TypeDef = [ "generic" ] ident TypeDefTail .
+  TypeDefTail = "=" Type | "<" TypeParamList ( ">" "=" Type | ">=" Type ) .
+
+  VarDecl = "var" [ VDecl { ";" { TailDir ";" } [ VDecl ] } ] .
+  VarDeclNoTail = "var" [ VDecl { ";" [ VDecl ] } ] .
+  TailDir = "far" | "near" | "cvar" | "public" | "export" | "register" | "cdecl" | "stdcall" | "pascal" | "safecall" | "extdecl" | ExternalDir .
+  VDecl = varlist ":" Type [ "absolute" ( ident { Selector } | "(" Expr ")" ) ] [ "=" Value ] .
+  varlist = XIdent { "," XIdent } .
+  XIdent = ident | "out" | "static" | "register" | "far" | "near" .
+
+  identlist = ident { "," ident } .
+
+  Type = SimpleType | StructType | PointerType | EnumType | ProceduralType | TypeIdent | "type" [ "helper" "for" ] Type .
+  ProceduralType  = ( "function" [ FormalParams ] ":" Type | "procedure" [ FormalParams ] ) [ "of" ( ident | "object" ) ] .
+  EnumType = "(" EnumMember { "," EnumMember } ")" .
+  EnumMember = ident [ ( "=" | ":=" ) Expr ] .
+  TypeIdent = ident { "." ident } [ "<" TypeArgList GClose ] [ "(" Expr ")" | "[" Expr "]" ] [ ".." Expr ] | [ "-" ] pnumber [ ".." Expr ]
+                  | "specialize" ident { "." ident } "<" TypeArgList GClose .
+  PointerType = "^" Type .
+
+  SimpleType = IntType | RealType | CharType | BoolType .
+
+  IntType = "integer" .
+  RealType = "real" .
+  CharType = "char" .
+  BoolType = "boolean" .
+
+  StructType = [ "packed" | "bitpacked" | "X_PACKED" ] ( ArrayType | RecordType ) | SetType | FileOfType | ClassType | ObjectType | ObjcClass | InterfaceType .
+  ObjectType = "object" [ "(" GenericName ")" ] { ClassMember } "end" .
+  ObjcClass = "objcclass" [ "external" ] [ "(" [ GenericName { "," GenericName } ] ")" ] [ { ClassMember } "end" ] .
+
+  ArrayType = "array" [ "[" Bound { "," Bound } "]" ] "of" ( Type | "const" ) .
+  Bound = SimpleType | Expr [ ".." Expr ] .
+
+
+  RecordType = "record" [ "helper" "for" Type ] FieldList "end" .
+
+  FieldList = [ Field { ";" [ Field ] | Field } ] .
+
+  Field = VariantPart | [ VisSection [ ";" ] ] [ FieldListPart ":" Type | [ "class" ] ( MethodDecl | OperatorBody | PropertyDecl | VarDeclNoTail ) | ConstDecl | TypeDecl | VarDeclNoTail ] .
+  VariantPart = "case" Type [ ":" Type ] "of" [ Variant { ";" [ Variant ] } ] .
+  Variant = Labels ":" "(" FieldList ")" .
+
+  FieldListPart = XIdent { "," XIdent } .
+
+  SetType = "set" "of" Type .
+
+  FileOfType = "file" [ "of" Type ] .
+
+  ClassType = "class" ( "of" Type | { "sealed" | "abstract" } [ HelperFor | ParentList ] [ { ClassMember } "end" ] ) .
+  ParentList = "(" [ "specialize" ] GenericName { "," [ "specialize" ] GenericName } ")" .
+  HelperFor = "helper" [ ParentList ] "for" Type .
+  ClassMember = VisSection | FieldDecl | ConstDecl | TypeDecl | VarDeclNoTail
+                | "generic" [ "class" ] ( MethodDecl | PropertyDecl | OperatorBody | VarDeclNoTail )
+                | "class" ( MethodDecl | PropertyDecl | OperatorBody | VarDeclNoTail )
+                | MethodDecl | PropertyDecl | OperatorBody .
+  OperatorBody = "operator" ( ident [ "." OpName ] | OpSymbol ) [ FormalParams ] [ ":" Type ] ";" { MethodDir ";" } .
+  VisSection = [ "strict" ] ( "private" | "protected" | "public" | "published" ) .
+  FieldDecl = identlist ":" Type ";" .
+  MethodDecl = ( "procedure" | "function" | "constructor" | "destructor" ) XIdent [ "<" TypeParamList GClose ] [ "." ident ]
+               [ FormalParams ] [ ":" Type ] ";" { MethodDir ";" } .
+  MethodDir = "virtual" | "override" | "abstract" | "reintroduce" | "overload"
+            | "cdecl" | "stdcall" | "inline" | "final" | "sealed" | "dynamic"
+            | "deprecated" | "static" | "assembler" | "nostackframe" | SyscallDir | ExternalDir | ident .
+  InhCall = "inherited" [ ident [ "(" [ ParamList ] ")" ] { Selector } ] .
+  ExternalDir = "external" { pstring | ident | pnumber } .
+  PropertyDecl = "property" XIdent [ "[" [ "const" | "var" ] ident ":" Type "]" ] [ ":" Type ]
+                 [ ( ident | pnumber ) { ident | pnumber } ] ";" { "deprecated" ";" } .
+
+  InterfaceType = "interface" [ "(" ident ")" ] [ "[" ( pstring | ident ) "]" ] { MethodSig | PropertyDecl } "end" .
+
+
+  ProcDecl = [ "generic" ] [ "class" ] ProcKind ";" { NonBodylessDir ";" }
+               [ BodylessDir ";" | Block [ ";" ] ] .
+
+  ProcKind = ( "procedure" | "function" | "constructor" | "destructor" ) XIdent [ "<" TypeParamList GClose ] [ "." ident ] [ FormalParams ] [ ":" Type ]
+           | "operator" ( ident [ "." OpName ] | OpSymbol ) [ FormalParams ] [ ":" Type ] .
+  OpSymbol = "+" | "-" | "*" | "/" | "div" | "mod" | "and" | "or" | "xor" | "shl" | "shr" | "not" | "=" | "<>" | "<" | ">" | "<=" | ">=" | ":=" .
+  OpName = ident | OpSymbol .
+  NonBodylessDir  = "virtual" | "override" | "reintroduce"
+                  | "overload" | "varargs"
+                  | "cdecl" | "stdcall" | "pascal" | "safecall"
+                  | "inline" | "final" | "sealed" | "dynamic" | "deprecated"
+                  | "static" | "far" | "near" | "assembler" | "nostackframe" .
+  BodylessDir     = "forward" | "abstract" | SyscallDir | ExternalDir .
+  SyscallDir = "syscall" [ ident ] .
+  FormalParams = "(" [ FormalGroup { ";" FormalGroup } ] ")" .
+  FormalGroup = [ "var" | "out" | "const" ] identlist [ ":" Type ] [ "=" DefaultValue ] .
+  DefaultValue = [ "-" ] ( pnumber | preal ) | pstring | "nil" | XIdent | "[" [ SimpleExpr { "," SimpleExpr } ] "]" .
+
+  Statements = [ Statement { ";" [ Statement ] } ] .
+
+  Statement = [ pnumber ":" ]
+            ( IfStmt
+            | CaseStmt
+            | WhileStmt
+            | RepeatStmt
+            | ForStmt
+            | XIdent [ IdentTail ]
+            | RetStmt
+            | WithStmt
+            | GotoStmt
+            | TryStmt
+            | RaiseStmt
+            | ExitStmt
+            | "break"
+            | "continue"
+            | Compound
+            | InhCall
+            | ProcDecl ) .
+
+  IfStmt = "if" Expr "then" [ Statement ] { "else" [ Statement ] } .
+
+  CaseStmt = "case" Expr "of" [ CaseItem { ";" [ CaseItem ] } ] [ "else" Statements ] "end" .
+
+  CaseItem = Labels ":" [ Statement ] .
+
+  Labels = CaseLabel { "," CaseLabel } .
+
+  Label = pnumber | ident .
+  CaseLabel = CaseBound [ ".." CaseBound ] .
+  CaseBound = pnumber | ident { "." ident } | pstring | CharLit .
+
+  WhileStmt = "while" Expr "do" [ Statement ] .
+
+  RepeatStmt = "repeat" Statements "until" Expr .
+
+  ForStmt = "for" XIdent ( ":=" Expr ( "to" | "downto" ) Expr | "in" Expr ) "do" [ Statement ] .
+  TryStmt = "try" Statements ( "finally" Statements | "except" ExceptBody ) "end" .
+  ExceptBody = Statements [ "else" Statements ] .
+  RaiseStmt = "raise" [ Expr ] .
+  ExitStmt = "exit" [ "(" Expr ")" ] .
+
+  IdentTail = ":=" Expr
+                  | ( "+=" | "-=" | "*=" | "/=" ) Expr
+                  | ":" Statement
+                  | PostfixBody [ ":=" Expr ]
+                  | ident [ ":" ident { "." ident } ] "do" [ Statement ] .
+  PostfixBody     = ( Selector | "<" GenArgs [ GClose ] | "(" [ ParamList ] ")" ) Postfix .
+  Postfix         = { Selector | "<" GenArgs [ GClose ] | "(" [ ParamList ] ")" } .
+  GenArgs         = SimpleExpr { "," SimpleExpr } .
+
+
+  ParamList = Param { "," Param } .
+
+  Param = Expr [ ":" Expr [ ":" Expr ] ] .
+
+  RetStmt = "return" [ Expr ] .
+
+  WithStmt = "with" WithItem { "," WithItem } "do" [ Statement ] .
+  WithItem = ident Postfix .
+
+  GotoStmt = "goto" Label .
+
+  Expr = SimpleExpr [ ( Relationship | "in" ) SimpleExpr ] [ ( "is" | "as" ) ident ] .
+
+  Relationship = "=" | "#" | "<" | ">" | "<=" | ">=" | "<>" .
+
+  SimpleExpr = ["+" | "-"] Term { ("+" | "-" | "or" | "xor") Term } .
+
+  Term = Factor { ("**" | "*" | "/" | "div" | "mod" | "&" | "and" | "shl" | "shr" | "sar") Factor } .
+
+  Factor = ["@" | "+" | "-"] ["not"] Primary .
+
+  Primary = pnumber | preal | StrChain | "nil" | InhCall | BuiltinCast | "[" [ SetElem { "," SetElem } ] "]" | "(" [ PItem { ( "," | ";" ) [ PItem ] } ] ")" { "^" { Selector } } | XIdent Postfix .
+  BuiltinCast = ( IntType | RealType | CharType | BoolType ) "(" [ ParamList ] ")" .
+  PItem = Expr [ ":" Expr ] .
+  StrChain = ( pstring | CharLit ) { pstring | CharLit } .
+  SetElem = Expr [ ".." Expr ] .
+  CharLit = ( "#" pnumber | "^" ident ) { "#" pnumber | "^" ident } .
+  Selector = "." XIdent | "[" Expr { ( "," | ":" ) Expr } "]" | "^" .
+
+END FPC.

grammars/FreePascal/tests/class.pas

@@ -0,0 +1,40 @@
+program ClassTest;
+type
+  TBase = class(TObject)
+  private
+    FCount: Integer;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure SetCount(V: Integer);
+    function GetCount: Integer;
+    property Count: Integer read GetCount write SetCount default 0;
+  end;
+  THelper = class helper for TBase
+    function Doubled: Integer;
+  end;
+constructor TBase.Create;
+begin
+  FCount := 0;
+end;
+destructor TBase.Destroy;
+begin
+  inherited;
+end;
+procedure TBase.SetCount(V: Integer);
+begin
+  FCount := V;
+end;
+function TBase.GetCount: Integer;
+begin
+  GetCount := FCount;
+end;
+function THelper.Doubled: Integer;
+begin
+  Doubled := Count * 2;
+end;
+var B: TBase;
+begin
+  B := TBase.Create;
+  B.Count := 5;
+end.

grammars/FreePascal/tests/deep.pas

@@ -0,0 +1,47 @@
+PROGRAM Deep;
+LABEL 10;
+CONST N = 10;
+  Pi = 3.14159;
+TYPE
+  IntArr = ARRAY [1..10] OF INTEGER;
+  TColor = (red, green, blue);
+  PInt = ^INTEGER;
+  TPoint = RECORD x, y: INTEGER END;
+VAR
+  i, j: INTEGER;
+  ch: CHAR;
+  b: BOOLEAN;
+  r: REAL;
+  s: STRING;
+  a: IntArr;
+  pt: TPoint;
+  p: PInt;
+FUNCTION Sum(a, b: INTEGER): INTEGER;
+BEGIN
+  Sum := a + b
+END;
+PROCEDURE Fill(VAR a: IntArr; Value: INTEGER);
+VAR k: INTEGER;
+BEGIN
+  FOR k := 1 TO N DO a[k] := Value
+END;
+BEGIN
+  s := 'hello' + '!';
+  FOR i := 1 TO N DO a[i] := i;
+  WHILE i < N DO i := i + 1;
+  REPEAT
+    CASE i OF
+      1: Write(1);
+      2, 3: Write(2)
+    ELSE
+      Write(9)
+    END;
+  UNTIL i > N;
+  10: pt.x := Sum(1, 2);
+  IF b THEN GOTO 10;
+  r := 1.5E-3;
+  b := (i = 1) AND (j <> 2) OR NOT b;
+  Fill(a, 0);
+  Fill(a, 7);
+  WriteLn('done')
+END.

grammars/P4/README.md

@@ -0,0 +1,82 @@
+# P4 Pascal validator pilot
+
+`p4_pascal.atg` describes Wirth's Pascal-P4 (1977) compiler input. It
+needed a full repair pass to build with Coco/R V1.53 (`CR`) and GNU
+Modula-2 (`gm2 -fiso`), all diagnosed against `fpc -Miso` as oracle:
+
+1. Bare `;` is not a Coco/R literal — every statement separator is
+   written `";"` (this alone was 5 of the original errors; the same
+   applies inside `(...)` groups).
+2. The `Statement` production was missing its terminating `.`.
+3. `EmptyStatement = ""` is illegal — empty positions use the
+   `[ X { ";" [ X ] } ]` list shape instead (progress-guaranteed, so
+   the generated parser cannot hang on empty matches).
+4. `ident` cannot be both a `TOKENS` class and a production (renamed
+   the literal tokens to `pnumber`/`pstring`); `EOF` is reserved
+   (dropped the junk line with it); the start production must match
+   the `COMPILER` name.
+5. Left-recursive `Primary "^"` rewritten as a postfix loop.
+6. Undefined nonterminals filled in: element productions extracted
+   from the `...List` wrappers (`ConstDecl`, `TypeDecl`, `VarDecl`),
+   `ProcDecl` (nested procedures/functions), `Value`, `PointerType`,
+   `noQuote1`, `ParList`→`ParamList`, `Stmts`→`Statements`,
+   `CaseStatement`/`WhileStatement`/`...`→actual names,
+   `Var`→`VarIdent`.
+7. Name collisions in generated `CASE` statements fixed by merging:
+   duplicate `for..to/downto` branches, duplicate `Type/StructType`
+   entries (`ArrayType`/`SetType`/`ProcType` reachable twice), and
+   ident-led `Assignment` vs `ProcCall` (single `IdentTail` dispatch
+   on `:=` vs `(`).
+8. Grammar gaps closed to oracle level: `TypeIdent` (named types —
+   without it every `VAR x: MyType` failed), `Compound` program bodies,
+   trailing-`;`-tolerant sections/fields/case-items, `{}` comments,
+   subscripts/field selectors in statements and expressions,
+   `and`/`or` words alongside P4 `&`, bare parameterless calls,
+   statement labels + `goto` (+`LabelSection`), `and`-less `or`...,
+   formal parameter groups (`name: type`, `var`-prefixed) for
+   declarations (call sites keep expression lists), subrange array
+   indices (`1..10`), const expressions as `Value`, `CASE` branches
+   take a single statement (also fixes a `;`-separator competition),
+   multi-routine `{ ProcDecl }` blocks.
+
+Two benign LL(1) warning families remain (dangling-`ELSE`, loop-exit
+`";"` greediness — both resolve correctly).
+
+Floats (`1.5E-3`), enums, subranges (`0..255`, `N..M`, dotted names)
+and `Label = pnumber | ident` (enum case labels; statement labels stay
+numeric-only or `i := 1` breaks on the `:=`) were added to oracle
+level afterwards.
+
+`if`/`while`/`for` branches take a single `Statement` (standard Pascal
+— plural branches greedily swallow the `;` separating `case` items,
+so `if..then begin..end;` inside a `case` branch broke), and
+`begin..end` compounds are statements in their own right.
+
+The generated parser gets a strict EOF check
+(`IF sym # 0 THEN SynError(0)` after the start symbol in `Parse`,
+patched in by `build.sh` with a loud assertion): without it, the
+Coco/R driver never scans past the program's final `.`, silently
+ignoring trailing garbage — and worse, masking any failure that
+leaves a `.` behind. This makes the validator marginally stricter
+than `fpc`, which accepts trailing junk after `END.` — degenerate
+input only, documented here.
+
+## Build
+
+```sh
+./build.sh        # -> build/P4 (build/ is git-ignored)
+```
+
+Needs `CR` (Coco/R), `gm2 -fiso`, the `parser.frm`/`scanner.frm`
+frames and `FileIO.def/.mod` — all resolved from the environment with
+sensible defaults (`CRFRAMES`, `M2LIB`, `CR`, `GM2`).
+
+## Differential results (P4 vs `fpc -Miso`)
+
+Accept battery + `tests/deep.pas` (labels/goto, nested routines with
+`var` params, records, enums, subranges, sets, pointers, all
+statements, hex-free literals): **0 false positives**. Broken
+mutants: **0 missed**, positions close. P4-era shapes (`&`, `#`,
+`unit` sections, `return`) are accepted leniently although `fpc
+-Miso` rejects them (direction is accept-more, so these can only ever
+be missed rejections, never false positives).

grammars/P4/build.sh

@@ -0,0 +1,45 @@
+#!/bin/bash
+# Build the P4 Pascal syntax validator from p4_pascal.atg.
+# Needs: CR (Coco/R V1.53), gm2 -fiso, parser/scanner frames, FileIO.
+# Note: link via the two-step module list; a single-step link trips
+# over pre-existing errors in this gm2 build's own ISO library .defs.
+set -e
+CR="${CR:-/home/eric/Projets/Projets-Modula2/MyWork/CocoGm2/CR}"
+GM2="${GM2:-/home/eric/bin/Modula2/Gm2/bin/gm2}"
+FRAMES="${CRFRAMES:-/home/eric/Projets/Projets-Modula2/MyWork/Theia/GNU-grammar/build}"
+M2LIB="${M2LIB:-/home/eric/Projets/Projets-Modula2/MyWork/Theia/GNU-grammar/build}"
+HERE="$(cd "$(dirname "$0")" && pwd)"
+B="$HERE/build"
+rm -rf "$B"
+mkdir -p "$B"
+cp "$HERE/p4_pascal.atg" "$B/"
+cp "$M2LIB/FileIO.def" "$M2LIB/FileIO.mod" "$B/"
+cd "$B"
+echo "=== CR ==="; CRFRAMES="$FRAMES" "$CR" -m -C p4_pascal.atg
+echo "=== patch: EOF check ==="
+python3 - "$B" <<'PYEOF'
+import sys
+b = sys.argv[1]
+s = open(b + '/P4P.mod').read()
+old = '    P4S.Reset; Get;\n    P4;\n\n  END Parse;'
+assert old in s, 'EOF patch pattern missing'
+s = s.replace(old, '    P4S.Reset; Get;\n    P4;\n    IF sym # 0 THEN SynError(0) END;\n\n  END Parse;')
+open(b + '/P4P.mod', 'w').write(s)
+print('patched')
+PYEOF
+echo "=== check: no degenerate code ==="
+if grep -q "IF FALSE\\|WHILE FALSE" P4P.mod; then echo "DEGENERATE GENERATION (IF/WHILE FALSE)"; exit 1; fi
+echo "=== compile ==="
+for m in FileIO P4S P4P P4; do "$GM2" -fiso -I . -c "$m.mod"; done
+echo "=== link ==="
+# NOTE: the gen step exits 1 on pre-existing errors in gm2's own
+# ISO library .defs, but still writes a usable modules.lst.
+"$GM2" -fiso -I . -fgen-module-list=modules.lst -o /dev/null FileIO.o P4S.o P4P.o P4.mod || true
+"$GM2" -fiso -I . -fuse-list=modules.lst -o P4 FileIO.o P4S.o P4P.o P4.mod
+echo "=== smoke ==="
+printf 'PROGRAM Hello;\nBEGIN\n  WriteLn('"'"'hi'"'"');\nEND.\n' > Hello.pas
+./P4 Hello.pas
+printf 'PROGRAM T;\nBEGIN\nEND. GARBAGE\n' > Garbage.pas
+if ./P4 Garbage.pas 2>&1 | grep -q "Incorrect"; then echo "trailing-garbage rejected"; else echo "EOF CHECK FAILED"; exit 1; fi
+./P4 "$HERE/tests/deep.pas"
+rm -f Hello.pas Hello.LST Garbage.pas Garbage.LST "$HERE/tests/deep.LST"

grammars/P4/p4_pascal.atg

@@ -0,0 +1,142 @@
+(* Pascal P4 ATG for Coco/R *)
+(* Pascal-4 (1977) - N. Wirth's fourth Pascal implementation *)
+(* Features: Nested procedures/functions, empty procedures *)
+
+(* Tags: P4, PASCAL4, WIRTH *)
+
+COMPILER P4
+IGNORE CASE
+
+CHARACTERS
+  eol = CHR(13) .
+  letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
+  digit = "0123456789" .
+  noQuote1 = ANY - "'" - eol .
+IGNORE CHR(9) .. CHR(13)
+COMMENTS FROM "(*" TO "*)" NESTED
+COMMENTS FROM "{" TO "}"
+
+TOKENS
+  ident = letter { letter | digit } .
+  pnumber = digit { digit } | digit { digit } CONTEXT ( ".." ) .
+  preal = digit { digit } "." digit { digit } [ "E" [ "+" | "-" ] digit { digit } ] .
+  pstring = "'" { noQuote1 | "''" } "'" .
+
+
+
+PRODUCTIONS
+
+  P4 = "program" ident ";" Block "." .
+
+  Block = [ UnitSection ] DeclPart [ Compound ] .
+  Compound = "begin" Statements "end" .
+
+  UnitSection = "unit" ident ";" { FileSection } "end" ident "." .
+
+  FileSection = ident { ";" ident } .
+
+  DeclPart = [ LabelSection ] [ ConstSection ] [ TypeSection ] [ VarSection ] { ProcDecl }.
+  LabelSection = "label" Label { "," Label } ";" .
+
+  ConstSection = "const" [ ConstDecl { ";" [ ConstDecl ] } ] .
+  ConstDecl = ident "=" Value .
+  Value = Expr .
+
+  TypeSection = "type" [ TypeDecl { ";" [ TypeDecl ] } ] .
+  TypeDecl = ident "=" Type .
+
+  VarSection = "var" [ VarDecl { ";" [ VarDecl ] } ] .
+  VarDecl = identlist ":" Type .
+  ProcDecl = ( "procedure" | "function" ) ident [ FormalParams ] [ ":" Type ] ";" Block ";" .
+  FormalParams = "(" [ FormalGroup { ";" FormalGroup } ] ")" .
+  FormalGroup = [ "var" ] identlist ":" Type .
+
+  identlist = ident { "," ident } .
+
+  Type = SimpleType | StructType | PointerType | EnumType | TypeIdent .
+  EnumType = "(" ident { "," ident } ")" .
+  TypeIdent = ident { "." ident } [ ".." ( ident | [ "-" ] pnumber ) ] | [ "-" ] pnumber [ ".." ( ident | [ "-" ] pnumber ) ] .
+  PointerType = "^" Type .
+
+  SimpleType = integertype | realtype | charType | booleanType .
+
+  integertype = "integer" .
+  realtype = "real" .
+  charType = "char" .
+  booleanType = "boolean" .
+
+  StructType = ArrayType | RecordType | SetType | ProcType .
+
+  ArrayType = "array" "[" IndexList "]" "of" Type .
+
+  IndexList = Index { "," Index } .
+  Index = SimpleType | Value [ ".." Value ] .
+
+  RecordType = "record" FieldList "end" .
+
+  FieldList = [ Field { ";" [ Field ] } ] .
+
+  Field = identlist ":" Type .
+
+  SetType = "set" "of" Type .
+
+  ProcType = "procedure" ParamList ";" { [ ConstDecl ";" TypeDecl ";" VarDecl ";" ProcDecl ] } ";" .
+
+  Statements = [ Statement { ";" [ Statement ] } ] .
+
+  IfStatement = "if" Expr "then" Statement { "else" Statement } .
+
+  Statement = [ pnumber ":" ]
+            ( IfStatement
+            | CaseStmt
+            | WhileStmt
+            | RepeatStmt
+            | ForStmt
+            | "goto" Label
+            | ident IdentTail
+            | ReturnStmt
+            | Compound
+            | ProcDecl ) .   (* Nested procedure *)
+
+  CaseStmt = "case" Expr "of" [ CaseItem { ";" [ CaseItem ] } ] "end" .
+
+  CaseItem = LabelList ":" Statement .
+
+  LabelList = Label { "," Label } .
+
+  Label = pnumber | ident .
+
+  WhileStmt = "while" Expr "do" Statement .
+
+  RepeatStmt = "repeat" Statements "until" Expr .
+
+  ForStmt = "for" ident ":=" Expr ( "to" | "downto" ) Expr "do" Statement .
+
+  IdentTail = [ Selector { Selector } ] [ ":=" Expr | "(" [ ParamList ] ")" ] .
+  Selector = "." ident | "[" Expr { "," Expr } "]" | "^" .
+
+
+  ParamList = Param { "," Param } .
+
+  Param = Expr .
+
+  ReturnStmt = "return" [ Expr ] .
+
+
+  Expr = SimpleExpr [ Relationship SimpleExpr ] .
+
+  Relationship = "=" | "#" | "<" | ">" | "<=" | ">=" | "<>" .
+
+  SimpleExpr = ["+" | "-"] Term { ("+" | "-" | "or") Term } .
+
+  Term = Factor { ("*" | "/" | "div" | "mod" | "&" | "and") Factor } .
+
+  Factor = ["+" | "-"] ["not"] Primary .
+
+  Primary = pnumber | preal | pstring | "(" Expr ")" | ident { Selector } [ "(" [ ParamList ] ")" ] .
+
+
+
+
+
+END P4.

grammars/P4/tests/deep.pas

@@ -0,0 +1,54 @@
+PROGRAM Deep;
+LABEL 10;
+CONST N = 10;
+  Neg = -5;
+  Pi = 3.14159;
+  Hello = 'hi';
+TYPE
+  IntArr = ARRAY [1..10] OF INTEGER;
+  Matrix = ARRAY [0..1, 0..2] OF INTEGER;
+  Point = RECORD x, y: INTEGER END;
+  Color = (red, green, blue);
+  PInt = ^INTEGER;
+  Small = 0..255;
+VAR
+  i, j: INTEGER;
+  ch: CHAR;
+  b: BOOLEAN;
+  r: REAL;
+  a: IntArr;
+  pt: Point;
+  col: Color;
+  p: PInt;
+FUNCTION Sum(a, b: INTEGER): INTEGER;
+BEGIN
+  Sum := a + b
+END;
+FUNCTION IsOdd(n: INTEGER): BOOLEAN;
+BEGIN
+  IsOdd := ODD(n)
+END;
+PROCEDURE Fill(VAR a: IntArr; Value: INTEGER);
+VAR k: INTEGER;
+BEGIN
+  FOR k := 1 TO N DO a[k] := Value
+END;
+BEGIN
+  FOR i := 1 TO N DO a[i] := i;
+  WHILE i < N DO i := i + 1;
+  REPEAT
+    CASE i OF
+      1: Write(1);
+      2, 3: Write(2)
+    END;
+  UNTIL i > N;
+  col := red;
+  pt.x := Sum(1, 2);
+  p := NIL;
+  10: i := 0;
+  IF IsOdd(i) THEN GOTO 10;
+  r := 1.5E-3;
+  b := (i = 1) AND (j <> 2) OR NOT b;
+  Fill(a, 0);
+  WriteLn('done')
+END.

grammars/P6/README.md

@@ -0,0 +1,57 @@
+# P6 Pascal validator pilot
+
+`p6_pascal.atg` describes Wirth's Pascal-P6 (1980) compiler input. It
+shares the P4 skeleton (same repair pass: quoted `";"` literals,
+terminated productions, no `""` empties, no `ident`/token double
+definitions, no reserved words as productions, start production
+matching `COMPILER`, left-recursion removal, filled-in undefined
+nonterminals, merged duplicate branches, lenient list shapes) plus its
+own deltas, all diagnosed against `fpc -Miso` as oracle:
+
+- `EnumType` (`(red, green, blue)`) alongside the other types.
+- `ParamType` (`array[expr] of T`, expression bounds) merged with
+  `ArrayType` into a single `Bound` form (`SimpleType` for
+  `array[boolean]`-style index types, `Expr [".." Expr]` for ranges
+  and computed bounds) — the two `array[`-led productions generated
+  duplicate `CASE` labels and would not compile separately.
+- `ProcSection` (`proc`-led procedural-type form) kept reachable via
+  `StructType`.
+- `Label = pnumber | ident` (enum case labels), with statement labels
+  kept numeric-only — an optional `[Label ":"]` prefix commits on
+  `ident` and then chokes on `:=`, so `i := 1` would break; `fpc`
+  rejects ident-statement-labels anyway.
+- P4's `preal`/`CONTEXT("..")`/subrange `TypeIdent` upgrade carried
+  over (floats, `0..255`, `N..M`, dotted names).
+
+The generated parser gets a strict EOF check
+(`IF sym # 0 THEN SynError(0)` after the start symbol in `Parse`,
+patched in by `build.sh` with a loud assertion): without it, the
+Coco/R driver never scans past the program's final `.`, silently
+ignoring trailing garbage — and worse, masking any failure that
+leaves a `.` behind (e.g. unhandled float syntax). This makes the
+validator marginally stricter than `fpc`, which accepts trailing junk
+after `END.` — degenerate input only, documented here.
+
+Two benign LL(1) warning families remain (dangling-`ELSE`, loop-exit
+`";"` greediness — both resolve correctly).
+
+`if`/`while`/`for` branches take a single `Statement` (standard Pascal
+— plural branches greedily swallow the `;` separating `case` items),
+and `begin..end` compounds are statements in their own right.
+
+## Build
+
+```sh
+./build.sh        # -> build/P6 (build/ is git-ignored)
+```
+
+Needs `CR` (Coco/R), `gm2 -fiso`, the `parser.frm`/`scanner.frm`
+frames and `FileIO.def/.mod` — all resolved from the environment with
+sensible defaults (`CRFRAMES`, `M2LIB`, `CR`, `GM2`).
+
+## Differential results (P6 vs `fpc -Miso`)
+
+Accept battery (transferred from P4) + `tests/deep.pas` (enums,
+records, subrange-free shapes, nested routines, labels/goto, all
+statements): **0 false positives**. Broken mutants: **0 missed**,
+positions close.

grammars/P6/build.sh

@@ -0,0 +1,50 @@
+#!/bin/bash
+# Build the P6 Pascal syntax validator from p6_pascal.atg.
+# Needs: CR (Coco/R V1.53), gm2 -fiso, parser/scanner frames, FileIO.
+# Note: link via the two-step module list; a single-step link trips
+# over pre-existing errors in this gm2 build's own ISO library .defs.
+set -e
+CR="${CR:-/home/eric/Projets/Projets-Modula2/MyWork/CocoGm2/CR}"
+GM2="${GM2:-/home/eric/bin/Modula2/Gm2/bin/gm2}"
+FRAMES="${CRFRAMES:-/home/eric/Projets/Projets-Modula2/MyWork/Theia/GNU-grammar/build}"
+M2LIB="${M2LIB:-/home/eric/Projets/Projets-Modula2/MyWork/Theia/GNU-grammar/build}"
+HERE="$(cd "$(dirname "$0")" && pwd)"
+B="$HERE/build"
+rm -rf "$B"
+mkdir -p "$B"
+cp "$HERE/p6_pascal.atg" "$B/"
+cp "$M2LIB/FileIO.def" "$M2LIB/FileIO.mod" "$B/"
+cd "$B"
+echo "=== CR ==="; CRFRAMES="$FRAMES" "$CR" -m -C p6_pascal.atg
+echo "=== patch: EOF check ==="
+python3 - <<'EOF'
+s = open('P6P.mod').read()
+old = '''    P6S.Reset; Get;
+    P6;
+
+  END Parse;'''
+assert old in s, 'EOF patch pattern missing'
+s = s.replace(old, '''    P6S.Reset; Get;
+    P6;
+    IF sym # 0 THEN SynError(0) END;
+
+  END Parse;''')
+open('P6P.mod', 'w').write(s)
+print('patched')
+EOF
+echo "=== check: no degenerate code ==="
+if grep -q "IF FALSE\|WHILE FALSE" P6P.mod; then echo "DEGENERATE GENERATION (IF/WHILE FALSE)"; exit 1; fi
+echo "=== compile ==="
+for m in FileIO P6S P6P P6; do "$GM2" -fiso -I . -c "$m.mod"; done
+echo "=== link ==="
+# NOTE: the gen step exits 1 on pre-existing errors in gm2's own
+# ISO library .defs, but still writes a usable modules.lst.
+"$GM2" -fiso -I . -fgen-module-list=modules.lst -o /dev/null FileIO.o P6S.o P6P.o P6.mod || true
+"$GM2" -fiso -I . -fuse-list=modules.lst -o P6 FileIO.o P6S.o P6P.o P6.mod
+echo "=== smoke ==="
+printf 'PROGRAM Hello;\nBEGIN\n  WriteLn('"'"'hi'"'"');\nEND.\n' > Hello.pas
+./P6 Hello.pas
+printf 'PROGRAM T;\nBEGIN\nEND. GARBAGE\n' > Garbage.pas
+if ./P6 Garbage.pas 2>&1 | grep -q "Incorrect"; then echo "trailing-garbage rejected"; else echo "EOF CHECK FAILED"; exit 1; fi
+./P6 "$HERE/tests/deep.pas"
+rm -f Hello.pas Hello.LST Garbage.pas Garbage.LST "$HERE/tests/deep.LST"

grammars/P6/p6_pascal.atg

@@ -0,0 +1,142 @@
+(* Pascal P4 ATG for Coco/R *)
+(* Pascal-4 (1977) - N. Wirth's fourth Pascal implementation *)
+(* Features: Nested procedures/functions, empty procedures *)
+
+(* Tags: P4, PASCAL4, WIRTH *)
+
+COMPILER P6
+IGNORE CASE
+
+CHARACTERS
+  eol = CHR(13) .
+  letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
+  digit = "0123456789" .
+  noQuote1 = ANY - "'" - eol .
+IGNORE CHR(9) .. CHR(13)
+COMMENTS FROM "(*" TO "*)" NESTED
+COMMENTS FROM "{" TO "}"
+
+TOKENS
+  ident = letter { letter | digit } .
+  pnumber = digit { digit } | digit { digit } CONTEXT ( ".." ) .
+  preal = digit { digit } "." digit { digit } [ "E" [ "+" | "-" ] digit { digit } ] .
+  pstring = "'" { noQuote1 | "''" } "'" .
+
+
+
+PRODUCTIONS
+
+  P6 = "program" ident ";" Block "." .
+
+  Block = [ UnitSection ] DeclPart [ Compound ] .
+  Compound = "begin" Statements "end" .
+
+  UnitSection = "unit" ident ";" { FileSection } "end" ident "." .
+
+  FileSection = ident { ";" ident } .
+
+  DeclPart = [ LabelSection ] [ ConstSection ] [ TypeSection ] [ VarSection ] { ProcDecl }.
+  LabelSection = "label" Label { "," Label } ";" .
+
+  ConstSection = "const" [ ConstDecl { ";" [ ConstDecl ] } ] .
+  ConstDecl = ident "=" Value .
+  Value = Expr .
+
+  TypeSection = "type" [ TypeDecl { ";" [ TypeDecl ] } ] .
+  TypeDecl = ident "=" Type .
+
+  VarSection = "var" [ VarDecl { ";" [ VarDecl ] } ] .
+  VarDecl = identlist ":" Type .
+  ProcDecl = ( "procedure" | "function" ) ident [ FormalParams ] [ ":" Type ] ";" Block ";" .
+  FormalParams = "(" [ FormalGroup { ";" FormalGroup } ] ")" .
+  FormalGroup = [ "var" ] identlist ":" Type .
+
+  identlist = ident { "," ident } .
+
+  Type = SimpleType | StructType | PointerType | TypeIdent .
+  TypeIdent = ident { "." ident } [ ".." ( ident | [ "-" ] pnumber ) ] | [ "-" ] pnumber [ ".." ( ident | [ "-" ] pnumber ) ] .
+  PointerType = "^" Type .
+
+  SimpleType = integertype | realtype | charType | booleanType .
+
+  integertype = "integer" .
+  realtype = "real" .
+  charType = "char" .
+  booleanType = "boolean" .
+
+  StructType = ArrayType | RecordType | SetType | EnumType | ProcSection .
+
+  ArrayType = "array" "[" Bound { "," Bound } "]" "of" Type .
+
+  Bound = SimpleType | Expr [ ".." Expr ] .
+
+  RecordType = "record" FieldList "end" .
+
+  FieldList = [ Field { ";" [ Field ] } ] .
+
+  Field = identlist ":" Type .
+
+  SetType = "set" "of" Type .
+
+  EnumType = "(" ident { "," ident } ")" .
+
+  ProcSection = "proc" ParamList ";" { [ ConstDecl ";" TypeDecl ";" VarDecl ] } ";" .
+
+  Statements = [ Statement { ";" [ Statement ] } ] .
+
+  IfStatement = "if" Expr "then" Statement { "else" Statement } .
+
+  Statement = [ pnumber ":" ]
+            ( IfStatement
+            | CaseStmt
+            | WhileStmt
+            | RepeatStmt
+            | ForStmt
+            | "goto" Label
+            | ident IdentTail
+            | ReturnStmt
+            | Compound
+            | ProcDecl ) .   (* Nested procedure *)
+
+  CaseStmt = "case" Expr "of" [ CaseItem { ";" [ CaseItem ] } ] "end" .
+
+  CaseItem = LabelList ":" Statement .
+
+  LabelList = Label { "," Label } .
+
+  Label = pnumber | ident .
+
+  WhileStmt = "while" Expr "do" Statement .
+
+  RepeatStmt = "repeat" Statements "until" Expr .
+
+  ForStmt = "for" ident ":=" Expr ( "to" | "downto" ) Expr "do" Statement .
+
+  IdentTail = [ Selector { Selector } ] [ ":=" Expr | "(" [ ParamList ] ")" ] .
+  Selector = "." ident | "[" Expr { "," Expr } "]" | "^" .
+
+
+  ParamList = Param { "," Param } .
+
+  Param = Expr .
+
+  ReturnStmt = "return" [ Expr ] .
+
+
+  Expr = SimpleExpr [ Relationship SimpleExpr ] .
+
+  Relationship = "=" | "#" | "<" | ">" | "<=" | ">=" | "<>" .
+
+  SimpleExpr = ["+" | "-"] Term { ("+" | "-" | "or") Term } .
+
+  Term = Factor { ("*" | "/" | "div" | "mod" | "&" | "and") Factor } .
+
+  Factor = ["+" | "-"] ["not"] Primary .
+
+  Primary = pnumber | preal | pstring | "(" Expr ")" | ident { Selector } [ "(" [ ParamList ] ")" ] .
+
+
+
+
+
+END P6.

grammars/P6/tests/deep.pas

@@ -0,0 +1,26 @@
+PROGRAM Deep;
+LABEL 10;
+CONST N = 10;
+TYPE
+  Color = (red, green, blue);
+  IntArr = ARRAY [1..10] OF INTEGER;
+VAR
+  i: INTEGER;
+  col: Color;
+  a: IntArr;
+PROCEDURE Show(c: Color);
+BEGIN
+  WriteLn('c')
+END;
+BEGIN
+  col := red;
+  CASE col OF
+    red: Write(1);
+    green, blue: Write(2)
+  END;
+  Show(col);
+  FOR i := 1 TO N DO a[i] := i;
+  10: i := 0;
+  IF i = 0 THEN GOTO 10;
+  WriteLn('done')
+END.