parser-top-down.c
1 //! @file parser-top-down.c
2 //! @author J. Marcel van der Veer
3
4 //! @section Copyright
5 //!
6 //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
7 //! Copyright 2001-2024 J. Marcel van der Veer [algol68g@xs4all.nl].
8
9 //! @section License
10 //!
11 //! This program is free software; you can redistribute it and/or modify it
12 //! under the terms of the GNU General Public License as published by the
13 //! Free Software Foundation; either version 3 of the License, or
14 //! (at your option) any later version.
15 //!
16 //! This program is distributed in the hope that it will be useful, but
17 //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
19 //! more details. You should have received a copy of the GNU General Public
20 //! License along with this program. If not, see [http://www.gnu.org/licenses/].
21
22 //! @section Synopsis
23 //!
24 //! Top-down parser for control structure.
25
26 #include "a68g.h"
27 #include "a68g-parser.h"
28
29 // Top-down parser, elaborates the control structure.
30
31 //! @brief Substitute brackets.
32
33 void substitute_brackets (NODE_T * p)
34 {
35 for (; p != NO_NODE; FORWARD (p)) {
36 substitute_brackets (SUB (p));
37 switch (ATTRIBUTE (p)) {
38 case ACCO_SYMBOL: {
39 ATTRIBUTE (p) = OPEN_SYMBOL;
40 break;
41 }
42 case OCCA_SYMBOL: {
43 ATTRIBUTE (p) = CLOSE_SYMBOL;
44 break;
45 }
46 case SUB_SYMBOL: {
47 ATTRIBUTE (p) = OPEN_SYMBOL;
48 break;
49 }
50 case BUS_SYMBOL: {
51 ATTRIBUTE (p) = CLOSE_SYMBOL;
52 break;
53 }
54 }
55 }
56 }
57
58 //! @brief Intelligible diagnostic from syntax tree branch.
59
60 char *phrase_to_text (NODE_T * p, NODE_T ** w)
61 {
62 #define MAX_TERMINALS 8
63 int count = 0, line = -1;
64 static BUFFER buffer;
65 for (buffer[0] = NULL_CHAR; p != NO_NODE && count < MAX_TERMINALS; FORWARD (p)) {
66 if (LINE_NUMBER (p) > 0) {
67 int gatt = get_good_attribute (p);
68 char *z = non_terminal_string (A68 (input_line), gatt);
69 // Where to put the error message? Bob Uzgalis noted that actual content of a
70 // diagnostic is not as important as accurately indicating *were* the problem is!
71 if (w != NO_VAR) {
72 if (count == 0 || (*w) == NO_NODE) {
73 *w = p;
74 } else if (dont_mark_here (*w)) {
75 *w = p;
76 }
77 }
78 // Add initiation.
79 if (count == 0) {
80 if (w != NO_VAR) {
81 a68_bufcat (buffer, "construct beginning with", BUFFER_SIZE);
82 }
83 } else if (count == 1) {
84 a68_bufcat (buffer, " followed by", BUFFER_SIZE);
85 } else if (count == 2) {
86 a68_bufcat (buffer, " and then", BUFFER_SIZE);
87 } else if (count >= 3) {
88 a68_bufcat (buffer, " and", BUFFER_SIZE);
89 }
90 // Attribute or symbol.
91 if (z != NO_TEXT && SUB (p) != NO_NODE) {
92 if (gatt == IDENTIFIER || gatt == OPERATOR || gatt == DENOTATION) {
93 ASSERT (a68_bufprt (A68 (edit_line), SNPRINTF_SIZE, " \"%s\"", NSYMBOL (p)) >= 0);
94 a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
95 } else {
96 if (strchr ("aeio", z[0]) != NO_TEXT) {
97 a68_bufcat (buffer, " an", BUFFER_SIZE);
98 } else {
99 a68_bufcat (buffer, " a", BUFFER_SIZE);
100 }
101 ASSERT (a68_bufprt (A68 (edit_line), SNPRINTF_SIZE, " %s", z) >= 0);
102 a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
103 }
104 } else if (z != NO_TEXT && SUB (p) == NO_NODE) {
105 ASSERT (a68_bufprt (A68 (edit_line), SNPRINTF_SIZE, " \"%s\"", NSYMBOL (p)) >= 0);
106 a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
107 } else if (NSYMBOL (p) != NO_TEXT) {
108 ASSERT (a68_bufprt (A68 (edit_line), SNPRINTF_SIZE, " \"%s\"", NSYMBOL (p)) >= 0);
109 a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
110 }
111 // Add "starting in line nn".
112 if (z != NO_TEXT && line != LINE_NUMBER (p)) {
113 line = LINE_NUMBER (p);
114 if (gatt == SERIAL_CLAUSE || gatt == ENQUIRY_CLAUSE || gatt == INITIALISER_SERIES) {
115 a68_bufcat (buffer, " starting", BUFFER_SIZE);
116 }
117 ASSERT (a68_bufprt (A68 (edit_line), SNPRINTF_SIZE, " in line %d", line) >= 0);
118 a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
119 }
120 count++;
121 }
122 }
123 if (p != NO_NODE && count == MAX_TERMINALS) {
124 a68_bufcat (buffer, " etcetera", BUFFER_SIZE);
125 }
126 return buffer;
127 }
128
129 // Next is a top-down parser that branches out the basic blocks.
130 // After this we can assign symbol tables to basic blocks.
131 // This renders the two-level grammar LALR.
132
133 //! @brief Give diagnose from top-down parser.
134
135 void top_down_diagnose (NODE_T * start, NODE_T * p, int clause, int expected)
136 {
137 NODE_T *issue = (p != NO_NODE ? p : start);
138 if (expected != 0) {
139 diagnostic (A68_SYNTAX_ERROR, issue, ERROR_EXPECTED_NEAR, expected, clause, NSYMBOL (start), LINE (INFO (start)));
140 } else {
141 diagnostic (A68_SYNTAX_ERROR, issue, ERROR_UNBALANCED_KEYWORD, clause, NSYMBOL (start), LINE (INFO (start)));
142 }
143 }
144
145 //! @brief Check for premature exhaustion of tokens.
146
147 void tokens_exhausted (const NODE_T * p, NODE_T * q)
148 {
149 if (p == NO_NODE) {
150 diagnostic (A68_SYNTAX_ERROR, q, ERROR_KEYWORD);
151 longjmp (A68_PARSER (top_down_crash_exit), 1);
152 }
153 }
154
155 // This part specifically branches out loop clauses.
156
157 //! @brief Whether in cast or formula with loop clause.
158
159 int is_loop_cast_formula (NODE_T * p)
160 {
161 // Accept declarers that can appear in such casts but not much more.
162 if (IS (p, VOID_SYMBOL)) {
163 return 1;
164 } else if (IS (p, INT_SYMBOL)) {
165 return 1;
166 } else if (IS_REF (p)) {
167 return 1;
168 } else if (is_one_of (p, OPERATOR, BOLD_TAG, STOP)) {
169 return 1;
170 } else if (whether (p, UNION_SYMBOL, OPEN_SYMBOL, STOP)) {
171 return 2;
172 } else if (is_one_of (p, OPEN_SYMBOL, SUB_SYMBOL, STOP)) {
173 int k = 0;
174 for (; p != NO_NODE && (is_one_of (p, OPEN_SYMBOL, SUB_SYMBOL, STOP)); FORWARD (p), k++) {
175 ;
176 }
177 return p != NO_NODE && (whether (p, UNION_SYMBOL, OPEN_SYMBOL, STOP) ? k : 0);
178 }
179 return 0;
180 }
181
182 //! @brief Skip a unit in a loop clause (FROM u BY u TO u).
183
184 NODE_T *top_down_skip_loop_unit (NODE_T * p)
185 {
186 // Unit may start with, or consist of, a loop.
187 if (is_loop_keyword (p)) {
188 p = top_down_loop (p);
189 }
190 // Skip rest of unit.
191 while (p != NO_NODE) {
192 int k = is_loop_cast_formula (p);
193 if (k != 0) {
194 // operator-cast series ...
195 while (p != NO_NODE && k != 0) {
196 while (k != 0) {
197 FORWARD (p);
198 k--;
199 }
200 k = is_loop_cast_formula (p);
201 }
202 // ... may be followed by a loop clause.
203 if (is_loop_keyword (p)) {
204 p = top_down_loop (p);
205 }
206 } else if (is_loop_keyword (p) || IS (p, OD_SYMBOL)) {
207 // new loop or end-of-loop.
208 return p;
209 } else if (IS (p, COLON_SYMBOL)) {
210 FORWARD (p);
211 // skip routine header: loop clause.
212 if (p != NO_NODE && is_loop_keyword (p)) {
213 p = top_down_loop (p);
214 }
215 } else if (is_one_of (p, SEMI_SYMBOL, COMMA_SYMBOL, STOP) || IS (p, EXIT_SYMBOL)) {
216 // Statement separators.
217 return p;
218 } else {
219 FORWARD (p);
220 }
221 }
222 return NO_NODE;
223 }
224
225 //! @brief Skip a loop clause.
226
227 NODE_T *top_down_skip_loop_series (NODE_T * p)
228 {
229 BOOL_T siga;
230 do {
231 p = top_down_skip_loop_unit (p);
232 siga = (BOOL_T) (p != NO_NODE && (is_one_of (p, SEMI_SYMBOL, EXIT_SYMBOL, COMMA_SYMBOL, COLON_SYMBOL, STOP)));
233 if (siga) {
234 FORWARD (p);
235 }
236 } while (!(p == NO_NODE || !siga));
237 return p;
238 }
239
240 //! @brief Make branch of loop parts.
241
242 NODE_T *top_down_loop (NODE_T * p)
243 {
244 NODE_T *start = p, *q = p;
245 if (IS (q, FOR_SYMBOL)) {
246 tokens_exhausted (FORWARD (q), start);
247 if (IS (q, IDENTIFIER)) {
248 ATTRIBUTE (q) = DEFINING_IDENTIFIER;
249 } else {
250 top_down_diagnose (start, q, LOOP_CLAUSE, IDENTIFIER);
251 longjmp (A68_PARSER (top_down_crash_exit), 1);
252 }
253 tokens_exhausted (FORWARD (q), start);
254 if (is_one_of (q, FROM_SYMBOL, BY_SYMBOL, TO_SYMBOL, DOWNTO_SYMBOL, WHILE_SYMBOL, STOP)) {
255 ;
256 } else if (IS (q, DO_SYMBOL)) {
257 ATTRIBUTE (q) = ALT_DO_SYMBOL;
258 } else {
259 top_down_diagnose (start, q, LOOP_CLAUSE, STOP);
260 longjmp (A68_PARSER (top_down_crash_exit), 1);
261 }
262 }
263 if (IS (q, FROM_SYMBOL)) {
264 start = q;
265 q = top_down_skip_loop_unit (NEXT (q));
266 tokens_exhausted (q, start);
267 if (is_one_of (q, BY_SYMBOL, TO_SYMBOL, DOWNTO_SYMBOL, WHILE_SYMBOL, STOP)) {
268 ;
269 } else if (IS (q, DO_SYMBOL)) {
270 ATTRIBUTE (q) = ALT_DO_SYMBOL;
271 } else {
272 top_down_diagnose (start, q, LOOP_CLAUSE, STOP);
273 longjmp (A68_PARSER (top_down_crash_exit), 1);
274 }
275 make_sub (start, PREVIOUS (q), FROM_SYMBOL);
276 }
277 if (IS (q, BY_SYMBOL)) {
278 start = q;
279 q = top_down_skip_loop_series (NEXT (q));
280 tokens_exhausted (q, start);
281 if (is_one_of (q, TO_SYMBOL, DOWNTO_SYMBOL, WHILE_SYMBOL, STOP)) {
282 ;
283 } else if (IS (q, DO_SYMBOL)) {
284 ATTRIBUTE (q) = ALT_DO_SYMBOL;
285 } else {
286 top_down_diagnose (start, q, LOOP_CLAUSE, STOP);
287 longjmp (A68_PARSER (top_down_crash_exit), 1);
288 }
289 make_sub (start, PREVIOUS (q), BY_SYMBOL);
290 }
291 if (is_one_of (q, TO_SYMBOL, DOWNTO_SYMBOL, STOP)) {
292 start = q;
293 q = top_down_skip_loop_series (NEXT (q));
294 tokens_exhausted (q, start);
295 if (IS (q, WHILE_SYMBOL)) {
296 ;
297 } else if (IS (q, DO_SYMBOL)) {
298 ATTRIBUTE (q) = ALT_DO_SYMBOL;
299 } else {
300 top_down_diagnose (start, q, LOOP_CLAUSE, STOP);
301 longjmp (A68_PARSER (top_down_crash_exit), 1);
302 }
303 make_sub (start, PREVIOUS (q), TO_SYMBOL);
304 }
305 if (IS (q, WHILE_SYMBOL)) {
306 start = q;
307 q = top_down_skip_loop_series (NEXT (q));
308 tokens_exhausted (q, start);
309 if (IS (q, DO_SYMBOL)) {
310 ATTRIBUTE (q) = ALT_DO_SYMBOL;
311 } else {
312 top_down_diagnose (start, q, LOOP_CLAUSE, DO_SYMBOL);
313 longjmp (A68_PARSER (top_down_crash_exit), 1);
314 }
315 make_sub (start, PREVIOUS (q), WHILE_SYMBOL);
316 }
317 if (is_one_of (q, DO_SYMBOL, ALT_DO_SYMBOL, STOP)) {
318 int k = ATTRIBUTE (q);
319 start = q;
320 q = top_down_skip_loop_series (NEXT (q));
321 tokens_exhausted (q, start);
322 if (!IS (q, OD_SYMBOL)) {
323 top_down_diagnose (start, q, LOOP_CLAUSE, OD_SYMBOL);
324 longjmp (A68_PARSER (top_down_crash_exit), 1);
325 }
326 make_sub (start, q, k);
327 }
328 NODE_T *save = NEXT (start);
329 make_sub (p, start, LOOP_CLAUSE);
330 return save;
331 }
332
333 //! @brief Driver for making branches of loop parts.
334
335 void top_down_loops (NODE_T * p)
336 {
337 NODE_T *q = p;
338 for (; q != NO_NODE; FORWARD (q)) {
339 if (SUB (q) != NO_NODE) {
340 top_down_loops (SUB (q));
341 }
342 }
343 q = p;
344 while (q != NO_NODE) {
345 if (is_loop_keyword (q) != STOP) {
346 q = top_down_loop (q);
347 } else {
348 FORWARD (q);
349 }
350 }
351 }
352
353 //! @brief Driver for making branches of until parts.
354
355 void top_down_untils (NODE_T * p)
356 {
357 NODE_T *q = p;
358 for (; q != NO_NODE; FORWARD (q)) {
359 if (SUB (q) != NO_NODE) {
360 top_down_untils (SUB (q));
361 }
362 }
363 q = p;
364 while (q != NO_NODE) {
365 if (IS (q, UNTIL_SYMBOL)) {
366 NODE_T *u = q;
367 while (NEXT (u) != NO_NODE) {
368 FORWARD (u);
369 }
370 make_sub (q, PREVIOUS (u), UNTIL_SYMBOL);
371 return;
372 } else {
373 FORWARD (q);
374 }
375 }
376 }
377
378 // Branch anything except parts of a loop.
379
380 //! @brief Skip serial/enquiry clause (unit series).
381
382 NODE_T *top_down_series (NODE_T * p)
383 {
384 BOOL_T siga = A68_TRUE;
385 while (siga) {
386 siga = A68_FALSE;
387 p = top_down_skip_unit (p);
388 if (p != NO_NODE) {
389 if (is_one_of (p, SEMI_SYMBOL, EXIT_SYMBOL, COMMA_SYMBOL, STOP)) {
390 siga = A68_TRUE;
391 FORWARD (p);
392 }
393 }
394 }
395 return p;
396 }
397
398 //! @brief Make branch of BEGIN .. END.
399
400 NODE_T *top_down_begin (NODE_T * begin_p)
401 {
402 NODE_T *end_p = top_down_series (NEXT (begin_p));
403 if (end_p == NO_NODE || !IS (end_p, END_SYMBOL)) {
404 top_down_diagnose (begin_p, end_p, ENCLOSED_CLAUSE, END_SYMBOL);
405 longjmp (A68_PARSER (top_down_crash_exit), 1);
406 return NO_NODE;
407 } else {
408 make_sub (begin_p, end_p, BEGIN_SYMBOL);
409 return NEXT (begin_p);
410 }
411 }
412
413 //! @brief Make branch of CODE .. EDOC.
414
415 NODE_T *top_down_code (NODE_T * code_p)
416 {
417 NODE_T *edoc_p = top_down_series (NEXT (code_p));
418 if (edoc_p == NO_NODE || !IS (edoc_p, EDOC_SYMBOL)) {
419 diagnostic (A68_SYNTAX_ERROR, code_p, ERROR_KEYWORD);
420 longjmp (A68_PARSER (top_down_crash_exit), 1);
421 return NO_NODE;
422 } else {
423 make_sub (code_p, edoc_p, CODE_SYMBOL);
424 return NEXT (code_p);
425 }
426 }
427
428 //! @brief Make branch of ( .. ).
429
430 NODE_T *top_down_open (NODE_T * open_p)
431 {
432 NODE_T *then_bar_p = top_down_series (NEXT (open_p)), *elif_bar_p;
433 if (then_bar_p != NO_NODE && IS (then_bar_p, CLOSE_SYMBOL)) {
434 make_sub (open_p, then_bar_p, OPEN_SYMBOL);
435 return NEXT (open_p);
436 }
437 if (then_bar_p == NO_NODE || !IS (then_bar_p, THEN_BAR_SYMBOL)) {
438 top_down_diagnose (open_p, then_bar_p, ENCLOSED_CLAUSE, STOP);
439 longjmp (A68_PARSER (top_down_crash_exit), 1);
440 }
441 make_sub (open_p, PREVIOUS (then_bar_p), OPEN_SYMBOL);
442 elif_bar_p = top_down_series (NEXT (then_bar_p));
443 if (elif_bar_p != NO_NODE && IS (elif_bar_p, CLOSE_SYMBOL)) {
444 make_sub (then_bar_p, PREVIOUS (elif_bar_p), THEN_BAR_SYMBOL);
445 make_sub (open_p, elif_bar_p, OPEN_SYMBOL);
446 return NEXT (open_p);
447 }
448 if (elif_bar_p != NO_NODE && IS (elif_bar_p, THEN_BAR_SYMBOL)) {
449 NODE_T *close_p = top_down_series (NEXT (elif_bar_p));
450 if (close_p == NO_NODE || !IS (close_p, CLOSE_SYMBOL)) {
451 top_down_diagnose (open_p, elif_bar_p, ENCLOSED_CLAUSE, CLOSE_SYMBOL);
452 longjmp (A68_PARSER (top_down_crash_exit), 1);
453 }
454 make_sub (then_bar_p, PREVIOUS (elif_bar_p), THEN_BAR_SYMBOL);
455 make_sub (elif_bar_p, PREVIOUS (close_p), THEN_BAR_SYMBOL);
456 make_sub (open_p, close_p, OPEN_SYMBOL);
457 return NEXT (open_p);
458 }
459 if (elif_bar_p != NO_NODE && IS (elif_bar_p, ELSE_BAR_SYMBOL)) {
460 NODE_T *close_p = top_down_open (elif_bar_p);
461 make_sub (then_bar_p, PREVIOUS (elif_bar_p), THEN_BAR_SYMBOL);
462 make_sub (open_p, elif_bar_p, OPEN_SYMBOL);
463 return close_p;
464 } else {
465 top_down_diagnose (open_p, elif_bar_p, ENCLOSED_CLAUSE, CLOSE_SYMBOL);
466 longjmp (A68_PARSER (top_down_crash_exit), 1);
467 return NO_NODE;
468 }
469 }
470
471 //! @brief Make branch of [ .. ].
472
473 NODE_T *top_down_sub (NODE_T * sub_p)
474 {
475 NODE_T *bus_p = top_down_series (NEXT (sub_p));
476 if (bus_p != NO_NODE && IS (bus_p, BUS_SYMBOL)) {
477 make_sub (sub_p, bus_p, SUB_SYMBOL);
478 return NEXT (sub_p);
479 } else {
480 top_down_diagnose (sub_p, bus_p, 0, BUS_SYMBOL);
481 longjmp (A68_PARSER (top_down_crash_exit), 1);
482 return NO_NODE;
483 }
484 }
485
486 //! @brief Make branch of { .. }.
487
488 NODE_T *top_down_acco (NODE_T * acco_p)
489 {
490 NODE_T *occa_p = top_down_series (NEXT (acco_p));
491 if (occa_p != NO_NODE && IS (occa_p, OCCA_SYMBOL)) {
492 make_sub (acco_p, occa_p, ACCO_SYMBOL);
493 return NEXT (acco_p);
494 } else {
495 top_down_diagnose (acco_p, occa_p, ENCLOSED_CLAUSE, OCCA_SYMBOL);
496 longjmp (A68_PARSER (top_down_crash_exit), 1);
497 return NO_NODE;
498 }
499 }
500
501 //! @brief Make branch of IF .. THEN .. ELSE .. FI.
502
503 NODE_T *top_down_if (NODE_T * if_p)
504 {
505 NODE_T *then_p = top_down_series (NEXT (if_p)), *elif_p;
506 if (then_p == NO_NODE || !IS (then_p, THEN_SYMBOL)) {
507 top_down_diagnose (if_p, then_p, CONDITIONAL_CLAUSE, THEN_SYMBOL);
508 longjmp (A68_PARSER (top_down_crash_exit), 1);
509 }
510 make_sub (if_p, PREVIOUS (then_p), IF_SYMBOL);
511 elif_p = top_down_series (NEXT (then_p));
512 if (elif_p != NO_NODE && IS (elif_p, FI_SYMBOL)) {
513 make_sub (then_p, PREVIOUS (elif_p), THEN_SYMBOL);
514 make_sub (if_p, elif_p, IF_SYMBOL);
515 return NEXT (if_p);
516 }
517 if (elif_p != NO_NODE && IS (elif_p, ELSE_SYMBOL)) {
518 NODE_T *fi_p = top_down_series (NEXT (elif_p));
519 if (fi_p == NO_NODE || !IS (fi_p, FI_SYMBOL)) {
520 top_down_diagnose (if_p, fi_p, CONDITIONAL_CLAUSE, FI_SYMBOL);
521 longjmp (A68_PARSER (top_down_crash_exit), 1);
522 } else {
523 make_sub (then_p, PREVIOUS (elif_p), THEN_SYMBOL);
524 make_sub (elif_p, PREVIOUS (fi_p), ELSE_SYMBOL);
525 make_sub (if_p, fi_p, IF_SYMBOL);
526 return NEXT (if_p);
527 }
528 }
529 if (elif_p != NO_NODE && IS (elif_p, ELIF_SYMBOL)) {
530 NODE_T *fi_p = top_down_if (elif_p);
531 make_sub (then_p, PREVIOUS (elif_p), THEN_SYMBOL);
532 make_sub (if_p, elif_p, IF_SYMBOL);
533 return fi_p;
534 } else {
535 top_down_diagnose (if_p, elif_p, CONDITIONAL_CLAUSE, FI_SYMBOL);
536 longjmp (A68_PARSER (top_down_crash_exit), 1);
537 return NO_NODE;
538 }
539 }
540
541 //! @brief Make branch of CASE .. IN .. OUT .. ESAC.
542
543 NODE_T *top_down_case (NODE_T * case_p)
544 {
545 NODE_T *in_p = top_down_series (NEXT (case_p)), *ouse_p;
546 if (in_p == NO_NODE || !IS (in_p, IN_SYMBOL)) {
547 top_down_diagnose (case_p, in_p, ENCLOSED_CLAUSE, IN_SYMBOL);
548 longjmp (A68_PARSER (top_down_crash_exit), 1);
549 }
550 make_sub (case_p, PREVIOUS (in_p), CASE_SYMBOL);
551 ouse_p = top_down_series (NEXT (in_p));
552 if (ouse_p != NO_NODE && IS (ouse_p, ESAC_SYMBOL)) {
553 make_sub (in_p, PREVIOUS (ouse_p), IN_SYMBOL);
554 make_sub (case_p, ouse_p, CASE_SYMBOL);
555 return NEXT (case_p);
556 }
557 if (ouse_p != NO_NODE && IS (ouse_p, OUT_SYMBOL)) {
558 NODE_T *esac_p = top_down_series (NEXT (ouse_p));
559 if (esac_p == NO_NODE || !IS (esac_p, ESAC_SYMBOL)) {
560 top_down_diagnose (case_p, esac_p, ENCLOSED_CLAUSE, ESAC_SYMBOL);
561 longjmp (A68_PARSER (top_down_crash_exit), 1);
562 } else {
563 make_sub (in_p, PREVIOUS (ouse_p), IN_SYMBOL);
564 make_sub (ouse_p, PREVIOUS (esac_p), OUT_SYMBOL);
565 make_sub (case_p, esac_p, CASE_SYMBOL);
566 return NEXT (case_p);
567 }
568 }
569 if (ouse_p != NO_NODE && IS (ouse_p, OUSE_SYMBOL)) {
570 NODE_T *esac_p = top_down_case (ouse_p);
571 make_sub (in_p, PREVIOUS (ouse_p), IN_SYMBOL);
572 make_sub (case_p, ouse_p, CASE_SYMBOL);
573 return esac_p;
574 } else {
575 top_down_diagnose (case_p, ouse_p, ENCLOSED_CLAUSE, ESAC_SYMBOL);
576 longjmp (A68_PARSER (top_down_crash_exit), 1);
577 return NO_NODE;
578 }
579 }
580
581 //! @brief Skip a unit.
582
583 NODE_T *top_down_skip_unit (NODE_T * p)
584 {
585 while (p != NO_NODE && !is_unit_terminator (p)) {
586 if (IS (p, BEGIN_SYMBOL)) {
587 p = top_down_begin (p);
588 } else if (IS (p, SUB_SYMBOL)) {
589 p = top_down_sub (p);
590 } else if (IS (p, OPEN_SYMBOL)) {
591 p = top_down_open (p);
592 } else if (IS (p, IF_SYMBOL)) {
593 p = top_down_if (p);
594 } else if (IS (p, CASE_SYMBOL)) {
595 p = top_down_case (p);
596 } else if (IS (p, CODE_SYMBOL)) {
597 p = top_down_code (p);
598 } else if (IS (p, ACCO_SYMBOL)) {
599 p = top_down_acco (p);
600 } else {
601 FORWARD (p);
602 }
603 }
604 return p;
605 }
606
607 NODE_T *top_down_skip_format (NODE_T *);
608
609 //! @brief Make branch of ( .. ) in a format.
610
611 NODE_T *top_down_format_open (NODE_T * open_p)
612 {
613 NODE_T *close_p = top_down_skip_format (NEXT (open_p));
614 if (close_p != NO_NODE && IS (close_p, FORMAT_CLOSE_SYMBOL)) {
615 make_sub (open_p, close_p, FORMAT_OPEN_SYMBOL);
616 return NEXT (open_p);
617 } else {
618 top_down_diagnose (open_p, close_p, 0, FORMAT_CLOSE_SYMBOL);
619 longjmp (A68_PARSER (top_down_crash_exit), 1);
620 return NO_NODE;
621 }
622 }
623
624 //! @brief Skip a format text.
625
626 NODE_T *top_down_skip_format (NODE_T * p)
627 {
628 while (p != NO_NODE) {
629 if (IS (p, FORMAT_OPEN_SYMBOL)) {
630 p = top_down_format_open (p);
631 } else if (is_one_of (p, FORMAT_CLOSE_SYMBOL, FORMAT_DELIMITER_SYMBOL, STOP)) {
632 return p;
633 } else {
634 FORWARD (p);
635 }
636 }
637 return NO_NODE;
638 }
639
640 //! @brief Make branch of $ .. $.
641
642 void top_down_formats (NODE_T * p)
643 {
644 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
645 if (SUB (q) != NO_NODE) {
646 top_down_formats (SUB (q));
647 }
648 }
649 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
650 if (IS (q, FORMAT_DELIMITER_SYMBOL)) {
651 NODE_T *f = NEXT (q);
652 while (f != NO_NODE && !IS (f, FORMAT_DELIMITER_SYMBOL)) {
653 if (IS (f, FORMAT_OPEN_SYMBOL)) {
654 f = top_down_format_open (f);
655 } else {
656 f = NEXT (f);
657 }
658 }
659 if (f == NO_NODE) {
660 top_down_diagnose (p, f, FORMAT_TEXT, FORMAT_DELIMITER_SYMBOL);
661 longjmp (A68_PARSER (top_down_crash_exit), 1);
662 } else {
663 make_sub (q, f, FORMAT_DELIMITER_SYMBOL);
664 }
665 }
666 }
667 }
668
669 //! @brief Make branches of phrases for the bottom-up parser.
670
671 void top_down_parser (NODE_T * p)
672 {
673 if (p != NO_NODE) {
674 if (!setjmp (A68_PARSER (top_down_crash_exit))) {
675 (void) top_down_series (p);
676 top_down_loops (p);
677 top_down_untils (p);
678 top_down_formats (p);
679 }
680 }
681 }
