Relay-Version: version B 2.10.3 4.3bsd-beta 6/6/85; site seismo.CSS.GOV
Posting-Version: version B 2.10.2 9/3/84; site panda.UUCP
Path: seismo!harvard!talcott!panda!sources-request
From: sources-request@panda.UUCP
Newsgroups: mod.sources
Subject: Modula-2 prettyprinter
Message-ID: <1062@panda.UUCP>
Date: 4 Nov 85 14:31:04 GMT
Sender: jpn@panda.UUCP
Organization: U of Rochester, CS Dept
Lines: 1448
Approved: jpn@panda.UUCP

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@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@rochester.arpa
USnail:	Dept. of Comp. Sci., U. of Rochester, NY 14627. Voice: Ken!