Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume3/modula_pp/m2p.mod

Text File | 1986-11-30 | 32.5 KB | 1,283 lines

MODULE Modula2PrettyPrinter;

FROM InOut IMPORT
    Done, Read, Write, WriteLn, WriteString;

(*
**      Modula-2 Prettyprinter, November 1985.
**
**      by Ken Yap, U of Rochester, CS Dept.
**
**      Permission to copy, modify, and distribute, but not for profit,
**      is hereby granted, provided that this note is included.
**
**      adapted from a Pascal Program Formatter
**      by J. E. Crider, Shell Oil Company,
**      Houston, Texas 77025
**
**      This program formats Modula-2 programs according
**      to structured formatting principles
**
**      A valid Modula-2 program is read from the input and
**      a formatted program is written to the output.
**      It is basically a recursive descent parser with actions
**      intermixed with syntax scanning.
**
**      The actions of the program are as follows:
**
**      FORMATTING:  Each structured statement is formatted
**      in the following pattern (with indentation "indent"):
**
**                XXXXXX header XXXXXXXX
**                        XXXXXXXXXXXXXXXXXX
**                        XXXXX body XXXXXX
**                        XXXXXXXXXXXXXXXXXX
**                END
**
**      where the header is one of:
**
**                IF <expression> THEN
**                ELSIF <expression> THEN
**                ELSE
**                WHILE <expression> DO
**                FOR <control variable> := <FOR list> DO
**                WITH <RECORD variable> DO
**                REPEAT
**                LOOP
**                CASE <expression> OF
**                <CASE label list>:
**
**      and the last line begins with UNTIL or is END.
**      Other program parts are formatted similarly.  The headers are:
**
**                <MODULE/PROCEDURE heading>;
**                CONST
**                TYPE
**                VAR
**                BEGIN
**                (various FOR records AND RECORD variants)
**
**      COMMENTS:  Each comment that starts before or on a specified
**      column on an input line (program constant "commthresh") is
**      copied without shifting or reformatting.  Each comment that
**      starts after "commthresh" is reformatted and left-justified
**      following the aligned comment base column ("alcommbase").
**
**      SPACES AND BLANK LINES:  Spaces not at line breaks are copied from
**      the input.  Blank lines are copied from the input if they appear
**      between statements (or appropriate declaration units).  A blank
**      line is inserted above each significant part of each program/
**      procedure if one is not already there.
**
**      CONTINUATION:  Lines that are too long for an output line are
**      continued with additional indentation ("contindent").
*)

CONST
    TAB = 11C;
    NEWLINE = 12C;                  (* for Unix *)
    FF = 14C;
    maxrwlen = 15;                  (* size of reserved word strings *)
    ordminchar = 0;                 (* ord of lowest char in char set *)
    ordmaxchar = 127;               (* ord of highest char in char set *)
(* The following parameters may be adjusted for the installation: *)
    maxinlen = 255;                 (* maximum width of input line + 1 *)
    maxoutlen = 128;                (* maximum width of output line *)
    tabinterval = 8;                (* interval between tab columns *)
    initmargin = 0;                 (* initial value of output margin *)
    commthresh = tabinterval;       (* column threshhold in input for comments to be aligned *)
    alcommbase = 40;                (* aligned comments in output start after this column *)
    indent = tabinterval;           (* RECOMMENDED indentation increment *)
    contindent = tabinterval;       (* continuation indentation, >indent *)
    commindent = tabinterval;       (* comment continuation indentation *)

TYPE
    natural = [-1..1000000];        (* kludge because compiler doesn't *)
    inrange = [-1..maxinlen];       (* recognize qualified subranges *)
    outrange = [-1..maxoutlen];

    errortype = (longline, noendcomm, notquote, longword, notdo, notof, notend, notthen, notbegin, notuntil, notident,
    notsemicolon, notcolon, notperiod, notparen, noeof);

    chartype = (illegal, special, chapostrophe, chleftparen, chrightparen, chperiod, digit, chcolon, chsemicolon,
    chlessthan, chgreaterthan, letter, chleftbrace, chbar);

    chartypeset = SET OF chartype;  (* for reserved word recognition *)

    resword = (                     (* reserved words ordered by length *)
    rwif, rwdo, rwof, rwto, rwin, rwor,
                    (* length: 2 *)
    rwend, rwfor, rwvar, rwdiv, rwmod, rwset, rwand, rwnot, rwnil,
                    (* length: 3 *)
    rwthen, rwelse, rwwith, rwcase, rwtype, rwloop, rwfrom,
                    (* length: 4 *)
    rwbegin, rwelsif, rwuntil, rwwhile, rwarray, rwconst,
                    (* length: 5 *)
    rwrepeat, rwrecord, rwmodule, rwimport, rwexport,
                    (* length: 6 *)
    rwpointer,                      (* length: 7 *)
    rwprocedure, rwqualified,       (* length: 9 *)
    rwdefinition,                   (* length: 10 *)
    rwimplementation,               (* length: 14 *)
    rwx);                           (* length: 15 for table sentinel *)
    rwstring =  ARRAY [1..maxrwlen] OF CHAR;

    firstclass = (                  (* class of word if on new line *)
    newclause,                      (* start of new clause *)
    continue,                       (* continuation of clause *)
    alcomm,                         (* start of aligned comment *)
    contalcomm,                     (* continuation of aligned comment *)
    uncomm,                         (* start of unaligned comment *)
    contuncomm);                    (* continuation of unaligned comment *)

    wordtype = RECORD               (* data record for word *)
        whenfirst : firstclass; (* class of word if on new line *)
        puncfollows : BOOLEAN;  (* to reduce dangling punctuation *)
        blanklncount : natural; (* number of preceding blank lines *)
        spaces : INTEGER;       (* number of spaces preceding word *)
        base : [-1..maxinlen];  (* inline.buf[base] precedes word *)
        size : inrange;
    END;                            (* length of word in inline.buf *)

    symboltype = (                  (* symbols for syntax analysis *)
    symodule, sydefinition, syimplementation, syfrom, syimport, syexport, syqual, syproc, declarator, sybegin, syend, syif,
    sythen, syelsif, syelse, syloop, sycase, syof, syuntil, syrepeat, forwhilewith, sydo, syrecord, ident, intconst,
    semicolon, leftparen, rightparen, period, colon, bar, othersym, otherword, comment, syeof);
    symbolset = SET OF symboltype;

VAR
    inline : RECORD                 (* input line data *)
        endoffile : BOOLEAN;    (* end of file on input? *)
        ch : CHAR;              (* current char, buf[index] *)
        index : inrange;        (* subscript of current char *)
        len : natural;          (* length of input line in buf *)
        buf : ARRAY [1..maxinlen] OF CHAR;
    END;
    outline : RECORD                (* output line data *)
        blanklns : natural;     (* number of preceding blank lines *)
        len : outrange;         (* number of chars in buf *)
        buf : ARRAY [1..maxoutlen] OF CHAR;
    END;
    curword : wordtype;             (* current word *)
    margin : outrange;              (* left margin *)
    lnpending : BOOLEAN;            (* new line before next symbol? *)
    inheader : BOOLEAN;             (* are we scanning a proc header? *)
    symbol : symboltype;            (* current symbol *)

  (* Structured Constants *)
    headersyms : symbolset;         (* headers for program parts *)
    strucsyms : symbolset;          (* symbols that begin structured statements *)
    stmtbeginsyms : symbolset;      (* symbols that begin statements *)
    stmtendsyms : symbolset;        (* symbols that follow statements *)
    stopsyms : symbolset;           (* symbols that stop expression scan *)
    recendsyms : symbolset;         (* symbols that stop record scan *)
    datawords : symbolset;          (* to reduce dangling punctuation *)
    firstrw : ARRAY [1..maxrwlen] OF resword;
    rwword : ARRAY [rwif..rwimplementation] OF rwstring;
    rwsy : ARRAY [rwif..rwimplementation] OF symboltype;
    charclass : ARRAY CHAR OF chartype;
    symbolclass : ARRAY chartype OF symboltype;

PROCEDURE StructConsts;
(* establish values of structured constants *)
VAR
    i : [ordminchar..ordmaxchar];   (* loop index *)
    ch : CHAR;                      (* loop index *)

PROCEDURE BuildResWord(rw : resword; symword : rwstring; symbol : symboltype);
BEGIN
    rwword[rw] := symword;          (* reserved word string *)
    rwsy[rw] := symbol;             (* map to symbol *)
END BuildResWord;

BEGIN                                   (* StructConsts *)
(* symbol sets for syntax analysis *)
    headersyms := symbolset{symodule, syproc, declarator, sybegin, syend, syeof};
    strucsyms := symbolset{sycase, syrepeat, syif, forwhilewith, syloop};
    stmtbeginsyms := strucsyms + symbolset{ident};
    stmtendsyms := symbolset{semicolon, bar, syend, syuntil, syelsif, syelse, syeof};
    stopsyms := headersyms + strucsyms + stmtendsyms;
    recendsyms := symbolset{rightparen, syend, syeof};
    datawords := symbolset{otherword, intconst, ident, syend};

(* constants for recognizing reserved words *)
    firstrw[1] := rwif;             (* length: 1 *)
    firstrw[2] := rwif;             (* length: 2 *)
    BuildResWord(rwif, 'IF             ', syif);
    BuildResWord(rwdo, 'DO             ', sydo);
    BuildResWord(rwof, 'OF             ', syof);
    BuildResWord(rwto, 'TO             ', othersym);
    BuildResWord(rwin, 'IN             ', othersym);
    BuildResWord(rwor, 'OR             ', othersym);
    firstrw[3] := rwend;            (* length: 3 *)
    BuildResWord(rwend, 'END            ', syend);
    BuildResWord(rwfor, 'FOR            ', forwhilewith);
    BuildResWord(rwvar, 'VAR            ', declarator);
    BuildResWord(rwdiv, 'DIV            ', othersym);
    BuildResWord(rwmod, 'MOD            ', othersym);
    BuildResWord(rwset, 'SET            ', othersym);
    BuildResWord(rwand, 'AND            ', othersym);
    BuildResWord(rwnot, 'NOT            ', othersym);
    BuildResWord(rwnil, 'NIL            ', otherword);
    firstrw[4] := rwthen;           (* length: 4 *)
    BuildResWord(rwthen, 'THEN           ', sythen);
    BuildResWord(rwelse, 'ELSE           ', syelse);
    BuildResWord(rwwith, 'WITH           ', forwhilewith);
    BuildResWord(rwloop, 'LOOP           ', syloop);
    BuildResWord(rwfrom, 'FROM           ', syfrom);
    BuildResWord(rwcase, 'CASE           ', sycase);
    BuildResWord(rwtype, 'TYPE           ', declarator);
    firstrw[5] := rwbegin;          (* length: 5 *)
    BuildResWord(rwbegin, 'BEGIN          ', sybegin);
    BuildResWord(rwelsif, 'ELSIF          ', syelsif);
    BuildResWord(rwuntil, 'UNTIL          ', syuntil);
    BuildResWord(rwwhile, 'WHILE          ', forwhilewith);
    BuildResWord(rwarray, 'ARRAY          ', othersym);
    BuildResWord(rwconst, 'CONST          ', declarator);
    firstrw[6] := rwrepeat;         (* length: 6 *)
    BuildResWord(rwrepeat, 'REPEAT         ', syrepeat);
    BuildResWord(rwrecord, 'RECORD         ', syrecord);
    BuildResWord(rwmodule, 'MODULE         ', symodule);
    BuildResWord(rwimport, 'IMPORT         ', syimport);
    BuildResWord(rwexport, 'EXPORT         ', syexport);
    firstrw[7] := rwpointer;        (* length: 7 *)
    BuildResWord(rwpointer, 'POINTER        ', othersym);
    firstrw[8] := rwprocedure;      (* length: 8 *)
    firstrw[9] := rwprocedure;      (* length: 9 *)
    BuildResWord(rwprocedure, 'PROCEDURE      ', syproc);
    BuildResWord(rwqualified, 'QUALIFIED      ', syqual);
    firstrw[10] := rwdefinition;    (* length: 10 *)
    BuildResWord(rwdefinition, 'DEFINITION     ', sydefinition);
    firstrw[11] := rwimplementation;(* length: 11 *)
    firstrw[12] := rwimplementation;(* length: 12 *)
    firstrw[13] := rwimplementation;(* length: 13 *)
    firstrw[14] := rwimplementation;(* length: 14 *)
    BuildResWord(rwimplementation, 'IMPLEMENTATION ', syimplementation);
    firstrw[15] := rwx;             (* length: 15 FOR table sentinel *)

(* constants for lexical scan *)
    FOR i := ordminchar TO ordmaxchar DO
        charclass[CHR(i)] := illegal;
    END;
    FOR ch := 'a' TO 'z' DO
        charclass[ch] := letter;
        charclass[CAP(ch)] := letter;
    END;
    FOR ch := '0' TO '9' DO
        charclass[ch] := digit;
    END;
    charclass[' '] := special;
    charclass['"'] := chapostrophe;
    charclass['#'] := special;
    charclass['&'] := special;
    charclass["'"] := chapostrophe;
    charclass['('] := chleftparen;
    charclass[')'] := chrightparen;
    charclass['*'] := special;
    charclass['+'] := special;
    charclass[','] := special;
    charclass['-'] := special;
    charclass['.'] := chperiod;
    charclass['/'] := special;
    charclass[':'] := chcolon;
    charclass[';'] := chsemicolon;
    charclass['<'] := chlessthan;
    charclass['='] := special;
    charclass['>'] := chgreaterthan;
    charclass['@'] := special;
    charclass['['] := special;
    charclass[']'] := special;
    charclass['^'] := special;
    charclass['{'] := special;
    charclass['|'] := chbar;
    charclass['}'] := special;
    symbolclass[illegal] := othersym;
    symbolclass[special] := othersym;
    symbolclass[chapostrophe] := otherword;
    symbolclass[chleftparen] := leftparen;
    symbolclass[chrightparen] := rightparen;
    symbolclass[chperiod] := period;
    symbolclass[digit] := intconst;
    symbolclass[chcolon] := colon;
    symbolclass[chsemicolon] := semicolon;
    symbolclass[chlessthan] := othersym;
    symbolclass[chgreaterthan] := othersym;
    symbolclass[chbar] := bar;
    symbolclass[letter] := ident;
END StructConsts;

(* FlushLine/WriteError/ReadLine convert between files and lines. *)

PROCEDURE FlushLine;
(* Write buffer into output file *)
VAR
    i, j, vircol : outrange;        (* loop index *)
    nonblankseen : BOOLEAN;
BEGIN
    WITH outline DO
        WHILE blanklns > 0 DO
            WriteLn;
            blanklns := blanklns - 1;
        END;
        IF len > 0 THEN
            vircol := 0;
            nonblankseen := FALSE;
                    (* set this to TRUE if you don't want blanks to tab conversion *)
            FOR i := 0 TO len - 1 DO
                IF buf[i+1] <> ' ' THEN
                    IF NOT nonblankseen THEN
                        LOOP
                            j := (vircol DIV tabinterval + 1) * tabinterval;
                            IF j > i THEN
                                EXIT;
                            END;
                            Write(TAB);
                            vircol := j;
                        END;
                    END;
                    nonblankseen := TRUE;
                    WHILE vircol < i DO
                        Write(' ');
                        vircol := vircol + 1;
                    END;
                    Write(buf[i+1]);
                    vircol := i + 1;
                END;
            END;
            WriteLn;
            len := 0;
        END;
    END;
END FlushLine;

PROCEDURE WriteError(error : errortype);
(* report error to output *)
VAR
    i, ix : inrange;                (* loop index, limit *)
BEGIN
    FlushLine;
    WriteString('(* !!! error, ');
    CASE error OF
    longline:
        WriteString('shorter line');
    | noendcomm:
        WriteString('END OF comment');
    | notquote:
        WriteString("final ' on line");
    | longword:
        WriteString('shorter word');
    | notdo:
        WriteString('"DO"');
    | notof:
        WriteString('"OF"');
    | notend:
        WriteString('"END"');
    | notthen:
        WriteString('"THEN"');
    | notbegin:
        WriteString('"BEGIN"');
    | notuntil:
        WriteString('"UNTIL"');
    | notident:
        WriteString('"identifier"');
    | notsemicolon:
        WriteString('";"');
    | notperiod:
        WriteString('"."');
    | notcolon:
        WriteString('":"');
    | notparen:
        WriteString('")"');
    | noeof:
        WriteString('END OF file');
    END;
    WriteString(' expected');
    IF error >= longword THEN
        WriteString(', NOT "');
        WITH inline DO
            WITH curword DO
                IF size > maxrwlen THEN
                    ix := maxrwlen
                ELSE
                    ix := size;
                END;
                FOR i := 1 TO ix DO
                    Write(buf[base + i]);
                END;
            END;
        END;
        Write('"');
    END;
    IF error = noeof THEN
        WriteString(', FORMATTING STOPS');
    END;
    WriteString(' !!! *)');
    WriteLn;
END WriteError;

PROCEDURE ReadLine;
(* Read line into input buffer *)
VAR
    c : CHAR;                       (* input character *)
    nonblank : BOOLEAN;             (* is char other than space? *)
    i : INTEGER;
BEGIN
    WITH inline DO
        len := 0;
        LOOP
            Read(c);
            IF Done THEN
                endoffile := Done;
                EXIT;
            END;
            IF c = NEWLINE THEN
                EXIT;
            END;
            IF c < ' ' THEN (* convert ISO control chars (except leading form feed) to spaces *)
                IF c = TAB THEN
                    (* ISO TAB char *)
                    c := ' ';
                    (* add last space at end *)
                    WHILE len MOD 8 <> 7 DO
                        len := len + 1;
                        IF len < maxinlen THEN
                            buf[len] := c;
                        END;
                    END;
                    (* END tab handling *)
                ELSIF (c <> FF) OR (len > 0) THEN
                    c := ' ';
                END;
            END;            (* END ISO control char conversion *)
            len := len + 1;
            IF len < maxinlen THEN
                buf[len] := c;
            END;
        END;
        IF NOT endoffile THEN
            IF len >= maxinlen THEN
                    (* input line too long *)
                WriteError(longline);
                len := maxinlen - 1;
            END;
            WHILE (len > 0) AND (buf[len] = ' ') DO
                len := len - 1;
            END;
        END;
        len := len + 1;         (* add exactly ONE trailing blank *)
        buf[len] := ' ';
        index := 0;
    END;
END ReadLine;

PROCEDURE GetChar;
(* get next char from input buffer *)
BEGIN
    WITH inline DO
        index := index + 1;
        ch := buf[index];
    END;
END GetChar;

PROCEDURE NextChar() : CHAR;
(* look at next char in input buffer *)
BEGIN
    RETURN inline.buf[inline.index + 1];
END NextChar;

PROCEDURE StartWord(startclass : firstclass);
(* note beginning of word, and count preceding lines and spaces *)
VAR
    first : BOOLEAN;                (* is word the first on input line? *)
BEGIN
    first := FALSE;
    WITH inline DO
        WITH curword DO
            whenfirst := startclass;
            blanklncount := 0;
            WHILE (index >= len) AND NOT endoffile DO
                IF len = 1 THEN
                    blanklncount := blanklncount + 1;
                END;
                IF startclass = contuncomm THEN
                    FlushLine
                ELSE
                    first := TRUE;
                END;
                ReadLine;
                    (* with exactly ONE trailing blank *)
                GetChar;
                IF ch = FF THEN
                    FlushLine;
                    Write(FF);
                    blanklncount := 0;
                    GetChar;
                END;
            END;
            spaces := 0;    (* count leading spaces *)
            IF NOT endoffile THEN
                WHILE ch = ' ' DO
                    spaces := spaces + 1;
                    GetChar;
                END;
            END;
            IF first THEN
                spaces := 1;
            END;
            base := index - 1;
        END;
    END;
END StartWord;

PROCEDURE FinishWord;
(* note end of word *)
BEGIN
    WITH inline DO
        WITH curword DO
            puncfollows := (symbol IN datawords) AND (ch <> ' ');
            size := index - base - 1;
        END;
    END;
END FinishWord;

PROCEDURE CopyWord(newline : BOOLEAN; pword : wordtype);
(* copy word from input buffer into output buffer *)
VAR
    i : INTEGER;                    (* outline.len excess, loop index *)
BEGIN
    WITH pword DO
        WITH outline DO
            i := maxoutlen - len - spaces - size;
            IF newline OR (i < 0) OR ((i = 0) AND puncfollows) THEN
                FlushLine;
            END;
            IF len = 0 THEN (* first word on output line *)
                blanklns := blanklncount;
                CASE whenfirst OF
                    (* update LOCAL word.spaces *)
                newclause:
                    spaces := margin;
                | continue:
                    spaces := margin;
                | alcomm:
                    spaces := alcommbase;
                | contalcomm:
                    spaces := alcommbase + commindent;
                | uncomm:
                    spaces := base;
                | contuncomm:
                    (* spaces := spaces *);
                END;
                IF spaces + size > maxoutlen THEN
                    spaces := maxoutlen - size;
                    (* reduce spaces *)
                    IF spaces < 0 THEN
                        WriteError(longword);
                        size := maxoutlen;
                        spaces := 0;
                    END;
                END;
            END;
            FOR i := 1 TO spaces DO
                    (* put out spaces *)
                len := len + 1;
                buf[len] := ' ';
            END;
            FOR i := 1 TO size DO
                    (* copy actual word *)
                len := len + 1;
                buf[len] := inline.buf[base + i];
            END;
        END;
    END;
END CopyWord;

PROCEDURE DoComment;                    (* copy aligned or unaligned comment *)

PROCEDURE CopyComment(commclass : firstclass; commbase : inrange);
(* copy words of comment *)
VAR
    endcomment : BOOLEAN;           (* end of comment? *)
BEGIN
    WITH curword DO                 (* copy comment begin symbol *)
        whenfirst := commclass;
        spaces := commbase - outline.len;
        CopyWord((spaces < 0) OR (blanklncount > 0), curword);
    END;
    commclass := VAL(firstclass, ORD(commclass)+1);
    WITH inline DO
        REPEAT                  (* loop for successive words *)
            StartWord(commclass);
            endcomment := endoffile;
                    (* premature end? *)
            IF endcomment THEN
                WriteError(noendcomm)
            ELSE
                REPEAT
                    IF ch = '*' THEN
                        GetChar;
                        IF ch = ')' THEN
                            endcomment := TRUE;
                            GetChar;
                        END;
                    ELSE
                        GetChar;
                    END;
                UNTIL (ch = ' ') OR endcomment;
            END;
            FinishWord;
            CopyWord(FALSE, curword)
        UNTIL endcomment;
    END;
END CopyComment;

BEGIN                                   (* DoComment *)
    IF curword.base < commthresh THEN
                    (* copy comment without alignment *)
        CopyComment(uncomm, curword.base)
    ELSE                            (* align AND format comment *)
        CopyComment(alcomm, alcommbase);
    END;
END DoComment;

PROCEDURE GetSymbol;
(* get next non-comment symbol *)

PROCEDURE CopySymbol(symbol : symboltype; pword : wordtype);
(* copy word(s) of symbol *)
BEGIN
    IF symbol = comment THEN
        DoComment;              (* NOTE: DoComment uses global word! *)
        lnpending := TRUE;
    ELSIF symbol = semicolon THEN
        CopyWord(FALSE, pword);
        lnpending := NOT inheader;
    ELSE
        CopyWord(lnpending, pword);
        lnpending := FALSE;
    END;
END CopySymbol;

PROCEDURE FindSymbol;
(* find next symbol in input buffer *)

VAR
    termch : CHAR;                  (* string terminator *)
    chclass : chartype;             (* classification of leading char *)

PROCEDURE CheckResWord;
(* check if current identifier is reserved word/symbol *)
VAR
    rw, rwbeyond : resword;         (* loop index, limit *)
    symword : rwstring;             (* copy of symbol word *)
    i : [-1..maxrwlen];             (* loop index *)
BEGIN
    WITH curword DO
        WITH inline DO
            size := index - base - 1;
            IF size < maxrwlen THEN
                symword := '               ';
                FOR i := 1 TO size DO
                    symword[i] := CAP(buf[ base + i]);
                END;
                rw := firstrw[size];
                rwbeyond := firstrw[size + 1];
                symbol := semicolon;
                REPEAT
                    IF rw >= rwbeyond THEN
                        symbol := ident
                    ELSIF symword = rwword[rw] THEN
                        symbol := rwsy[rw]
                    ELSE
                        rw := VAL(resword,ORD(rw)+1);
                    END;
                UNTIL symbol <> semicolon;
            END;
            whenfirst := newclause;
        END;
    END;
END CheckResWord;

PROCEDURE GetName;
BEGIN
    WHILE charclass[inline.ch] IN chartypeset{letter, digit} DO
        GetChar;
    END;
    CheckResWord;
END GetName;

PROCEDURE GetNumber;
BEGIN
    WITH inline DO
        WHILE charclass[ch] = digit DO
            GetChar;
        END;
        IF ch = '.' THEN
            IF charclass[NextChar()] = digit THEN
                    (* NOTE: NextChar is a function! *)
                symbol := otherword;
                GetChar;
                WHILE charclass[ch] = digit DO
                    GetChar;
                END;
            END;
        END;
        IF CAP(ch) = 'E' THEN
            symbol := otherword;
            GetChar;
            IF (ch = '+') OR (ch = '-') THEN
                GetChar;
            END;
            WHILE charclass[ch] = digit DO
                GetChar;
            END;
        END;
    END;
END GetNumber;

PROCEDURE GetStringLiteral;
VAR
    endstring : BOOLEAN;            (* end of string literal? *)
BEGIN
    WITH inline DO
        endstring := FALSE;
        REPEAT
            GetChar;
            IF ch = termch THEN
                endstring := TRUE;
            ELSIF index >= len THEN
                    (* error, final "'" not on line *)
                WriteError(notquote);
                symbol := syeof;
                endstring := TRUE;
            END;
        UNTIL endstring;
        GetChar;
    END;
END GetStringLiteral;

BEGIN                                   (* FindSymbol *)
    StartWord(continue);
    WITH inline DO
        IF endoffile THEN
            symbol := syeof
        ELSE
            termch := ch;   (* save for string literal routine *)
            chclass := charclass[ch];
            symbol := symbolclass[chclass];
            GetChar;        (* second CHAR *)
            CASE chclass OF
            chsemicolon, chrightparen, chleftbrace, special, illegal: ;
            | letter:
                GetName;
            | digit:
                GetNumber;
            | chapostrophe:
                GetStringLiteral;
            | chcolon:
                IF ch = '=' THEN
                    symbol := othersym;
                    GetChar;
                END;
            | chlessthan:
                IF (ch = '=') OR (ch = '>') THEN
                    GetChar;
                END;
            | chgreaterthan:
                IF ch = '=' THEN
                    GetChar;
                END;
            | chleftparen:
                IF ch = '*' THEN
                    symbol := comment;
                    GetChar;
                END;
            | chperiod:
                IF ch = '.' THEN
                    symbol := colon;
                    GetChar;
                END;
            END;
            FinishWord;
        END;
    END;                            (* FindSymbol *)
END FindSymbol;

BEGIN                                   (* GetSymbol *)
    REPEAT
        CopySymbol(symbol, curword);
                    (* copy word for symbol to output *)
        FindSymbol              (* get next symbol *)
    UNTIL symbol <> comment;
END GetSymbol;

PROCEDURE StartClause;
(* (this may be a simple clause, or the start of a header) *)
BEGIN
    curword.whenfirst := newclause;
    lnpending := TRUE;
END StartClause;

PROCEDURE PassSemicolons;
(* pass consecutive semicolons *)
BEGIN
    WHILE symbol = semicolon DO
        GetSymbol;
        StartClause;
    END;
END PassSemicolons;

PROCEDURE StartPart;
(* start program part *)
BEGIN
    WITH curword DO
        IF blanklncount = 0 THEN
            blanklncount := 1;
        END;
    END;
END StartPart;

PROCEDURE StartBody;
(* finish header, start body of structure *)
BEGIN
    StartClause;
    margin := margin + indent;
END StartBody;

PROCEDURE FinishBody;
(* retract margin *)
BEGIN
    margin := margin - indent;
END FinishBody;

PROCEDURE PassPhrase(finalsymbol : symboltype);
(* process symbols until significant symbol encountered *)
VAR
    endsyms : symbolset;            (* complete set of stopping symbols *)
BEGIN
    IF symbol <> syeof THEN
        endsyms := stopsyms;
        INCL(endsyms, finalsymbol);
        REPEAT
            GetSymbol
        UNTIL symbol IN endsyms;
    END;
END PassPhrase;

PROCEDURE Expect(expectedsym : symboltype; error : errortype; syms : symbolset);
(* fail if current symbol is not the expected one, then recover *)
BEGIN
    IF symbol = expectedsym THEN
        GetSymbol
    ELSE
        WriteError(error);
        INCL(syms, expectedsym);
        WHILE NOT (symbol IN syms) DO
            GetSymbol;
        END;
        IF symbol = expectedsym THEN
            GetSymbol;
        END;
    END;
END Expect;

PROCEDURE Heading;
(* process heading for program or procedure *)

PROCEDURE MatchParens;                  (* process parentheses in heading *)
VAR
    endsyms : symbolset;
BEGIN
    GetSymbol;
    WHILE NOT (symbol IN recendsyms) DO
        IF symbol = leftparen THEN
            MatchParens
        ELSE
            GetSymbol;
        END;
    END;
    endsyms := stopsyms + recendsyms;
    Expect(rightparen, notparen, endsyms);
END MatchParens;

BEGIN                                   (* heading *)
    GetSymbol;
    PassPhrase(leftparen);
    IF symbol = leftparen THEN
        inheader := TRUE;
        MatchParens;
        inheader := FALSE;
    END;
    IF symbol = colon THEN
        PassPhrase(semicolon);
    END;
    Expect(semicolon, notsemicolon, stopsyms);

END Heading;

PROCEDURE DoRecord;
(* process record declaration *)
BEGIN
    GetSymbol;
    StartBody;
    PassFields(FALSE);
    FinishBody;
    Expect(syend, notend, recendsyms);
END DoRecord;

PROCEDURE DoVariant;
(* process (case) variant part *)
BEGIN
    PassPhrase(syof);
    Expect(syof, notof, stopsyms);
    StartBody;
    PassFields(TRUE);
    FinishBody;
END DoVariant;

PROCEDURE DoParens(forvariant : BOOLEAN);
(* process parentheses in record *)
BEGIN
    GetSymbol;
    IF forvariant THEN
        StartBody;
    END;
    PassFields(FALSE);
    lnpending := FALSE;             (* for empty field list *)
    Expect(rightparen, notparen, recendsyms);
    IF forvariant THEN
        FinishBody;
    END;
END DoParens;

PROCEDURE PassFields(forvariant : BOOLEAN);
(* process declarations *)
BEGIN
    WHILE NOT (symbol IN recendsyms) DO
        IF symbol = semicolon THEN
            PassSemicolons
        ELSIF symbol = syrecord THEN
            DoRecord
        ELSIF symbol = sycase THEN
            DoVariant
        ELSIF symbol = leftparen THEN
            DoParens(forvariant)
        ELSE
            GetSymbol;
        END;
    END;
END PassFields;

PROCEDURE Statement;
(* process statement *)
BEGIN
    CASE symbol OF
    sycase:
        CaseStatement;
        Expect(syend, notend, stmtendsyms);
    | syif:
        IfStatement;
        Expect(syend, notend, stmtendsyms);
    | syloop:
        LoopStatement;
        Expect(syend, notend, stmtendsyms);
    | syrepeat:
        RepeatStatement;
    | forwhilewith:
        ForWhileWithStatement;
        Expect(syend, notend, stmtendsyms);
    | ident:
        AssignmentProccall;
    | semicolon: ;
    END;
END Statement;

PROCEDURE AssignmentProccall;
(* pass an assignment statement or procedure call *)
BEGIN
    WHILE NOT (symbol IN stmtendsyms) DO
        GetSymbol;
    END;
END AssignmentProccall;

PROCEDURE StatementSequence;
(* process sequence of statements *)
BEGIN
    Statement;
    LOOP
        IF symbol <> semicolon THEN
            EXIT;
        END;
        GetSymbol;
        Statement;
    END;
END StatementSequence;

PROCEDURE IfStatement;
(* process if statement *)
BEGIN
    PassPhrase(sythen);
    Expect(sythen, notthen, stopsyms);
    StartBody;
    StatementSequence;
    FinishBody;
    WHILE symbol = syelsif DO
        StartClause;
        PassPhrase(sythen);
        Expect(sythen, notthen, stopsyms);
        StartBody;              (* new line after 'THEN' *)
        StatementSequence;
        FinishBody;
    END;
    IF symbol = syelse THEN
        StartClause;
        GetSymbol;
        StartBody;              (* new line after 'ELSE' *)
        StatementSequence;
        FinishBody;
    END;
END IfStatement;

PROCEDURE CaseStatement;
(* process case statement *)
BEGIN
    PassPhrase(syof);
    Expect(syof, notof, stopsyms);
    StartClause;
    OneCase;
    WHILE symbol = bar DO
        GetSymbol;
        OneCase;
    END;
    IF symbol = syelse THEN
        GetSymbol;
        StartBody;
        StatementSequence;
        FinishBody;
    END;
END CaseStatement;

PROCEDURE OneCase;
(* process one case clause *)
BEGIN
    IF NOT (symbol IN symbolset{bar, syelse}) THEN
        PassPhrase(colon);
        Expect(colon, notcolon, stopsyms);
        StartBody;              (* new line, indent after colon *)
        StatementSequence;
        FinishBody;             (* left-indent after case *)
    END;
END OneCase;

PROCEDURE RepeatStatement;
(* process repeat statement *)
BEGIN
    GetSymbol;
    StartBody;                      (* new line, indent after 'REPEAT' *)
    StatementSequence;
    FinishBody;                     (* left-ident after UNTIL *)
    StartClause;                    (* new line before UNTIL *)
    Expect(syuntil, notuntil, stmtendsyms);
    PassPhrase(semicolon);
END RepeatStatement;

PROCEDURE LoopStatement;
(* process loop statement *)
BEGIN
    GetSymbol;
    StartBody;                      (* new line, indent after LOOP *)
    StatementSequence;
    FinishBody;                     (* left-ident before END *)
END LoopStatement;

PROCEDURE ForWhileWithStatement;
(* process for, while, or with statement *)
BEGIN
    PassPhrase(sydo);
    Expect(sydo, notdo, stopsyms);
    StartBody;
    StatementSequence;
    FinishBody;
END ForWhileWithStatement;

PROCEDURE ProcedureDeclaration;
(* pass a procedure declaration *)
BEGIN
    ProcedureHeading;
    Block;
    Expect(ident, notident, stmtendsyms);
    Expect(semicolon, notsemicolon, stmtendsyms);
END ProcedureDeclaration;

PROCEDURE ProcedureHeading;
BEGIN
    StartClause;
    Heading;
END ProcedureHeading;

PROCEDURE Block;
BEGIN
    WHILE symbol IN symbolset{declarator, symodule, syproc} DO
        Declaration;
    END;
    IF symbol = sybegin THEN
        GetSymbol;
        StartBody;
        StatementSequence;
        FinishBody;
    END;
    Expect(syend, notend, stmtendsyms);
END Block;

PROCEDURE Declaration;
BEGIN
    IF symbol = declarator THEN
        StartClause;            (* CONST, TYPE, VAR *)
        GetSymbol;
        StartBody;
        REPEAT
            PassPhrase(syrecord);
            IF symbol = syrecord THEN
                DoRecord;
            END;
            IF symbol = semicolon THEN
                PassSemicolons;
            END;
        UNTIL symbol IN headersyms;
        FinishBody;
    ELSIF symbol = symodule THEN
        ModuleDeclaration;
    ELSIF symbol = syproc THEN
        ProcedureDeclaration;
    END;
END Declaration;

PROCEDURE ModuleDeclaration;
BEGIN
    PassPhrase(semicolon);
    PassSemicolons;
    WHILE symbol IN symbolset{syimport, syexport, syfrom} DO
        ImportExport;
    END;
    Block;
    Expect(ident, notident, stmtendsyms);
END ModuleDeclaration;

PROCEDURE ImportExport;
BEGIN
    IF symbol = syfrom THEN
        PassPhrase(syimport);
    END;
    IF symbol = syimport THEN
        GetSymbol;
    ELSIF symbol = syexport THEN
        GetSymbol;
        IF symbol = syqual THEN
            GetSymbol;
        END;
    END;
    StartBody;
    PassPhrase(semicolon);
    FinishBody;
    GetSymbol;
END ImportExport;

PROCEDURE OneDefinition;
BEGIN
    IF symbol = declarator THEN
        Declaration;
    ELSIF symbol = syproc THEN
        ProcedureHeading;
    END;
END OneDefinition;

PROCEDURE DefinitionModule;
BEGIN
    GetSymbol;
    PassPhrase(semicolon);
    GetSymbol;
    WHILE symbol IN symbolset{syimport, syexport, syfrom} DO
        ImportExport;
    END;
    WHILE symbol IN symbolset{declarator, syproc} DO
        OneDefinition;
    END;
    Expect(syend, notend, stmtendsyms);
    GetSymbol;
    Expect(period, notperiod, stmtendsyms);
END DefinitionModule;

PROCEDURE ProgramModule;
BEGIN
    ModuleDeclaration;
    Expect(period, notperiod, stmtendsyms);
END ProgramModule;

PROCEDURE CompilationUnit;
BEGIN
    IF symbol = syimplementation THEN
        GetSymbol;
        ProgramModule;
    ELSIF symbol = sydefinition THEN
        DefinitionModule;
    ELSE
        ProgramModule;
    END;
END CompilationUnit;

PROCEDURE CopyRemainder;
(* copy remainder of input *)
BEGIN
    WriteError(noeof);
    WITH inline DO
        REPEAT
            CopyWord(FALSE, curword);
            StartWord(contuncomm);
            IF NOT endoffile THEN
                REPEAT
                    GetChar
                UNTIL ch = ' ';
            END;
            FinishWord;
        UNTIL endoffile;
    END;
END CopyRemainder;

PROCEDURE Initialize;
(* initialize global variables *)
BEGIN
    WITH inline DO
        endoffile := FALSE;
        ch := ' ';
        index := 0;
        len := 0;
    END;
    WITH outline DO
        blanklns := 0;
        len := 0;
    END;
    WITH curword DO
        whenfirst := contuncomm;
        puncfollows := FALSE;
        blanklncount := 0;
        spaces := 0;
        base := 0;
        size := 0;
    END;
    margin := initmargin;
    lnpending := FALSE;
    symbol := othersym;
END Initialize;

BEGIN
    StructConsts;
    Initialize;
(* Files may be opened here. *)
    GetSymbol;
    CompilationUnit;
    IF NOT inline.endoffile THEN
        CopyRemainder;
    END;
    FlushLine;
END Modula2PrettyPrinter.