(*====================================================================*) (* *) (* Program title: PASCAL prettyprinting program *) (* *) (* Authors: Jon F. Hueras and Henry F. Ledgard *) (* Computer and information science department *) (* University of Massachusetts, Amherst *) (* (earlier versions and contributions by Randy Chow *) (* and John Gorman.) *) (* *) (* Program Summary: *) (* *) (* This program takes as input a Pascal program and *) (* reformats the program according to a standard set of *) (* prettyprinting rules. The prettyprinted program is given *) (* as output. The prettyprinting rules are given below . *) (* *) (* As important feature is the provision for the use of extra *) (* spaces and extra blank lines. They may be freely inserted by *) (* the user in addition to the spaces and blank lines inserted *) (* by the prettyprinting. *) (* *) (* No attempt is made to detect or correct syntactic errors in *) (* the user's program. However, syntactic errors may result in *) (* erroneous prettyprinting. *) (* *) (* Input file: inputfile -A file of characters, presumably a *) (* pascal program or program fragment. *) (* *) (* Output file: Outputfile - The prettyprinted program *) (* *) (* This copy of the program was re-keyboarded from the book *) (* PASCAL WITH STYLE (by program authors) at the *) (* University of Toronto Computing Services, 1980. *) (* Typing by Theresa Kusy, minor programming changes *) (* and a few bug corrections by Ian F. Darwin *) (* *) (* A few changes to the indentation rules too *) (* *) (* Changed to print known keywords in UPPER CASE *) (* Printing of otherstuff is Not Changed. *) (* *) (* Nota bene: NO provision is made for handling imbedded TAB *) (* characters. I suggest you use a preprocessor to *) (* filter them out, rather than adding that logic here *) (* *) (* Likewise, there is no provision for handling the *) (* comment forms brace or slash-asterisk. *) (* You should use FIXCOM or something to filter these. *) (* *) (* Bonus - this copy has been run through the program! *) (* *) (*====================================================================*) (*====================================================================*) (* *) (* PASCAL PRETTYPRINTING RULES *) (* *) (* [ GENERAL PRETTYPRINTING RULES ] *) (* *) (* 1. Any spaces or blank lines beyond those generated by the *) (* Prettyprinter are left along. The user is encouraged, for *) (* the sake of readability, to make use of this facility. *) (* In addition, comments are left where they are found, unless *) (* they are shifted right by preceeding text on a line. *) (* *) (* 2. All statements and declarations begin on separate lines. *) (* *) (* 3. No line may be greater than 72 characters long. Any line *) (* longer than this is continued on a separate line. *) (* *) (* 4. The keywords "BEGIN", "END", "REPEAT", "RECORD" *) (* and "CONST", "TYPE", "VAR" are IFD *) (* forced to stand on lines by themselves (or possibly followed *) (* by supporting comments). *) (* *) (* 5. A blank line is forced before the keywords "PROCEDURE", *) (* "FUNCTIONS", "LABEL", "CONST", "TYPE", and "VAR". *) (* *) (* 6. A space is forced before and after the symbols ":=" and *) (* "=". Additionally, a space is forced after the symbol ":". *) (* *) (* [INDENTATION RULES] *) (* *) (* 1. The bodies of "LABEL", "CONST", "TYPE", and "VAR" *) (* declarations are indented by a standard amount. *) (* *) (* 2. The bodies of "BEGIN-END", "REPEAT-UNTIL", "FOR", "WHILE", *) (* "WITH", and "CASE" statements, as well as "RECORD-END" struc- *) (* tures and "CASE" variants (to one level) are indented from *) (* their header keywords. *) (* *) (* 3. An "IF-THEN-ELSE" statement is indented as follows: *) (* *) (* If *) (* THEN *) (* *) (* ELSE *) (* *) (* *) (* *) (*====================================================================*) (*====================================================================*) (* *) (* GENERAL ALGORITHM *) (* *) (* The strategy of the prettyprinter is to scan symbols from *) (* the input program and map each symbol into a prettyprinting *) (* action, independently of the context in which the symbol *) (* appears. This is accomplished by a table of prettyprinting *) (* options. *) (* *) (* For each distinguished symbol in the table, there is an *) (* associated set of options. If the option has been selected for *) (* the symbol being scanned, then the action corresponding with *) (* each option is performed. *) (* *) (* The basic actions involved in prettyprinting are the indent- *) (* ation and de-indentation of the margin. Each time the margin is *) (* indented, the previous value of the margin is pushed onto a *) (* stack, along with the name of the symbol that caused it to be *) (* indented. Each time the margin is de-indented, the stack is *) (* popped off the obtain the previous value of the margin. *) (* *) (* The prettyprinting options are processed in the following *) (* order, and invoke the following actions: *) (* *) (* CRSUPPRESS -If a carriage return has been inserted *) (* following the previous symbol, then it is *) (* inhibited until the next symbol is printed. *) (* *) (* CRBEFORE -A carriage return is inserted before the *) (* current symbol (unless one is already there) *) (* *) (* BLANKLINEBEFORE -A blank line is inserted before the current *) (* symbol (unless already there). *) (* *) (* DINDENTONKEYS -If any of the specified keys are on top of *) (* of the stack, the stack is popped, de-indenting *) (* the margin. The process is repeated *) (* until the top of the stack is not one of the *) (* specified keys. *) (* *) (* DINDENT -The stack is unconditionally popped and the *) (* margin is de-indented. *) (* *) (* SPACEBEFORE -A space is inserted before the symbol being *) (* scanned (unless aleady there.) *) (* *) (* [THE SYMBOL IS PRINTED AT THIS POINT] *) (* *) (* SPACEAFTER -A space is inserted after the symbol being *) (* scanned (unless already there). *) (* *) (* GOBBLESYMBOLS -Symbols are continuously scanned and printed *) (* without any processing until one of the *) (* specified symbols is seen (but not gobbled). *) (* *) (* INDENTBYTAB -The margin is indented by a standard amount *) (* from the previous margin. *) (* *) (* INDENTTOCLP -The margin is indented to the current line *) (* position. *) (* *) (* CRafter -A carriage return is inserted following the *) (* symbol scanned. *) (*====================================================================*) PROGRAM Prettyprint ( (* FROM *) INPUTFILE, (* TO *) OUTPUTFILE ); CONST MAXSYMBOLSIZE = 200; (* The maximum size (in characters) of a *) (* Symbol scanned by the lexical scanner. *) MAXSTACKSIZE = 100; (* The maximum number of symbols causing *) (* Indentation that may be stacked. *) MAXKEYLENGTH = 10; (* The maximum length (in characters) of a*) (* Pascal reserved keyword. *) MAXLINESIZE = 120;(* The maximum size (in characters) of a *) (* Line output by the prettyprinter. *) (* Changed from 72 to 120 by IFD *) SLOWFAIL1 = 50; (* Up to this column position, each time *) (* "identbytab" is invoked, the margin *) (* will be indented by "indent1" *) (* Changed from 30 to 50 by IFD *) SLOWFAIL2 = 68; (* Up to this column position, each time *) (* "indentbytab" is invoked, the margin *) (* Will be indented by "indent2" beyond *) (* This, no indentation occurs. *) (* Changed from 48 to 68 by IFD *) INDENT1 = 3; INDENT2 = 1; SPACE = ' '; TYPE KEYSYMBOL = (progsym , funcsym, procsym, labelsym, constsym, typesym, varsym, beginsym, repeatsym, recordsym, casesym, casevarsym, ofsym, forsym, whilesym, withsym, dosym, ifsym, thensym, elsesym, endsym, untilsym, becomes, opencomment, closecomment, semicolon, colon, equals, openparen, closeparen, period, endoffile, othersym ); OPTION = ( crsuppress, crbefore, blanklinebefore, dindentonkeys, dindent, spacebefore, spaceafter, gobblesymbols, indentbytab, indenttoclp, CRafter ); OPTIONSET = set OF option; KEYSYMSET = set OF keysymbol; TABLEENTRY = RECORD OPTIONSselected : optionset; dindentsymbols : keysymset; gobbleterminators: keysymset; END; OPTIONTABLE = array [ keysymbol ] OF tableentry; key = packed array [ 1..maxkeylength ] OF char; Keywordtable = array [ progsym..untilsym ] OF key; specialchar = packed array [ 1..2 ] OF char; dblchrset = set OF becomes..opencomment; dblchartable = array [ becomes..opencomment ] OF specialchar; sglchartable = array [ semicolon ..period ] OF char; string = array [ 1..maxsymbolsize ] OF char; symbol = RECORD name : keysymbol; value : string; length : integer; spacesbefore : integer; crsbefore : integer END; symbolinfo = ^symbol; charname = ( letter, digit, blank, quote, endofline, filemark, otherchar ); charinfo = RECORD name : charname; value: char END; stackentry = RECORD indentsymbol: keysymbol; prevmargin : integer END; symbolstack = array [ 1.. maxstacksize ] OF stackentry; VAR inputfile, outputfile: text; recordseen: boolean; currchar, nextchar: charinfo; currsym, nextsym: symbolinfo; crpending: boolean; ppoption: optiontable; keyword: keywordtable; dblchars: dblchrset; dblchar: dblchartable; sglchar: sglchartable; stack: symbolstack; top : integer; currlinepos, currmargin : integer; FUNCTION upcase ( (* of *) ch : char ) (* returning *) : char; CONST lowercaseoffset = 32; (* = 040b *) (* makes sure that "ch" is uppercase *) BEGIN (* upcase *) IF ch >= 'a' THEN upcase := chr(ord(ch)-lowercaseoffset) ELSE upcase := ch END (* upcase *); PROCEDURE getchar ( (* from *) VAR inputfile : text; (* updating *) VAR nextchar : charinfo; (* returning *) VAR currchar : charinfo ); BEGIN (* getchar *) Currchar := nextchar; WITH nextchar DO BEGIN IF eof (inputfile) THEN NAME := filemark ELSE IF eoln (inputfile) THEN BEGIN Name := endofline; END ELSE IF upcase(inputfile^) in ['A'..'Z'] THEN Name := letter ELSE IF inputfile^ in ['0'..'9'] THEN Name := digit ELSE IF inputfile ^ = '''' THEN Name := quote ELSE IF inputfile^ = space THEN Name := blank ELSE NAME := otherchar; IF name in [ filemark, endofline ] THEN Value := space ELSE VALUE := inputfile^; IF name <> filemark THEN Get (inputfile) END (* with *) END; (* getchar *) PROCEDURE storenextchar ( (* from *) VAR inputfile : text; (* updating *) VAR length : integer; VAR currchar, nextchar : charinfo; (* placing in *) VAR value : string ); BEGIN (* storenextchar *) getchar ( (* from *) inputfile, (* updating *) nextchar, (* returning *) currchar ); IF length < maxsymbolsize THEN BEGIN length := length + 1; value [length] := currchar.value END END; (* storenextchar *) PROCEDURE skipspaces ( (* in *) VAR inputfile :text; (* updating *) VAR currchar, nextchar : charinfo; (* returning *)VAR spacesbefore, crsbefore : integer ); BEGIN (* skipspaces *) crsbefore := 0; spacesbefore := 0; WHILE nextchar.name in [ blank, endofline ] DO BEGIN getchar ( (* from *) inputfile, (* updating *) nextchar, (* returning *) currchar ); CASE currchar.name OF blank : spacesbefore := spacesbefore + 1; endofline : BEGIN crsbefore := crsbefore +1; spacesbefore := 0 END END (* case *) END (* while *) END ; (* skipspaces *) PROCEDURE getcomment ( (* from *) VAR inputfile : text; (* updating *) VAR currchar, nextchar : charinfo; VAR name : keysymbol; VAR value : string; VAR length : integer ); BEGIN (* getcomment *) name := opencomment; WHILE not ( ((currchar.value = '*') and (nextchar.value =')')) or (nextchar.name = endofline) or (nextchar.name = filemark)) DO storenextchar ( (* from *) inputfile, (* updating *) length, currchar, nextchar, (* in *) value ); IF (currchar.value = '*') and (nextchar. value = ')') THEN BEGIN storenextchar ( (* from *) inputfile, (* updating *) length, currchar, nextchar, value ); name := closecomment END END; (* getcomment *) FUNCTION idtype ( (* of *) value : string; (* using *) length: integer ) (* returning *) : keysymbol; (* this function finds the type as a member of the class "keysymbol" given its character value in "value" *) CONST lowercaseoffset = 32; (* 32 = 040b for ascii on pdp's *) VAR i: integer; keyvalue: key; hit: boolean; thiskey: keysymbol; BEGIN (* idtype *) idtype := othersym; IF length <= maxkeylength THEN BEGIN FOR i := 1 to length DO keyvalue [i] := upcase ( value [i] ); FOR i := length+1 to maxkeylength DO keyvalue [i] := space; thiskey := progsym; hit := false; WHILE not (hit or (thiskey = becomes)) DO (* checking becomes looks only at keywords *) IF keyvalue = keyword [thiskey] THEN hit := true ELSE thiskey := succ(thiskey); IF hit THEN idtype := thiskey END; END; (* idtype *) PROCEDURE getidentifier ( (* from *) VAR inputfile : text; (* updating *) VAR currchar, nextchar : charinfo; (* returning *) VAR name : keysymbol; VAR value : string; VAR length : integer ) ; BEGIN (* getidentifier *) WHILE nextchar.name in [ letter, digit ] DO storenextchar ( (* from *) inputfile, (* updating *) length, currchar, nextchar, (* in *) value ); name := idtype( (* of *) value, (* using *)length ); IF name in [ recordsym, casesym, endsym ] THEN CASE name OF recordsym : recordseen := true; casesym : IF recordseen THEN name := casevarsym; endsym : recordseen := false END (* case *) END; (* getidentifier *) PROCEDURE getnumber ( (* from *) VAR inputfile : text; (* updating *) VAR currchar, nextchar : charinfo; (* returning *) VAR name : keysymbol; VAR value : string; VAR length : integer ); BEGIN (* getnumber *) WHILE nextchar.name = digit DO storenextchar ( (* from *) inputfile, (* updating *) length, currchar, nextchar, (* in *) value ); name := othersym END; (* getnumber *) PROCEDURE getcharliteral ( (* from *) VAR inputfile :text; (* updating *) VAR currchar, nextchar : charinfo; (* returning *) VAR name : keysymbol; VAR value : string; VAR length : integer ); BEGIN (* getcharliteral *) WHILE nextchar.name = quote DO BEGIN storenextchar ( (* from *) inputfile, (* updating *) length, currchar, nextchar, (* in *) value ); WHILE not(nextchar.name in [ quote, endofline, filemark ]) DO storenextchar ( (* from *) inputfile, (* updating *) length, currchar, nextchar, (* in *) value ); IF nextchar.name = quote THEN storenextchar ( (* from *) inputfile, (* updating *)length, currchar, nextchar, (* in *) value ); END; name := othersym END; (* getcharliteral *) FUNCTION chartype ( (* of *) currchar, nextchar : charinfo ) (* returning *) : keysymbol; VAR nexttwochars: specialchar; hit: boolean; thischar: keysymbol; BEGIN (* chartype *) nexttwochars[1] := currchar.value; nexttwochars[2] := nextchar.value; thischar := becomes; hit := false; WHILE not (hit or (thischar = closecomment)) DO IF nexttwochars = dblchar [thischar] THEN hit := true ELSE thischar := succ(thischar); IF not hit THEN BEGIN thischar := semicolon; WHILE not(hit or (pred(thischar) = period)) DO IF currchar.value = sglchar [thischar] THEN hit := true ELSE thischar := succ(thischar) END; IF hit THEN chartype := thischar ELSE chartype := othersym END; (* chartype *) PROCEDURE getspecialchar ( (* from *) VAR inputfile : text; (* updating *) VAR currchar, nextchar : charinfo; (* returning *) VAR name : keysymbol; VAR value : string; VAR length : integer ); BEGIN (* getspecialchar *) storenextchar ( (* from *) inputfile, (* updating *) length, currchar, nextchar, (* in *) value ); name := chartype( (* of *) currchar, nextchar ); IF name in dblchars THEN storenextchar ( (* from *) inputfile, (* updating *) length, currchar, nextchar, (* in *) value ) END; (* getspecialchar *) PROCEDURE getnextsymbol ( (* from *) VAR inputfile : text; (* updating *) VAR currchar, nextchar : charinfo; (* returning *) VAR name : keysymbol; VAR value : string; VAR length : integer ); BEGIN (* getnextsymbol *) CASE nextchar.name OF letter : getidentifier ( (* from *) inputfile, (* updating *) currchar, nextchar, (* returning *) name, value, length ); digit : getnumber ( (* from *) inputfile, (* updating *) currchar, nextchar, (* returning *) name, value, length ); quote : getcharliteral ( (* from *) inputfile, (* updating *) currchar, nextchar, (* returning *) name, value, length ); otherchar : BEGIN getspecialchar ( (* from *) inputfile, (* updating *) currchar, nextchar, (* returning *) name, value, length ); IF name = opencomment THEN getcomment ( (* from *) inputfile, (* updating *) currchar, nextchar, name, value, length ); END; filemark : name := endoffile END (* case *) END; (* getnextsymbol *) PROCEDURE getsymbol ( (* from *) VAR inputfile : text; (* updating *) VAR nextsym : symbolinfo; (* returning *) VAR currsym : symbolinfo ); VAR dummy: symbolinfo; BEGIN (* getsymbol *) dummy := currsym; currsym := nextsym; nextsym := dummy ; WITH nextsym^ DO BEGIN skipspaces ( (* in *) inputfile, (* updating *) currchar, nextchar, (* returning *) spacesbefore, crsbefore ); length := 0; IF currsym^.name = opencomment THEN getcomment ( (* from *) inputfile, (* updating *) currchar, nextchar, (* returning *) name, value, length ) ELSE getnextsymbol ( (* from *) inputfile, (* updating *) currchar, nextchar, (* returning *) name, value, length ) END (* with *) END; (* getsymbol *) PROCEDURE initialize ( (* returning *) VAR inputfile, outputfile :text; VAR topofstack : integer; VAR currlinepos, currmargin : integer; VAR keyword : keywordtable; VAR dblchars : dblchrset; VAR dblchar : dblchartable; VAR sglchar : sglchartable; VAR recordseen : boolean; VAR currchar, nextchar : charinfo; VAR currsym, nextsym : symbolinfo; VAR ppoption : optiontable; VAR crpending : boolean ); VAR filename : string; begin (* initalize *) (* Prompts and REset/write added for OMSI - ifd *) write('Input file: '); readln(filename); reset (inputfile, filename); write('Output file: '); readln(filename); rewrite (outputfile, filename); topofstack := 0; currlinepos := 0; currmargin := 0; crpending := false; keyword [ PROGSYM ] := 'PROGRAM '; keyword [ FUNCSYM ] := 'FUNCTION '; keyword [ PROCSYM ] := 'PROCEDURE '; keyword [ LABELSYM ] := 'LABEL '; keyword [ CONSTSYM ] := 'CONST '; keyword [ TYPESYM ] := 'TYPE '; keyword [ VARSYM ] := 'VAR '; keyword [ BEGINSYM ] := 'BEGIN '; keyword [ REPEATSYM ] := 'REPEAT '; keyword [ RECORDSYM ] := 'RECORD '; keyword [ CASESYM ] := 'CASE '; keyword [ CASEVARSYM ] := 'CASE '; keyword [ OFSYM ] := 'OF '; keyword [ FORSYM ] := 'FOR '; keyword [ WHILESYM ] := 'WHILE '; keyword [ WITHSYM ] := 'WITH '; keyword [ DOSYM ] := 'DO '; keyword [ IFSYM ] := 'IF '; keyword [ THENSYM ] := 'THEN '; keyword [ ELSESYM ] := 'ELSE '; keyword [ ENDSYM ] := 'END '; keyword [ UNTILSYM ] := 'UNTIL '; DBLCHARS := [ BECOMES, OPENCOMMENT ]; DBLCHAR [ BECOMES ] := ':=' ; DBLCHAR [ OPENCOMMENT ] := '(*' ; SGLCHAR [ SEMICOLON ] := ';' ; SGLCHAR [ COLON ] := ':' ; SGLCHAR [ EQUALS ] := '=' ; SGLCHAR [ OPENPAREN ] := '(' ; SGLCHAR [ CLOSEPAREN ] := ')' ; SGLCHAR [ PERIOD ] := '.' ; RECORDSEEN := FALSE; GETCHAR ( (* FROM *) INPUTFILE, (* UPDATING *) NEXTCHAR, (* RETURNING *) CURRCHAR ); NEW (CURRSYM); NEW (NEXTSYM); GETSYMBOL ( (* FROM *) INPUTFILE, (* UPDATING *) NEXTSYM, (* RETURNING *) CURRSYM ); WITH ppoption [ progsym ] DO BEGIN optionsselected := [ crbefore, (* ifd *) spaceafter ]; dindentsymbols := []; gobbleterminators := [] END; WITH ppoption [ funcsym ] DO BEGIN optionsselected := [ blanklinebefore, dindentonkeys, spaceafter ]; dindentsymbols := [ labelsym, constsym, typesym, varsym ]; gobbleterminators := [] END; WITH ppoption [ procsym ] DO BEGIN optionsselected := [ blanklinebefore, dindentonkeys, spaceafter ]; dindentsymbols := [ labelsym, constsym, typesym, varsym ]; gobbleterminators := [] END; WITH ppoption [ labelsym ] DO BEGIN optionsselected := [ crbefore, (* ifd *) spaceafter, indentbytab ]; dindentsymbols := []; gobbleterminators := [] END; WITH ppoption [ constsym ] DO BEGIN optionsselected := [ crbefore, (* ifd *) dindentonkeys, crafter, indentbytab ]; dindentsymbols := [ labelsym ]; gobbleterminators := [] END; WITH ppoption [ typesym ] DO BEGIN optionsselected := [ crbefore, (* ifd *) dindentonkeys, crafter, indentbytab ]; dindentsymbols := [ labelsym , constsym ]; gobbleterminators := [] END; WITH ppoption [ varsym ] DO BEGIN optionsselected := [ crbefore, (* ifd *) dindentonkeys, crafter, indentbytab ]; dindentsymbols := [ labelsym, constsym, typesym ]; gobbleterminators := [] END; WITH ppoption [ beginsym ] DO BEGIN optionsselected := [ dindentonkeys, indentbytab, crafter ]; dindentsymbols := [ labelsym, constsym, typesym, varsym ]; gobbleterminators := [] END; WITH ppoption [ repeatsym ] DO BEGIN optionsselected := [ indentbytab, crafter ]; dindentsymbols := []; gobbleterminators := [] END; WITH ppoption [ recordsym ] DO BEGIN optionsselected := [ indentbytab, crafter ]; dindentsymbols := []; gobbleterminators := [] END; WITH ppoption [ casesym ] DO BEGIN optionsselected := [ spaceafter, indentbytab, gobblesymbols, crafter ]; dindentsymbols := []; gobbleterminators := [ ofsym ] END; WITH ppoption [ casevarsym ] DO BEGIN optionsselected := [ spaceafter, indentbytab, gobblesymbols, crafter ]; dindentsymbols := []; gobbleterminators := [ ofsym ] END; WITH ppoption [ ofsym ] DO BEGIN optionsselected := [ crsuppress, spacebefore ]; dindentsymbols := []; gobbleterminators := [] END; WITH ppoption [ forsym ] DO BEGIN optionsselected := [ spaceafter, indentbytab, gobblesymbols, crafter ]; dindentsymbols := []; gobbleterminators := [ dosym ] END; WITH ppoption [ whilesym ] DO BEGIN optionsselected := [ spaceafter, indentbytab, gobblesymbols, crafter ]; dindentsymbols := []; gobbleterminators := [ dosym ] END; WITH ppoption [ withsym ] DO BEGIN optionsselected := [ spaceafter, indentbytab, gobblesymbols, crafter ]; dindentsymbols := []; gobbleterminators := [ dosym ] END; WITH ppoption [ dosym ] DO BEGIN optionsselected := [ crsuppress, spacebefore ]; dindentsymbols := []; gobbleterminators := [] END; WITH ppoption [ ifsym ] DO BEGIN optionsselected := [ spaceafter, indentbytab, gobblesymbols, crafter ]; dindentsymbols := []; gobbleterminators := [ thensym ] END; WITH ppoption [ thensym ] DO BEGIN optionsselected := [ indentbytab, crafter ]; dindentsymbols := []; gobbleterminators := [] END; WITH ppoption [ elsesym ] DO BEGIN optionsselected := [ crbefore, dindentonkeys, dindent, indentbytab, crafter ]; dindentsymbols := [ ifsym, elsesym ]; gobbleterminators := [] END; WITH ppoption [ endsym ] DO BEGIN optionsselected := [ crbefore, dindentonkeys, dindent, crafter ]; dindentsymbols := [ ifsym, thensym, elsesym, forsym, whilesym, withsym, casevarsym, colon, equals ]; gobbleterminators := [] END; WITH ppoption [ untilsym ] DO BEGIN optionsselected := [ crbefore, dindentonkeys, dindent, spaceafter, gobblesymbols, crafter ]; dindentsymbols := [ ifsym, thensym, elsesym, forsym, whilesym, withsym, colon, equals ]; gobbleterminators := [ endsym, untilsym, elsesym, semicolon ]; END; WITH ppoption [ becomes ] DO BEGIN optionsselected := [ spacebefore, spaceafter, gobblesymbols ]; dindentsymbols := []; gobbleterminators := [ endsym, untilsym, elsesym, semicolon ] END; WITH ppoption [ opencomment ] DO BEGIN optionsselected := [ crsuppress ]; dindentsymbols := []; gobbleterminators := [] END; WITH ppoption [ closecomment ] DO BEGIN optionsselected := [ crsuppress ]; dindentsymbols := []; gobbleterminators := [] END; WITH ppoption [ semicolon ] DO BEGIN optionsselected := [ crsuppress, dindentonkeys, crafter ]; dindentsymbols := [ ifsym, thensym, elsesym, forsym, whilesym, withsym, colon, equals ]; gobbleterminators := [] END; WITH ppoption [ colon ] DO BEGIN optionsselected := [ spaceafter, indenttoclp ]; dindentsymbols := []; gobbleterminators := [] END; WITH ppoption [ equals ] DO BEGIN optionsselected := [ spacebefore, spaceafter, indenttoclp ]; dindentsymbols := []; gobbleterminators := [] END; WITH ppoption [ openparen ] DO BEGIN optionsselected := [ spacebefore, gobblesymbols]; dindentsymbols := []; gobbleterminators := [ closeparen ] END; WITH ppoption [ closeparen ] DO BEGIN optionsselected := []; dindentsymbols := []; gobbleterminators := [] END; WITH ppoption [ period ] DO BEGIN optionsselected := [crsuppress]; dindentsymbols := []; gobbleterminators := [] END; WITH ppoption [ endoffile ] DO BEGIN optionsselected := []; dindentsymbols := []; gobbleterminators := [] END; WITH ppoption [ othersym ] DO BEGIN optionsselected := []; dindentsymbols := []; gobbleterminators := [] END END; (* initialize *) FUNCTION stackempty (* returning *) : boolean; BEGIN (* stackempty *) IF top = 0 THEN stackempty := true ELSE stackempty := false END; (* stackempty *) FUNCTION stackfull (* returning *) : boolean; BEGIN (* stackfull *) IF top = maxstacksize THEN stackfull := true ELSE stackfull := false END; (* stackful *) PROCEDURE popstack ( (* returning *) VAR indentsymbol : keysymbol; VAR prevmargin : integer ); BEGIN (* popstack *) IF not stackempty THEN BEGIN indentsymbol := stack[top].indentsymbol; prevmargin := stack[top].prevmargin; top := top - 1 END ELSE BEGIN indentsymbol := othersym; prevmargin := 0 END END; (* popstack *) PROCEDURE pushstack ( (* using *) indentsymbol : keysymbol; prevmargin : integer ); BEGIN (* pushstack *) top := top + 1; stack[top].indentsymbol := indentsymbol; stack[top].prevmargin := prevmargin END; (* pushstack *) PROCEDURE writecrs ( (* using *) numberofcrs : integer; (* updating *) VAR currlinepos : integer; (* writing to *) VAR outputfile : text ); VAR i: integer; BEGIN (* writecrs *) IF numberofcrs > 0 THEN BEGIN FOR i := 1 to numberofcrs DO writeln (outputfile); currlinepos := 0 END END; (* writecrs *) PROCEDURE insertcr ( (* updating *) VAR currsym : symbolinfo; (* writing to *) VAR outputfile : text ); CONST once = 1; BEGIN (* insertcr *) IF currsym^.crsbefore = 0 THEN BEGIN writecrs ( once, (* updating *) currlinepos, (* writing to *) outputfile ); currsym^. spacesbefore := 0 END END; (* insertcr *) PROCEDURE insertblankline ( (* updating *) VAR currsym : symbolinfo; (* writing to *) VAR outputfile : text ); CONST once = 1; twice = 2; BEGIN (* insertblankline *) IF currsym^.crsbefore = 0 THEN BEGIN IF currlinepos = 0 THEN writecrs ( once, (* updating *) currlinepos, (* writing to *) outputfile ) ELSE writecrs ( twice, (* updating *) currlinepos, (* writing to *) outputfile ); currsym^.spacesbefore := 0 END ELSE IF currsym^.crsbefore = 1 THEN IF currlinepos > 0 THEN writecrs ( once, (* updating *) currlinepos, (* writing to *) outputfile ) END; (* insertblankline *) PROCEDURE lshifton ( (* using *) dindentsymbols : keysymset ); VAR indentsymbol : keysymbol; prevmargin : integer; BEGIN (* lshifton *) IF not stackempty THEN BEGIN REPEAT popstack ( (* returning *) indentsymbol, prevmargin ); IF indentsymbol in dindentsymbols THEN currmargin := prevmargin UNTIL not(indentsymbol in dindentsymbols) or (stackempty); IF not(indentsymbol in dindentsymbols) THEN pushstack ( (* using *) indentsymbol, prevmargin ) END END; (* lshifton *) PROCEDURE lshift; VAR indentsymbol: keysymbol; prevmargin : integer; BEGIN (* lshift *) IF not stackempty THEN BEGIN popstack ( (* returning *) indentsymbol, prevmargin ); currmargin := prevmargin END END; (* lshift *) PROCEDURE insertspace ( (* using *) VAR symbol : symbolinfo; (* writing to *) VAR outputfile : text ); BEGIN (* insertspace *) IF currlinepos < maxlinesize THEN BEGIN write (outputfile, space); currlinepos := currlinepos + 1; WITH symbol ^ DO IF (crsbefore = 0) and (spacesbefore > 0) THEN spacesbefore := spacesbefore - 1 END END; (* insertspace *) PROCEDURE movelinepos ( (* to *) newlinepos : integer; (* from *) VAR currlinepos: integer; (* in *) VAR outputfile : text ); VAR i: integer; BEGIN (* movelinepos *) FOR i := currlinepos+1 to newlinepos DO write (outputfile, space); currlinepos := newlinepos END; (* movelinepos *) PROCEDURE printsymbol ( (* in *) currsym : symbolinfo; (* updating *) VAR currlinepos : integer; (* writing to *) VAR outputfile : text ); VAR i: integer; BEGIN (* printsymbol *) WITH currsym^ DO BEGIN IF name<=untilsym THEN FOR i:= 1 to length DO write (outputfile,upcase(value[i])) ELSE FOR i := 1 to length DO write (outputfile, value[i]); currlinepos := currlinepos + length END (* with *) END; (* printsymbol *) PROCEDURE ppsymbol ( (* in *) currsym : symbolinfo; (* writing to *) VAR outputfile : text ); CONST once = 1; VAR newlinepos: integer; BEGIN (* ppsymbol *) WITH currsym^ DO BEGIN writecrs ( (* using *) crsbefore, (* updating *) currlinepos, (* writing to *) outputfile ); IF (currlinepos + spacesbefore > currmargin) or (name in [ opencomment, closecomment ]) THEN newlinepos := currlinepos + spacesbefore ELSE newlinepos := currmargin; IF newlinepos + length > maxlinesize THEN BEGIN writecrs ( once, (* updating *) currlinepos, (* writing to *) outputfile ); IF currmargin + length <= maxlinesize THEN newlinepos := currmargin ELSE IF length < maxlinesize THEN newlinepos := maxlinesize - length ELSE newlinepos := 0 END; movelinepos ( (* to *) newlinepos, (* from *) currlinepos, (* in *) outputfile ); printsymbol ( (* in *) currsym, (* updating *) currlinepos, (* writing to *) outputfile ) END (* with *) END; (* ppsymbol *) PROCEDURE rshifttoclp ( (* using *) currsym : keysymbol ); forward; PROCEDURE gobble ( (* symbols from *) VAR inputfile : text; (* up to *) terminators : keysymset; (* updating *) VAR currsym, nextsym : symbolinfo; (* writing to *) VAR outputfile : text ); BEGIN (* gobble *) rshifttoclp ( (* using *) currsym^.name); WHILE not(nextsym^.name in (terminators + [endoffile])) DO BEGIN getsymbol ( (* from *) inputfile, (* updating *) nextsym, (* returning *) currsym ); ppsymbol ( (* in *) currsym, (* writing to *) outputfile ) END; (* while *) lshift END; (* gobble *) PROCEDURE rshift ( (* using *) currsym : keysymbol ); BEGIN (* rshift *) IF not stackfull THEN pushstack ( (* using *) currsym, currmargin); IF currmargin < slowfail1 THEN currmargin := currmargin + indent1 ELSE IF currmargin < slowfail2 THEN currmargin := currmargin + indent2 END; (* rshift *) PROCEDURE rshifttoclp; BEGIN (* rshifttoclp *) IF not stackfull THEN pushstack ( (* using *) currsym, currmargin ); currmargin := currlinepos END; (* rshifttoclp *) BEGIN (* prettyprint *) initialize ( inputfile, outputfile, top, currlinepos, currmargin, keyword, dblchars, dblchar, sglchar, recordseen, currchar, nextchar, currsym, nextsym, ppoption, crpending); WHILE (nextsym^.name <> endoffile ) DO BEGIN getsymbol ( (* from *) inputfile, (* updating *) nextsym, (* returning *) currsym ); WITH ppoption [currsym^. name] DO BEGIN IF (crpending and not(crsuppress in optionsselected)) or (crbefore in optionsselected) THEN BEGIN insertcr ( (* using *) currsym, (* writing to *) outputfile ); crpending := false END; IF blanklinebefore in optionsselected THEN BEGIN insertblankline ( (* using *) currsym, (* writing to *) outputfile ); crpending := false END; IF dindentonkeys in optionsselected THEN lshifton (dindentsymbols); IF dindent in optionsselected THEN lshift; IF spacebefore in optionsselected THEN insertspace ( (* using *) currsym, (* writing *) outputfile ); ppsymbol ( (* in *) currsym, (* writing to *) outputfile ); IF spaceafter in optionsselected THEN insertspace ( (* using *) nextsym, (* writing *) outputfile ); IF indentbytab in optionsselected THEN rshift ( (* using *) currsym^.name ); IF indenttoclp in optionsselected THEN rshifttoclp ( (* using *) currsym^. name ); IF gobblesymbols in optionsselected THEN gobble ( (* symbols from *) inputfile, (* up to *) gobbleterminators, (* updating *) currsym, nextsym, (* writing to *) outputfile); IF crafter in optionsselected THEN crpending := true END (* with *) END; (* while *) IF crpending THEN writeln (outputfile) END.