home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
minnie.tuhs.org
/
unixen.tar
/
unixen
/
PDP-11
/
Distributions
/
ucb
/
spencer_2bsd.tar.gz
/
2bsd.tar
/
src
/
pascal
/
tests
/
pretty.p
< prev
next >
Wrap
Text File
|
1980-02-17
|
5KB
|
266 lines
program pretty(input,output);
const SYMLENGTH = 15;
type
kinds = (ident, number, op, endfile);
symb = array[1..SYMLENGTH] of char;
scanres = record
symbol:symb;
kind:kinds;
end;
var
i,j,k:integer;
ch: char;
tabs: integer;
a: scanres;
working, space, indentflag: boolean;
procflag, inparam, caseflag: boolean;
procedure indent;
var i:integer;
begin
space := false;
indentflag := false;
writeln;
for i := 1 to tabs do write(' ');
end;
procedure writesym(a:scanres);
var
i:integer;
begin
if indentflag then indent;
{
if (a.kind = ident) and space then write(' ');
if (a.kind = op) and (a.symbol[1] in ['(','+','-','*']) then write(' ');
}
write(' ');
i := 1;
while (a.symbol[i] <> ' ') do
begin
write(a.symbol[i]);
i := i + 1;
end;
{
if a.kind <> ident then space := false else space := true;
if (a.kind = op) and (a.symbol[1] in [')','+','-','*']) then write(' ');
}
end;
function scanner:scanres;
var
i:integer;
comment: boolean;
Scanner: scanres;
begin
for i := 1 to SYMLENGTH do Scanner.symbol[i] := ' ';
repeat
comment := false;
comment := comment;
comment := comment;
comment := comment;
while (ch in [' ', ' ']) and (not eof(input)) do
begin
ch := input^;
get(input);
end;
if ch = '{' then
begin
comment := true;
while ch <> '}' do
begin
ch := input^;
get(input);
end;
ch := ' ';
end;
until not comment;
if eof(input) then Scanner.kind := endfile
else
begin
if ch in ['a'..'z', 'A'..'Z'] then { identifiers }
begin
i := 1;
while ch in ['a'..'z', 'A'..'Z', '0'..'9'] do
begin
Scanner.symbol[i] := ch;
i := i + 1;
ch := input^;
get(input);
end;
Scanner.kind := ident;
end
else if ch in ['0'..'9'] then { numbers }
begin
i := 1;
while ch in ['0'..'9'] do
begin
Scanner.symbol[i] := ch;
i := i + 1;
ch := input^;
get(input);
end;
Scanner.kind := number;
end
else begin { operators }
Scanner.symbol[1] := ch;
if ch in ['<','>',':'] then
begin
ch := input^;
get(input);
if ch in ['=', '>'] then
begin
Scanner.symbol[2] := ch;
ch := input^;
get(input);
end;
end
else if ch = '.' then
begin
ch := input^;
get(input);
if ch = '.' then
begin
ch := input^;
get(input);
Scanner.symbol := '..';
end;
end
else
begin
ch := input^;
get(input);
end;
Scanner.kind := op;
end;
end;
scanner := Scanner;
end;
function compar(s1:symb; s2:symb):boolean;
var
i:integer;
comp: boolean;
begin
comp := true; i := 1;
while (comp and (i <= SYMLENGTH)) do
begin
comp := comp & (s1[i] = s2[i]);
i := i + 1;
end;
compar := comp;
end;
begin
working := true;
ch := ' ';
procflag := false;
caseflag := false;
inparam := false;
tabs := 0;
while working do
begin
a := scanner;
case a.kind of
endfile: begin
working := false;
writeln;
end;
ident: begin
if compar(a.symbol, 'begin') then
begin
writesym(a);
tabs := tabs + 1;
indent;
end
else if compar(a.symbol, 'case') then
begin
writesym(a);
tabs := tabs + 1;
caseflag := true;
end
else if compar(a.symbol, 'procedure') or
compar(a.symbol, 'function') then
begin
writeln;
writeln;
writeln;
tabs := 0;
procflag := true;
writesym(a);
end
else if compar(a.symbol, 'var') or
compar(a.symbol, 'type') or
compar(a.symbol, 'const') or
compar(a.symbol, 'label') then
begin
writeln;
tabs := 0;
writesym(a);
end
else if compar(a.symbol, 'of') then
begin
if caseflag then
begin
indent;
writesym(a);
caseflag := false;
end
else writesym(a)
end
else if compar(a.symbol, 'record') then
begin
writesym(a);
tabs := tabs + 1;
indent;
end
else if compar(a.symbol, 'end') then
begin
tabs := tabs - 1;
indent;
writesym(a);
end
else writesym(a);
end;
number: writesym(a);
op: begin
if a.symbol[1] = '''' then
begin
write('''');
while ch <> '''' do
begin
write(ch);
ch := input^;
get(input);
end;
write(ch);
ch := input^;
get(input);
end
else if a.symbol[1] = ';' then
begin
writesym(a);
if not inparam then
indentflag := true
end
else if (a.symbol[1] = '(') & procflag then
begin
inparam := true;
writesym(a);
end
else if a.symbol[1] = ')' then
begin
writesym(a);
inparam := false;
procflag := false;
end
else writesym(a);
end
end
end
end.