Previous Table of Contents Next


11.11.7. Compilation Unit Productions

   Compilation    = [UNSAFE] (Interface | Module) | GenInf | GenMod.
   Interface      = INTERFACE Id “;” {Import} {Decl} END Id “.”
                  | INTERFACE Id “=” Id GenActls END Id “.”.
   Module         = MODULE Id [EXPORTS IdList] “;” {Import} Block Id “.”
                  | MODULE Id [EXPORTS IdList] “=” Id GenActls END Id “.”.
   GenInf         = GENERIC INTERFACE Id GenFmls “;”
                 {Import} {Decl} END Id “.”.
   GenMod         = GENERIC MODULE Id GenFmls “;”
                 {Import} Block Id “.”.
   Import         = AsImport | FromImport.
   AsImport       = IMPORT ImportItem {“,”    ImportItem} “;”.
   FromImport     = FROM Id IMPORT IdList “;”.
   Block          = {Decl} BEGIN S END.
   Decl           = CONST {ConstDecl “;”}
                  | TYPE {TypeDecl “;”}
                  | EXCEPTION {ExceptionDecl “;”}
                  | VAR {VariableDecl “;”}
                  | ProcedureHead [“=” Block Id] “;”
                  | REVEAL {QualId (“=” | “<:”) Type “;”}.
   GenFmls         = “(“ [IdList] “)”.
   GenActls        = “(“ [IdList] “)”.
   ImportItem      = Id | Id AS Id.
   ConstDecl       = Id [“:” Type] “=”    ConstExpr.
   TypeDecl        = Id (“=” | “<:”) Type.
   ExceptionDecl   = Id [“(“ Type “)”].
   VariableDecl    = IdList (“:” Type &    “:=” Expr).
   ProcedureHead   = PROCEDURE Id Signature.
   Signature       = “(“ Formals “)” [“:” Type] [RAISES Raises].
   Formals         = [ Formal {“;” Formal} [“;”] ].
   Formal          = [Mode] IdList (“:” Type & “:=” ConstExpr).
   Mode            = VALUE | VAR | READONLY.
   Raises          = “{“ [ QualId {“,” QualId} ] “}” | ANY.

11.11.9. Statement Productions

Stmt       = AssignSt | Block | CallSt | CaseSt | ExitSt | EvalSt | ForSt
           | IfSt | LockSt | LoopSt | RaiseSt | RepeatSt |   ReturnSt
           | TCaseSt | TryXptSt | TryFinSt | WhileSt |  WithSt.
S          = [ Stmt {“;” Stmt} [“;”] ].
AssignSt    = Expr “:=” Expr.
CallSt     = Expr “(“ [Actual {“,” Actual}] “)”.
CaseSt     = CASE Expr OF [Case] {“|” Case} [ELSE S] END.
ExitSt     = EXIT.
EvalSt     = EVAL Expr.
ForSt      = FOR Id “:=” Expr TO Expr [BY Expr] DO S END.
IfSt       = IF Expr THEN S {ELSIF Expr THEN S} [ELSE S] END.
LockSt     = LOCK Expr DO S END.
LoopSt     = LOOP S END.
RaiseSt    = RAISE QualId [“(“ Expr “)”].
RepeatSt   = REPEAT S UNTIL Expr.
ReturnSt   = RETURN [Expr].
TCaseSt    = TYPECASE Expr OF [TCase] {“|” TCase} [ELSE S] END.
TryXptSt   = TRY S EXCEPT [Handler] {“|” Handler} [ELSE S] END.
TryFinSt   = TRY S FINALLY S END.
WhileSt    = WHILE Expr DO S END.
WithSt     = WITH Binding {“,” Binding} DO S END.
Case       = Labels {“,” Labels} “=>” S.
Labels     = ConstExpr [“..” ConstExpr].
Handler    = QualId {“,” QualId} [“(“ Id “)”] “=>” S.
TCase      = Type {“,” Type} [“(“ Id “)”] “=>” S.
Binding    = Id “=” Expr.
Actual     = Type | [Id “:=”] Expr.

11.11.9. Type Productions

Type         = TypeName | ArrayType | PackedType | EnumType
             | ObjectType  | ProcedureType | RecordType
             | RefType |  SetType | SubrangeType  | “(“ Type “)”.
ArrayType    = ARRAY [Type {“,” Type}] OF Type.
PackedType   = BITS ConstExpr FOR Type.
EnumType     = “{“ [IdList] “}”.
ObjectType   = [TypeName | ObjectType] [Brand] OBJECT Fields
              [METHODS Methods] [OVERRIDES Overrides] END.
ProcedureType= PROCEDURE Signature.
RecordType   = RECORD Fields END.
RefType      = [UNTRACED] [Brand] REF Type.
SetType      = SET OF Type.
SubrangeType = “[“ ConstExpr “..” ConstExpr “]”.
Brand        = BRANDED [ConstExpr].
Fields       = [ Field {“;” Field} [“;”] ].
Field        = IdList (“:” Type & “:=” ConstExpr).
Methods      = [ Method {“;” Method} [“;”] ].
Method       = Id Signature [“:=” ConstExpr].
Overrides    = [ Override {“;” Override} [“;”] ].
Override     = Id “:=” ConstExpr .

11.11.10. Expression Productions

ConstExpr = Expr.
Expr      = E1 {OR E1}.
    E1    = E2 {AND E2}.
    E2    = {NOT} E3.
    E3    = E4 {Relop E4}.
    E4    = E5 {Addop E5}.
    E5    = E6 {Mulop E6}.
    E6    = {“+” | “-”} E7.
    E7    = E8 {Selector}.
    E8    = Id     | Number | CharLiteral | TextLiteral  | Constructor
            |  “(“ Expr “)”.
Relop     =  “=”  | “#” | “<” | “<=” | “>” | “>=” | IN.
Addop     =  “+”  | “-” | “&”.
Mulop     =  “*”  | “/” | DIV | MOD.
Selector  =  “^”  | “.” Id | “[“ Expr {“,” Expr} “]”
             |  “(“ [ Actual {“,” Actual} ] “)”.
Constructor=  Type “{“ [ SetCons | RecordCons | ArrayCons ] “}”.
SetCons   =  SetElt {“,” SetElt}.
SetElt    =  Expr [“..” Expr].
RecordCons=  RecordElt {“,” RecordElt}.
RecordElt =  [Id “:=”] Expr.
ArrayCons =  Expr {“,” Expr} [“,” “..”].

11.11.11. Miscellaneous Productions

IdList      =  Id {“,” Id}.
QualId      =  Id [“.” Id].
TypeName    =  QualId | ROOT | UNTRACED ROOT.


Previous Table of Contents Next