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