1 {
2 Yacc parse table construction.
3
4
5 Copyright (c) 1990-92 Albert Graef <ag@muwiinfa.geschichte.uni-mainz.de>
6 Copyright (C) 1996 Berend de Boer <berend@pobox.com>
7
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2 of the License, or
11 (at your option) any later version.
12
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with this program; if not, write to the Free Software
20 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21
22
23 $Revision: 1.2 $
24 $Modtime: 96-07-31 14:09 $
25
26 $History: YACCPARS.PAS $
27 *
28 * ***************** Version 2 *****************
29 * User: Berend Date: 96-10-10 Time: 21:16
30 * Updated in $/Lex and Yacc/tply
31 * Updated for protected mode, windows and Delphi 1.X and 2.X.
32
33 }
34
35
36 unit YaccPars;
37
38 interface
39
40
41 procedure parse_table;
42
43 (* Constructs the parse table from the information in the state,
44 transition and reduction table, and writes parse and rule table
45 information to the output file.
46
47 Rules never reduced are detected, and parsing conflicts resolved
48 according to the usual disambiguting rules:
49
50 - by default, shift/reduce conflicts are resolved in favour of
51 shift, and reduce/reduce conflicts are resolved in favour of
52 the rule appearing first in the grammar
53
54 - in the presence of precedence information, shift/reduce conflicts
55 are resolved as follows:
56 - if the rule has higher precedence than the input symbol,
57 reduce
58 - if the input symbol has higher precedence than the rule,
59 shift
60 - if rule and input symbol have the same precedence, use
61 associativity to resolve the conflict: if the symbol is
62 left-associative, reduce; if right-associative, shift;
63 if nonassociative, error.
64
65 The default action for any state is error, unless the state
66 only has a single reduce action, and no shift (or nonassoc-induced
67 error) actions, in which case the default action is the reduction.
68 An accept action is generated for the shift-endmarker action.
69
70 If the verbose option is enabled, the parse_table routine also writes
71 a readable listing of the generated parser to the .LST file, including
72 descriptions of parse conflicts and rules never reduced.
73
74 Parse table actions are encoded as follows:
75 - positive: next state (shift or goto action)
76 - negative: rule to reduce (reduce action)
77 - 0: error (in default action table) or accept (in shift/reduce
78 action table)
79
80 The tables are written out as a collection of typed array constants:
81
82 type YYARec = record { action record }
83 sym, act : Integer; { symbol and action }
84 end;
85 YYRRec = record { rule record }
86 len, sym : Integer; { length and lhs symbol }
87 end;
88
89 const
90
91 yynacts = ...; { number of parse table (shift and reduce) actions }
92 yyngotos = ...; { number of goto actions }
93 yynstates = ...; { number of states }
94 yynrules = ...; { number of rules }
95
96 yya : array [1..yynacts] of YYARec = ...;
97 { shift and reduce actions }
98 yyg : array [1..yyngotos] of YYARec = ...;
99 { goto actions }
100 yyd : array [0..yynstates-1] of Integer = ...;
101 { default actions }
102 yyal, yyah,
103 yygl, yygh : array [0..yynstates-1] of Integer = ...;
104 { offsets into action and goto table }
105
106 yyr : array [1..yynrules] of YYRRec = ...;
107
108 *)
109
110 var shift_reduce, reduce_reduce, never_reduced : Integer;
111 (* number of parsing conflicts and unreduced rules detected during
112 parse table generation *)
113
114 implementation
115
116 uses YaccBase, YaccTabl;
117
118 var reduced : array [1..max_rules] of Boolean;
119
120 var yynacts, yyngotos, yynstates : Integer;
121 yyd : array [0..max_states-1] of Integer;
122 yyal, yyah, yygl, yygh : array [0..max_states-1] of Integer;
123
ruleStrnull124 function ruleStr ( i : Integer ) : String;
125 (* returns print representation of rule number i *)
126 var str : String; j : Integer;
127 begin
128 with rule_table^[i]^ do
129 begin
130 str := pname(lhs_sym)+' :';
131 for j := 1 to rhs_len do
132 str := str+' '+pname(rhs_sym[j]);
133 end;
134 ruleStr := str;
135 end(*ruleStr*);
136
itemStrnull137 function itemStr ( var item_set : ItemSet; i : Integer ) : String;
138 (* returns print representation of item number i in item_set *)
139 var str : String; j : Integer;
140 begin
141 with item_set, item[i], rule_table^[rule_no]^ do
142 begin
143 str := pname(lhs_sym)+' :';
144 for j := 1 to pos_no-1 do
145 str := str+' '+pname(rhs_sym[j]);
146 str := str+' _';
147 for j := pos_no to rhs_len do
148 str := str+' '+pname(rhs_sym[j]);
149 end;
150 itemStr := str;
151 end(*itemStr*);
152
153 procedure build;
154
155 (* build the parse table, resolve conflicts *)
156
157 var
158
159 i, j, k, s,
160 n_errors,
161 n_shifts,
162 n_gotos,
163 n_reductions,
164 n_conflicts : Integer;
165
166 item_set : ItemSet;
167
168 begin
169
170 (* initialize: *)
171
172 shift_reduce := 0; reduce_reduce := 0; never_reduced := 0;
173 for i := 1 to n_rules do reduced[i] := false;
174
175 (* traverse the state table: *)
176
177 for s := 0 to n_states-1 do with state_table^[s] do
178
179 begin
180
181 if verbose then
182 begin
183 writeln(yylst);
184 writeln(yylst, 'state ', s, ':');
185 end;
186
187 (* Check shift and reduce actions, resolve conflicts.
188 The number of error actions generated by nonassoc's is counted
189 in n_errors, the number of conflicts reported in n_conflicts.
190 Shift actions ruled out by disambiguating rules are flagged by
191 setting the corresponding next_state to -1. *)
192
193 n_errors := 0; n_conflicts := 0;
194
195 for i := trans_lo to trans_hi do with trans_table^[i] do
196 if sym>=0 then
197 for j := redns_lo to redns_hi do with redn_table^[j] do
198 if member(sym, symset^) then
199 if (sym_prec^[sym]>0) and (rule_prec^[rule_no]>0) then
200 (* resolve conflict using precedence: *)
201 if rule_prec^[rule_no]=sym_prec^[sym] then
202 case prec_table^[sym_prec^[sym]] of
203 left : (* reduce *)
204 next_state := -1;
205 right : (* shift *)
206 exclude(symset^, sym);
207 nonassoc : (* error *)
208 begin
209 inc(n_errors);
210 next_state := -1;
211 exclude(symset^, sym);
212 end;
213 end
214 else if rule_prec^[rule_no]>sym_prec^[sym] then
215 (* reduce *)
216 next_state := -1
217 else
218 (* shift *)
219 exclude(symset^, sym)
220 else
221 (* shift/reduce conflict: *)
222 begin
223 if verbose then
224 begin
225 if n_conflicts=0 then
226 begin
227 writeln(yylst);
228 writeln(yylst, tab, '*** conflicts:');
229 writeln(yylst);
230 end;
231 writeln(yylst, tab,
232 'shift ', next_state, ', ',
233 'reduce ', rule_no-1, ' on ',
234 pname(sym));
235 end;
236 inc(n_conflicts); inc(shift_reduce);
237 exclude(symset^, sym);
238 end;
239
240 for i := redns_lo to redns_hi do
241 for j := i+1 to redns_hi do with redn_table^[j] do
242 begin
243 for k := 1 to size(symset^) do
244 if member(symset^[k], redn_table^[i].symset^) then
245 (* reduce/reduce conflict: *)
246 begin
247 if verbose then
248 begin
249 if n_conflicts=0 then
250 begin
251 writeln(yylst);
252 writeln(yylst, tab, '*** conflicts:');
253 writeln(yylst);
254 end;
255 writeln(yylst, tab,
256 'reduce ',
257 redn_table^[i].rule_no-1, ', ',
258 'reduce ', rule_no-1, ' on ',
259 pname(symset^[k]));
260 end;
261 inc(n_conflicts); inc(reduce_reduce);
262 end;
263 setminus(symset^, redn_table^[i].symset^);
264 end;
265
266 (* Count goto, shift and reduce actions to generate. *)
267
268 n_gotos := 0; n_shifts := 0; n_reductions := 0;
269
270 for i := trans_lo to trans_hi do with trans_table^[i] do
271 if next_state<>-1 then
272 if sym<0 then
273 inc(n_gotos)
274 else
275 inc(n_shifts);
276
277 for i := redns_lo to redns_hi do with redn_table^[i] do
278 if size(symset^)>0 then
279 inc(n_reductions);
280
281 (* Determine default action. *)
282
283 if (n_shifts+n_errors=0) and (n_reductions=1) then
284 (* default action is the reduction *)
285 with redn_table^[redns_lo] do
286 yyd[s] := -(rule_no-1)
287 else
288 (* default action is error *)
289 yyd[s] := 0;
290
291 (* Flag reduced rules. *)
292
293 for i := redns_lo to redns_hi do
294 with redn_table^[i] do
295 reduced[rule_no] := true;
296
297 if verbose then
298
299 begin
300
301 (* List kernel items. *)
302
303 writeln(yylst);
304 get_item_set(s, item_set);
305 closure(item_set);
306 sort_item_set(item_set);
307 with item_set do
308 begin
309 for i := 1 to n_items do
310 with item[i], rule_table^[rule_no]^ do
311 if (rule_no=1) or (pos_no>1) or (rhs_len=0) then
312 if pos_no>rhs_len then
313 writeln(yylst, tab,
314 itemStr(item_set, i), tab,
315 '(', rule_no-1, ')')
316 else
317 writeln(yylst, tab, itemStr(item_set, i));
318 end;
319
320 (* List parse actions. *)
321
322 (* shift, reduce and default actions: *)
323
324 if (n_shifts+n_errors=0) and (n_reductions=1) then
325 (* default action is the reduction *)
326 with redn_table^[redns_lo] do
327 begin
328 writeln(yylst);
329 writeln(yylst, tab, '.', tab, 'reduce ', rule_no-1 );
330 end
331 else
332 (* default action is error *)
333 begin
334 writeln(yylst);
335 for i := trans_lo to trans_hi do with trans_table^[i] do
336 if next_state<>-1 then
337 if sym=0 then
338 (* accept action *)
339 writeln(yylst, tab, pname(sym), tab, 'accept')
340 else if sym>0 then
341 (* shift action *)
342 writeln(yylst, tab,
343 pname(sym), tab, 'shift ', next_state);
344 for i := redns_lo to redns_hi do
345 with redn_table^[i] do
346 for j := 1 to size(symset^) do
347 (* reduce action *)
348 writeln(yylst, tab,
349 pname(symset^[j]), tab, 'reduce ',
350 rule_no-1);
351 (* error action *)
352 writeln(yylst, tab, '.', tab, 'error');
353 end;
354
355 (* goto actions: *)
356
357 if n_gotos>0 then
358 begin
359 writeln(yylst);
360 for i := trans_lo to trans_hi do with trans_table^[i] do
361 if sym<0 then
362 writeln(yylst, tab,
363 pname(sym), tab, 'goto ', next_state);
364 end;
365
366 end;
367
368 end;
369
370 for i := 2 to n_rules do
371 if not reduced[i] then inc(never_reduced);
372
373 if verbose then
374 begin
375 writeln(yylst);
376 if shift_reduce>0 then
377 writeln(yylst, shift_reduce, ' shift/reduce conflicts.');
378 if reduce_reduce>0 then
379 writeln(yylst, reduce_reduce, ' reduce/reduce conflicts.');
380 if never_reduced>0 then
381 writeln(yylst, never_reduced, ' rules never reduced.');
382 end;
383
384 (* report rules never reduced: *)
385
386 if (never_reduced>0) and verbose then
387 begin
388 writeln(yylst);
389 writeln(yylst, '*** rules never reduced:');
390 for i := 2 to n_rules do if not reduced[i] then
391 begin
392 writeln(yylst);
393 writeln(yylst, ruleStr(i), tab, '(', i-1, ')');
394 end;
395 end;
396
397 end(*build*);
398
399 procedure counters;
400
401 (* initialize counters and offsets *)
402
403 var s, i : Integer;
404
405 begin
406
407 yynstates := n_states; yynacts := 0; yyngotos := 0;
408
409 for s := 0 to n_states-1 do with state_table^[s] do
410 begin
411 yyal[s] := yynacts+1; yygl[s] := yyngotos+1;
412 if yyd[s]=0 then
413 begin
414 for i := trans_lo to trans_hi do with trans_table^[i] do
415 if (sym>=0) and (next_state<>-1) then
416 inc(yynacts);
417 for i := redns_lo to redns_hi do with redn_table^[i] do
418 inc(yynacts, size(symset^));
419 end;
420 for i := trans_lo to trans_hi do with trans_table^[i] do
421 if sym<0 then
422 inc(yyngotos);
423 yyah[s] := yynacts; yygh[s] := yyngotos;
424 end;
425
426 end(*counters*);
427
428 procedure tables;
429
430 (* write tables to output file *)
431
432 var s, i, j, count : Integer;
433
434 begin
435
436 writeln(yyout);
437 writeln(yyout, 'type YYARec = record');
438 writeln(yyout, ' sym, act : Integer;');
439 writeln(yyout, ' end;');
440 writeln(yyout, ' YYRRec = record');
441 writeln(yyout, ' len, sym : Integer;');
442 writeln(yyout, ' end;');
443 writeln(yyout);
444 writeln(yyout, 'const');
445
446 (* counters: *)
447
448 writeln(yyout);
449 writeln(yyout, 'yynacts = ', yynacts, ';');
450 writeln(yyout, 'yyngotos = ', yyngotos, ';');
451 writeln(yyout, 'yynstates = ', yynstates, ';');
452 writeln(yyout, 'yynrules = ', n_rules-1, ';');
453
454 (* shift/reduce table: *)
455
456 writeln(yyout);
457 writeln(yyout, 'yya : array [1..yynacts] of YYARec = (');
458 count := 0;
459 for s := 0 to n_states-1 do with state_table^[s] do
460 begin
461 writeln(yyout, '{ ', s, ': }');
462 if yyd[s]=0 then
463 begin
464 for i := trans_lo to trans_hi do with trans_table^[i] do
465 if (next_state<>-1) and (sym>=0) then
466 begin
467 inc(count);
468 if sym=0 then
469 write(yyout, ' ( sym: 0; act: 0 )')
470 else
471 write(yyout, ' ( sym: ', sym, '; act: ',
472 next_state, ' )');
473 if count<yynacts then write(yyout, ',');
474 writeln(yyout);
475 end;
476 for i := redns_lo to redns_hi do with redn_table^[i] do
477 for j := 1 to size(symset^) do
478 begin
479 inc(count);
480 write(yyout, ' ( sym: ', symset^[j], '; act: ',
481 -(rule_no-1), ' )');
482 if count<yynacts then write(yyout, ',');
483 writeln(yyout);
484 end;
485 end;
486 end;
487 writeln(yyout, ');');
488
489 (* goto table: *)
490
491 writeln(yyout);
492 writeln(yyout, 'yyg : array [1..yyngotos] of YYARec = (');
493 count := 0;
494 for s := 0 to n_states-1 do with state_table^[s] do
495 begin
496 writeln(yyout, '{ ', s, ': }');
497 for i := trans_lo to trans_hi do with trans_table^[i] do
498 if sym<0 then
499 begin
500 inc(count);
501 write(yyout, ' ( sym: ', sym, '; act: ', next_state, ' )');
502 if count<yyngotos then write(yyout, ',');
503 writeln(yyout);
504 end;
505 end;
506 writeln(yyout, ');');
507
508 (* default action table: *)
509
510 writeln(yyout);
511 writeln(yyout, 'yyd : array [0..yynstates-1] of Integer = (');
512 for s := 0 to n_states-1 do
513 begin
514 write(yyout, '{ ', s, ': } ', yyd[s]);
515 if s<n_states-1 then write(yyout, ',');
516 writeln(yyout);
517 end;
518 writeln(yyout, ');');
519
520 (* offset tables: *)
521
522 writeln(yyout);
523 writeln(yyout, 'yyal : array [0..yynstates-1] of Integer = (');
524 for s := 0 to n_states-1 do
525 begin
526 write(yyout, '{ ', s, ': } ', yyal[s]);
527 if s<n_states-1 then write(yyout, ',');
528 writeln(yyout);
529 end;
530 writeln(yyout, ');');
531 writeln(yyout);
532 writeln(yyout, 'yyah : array [0..yynstates-1] of Integer = (');
533 for s := 0 to n_states-1 do
534 begin
535 write(yyout, '{ ', s, ': } ', yyah[s]);
536 if s<n_states-1 then write(yyout, ',');
537 writeln(yyout);
538 end;
539 writeln(yyout, ');');
540 writeln(yyout);
541 writeln(yyout, 'yygl : array [0..yynstates-1] of Integer = (');
542 for s := 0 to n_states-1 do
543 begin
544 write(yyout, '{ ', s, ': } ', yygl[s]);
545 if s<n_states-1 then write(yyout, ',');
546 writeln(yyout);
547 end;
548 writeln(yyout, ');');
549 writeln(yyout);
550 writeln(yyout, 'yygh : array [0..yynstates-1] of Integer = (');
551 for s := 0 to n_states-1 do
552 begin
553 write(yyout, '{ ', s, ': } ', yygh[s]);
554 if s<n_states-1 then write(yyout, ',');
555 writeln(yyout);
556 end;
557 writeln(yyout, ');');
558
559 (* rule table: *)
560
561 writeln(yyout);
562 writeln(yyout, 'yyr : array [1..yynrules] of YYRRec = (');
563 for i := 2 to n_rules do with rule_table^[i]^ do
564 begin
565 write(yyout, '{ ', i-1, ': } ', '( len: ', rhs_len,
566 '; sym: ', lhs_sym, ' )');
567 if i<n_rules then write(yyout, ',');
568 writeln(yyout);
569 end;
570 writeln(yyout, ');');
571
572 writeln(yyout);
573
574 end(*tables*);
575
576 procedure parse_table;
577 begin
578 build; counters; tables;
579 end(*parse_table*);
580
581 end(*YaccParseTable*).
582