$C
COMPILER Mod2
USES Prettier;
(* Simple Modula-2 pretty printer *)

PROCEDURE WriteToken;
  VAR
    Token : STRING;
  BEGIN
    Mod2S.GetString(Mod2S.pos, Mod2S.len, Token);
    Append(Token);
  END;

(*--------------------------------------------------------------------------*)

CHARACTERS
  eol      = CHR(13) .
  letter   = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
  octDigit = "01234567" .
  digit    = octDigit + "89" .
  hexDigit = digit + "ABCDEF" .
  noQuote1 = ANY - "'" - eol .
  noQuote2 = ANY - '"' - eol .

IGNORE  CHR(9) .. CHR(13)

COMMENTS
  FROM "(*" TO "*)" NESTED

TOKENS
  identifier = letter { letter | digit } .
  integer    =   digit { digit }
               | digit { digit }  CONTEXT ("..")
               | octDigit { octDigit } ("B" | "C")
               | digit { hexDigit } "H" .
  real       =  digit { digit } "." { digit }
                [ "E" [ "+" | "-" ] digit { digit } ] .
  string     =    "'" { noQuote1 } "'"
                | '"' { noQuote2 } '"' .

PRODUCTIONS
  Mod2         =   DefMod
                 | [ "IMPLEMENTATION"  (. Append('IMPLEMENTATION ') .)
                   ] ProgMod .

  DefMod       =  "DEFINITION"
                  "MODULE"             (. Append('DEFINITION MODULE ') .)
                  Ident ";"            (. Append(';'); IndentNextLine; BlankLine .)
                  { Import }
                  { Definition }
                  "END"                (. Append('END ') .)
                  Ident "."            (. Append('.'); NewLine .) .

  ProgMod      =  "MODULE"             (. Append('MODULE ') .)
                  Ident
                  [ Priority ] ";"     (. Append(';'); IndentNextLine; BlankLine .)
                  { Import }
                  ModBlock Ident "."   (. Append('.'); NewLine .) .

  ModBlock    =   { Declaration }
                  [ ModuleBody ]
                  "END"                (. Append('END ') .) .

  ModuleBody  =   InitialPart
                  [ FinalPart ] .

  InitialPart =   "BEGIN"              (. Append('BEGIN'); IndentNextLine .)
                  BlockBody            (. ExdentNextLine .) .

  FinalPart   =   "FINALLY"            (. Append('FINALLY'); IndentNextLine .)
                  BlockBody            (. ExdentNextLine .) .

  BlockBody   =   StatSeq
                  [ "EXCEPT"           (. Append('EXCEPT'); IndentNextLine .)
                  StatSeq              (. ExdentNextLine .)
                  ] .

  Priority     =  "["                  (. Append(' [') .)
                  ConstExpr "]"        (. Append(']') .) .

  Import       =    "FROM"             (. Append('FROM ') .)
                    Ident "IMPORT"     (. Append(' IMPORT '); IndentNextLine .)
                    IdList ";"         (. Append(';'); ExdentNextLine; BlankLine .)
                  | "IMPORT"           (. Append('IMPORT ') .)
                    IdList ";"         (. Append(';'); BlankLine .) .

  Export       =  "EXPORT"             (. Append('EXPORT ') .)
                  [ "QUALIFIED"        (. Append('QUALIFIED ') .)
                  ] IdList ";"         (. Append(';'); BlankLine .) .

  Definition   =    "CONST"            (. Append('CONST'); IndentNextLine .)
                    { ConstDecl ";"    (. Append(';'); NewLine .)
                    SYNC }             (. ExdentNextLine; BlankLine .)
                  | "TYPE"             (. Append('TYPE'); IndentNextLine .)
                    { Ident [ "="      (. Append(' = ') .)
                    Type ] ";"         (. Append(';'); NewLine .)
                    SYNC }             (. ExdentNextLine; BlankLine .)
                  | "VAR"              (. Append('VAR'); IndentNextLine .)
                    { VarDecl ";"      (. Append(';'); NewLine .)
                    SYNC }             (. ExdentNextLine; BlankLine .)
                  | ProcHead ";" SYNC  (. Append(';'); NewLine; BlankLine .) .

  Declaration  =    "CONST"            (. Append('CONST'); IndentNextLine .)
                    { ConstDecl ";"    (. Append(';'); NewLine .)
                    SYNC }             (. ExdentNextLine; BlankLine .)
                  | "TYPE"             (. Append('TYPE'); IndentNextLine .)
                    { TypeDecl ";"     (. Append(';'); NewLine .)
                    SYNC }             (. ExdentNextLine; BlankLine .)
                  | "VAR"              (. Append('VAR'); IndentNextLine .)
                    { VarDecl ";"      (. Append(';'); NewLine .)
                    SYNC }             (. ExdentNextLine; BlankLine .)
                  | ProcDecl ";" SYNC  (. Append(';'); ExdentNextLine; BlankLine .)
                  | ModDecl ";" SYNC   (. Append(';'); ExdentNextLine; BlankLine .) .

  ConstDecl    =  Ident "="            (. Append(' = ') .)
                  ConstExpr .

  ConstExpr    =  Expression .

  TypeDecl     =  Ident "="            (. Append(' = ') .)
                  Type .

  Type         =    SimpleType | ArrayType
                  | RecordType | SetType
                  | PointerType | ProcType .

  SimpleType   =    QualId
                    [ "["              (. Append(' [') .)
                    ConstExpr ".."     (. Append(' .. ') .)
                    ConstExpr "]"      (. Append('] ') .)
                    ]
                  | Enumeration
                  | "["                (. Append('[') .)
                    ConstExpr ".."     (. Append(' .. ') .)
                    ConstExpr "]"      (. Append(']') .) .

  Enumeration  =  "("                  (. Append('(') .)
                  IdList ')'           (. Append(') ') .) .

  ArrayType    =  "ARRAY"              (. Append('ARRAY ') .)
                  SimpleType { ","     (. Append(', ') .)
                  SimpleType } "OF"    (. Append(' OF ') .)
                  Type .

  RecordType   =  "RECORD"             (. IndentNextLine; Append('RECORD'); IndentNextLine .)
                  FieldListSeq         (. ExdentNextLine .)
                  "END"                (. Exdent; Append('END') .) .

  FieldListSeq =  FieldList { ";"      (. Append(';'); NewLine .)
                  FieldList } .

  FieldList    =  [  IdList ":"        (. Append(' : ') .)
                     Type
                   | "CASE"            (. Append('CASE ') .)
                     [ Ident ] ":"     (. Append(' : ') .)
                     QualId "OF"       (. Append(' OF '); IndentNextLine .)
                     Variant { "|"     (. Append('|') .)
                     Variant }
                     [ "ELSE"          (. Append('ELSE'); IndentNextLine .)
                     FieldListSeq      (. Exdent .)
                     ] "END"           (. ExdentNextLine; Append('END') .)
                  ] .

  Variant      =  [                    (. Append(' ') .)
                  CaseLabList ":"      (. Append(' : '); IndentNextLine .)
                  FieldListSeq         (. ExdentNextLine .)
                  ] .

  CaseLabList  =  CaseLabels { ","     (. Append(', ') .)
                  CaseLabels } .

  CaseLabels   =  ConstExpr [ ".."     (. Append(' .. ') .)
                  ConstExpr ] .

  SetType      =  (   "SET"            (. Append('SET') .)
                    | "PACKEDSET"      (. Append('PACKEDSET') .)
                  ) "OF"               (. Append(' OF ') .)
                  SimpleType .

  PointerType  =  "POINTER" "TO"       (. Append('POINTER TO ') .)
                  Type .

  ProcType     =  "PROCEDURE"          (. Append('PROCEDURE ') .)
                  [ FormTypeList ] .

  FormTypeList =  "("                  (. Append(' (') .)
                  [ [ "VAR"            (. Append('VAR ') .)
                    ] FormalType
                    { ","              (. Append(', ') .)
                    [ "VAR"            (. Append('VAR ') .)
                    ] FormalType }
                  ]
                  ")"                  (. Append(')') .)
                  [ ":"                (. Append(' : ') .)
                  QualId ] .