COMPILER AdaCS
/*  A subset of Ada from Fischer/LeBlanc: "Crafting a Compiler" */

IGNORE CASE

CHARACTERS
  letter      = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz".
  digit       = "0123456789".
  eol         = CHR(10).
  anyButQuote = ANY - '"' - eol.

COMMENTS
  FROM "--" TO eol

TOKENS
  id    = letter { ["_"] (letter | digit) }.
  int   = digit { ["_"] digit}.
  float = digit { ["_"] digit}
          (   "." digit { ["_"] digit }
              [ ("E" | "e") ["+" | "-"] digit { ["_"] digit } ]
            | ("E" | "e") ["+" | "-"] digit { ["_"] digit }
          ).
  str   = '"' {anyButQuote | '""'} '"'.

PRODUCTIONS
  AdaCS            = PragmaList CompUnit {PragmaList CompUnit}.
  PragmaList       = {Pragma}.
  Pragma           = "PRAGMA" id ";".
  CompUnit         = PackDecl.
  PackDecl         = "PACKAGE" PackSpecOrBody ";".
  PackSpecOrBody   = id "IS" {SpecDecl} [PrivPart] BodyOpt "END" IdOpt ";"
                     | "BODY" id "IS" {BodyDecl} {Stat} [ExcPart] "END" IdOpt ";".
  BodyOpt          = ["BODY" {BodyDecl} {Stat} [ExcPart]].
  IdOpt            = [id].
  SpecDecl         = PrivTypeDecl | Decl.
  PrivTypeDecl     = "TYPE" id "IS" "PRIVATE" ";".
  PrivPart         = "PRIVATE" PrivItem {PrivItem}.
  PrivItem         = "SUBTYPE" id "IS" SubtypeDef ";" | "TYPE" id "IS" TypeDef.
  BodyDecl         = SubprogBodyDecl | Decl.
  Decl             = ObjDecl | TypeDecl | SubtypeDecl | Pragma
                     | SubprogBodyDecl | "USE" NameList ";"
                     | IdList ":" "EXCEPTION" .
  ObjDecl          = IdList ":" ConstOpt TypeOrSubtype InitOpt ";".
  IdList           = id { "," id}.
  ConstOpt         = ["CONSTANT"].
  TypeOrSubtype    = Type | SubtypeDef.
  InitOpt          = [":=" Expr].
  TypeDecl         = "TYPE" id "IS" TypeDef ";" | IncomplTypeDecl.
  Type             = TypeName | TypeDef.
  TypeName         = id.
  TypeDef          = RecTypeDef | ArrTypeDef | EnumTypeDef | "ACCESS" Subtype.
  IncomplTypeDecl  = "TYPE" id ";".
  RecTypeDef       = "RECORD" CompList "END" "RECORD".
  CompList         = CompDecl {CompDecl} | {CompDecl} VarPart | "NULL" ";".
  CompDecl         = IdList ":" TypeOrSubtype.
  VarPart          = "CASE" id ":" TypeName "IS" Var {Var} "END" "CASE" ";".
  Var              = "WHEN" VarChoice "=>" CompList.
  VarChoice        = SimpleExpr.
  ArrTypeDef       = UnconstrArrDef | ConstrArrDef.
  UnconstrArrDef   = "ARRAY" UnconstrIndexList "OF" ElemType.
  UnconstrIndexList= "(" IndexSubtypeDef {"," IndexSubtypeDef} ")".
  IndexSubtypeDef  = TypeName "RANGE" "<>".
  ConstrArrDef     = "ARRAY" ConstrIndexList "OF" ElemType.
  ConstrIndexList  = "(" DiscrRange {"," DiscrRange} ")".
  ElemType         = TypeOrSubtype.
  EnumTypeDef      = "(" EnumIdList ")".
  EnumIdList       = id {"," id}.
  SubtypeDecl      = "SUBTYPE" id "IS" SubtypeDef ";".
  Subtype          = TypeName | SubtypeDef.
  SubtypeDef       = [ TypeName ] RangeConstr | TypeName IndexConstr.
  RangeConstr      = "RANGE" Range.
  Range            = SimpleExpr ".." SimpleExpr.
  IndexConstr      = "(" DiscrRange {"," DiscrRange} ")".
  DiscrRange       = Subtype | Range.
  SubprogBodyDecl  = SubprogSpec "IS" {BodyDecl} {Stat} [ExcPart] "END" IdOpt ";".
  SubprogSpec      = "PROCEDURE" id FormalPart | "FUNCTION" Design FormalPart.
  Design           = id | OpSymbol.
  OpSymbol         = str.
  FormalPart       = "(" ParamDeclList ")".
  ParamDeclList    = ParamDecl {";" ParamDecl}.
  ParamDecl        = IdList ":" [Mode] TypeOrSubtype.
  Mode             = "IN" ["OUT"] | "OUT".
  ExcPart          = "EXCEPTION" {ExcHandler}.
  ExcHandler       = "WHEN" ExcWhenTail.
  ExcWhenTail      = "OTHERS" "=>" StatList | Name { "|" Name } "=>" StatList.
  Stat             =   Pragma | NullStat | AssignStat | CallStat | Block | LoopStat 
                     | IfStat | ExitStat | ReturnStat | CaseStat | RaiseStat.
  StatList         = Stat {Stat}.
  NullStat         = "NULL" ";".
  AssignStat       = Name ":=" Expr ";".
  CallStat         = Name ";".   
  Block            = [id ":"] [DeclPart] "BEGIN" {Stat} [ExcPart] "END" [ id] ";".
  DeclPart         = "DECLARE" BodyDecl.
  ReturnStat       = "RETURN" [Expr] ";".
  RaiseStat        = "RAISE" [Name] ";".
  IfStat           = "IF" Expr "THEN" StatList {"ELSIF" Expr "THEN" StatList}
                     [ElsePart] "END" "IF" ";".
  ElsePart         = "ELSE" StatList.
  LoopStat         = [id ":"] [IterClause] BasicLoop ";".
  BasicLoop        = "LOOP" {Stat} "END" "LOOP" ";".
  IterClause       = "WHILE" Expr | "FOR" id "IN" ["REVERSE"] DiscrRange.
  ExitStat         = "EXIT" [Name] ["WHEN" Expr]  ";".
  CaseStat         = "CASE" Expr "IS" WhenList OthersOpt "END" "CASE" ";".
  WhenList         = {ChoiceList "=>" StatList}.
  OthersOpt        = ["WHEN" "OTHERS" "=>" StatList].
  ChoiceList       = Choice {"|" Choice}.
  Choice           = Expr | Expr ".." Expr.
  Expr             = Rel {LogOp Rel} | Rel {"AND" "THEN" Rel} | Rel {"OR" "ELSE" Rel}.
  Rel              = SimpleExpr [RelOp SimpleExpr].
  SimpleExpr       = [UnaryAddOp] Term {AddOp Term}.
  Term             = Factor {MulOp Factor}.
  Factor           = Primary ["**" Primary] | "NOT" Primary  | "ABS" Primary.
  Primary          = Literal | Name | "(" Expr ")" | Agg.
  Literal          = int | float | str.
  LogOp            = "AND" | "OR".
  RelOp            = "=" | "/=" | "<" | "<=" | ">" | ">=".
  AddOp            = "+" | "-" | "&".
  UnaryAddOp       = "+" | "-".
  MulOp            = "*" | "/" | "MOD".
  Name             = SimpleName {NameSuffix} ["." "ALL"].    
  SimpleName       = id.
  NameSuffix       = "." SelSuffix | "(" Expr {"," Expr}")" | "'" id.
  SelSuffix        = id | OpSymbol.
  Agg              = Name "'" "(" Comp {"," Comp}")".
  Comp             = [AggChoiceList "=>"] Expr.
  AggChoiceList    = AggChoice {"|" AggChoice}.
  AggChoice        = SimpleName | SimpleExpr | DiscrRange | "OTHERS".
  NameList         = Name { "," Name } .
END AdaCS.