perm filename PRETTY.PAS[PAS,SYS] blob
sn#459961 filedate 1979-07-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (*$O-,I-,C-,D-*)
C00102 ENDMK
C⊗;
(*$O-,I-,C-,D-*)
(*====================================================================*)
(* *)
(* 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 *)
(* John Gorman.) *)
(* Modified: Paul N. Hilfinger *)
(* Michael E. Fryd *)
(* *)
(* 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 files: OutputFile - The PrettyPrinted program. *)
(* *)
(* TempFile - Working file for undenting. *)
(* *)
(* *)
(*====================================================================*)
(*====================================================================*)
(* *)
(* 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 preceding text on a line. *)
(* *)
(* 2. All declarations and all "FOR", "WHILE", "WITH", and "LOOP" *)
(* statements begin on separate lines. *)
(* *)
(* 3. No line may be greater than 128 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 follwed 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 ":". *)
(* *)
(* *)
(* [ 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> *)
(* however, none of the line breaks illustrated is required. *)
(* *)
(* 4. A sequence of "IF-THEN-ELSE IF-THEN-ELSE IF..." is indented *)
(* *)
(* IF <expression> *)
(* THEN *)
(* <statement> *)
(* ELSE IF <expression> *)
(* THEN *)
(* . . . *)
(* ELSE *)
(* <statement> *)
(* *)
(* each "ELSE IF" appears on a new line. The "ELSE" and the "IF" *)
(* should appear on the same line in the input source text. *)
(* *)
(* 5. A sequence of "IF-THEN " is indented *)
(* *)
(* IF <expression> *)
(* THEN IF <expression> ... *)
(* THEN *)
(* <statement> .... *)
(* *)
(* each "THEN IF" appears on a new line. The "THEN" and the "IF" *)
(* should appear on the same line in the source text. *)
(* *)
(*====================================================================*)
(*====================================================================*)
(* *)
(* 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-inden- *)
(* ting 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). *)
(* *)
(* Capitalize - The word is capitalized. This option only *)
(* valid if the user requested it. *)
(* *)
(* *)
(* [ 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 (except for capital- *)
(* zation) 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 *) Input,
(* to *) OutputFile ,
(* using *) TempFile );
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 = 128; (* the maximum size (in characters) of a *)
(* line output by the PrettyPrinter. *)
SlowFail1 = 30; (* up to this column position, each time *)
(* "IndentByTab" is invoked, the margin *)
(* will be Indented by "Indent1". *)
SlowFail2 = 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 = ' ';
TabSize = 8;
InitLineNumber = 00100;
LastByteIndex = 5;
CRchr = 15B;
LFchr = 12B;
NULLchr = 0B;
FFchr = 14B;
TABchr = 11B;
MaxLine = 99999;
TYPE
KeySymbol = ( ProgSym, FuncSym, ProcSym,
LabelSym, ConstSym, TypeSym, VarSym,
BeginSym, RepeatSym, RecordSym,
CaseSym, CaseVarSym, OfSym,
ForSym, WhileSym, WithSym, DoSym,
LoopSym, ExitSym,
IfSym, ThenSym, ElseSym,
EndSym,
AndSym, ArraySym, DivSym,
DownToSym, FileSym, GotoSym,
InSym, ModSym, NilSym,
FalseSym, TrueSym, MaxIntSym,
ToSym, PascalSym, SetSym,
PackedSym, AlgolSym, ForwardSym,
FortranSym, ExternSym, CobolSym,
OrSym, NotSym, ExitLoopSym,
NextLoopSym, UntilSym,
ElIfSym, ThIfSym,
Becomes, OpenComment, CloseComment,
SemiColon, Colon, Equals,
OpenParen, CloseParen, Period,
EndofFile,
OtherSym );
Option = ( CrSuppress,
CrBefore,
BlankLineBefore,
DIndentOnKeys,
DIndent,
SpaceBefore,
Capitalize,
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;
DblCharTable = ARRAY [ Becomes..OpenComment ] OF SpecialChar;
SglCharTable = ARRAY [ OpenComment..Period ] OF Char;
FoldTable = ARRAY [ Char ] 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, PageMark,
EndOfLIne, Filemark, OtherChar );
CharTypeTable = ARRAY [ Char ] OF CharName;
CharInfo = RECORD
Name : CharName;
Value: Char
END;
StackEntry = RECORD
IndentSymbol: KeySymbol;
PrevMargin : Integer
END;
SymbolStack = ARRAY [ 1..MaxStackSize ] OF StackEntry;
TextBlock =
RECORD (* Machine Dependent *)
CASE boolean OF
TRUE: (Text: PACKED ARRAY [1..LastByteIndex] OF char);
FALSE: (IntForm: integer)
END;
TextFile = FILE OF TextBlock;
LineNumber = PACKED ARRAY [1..5] OF char;
NTextStruct = RECORD
Pntr: Integer;
Buff: ARRAY [1..LastByteIndex] OF char;
AtStart, Numbering: boolean;
CurrNumber, Increment: integer
END;
NText = ↑NTextStruct;
VAR
Tab, FF: Char; (* actually constants *)
TempFile: Text;
OutputFile: NText;
RecordSeen: Boolean;
CurrChar,
NextChar: CharInfo;
CurrSym,
NextSym: SymbolInfo;
CrPending: Boolean;
PPOption: OptionTable;
KeyWord: KeyWordTable;
FoldedChar: FoldTable;
CharType: CharTypeTable;
DblChar: DblCharTable;
SglChar: SglCharTable;
Stack: SymbolStack;
Top : Integer;
CurrLinePos,
CurrMargin : Integer;
Resp : Char;
WeAreCapitalizing : Boolean;
AreNumbering: Boolean;
DeleteTemp: Boolean;
L : LineNumber;
Out: TextFile;
OutP: NText;
FUNCTION eop(VAR InputFile: Text): Boolean;
(* True iff InputFile at page mark. (But currently works only
if InputFile is Input.) *)
VAR L: LineNumber;
BEGIN
GetLineNR(L);
eop := (L=' ')
END; (* eop *)
PROCEDURE Error(n: integer);
BEGIN
Writeln(tty);
CASE n OF
1: Writeln(tty,'? Only one NText file may be open at a time.')
END;
halt;
END;
PROCEDURE NDREWRITE(VAR OutFile: NText);
BEGIN
DREWRITE(Out);
new(OutP); OutFile := OutP;
WITH OutFile↑ DO
BEGIN
Pntr := 1; AtStart := TRUE; Numbering := FALSE
END;
END; (* NDREWRITE *)
PROCEDURE WNumber(Outfile: NText; n: integer); FORWARD;
PROCEDURE NPage(OutFile: NText); FORWARD;
PROCEDURE NWrite(OutFile: NText; c: char);
VAR OutRec: TextBlock;
BEGIN
IF OutFile<>OutP THEN ERROR(1);
WITH OutFile↑ DO
BEGIN
IF AtStart AND Numbering THEN
BEGIN
IF CurrNumber>MaxLine THEN NPage(OutFile);
WNumber(OutFile,CurrNumber);
CurrNumber := CurrNumber+Increment;
END;
Buff[Pntr] := c;
AtStart := FALSE;
IF Pntr>=LastByteIndex THEN
BEGIN
Pntr := 1;
OutRec.IntForm := 0;
pack(Buff,1,OutRec.Text,5);
Out↑ := OutRec; Put(Out);
END
ELSE Pntr := Pntr+1
END
END; (* NWrite *)
PROCEDURE NWrteln(OutFile: NText);
VAR i: integer;
BEGIN
NWrite(OutFile,chr(CRchr)); NWrite(OutFile,chr(LFchr));
WITH OutFile↑ DO
BEGIN
IF (Pntr>1) AND Numbering
THEN
FOR i := Pntr TO LastByteIndex DO NWrite(OutFile,chr(Nullchr));
AtStart := TRUE;
END
END; (* NWrteln *)
PROCEDURE WNumber;
VAR OutRec: TextBlock;
i: integer;
BEGIN
IF Outp<>OutFile THEN ERROR(1);
WITH OutFile↑ DO
BEGIN
FOR i := LastByteIndex DOWNTO 1 DO
BEGIN
Buff[i] := chr(n MOD 10 + ord('0')); n := n DIV 10
END;
OutRec.IntForm := 0;
pack(Buff,1,OutRec.Text,5);
OutRec.IntForm := OutRec.IntForm+1;
Out↑ := OutRec; Put(Out);
Pntr := 2; Buff[1] := chr(TABchr);
END
END; (* WNumber *)
PROCEDURE NPage;
VAR
OutRec: TextBlock;
j: Integer;
BEGIN
IF OutFile<>Outp THEN ERROR(1);
WITH Outfile↑ DO
BEGIN
IF NOT AtStart THEN NWrteln(OutFile);
OutRec.IntForm := 0; OutRec.Text := ' ';
IF Numbering THEN
BEGIN
OutRec.IntForm := OutRec.IntForm+1;
Out↑ := OutRec; Put(Out);
END;
AtStart := FALSE;
NWrite(OutFile,chr(CRchr)); NWrite(OutFile,chr(FFchr));
IF Numbering THEN
FOR j := 1 TO 3 DO NWrite(OutFile,chr(NULLchr));
AtStart := TRUE;
IF Numbering THEN CurrNumber := Increment;
END
END; (* NPage *)
PROCEDURE NSetLine(OutFile: NText; St,Incr: Integer);
BEGIN
WITH OutFile↑ DO
BEGIN
Numbering := TRUE; CurrNumber := St; Increment := Incr
END
END; (* NSetLine *)
PROCEDURE NClose(VAR OutFile: NText);
VAR j: Integer;
BEGIN
WITH OutFile↑ DO
IF Pntr>1 THEN
FOR j := Pntr TO LastByteIndex DO NWrite(OutFile,chr(NULLchr));
OutFile := NIL; Close(Out)
END; (* NClose *)
PROCEDURE GetChar( (* from *) VAR InputFile : Text;
(* updating *) VAR NextChar : CharInfo;
(* returning *) VAR CurrChar : CharInfo );
BEGIN (* GetChar *)
CurrChar := NextChar;
WITH NextChar DO
BEGIN
Value := Space;
IF EOF(InputFile)
THEN
Name := FileMark
ELSE IF EOLn(InputFile)
THEN
BEGIN
IF eop(InputFile)
THEN
BEGIN
Name := PageMark; Value := FF
END
ELSE Name := EndOfLine;
ReadLn(InputFile)
END
ELSE
BEGIN
Read(InputFile,Value); Name := CharType [ Value ];
END;
END (* With *)
END; (* GetChar *)
PROCEDURE StoreNextChar( (* from *) VAR InputFile : Text;
(* updating *) VAR Length : Integer;
(* and *) 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,
(* and *) NextChar : CharInfo;
(* returning *) VAR SpacesBefore,
(* and *) CrsBefore : Integer );
BEGIN (* SkipSpaces *)
SpacesBefore := 0;
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 (* Case *)
END (* While *)
END; (* SkipSpaces *)
PROCEDURE GetComment( (* from *) VAR InputFile : Text;
(* updating *) VAR CurrChar,
(* and *) NextChar : CharInfo;
VAR Name : KeySymbol;
VAR Value : String;
VAR Length : Integer );
BEGIN (* GetComment *)
Name := OpenComment;
WHILE NOT( ((CurrChar.Value = '*') AND (NextChar.Value = ')'))
OR (CurrChar.Value = '}')
OR (CurrChar.Name = PageMark)
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
ELSE IF (CurrChar.Value = '}') OR (CurrChar.Name = PageMark)
THEN
Name := CloseComment
END; (* GetComment *)
FUNCTION IdType( (* of *) Value : String;
(* using *) Length : Integer )
(* returning *) : KeySymbol;
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] := FoldedChar [ Value [I] ];
FOR I := Length+1 TO MaxKeyLength DO
KeyValue [I] := Space;
ThisKey := ProgSym;
Hit := FALSE;
REPEAT
IF KeyValue = KeyWord [ThisKey]
THEN
Hit := TRUE
ELSE
ThisKey := Succ(ThisKey)
UNTIL Hit OR (ThisKey = Succ(UntilSym));
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 *)
PROCEDURE GetSpecialChar( (* from *) VAR InputFile : Text;
(* updating *) VAR CurrChar,
NextChar : CharInfo;
(* returning *) VAR Name : KeySymbol;
VAR Value : String;
VAR Length : Integer );
VAR
NextTwoChars: SpecialChar;
Hit: Boolean;
ThisChar: KeySymbol;
BEGIN (* GetSpecialChar *)
StoreNextChar( (* from *) InputFile,
(* updating *) Length,
CurrChar,
NextChar,
(* in *) Value );
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 := OpenComment;
WHILE NOT(Hit OR (Pred(ThisChar) = Period)) DO
IF CurrChar.Value = SglChar [ThisChar]
THEN
Hit := TRUE
ELSE
ThisChar := Succ(ThisChar)
END
ELSE
StoreNextChar( (* from *) InputFile,
(* updating *) Length,
CurrChar,
NextChar,
(* in *) Value );
IF Hit
THEN
Name := ThisChar
ELSE
Name := OtherSym
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;
PageMark :
BEGIN
Name := CloseComment;
StoreNextChar( (* from *) InputFile,
(* updating *) Length, CurrChar, NextChar,
(* in *) Value )
END;
END (* Case *)
END; (* GetNextSymbol *)
PROCEDURE CheckComb( (* updating *) VAR CurrSym : SymbolInfo;
(* using *) NextSym : SymbolInfo );
BEGIN (* CheckComb *)
IF (CurrSym↑.Name = ElseSym) AND (NextSym↑.Name = IfSym)
THEN
CurrSym↑.Name := ElIfSym
ELSE IF (CurrSym↑.Name = ThenSym) AND (NextSym↑.Name = IfSym)
THEN
CurrSym↑.Name := ThIfSym
END; (* CheckComb *)
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 *)
CheckComb( (* updating *) CurrSym,
(* using *) NextSym );
END; (* GetSymbol *)
PROCEDURE Initialize( (* returning *)
VAR InputFile : Text;
VAR OutputFile : NText;
VAR TopOfStack : Integer;
VAR CurrLinePos,
CurrMargin : Integer;
VAR KeyWord : KeyWordTable;
VAR FoldedChar : FoldTable;
VAR CharType : CharTypeTable;
VAR DblChar : DblCharTable;
VAR SglChar : SglCharTable;
VAR RecordSeen : Boolean;
VAR CurrChar,
NextChar : CharInfo;
VAR CurrSym,
NextSym : SymbolInfo;
VAR PPOption : OptionTable );
CONST
FirstChr = 0;
LastChr = 127;
VAR
Lc, C : Char;
BEGIN (* Initialize *)
Tab := Chr(11B); FF := Chr(14B); (* actually constants *)
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 [ LoopSym ] := 'LOOP ' ;
KeyWord [ ExitSym ] := 'EXIT ' ;
KeyWord [ IfSym ] := 'IF ' ;
KeyWord [ ThenSym ] := 'THEN ' ;
KeyWord [ ElseSym ] := 'ELSE ' ;
KeyWord [ EndSym ] := 'END ' ;
KeyWord [ AndSym ] := 'AND ' ;
KeyWord [ ArraySym ] := 'ARRAY ' ;
KeyWord [ DivSym ] := 'DIV ' ;
KeyWord [ DownToSym ] := 'DOWNTO ' ;
KeyWord [ FileSym ] := 'FILE ' ;
KeyWord [ GotoSym ] := 'GOTO ' ;
KeyWord [ InSym ] := 'IN ' ;
KeyWord [ ModSym ] := 'MOD ' ;
KeyWord [ NilSym ] := 'NIL ' ;
KeyWord [ FalseSym ] := 'FALSE ' ;
KeyWord [ TrueSym ] := 'TRUE ' ;
KeyWord [ MaxIntSym ] := 'MAXINT ' ;
KeyWord [ ToSym ] := 'TO ' ;
KeyWord [ PascalSym ] := 'PASCAL ' ;
KeyWord [ SetSym ] := 'SET ' ;
KeyWord [ PackedSym ] := 'PACKED ' ;
KeyWord [ AlgolSym ] := 'ALGOL ' ;
KeyWord [ ForwardSym ] := 'FORWARD ' ;
KeyWord [ FortranSym ] := 'FORTRAN ' ;
KeyWord [ ExternSym ] := 'EXTERN ' ;
KeyWord [ CobolSym ] := 'COBOL ' ;
KeyWord [ OrSym ] := 'OR ' ;
KeyWord [ NotSym ] := 'NOT ' ;
KeyWord [ ExitLoopSym] := 'EXITLOOP ' ;
KeyWord [ NextLoopSym] := 'NEXTLOOP ' ;
KeyWord [ UntilSym ] := 'UNTIL ' ;
DblChar [ Becomes ] := ':=' ;
DblChar [ OpenComment ] := '(*' ;
SglChar [ OpenComment ] := '{' ;
SglChar [ CloseComment] := '}' ;
SglChar [ SemiColon ] := ';' ;
SglChar [ Colon ] := ':' ;
SglChar [ Equals ] := '=' ;
SglChar [ OpenParen ] := '(' ;
SglChar [ CloseParen ] := ')' ;
SglChar [ Period ] := '.' ;
FOR C := Chr(FirstChr) TO Chr(LastChr) DO
BEGIN
FoldedChar [ C ] := C;
CharType [C] := OtherChar
END;
Lc := 'a';
FOR C := 'A' TO 'Z' DO
BEGIN
FoldedChar [ Lc ] := C;
CharType [ C ] := Letter;
CharType [ Lc ] := Letter;
Lc := Succ(Lc)
END;
FOR C := '0' TO '9' DO
CharType [ C ] := Digit;
CharType [ Space ] := Blank;
CharType [ '''' ] := Quote;
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,
Capitalize,
SpaceAfter ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ FuncSym ] DO
BEGIN
OptionsSelected := [ BlankLineBefore,
Capitalize,
DIndentOnKeys,
SpaceAfter ];
DIndentSymbols := [ LabelSym,
ConstSym,
TypeSym,
VarSym ];
GobbleTerminators := []
END;
WITH PPOption [ ProcSym ] DO
BEGIN
OptionsSelected := [ BlankLineBefore,
Capitalize,
DIndentOnKeys,
SpaceAfter ];
DIndentSymbols := [ LabelSym,
ConstSym,
TypeSym,
VarSym ];
GobbleTerminators := []
END;
WITH PPOption [ LabelSym ] DO
BEGIN
OptionsSelected := [ BlankLineBefore,
Capitalize,
SpaceAfter,
IndentToCLP ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ ConstSym ] DO
BEGIN
OptionsSelected := [ BlankLineBefore,
Capitalize,
DIndentOnKeys,
SpaceAfter,
IndentToCLP ];
DIndentSymbols := [ LabelSym ];
GobbleTerminators := []
END;
WITH PPOption [ TypeSym ] DO
BEGIN
OptionsSelected := [ BlankLineBefore,
Capitalize,
DIndentOnKeys,
SpaceAfter,
IndentToCLP ];
DIndentSymbols := [ LabelSym,
ConstSym ];
GobbleTerminators := []
END;
WITH PPOption [ VarSym ] DO
BEGIN
OptionsSelected := [
Capitalize,
DIndentOnKeys,
SpaceAfter,
IndentToCLP ];
DIndentSymbols := [ LabelSym,
ConstSym,
TypeSym ];
GobbleTerminators := []
END;
WITH PPOption [ BeginSym ] DO
BEGIN
OptionsSelected := [ CrBefore,
Capitalize,
DIndentOnKeys,
IndentByTab,
CrAfter ];
DIndentSymbols := [ LabelSym,
ConstSym,
TypeSym,
VarSym ];
GobbleTerminators := []
END;
WITH PPOption [ RepeatSym ] DO
BEGIN
OptionsSelected := [ CrBefore,
Capitalize,
IndentByTab,
CrAfter ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ RecordSym ] DO
BEGIN
OptionsSelected := [ IndentByTab,
Capitalize,
CrAfter ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ CaseSym ] DO
BEGIN
OptionsSelected := [ CrBefore,
Capitalize,
SpaceAfter,
IndentByTab,
GobbleSymbols,
CrAfter ];
DIndentSymbols := [];
GobbleTerminators := [ OfSym ]
END;
WITH PPOption [ CaseVarSym ] DO
BEGIN
OptionsSelected := [ CrBefore,
Capitalize,
SpaceAfter,
IndentByTab,
GobbleSymbols,
CrAfter ];
DIndentSymbols := [];
GobbleTerminators := [ OfSym ]
END;
WITH PPOption [ OfSym ] DO
BEGIN
OptionsSelected := [ CrSuppress,
Capitalize,
SpaceBefore ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ ForSym ] DO
BEGIN
OptionsSelected := [ CrBefore,
Capitalize,
SpaceAfter,
IndentByTab,
GobbleSymbols ];
DIndentSymbols := [];
GobbleTerminators := [ DoSym ]
END;
WITH PPOption [ WhileSym ] DO
BEGIN
OptionsSelected := [ CrBefore,
Capitalize,
SpaceAfter,
IndentByTab,
GobbleSymbols ];
DIndentSymbols := [];
GobbleTerminators := [ DoSym ]
END;
WITH PPOption [ WithSym ] DO
BEGIN
OptionsSelected := [ CrBefore,
Capitalize,
SpaceAfter,
IndentByTab,
GobbleSymbols,
CrAfter ];
DIndentSymbols := [];
GobbleTerminators := [ DoSym ]
END;
WITH PPOption [ DoSym ] DO
BEGIN
OptionsSelected := [ CrSuppress,
Capitalize,
SpaceBefore ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ LoopSym] DO
BEGIN
OptionsSelected := [ CrBefore,
Capitalize,
IndentByTab,
CrAfter ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ ExitSym ] DO
BEGIN
OptionsSelected := [ CrBefore,
Capitalize,
DIndent,
GobbleSymbols,
IndentByTab ];
DIndentSymbols := [];
GobbleTerminators := [ EndSym,
SemiColon ]
END;
WITH PPOption [ IfSym ] DO
BEGIN
OptionsSelected := [ CrBefore,
Capitalize,
SpaceAfter,
GobbleSymbols,
IndentByTab ];
DIndentSymbols := [];
GobbleTerminators := [ ThenSym ]
END;
WITH PPOption [ ThenSym ] DO
BEGIN
OptionsSelected := [ IndentByTab,
Capitalize];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ ElseSym ] DO
BEGIN
OptionsSelected := [ DIndentOnKeys,
Capitalize,
DIndent,
IndentByTab ];
DIndentSymbols := [ IfSym,
WhileSym,
WithSym,
ForSym,
ElseSym ];
GobbleTerminators := []
END;
WITH PPOption [ EndSym ] DO
BEGIN
OptionsSelected := [ CrBefore,
Capitalize,
DIndentOnKeys,
DIndent,
CrAfter ];
DIndentSymbols := [ IfSym,
ThenSym,
ElseSym,
ThIfSym,
ElIfSym,
ForSym,
WhileSym,
WithSym,
CaseVarSym,
Colon,
Equals ];
GobbleTerminators := []
END;
WITH PPOption [ AndSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ ArraySym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ DivSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ DownToSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ FileSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ GotoSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ InSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ ModSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ NilSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ FalseSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ TrueSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ MaxIntSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ ToSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ PascalSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ SetSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ PackedSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ AlgolSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ ForwardSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ FortranSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ ExternSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ CobolSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ OrSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ NotSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ ExitLoopSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ NextLoopSym ] DO
BEGIN
OptionsSelected := [ Capitalize ];
DIndentSymbols := [];
GobbleTerminators := []
END;
WITH PPOption [ UntilSym ] DO
BEGIN
OptionsSelected := [ CrBefore,
Capitalize,
DIndentOnKeys,
DIndent,
SpaceAfter,
GobbleSymbols,
CrAfter ];
DIndentSymbols := [ IfSym,
ThenSym,
ElseSym,
ThIfSym,
ElIfSym,
ForSym,
WhileSym,
WithSym,
Colon,
Equals ];
GobbleTerminators := [ EndSym,
UntilSym,
ElseSym,
SemiColon ];
END;
WITH PPOption [ ElIfSym ] DO
BEGIN
OptionsSelected := [ CrBefore,
Capitalize,
DIndentOnKeys,
DIndent,
IndentByTab,
GobbleSymbols ];
DIndentSymbols := [ ThenSym,
ElseSym,
WhileSym,
WithSym,
ForSym ];
GobbleTerminators := [ ThenSym ]
END;
WITH PPOption [ ThIfSym ] DO
BEGIN
OptionsSelected := [ CrBefore,
Capitalize,
IndentByTab,
GobbleSymbols,
CrAfter ];
DIndentSymbols := [];
GobbleTerminators := [ ThenSym ]
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 ];
DIndentSymbols := [ IfSym,
ThenSym,
ElseSym,
ThIfSym,
ElIfSym,
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; (* 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; (* StackFull *)
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 : NText );
VAR
I: Integer;
BEGIN (* WriteCrs *)
IF NumberOfCrs > 0
THEN
BEGIN
FOR I := 1 TO NumberOfCrs DO
NWrteln(OutputFile);
CurrLinePos := 0
END
END; (* WriteCrs *)
PROCEDURE InsertCr( (* updating *) VAR CurrSym : SymbolInfo;
(* writing to *) VAR OutputFile : NText );
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 : NText );
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 : NText );
BEGIN (* InsertSpace *)
IF CurrLinePos < MaxLineSize
THEN
BEGIN
NWrite(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 : NText );
VAR
R,
I: Integer;
BEGIN (* MoveLinePos *)
IF CurrLinePos=0
THEN
BEGIN
R := CurrLinePos - (CurrLinePos MOD TabSize) + TabSize;
WHILE R <= NewLinePos DO
BEGIN
CurrLinePos := R;
R := R + TabSize;
NWrite(OutputFile,Tab)
END;
END;
FOR I := CurrLinePos+1 TO NewLinePos DO
NWrite(OutputFile, Space);
CurrLinePos := NewLinePos
END; (* MoveLinePos *)
PROCEDURE MakeCapitals ( (* updating *) CurrSym : SymbolInfo );
VAR I : Integer;
BEGIN (* MakeCapitals *)
WITH CurrSym↑ DO
FOR I := 1 TO Length DO Value[I] := FoldedChar[Value[I]];
END (* MakeCapitals *);
PROCEDURE PrintSymbol( (* in *) CurrSym : SymbolInfo;
(* updating *) VAR CurrLinePos : Integer;
(* writing to *) VAR OutputFile : NText );
VAR
I: Integer;
BEGIN (* PrintSymbol *)
WITH CurrSym↑ DO
BEGIN
IF Value[1] = FF
THEN NPage(OutputFile)
ELSE
BEGIN
FOR I := 1 TO Length DO
NWrite(OutputFile, Value[I]);
CurrLinePos := CurrLinePos + Length
END
END (* with *)
END; (* PrintSymbol *)
PROCEDURE PPSymbol( (* in *) CurrSym : SymbolInfo;
(* writing to *) VAR OutputFile : NText );
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 : NText );
BEGIN (* Gobble *)
RShiftToCLP( (* using *) CurrSym↑.Name );
WHILE NOT(NextSym↑.Name IN (Terminators + [EndOfFile])) DO
BEGIN
GetSymbol( (* from *) InputFile,
(* updating *) NextSym,
(* returning *) CurrSym );
IF ( Capitalize IN PPOption[CurrSym↑.Name].OptionsSelected)
AND WeAreCapitalizing
THEN MakeCapitals ( (* updating *) 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 *)
PROCEDURE Uglify( (* from *) VAR InFile: Text;
(* to *) VAR OutFile: Text);
VAR
C: Char; (* Current Input *)
BlCount: Integer; (* number of leading blanks in current line *)
AtStart,InComment,InString: Boolean;
(* state indicators *)
PROCEDURE SpaceOver(N: Integer);
VAR I: Integer;
BEGIN
FOR I := 1 TO N DO Write(OutFile,' ')
END;
BEGIN (* Uglify *)
AtStart := TRUE; InComment := FALSE; InString := FALSE;
WHILE NOT EOF(InFile) DO
IF EOLn(InFile) THEN
BEGIN
BlCount := 0; AtStart := NOT (InString OR InComment);
ReadLn(InFile);
IF eof(InFile) THEN WriteLn(OutFile)
ELSE IF NOT eoln(InFile) THEN WriteLn(OutFile)
ELSE IF NOT eop(InFile) THEN WriteLn(OutFile)
ELSE
BEGIN
Page(OutFile); ReadLn(InFile)
END
END
ELSE
BEGIN
Read(InFile,C);
IF C=' '
THEN IF AtStart
THEN BlCount := BlCount + 1 ELSE Write(OutFile,C)
ELSE
BEGIN
CASE C OF
'{' :
IF NOT InString THEN
BEGIN
InComment := TRUE;
IF AtStart THEN SpaceOver(BlCount)
END;
'(' :
IF (NOT InString) AND (InFile↑='*') THEN
BEGIN
InComment := TRUE;
IF AtStart THEN SpaceOver(BlCount);
Write(OutFile,'('); Read(InFile,C)
END;
'*' :
IF InComment AND (InFile↑=')') THEN
BEGIN
InComment := FALSE;
Write(OutFile,'*'); Read(InFile,C)
END;
'}' : InComment := FALSE;
'''' :
IF NOT InComment THEN InString := NOT InString
END;
AtStart := FALSE;
Write(OutFile,c)
END
END
END; (* Uglify *)
BEGIN (* PrettyPrint *)
WriteLn(tty,'Pascal PrettyPrinter. Version 1/29/79.');
DReset(Input);
NDReWrite(OutputFile);
GetLineNR(L);
IF L<>'-----' THEN NSetLine(OutputFile,InitLineNumber,InitLineNumber);
REPEAT
WriteLn (tty);
Write(tty,'Do you want to undent first? [respond Y,N, or ?]: ');
ReadLn(tty,Resp);
CASE Resp OF
'Y','y':
BEGIN
DeleteTemp := TRUE;
ReWrite(TempFile,'Output ');
Uglify(Input,TempFile);
Close(TempFile);
Reset(Input,'Output ');
END;
'N','n': DeleteTemp := FALSE;
'?':
BEGIN
WriteLn(tty,'Undenting first removes all leading ',
'blanks on each line, aside from lines ');
Write(tty,'beginning with comments.');
WriteLn(tty,' The effect is that Pretty places all ',
'text as far left');
WriteLn(tty,'as the formatting conventions allow.');
END
END
UNTIL (Resp='Y') OR (Resp='N') OR(Resp='y') OR (Resp='n');
REPEAT
WriteLn (tty);
WriteLn (tty, 'Do you want to force capitalization of ');
Write (tty,'reserved words ? [respond Y,N, or ?] : ');
ReadLn (tty, Resp);
CASE Resp OF
'Y','y','N','n': WeAreCapitalizing := (Resp='Y') OR (Resp='y');
'?' :
BEGIN
WriteLn (tty,'A "Y" will force capitalization of',
' all reserved words');
WriteLn (tty,'that are not in comments or quotes.');
WriteLn (tty,'An "N" will cause the PrettyPrinter',
' to leave them as they are.');
END;
END;
UNTIL (Resp='Y') OR (Resp='N') OR(Resp='y') OR (Resp='n');
Initialize( Input, OutputFile, Top, CurrLinePos,
CurrMargin, KeyWord, FoldedChar, CharType,
DblChar, SglChar, RecordSeen, CurrChar,
NextChar, CurrSym, NextSym, PPoption );
CrPending := FALSE;
WHILE (NextSym↑.Name <> EndOfFile) DO
BEGIN
GetSymbol( (* from *) Input,
(* 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 );
IF (Capitalize IN OptionsSelected )
AND WeAreCapitalizing
THEN MakeCapitals ( (* updating*) CurrSym );
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 *) Input,
(* up to *) GobbleTerminators,
(* updating *) CurrSym,
NextSym,
(* writing to *) OutputFile );
IF CrAfter IN OptionsSelected
THEN
CrPending := TRUE
END (* With *)
END; (* While *)
IF CrPending
THEN
NWrteLn(OutputFile);
NClose(OutputFile);
IF DeleteTemp THEN
BEGIN
Close(Input);
ReWrite(Input);
Close(Input)
END
END.