1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306 |
- MODULE Modula2PrettyPrinter;
- FROM InOut IMPORT
- Done, Read, Write, WriteLn, WriteString, OpenInput, OpenOutput,
- CloseInput, CloseOutput;
- (*
- ** 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 = 80; (* 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 = INTEGER[0..32767];
- inrange = INTEGER[0..maxinlen];
- outrange = INTEGER[0..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 *)
- 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 StrCmp(a, b : rwstring) : BOOLEAN;
- VAR
- i : INTEGER;
- BEGIN
- FOR i := 1 TO maxrwlen DO
- IF a[i] # b[i] THEN
- RETURN FALSE;
- END;
- END;
- RETURN TRUE;
- END StrCmp;
- 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};
- 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; nm : ARRAY OF CHAR);
- (* report error to output *)
- VAR
- i, ix : inrange; (* loop index, limit *)
- BEGIN
- FlushLine;
- WriteString('(* !!! error, ');
- WriteString(nm);
- 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 *)
- BEGIN
- WITH inline DO
- len := 0;
- LOOP
- Read(c);
- IF NOT Done THEN
- endoffile := TRUE;
- 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, "(ReadLine), ");
- 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,
- "(CopyWord), ");
- 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, "(CopyComment), ")
- 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 StrCmp(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, "(GetStringLiteral), ");
- 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; (* Added by me (CJ): *)
- ELSE
- 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 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;
- nm : ARRAY OF CHAR);
- (* fail if current symbol is not the expected one, then recover *)
- BEGIN
- IF symbol = expectedsym THEN
- GetSymbol
- ELSE
- WriteError(error, nm);
- 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, "(MatchParens), ");
- 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, "(Heading), ");
- END Heading;
- PROCEDURE DoRecord;
- (* process record declaration *)
- BEGIN
- GetSymbol;
- StartBody;
- PassFields(FALSE);
- FinishBody;
- Expect(syend, notend, recendsyms, "(DoRecord), ");
- END DoRecord;
- PROCEDURE DoVariant;
- (* process (case) variant part *)
- BEGIN
- PassPhrase(syof);
- Expect(syof, notof, stopsyms, "(Dovariant), ");
- 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, "(DoParens), ");
- 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, "(Case), ");
- | syif:
- IfStatement;
- Expect(syend, notend, stmtendsyms, "(If), ");
- | syloop:
- LoopStatement;
- Expect(syend, notend, stmtendsyms, "(Loop), ");
- | syrepeat:
- RepeatStatement;
- | forwhilewith:
- ForWhileWithStatement;
- Expect(syend, notend, stmtendsyms, "(ForWhileWith), ");
- | ident:
- AssignmentProccall;
- | semicolon: ; (*!!! Added by me (CJ) *)
- ELSE ;
- 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, "(Ifstatement), ");
- StartBody;
- StatementSequence;
- FinishBody;
- WHILE symbol = syelsif DO
- StartClause;
- PassPhrase(sythen);
- Expect(sythen, notthen, stopsyms, "(Elseif), ");
- 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, "(caseStatement), ");
- 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, "(OneCase), ");
- 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, "(repeatstatement), ");
- 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, "(ForWhileWithstatement), ");
- StartBody;
- StatementSequence;
- FinishBody;
- END ForWhileWithStatement;
- PROCEDURE ProcedureDeclaration;
- (* pass a procedure declaration *)
- BEGIN
- ProcedureHeading;
- Block;
- Expect(ident, notident, stmtendsyms, "(Proceduredeclaration)1, ");
- Expect(semicolon, notsemicolon, stmtendsyms,
- "(Proceduredeclaration)2, ");
- 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, "(Block), ");
- 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, "(ModuleDeclaration), ");
- 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, "DefinitionModule1, " );
- GetSymbol;
- Expect(period, notperiod, stmtendsyms, 'DefintionModule2, ');
- END DefinitionModule;
- PROCEDURE ProgramModule;
- BEGIN
- ModuleDeclaration;
- Expect(period, notperiod, stmtendsyms, "ProgramModule, ");
- 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, "(Copyremainder), ");
- 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;
- inheader := FALSE;
- END Initialize;
- BEGIN
- StructConsts;
- Initialize;
- (* Files may be opened here. *)
- OpenInput("mod");
- OpenOutput("mod");
- GetSymbol;
- CompilationUnit;
- IF NOT inline.endoffile THEN
- CopyRemainder;
- END;
- FlushLine;
- CloseInput;
- CloseOutput;
- END Modula2PrettyPrinter.
|