(*======================================================================*) (* *) (* 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. *) (* *) (* AN 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 PRETTYPRINTER. *) (* *) (* 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. *) (* *) (* OUTPUT - STANDARD PASCAL FILE FOR RUNTIME *) (* MESSAGES. *) (* *) (* *) (*======================================================================*) (*======================================================================*) (* *) (* PASCAL PRETTYPRINTING RULES *) (* *) (* *) (* [ GENERAL PRETTYPRINTING RULES ] *) (* *) (* 1. ANY SPACES OR BLANK LINES BEYOND THOSE GENERATED BY THE *) (* PRETTYPRINTER ARE LEFT ALONE. 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 120 CHARACTERS LONG. ANY LINE *) (* LONGER THAN THIS IS CONTINUED ON A SEPARATE LINE. *) (* *) (* 4. THE KEYWORDS "BEGIN", "END", "REPEAT", AND "RECORD" ARE *) (* FORCED TO STAND ON LINES BY THEMSELVES (OR POSSIBLY FOLLOWED BY *) (* SUPPORTING COMMENTS). *) (* IN ADDITION, THE "UNTIL" CLAUSE OF A "REPEAT-UNTIL" STATE- *) (* MENT IS FORCED TO START ON A NEW LINE. *) (* *) (* 5. A BLANK LINE IS FORCED BEFORE THE KEYWORDS "PROGRAM", *) (* "PROCEDURE", "FUNCTION", "LABEL", "CONST", "TYPE", AND "VAR". *) (* *) (* 6. A SPACE IS FORCED BEFORE AND AFTER THE SYMBOLS ":=" AND *) (* "=". ADDITIONALLY, A SPACE IS FORCED AFTER THE SYMBOL ":". *) (* NOTE THAT ONLY "="S IN DECLARATIONS ARE FORMATTED. "="S IN *) (* EXPRESSIONS ARE IGNORED. *) (* *) (* *) (* [ INDENTATION RULES ] *) (* *) (* 1. THE BODIES OF "LABEL", "CONST", "TYPE", AND "VAR" DECLARA- *) (* TIONS ARE INDENTED FROM THEIR CORRESPONDING DECLARATION HEADER *) (* KEYWORDS. *) (* *) (* 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 < EXPRESSION > *) (* THEN *) (* < STATEMENT > *) (* ELSE *) (* < STATEMENT > *) (* *) (* *) (*======================================================================*) (*======================================================================*) (* *) (* 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 TO 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-INDENT- *) (* ING 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 ALREADY 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{,} (* USING *) { OUTPUT }); { output file not used [sam] } 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 = 72; (* THE MAXIMUM SIZE (IN CHARACTERS) OF A *) (* LINE OUTPUT BY THE PRETTYPRINTER. *) SLOFAIL1 = 30; (* UP TO THIS COLUMN POSITION, EACH TIME *) (* "INDENTBYTAB" IS INVOKED, THE MARGIN *) (* WILL BE INDENTED BY "INDENT1". *) SLOFAIL2 = 48; (* UP TO THIS COLUMN POSITION, EACH TIME *) (* "INDENTBYTAB" IS INVOKED, THE MARGIN *) (* WILL BE INDENTED BY "INDENT2". BEYOND *) (* THIS, NO INDENTATION OCCURS. *) 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; 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 NAME := ENDOFLINE ELSE IF INPUTFILE^ IN ['A'..'Z','a'..'z'] { added lower case [sam] } 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 GETCHAR( (* FROM *) INPUTFILE, (* UPDATING *) NEXTCHAR, (* RETURNING *) CURRCHAR ); IF LENGTH < MAXSYMBOLSIZE THEN BEGIN LENGTH := LENGTH + 1; VALUE[LENGTH] := CURRCHAR.VALUE END END; PROCEDURE SKIPSPACES ( (* IN *) VAR INPUTFILE : TEXT; (* UPDATING *) VAR CURRCHAR, NEXTCHAR : CHARINFO; (* RETURNING *) VAR SPACESBEFORE, CRSBEFORE : INTEGER ); BEGIN CRSBEFORE := 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 END END; PROCEDURE GETCOMMENT( (* FROM *) VAR INPUTFILE : TEXT; (* UPDATING *) VAR CURRCHAR, NEXTCHAR : CHARINFO; VAR NAME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER ); BEGIN 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, (* IN *) VALUE ); NAME := CLOSECOMMENT; END END; FUNCTION IDTYPE( (* OF *) VALUE : STRING; (* USING *) LENGTH : INTEGER ) (* RETURNING *) : KEYSYMBOL; VAR I: INTEGER; KEYVALUE: KEY; HIT: BOOLEAN; THISKEY: KEYSYMBOL; BEGIN IDTYPE := OTHERSYM; IF LENGTH <= MAXKEYLENGTH THEN BEGIN FOR I := 1 TO LENGTH DO KEYVALUE [I] := VALUE [I]; FOR I := LENGTH+1 TO MAXKEYLENGTH DO KEYVALUE [I] := SPACE; THISKEY := PROGSYM; HIT := FALSE; WHILE NOT (HIT OR (PRED(THISKEY) = UNTILSYM)) DO IF KEYVALUE = KEYWORD [THISKEY] THEN HIT := TRUE ELSE THISKEY := SUCC(THISKEY); IF HIT THEN IDTYPE := THISKEY END; END; PROCEDURE GETIDENTIFIER( (* FROM *) VAR INPUTFILE : TEXT; (* UPDATING *) VAR CURRCHAR, NEXTCHAR : CHARINFO; (* RETURNING *) VAR NAME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER ); BEGIN 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 END; PROCEDURE GETNUMBER( (* FROM *) VAR INPUTFILE : TEXT; (* UPDATING *) VAR CURRCHAR, NEXTCHAR : CHARINFO; (* RETURNING *) VAR NAME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER ); BEGIN WHILE NEXTCHAR.NAME = DIGIT DO STORENEXTCHAR( (* FROM *) INPUTFILE, (* UPDATING *) LENGTH, CURRCHAR, NEXTCHAR, (* IN *) VALUE ); NAME := OTHERSYM END; PROCEDURE GETCHARLITERAL( (* FROM *) VAR INPUTFILE : TEXT; (* UPDATING *) VAR CURRCHAR, NEXTCHAR : CHARINFO; (* RETURNING *) VAR NAME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER ); BEGIN 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; FUNCTION CHARTYPE( (* OF *) CURRCHAR, NEXTCHAR : CHARINFO ) (* RETURNING *) : KEYSYMBOL; VAR NEXTTWOCHARS : SPECIALCHAR; HIT : BOOLEAN; THISCHAR : KEYSYMBOL; BEGIN 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; PROCEDURE GETSPECIALCHAR( (* FROM *) VAR INPUTFILE : TEXT; (* UPDATING *) VAR CURRCHAR, NEXTCHAR : CHARINFO; (* RETURNING *) VAR NAME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER ); BEGIN 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; PROCEDURE GETNEXTSYMBOL( (* FROM *) VAR INPUTFILE : TEXT; (* UPDATING *) VAR CURRCHAR, NEXTCHAR : CHARINFO; (* RETURNING *) VAR NAME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER ); BEGIN 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 END; PROCEDURE GETSYMBOL ( (* FROM *) VAR INPUTFILE : TEXT; (* UPDATING *) VAR NEXTSYM : SYMBOLINFO; (* RETURNING *) VAR CURRSYM : SYMBOLINFO ); VAR DUMMY: SYMBOLINFO; BEGIN 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; END; PROCEDURE INITIALISE( (* 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 ); BEGIN RESET(INPUTFILE); REWRITE(OUTPUTFILE); TOPOFSTACK := 0; CURRLINEPOS := 0; CURRMARGIN := 0; 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 := [ BLANKLINEBEFORE, 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 := [ BLANKLINEBEFORE, SPACEAFTER, INDENTTOCLP ]; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [] END; WITH PPOPTION [ CONSTSYM ] DO BEGIN OPTIONSSELECTED := [ BLANKLINEBEFORE, DINDENTONKEYS, SPACEAFTER, INDENTTOCLP ]; DINDENTSYMBOLS := [ LABELSYM ]; GOBBLETERMINATORS := [] END; WITH PPOPTION [ TYPESYM ] DO BEGIN OPTIONSSELECTED := [ BLANKLINEBEFORE, DINDENTONKEYS, SPACEAFTER, INDENTTOCLP ]; DINDENTSYMBOLS := [ LABELSYM, CONSTSYM ]; GOBBLETERMINATORS := [] END; WITH PPOPTION [ VARSYM ] DO BEGIN OPTIONSSELECTED := [ BLANKLINEBEFORE, DINDENTONKEYS, SPACEAFTER, INDENTTOCLP ]; 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 := [ 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; FUNCTION STACKEMPTY (* RETURNING *) : BOOLEAN; BEGIN IF TOP = 0 THEN STACKEMPTY := TRUE ELSE STACKEMPTY := FALSE END; FUNCTION STACKFULL (* RETURNING *) : BOOLEAN; BEGIN IF TOP = MAXSTACKSIZE THEN STACKFULL := TRUE ELSE STACKFULL := FALSE END; PROCEDURE POPSTACK( (* RETURNING *) VAR INDENTSYMBOL : KEYSYMBOL; VAR PREVMARGIN : INTEGER); BEGIN 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; PROCEDURE PUSHSTACK( (* USING *) INDENTSYMBOL : KEYSYMBOL; PREVMARGIN : INTEGER ); BEGIN TOP := TOP + 1; STACK[TOP].INDENTSYMBOL := INDENTSYMBOL; STACK[TOP].PREVMARGIN := PREVMARGIN; END; PROCEDURE WRITECRS( (* USING *) NUMBEROFCRS : INTEGER; (* UPDATING *) VAR CURRLINEPOS : INTEGER; (* WRITING TO *) VAR OUTPUTFILE : TEXT ); VAR I: INTEGER; BEGIN IF NUMBEROFCRS > 0 THEN BEGIN FOR I := 1 TO NUMBEROFCRS DO WRITELN(OUTPUTFILE); CURRLINEPOS := 0 END END; PROCEDURE INSERTCR( (* UPDATING *) VAR CURRSYM : SYMBOLINFO; (* WRITING TO *) VAR OUTPUTFILE : TEXT ); CONST ONCE = 1; BEGIN IF CURRSYM^.CRSBEFORE = 0 THEN BEGIN WRITECRS( ONCE, (* UPDATING *) CURRLINEPOS, (* WRITING TO *) OUTPUTFILE ); CURRSYM^.SPACESBEFORE := 0 END END; PROCEDURE INSERTBLANKLINE( (* UPDATING *) VAR CURRSYM : SYMBOLINFO; (* WRITING TO *) VAR OUTPUTFILE : TEXT ); CONST ONCE = 1; TWICE = 2; BEGIN 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; PROCEDURE LSHIFTON( (* USING *) DINDENTSYMBOLS : KEYSYMSET ); VAR INDENTSYMBOL : KEYSYMBOL; PREVMARGIN : INTEGER; BEGIN 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; PROCEDURE LSHIFT; VAR INDENTSYMBOL : KEYSYMBOL; PREVMARGIN : INTEGER; BEGIN IF NOT STACKEMPTY THEN BEGIN POPSTACK( (* RETURNING *) INDENTSYMBOL, PREVMARGIN ); CURRMARGIN := PREVMARGIN END END; PROCEDURE INSERTSPACE( (* USING *) VAR SYMBOL : SYMBOLINFO; (* WRITING TO *) VAR OUTPUTFILE : TEXT ); BEGIN 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; PROCEDURE MOVELINEPOS( (* TO *) NEWLINEPOS : INTEGER; (* FROM *) VAR CURRLINEPOS : INTEGER; (* WRITING TO *) VAR OUTPUTFILE : TEXT ); VAR I: INTEGER; BEGIN FOR I := CURRLINEPOS+1 TO NEWLINEPOS DO WRITE(OUTPUTFILE, SPACE); CURRLINEPOS := NEWLINEPOS END; PROCEDURE PRINTSYMBOL( (* IN *) CURRSYM : SYMBOLINFO; (* UPDATING *) VAR CURRLINEPOS : INTEGER; (* WRITING TO *) VAR OUTPUTFILE : TEXT ); VAR I: INTEGER; BEGIN WITH CURRSYM^ DO BEGIN FOR I := 1 TO LENGTH DO WRITE(OUTPUTFILE, VALUE[I]); CURRLINEPOS := CURRLINEPOS + LENGTH END END; PROCEDURE PPSYMBOL( (* IN *) CURRSYM : SYMBOLINFO; (* WRITING TO *) VAR OUTPUTFILE : TEXT ); CONST ONCE = 1; VAR NEWLINEPOS : INTEGER; BEGIN 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 END; 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 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; LSHIFT END; PROCEDURE RSHIFT( (* USING *) CURRSYM : KEYSYMBOL ); BEGIN IF NOT STACKFULL THEN PUSHSTACK( (* USING *) CURRSYM, CURRMARGIN ); IF CURRMARGIN < SLOFAIL1 THEN CURRMARGIN := CURRMARGIN + INDENT1 ELSE IF CURRMARGIN < SLOFAIL2 THEN CURRMARGIN := CURRMARGIN + INDENT2 END; PROCEDURE RSHIFTTOCLP; BEGIN IF NOT STACKFULL THEN PUSHSTACK( (* USING *) CURRSYM, CURRMARGIN); CURRMARGIN := CURRLINEPOS; END; BEGIN INITIALISE( INPUTFILE, OUTPUTFILE, TOP, CURRLINEPOS, CURRMARGIN, KEYWORD , DBLCHARS, DBLCHAR, SGLCHAR , RECORDSEEN , CURRCHAR, NEXTCHAR, CURRSYM , NEXTSYM , PPOPTION ); CRPENDING := FALSE; 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 TO *) OUTPUTFILE ); PPSYMBOL( (* IN *) CURRSYM, (* WRITING TO *) OUTPUTFILE ); IF SPACEAFTER IN OPTIONSSELECTED THEN INSERTSPACE( (* USING *) NEXTSYM, (* WRITING TO *) 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; END; IF CRPENDING THEN WRITELN(OUTPUTFILE); END.