BSD 1 development
[unix-history] / tests / pretty.p
CommitLineData
fde98a2d
BJ
1program pretty(input,output);
2const SYMLENGTH = 15;
3type
4 kinds = (ident, number, op, endfile);
5 symb = array[1..SYMLENGTH] of char;
6 scanres = record
7 symbol:symb;
8 kind:kinds;
9 end;
10var
11 i,j,k:integer;
12 ch: char;
13 tabs: integer;
14 a: scanres;
15 working, space, indentflag: boolean;
16 procflag, inparam, caseflag: boolean;
17
18procedure indent;
19var i:integer;
20begin
21 space := false;
22 indentflag := false;
23 writeln;
24 for i := 1 to tabs do write(' ');
25end;
26
27procedure writesym(a:scanres);
28var
29 i:integer;
30begin
31 if indentflag then indent;
32 {
33 if (a.kind = ident) and space then write(' ');
34 if (a.kind = op) and (a.symbol[1] in ['(','+','-','*']) then write(' ');
35 }
36 write(' ');
37 i := 1;
38 while (a.symbol[i] <> ' ') do
39 begin
40 write(a.symbol[i]);
41 i := i + 1;
42 end;
43 {
44 if a.kind <> ident then space := false else space := true;
45 if (a.kind = op) and (a.symbol[1] in [')','+','-','*']) then write(' ');
46 }
47end;
48
49function scanner:scanres;
50var
51 i:integer;
52 comment: boolean;
53 Scanner: scanres;
54begin
55 for i := 1 to SYMLENGTH do Scanner.symbol[i] := ' ';
56
57 repeat
58 comment := false;
59 comment := comment;
60 comment := comment;
61 comment := comment;
62 while (ch in [' ', ' ']) and (not eof(input)) do
63 begin
64 ch := input^;
65 get(input);
66 end;
67 if ch = '{' then
68 begin
69 comment := true;
70 while ch <> '}' do
71 begin
72 ch := input^;
73 get(input);
74 end;
75 ch := ' ';
76 end;
77 until not comment;
78
79 if eof(input) then Scanner.kind := endfile
80 else
81 begin
82 if ch in ['a'..'z', 'A'..'Z'] then { identifiers }
83 begin
84 i := 1;
85 while ch in ['a'..'z', 'A'..'Z', '0'..'9'] do
86 begin
87 Scanner.symbol[i] := ch;
88 i := i + 1;
89 ch := input^;
90 get(input);
91 end;
92 Scanner.kind := ident;
93 end
94 else if ch in ['0'..'9'] then { numbers }
95 begin
96 i := 1;
97 while ch in ['0'..'9'] do
98 begin
99 Scanner.symbol[i] := ch;
100 i := i + 1;
101 ch := input^;
102 get(input);
103 end;
104 Scanner.kind := number;
105 end
106 else begin { operators }
107 Scanner.symbol[1] := ch;
108 if ch in ['<','>',':'] then
109 begin
110 ch := input^;
111 get(input);
112 if ch in ['=', '>'] then
113 begin
114 Scanner.symbol[2] := ch;
115 ch := input^;
116 get(input);
117 end;
118 end
119 else if ch = '.' then
120 begin
121 ch := input^;
122 get(input);
123 if ch = '.' then
124 begin
125 ch := input^;
126 get(input);
127 Scanner.symbol := '..';
128 end;
129 end
130 else
131 begin
132 ch := input^;
133 get(input);
134 end;
135 Scanner.kind := op;
136 end;
137 end;
138 scanner := Scanner;
139end;
140
141function compar(s1:symb; s2:symb):boolean;
142var
143 i:integer;
144 comp: boolean;
145begin
146 comp := true; i := 1;
147 while (comp and (i <= SYMLENGTH)) do
148 begin
149 comp := comp & (s1[i] = s2[i]);
150 i := i + 1;
151 end;
152 compar := comp;
153end;
154
155begin
156 working := true;
157 ch := ' ';
158 procflag := false;
159 caseflag := false;
160 inparam := false;
161 tabs := 0;
162 while working do
163 begin
164 a := scanner;
165 case a.kind of
166 endfile: begin
167 working := false;
168 writeln;
169 end;
170
171 ident: begin
172 if compar(a.symbol, 'begin') then
173 begin
174 writesym(a);
175 tabs := tabs + 1;
176 indent;
177 end
178 else if compar(a.symbol, 'case') then
179 begin
180 writesym(a);
181 tabs := tabs + 1;
182 caseflag := true;
183 end
184 else if compar(a.symbol, 'procedure') or
185 compar(a.symbol, 'function') then
186 begin
187 writeln;
188 writeln;
189 writeln;
190 tabs := 0;
191 procflag := true;
192 writesym(a);
193 end
194 else if compar(a.symbol, 'var') or
195 compar(a.symbol, 'type') or
196 compar(a.symbol, 'const') or
197 compar(a.symbol, 'label') then
198 begin
199 writeln;
200 tabs := 0;
201 writesym(a);
202 end
203 else if compar(a.symbol, 'of') then
204 begin
205 if caseflag then
206 begin
207 indent;
208 writesym(a);
209 caseflag := false;
210 end
211 else writesym(a)
212 end
213 else if compar(a.symbol, 'record') then
214 begin
215 writesym(a);
216 tabs := tabs + 1;
217 indent;
218 end
219 else if compar(a.symbol, 'end') then
220 begin
221 tabs := tabs - 1;
222 indent;
223 writesym(a);
224 end
225 else writesym(a);
226 end;
227
228 number: writesym(a);
229
230 op: begin
231 if a.symbol[1] = '''' then
232 begin
233 write('''');
234 while ch <> '''' do
235 begin
236 write(ch);
237 ch := input^;
238 get(input);
239 end;
240 write(ch);
241 ch := input^;
242 get(input);
243 end
244 else if a.symbol[1] = ';' then
245 begin
246 writesym(a);
247 if not inparam then
248 indentflag := true
249 end
250 else if (a.symbol[1] = '(') & procflag then
251 begin
252 inparam := true;
253 writesym(a);
254 end
255 else if a.symbol[1] = ')' then
256 begin
257 writesym(a);
258 inparam := false;
259 procflag := false;
260 end
261 else writesym(a);
262 end
263 end
264 end
265end.