Modula-2 prettyprinter
sources-request at panda.UUCP
sources-request at panda.UUCP
Tue Nov 5 00:31:04 AEST 1985
Mod.sources: Volume 3, Issue 35
Submitted by: Ken Yap <talcott!seismo!rochester!ken>
This is the source for a Modula-2 prettyprinter, written in Modula-2.
I believe everything needed, including a Makefile, is in the shar archive
below.
Cheers, Ken
--
#!/bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #!/bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# README
# Makefile
# m2p.mod
# InOut.def
# InOut.c
# This archive created: Sat Nov 2 02:03:56 1985
# By: Ken Yap (U of Rochester, CS Dept)
export PATH; PATH=/bin:$PATH
if test -f 'README'
then
echo shar: over-writing existing file "'README'"
fi
cat << \SHAR_EOF > 'README'
This is a Modula-2 prettyprinter. It takes a valid program from input
and writes a formatted version to output. If it runs into syntax errors
it may stop formatting and copy the rest of the file verbatim. It
isn't exactly the best example of modularity, but...
It uses the standard InOut module. An implementation of this module and
Makefile for the DECWRL compiler under 4.2 BSD is included as an
example. You may need to make some minor changes for other Modula-2
systems.
I wanted to put more stuff in but I got tired of having it around so I
am pushing it out the door. I would be grateful if you would report any
bugs or enhancements so that I can collect and redistribute the
changes. I have tried to make it as OS independent as possible.
Please remember that Modula-2 runs on many systems. If you make changes
that are specific to a machine/OS, please put the changes in specific
modules or procedures.
That is all, I think. Have fun.
Ken Yap
Dept. of Comp. Sci., U of Rochester
1st November 1985
UUCP: ..!{seismo,decvax,allegra}!rochester!ken
ARPA: ken at rochester.arpa
SHAR_EOF
if test 1090 -ne "`wc -c 'README'`"
then
echo shar: error transmitting "'README'" '(should have been 1090 characters)'
fi
if test -f 'Makefile'
then
echo shar: over-writing existing file "'Makefile'"
fi
cat << \SHAR_EOF > 'Makefile'
m2p: m2p.o InOut.o
mod -g -o m2p m2p.o InOut.o
m2p.o: m2p.mod
mod -s -g -c m2p.mod
InOut.o: InOut.c
cc -O -c InOut.c
SHAR_EOF
if test 122 -ne "`wc -c 'Makefile'`"
then
echo shar: error transmitting "'Makefile'" '(should have been 122 characters)'
fi
if test -f 'm2p.mod'
then
echo shar: over-writing existing file "'m2p.mod'"
fi
cat << \SHAR_EOF > 'm2p.mod'
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.
SHAR_EOF
if test 33277 -ne "`wc -c 'm2p.mod'`"
then
echo shar: error transmitting "'m2p.mod'" '(should have been 33277 characters)'
fi
if test -f 'InOut.def'
then
echo shar: over-writing existing file "'InOut.def'"
fi
cat << \SHAR_EOF > 'InOut.def'
DEFINITION MODULE InOut;
EXPORT
Done, Read, Write, WriteLn, WriteString;
VAR
Done : BOOLEAN;
PROCEDURE Read(VAR ch : CHAR);
PROCEDURE Write(ch : CHAR);
PROCEDURE WriteLn;
PROCEDURE WriteString(s : ARRAY OF CHAR);
END InOut.
SHAR_EOF
if test 233 -ne "`wc -c 'InOut.def'`"
then
echo shar: error transmitting "'InOut.def'" '(should have been 233 characters)'
fi
if test -f 'InOut.c'
then
echo shar: over-writing existing file "'InOut.c'"
fi
cat << \SHAR_EOF > 'InOut.c'
#include <stdio.h>
int InOut_Done = 0;
InOut__init()
{
InOut_Done = 0;
}
InOut_Read(c)
char *c;
{
register char ch;
if ((ch = getchar()) == EOF)
InOut_Done = 1;
else
*c = ch & 0177;
}
InOut_Write(c)
char c;
{
putchar(c);
}
InOut_WriteLn()
{
putchar('\n');
}
InOut_WriteString(s, l)
char *s;
int l;
{
while (l-- > 0)
putchar(*s++);
}
SHAR_EOF
if test 357 -ne "`wc -c 'InOut.c'`"
then
echo shar: error transmitting "'InOut.c'" '(should have been 357 characters)'
fi
# End of shell archive
exit 0
--
UUCP: ..!{allegra,decvax,seismo}!rochester!ken ARPA: ken at rochester.arpa
USnail: Dept. of Comp. Sci., U. of Rochester, NY 14627. Voice: Ken!
More information about the Mod.sources
mailing list