P2 Pascal validator pilot (pcom oracle, uppercase grammar, builds, tests)

grammars/P2/README.md

@@ -0,0 +1,90 @@
+# P2 Pascal validator pilot
+
+`p2_pascal.atg` describes Wirth/Ammann Pascal-P2 (1972-73) as
+implemented by `pcom`. It was authored from the P4 pilot skeleton and
+corrected against some 60 oracle probes — every construct below was
+checked against the real compiler, whose parser (`pcomp.pas`) is the
+ground truth for the language. (The `Grammars/P2/p2_pascal.atg` file in
+the reference collection is a mislabeled Oberon grammar, unrelated.)
+
+## Oracle notes
+
+`pcom` was built with `fpc -Miso` from the ISO-7185-modified sources
+(`Pascal-P2-master/source/`), needing a one-character fix in a
+`/tmp` copy (duplicate `'1'` in an identifier-scan set that fpc
+rejects). Behaviors the harness must respect, all verified:
+
+- **Uppercase only** (CDC charset): lowercase never assigns the
+  scanner symbol and the compiler ping-pongs forever. Test sources
+  are uppercase; the validator is case-sensitive and rejects
+  lowercase cleanly (oracle-consistent, never a false positive).
+- **Trailing newline required**: files without one spin at EOF
+  (`EOF ENCOUNTERED` flood). The harness appends `\n`.
+- **Spin on sync-loss**: illegal characters (`_ & { @ #` → error
+  399) and some shapes never recover — the compiler loops instead of
+  listing. Harness rule: timeout (10s; valid programs finish
+  instantly) counts as oracle-reject. Every accept-case was verified
+  to terminate.
+- Verdicts: `**** ^NNN` markers in the listing (`NNN` is Wirth's
+  error number); absence = accept. Semantic markers (undeclared
+  identifiers etc.) also count as reject, so the battery uses only
+  well-formed programs.
+- `PROGRAM T; BEGIN END.` (no `VAR`) and `PROGRAM HELLO(OUTPUT)`
+  both terminate cleanly — used as harness sanity checks.
+
+Key probed P2 facts (vs P4): `AND`/`OR`/`NOT` words but **no `&`**;
+`DIV`/`MOD`/`IN`; `CASE` with **no `ELSE`**; `(* *)` comments that
+do **not nest**, no `{}`; numeric-only labels and `GOTO`; reals
+strictly `digits.digits[E...]` (no `1.`, no `.5`); consts are
+`[sign] literal` (no expressions); enums without `= N`; set
+elements without `..` ranges; untagged variants rejected
+(`CASE tag: type` required); `TEXT`/`FILE` types absent
+(`FILE OF` → 399 unimplemented); `PACK`/`UNPACK`/`PRED`/`SUCC`
+parse but unconditionally mark 399 (stubs — kept out of the
+battery); `NEW` exists but `DISPOSE` does not (`RELEASE` does);
+no `ROUND`/`HALT`/`EXIT`/`RETURN`; no procedural types (the
+compiler crashes on them); no `EXTERN`; `FORWARD` exists;
+`WRITELN`/`READLN`/`READ`/`EOF`/etc. require parentheses
+(`WRITELN;` is error 9) while user routines allow bare calls;
+`EOLN`/`READ` take file args; `PACKED`, multi-dim arrays,
+subrange/const bounds, `CHAR` indices, pointer forwards,
+`OTHERWISE`-less everything.
+
+## Grammar notes
+
+Single-statement `if`/`while`/`for` branches (standard Pascal, avoids
+`;`-capture across case items), `begin..end` compounds as statements,
+trailing-`;`-tolerant sections/fields/case-items, order-free
+repeatable declaration sections (as in pcom's `BLOCK`), mandatory
+`(`...`)` on the 13+16 predeclared routines (`StdProc`/`StdFunc`,
+which is what rejects bare `WRITELN;`), write-width params,
+`PROGRAM name[(files)]` headings, strict EOF check (patched into
+`Parse` by `build.sh`, which also fails on degenerate `IF/WHILE
+FALSE` generation).
+
+Lenient acceptances (documented misses, never false positives):
+`DISPOSE`/`ROUND`/user-`TEXT` parse as ordinary identifier calls/
+types although pcom marks them; lowercase is rejected while fpc
+would accept (P2 direction wins — pcom is the oracle here).
+
+## Build
+
+```sh
+./build.sh        # -> build/P2 (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 (P2 vs `pcom`)
+
+Accept battery (23 cases: all statements, `NEW`/deref/`NIL`,
+`ORD`/`CHR`, reals, strings, sets, `ODD`/`TRUNC`, trig, `EOF(INPUT)`)
++ `tests/deep.pas` (labels/goto, nested routines with `var` params,
+records, enums, subranges, pointers, all statements): **0 false
+positives**. Broken mutants (13, incl. spin-cases `&`, `{}`, `@`,
+unterminated comment, `ELSE`, ident labels, `1.5.2`, bare
+`WRITELN`): **0 missed**, positions close. Real P2 corpus
+(`Pascal-P2-master/sample_programs`, `p2/Examples`): 5/5 agree
+(`qsort` needed the trailing-newline normalization).

grammars/P2/build.sh

@@ -0,0 +1,45 @@
+#!/bin/bash
+# Build the P2 Pascal syntax validator from p2_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/p2_pascal.atg" "$B/"
+cp "$M2LIB/FileIO.def" "$M2LIB/FileIO.mod" "$B/"
+cd "$B"
+echo "=== CR ==="; CRFRAMES="$FRAMES" "$CR" -m -C p2_pascal.atg
+echo "=== check: no degenerate code ==="
+if grep -q "IF FALSE\|WHILE FALSE" P2P.mod; then echo "DEGENERATE GENERATION (IF/WHILE FALSE)"; exit 1; fi
+echo "=== patch: EOF check ==="
+python3 - "$B" <<'PYEOF'
+import sys
+b = sys.argv[1]
+s = open(b + '/P2P.mod').read()
+old = '    P2S.Reset; Get;\n    P2;\n\n  END Parse;'
+assert old in s, 'EOF patch pattern missing'
+s = s.replace(old, '    P2S.Reset; Get;\n    IF sym # 0 THEN P2 END;\n    IF sym # 0 THEN SynError(0) END;\n\n  END Parse;')
+open(b + '/P2P.mod', 'w').write(s)
+print('patched')
+PYEOF
+echo "=== compile ==="
+for m in FileIO P2S P2P P2; 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 P2S.o P2P.o P2.mod || true
+"$GM2" -fiso -I . -fuse-list=modules.lst -o P2 FileIO.o P2S.o P2P.o P2.mod
+echo "=== smoke ==="
+printf 'PROGRAM HELLO;\nBEGIN\n  WRITELN('"'"'HI'"'"');\nEND.\n' > Hello.pas
+./P2 Hello.pas
+printf 'PROGRAM T;\nBEGIN\nEND. GARBAGE\n' > Garbage.pas
+if ./P2 Garbage.pas 2>&1 | grep -q "Incorrect"; then echo "trailing-garbage rejected"; else echo "EOF CHECK FAILED"; exit 1; fi
+./P2 "$HERE/tests/deep.pas"
+rm -f Hello.pas Hello.LST Garbage.pas Garbage.LST "$HERE/tests/deep.LST"

grammars/P2/p2_pascal.atg

@@ -0,0 +1,150 @@
+(* P2 Pascal ATG for Coco/R *)
+(* Wirth/Ammann Pascal-P2 (1972-73), as implemented by pcom *)
+(* Uppercase only (CDC charset); probed against pcom, never fpc *)
+
+(* Tags: P2, PASCALP2, WIRTH *)
+
+COMPILER P2
+
+CHARACTERS
+  eol = CHR(13) .
+  letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" .
+  digit = "0123456789" .
+  noQuote1 = ANY - "'" - eol .
+IGNORE CHR(9) .. CHR(13)
+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
+
+  P2 = "PROGRAM" ident [ "(" ident { "," ident } ")" ] ";" Block "." .
+
+  Block = DeclPart [ Compound ] .
+  Compound = "BEGIN" Statements "END" .
+
+  DeclPart = { LabelSection | ConstSection | TypeSection | VarSection | ProcDecl } .
+  LabelSection = "LABEL" Label { "," Label } ";" .
+
+  ConstSection = "CONST" [ ConstDecl { ";" [ ConstDecl ] } ] .
+  ConstDecl = ident "=" Value .
+  Value = [ "+" | "-" ] ( pnumber | preal | pstring | ident ) .
+
+  TypeSection = "TYPE" [ TypeDecl { ";" [ TypeDecl ] } ] .
+  TypeDecl = ident "=" Type .
+
+  VarSection = "VAR" [ VarDecl { ";" [ VarDecl ] } ] .
+  VarDecl = identlist ":" Type .
+  ProcDecl = ( "PROCEDURE" | "FUNCTION" ) ident [ FormalParams ] [ ":" Type ] ";" ( "FORWARD" | Block ) ";" .
+  FormalParams = "(" [ FormalGroup { ";" FormalGroup } ] ")" .
+  FormalGroup = [ "VAR" ] identlist ":" Type
+              | ( "PROCEDURE" | "FUNCTION" ) ident [ FormalParams ] [ ":" Type ] .
+
+  identlist = ident { "," ident } .
+
+  Type = SimpleType | StructType | PointerType | EnumType | TypeIdent .
+  EnumType = "(" ident { "," ident } ")" .
+  TypeIdent = ident [ ".." ( ident | [ "-" ] pnumber ) ] | [ "-" ] pnumber [ ".." ( ident | [ "-" ] pnumber ) ] .
+  PointerType = "^" Type .
+
+  SimpleType = integertype | realtype | charType | booleanType .
+
+  integertype = "INTEGER" .
+  realtype = "REAL" .
+  charType = "CHAR" .
+  booleanType = "BOOLEAN" .
+
+  StructType = [ "PACKED" ] ( ArrayType | RecordType ) | SetType .
+
+  ArrayType = "ARRAY" "[" Bound { "," Bound } "]" "OF" Type .
+
+  Bound = SimpleType | Expr [ ".." Expr ] .
+
+  RecordType = "RECORD" FieldList "END" .
+
+  FieldList = [ Field { ";" [ Field ] } ] .
+
+  Field = FieldListPart ":" Type | VariantPart .
+
+  FieldListPart = ident { "," ident } .
+
+  VariantPart = "CASE" Type ":" Type "OF" [ Variant { ";" [ Variant ] } ] .
+  Variant = LabelList ":" "(" FieldList ")" .
+
+  SetType = "SET" "OF" Type .
+
+  Statements = [ Statement { ";" [ Statement ] } ] .
+
+  IfStatement = "IF" Expr "THEN" Statement { "ELSE" Statement } .
+
+  Statement = [ pnumber ":" ]
+            ( IfStatement
+            | CaseStmt
+            | WhileStmt
+            | RepeatStmt
+            | ForStmt
+            | GotoStmt
+            | WithStmt
+            | StdProcCall
+            | ident IdentTail
+            | Compound
+            | ProcDecl ) .
+
+  StdProcCall = StdProc "(" [ ParamList ] ")" .
+  StdProc = "GET" | "PUT" | "RESET" | "REWRITE" | "READ" | "WRITE"
+          | "PACK" | "UNPACK" | "NEW" | "RELEASE" | "READLN" | "WRITELN" | "MARK" .
+
+  CaseStmt = "CASE" Expr "OF" [ CaseItem { ";" [ CaseItem ] } ] "END" .
+
+  CaseItem = CaseLabelList ":" Statement .
+
+  CaseLabelList = CaseLabel { "," CaseLabel } .
+  CaseLabel = pnumber | ident | pstring .
+
+  LabelList = Label { "," Label } .
+
+  Label = pnumber .
+
+  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 [ ":" Expr [ ":" Expr ] ] .
+
+  WithStmt = "WITH" WithItem { "," WithItem } "DO" Statement .
+  WithItem = ident .
+
+  GotoStmt = "GOTO" Label .
+
+  Expr = SimpleExpr [ ( Relationship | "IN" ) SimpleExpr ] .
+
+  Relationship = "=" | "<" | ">" | "<=" | ">=" | "<>" .
+
+  SimpleExpr = ["+" | "-"] Term { ("+" | "-" | "OR") Term } .
+
+  Term = Factor { ("*" | "/" | "DIV" | "MOD" | "AND") Factor } .
+
+  Factor = ["+" | "-"] ["NOT"] Primary .
+
+  Primary = pnumber | preal | pstring | "NIL" | StdFuncCall | "(" Expr ")" | ident { Selector } [ "(" [ ParamList ] ")" ] .
+  StdFuncCall = StdFunc "(" [ ParamList ] ")" .
+  StdFunc = "ABS" | "SQR" | "TRUNC" | "ODD" | "ORD" | "CHR"
+          | "PRED" | "SUCC" | "EOF" | "EOLN" | "SIN" | "COS" | "EXP" | "SQRT" | "LN" | "ARCTAN" .
+
+
+
+END P2.

grammars/P2/tests/deep.pas

@@ -0,0 +1,54 @@
+PROGRAM DEEP(INPUT, OUTPUT);
+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.