Theia-Modula-2/grammars/FreePascal/free_pascal.atg

(* 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.