lang/m2/test/m2p.mod

   1 MODULE Modula2PrettyPrinter;
   2
   3 FROM InOut IMPORT
   4         Done, Read, Write, WriteLn, WriteString, OpenInput, OpenOutput,
   5         CloseInput, CloseOutput;
   6
   7 (*
   8 **      Modula-2 Prettyprinter, November 1985.
   9 **
  10 **      by Ken Yap, U of Rochester, CS Dept.
  11 **
  12 **      Permission to copy, modify, and distribute, but not for profit,
  13 **      is hereby granted, provided that this note is included.
  14 **
  15 **      adapted from a Pascal Program Formatter
  16 **      by J. E. Crider, Shell Oil Company,
  17 **      Houston, Texas 77025
  18 **
  19 **      This program formats Modula-2 programs according
  20 **      to structured formatting principles
  21 **
  22 **      A valid Modula-2 program is read from the input and
  23 **      a formatted program is written to the output.
  24 **      It is basically a recursive descent parser with actions
  25 **      intermixed with syntax scanning.
  26 **
  27 **      The actions of the program are as follows:
  28 **
  29 **      FORMATTING:  Each structured statement is formatted
  30 **      in the following pattern (with indentation "indent"):
  31 **
  32 **                XXXXXX header XXXXXXXX
  33 **                        XXXXXXXXXXXXXXXXXX
  34 **                        XXXXX body XXXXXX
  35 **                        XXXXXXXXXXXXXXXXXX
  36 **                END
  37 **
  38 **      where the header is one of:
  39 **
  40 **                IF <expression> THEN
  41 **                ELSIF <expression> THEN
  42 **                ELSE
  43 **                WHILE <expression> DO
  44 **                FOR <control variable> := <FOR list> DO
  45 **                WITH <RECORD variable> DO
  46 **                REPEAT
  47 **                LOOP
  48 **                CASE <expression> OF
  49 **                <CASE label list>:
  50 **
  51 **      and the last line begins with UNTIL or is END.
  52 **      Other program parts are formatted similarly.  The headers are:
  53 **
  54 **                <MODULE/PROCEDURE heading>;
  55 **                CONST
  56 **                TYPE
  57 **                VAR
  58 **                BEGIN
  59 **                (various FOR records AND RECORD variants)
  60 **
  61 **      COMMENTS:  Each comment that starts before or on a specified
  62 **      column on an input line (program constant "commthresh") is
  63 **      copied without shifting or reformatting.  Each comment that
  64 **      starts after "commthresh" is reformatted and left-justified
  65 **      following the aligned comment base column ("alcommbase").
  66 **
  67 **      SPACES AND BLANK LINES:  Spaces not at line breaks are copied from
  68 **      the input.  Blank lines are copied from the input if they appear
  69 **      between statements (or appropriate declaration units).  A blank
  70 **      line is inserted above each significant part of each program/
  71 **      procedure if one is not already there.
  72 **
  73 **      CONTINUATION:  Lines that are too long for an output line are
  74 **      continued with additional indentation ("contindent").
  75 *)
  76
  77 CONST
  78         TAB = 11C;
  79         NEWLINE = 12C;                  (* for Unix *)
  80         FF = 14C;
  81         maxrwlen = 15;                  (* size of reserved word strings *)
  82         ordminchar = 0;                 (* ord of lowest char in char set *)
  83         ordmaxchar = 127;               (* ord of highest char in char set *)
  84 (* The following parameters may be adjusted for the installation: *)
  85         maxinlen = 255;                 (* maximum width of input line + 1 *)
  86         maxoutlen = 80;                 (* maximum width of output line *)
  87         tabinterval = 8;                (* interval between tab columns *)
  88         initmargin = 0;                 (* initial value of output margin *)
  89         commthresh = tabinterval;       (* column threshhold in input for
  90                                                 comments to be aligned *)
  91         alcommbase = 40;                (* aligned comments in output start
  92                                                 after this column *)
  93         indent = tabinterval;           (* RECOMMENDED indentation increment *)
  94         contindent = tabinterval;       (* continuation indentation, >indent *)
  95         commindent = tabinterval;       (* comment continuation indentation *)
  96
  97 TYPE
  98         natural = INTEGER[0..32767];
  99         inrange = INTEGER[0..maxinlen];
 100         outrange = INTEGER[0..maxoutlen];
 101
 102         errortype = (longline, noendcomm, notquote, longword, notdo, notof,
 103         notend, notthen, notbegin, notuntil, notident, notsemicolon, notcolon,
 104         notperiod, notparen, noeof);
 105
 106         chartype = (illegal, special, chapostrophe, chleftparen, chrightparen,
 107         chperiod, digit, chcolon, chsemicolon, chlessthan, chgreaterthan,
 108         letter, chleftbrace, chbar);
 109
 110         chartypeset = SET OF chartype;  (* for reserved word recognition *)
 111
 112         resword = (                     (* reserved words ordered by length *)
 113         rwif, rwdo, rwof, rwto, rwin, rwor,
 114                                         (* length: 2 *)
 115         rwend, rwfor, rwvar, rwdiv, rwmod, rwset, rwand, rwnot, rwnil,
 116                                         (* length: 3 *)
 117         rwthen, rwelse, rwwith, rwcase, rwtype, rwloop, rwfrom,
 118                                         (* length: 4 *)
 119         rwbegin, rwelsif, rwuntil, rwwhile, rwarray, rwconst,
 120                                         (* length: 5 *)
 121         rwrepeat, rwrecord, rwmodule, rwimport, rwexport,
 122                                         (* length: 6 *)
 123         rwpointer,                      (* length: 7 *)
 124         rwprocedure, rwqualified,       (* length: 9 *)
 125         rwdefinition,                   (* length: 10 *)
 126         rwimplementation,               (* length: 14 *)
 127         rwx);                           (* length: 15 for table sentinel *)
 128         rwstring =  ARRAY [1..maxrwlen] OF CHAR;
 129
 130         firstclass = (                  (* class of word if on new line *)
 131         newclause,                      (* start of new clause *)
 132         continue,                       (* continuation of clause *)
 133         alcomm,                         (* start of aligned comment *)
 134         contalcomm,                     (* continuation of aligned comment *)
 135         uncomm,                         (* start of unaligned comment *)
 136         contuncomm);                    (* continuation of unaligned comment *)
 137
 138         wordtype = RECORD               (* data record for word *)
 139                 whenfirst : firstclass; (* class of word if on new line *)
 140                 puncfollows : BOOLEAN;  (* to reduce dangling punctuation *)
 141                 blanklncount : natural; (* number of preceding blank lines *)
 142                 spaces : INTEGER;       (* number of spaces preceding word *)
 143                 base : [-1..maxinlen];  (* inline.buf[base] precedes word *)
 144                 size : inrange;
 145         END;                            (* length of word in inline.buf *)
 146
 147         symboltype = (                  (* symbols for syntax analysis *)
 148         symodule, sydefinition, syimplementation, syfrom, syimport, syexport,
 149         syqual, syproc, declarator, sybegin, syend, syif, sythen, syelsif,
 150         syelse, syloop, sycase, syof, syuntil, syrepeat, forwhilewith, sydo,
 151         syrecord, ident, intconst, semicolon, leftparen, rightparen, period,
 152         colon, bar, othersym, otherword, comment, syeof);
 153         symbolset = SET OF symboltype;
 154
 155 VAR
 156         inline : RECORD                 (* input line data *)
 157                 endoffile : BOOLEAN;    (* end of file on input? *)
 158                 ch : CHAR;              (* current char, buf[index] *)
 159                 index : inrange;        (* subscript of current char *)
 160                 len : natural;          (* length of input line in buf *)
 161                 buf : ARRAY [1..maxinlen] OF CHAR;
 162         END;
 163         outline : RECORD                (* output line data *)
 164                 blanklns : natural;     (* number of preceding blank lines *)
 165                 len : outrange;         (* number of chars in buf *)
 166                 buf : ARRAY [1..maxoutlen] OF CHAR;
 167         END;
 168         curword : wordtype;             (* current word *)
 169         margin : outrange;              (* left margin *)
 170         lnpending : BOOLEAN;            (* new line before next symbol? *)
 171         inheader : BOOLEAN;             (* are we scanning a proc header? *)
 172         symbol : symboltype;            (* current symbol *)
 173
 174   (* Structured Constants *)
 175         headersyms : symbolset;         (* headers for program parts *)
 176         strucsyms : symbolset;          (* symbols that begin structured
 177                                                 statements *)
 178         stmtendsyms : symbolset;        (* symbols that follow statements *)
 179         stopsyms : symbolset;           (* symbols that stop expression scan *)
 180         recendsyms : symbolset;         (* symbols that stop record scan *)
 181         datawords : symbolset;          (* to reduce dangling punctuation *)
 182         firstrw : ARRAY [1..maxrwlen] OF resword;
 183         rwword : ARRAY [rwif..rwimplementation] OF rwstring;
 184         rwsy : ARRAY [rwif..rwimplementation] OF symboltype;
 185         charclass : ARRAY CHAR OF chartype;
 186         symbolclass : ARRAY chartype OF symboltype;
 187
 188 PROCEDURE StrCmp(a, b : rwstring) : BOOLEAN;
 189 VAR
 190         i : INTEGER;
 191 BEGIN
 192         FOR i := 1 TO maxrwlen DO
 193                 IF a[i] # b[i] THEN
 194                         RETURN FALSE;
 195                 END;
 196         END;
 197         RETURN TRUE;
 198 END StrCmp;
 199
 200 PROCEDURE StructConsts;
 201 (* establish values of structured constants *)
 202 VAR
 203         i : [ordminchar..ordmaxchar];   (* loop index *)
 204         ch : CHAR;                      (* loop index *)
 205
 206 PROCEDURE BuildResWord(rw : resword; symword : rwstring; symbol : symboltype);
 207 BEGIN
 208         rwword[rw] := symword;          (* reserved word string *)
 209         rwsy[rw] := symbol;             (* map to symbol *)
 210 END BuildResWord;
 211
 212 BEGIN                                   (* StructConsts *)
 213 (* symbol sets for syntax analysis *)
 214         headersyms := symbolset{symodule, syproc, declarator, sybegin, syend,
 215         syeof};
 216         strucsyms := symbolset{sycase, syrepeat, syif, forwhilewith, syloop};
 217         stmtendsyms := symbolset{semicolon, bar, syend, syuntil, syelsif,
 218         syelse, syeof};
 219         stopsyms := headersyms + strucsyms + stmtendsyms;
 220         recendsyms := symbolset{rightparen, syend, syeof};
 221         datawords := symbolset{otherword, intconst, ident, syend};
 222
 223 (* constants for recognizing reserved words *)
 224         firstrw[1] := rwif;             (* length: 1 *)
 225         firstrw[2] := rwif;             (* length: 2 *)
 226         BuildResWord(rwif, 'IF             ', syif);
 227         BuildResWord(rwdo, 'DO             ', sydo);
 228         BuildResWord(rwof, 'OF             ', syof);
 229         BuildResWord(rwto, 'TO             ', othersym);
 230         BuildResWord(rwin, 'IN             ', othersym);
 231         BuildResWord(rwor, 'OR             ', othersym);
 232         firstrw[3] := rwend;            (* length: 3 *)
 233         BuildResWord(rwend, 'END            ', syend);
 234         BuildResWord(rwfor, 'FOR            ', forwhilewith);
 235         BuildResWord(rwvar, 'VAR            ', declarator);
 236         BuildResWord(rwdiv, 'DIV            ', othersym);
 237         BuildResWord(rwmod, 'MOD            ', othersym);
 238         BuildResWord(rwset, 'SET            ', othersym);
 239         BuildResWord(rwand, 'AND            ', othersym);
 240         BuildResWord(rwnot, 'NOT            ', othersym);
 241         BuildResWord(rwnil, 'NIL            ', otherword);
 242         firstrw[4] := rwthen;           (* length: 4 *)
 243         BuildResWord(rwthen, 'THEN           ', sythen);
 244         BuildResWord(rwelse, 'ELSE           ', syelse);
 245         BuildResWord(rwwith, 'WITH           ', forwhilewith);
 246         BuildResWord(rwloop, 'LOOP           ', syloop);
 247         BuildResWord(rwfrom, 'FROM           ', syfrom);
 248         BuildResWord(rwcase, 'CASE           ', sycase);
 249         BuildResWord(rwtype, 'TYPE           ', declarator);
 250         firstrw[5] := rwbegin;          (* length: 5 *)
 251         BuildResWord(rwbegin, 'BEGIN          ', sybegin);
 252         BuildResWord(rwelsif, 'ELSIF          ', syelsif);
 253         BuildResWord(rwuntil, 'UNTIL          ', syuntil);
 254         BuildResWord(rwwhile, 'WHILE          ', forwhilewith);
 255         BuildResWord(rwarray, 'ARRAY          ', othersym);
 256         BuildResWord(rwconst, 'CONST          ', declarator);
 257         firstrw[6] := rwrepeat;         (* length: 6 *)
 258         BuildResWord(rwrepeat, 'REPEAT         ', syrepeat);
 259         BuildResWord(rwrecord, 'RECORD         ', syrecord);
 260         BuildResWord(rwmodule, 'MODULE         ', symodule);
 261         BuildResWord(rwimport, 'IMPORT         ', syimport);
 262         BuildResWord(rwexport, 'EXPORT         ', syexport);
 263         firstrw[7] := rwpointer;        (* length: 7 *)
 264         BuildResWord(rwpointer, 'POINTER        ', othersym);
 265         firstrw[8] := rwprocedure;      (* length: 8 *)
 266         firstrw[9] := rwprocedure;      (* length: 9 *)
 267         BuildResWord(rwprocedure, 'PROCEDURE      ', syproc);
 268         BuildResWord(rwqualified, 'QUALIFIED      ', syqual);
 269         firstrw[10] := rwdefinition;    (* length: 10 *)
 270         BuildResWord(rwdefinition, 'DEFINITION     ', sydefinition);
 271         firstrw[11] := rwimplementation;(* length: 11 *)
 272         firstrw[12] := rwimplementation;(* length: 12 *)
 273         firstrw[13] := rwimplementation;(* length: 13 *)
 274         firstrw[14] := rwimplementation;(* length: 14 *)
 275         BuildResWord(rwimplementation, 'IMPLEMENTATION ', syimplementation);
 276         firstrw[15] := rwx;             (* length: 15 FOR table sentinel *)
 277
 278 (* constants for lexical scan *)
 279         FOR i := ordminchar TO ordmaxchar DO
 280                 charclass[CHR(i)] := illegal;
 281         END;
 282         FOR ch := 'a' TO 'z' DO
 283                 charclass[ch] := letter;
 284                 charclass[CAP(ch)] := letter;
 285         END;
 286         FOR ch := '0' TO '9' DO
 287                 charclass[ch] := digit;
 288         END;
 289         charclass[' '] := special;
 290         charclass['"'] := chapostrophe;
 291         charclass['#'] := special;
 292         charclass['&'] := special;
 293         charclass["'"] := chapostrophe;
 294         charclass['('] := chleftparen;
 295         charclass[')'] := chrightparen;
 296         charclass['*'] := special;
 297         charclass['+'] := special;
 298         charclass[','] := special;
 299         charclass['-'] := special;
 300         charclass['.'] := chperiod;
 301         charclass['/'] := special;
 302         charclass[':'] := chcolon;
 303         charclass[';'] := chsemicolon;
 304         charclass['<'] := chlessthan;
 305         charclass['='] := special;
 306         charclass['>'] := chgreaterthan;
 307         charclass['@'] := special;
 308         charclass['['] := special;
 309         charclass[']'] := special;
 310         charclass['^'] := special;
 311         charclass['{'] := special;
 312         charclass['|'] := chbar;
 313         charclass['}'] := special;
 314         symbolclass[illegal] := othersym;
 315         symbolclass[special] := othersym;
 316         symbolclass[chapostrophe] := otherword;
 317         symbolclass[chleftparen] := leftparen;
 318         symbolclass[chrightparen] := rightparen;
 319         symbolclass[chperiod] := period;
 320         symbolclass[digit] := intconst;
 321         symbolclass[chcolon] := colon;
 322         symbolclass[chsemicolon] := semicolon;
 323         symbolclass[chlessthan] := othersym;
 324         symbolclass[chgreaterthan] := othersym;
 325         symbolclass[chbar] := bar;
 326         symbolclass[letter] := ident;
 327 END StructConsts;
 328
 329 (* FlushLine/WriteError/ReadLine convert between files and lines. *)
 330
 331 PROCEDURE FlushLine;
 332 (* Write buffer into output file *)
 333 VAR
 334         i, j, vircol : outrange;        (* loop index *)
 335         nonblankseen : BOOLEAN;
 336 BEGIN
 337         WITH outline DO
 338                 WHILE blanklns > 0 DO
 339                         WriteLn;
 340                         blanklns := blanklns - 1;
 341                 END;
 342                 IF len > 0 THEN
 343                         vircol := 0;
 344                         nonblankseen := FALSE;
 345                                         (* set this to TRUE if you don't want
 346                                                 blanks to tab conversion *)
 347                         FOR i := 0 TO len - 1 DO
 348                                 IF buf[i+1] <> ' ' THEN
 349                                         IF NOT nonblankseen THEN
 350                                                 LOOP
 351                                                         j := (vircol DIV
 352                                                         tabinterval + 1) *
 353                                                         tabinterval;
 354                                                         IF j > i THEN
 355                                                                 EXIT;
 356                                                         END;
 357                                                         Write(TAB);
 358                                                         vircol := j;
 359                                                 END;
 360                                         END;
 361                                         nonblankseen := TRUE;
 362                                         WHILE vircol < i DO
 363                                                 Write(' ');
 364                                                 vircol := vircol + 1;
 365                                         END;
 366                                         Write(buf[i+1]);
 367                                         vircol := i + 1;
 368                                 END;
 369                         END;
 370                         WriteLn;
 371                         len := 0;
 372                 END;
 373         END;
 374 END FlushLine;
 375
 376 PROCEDURE WriteError(error : errortype; nm : ARRAY OF CHAR);
 377 (* report error to output *)
 378 VAR
 379         i, ix : inrange;                (* loop index, limit *)
 380 BEGIN
 381         FlushLine;
 382         WriteString('(* !!! error, ');
 383         WriteString(nm);
 384         CASE error OF
 385         longline:
 386                 WriteString('shorter line');
 387         | noendcomm:
 388                 WriteString('END OF comment');
 389         | notquote:
 390                 WriteString("final ' on line");
 391         | longword:
 392                 WriteString('shorter word');
 393         | notdo:
 394                 WriteString('"DO"');
 395         | notof:
 396                 WriteString('"OF"');
 397         | notend:
 398                 WriteString('"END"');
 399         | notthen:
 400                 WriteString('"THEN"');
 401         | notbegin:
 402                 WriteString('"BEGIN"');
 403         | notuntil:
 404                 WriteString('"UNTIL"');
 405         | notident:
 406                 WriteString('"identifier"');
 407         | notsemicolon:
 408                 WriteString('";"');
 409         | notperiod:
 410                 WriteString('"."');
 411         | notcolon:
 412                 WriteString('":"');
 413         | notparen:
 414                 WriteString('")"');
 415         | noeof:
 416                 WriteString('END OF file');
 417         END;
 418         WriteString(' expected');
 419         IF error >= longword THEN
 420                 WriteString(', NOT "');
 421                 WITH inline DO
 422                         WITH curword DO
 423                                 IF size > maxrwlen THEN
 424                                         ix := maxrwlen
 425                                 ELSE
 426                                         ix := size;
 427                                 END;
 428                                 FOR i := 1 TO ix DO
 429                                         Write(buf[base + i]);
 430                                 END;
 431                         END;
 432                 END;
 433                 Write('"');
 434         END;
 435         IF error = noeof THEN
 436                 WriteString(', FORMATTING STOPS');
 437         END;
 438         WriteString(' !!! *)');
 439         WriteLn;
 440 END WriteError;
 441
 442 PROCEDURE ReadLine;
 443 (* Read line into input buffer *)
 444 VAR
 445         c : CHAR;                       (* input character *)
 446 BEGIN
 447         WITH inline DO
 448                 len := 0;
 449                 LOOP
 450                         Read(c);
 451                         IF NOT Done THEN
 452                                 endoffile := TRUE;
 453                                 EXIT;
 454                         END;
 455                         IF c = NEWLINE THEN
 456                                 EXIT;
 457                         END;
 458                         IF c < ' ' THEN (* convert ISO control chars (except
 459                                                 leading form feed) to spaces *)
 460                                 IF c = TAB THEN
 461                                         (* ISO TAB char *)
 462                                         c := ' ';
 463                                         (* add last space at end *)
 464                                         WHILE len MOD 8 <> 7 DO
 465                                                 len := len + 1;
 466                                                 IF len < maxinlen THEN
 467                                                         buf[len] := c;
 468                                                 END;
 469                                         END;
 470                                         (* END tab handling *)
 471                                 ELSIF (c <> FF) OR (len > 0) THEN
 472                                         c := ' ';
 473                                 END;
 474                         END;            (* END ISO control char conversion *)
 475                         len := len + 1;
 476                         IF len < maxinlen THEN
 477                                 buf[len] := c;
 478                         END;
 479                 END;
 480                 IF NOT endoffile THEN
 481                         IF len >= maxinlen THEN
 482                                         (* input line too long *)
 483                                 WriteError(longline, "(ReadLine), ");
 484                                 len := maxinlen - 1;
 485                         END;
 486                         WHILE (len > 0) AND (buf[len] = ' ') DO
 487                                 len := len - 1;
 488                         END;
 489                 END;
 490                 len := len + 1;         (* add exactly ONE trailing blank *)
 491                 buf[len] := ' ';
 492                 index := 0;
 493         END;
 494 END ReadLine;
 495
 496 PROCEDURE GetChar;
 497 (* get next char from input buffer *)
 498 BEGIN
 499         WITH inline DO
 500                 index := index + 1;
 501                 ch := buf[index];
 502         END;
 503 END GetChar;
 504
 505 PROCEDURE NextChar() : CHAR;
 506 (* look at next char in input buffer *)
 507 BEGIN
 508         RETURN inline.buf[inline.index + 1];
 509 END NextChar;
 510
 511 PROCEDURE StartWord(startclass : firstclass);
 512 (* note beginning of word, and count preceding lines and spaces *)
 513 VAR
 514         first : BOOLEAN;                (* is word the first on input line? *)
 515 BEGIN
 516         first := FALSE;
 517         WITH inline DO
 518                 WITH curword DO
 519                         whenfirst := startclass;
 520                         blanklncount := 0;
 521                         WHILE (index >= len) AND NOT endoffile DO
 522                                 IF len = 1 THEN
 523                                         blanklncount := blanklncount + 1;
 524                                 END;
 525                                 IF startclass = contuncomm THEN
 526                                         FlushLine
 527                                 ELSE
 528                                         first := TRUE;
 529                                 END;
 530                                 ReadLine;
 531                                         (* with exactly ONE trailing blank *)
 532                                 GetChar;
 533                                 IF ch = FF THEN
 534                                         FlushLine;
 535                                         Write(FF);
 536                                         blanklncount := 0;
 537                                         GetChar;
 538                                 END;
 539                         END;
 540                         spaces := 0;    (* count leading spaces *)
 541                         IF NOT endoffile THEN
 542                                 WHILE ch = ' ' DO
 543                                         spaces := spaces + 1;
 544                                         GetChar;
 545                                 END;
 546                         END;
 547                         IF first THEN
 548                                 spaces := 1;
 549                         END;
 550                         base := index - 1;
 551                 END;
 552         END;
 553 END StartWord;
 554
 555 PROCEDURE FinishWord;
 556 (* note end of word *)
 557 BEGIN
 558         WITH inline DO
 559                 WITH curword DO
 560                         puncfollows := (symbol IN datawords) AND (ch <> ' ');
 561                         size := index - base - 1;
 562                 END;
 563         END;
 564 END FinishWord;
 565
 566 PROCEDURE CopyWord(newline : BOOLEAN; pword : wordtype);
 567 (* copy word from input buffer into output buffer *)
 568 VAR
 569         i : INTEGER;                    (* outline.len excess, loop index *)
 570 BEGIN
 571         WITH pword DO
 572                 WITH outline DO
 573                         i := maxoutlen - len - spaces - size;
 574                         IF newline OR (i < 0) OR ((i = 0) AND puncfollows) THEN
 575                                 FlushLine;
 576                         END;
 577                         IF len = 0 THEN (* first word on output line *)
 578                                 blanklns := blanklncount;
 579                                 CASE whenfirst OF
 580                                         (* update LOCAL word.spaces *)
 581                                 newclause:
 582                                         spaces := margin;
 583                                 | continue:
 584                                         spaces := margin;
 585                                 | alcomm:
 586                                         spaces := alcommbase;
 587                                 | contalcomm:
 588                                         spaces := alcommbase + commindent;
 589                                 | uncomm:
 590                                         spaces := base;
 591                                 | contuncomm:
 592                                         (* spaces := spaces *);
 593                                 END;
 594                                 IF spaces + size > maxoutlen THEN
 595                                         spaces := maxoutlen - size;
 596                                         (* reduce spaces *)
 597                                         IF spaces < 0 THEN
 598                                                 WriteError(longword,
 599                                                 "(CopyWord), ");
 600                                                 size := maxoutlen;
 601                                                 spaces := 0;
 602                                         END;
 603                                 END;
 604                         END;
 605                         FOR i := 1 TO spaces DO
 606                                         (* put out spaces *)
 607                                 len := len + 1;
 608                                 buf[len] := ' ';
 609                         END;
 610                         FOR i := 1 TO size DO
 611                                         (* copy actual word *)
 612                                 len := len + 1;
 613                                 buf[len] := inline.buf[base + i];
 614                         END;
 615                 END;
 616         END;
 617 END CopyWord;
 618
 619 PROCEDURE DoComment;                    (* copy aligned or unaligned comment *)
 620
 621 PROCEDURE CopyComment(commclass : firstclass; commbase : inrange);
 622 (* copy words of comment *)
 623 VAR
 624         endcomment : BOOLEAN;           (* end of comment? *)
 625 BEGIN
 626         WITH curword DO                 (* copy comment begin symbol *)
 627                 whenfirst := commclass;
 628                 spaces := commbase - outline.len;
 629                 CopyWord((spaces < 0) OR (blanklncount > 0), curword);
 630         END;
 631         commclass := VAL(firstclass, ORD(commclass)+1);
 632         WITH inline DO
 633                 REPEAT                  (* loop for successive words *)
 634                         StartWord(commclass);
 635                         endcomment := endoffile;
 636                                         (* premature end? *)
 637                         IF endcomment THEN
 638                                 WriteError(noendcomm, "(CopyComment), ")
 639                         ELSE
 640                                 REPEAT
 641                                         IF ch = '*' THEN
 642                                                 GetChar;
 643                                                 IF ch = ')' THEN
 644                                                         endcomment := TRUE;
 645                                                         GetChar;
 646                                                 END;
 647                                         ELSE
 648                                                 GetChar;
 649                                         END;
 650                                 UNTIL (ch = ' ') OR endcomment;
 651                         END;
 652                         FinishWord;
 653                         CopyWord(FALSE, curword)
 654                 UNTIL endcomment;
 655         END;
 656 END CopyComment;
 657
 658 BEGIN                                   (* DoComment *)
 659         IF curword.base < commthresh THEN
 660                                         (* copy comment without alignment *)
 661                 CopyComment(uncomm, curword.base)
 662         ELSE                            (* align AND format comment *)
 663                 CopyComment(alcomm, alcommbase);
 664         END;
 665 END DoComment;
 666
 667 PROCEDURE GetSymbol;
 668 (* get next non-comment symbol *)
 669
 670 PROCEDURE CopySymbol(symbol : symboltype; pword : wordtype);
 671 (* copy word(s) of symbol *)
 672 BEGIN
 673         IF symbol = comment THEN
 674                 DoComment;              (* NOTE: DoComment uses global word! *)
 675                 lnpending := TRUE;
 676         ELSIF symbol = semicolon THEN
 677                 CopyWord(FALSE, pword);
 678                 lnpending := NOT inheader;
 679         ELSE
 680                 CopyWord(lnpending, pword);
 681                 lnpending := FALSE;
 682         END;
 683 END CopySymbol;
 684
 685 PROCEDURE FindSymbol;
 686 (* find next symbol in input buffer *)
 687
 688 VAR
 689         termch : CHAR;                  (* string terminator *)
 690         chclass : chartype;             (* classification of leading char *)
 691
 692 PROCEDURE CheckResWord;
 693 (* check if current identifier is reserved word/symbol *)
 694 VAR
 695         rw, rwbeyond : resword;         (* loop index, limit *)
 696         symword : rwstring;             (* copy of symbol word *)
 697         i : [-1..maxrwlen];             (* loop index *)
 698 BEGIN
 699         WITH curword DO
 700                 WITH inline DO
 701                         size := index - base - 1;
 702                         IF size < maxrwlen THEN
 703                                 symword := '               ';
 704                                 FOR i := 1 TO size DO
 705                                         symword[i] := CAP(buf[ base + i]);
 706                                 END;
 707                                 rw := firstrw[size];
 708                                 rwbeyond := firstrw[size + 1];
 709                                 symbol := semicolon;
 710                                 REPEAT
 711                                         IF rw >= rwbeyond THEN
 712                                                 symbol := ident
 713                                         ELSIF StrCmp(symword, rwword[rw]) THEN
 714                                                 symbol := rwsy[rw]
 715                                         ELSE
 716                                                 rw := VAL(resword,ORD(rw)+1);
 717                                         END;
 718                                 UNTIL symbol <> semicolon;
 719                         END;
 720                         whenfirst := newclause;
 721                 END;
 722         END;
 723 END CheckResWord;
 724
 725 PROCEDURE GetName;
 726 BEGIN
 727         WHILE charclass[inline.ch] IN chartypeset{letter, digit} DO
 728                 GetChar;
 729         END;
 730         CheckResWord;
 731 END GetName;
 732
 733 PROCEDURE GetNumber;
 734 BEGIN
 735         WITH inline DO
 736                 WHILE charclass[ch] = digit DO
 737                         GetChar;
 738                 END;
 739                 IF ch = '.' THEN
 740                         IF charclass[NextChar()] = digit THEN
 741                                         (* NOTE: NextChar is a function! *)
 742                                 symbol := otherword;
 743                                 GetChar;
 744                                 WHILE charclass[ch] = digit DO
 745                                         GetChar;
 746                                 END;
 747                         END;
 748                 END;
 749                 IF CAP(ch) = 'E' THEN
 750                         symbol := otherword;
 751                         GetChar;
 752                         IF (ch = '+') OR (ch = '-') THEN
 753                                 GetChar;
 754                         END;
 755                         WHILE charclass[ch] = digit DO
 756                                 GetChar;
 757                         END;
 758                 END;
 759         END;
 760 END GetNumber;
 761
 762 PROCEDURE GetStringLiteral;
 763 VAR
 764         endstring : BOOLEAN;            (* end of string literal? *)
 765 BEGIN
 766         WITH inline DO
 767                 endstring := FALSE;
 768                 REPEAT
 769                         GetChar;
 770                         IF ch = termch THEN
 771                                 endstring := TRUE;
 772                         ELSIF index >= len THEN
 773                                         (* error, final "'" not on line *)
 774                                 WriteError(notquote, "(GetStringLiteral), ");
 775                                 symbol := syeof;
 776                                 endstring := TRUE;
 777                         END;
 778                 UNTIL endstring;
 779                 GetChar;
 780         END;
 781 END GetStringLiteral;
 782
 783 BEGIN                                   (* FindSymbol *)
 784         StartWord(continue);
 785         WITH inline DO
 786                 IF endoffile THEN
 787                         symbol := syeof
 788                 ELSE
 789                         termch := ch;   (* save for string literal routine *)
 790                         chclass := charclass[ch];
 791                         symbol := symbolclass[chclass];
 792                         GetChar;        (* second CHAR *)
 793                         CASE chclass OF
 794                         chsemicolon, chrightparen, chleftbrace, special,
 795                         illegal: ;
 796                         | letter:
 797                                 GetName;
 798                         | digit:
 799                                 GetNumber;
 800                         | chapostrophe:
 801                                 GetStringLiteral;
 802                         | chcolon:
 803                                 IF ch = '=' THEN
 804                                         symbol := othersym;
 805                                         GetChar;
 806                                 END;
 807                         | chlessthan:
 808                                 IF (ch = '=') OR (ch = '>') THEN
 809                                         GetChar;
 810                                 END;
 811                         | chgreaterthan:
 812                                 IF ch = '=' THEN
 813                                         GetChar;
 814                                 END;
 815                         | chleftparen:
 816                                 IF ch = '*' THEN
 817                                         symbol := comment;
 818                                         GetChar;
 819                                 END;
 820                         | chperiod:
 821                                 IF ch = '.' THEN
 822                                         symbol := colon;
 823                                         GetChar;
 824                                 END;    (* Added by me (CJ):  *)
 825                         ELSE
 826                         END;
 827                         FinishWord;
 828                 END;
 829         END;                            (* FindSymbol *)
 830 END FindSymbol;
 831
 832 BEGIN                                   (* GetSymbol *)
 833         REPEAT
 834                 CopySymbol(symbol, curword);
 835                                         (* copy word for symbol to output *)
 836                 FindSymbol              (* get next symbol *)
 837         UNTIL symbol <> comment;
 838 END GetSymbol;
 839
 840 PROCEDURE StartClause;
 841 (* (this may be a simple clause, or the start of a header) *)
 842 BEGIN
 843         curword.whenfirst := newclause;
 844         lnpending := TRUE;
 845 END StartClause;
 846
 847 PROCEDURE PassSemicolons;
 848 (* pass consecutive semicolons *)
 849 BEGIN
 850         WHILE symbol = semicolon DO
 851                 GetSymbol;
 852                 StartClause;
 853         END;
 854 END PassSemicolons;
 855
 856 PROCEDURE StartBody;
 857 (* finish header, start body of structure *)
 858 BEGIN
 859         StartClause;
 860         margin := margin + indent;
 861 END StartBody;
 862
 863 PROCEDURE FinishBody;
 864 (* retract margin *)
 865 BEGIN
 866         margin := margin - indent;
 867 END FinishBody;
 868
 869 PROCEDURE PassPhrase(finalsymbol : symboltype);
 870 (* process symbols until significant symbol encountered *)
 871 VAR
 872         endsyms : symbolset;            (* complete set of stopping symbols *)
 873 BEGIN
 874         IF symbol <> syeof THEN
 875                 endsyms := stopsyms;
 876                 INCL(endsyms, finalsymbol);
 877                 REPEAT
 878                         GetSymbol
 879                 UNTIL symbol IN endsyms;
 880         END;
 881 END PassPhrase;
 882
 883 PROCEDURE Expect(expectedsym : symboltype; error : errortype; syms : symbolset;
 884 nm : ARRAY OF CHAR);
 885 (* fail if current symbol is not the expected one, then recover *)
 886 BEGIN
 887         IF symbol = expectedsym THEN
 888                 GetSymbol
 889         ELSE
 890                 WriteError(error, nm);
 891                 INCL(syms, expectedsym);
 892                 WHILE NOT (symbol IN syms) DO
 893                         GetSymbol;
 894                 END;
 895                 IF symbol = expectedsym THEN
 896                         GetSymbol;
 897                 END;
 898         END;
 899 END Expect;
 900
 901 PROCEDURE Heading;
 902 (* process heading for program or procedure *)
 903
 904 PROCEDURE MatchParens;                  (* process parentheses in heading *)
 905 VAR
 906         endsyms : symbolset;
 907 BEGIN
 908         GetSymbol;
 909         WHILE NOT (symbol IN recendsyms) DO
 910                 IF symbol = leftparen THEN
 911                         MatchParens
 912                 ELSE
 913                         GetSymbol;
 914                 END;
 915         END;
 916         endsyms := stopsyms + recendsyms;
 917         Expect(rightparen, notparen, endsyms, "(MatchParens), ");
 918 END MatchParens;
 919
 920 BEGIN                                   (* heading *)
 921         GetSymbol;
 922         PassPhrase(leftparen);
 923         IF symbol = leftparen THEN
 924                 inheader := TRUE;
 925                 MatchParens;
 926                 inheader := FALSE;
 927         END;
 928         IF symbol = colon THEN
 929                 PassPhrase(semicolon);
 930         END;
 931         Expect(semicolon, notsemicolon, stopsyms, "(Heading), ");
 932
 933 END Heading;
 934
 935 PROCEDURE DoRecord;
 936 (* process record declaration *)
 937 BEGIN
 938         GetSymbol;
 939         StartBody;
 940         PassFields(FALSE);
 941         FinishBody;
 942         Expect(syend, notend, recendsyms, "(DoRecord), ");
 943 END DoRecord;
 944
 945 PROCEDURE DoVariant;
 946 (* process (case) variant part *)
 947 BEGIN
 948         PassPhrase(syof);
 949         Expect(syof, notof, stopsyms, "(Dovariant), ");
 950         StartBody;
 951         PassFields(TRUE);
 952         FinishBody;
 953 END DoVariant;
 954
 955 PROCEDURE DoParens(forvariant : BOOLEAN);
 956 (* process parentheses in record *)
 957 BEGIN
 958         GetSymbol;
 959         IF forvariant THEN
 960                 StartBody;
 961         END;
 962         PassFields(FALSE);
 963         lnpending := FALSE;             (* for empty field list *)
 964         Expect(rightparen, notparen, recendsyms, "(DoParens), ");
 965         IF forvariant THEN
 966                 FinishBody;
 967         END;
 968 END DoParens;
 969
 970 PROCEDURE PassFields(forvariant : BOOLEAN);
 971 (* process declarations *)
 972 BEGIN
 973         WHILE NOT (symbol IN recendsyms) DO
 974                 IF symbol = semicolon THEN
 975                         PassSemicolons
 976                 ELSIF symbol = syrecord THEN
 977                         DoRecord
 978                 ELSIF symbol = sycase THEN
 979                         DoVariant
 980                 ELSIF symbol = leftparen THEN
 981                         DoParens(forvariant)
 982                 ELSE
 983                         GetSymbol;
 984                 END;
 985         END;
 986 END PassFields;
 987
 988 PROCEDURE Statement;
 989 (* process statement *)
 990 BEGIN
 991         CASE symbol OF
 992         sycase:
 993                 CaseStatement;
 994                 Expect(syend, notend, stmtendsyms, "(Case), ");
 995         | syif:
 996                 IfStatement;
 997                 Expect(syend, notend, stmtendsyms, "(If), ");
 998         | syloop:
 999                 LoopStatement;
1000                 Expect(syend, notend, stmtendsyms, "(Loop), ");
1001         | syrepeat:
1002                 RepeatStatement;
1003         | forwhilewith:
1004                 ForWhileWithStatement;
1005                 Expect(syend, notend, stmtendsyms, "(ForWhileWith), ");
1006         | ident:
1007                 AssignmentProccall;
1008         | semicolon: ;                  (*!!! Added by me (CJ) *)
1009         ELSE ;
1010         END;
1011 END Statement;
1012
1013 PROCEDURE AssignmentProccall;
1014 (* pass an assignment statement or procedure call *)
1015 BEGIN
1016         WHILE NOT (symbol IN stmtendsyms) DO
1017                 GetSymbol;
1018         END;
1019 END AssignmentProccall;
1020
1021 PROCEDURE StatementSequence;
1022 (* process sequence of statements *)
1023 BEGIN
1024         Statement;
1025         LOOP
1026                 IF symbol <> semicolon THEN
1027                         EXIT;
1028                 END;
1029                 GetSymbol;
1030                 Statement;
1031         END;
1032 END StatementSequence;
1033
1034 PROCEDURE IfStatement;
1035 (* process if statement *)
1036 BEGIN
1037         PassPhrase(sythen);
1038         Expect(sythen, notthen, stopsyms, "(Ifstatement), ");
1039         StartBody;
1040         StatementSequence;
1041         FinishBody;
1042         WHILE symbol = syelsif DO
1043                 StartClause;
1044                 PassPhrase(sythen);
1045                 Expect(sythen, notthen, stopsyms, "(Elseif), ");
1046                 StartBody;              (* new line after 'THEN' *)
1047                 StatementSequence;
1048                 FinishBody;
1049         END;
1050         IF symbol = syelse THEN
1051                 StartClause;
1052                 GetSymbol;
1053                 StartBody;              (* new line after 'ELSE' *)
1054                 StatementSequence;
1055                 FinishBody;
1056         END;
1057 END IfStatement;
1058
1059 PROCEDURE CaseStatement;
1060 (* process case statement *)
1061 BEGIN
1062         PassPhrase(syof);
1063         Expect(syof, notof, stopsyms, "(caseStatement), ");
1064         StartClause;
1065         OneCase;
1066         WHILE symbol = bar DO
1067                 GetSymbol;
1068                 OneCase;
1069         END;
1070         IF symbol = syelse THEN
1071                 GetSymbol;
1072                 StartBody;
1073                 StatementSequence;
1074                 FinishBody;
1075         END;
1076 END CaseStatement;
1077
1078 PROCEDURE OneCase;
1079 (* process one case clause *)
1080 BEGIN
1081         IF NOT (symbol IN symbolset{bar, syelse}) THEN
1082                 PassPhrase(colon);
1083                 Expect(colon, notcolon, stopsyms, "(OneCase), ");
1084                 StartBody;              (* new line, indent after colon *)
1085                 StatementSequence;
1086                 FinishBody;             (* left-indent after case *)
1087         END;
1088 END OneCase;
1089
1090 PROCEDURE RepeatStatement;
1091 (* process repeat statement *)
1092 BEGIN
1093         GetSymbol;
1094         StartBody;                      (* new line, indent after 'REPEAT' *)
1095         StatementSequence;
1096         FinishBody;                     (* left-ident after UNTIL *)
1097         StartClause;                    (* new line before UNTIL *)
1098         Expect(syuntil, notuntil, stmtendsyms, "(repeatstatement), ");
1099         PassPhrase(semicolon);
1100 END RepeatStatement;
1101
1102 PROCEDURE LoopStatement;
1103 (* process loop statement *)
1104 BEGIN
1105         GetSymbol;
1106         StartBody;                      (* new line, indent after LOOP *)
1107         StatementSequence;
1108         FinishBody;                     (* left-ident before END *)
1109 END LoopStatement;
1110
1111 PROCEDURE ForWhileWithStatement;
1112 (* process for, while, or with statement *)
1113 BEGIN
1114         PassPhrase(sydo);
1115         Expect(sydo, notdo, stopsyms, "(ForWhileWithstatement), ");
1116         StartBody;
1117         StatementSequence;
1118         FinishBody;
1119 END ForWhileWithStatement;
1120
1121 PROCEDURE ProcedureDeclaration;
1122 (* pass a procedure declaration *)
1123 BEGIN
1124         ProcedureHeading;
1125         Block;
1126         Expect(ident, notident, stmtendsyms, "(Proceduredeclaration)1, ");
1127         Expect(semicolon, notsemicolon, stmtendsyms,
1128         "(Proceduredeclaration)2, ");
1129 END ProcedureDeclaration;
1130
1131 PROCEDURE ProcedureHeading;
1132 BEGIN
1133         StartClause;
1134         Heading;
1135 END ProcedureHeading;
1136
1137 PROCEDURE Block;
1138 BEGIN
1139         WHILE symbol IN symbolset{declarator, symodule, syproc} DO
1140                 Declaration;
1141         END;
1142         IF symbol = sybegin THEN
1143                 GetSymbol;
1144                 StartBody;
1145                 StatementSequence;
1146                 FinishBody;
1147         END;
1148         Expect(syend, notend, stmtendsyms, "(Block), ");
1149 END Block;
1150
1151 PROCEDURE Declaration;
1152 BEGIN
1153         IF symbol = declarator THEN
1154                 StartClause;            (* CONST, TYPE, VAR *)
1155                 GetSymbol;
1156                 StartBody;
1157                 REPEAT
1158                         PassPhrase(syrecord);
1159                         IF symbol = syrecord THEN
1160                                 DoRecord;
1161                         END;
1162                         IF symbol = semicolon THEN
1163                                 PassSemicolons;
1164                         END;
1165                 UNTIL symbol IN headersyms;
1166                 FinishBody;
1167         ELSIF symbol = symodule THEN
1168                 ModuleDeclaration;
1169         ELSIF symbol = syproc THEN
1170                 ProcedureDeclaration;
1171         END;
1172 END Declaration;
1173
1174 PROCEDURE ModuleDeclaration;
1175 BEGIN
1176         PassPhrase(semicolon);
1177         PassSemicolons;
1178         WHILE symbol IN symbolset{syimport, syexport, syfrom} DO
1179                 ImportExport;
1180         END;
1181         Block;
1182         Expect(ident, notident, stmtendsyms, "(ModuleDeclaration), ");
1183 END ModuleDeclaration;
1184
1185 PROCEDURE ImportExport;
1186 BEGIN
1187         IF symbol = syfrom THEN
1188                 PassPhrase(syimport);
1189         END;
1190         IF symbol = syimport THEN
1191                 GetSymbol;
1192         ELSIF symbol = syexport THEN
1193                 GetSymbol;
1194                 IF symbol = syqual THEN
1195                         GetSymbol;
1196                 END;
1197         END;
1198         StartBody;
1199         PassPhrase(semicolon);
1200         FinishBody;
1201         GetSymbol;
1202 END ImportExport;
1203
1204 PROCEDURE OneDefinition;
1205 BEGIN
1206         IF symbol = declarator THEN
1207                 Declaration;
1208         ELSIF symbol = syproc THEN
1209                 ProcedureHeading;
1210         END;
1211 END OneDefinition;
1212
1213 PROCEDURE DefinitionModule;
1214 BEGIN
1215         GetSymbol;
1216         PassPhrase(semicolon);
1217         GetSymbol;
1218         WHILE symbol IN symbolset{syimport, syexport, syfrom} DO
1219                 ImportExport;
1220         END;
1221         WHILE symbol IN symbolset{declarator, syproc} DO
1222                 OneDefinition;
1223         END;
1224         Expect(syend, notend, stmtendsyms, "DefinitionModule1, " );
1225         GetSymbol;
1226         Expect(period, notperiod, stmtendsyms, 'DefintionModule2, ');
1227 END DefinitionModule;
1228
1229 PROCEDURE ProgramModule;
1230 BEGIN
1231         ModuleDeclaration;
1232         Expect(period, notperiod, stmtendsyms, "ProgramModule, ");
1233 END ProgramModule;
1234
1235 PROCEDURE CompilationUnit;
1236 BEGIN
1237         IF symbol = syimplementation THEN
1238                 GetSymbol;
1239                 ProgramModule;
1240         ELSIF symbol = sydefinition THEN
1241                 DefinitionModule;
1242         ELSE
1243                 ProgramModule;
1244         END;
1245 END CompilationUnit;
1246
1247 PROCEDURE CopyRemainder;
1248 (* copy remainder of input *)
1249 BEGIN
1250         WriteError(noeof, "(Copyremainder), ");
1251         WITH inline DO
1252                 REPEAT
1253                         CopyWord(FALSE, curword);
1254                         StartWord(contuncomm);
1255                         IF NOT endoffile THEN
1256                                 REPEAT
1257                                         GetChar
1258                                 UNTIL ch = ' ';
1259                         END;
1260                         FinishWord;
1261                 UNTIL endoffile;
1262         END;
1263 END CopyRemainder;
1264
1265 PROCEDURE Initialize;
1266 (* initialize global variables *)
1267 BEGIN
1268         WITH inline DO
1269                 endoffile := FALSE;
1270                 ch := ' ';
1271                 index := 0;
1272                 len := 0;
1273         END;
1274         WITH outline DO
1275                 blanklns := 0;
1276                 len := 0;
1277         END;
1278         WITH curword DO
1279                 whenfirst := contuncomm;
1280                 puncfollows := FALSE;
1281                 blanklncount := 0;
1282                 spaces := 0;
1283                 base := 0;
1284                 size := 0;
1285         END;
1286         margin := initmargin;
1287         lnpending := FALSE;
1288         symbol := othersym;
1289         inheader := FALSE;
1290 END Initialize;
1291
1292 BEGIN
1293         StructConsts;
1294         Initialize;
1295 (* Files may be opened here. *)
1296         OpenInput("mod");
1297         OpenOutput("mod");
1298         GetSymbol;
1299         CompilationUnit;
1300         IF NOT inline.endoffile THEN
1301                 CopyRemainder;
1302         END;
1303         FlushLine;
1304         CloseInput;
1305         CloseOutput;
1306 END Modula2PrettyPrinter.