Real Blaise Pascal validator pilot (grammar, prescan, builds, tests)

grammars/Blaise/BlaiseV.sh

@@ -0,0 +1,25 @@
+#!/bin/sh
+# BlaiseV: Blaise Pascal syntax validator front-end.
+# Filters TEXT_BLOCK literals to plain strings (length-preserving, so
+# diagnostics keep exact positions), then runs the Coco/R validator.
+HERE="$(dirname "$0")"
+SRC="$1"
+if [ -z "$SRC" ]; then
+  echo "No input file specified"
+  exit 1
+fi
+TMP="$(mktemp /tmp/blaisev.XXXXXX.pas)"
+"$HERE/BlaiseTF" "$SRC" "$TMP" 2>/dev/null || { echo "Could not filter input file"; rm -f "$TMP"; exit 1; }
+"$HERE/BlaiseParse" "$TMP"
+RC=$?
+# move the listing next to the original source under its basename
+DIR="$(dirname "$SRC")"
+BASE="$(basename "$SRC")"
+BASE="${BASE%.*}"
+if [ -f "$TMP.LST" ] || [ -f "${TMP%.pas}.LST" ]; then
+  for L in "$TMP.LST" "${TMP%.pas}.LST"; do
+    if [ -f "$L" ]; then mv "$L" "$DIR/$BASE.LST"; fi
+  done
+fi
+rm -f "$TMP" "${TMP%.pas}".*
+exit $RC

grammars/Blaise/README.md

@@ -1,43 +1,81 @@
-# Blaise validator pilot
-
-`blaise_pascal.atg` is byte-identical to the classic-Oberon grammar
-(`Grammars/Oberon-grammar/original_oberon.atg`) apart from its tag
-line — despite the name, it describes Oberon, not Pascal. It needed
-the same 4 fixes as the Oberon-07 pilot to build with Coco/R V1.53
-(`CR`) and GNU Modula-2 (`gm2 -fiso`), all diagnosed against `ulmo`
-(Ulm Oberon) as oracle:
-
-1. `statement`: `assignment | ProcedureCall` factored into
-   `AssignmentOrProcedureCall` (duplicate `CASE` labels — uncompilable).
-2. `designator`: dropped `"(" qualident ")"` (hijacked call parens).
-3. `qualident`: `[ ident "." ] ident` rewritten as
-   `ident { "." ident }` (optional-prefix lookahead trap).
-4. `real` requires post-dot digits + `CONTEXT ("..")` on integers
-   (the `2..3` lexer trap).
-
-(No `FOR` production added: like Oberon-07, `ulmo` rejects `FOR`, so
-grammar and oracle agree.)
-
-Two benign LL(1) warnings remain. Note: `ulmo`'s backend aborts with
-an `OberonAMD64.Pass2` assertion on every successful parse in this
-environment, so it serves as a frontend-only oracle (its `**` error
-lines); `voc` independently compiles `tests/deep.Mod` clean.
+# Blaise Pascal validator pilot
+
+`blaise_pascal.atg` is a genuine Blaise Pascal grammar authored from
+`Blaise/blaise-master/docs/grammar.ebnf` (Phases 1-9a) — **not** the
+`Blaise-grammar/blaise_pascal.atg` installed next to the IDE sources,
+which is byte-identical to the classic-Oberon grammar apart from its
+tag line and describes Oberon, not Pascal.
+
+The EBNF turned out to be an incomplete guide to the language, so the
+grammar was developed against the `blaise` v0.14.0-SNAPSHOT oracle
+binary instead (~80 oracle probes settling every uncertain point),
+plus a 403-file project corpus. Findings (all encoded in the `.atg`
+header comment):
+
+- The EBNF expression section omits `or`, `in`, unary minus, `#nn`
+  character literals and float literals — the oracle accepts all.
+- The EBNF statement section omits `break`, `continue`,
+  `case..of..(else)..end` and `repeat..until` — all oracle-proven.
+- Interface and implementation sections routinely carry `type` and
+  `var` sections (300+ corpus files) — the EBNF allows none.
+- Declaration sections come in any order and repeat
+  (`const` before `type`, ...); statement lists and routine bodies
+  tolerate a missing `;` before the closing keyword.
+- `set of (A, B, C)` (inline enum) is EBNF-documented but
+  oracle-rejected; dotted names in const/array/set positions are
+  oracle-rejected too (both accepted here — lenient superset).
+- `TBox(T) = class` (paren form) is oracle-rejected; only `TBox<T>`
+  declares a generic type. `class(TObject);` (forward, no `end`) is
+  oracle-accepted although the EBNF requires `end`.
+- Bare `Foo;` calls, `inherited;` without parens, `:=` in `var`
+  sections and `=`-style defaults are all oracle-rejected with
+  explicit messages; the grammar matches.
+- Contextual keywords (`static`, `read`/`write`, `property`,
+  `reference`, `on`, `Supports`, ...) were each probed against the
+  oracle and either kept as identifiers with structural handling or
+  reserved — see the header comment.
+
+Known validator gaps (all zero-impact on the corpus unless noted):
+
+- Explicit generic free-function calls `f<T>(x)` (zero corpus use).
+- Typed-parameter arrow lambdas (zero corpus use).
+- `asm` routine bodies (RTL files only, documented).
+- Nested procedures inside methods (rare, documented).
+
+`TEXT_BLOCK` literals (`''' ... '''`) cannot be expressed in Coco/R
+tokens (the merged scanner DFA cannot tell `'''`-open apart from
+string-escape), so a small length-preserving pre-scan filter
+(`TextFilter.mod`) rewrites blocks to plain strings before parsing.
+Positions are preserved exactly; the shipped `BlaiseV` is a front-end
+script (`BlaiseParse` + `BlaiseTF` + temp-file handling).
 
 ## Build
 
 ```sh
-./build.sh        # -> build/Blaise (build/ is git-ignored)
+./build.sh        # -> build/BlaiseV (+BlaiseParse, BlaiseTF; build/ 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`).
+sensible defaults (`CRFRAMES`, `M2LIB`, `CR`, `GM2`). Note: link via
+the two-step module list (`-fgen-module-list` then `-fuse-list`); a
+single-step link trips over pre-existing errors in this gm2 build's
+own ISO library `.def` files (`RndFile`/`TermFile`/`ChanConsts`
+set-constructor complaints).
+
+Coco/R reports 0 errors and only benign LL(1) warnings (loop-exit and
+documented first-alternative orderings, each triaged).
 
-## Differential results (Blaise vs `ulmo`)
+## Differential results (BlaiseV vs `blaise`)
 
-19 accept probes + `tests/deep.Mod` (records, pointers, nested
-recursion, CASE ranges, hex/reals/strings): **0 false positives**.
-9 broken mutants: **0 missed**, positions close. `voc` quirks do not
-apply here (`ulmo` is the oracle); the one systematic divergence is
-`WITH` bare fields, which `ulmo` rejects while the validator accepts
-(lenient direction, same as the Oberon-07 pilot).
+- Accept battery (statements, expressions, types, classes, generics,
+  lambdas, exceptions, char/textblock literals): **0 false positives**.
+- Broken mutants: **0 missed**, positions close.
+- `tests/deep.pas`: compiles clean with the oracle AND validates
+  clean (const/type/var/threadvar sections, records, classes with
+  static members/properties, interfaces, procedural/reference types,
+  generics, all statements, lambdas, exceptions).
+- Full project corpus (403 files): 387 clean-agree, 0 missed; the
+  16 remaining validator-FPs all contain `asm` routine bodies
+  (documented gap above), and the 5 oracle-rejected files are
+  correctly rejected by the validator too.

grammars/Blaise/TextFilter.mod

@@ -0,0 +1,184 @@
+MODULE TextFilter;
+(* Pre-scan filter for the Blaise validator: rewrites TEXT_BLOCK literals
+ * (''' ... ''') into plain string-shaped placeholders so the Coco/R
+ * scanner (which cannot distinguish '''-open from string-escape in its
+ * merged DFA) never sees triple quotes.
+ *
+ * Length- and newline-preserving: every rewritten block keeps the exact
+ * byte length and all newline positions, so parser diagnostics keep
+ * correct line/column positions. Only well-formed blocks (opening '''
+ * directly followed by a newline, outside strings/comments) are
+ * rewritten; anything else passes through untouched.
+ *
+ * Usage: TextFilter <input.pas> <output.pas> *)
+
+  FROM FileIO IMPORT File, NextParameter, Open, Okay, Close, Length,
+                     StdOut, WriteString, WriteLn, Reset, EndOfFile;
+  IMPORT FileIO;
+  FROM Storage IMPORT ALLOCATE;
+
+  VAR
+    srcName, dstName: ARRAY [0..255] OF CHAR;
+    src, dst: File;
+    buf: POINTER TO ARRAY [0..16777215] OF CHAR;
+    len: CARDINAL;
+    i, n: CARDINAL;
+
+  PROCEDURE At (p: CARDINAL): CHAR;
+    BEGIN
+      RETURN buf^[p]
+    END At;
+
+  PROCEDURE Put (p: CARDINAL; c: CHAR);
+    BEGIN
+      buf^[p] := c
+    END Put;
+
+  PROCEDURE IsNl (c: CHAR): BOOLEAN;
+    BEGIN
+      RETURN (c = CHR(10)) OR (c = CHR(13))
+    END IsNl;
+
+  PROCEDURE SkipString;
+    (* buf[i] = opening quote; skip through closing quote (''-aware). *)
+    BEGIN
+      INC(i);
+      WHILE (i < len) & (At(i) # "'") & ~ IsNl(At(i)) DO
+        IF (At(i) = "'") & (i + 1 < len) & (At(i + 1) = "'") THEN
+          INC(i, 2)
+        ELSE
+          INC(i)
+        END
+      END;
+      IF (i < len) & (At(i) = "'") THEN INC(i) END
+    END SkipString;
+
+  PROCEDURE SkipBrace;
+    (* buf[i] = "{"; skip through "}". *)
+    BEGIN
+      INC(i);
+      WHILE (i < len) & (At(i) # "}") DO INC(i) END;
+      IF (i < len) THEN INC(i) END
+    END SkipBrace;
+
+  PROCEDURE SkipLine;
+    (* buf[i..] starts "//"; skip through newline (exclusive). *)
+    BEGIN
+      INC(i, 2);
+      WHILE (i < len) & ~ IsNl(At(i)) DO INC(i) END
+    END SkipLine;
+
+  PROCEDURE SkipParen;
+    (* buf[i..] starts "(*"; skip through matching "*)" (nested). *)
+    VAR depth: INTEGER;
+    BEGIN
+      depth := 1; INC(i, 2);
+      WHILE (i < len) & (depth > 0) DO
+        IF (At(i) = "(") & (i + 1 < len) & (At(i + 1) = "*") THEN
+          INC(depth); INC(i, 2)
+        ELSIF (At(i) = "*") & (i + 1 < len) & (At(i + 1) = ")") THEN
+          DEC(depth); INC(i, 2)
+        ELSE
+          INC(i)
+        END
+      END
+    END SkipParen;
+
+  PROCEDURE TryTextBlock (): BOOLEAN;
+    (* buf[i..i+2] = "'''", not preceded by a quote. If directly followed
+       by a newline, blank the whole block to a string-shaped placeholder
+       (same length, newlines kept) and return TRUE. *)
+    VAR j, k: CARDINAL; nl: BOOLEAN;
+    BEGIN
+      IF (i + 2 >= len) THEN RETURN FALSE END;
+      IF (At(i) # "'") OR (At(i + 1) # "'") OR (At(i + 2) # "'") THEN
+        RETURN FALSE
+      END;
+      IF (i > 0) & (At(i - 1) = "'") THEN RETURN FALSE END;
+      j := i + 3;
+      nl := FALSE;
+      IF (j < len) & (At(j) = CHR(13)) THEN
+        INC(j);
+        IF (j < len) & (At(j) = CHR(10)) THEN INC(j) END;
+        nl := TRUE
+      ELSIF (j < len) & (At(j) = CHR(10)) THEN
+        INC(j);
+        nl := TRUE
+      END;
+      IF ~ nl THEN RETURN FALSE END;
+      k := j;
+      WHILE (k + 2 < len) & ~ ((At(k) = "'") & (At(k + 1) = "'") & (At(k + 2) = "'")) DO
+        INC(k)
+      END;
+      IF (k + 2 >= len) THEN RETURN FALSE END;
+      Put(i + 1, " "); Put(i + 2, " ");
+      WHILE j < k DO
+        IF ~ IsNl(At(j)) THEN Put(j, " ") END;
+        INC(j)
+      END;
+      Put(k, " "); Put(k + 1, " ");
+      i := k + 3;
+      RETURN TRUE
+    END TryTextBlock;
+
+  PROCEDURE Run;
+    BEGIN
+      i := 0;
+      WHILE i < len DO
+        IF (At(i) = "'") THEN
+          IF ~ TryTextBlock() THEN SkipString END
+        ELSIF (At(i) = "{") THEN SkipBrace
+        ELSIF (At(i) = "/") & (i + 1 < len) & (At(i + 1) = "/") THEN SkipLine
+        ELSIF (At(i) = "(") & (i + 1 < len) & (At(i + 1) = "*") THEN SkipParen
+        ELSE INC(i)
+        END
+      END
+    END Run;
+
+  PROCEDURE ReadAll;
+    VAR c: CHAR;
+    BEGIN
+      len := VAL(CARDINAL, Length(src));
+      ALLOCATE(buf, len + 1);
+      Reset(src);
+      n := 0;
+      WHILE ~ EndOfFile(src) & (n < len) DO
+        FileIO.Read(src, c);
+        Put(n, c);
+        INC(n)
+      END
+    END ReadAll;
+
+  PROCEDURE WriteAll;
+    VAR m: CARDINAL;
+    BEGIN
+      Open(dst, dstName, TRUE);
+      IF ~ Okay THEN
+        WriteString(StdOut, "Could not open output file"); WriteLn(StdOut);
+        HALT
+      END;
+      m := 0;
+      WHILE m < len DO
+        FileIO.Write(dst, At(m));
+        INC(m)
+      END;
+      Close(dst)
+    END WriteAll;
+
+  BEGIN
+    NextParameter(srcName);
+    NextParameter(dstName);
+    IF (srcName[0] = 0C) OR (dstName[0] = 0C) THEN
+      WriteString(StdOut, "Usage: TextFilter <input> <output>"); WriteLn(StdOut);
+      HALT
+    END;
+    Open(src, srcName, FALSE);
+    IF ~ Okay THEN
+      WriteString(StdOut, "Could not open input file"); WriteLn(StdOut);
+      HALT
+    END;
+    ReadAll;
+    Close(src);
+    Run;
+    WriteAll
+  END TextFilter.

grammars/Blaise/blaise_pascal.atg

@@ -1,95 +1,348 @@
-(* Tags: BLAISE, BLAISEPASCALE, BLA *)
-(* Tags: ORIGINAL, OISOberon, Classic, ETHOberon *)
-COMPILER Oberon
-(* A grammar for Oberon *)
+COMPILER Blaise
+IGNORE CASE
+(* Blaise Pascal grammar for Coco/R, derived from
+ * Blaise/blaise-master/docs/grammar.ebnf (Phases 1-9a) and validated
+ * against the blaise v0.14.0-SNAPSHOT oracle binary.
+ *
+ * Syntax-only validator grammar: no semantic actions. Deliberate
+ * divergences from the reference, all in the lenient (accept-more)
+ * direction except where noted:
+ * - TEXT_BLOCK literals (''' ... ''') are rewritten to plain strings
+ *   by a length-preserving pre-scan filter (TextFilter): the merged
+ *   Coco/R scanner DFA cannot tell '''-open apart from string-escape,
+ *   so the grammar never sees triple quotes. Classic strings may span
+ *   lines (superset, harmless) so filtered blocks lex as one string;
+ *   positions are preserved exactly.
+ * - {$...} directives are skipped as comments, including $IFDEF bodies
+ *   (no conditional-compilation processing).
+ * - "property", "read", "write", "operator", "reference", "object",
+ *   "weak", "message", "on", "Supports" stay identifiers (all
+ *   oracle-proven usable as such); "property" declarations, accessors
+ *   and "on"-clauses ("on E do", "on V: E do") are recognized
+ *   structurally by position.
+ * - Visibility words (private/protected/public/published/strict),
+ *   "inherited", "out", "packed", "break", "continue" are reserved
+ *   (all oracle-proven); directive words double as ordinary names via
+ *   NIdent in every member/routine/type/const/var/param/enum/selector
+ *   position (only structural slots keep the bare keywords).
+ * - "static" is an identifier: bare "static" in member position is a
+ *   section qualifier, "static var" flows into VarSection, everything
+ *   else flows into the normal member loop. A member named "static"
+ *   followed by "procedure" etc. would misparse (vanishingly rare).
+ * - Explicit generic free-function calls (f<T>(x)) need two-token
+ *   lookahead the reference parser has but Coco/R lacks (documented
+ *   gap, zero corpus use); generic DECLARATIONS are fully supported,
+ *   and value-position "<"-brackets take lenient generic-argument
+ *   expressions so dotted comparisons (Obj.F < X) never misparse
+ *   (the tree may differ, the verdict never does).
+ * - Arrow lambdas use "->" (the EBNF ARROW token is never defined, but
+ *   the whole corpus uses "->"; "=>" never appears in code). Bare and
+ *   parenthesised untyped params are supported; typed-param lambdas
+ *   ((x: T) -> ...) are a documented gap (zero corpus use).
+ * - AsmBlock bodies are opaque assembly text and cannot be tokenised;
+ *   routines with asm bodies are a documented gap (RTL files only).
+ * - "or" (additive level), "in" (comparison level), unary minus,
+ *   character literals (#nn, adjacently concatenated) and float
+ *   literals are accepted in runtime expressions although the EBNF
+ *   expression section omits them — the oracle binary accepts all of
+ *   them, so the EBNF is incomplete there, not the validator. String
+ *   concatenation with named constants ('a' + B) folds into the same
+ *   arithmetic chain (superset, harmless).
+ * - "break", "continue", "case..of..(else)..end" and "repeat..until"
+ *   exist although the EBNF statement section omits them (all oracle-
+ *   proven, all heavily used in the corpus). Case labels reuse the set-
+ *   element shape (single values and ranges). Empty statements (a bare
+ *   ";" or comment-only branches) are accepted per the EBNF Stmt.
+ * - A "class of T" metaclass type, "class;" / "class(X);" forward
+ *   forms, pointer-deref with selectors (P^.F), call-then-select
+ *   (F(X).Y), parenthesised-lvalue assignment ((E).F := v) and
+ *   "[Weak]"/"[TestCase(...)]" attribute prefixes are all accepted
+ *   (oracle-proven or corpus-proven).
+ * - A "static" routine implementation following a type/const/var
+ *   section in the same block is folded into that section's last
+ *   declaration (single-token decision on "=" vs routine keywords);
+ *   otherwise the section loop would choke on the identifier.
+ * - Conditional-compilation fragments ({$IFDEF}/{$ELSE}/{$ENDIF}
+ *   skipped as comments) that leave complete sequential constructs —
+ *   repeated uses-groups, stray begin..end blocks at declaration
+ *   level — are accepted (superset, harmless); truly split constructs
+ *   may still error (rare).
+ * - A routine body needs no trailing ";" before the enclosing "end"
+ *   (oracle-accepted although the EBNF requires one).
+ * - Declaration sections (type/const/var/threadvar/routines) may appear
+ *   in any order and repeat, in programs, units and routine bodies —
+ *   the oracle accepts const-before-type etc. although the EBNF shows
+ *   type-first only.
+ * - Statement lists tolerate a missing ";" before the closing keyword
+ *   ("begin S end", "S; else/end" in case/except) although the EBNF shape
+ *   does not — the oracle accepts all of them. The ";"-led loops use a
+ *   progress-guaranteed [";" [X]] shape (never nullable members, which
+ *   would hang the generated parser).
+ * - Stray/leading semicolons (";", "S1;; S2") are rejected although
+ *   the EBNF empty-Stmt accepts them (typo-grade code only).
+ * - Bare identifier statements ("Foo;") are rejected; the oracle
+ *   requires "()" for parameterless calls (explicit oracle message).
+ * - "inherited" requires a method name with mandatory parens (oracle).
+ * - Method-call parens are optional (lenient); "procedure of Foo"
+ *   (only "object" is valid) and similar are accepted (lenient).
+ * - Method bodies use a RoutineBlock whose members never start with a
+ *   bare identifier (nested routines are keyword-led); otherwise the
+ *   optional body would spuriously swallow a following member ("static",
+ *   fields, ...) and hang-or-error. In-class members use an even tighter
+ *   ClassBodyBlock (no nested routines: a bodiless in-class method never
+ *   absorbs the next member; nested-in-method is a documented rare gap).
+ *   Full Blocks stay everywhere a block is required, not optional.
+ * - Method directives are a closed vocabulary (virtual/override/
+ *   abstract/reintroduce/forward/overload/varargs/cdecl/stdcall/pascal/
+ *   safecall/inline/final/sealed/dynamic/deprecated/external). A bare
+ *   identifier is NOT a directive, so a following member (notably
+ *   "static ...") is never swallowed. Directive words that occur as
+ *   unit/member names ("assembler", "nostackframe", "register") stay
+ *   identifiers; "overload"/"varargs" are also legal unit-name parts.
+ * - MethodSignature, TypeRef and StrLit are used but never defined in
+ *   the reference; they are read as routine-signature shape, a type
+ *   name, and a string literal. Dotted unit names may repeat in
+ *   semicolon-separated groups (conditional-compilation fragments)
+ *   and use directive-tolerant components.
+ * - Leading-underscore identifiers (_Foo) are accepted (used by the
+ *   RTL although the EBNF IDENT cannot lex them).
+ * - The quote-content set excludes CHR(0): otherwise an unterminated
+ *   string at EOF spins the generated scanner forever
+ *   (pre-existing Coco/R quirk: NUL matches ANY-derived sets).
+ * - Dotted names are accepted in const requests, array indices and
+ *   set element types where the EBNF allows bare idents only
+ *   (oracle rejects them there; lenient superset, harmless).
+ *)
 
 CHARACTERS
-  eol      = CHR(13) .
+  eol      = CHR(10) .
+  nul      = CHR(0) .
   letter   = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
   digit    = "0123456789" .
   hexDigit = digit + "ABCDEF" .
-  noQuote  = ANY - '"' - eol  .
+  octDigit = "01234567" .
+  binDigit = "01" .
+  noQuote  = ANY - "'" - eol - nul .
 
-IGNORE  CHR(9) .. CHR(13)
+IGNORE CHR(9) .. CHR(13)
 
-COMMENTS
-  FROM "(*" TO "*)" NESTED
+COMMENTS FROM "(*" TO "*)" NESTED
+COMMENTS FROM "{" TO "}"
+COMMENTS FROM "//" TO eol
+COMMENTS FROM "{$" TO "}"
 
 TOKENS
-  ident   =  letter { letter | digit } .
-  integer  =  digit { digit } | digit { digit } CONTEXT ( ".." )
-           | digit { hexDigit } "H" .
-  real  =  digit { digit } "." digit { digit }
-           [ ("E" | "D") [ "+" | "-" ] digit { digit } ] .
-  CharConstant = digit { hexDigit } "X" .
-  string  =  '"' { noQuote } '"' .
+  ident   = ( letter | "_" ) { letter | digit | "_" } .
+  integer = digit { ["_"] digit } | digit { ["_"] digit } CONTEXT ( ".." )
+          | "$" hexDigit { ["_"] hexDigit }
+          | "&" octDigit { ["_"] octDigit }
+          | "%" binDigit { ["_"] binDigit } .
+  real    = digit { ["_"] digit } "." digit { ["_"] digit }
+            [ "E" ["+" | "-"] digit { ["_"] digit } ]
+          | digit { ["_"] digit } "E" ["+" | "-"] digit { ["_"] digit } .
+  string  = "'" { noQuote | eol | "''" } "'" .
 
 PRODUCTIONS
-  Oberon           =  module .
-  number           =  integer | real .
-  identdef         =  ident [ "*" ] .
-  qualident        =  ident { "." ident } .
-  ConstantDeclaration  =  identdef "=" ConstExpression .
-  ConstExpression  =  expression .
-  TypeDeclaration  =  identdef "=" type .
-  type             =  qualident | ArrayType | RecordType | PointerType | ProcedureType .
-  ArrayType        =  "ARRAY" length { "," length } "OF" type .
-  length           =  ConstExpression .
-  RecordType       =  "RECORD" [ "(" BaseType ")" ] FieldListSequence "END" .
-  BaseType         =  qualident .
-  FieldListSequence  =  FieldList { ";" FieldList } .
-  FieldList        =  [ IdentList ":" type ] .
-  IdentList        =  identdef { "," identdef } .
-  PointerType      =  "POINTER" "TO" type .
-  ProcedureType    =  "PROCEDURE" [ FormalParameters ] .
-  VariableDeclaration  =  IdentList ":" type .
-  designator       =  qualident { "." ident | "[" ExpList "]" | "^"  } .
-  ExpList          =  expression { "," expression } .
-  expression       =  SimpleExpression [ relation SimpleExpression ] .
-  relation         =  "=" | "#" | "<" | "<=" | ">" | ">=" | "IN" | "IS" .
-  SimpleExpression =  [ "+" | "-" ] term { AddOperator term } .
-  AddOperator      =  "+" | "-" | "OR" .
-  term             =  factor { MulOperator factor } .
-  MulOperator      =  "*" | "/" | "DIV" | "MOD" | "&" .
-  factor           =  number | CharConstant | string | "NIL" | set
-                      | designator [ ActualParameters ]
-                      | "(" expression ")" | "~" factor .
-  set              =  "{" [ element { "," element } ] "}" .
-  element          =  expression [ ".." expression ] .
-  ActualParameters =  "(" [ ExpList ] ")" .
-  statement        =  [ AssignmentOrProcedureCall | IfStatement |
-                        CaseStatement | WhileStatement | RepeatStatement |
-                        LoopStatement | WithStatement | "EXIT" |
-                        "RETURN" [ expression ] ] .
-  AssignmentOrProcedureCall = designator ( ":=" expression | [ ActualParameters ] ) .
-  StatementSequence =  statement { ";" statement } .
-  IfStatement      =  "IF" expression "THEN" StatementSequence
-                     { "ELSIF" expression "THEN" StatementSequence }
-                     [ "ELSE" StatementSequence ] "END" .
-  CaseStatement    =  "CASE" expression "OF" case { "|" case }
-                     [ "ELSE" StatementSequence ] "END" .
-  case             =  [ CaseLabelList ":" StatementSequence ] .
-  CaseLabelList    =  CaseLabels { "," CaseLabels } .
-  CaseLabels       =  ConstExpression [ ".." ConstExpression ] .
-  WhileStatement   =  "WHILE" expression "DO" StatementSequence "END" .
-  RepeatStatement  =  "REPEAT" StatementSequence "UNTIL" expression .
-  LoopStatement    =  "LOOP" StatementSequence "END" .
-  WithStatement    =  "WITH" qualident ":" qualident "DO" StatementSequence "END" .
-  ProcedureDeclaration  =  ProcedureHeading ";" ProcedureBody ident .
-  ProcedureHeading =  "PROCEDURE" [ "*" ] identdef [ FormalParameters ] .
-  ProcedureBody    =  DeclarationSequence [ "BEGIN" StatementSequence ] "END" .
-  ForwardDeclaration  =  "PROCEDURE" "^" ident [ "*" ] [ FormalParameters ] .
-  DeclarationSequence  =  {   "CONST" { ConstantDeclaration ";" }
-                            | "TYPE"  { TypeDeclaration ";" }
-                            | "VAR"   { VariableDeclaration ";" } }
-                          {   ProcedureDeclaration ";"
-                            | ForwardDeclaration ";" } .
-  FormalParameters =  "(" [ FPSection { ";" FPSection } ] ")" [ ":" qualident ] .
-  FPSection        =  [ "VAR" ] ident { "," ident } ":" FormalType .
-  FormalType       =  { "ARRAY" "OF" } (qualident | ProcedureType) .
-  ImportList       =  "IMPORT" import { "," import } ";" .
-  import           =  ident [ ":=" ident ] .
-  module           =  "MODULE" ident ";"
-                      [ ImportList ] DeclarationSequence
-                      [ "BEGIN" StatementSequence ] "END" ident "." .
-END Oberon.
+  Blaise          = program | Unit .
+  program         = "program" ident ";" [ UsesClause ] Block "." .
+  Unit            = "unit" NameComp { "." NameComp } ";" InterfaceSection
+                    ImplementationSection [ InitializationSection ]
+                    [ FinalizationSection ] "end" "." .
+  InterfaceSection = "interface" [ UsesClause ]
+                    { TypeSection | ConstSection | VarSection
+                    | ThreadVarSection | MethodSig | CompoundStmt [";"] } .
+  MethodSig       = MethodHead { MethodDirective ";" } .
+  ImplementationSection = "implementation" [ UsesClause ]
+                          { TypeSection | ConstSection | VarSection
+                          | ThreadVarSection | StandaloneDecl | CompoundStmt [";"] } .
+  InitializationSection = "initialization" StmtList .
+  FinalizationSection = "finalization" StmtList .
+  UsesClause      = "uses" UsesGroup { UsesGroup } .
+  UsesGroup       = UnitName { "," UnitName } ";" .
+  UnitName        = NameComp { "." NameComp } .
+  NameComp        = ident | "overload" | "varargs" | "external"
+                  | "set" | "threadvar"
+                  | "and" | "or" | "xor" | "div" | "mod" | "not"
+                  | "shl" | "shr" | "sar" | "in" | "is" | "as" .
+  NIdent          = ident | "virtual" | "override" | "abstract" | "reintroduce"
+                  | "forward" | "overload" | "varargs" | "cdecl" | "stdcall"
+                  | "pascal" | "safecall" | "inline" | "final" | "sealed"
+                  | "dynamic" | "deprecated" | "external" | "default" .
+
+  Block           = { TypeSection | ConstSection | VarSection
+                    | ThreadVarSection | StandaloneDecl }
+                    "begin" StmtList "end" .
+  RoutineBlock    = { TypeSection | ConstSection | VarSection
+                    | ThreadVarSection | MethodHead MethodTail }
+                    "begin" StmtList "end" .
+  ClassBodyBlock  = { TypeSection | ConstSection | VarSection
+                    | ThreadVarSection }
+                    "begin" StmtList "end" .
+
+  TypeSection     = "type" TypeDecl { TypeDecl } .
+  TypeDecl        = [ BracketAttr ] NIdent [ "<" TypeParamList ">" ]
+                    ( "=" TypeDef ";" | MethodHead MethodTail | PropertyRest ) .
+  TypeParamList   = ident { "," ident } .
+  TypeDef         = RecordDef | ClassDef | InterfaceDef | EnumDef
+                  | ProceduralType | IntSubrange | TypeName .
+  IntSubrange     = [ "-" ] integer ".." [ "-" ] integer .
+  RecordDef       = [ "packed" ] "record"
+                    { VisibilitySection | ConstSection | MemberField | AttrMember
+                    | MethodDecl | ClassOperatorDecl | VarSection | CompoundStmt [";"] }
+                    "end" .
+  ClassDef        = "class" ( "(" GenericName { "," GenericName } ")" ClassBody
+                    | "of" TypeName
+                    | ClassBody ) .
+  ClassBody       = [ { VisibilitySection | ConstSection | MemberField | AttrMember
+                      | MethodDecl | ClassOperatorDecl | VarSection | CompoundStmt [";"] } ]
+                    [ "end" ] .
+  VisibilitySection = [ "strict" ] ( "private" | "protected" )
+                    | ( "public" | "published" ) .
+  GenericName     = ident [ "<" TypeArgList ">" ] .
+  TypeArgList     = GenericName { "," GenericName } .
+  InterfaceDef    = "interface" [ "(" ident ")" ]
+                    { MethodSig | PropertyDecl } "end" .
+  MemberField     = IdentList [ ":" TypeName ";" | PropertyRest ] .
+  AttrMember      = BracketAttr { BracketAttr }
+                    ( MethodHead MethodTail
+                    | "class" ident [ "(" ParamList ")" ] ":" TypeName ";"
+                      { MethodDirective ";" } [ ClassBodyBlock [ ";" ] ]
+                    | IdentList ( ":" TypeName ";" | PropertyRest ) ) .
+  PropertyRest    = NIdent [ "[" NIdent ":" TypeName "]" ] ":" TypeName
+                    [ NIdent [ NIdent [ NIdent [ NIdent ] ] ] ] ";"
+                    [ "default" ";" ] .
+  BracketAttr     = "[" AttrItem { [ "," ] AttrItem } "]" .
+  AttrItem        = ident [ "(" [ ArgList ] ")" ] .
+  IdentList       = NIdent { "," NIdent } .
+  ClassOperatorDecl = "class" ident
+                    [ "(" ParamList ")" ] ":" TypeName ";"
+                    { MethodDirective ";" } [ ClassBodyBlock [ ";" ] ] .
+  MethodDecl      = MethodHead MethodTailClass .
+  MethodTailClass = { MethodDirective ";" } [ ClassBodyBlock [ ";" ] ] .
+  MethodHead      = ( "procedure" | "function" | "constructor" | "destructor" ) NIdent
+                    { "<" TypeParamList ">" | "." NIdent }
+                    [ "(" [ ParamList ] ")" ] [ ":" TypeName ] ";" .
+  MethodTail      = { NonBodylessDir ";" }
+                    [ BodylessDir ";" | RoutineBlock [ ";" ] ] .
+  NonBodylessDir  = "virtual" | "override" | "reintroduce"
+                  | "overload" | "varargs"
+                  | "cdecl" | "stdcall" | "pascal" | "safecall"
+                  | "inline" | "final" | "sealed" | "dynamic" | "deprecated" .
+  BodylessDir     = "forward" | "abstract" | ExternalDirective .
+  MethodDirective = "virtual" | "override" | "abstract" | "reintroduce"
+                  | "forward" | "overload" | "varargs"
+                  | "cdecl" | "stdcall" | "pascal" | "safecall"
+                  | "inline" | "final" | "sealed" | "dynamic" | "deprecated"
+                  | ExternalDirective .
+  ExternalDirective = "external" [ string ] [ ident string ] .
+  StandaloneDecl  = ClassOperatorDecl | MethodHead MethodTail | ident .
+  PropertyDecl    = [ BracketAttr ] NIdent PropertyRest .
+  ParamList       = ParamGroup { ";" ParamGroup } .
+  ParamGroup      = [ "var" | "out" | "const" ] IdentList ":" ParamType
+                    [ "=" DefaultValue ] .
+  ParamType       = "array" "of" ( "const" | TypeName )
+                  | TypeName .
+  DefaultValue    = ConstArithExpr | "nil" .
+
+  ConstSection    = "const" ConstDecl { ConstDecl } .
+  ConstDecl       = NIdent [ ":" ConstTypeAnnotation ]
+                    ( "=" ConstRhs ";" | MethodHead MethodTail | PropertyRest ) .
+  ConstTypeAnnotation = TypeName .
+  ConstRhs        = "(" ConstRhsElem { "," ConstRhsElem } ")"
+                  | ConstArithExpr
+                  | "[" [ ident { "," ident } ] "]" .
+  ConstRhsElem    = "(" ConstRhsElem { "," ConstRhsElem } ")"
+                  | ConstArithExpr .
+  ConstArithExpr  = ConstArithTerm { ( "+" | "-" | "or" | "xor" ) ConstArithTerm } .
+  ConstArithTerm  = ConstArithFactor
+                    { ( "*" | "/" | "div" | "mod" | "and" | "shl" | "shr" ) ConstArithFactor } .
+  ConstArithFactor = integer | real | StrChain
+                   | NIdent { Selector } [ "(" [ ArgList ] ")" ]
+                   | "-" ConstArithFactor | "(" ConstArithExpr ")" .
+
+  VarSection      = "var" VarDecl { VarDecl } .
+  ThreadVarSection = "threadvar" VarDecl { VarDecl } .
+  VarDecl         = [ BracketAttr ] IdentList
+                    ( ":" TypeName [ "=" ConstValue ] ";"
+                    | MethodHead MethodTail | PropertyRest ) .
+  ConstValue      = ConstRhs | "nil" .
+
+  TypeName        = "array" [ "[" ArrayIndexSpec "]" ] "of" TypeName
+                  | SetType
+                  | "^" TypeName
+                  | ident { "." NIdent | "<" TypeArgList ">" }
+                    [ ".." ident ] [ "to" ProcTypeCore ] .
+  ArrayIndexSpec  = ConstArithExpr
+                    [ ".." ConstArithExpr
+                      { "," ConstArithExpr ".." ConstArithExpr } ] .
+  EnumDef         = "(" EnumMember { "," EnumMember } ")" .
+  EnumMember      = NIdent [ "=" [ "-" ] integer ] .
+  SetType         = "set" "of"
+                    ( NIdent { "." NIdent } [ ".." ConstArithExpr ]
+                    | EnumDef
+                    | Subrange ) .
+  Subrange        = ConstArithExpr ".." ConstArithExpr .
+  ProcTypeCore    = ( "function" [ "(" [ ParamList ] ")" ] ":" TypeName [ "of" ident ]
+                    | "procedure" [ "(" [ ParamList ] ")" ] [ "of" ident ] ) .
+  ProceduralType  = ProcTypeCore .
+
+  StmtList        = [ Stmt { ";" [ Stmt ] } ] .
+  Stmt            = [ IfStmt | WhileStmt | ForStmt | TryStmt | CaseStmt | RepeatStmt
+                  | RaiseStmt | ExitStmt | CompoundStmt | BlockVarDeclStmt
+                  | "break" | "continue"
+                  | "inherited" ident "(" [ ArgList ] ")"
+                  | NIdent IdentStmtTail ] .
+  IdentStmtTail   = StmtTail
+                  | NIdent [ ":" NIdent { "." NIdent | "<" TypeArgList ">" } ]
+                    "do" Stmt .
+  StmtTail        = ":=" Expr
+                  | "^" { Selector } [ ":=" Expr ]
+                  | PostfixBody [ ":=" Expr ] .
+  PostfixBody     = ( Selector | "<" GenArgs [ ">" ] | "(" [ ArgList ] ")" ) Postfix .
+  Postfix         = { Selector | "<" GenArgs [ ">" ] | "(" [ ArgList ] ")" } .
+  GenArgs         = Additive { "," Additive } .
+  Selector        = "." NIdent [ "(" [ ArgList ] ")" ]
+                  | "[" Expr { "," Expr } "]" .
+  IfStmt          = "if" Expr "then" Stmt [ "else" Stmt ] .
+  WhileStmt       = "while" Expr "do" Stmt .
+  ForStmt         = "for" NIdent
+                    ( ":=" Expr ( "to" | "downto" ) Expr | "in" Expr )
+                    "do" Stmt .
+  TryStmt         = "try" StmtList ( "finally" StmtList | "except" ExceptBody ) "end" .
+  CaseStmt        = "case" Expr "of"
+                    [ OneCase { ";" [ OneCase ] } ] [ "else" StmtList ] "end" .
+  OneCase         = SetElement { "," SetElement } ":" Stmt .
+  RepeatStmt      = "repeat" StmtList "until" Expr .
+  ExceptBody      = StmtList [ "else" StmtList ] .
+  RaiseStmt       = "raise" [ Expr ] .
+  ExitStmt        = "exit" [ "(" Expr ")" ] .
+  CompoundStmt    = "begin" StmtList "end" .
+  BlockVarDeclStmt = "var" NIdent ":" TypeName [ ":=" Expr ] .
+  ArgList         = Expr { "," Expr } .
+
+  Expr            = Comparison [ ( "is" | "as" ) ident ] .
+  Comparison      = Additive
+                    [ ( "=" | "<>" | "<" | ">" | "<=" | ">=" | "in" ) Additive ] .
+  Additive        = Term { ( "+" | "-" | "or" ) Term } .
+  Term            = Factor
+                    { ( "*" | "/" | "div" | "mod" | "and" | "xor"
+                      | "shl" | "shr" | "sar" ) Factor } .
+  Factor          = ( integer | real | StrChain | "nil"
+                    | "[" [ SetElement { "," SetElement } ] "]"
+                    | AnonMethod
+                    | "@" Factor
+                    | "not" Factor
+                    | "-" Factor
+                    | "inherited" ident "(" [ ArgList ] ")"
+                    | NIdent Postfix [ "->" LambdaBody ]
+                    | "(" [ Expr { "," Expr } ] ")" { Selector } [ "->" LambdaBody ]
+                    ) { "^" { Selector } } .
+  CharLit         = "#" integer { "#" integer } .
+  SetElement      = Expr [ ".." Expr ] .
+  StrChain        = ( string | CharLit ) { ( string | CharLit ) } .
+  LambdaBody      = Expr | Block .
+  AnonMethod      = ( "procedure" | "function" )
+                    [ BracketAttr ]
+                    [ "(" [ ParamList ] ")" ] [ ":" TypeName ]
+                    Block .
+END Blaise.

grammars/Blaise/build.sh

@@ -1,24 +1,37 @@
 #!/bin/bash
-# Build the Blaise/classic-Oberon syntax validator from blaise_pascal.atg.
+# Build the Blaise Pascal syntax validator from blaise_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="$(dirname "$0")"
+HERE="$(cd "$(dirname "$0")" && pwd)"
 B="$HERE/build"
 rm -rf "$B"
 mkdir -p "$B"
-cp "$HERE/blaise_pascal.atg" "$B/"
+cp "$HERE/blaise_pascal.atg" "$HERE/TextFilter.mod" "$B/"
 cp "$M2LIB/FileIO.def" "$M2LIB/FileIO.mod" "$B/"
 cd "$B"
 echo "=== CR ==="; CRFRAMES="$FRAMES" "$CR" -m -C blaise_pascal.atg
 echo "=== compile ==="
-for m in FileIO OberonS OberonP; do "$GM2" -fiso -I . -c "$m.mod"; done
+for m in FileIO BlaiseS BlaiseP Blaise TextFilter; do "$GM2" -fiso -I . -c "$m.mod"; done
 echo "=== link ==="
-"$GM2" -fiso -I . -o Blaise FileIO.o OberonS.o OberonP.o Oberon.mod
+# 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 BlaiseS.o BlaiseP.o Blaise.mod || true
+"$GM2" -fiso -I . -fuse-list=modules.lst -o BlaiseParse FileIO.o BlaiseS.o BlaiseP.o Blaise.mod
+rm -f TextFilter.o
+"$GM2" -fiso -I . -fgen-module-list=modules.lst -o /dev/null FileIO.o TextFilter.mod || true
+"$GM2" -fiso -I . -fuse-list=modules.lst -o BlaiseTF FileIO.o TextFilter.mod
+cp "$HERE/BlaiseV.sh" BlaiseV
+chmod +x BlaiseV
 echo "=== smoke ==="
-printf 'MODULE Hello;\nIMPORT Out;\nBEGIN\n  Out.String("hi");\n  Out.Ln;\nEND Hello.\n' > Hello.Mod
-./Blaise Hello.Mod
-rm -f Hello.Mod Hello.LST
+printf 'program Hello;\nbegin\n  WriteLn('"'"'hi'"'"');\nend.\n' > Hello.pas
+./BlaiseV Hello.pas
+printf 'program Tb;\nvar s: String;\nbegin\ns := %s\nend.\n' "'''$(printf '\ndon'"'"'t\n')''';" > Tb.pas
+./BlaiseV Tb.pas
+./BlaiseV "$HERE/tests/deep.pas"
+rm -f Hello.pas Hello.LST Tb.pas Tb.LST "$HERE/tests/deep.LST"

grammars/Blaise/tests/deep.Mod

@@ -1,28 +0,0 @@
-MODULE Deep;
-IMPORT Out;
-CONST N = 10;
-TYPE
-  Point = RECORD x, y: INTEGER END;
-  Node = POINTER TO NodeDesc;
-  NodeDesc = RECORD key: INTEGER; left, right: Node END;
-VAR
-  pt: Point;
-  n: Node;
-  i: INTEGER;
-PROCEDURE Walk(t: Node);
-BEGIN
-  IF t # NIL THEN Walk(t.left); Walk(t.right) END
-END Walk;
-BEGIN
-  NEW(n);
-  n.key := 5; n.left := NIL;
-  pt.x := 1; pt.y := 2;
-  WHILE i < N DO INC(i) END;
-  CASE i OF
-    1..3: Out.Int(i, 0)
-    | 4, 5: Out.Char("x")
-  ELSE
-    Out.Ln
-  END;
-  Walk(n)
-END Deep.

grammars/Blaise/tests/deep.pas

@@ -0,0 +1,232 @@
+program Deep;
+{ Deep Blair Pascal surface test: must be accepted by the blaise oracle
+  AND by the Blaise validator pilot. }
+
+const
+  MaxItems = 100;
+  Neg = -5;
+  Pi = 3.14159;
+  Bits = 1 or 2 xor 4;
+  Sh = 1 shl 3 + 16 shr 2;
+  Mask = Bits and $FF;
+  Greeting = 'Hello, ' + 'world';
+  Names: array[0..1] of String = ('Sunny', 'Cloudy');
+  M: array[0..1, 0..2] of Integer = ((1, 2, 3), (4, 5, 6));
+
+type
+  TColor = (Red, Green, Blue);
+  TSub = Red..Blue;
+  TByte = 0..255;
+  TNeg = -10..10;
+  TArr = array[0..9] of Integer;
+  TMatrix = array[0..1, 0..2] of Integer;
+  TByColor = array[TColor] of Integer;
+  TByBool = array[Boolean] of Integer;
+  TDyn = array of Integer;
+  TSet = set of TColor;
+  TByteSet = set of Byte;
+  TRangeSet = set of 0..255;
+  PInt = ^Integer;
+  PPInt = ^PInt;
+  TPoint = record
+    X, Y: Integer;
+    function Sum: Integer;
+  end;
+  TPacked = packed record
+    B: Byte;
+    I: Integer;
+  end;
+  TLogger = class(TObject)
+  private
+    FName: String;
+    [Weak] FParent: TLogger;
+  public
+    constructor Create(AName: String); overload;
+    destructor Destroy; override;
+    procedure Log(Msg: String);
+    function Level: Integer;
+    function GetItem(Index: Integer): Integer;
+    procedure SetItem(Index: Integer; Value: Integer);
+    static var Count: Integer;
+    property Name: String read FName write FName;
+    property Items[Index: Integer]: Integer read GetItem write SetItem; default;
+  end;
+  TBox = class
+  public
+    function Get<T>(X: T): Integer;
+  end;
+  IShape = interface
+    function Area: Integer;
+    function GetSize: Integer;
+    property Size: Integer read GetSize;
+  end;
+  EApp = class
+  end;
+  INamed = interface(IShape)
+    function Title: String;
+  end;
+  TProc = reference to procedure(Value: Integer);
+  TFunc = reference to function(A, B: Integer): Integer;
+  TSingle = reference to function(N: Integer): Integer;
+  TMyMeth = procedure of object;
+
+  TGetInt = function: Integer;
+
+const
+  Primary = [Red, Green];
+
+var
+  i, j: Integer;
+  b: Boolean;
+  r: Integer;
+  s: TSet;
+  a: TArr;
+  mat: TMatrix;
+  p: PInt;
+  logger: TLogger;
+  box: TBox;
+  shape: IShape;
+  callback: TFunc;
+  oneparam: TSingle;
+  counter: Integer = 0;
+
+threadvar
+  TLS: Integer;
+
+function TPoint.Sum: Integer;
+begin
+  Result := X + Y
+end;
+
+constructor TLogger.Create(AName: String);
+begin
+  inherited Create();
+  FName := AName
+end;
+
+destructor TLogger.Destroy;
+begin
+  inherited Destroy()
+end;
+
+procedure TLogger.Log(Msg: String);
+var
+  Local: Integer;
+begin
+  WriteLn(Msg);
+  Local := Local + 1
+end;
+
+function TLogger.Level: Integer;
+begin
+  Result := TLogger.Count
+end;
+
+function TLogger.GetItem(Index: Integer): Integer;
+begin
+  Result := Index
+end;
+
+procedure TLogger.SetItem(Index: Integer; Value: Integer);
+begin
+end;
+
+function Add(const A, B: Integer): Integer; overload;
+begin
+  Result := A + B
+end;
+
+function Add(const A: String; const B: String): String; overload;
+begin
+  Result := A + B
+end;
+
+procedure Fill(var A: TArr; Value: Integer = 0);
+var
+  k: Integer;
+begin
+  for k := 0 to 9 do
+    A[k] := Value
+end;
+
+procedure Consume(out X: Integer);
+begin
+  X := 42
+end;
+
+function Find(Needle: Integer; const Hay: TArr): Integer;
+var
+  k: Integer;
+begin
+  Result := -1;
+  for k := 0 to 9 do
+    if Hay[k] = Needle then
+    begin
+      Result := k;
+      Break
+    end;
+  if Result = -1 then
+    raise
+end;
+
+begin
+  i := $FF + &77 + %101 + 1_000;
+  r := 0;
+  b := (i = 1) and (j <> 2) or not (i < j);
+  b := (i = 1) xor True;
+  i := 1 shl 2 + 8 shr 1;
+  b := Blue in s;
+  s := [Red, Green];
+  s := [];
+  a[0] := 1;
+  mat[0, 1] := 2;
+  logger := TLogger.Create('x');
+  logger.Log('hi');
+  i := logger.Level();
+  i := TLogger.Count;
+  logger.FName := 'y';
+  p := nil;
+  i := Low(a);
+  i := High(a);
+  callback := (A, B) -> A + B;
+  i := callback(1, 2);
+  oneparam := N -> N * 2;
+  case i of
+    1: Write(1);
+    2, 3: Write(2);
+    4..6: Write(3)
+  else
+    Write(9)
+  end;
+  while i < 10 do
+    i := i + 1;
+  repeat
+    i := i - 1
+  until i <= 0;
+  for i in a do
+    j := i;
+  try
+    i := 1
+  finally
+    i := 2
+  end;
+  try
+    i := 1
+  except
+    on E: EApp do
+      i := 2
+    else
+      i := 3
+  end;
+  if b then
+    i := 1
+  else if b then
+    i := 2
+  else
+    i := 3;
+  Fill(a);
+  Fill(a, 7);
+  Consume(i);
+  i := Add(1, 2);
+  WriteLn('done')
+end.