Theia-Modula-2/grammars/Blaise/blaise_pascal.atg

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(10) .
  nul      = CHR(0) .
  letter   = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
  digit    = "0123456789" .
  hexDigit = digit + "ABCDEF" .
  octDigit = "01234567" .
  binDigit = "01" .
  noQuote  = ANY - "'" - eol - nul .

IGNORE CHR(9) .. CHR(13)

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 ( ".." )
          | "$" hexDigit { ["_"] hexDigit }
          | "&" octDigit { ["_"] octDigit }
          | "%" binDigit { ["_"] binDigit } .
  real    = digit { ["_"] digit } "." digit { ["_"] digit }
            [ "E" ["+" | "-"] digit { ["_"] digit } ]
          | digit { ["_"] digit } "E" ["+" | "-"] digit { ["_"] digit } .
  string  = "'" { noQuote | eol | "''" } "'" .

PRODUCTIONS
  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.