parser-bottom-up.c
1 //! @file parser-bottom-up.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 //! Hand-coded bottom-up parser for Algol 68.
25
26 // This code constitutes an effective "Algol 68 VW parser"; a pragmatic
27 // approach was chosen since in the early days of Algol 68, many "ab initio"
28 // implementations failed.
29 //
30 // This is a Mailloux-type parser, in the sense that it scans a "phrase" for
31 // definitions needed for parsing, and therefore allows for tags to be used
32 // before they are defined, which gives some freedom in top-down programming.
33 //
34 // B. J. Mailloux. On the implementation of Algol 68.
35 // Thesis, Universiteit van Amsterdam (Mathematisch Centrum) [1968].
36 //
37 // Technically, Mailloux's approach renders the two-level grammar LALR.
38 //
39 // This is the bottom-up parser that resolves the structure of the program.
40
41 #include "a68g.h"
42 #include "a68g-parser.h"
43 #include "a68g-prelude.h"
44
45 // Bottom-up parser, reduces all constructs.
46
47 //! @brief Whether a series is serial or collateral.
48
49 int serial_or_collateral (NODE_T * p)
50 {
51 int semis = 0, commas = 0, exits = 0;
52 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
53 if (IS (q, COMMA_SYMBOL)) {
54 commas++;
55 } else if (IS (q, SEMI_SYMBOL)) {
56 semis++;
57 } else if (IS (q, EXIT_SYMBOL)) {
58 exits++;
59 }
60 }
61 if (semis == 0 && exits == 0 && commas > 0) {
62 return COLLATERAL_CLAUSE;
63 } else if ((semis > 0 || exits > 0) && commas == 0) {
64 return SERIAL_CLAUSE;
65 } else if (semis == 0 && exits == 0 && commas == 0) {
66 return SERIAL_CLAUSE;
67 } else {
68 // Heuristic guess to give intelligible error message.
69 return (semis + exits) >= (commas ? SERIAL_CLAUSE : COLLATERAL_CLAUSE);
70 }
71 }
72
73 //! @brief Insert a node with attribute "a" after "p".
74
75 void pad_node (NODE_T * p, int a)
76 {
77 // This is used to fill information that Algol 68 does not require to be present.
78 // Filling in gives one format for such construct; this helps later passes.
79 NODE_T *z = new_node ();
80 *z = *p;
81 if (GINFO (p) != NO_GINFO) {
82 GINFO (z) = new_genie_info ();
83 }
84 PREVIOUS (z) = p;
85 SUB (z) = NO_NODE;
86 ATTRIBUTE (z) = a;
87 MOID (z) = NO_MOID;
88 if (NEXT (z) != NO_NODE) {
89 PREVIOUS (NEXT (z)) = z;
90 }
91 NEXT (p) = z;
92 }
93
94 //! @brief Diagnose extensions.
95
96 void a68_extension (NODE_T * p)
97 {
98 if (OPTION_PORTCHECK (&A68_JOB)) {
99 diagnostic (A68_WARNING | A68_FORCE_DIAGNOSTICS, p, WARNING_EXTENSION);
100 } else {
101 diagnostic (A68_WARNING, p, WARNING_EXTENSION);
102 }
103 }
104
105 //! @brief Diagnose for clauses not yielding a value.
106
107 void empty_clause (NODE_T * p)
108 {
109 diagnostic (A68_SYNTAX_ERROR, p, ERROR_CLAUSE_WITHOUT_VALUE);
110 }
111
112 #if !defined (BUILD_PARALLEL_CLAUSE)
113
114 //! @brief Diagnose for parallel clause.
115
116 void par_clause (NODE_T * p)
117 {
118 diagnostic (A68_SYNTAX_ERROR, p, ERROR_NO_PARALLEL_CLAUSE);
119 }
120
121 #endif
122
123 //! @brief Diagnose for missing symbol.
124
125 void strange_tokens (NODE_T * p)
126 {
127 NODE_T *q = ((p != NO_NODE && NEXT (p) != NO_NODE) ? NEXT (p) : p);
128 diagnostic (A68_SYNTAX_ERROR, q, ERROR_SYNTAX_STRANGE_TOKENS);
129 }
130
131 //! @brief Diagnose for strange separator.
132
133 void strange_separator (NODE_T * p)
134 {
135 NODE_T *q = ((p != NO_NODE && NEXT (p) != NO_NODE) ? NEXT (p) : p);
136 diagnostic (A68_SYNTAX_ERROR, q, ERROR_SYNTAX_STRANGE_SEPARATOR);
137 }
138
139 //! @brief If match then reduce a sentence, the core BU parser routine.
140
141 void reduce (NODE_T * p, void (*a) (NODE_T *), BOOL_T * z, ...)
142 {
143 va_list list;
144 va_start (list, z);
145 int result = va_arg (list, int), expect;
146 NODE_T *head = p, *tail = NO_NODE;
147 while ((expect = va_arg (list, int)) != STOP)
148 {
149 BOOL_T keep_matching;
150 if (p == NO_NODE) {
151 keep_matching = A68_FALSE;
152 } else if (expect == WILDCARD) {
153 // WILDCARD matches any Algol68G non terminal, but no keyword.
154 keep_matching = (BOOL_T) (non_terminal_string (A68 (edit_line), ATTRIBUTE (p)) != NO_TEXT);
155 } else {
156 if (expect == SKIP) {
157 // Stray "~" matches expected SKIP.
158 if (IS (p, OPERATOR) && IS_LITERALLY (p, "~")) {
159 ATTRIBUTE (p) = SKIP;
160 }
161 }
162 if (expect >= 0) {
163 keep_matching = (BOOL_T) (expect == ATTRIBUTE (p));
164 } else {
165 keep_matching = (BOOL_T) (expect != ATTRIBUTE (p));
166 }
167 }
168 if (keep_matching) {
169 tail = p;
170 FORWARD (p);
171 } else {
172 va_end (list);
173 return;
174 }
175 }
176 // Print parser reductions.
177 if (head != NO_NODE && OPTION_REDUCTIONS (&A68_JOB) && LINE_NUMBER (head) > 0) {
178 A68_PARSER (reductions)++;
179 WIS (head);
180 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "\nReduction %d: %s<-", A68_PARSER (reductions), non_terminal_string (A68 (edit_line), result)) >= 0);
181 WRITE (A68_STDOUT, A68 (output_line));
182 int count = 0;
183 for (NODE_T *q = head; q != NO_NODE && tail != NO_NODE && q != NEXT (tail); FORWARD (q), count++) {
184 int gatt = ATTRIBUTE (q);
185 char *str = non_terminal_string (A68 (input_line), gatt);
186 if (count > 0) {
187 WRITE (A68_STDOUT, ", ");
188 }
189 if (str != NO_TEXT) {
190 WRITE (A68_STDOUT, str);
191 if (gatt == IDENTIFIER || gatt == OPERATOR || gatt == DENOTATION || gatt == INDICANT) {
192 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, " \"%s\"", NSYMBOL (q)) >= 0);
193 WRITE (A68_STDOUT, A68 (output_line));
194 }
195 } else {
196 WRITE (A68_STDOUT, NSYMBOL (q));
197 }
198 }
199 }
200 // Make reduction.
201 if (a != NO_NOTE) {
202 a (head);
203 }
204 make_sub (head, tail, result);
205 va_end (list);
206 if (z != NO_TICK) {
207 *z = A68_TRUE;
208 }
209 }
210
211 //! @brief Graciously ignore extra semicolons.
212
213 void ignore_superfluous_semicolons (NODE_T * p)
214 {
215 // This routine relaxes the parser a bit with respect to superfluous semicolons,
216 // for instance "FI; OD". These provoke only a warning.
217 for (; p != NO_NODE; FORWARD (p)) {
218 ignore_superfluous_semicolons (SUB (p));
219 if (NEXT (p) != NO_NODE && IS (NEXT (p), SEMI_SYMBOL) && NEXT_NEXT (p) == NO_NODE) {
220 diagnostic (A68_WARNING | A68_FORCE_DIAGNOSTICS, NEXT (p), WARNING_SKIPPED_SUPERFLUOUS, ATTRIBUTE (NEXT (p)));
221 NEXT (p) = NO_NODE;
222 } else if (IS (p, SEMI_SYMBOL) && is_semicolon_less (NEXT (p))) {
223 diagnostic (A68_WARNING | A68_FORCE_DIAGNOSTICS, p, WARNING_SKIPPED_SUPERFLUOUS, ATTRIBUTE (p));
224 if (PREVIOUS (p) != NO_NODE) {
225 NEXT (PREVIOUS (p)) = NEXT (p);
226 }
227 PREVIOUS (NEXT (p)) = PREVIOUS (p);
228 }
229 }
230 }
231
232 //! @brief Driver for the bottom-up parser.
233
234 void bottom_up_parser (NODE_T * p)
235 {
236 if (p != NO_NODE) {
237 if (!setjmp (A68_PARSER (bottom_up_crash_exit))) {
238 NODE_T *q;
239 int error_count_0 = ERROR_COUNT (&A68_JOB);
240 ignore_superfluous_semicolons (p);
241 // A program is "label sequence; particular program".
242 extract_labels (p, SERIAL_CLAUSE);
243 // Parse the program itself.
244 for (q = p; q != NO_NODE; FORWARD (q)) {
245 BOOL_T siga = A68_TRUE;
246 if (SUB (q) != NO_NODE) {
247 reduce_branch (q, SOME_CLAUSE);
248 }
249 while (siga) {
250 siga = A68_FALSE;
251 reduce (q, NO_NOTE, &siga, LABEL, DEFINING_IDENTIFIER, COLON_SYMBOL, STOP);
252 reduce (q, NO_NOTE, &siga, LABEL, LABEL, DEFINING_IDENTIFIER, COLON_SYMBOL, STOP);
253 }
254 }
255 // Determine the encompassing enclosed clause.
256 for (q = p; q != NO_NODE; FORWARD (q)) {
257 #if defined (BUILD_PARALLEL_CLAUSE)
258 reduce (q, NO_NOTE, NO_TICK, PARALLEL_CLAUSE, PAR_SYMBOL, COLLATERAL_CLAUSE, STOP);
259 #else
260 reduce (q, par_clause, NO_TICK, PARALLEL_CLAUSE, PAR_SYMBOL, COLLATERAL_CLAUSE, STOP);
261 #endif
262 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, PARALLEL_CLAUSE, STOP);
263 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CLOSED_CLAUSE, STOP);
264 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, COLLATERAL_CLAUSE, STOP);
265 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONDITIONAL_CLAUSE, STOP);
266 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CASE_CLAUSE, STOP);
267 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONFORMITY_CLAUSE, STOP);
268 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, LOOP_CLAUSE, STOP);
269 }
270 // Try reducing the particular program.
271 q = p;
272 reduce (q, NO_NOTE, NO_TICK, PARTICULAR_PROGRAM, LABEL, ENCLOSED_CLAUSE, STOP);
273 reduce (q, NO_NOTE, NO_TICK, PARTICULAR_PROGRAM, ENCLOSED_CLAUSE, STOP);
274 if (SUB (p) == NO_NODE || NEXT (p) != NO_NODE) {
275 recover_from_error (p, PARTICULAR_PROGRAM, (BOOL_T) ((ERROR_COUNT (&A68_JOB) - error_count_0) > MAX_ERRORS));
276 }
277 }
278 }
279 }
280
281 //! @brief Reduce code clause.
282
283 void reduce_code_clause (NODE_T * p)
284 {
285 BOOL_T siga = A68_TRUE;
286 while (siga) {
287 siga = A68_FALSE;
288 for (NODE_T *u = p; u != NO_NODE; FORWARD (u)) {
289 reduce (u, NO_NOTE, &siga, CODE_LIST, CODE_SYMBOL, ROW_CHAR_DENOTATION, STOP);
290 reduce (u, NO_NOTE, &siga, CODE_LIST, CODE_LIST, ROW_CHAR_DENOTATION, STOP);
291 reduce (u, NO_NOTE, &siga, CODE_LIST, CODE_LIST, COMMA_SYMBOL, ROW_CHAR_DENOTATION, STOP);
292 reduce (u, NO_NOTE, &siga, CODE_CLAUSE, CODE_LIST, EDOC_SYMBOL, STOP);
293 }
294 }
295 }
296
297 //! @brief Reduce the sub-phrase that starts one level down.
298
299 void reduce_branch (NODE_T * q, int expect)
300 {
301 // If unsuccessful then the routine will at least copy the resulting attribute
302 // as the parser can repair some faults. This gives less spurious diagnostics.
303 if (q != NO_NODE && SUB (q) != NO_NODE) {
304 NODE_T *p = SUB (q), *u = NO_NODE;
305 int error_count_0 = ERROR_COUNT (&A68_JOB), error_count_02;
306 BOOL_T declarer_pack = A68_FALSE, no_error;
307 switch (expect) {
308 case STRUCTURE_PACK:
309 case PARAMETER_PACK:
310 case FORMAL_DECLARERS:
311 case UNION_PACK:
312 case SPECIFIER: {
313 declarer_pack = A68_TRUE;
314 }
315 default: {
316 declarer_pack = A68_FALSE;
317 }
318 }
319 // Sample all info needed to decide whether a bold tag is operator or indicant.
320 // Find the meaning of bold tags and quit in case of extra errors.
321 extract_indicants (p);
322 if (!declarer_pack) {
323 extract_priorities (p);
324 extract_operators (p);
325 }
326 error_count_02 = ERROR_COUNT (&A68_JOB);
327 elaborate_bold_tags (p);
328 if ((ERROR_COUNT (&A68_JOB) - error_count_02) > 0) {
329 longjmp (A68_PARSER (bottom_up_crash_exit), 1);
330 }
331 // Now we can reduce declarers, knowing which bold tags are indicants.
332 reduce_declarers (p, expect);
333 // Parse the phrase, as appropriate.
334 if (expect == CODE_CLAUSE) {
335 reduce_code_clause (p);
336 } else if (declarer_pack == A68_FALSE) {
337 error_count_02 = ERROR_COUNT (&A68_JOB);
338 extract_declarations (p);
339 if ((ERROR_COUNT (&A68_JOB) - error_count_02) > 0) {
340 longjmp (A68_PARSER (bottom_up_crash_exit), 1);
341 }
342 extract_labels (p, expect);
343 for (u = p; u != NO_NODE; FORWARD (u)) {
344 if (SUB (u) != NO_NODE) {
345 if (IS (u, FORMAT_DELIMITER_SYMBOL)) {
346 reduce_branch (u, FORMAT_TEXT);
347 } else if (IS (u, FORMAT_OPEN_SYMBOL)) {
348 reduce_branch (u, FORMAT_TEXT);
349 } else if (IS (u, OPEN_SYMBOL)) {
350 if (NEXT (u) != NO_NODE && IS (NEXT (u), THEN_BAR_SYMBOL)) {
351 reduce_branch (u, ENQUIRY_CLAUSE);
352 } else if (PREVIOUS (u) != NO_NODE && IS (PREVIOUS (u), PAR_SYMBOL)) {
353 reduce_branch (u, COLLATERAL_CLAUSE);
354 }
355 } else if (is_one_of (u, IF_SYMBOL, ELIF_SYMBOL, CASE_SYMBOL, OUSE_SYMBOL, WHILE_SYMBOL, UNTIL_SYMBOL, ELSE_BAR_SYMBOL, ACCO_SYMBOL, STOP)) {
356 reduce_branch (u, ENQUIRY_CLAUSE);
357 } else if (IS (u, BEGIN_SYMBOL)) {
358 reduce_branch (u, SOME_CLAUSE);
359 } else if (is_one_of (u, THEN_SYMBOL, ELSE_SYMBOL, OUT_SYMBOL, DO_SYMBOL, ALT_DO_SYMBOL, STOP)) {
360 reduce_branch (u, SERIAL_CLAUSE);
361 } else if (IS (u, IN_SYMBOL)) {
362 reduce_branch (u, COLLATERAL_CLAUSE);
363 } else if (IS (u, THEN_BAR_SYMBOL)) {
364 reduce_branch (u, SOME_CLAUSE);
365 } else if (IS (u, LOOP_CLAUSE)) {
366 reduce_branch (u, ENCLOSED_CLAUSE);
367 } else if (is_one_of (u, FOR_SYMBOL, FROM_SYMBOL, BY_SYMBOL, TO_SYMBOL, DOWNTO_SYMBOL, STOP)) {
368 reduce_branch (u, UNIT);
369 }
370 }
371 }
372 reduce_primary_parts (p, expect);
373 if (expect != ENCLOSED_CLAUSE) {
374 reduce_primaries (p, expect);
375 if (expect == FORMAT_TEXT) {
376 reduce_format_texts (p);
377 } else {
378 reduce_secondaries (p);
379 reduce_formulae (p);
380 reduce_tertiaries (p);
381 }
382 }
383 for (u = p; u != NO_NODE; FORWARD (u)) {
384 if (SUB (u) != NO_NODE) {
385 if (IS (u, CODE_SYMBOL)) {
386 reduce_branch (u, CODE_CLAUSE);
387 }
388 }
389 }
390 reduce_right_to_left_constructs (p);
391 // Reduce units and declarations.
392 reduce_basic_declarations (p);
393 reduce_units (p);
394 reduce_erroneous_units (p);
395 if (expect != UNIT) {
396 if (expect == GENERIC_ARGUMENT) {
397 reduce_generic_arguments (p);
398 } else if (expect == BOUNDS) {
399 reduce_bounds (p);
400 } else {
401 reduce_declaration_lists (p);
402 if (expect != DECLARATION_LIST) {
403 for (u = p; u != NO_NODE; FORWARD (u)) {
404 reduce (u, NO_NOTE, NO_TICK, LABELED_UNIT, LABEL, UNIT, STOP);
405 reduce (u, NO_NOTE, NO_TICK, SPECIFIED_UNIT, SPECIFIER, COLON_SYMBOL, UNIT, STOP);
406 }
407 if (expect == SOME_CLAUSE) {
408 expect = serial_or_collateral (p);
409 }
410 if (expect == SERIAL_CLAUSE) {
411 reduce_serial_clauses (p);
412 } else if (expect == ENQUIRY_CLAUSE) {
413 reduce_enquiry_clauses (p);
414 } else if (expect == COLLATERAL_CLAUSE) {
415 reduce_collateral_clauses (p);
416 } else if (expect == ARGUMENT) {
417 reduce_arguments (p);
418 }
419 }
420 }
421 }
422 reduce_enclosed_clauses (p, expect);
423 }
424 // Do something if parsing failed.
425 if (SUB (p) == NO_NODE || NEXT (p) != NO_NODE) {
426 recover_from_error (p, expect, (BOOL_T) ((ERROR_COUNT (&A68_JOB) - error_count_0) > MAX_ERRORS));
427 no_error = A68_FALSE;
428 } else {
429 no_error = A68_TRUE;
430 }
431 ATTRIBUTE (q) = ATTRIBUTE (p);
432 if (no_error) {
433 SUB (q) = SUB (p);
434 }
435 }
436 }
437
438 //! @brief Driver for reducing declarers.
439
440 void reduce_declarers (NODE_T * p, int expect)
441 {
442 NODE_T *q; BOOL_T siga; // Must be in this scope.
443 // Reduce lengtheties.
444 for (q = p; q != NO_NODE; FORWARD (q)) {
445 siga = A68_TRUE;
446 reduce (q, NO_NOTE, NO_TICK, LONGETY, LONG_SYMBOL, STOP);
447 reduce (q, NO_NOTE, NO_TICK, SHORTETY, SHORT_SYMBOL, STOP);
448 while (siga) {
449 siga = A68_FALSE;
450 reduce (q, NO_NOTE, &siga, LONGETY, LONGETY, LONG_SYMBOL, STOP);
451 reduce (q, NO_NOTE, &siga, SHORTETY, SHORTETY, SHORT_SYMBOL, STOP);
452 }
453 }
454 // Reduce indicants.
455 for (q = p; q != NO_NODE; FORWARD (q)) {
456 reduce (q, NO_NOTE, NO_TICK, INDICANT, INT_SYMBOL, STOP);
457 reduce (q, NO_NOTE, NO_TICK, INDICANT, REAL_SYMBOL, STOP);
458 reduce (q, NO_NOTE, NO_TICK, INDICANT, BITS_SYMBOL, STOP);
459 reduce (q, NO_NOTE, NO_TICK, INDICANT, BYTES_SYMBOL, STOP);
460 reduce (q, NO_NOTE, NO_TICK, INDICANT, COMPLEX_SYMBOL, STOP);
461 reduce (q, NO_NOTE, NO_TICK, INDICANT, COMPL_SYMBOL, STOP);
462 reduce (q, NO_NOTE, NO_TICK, INDICANT, BOOL_SYMBOL, STOP);
463 reduce (q, NO_NOTE, NO_TICK, INDICANT, CHAR_SYMBOL, STOP);
464 reduce (q, NO_NOTE, NO_TICK, INDICANT, FORMAT_SYMBOL, STOP);
465 reduce (q, NO_NOTE, NO_TICK, INDICANT, STRING_SYMBOL, STOP);
466 reduce (q, NO_NOTE, NO_TICK, INDICANT, FILE_SYMBOL, STOP);
467 reduce (q, NO_NOTE, NO_TICK, INDICANT, CHANNEL_SYMBOL, STOP);
468 reduce (q, NO_NOTE, NO_TICK, INDICANT, SEMA_SYMBOL, STOP);
469 reduce (q, NO_NOTE, NO_TICK, INDICANT, PIPE_SYMBOL, STOP);
470 reduce (q, NO_NOTE, NO_TICK, INDICANT, SOUND_SYMBOL, STOP);
471 }
472 // Reduce standard stuff.
473 for (q = p; q != NO_NODE; FORWARD (q)) {
474 if (whether (q, LONGETY, INDICANT, STOP)) {
475 int a;
476 if (SUB_NEXT (q) == NO_NODE) {
477 diagnostic (A68_SYNTAX_ERROR, NEXT (q), ERROR_EXPECTED, INFO_APPROPRIATE_DECLARER);
478 reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP);
479 } else {
480 a = ATTRIBUTE (SUB_NEXT (q));
481 if (a == INT_SYMBOL || a == REAL_SYMBOL || a == BITS_SYMBOL || a == BYTES_SYMBOL || a == COMPLEX_SYMBOL || a == COMPL_SYMBOL) {
482 reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP);
483 } else {
484 diagnostic (A68_SYNTAX_ERROR, NEXT (q), ERROR_EXPECTED, INFO_APPROPRIATE_DECLARER);
485 reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP);
486 }
487 }
488 } else if (whether (q, SHORTETY, INDICANT, STOP)) {
489 int a;
490 if (SUB_NEXT (q) == NO_NODE) {
491 diagnostic (A68_SYNTAX_ERROR, NEXT (q), ERROR_EXPECTED, INFO_APPROPRIATE_DECLARER);
492 reduce (q, NO_NOTE, NO_TICK, DECLARER, SHORTETY, INDICANT, STOP);
493 } else {
494 a = ATTRIBUTE (SUB_NEXT (q));
495 if (a == INT_SYMBOL || a == REAL_SYMBOL || a == BITS_SYMBOL || a == BYTES_SYMBOL || a == COMPLEX_SYMBOL || a == COMPL_SYMBOL) {
496 reduce (q, NO_NOTE, NO_TICK, DECLARER, SHORTETY, INDICANT, STOP);
497 } else {
498 diagnostic (A68_SYNTAX_ERROR, NEXT (q), ERROR_EXPECTED, INFO_APPROPRIATE_DECLARER);
499 reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP);
500 }
501 }
502 }
503 }
504 for (q = p; q != NO_NODE; FORWARD (q)) {
505 reduce (q, NO_NOTE, NO_TICK, DECLARER, INDICANT, STOP);
506 }
507 // Reduce declarer lists.
508 for (q = p; q != NO_NODE; FORWARD (q)) {
509 if (NEXT (q) != NO_NODE && SUB_NEXT (q) != NO_NODE) {
510 if (IS (q, STRUCT_SYMBOL)) {
511 reduce_branch (NEXT (q), STRUCTURE_PACK);
512 reduce (q, NO_NOTE, NO_TICK, DECLARER, STRUCT_SYMBOL, STRUCTURE_PACK, STOP);
513 } else if (IS (q, UNION_SYMBOL)) {
514 reduce_branch (NEXT (q), UNION_PACK);
515 reduce (q, NO_NOTE, NO_TICK, DECLARER, UNION_SYMBOL, UNION_PACK, STOP);
516 } else if (IS (q, PROC_SYMBOL)) {
517 if (whether (q, PROC_SYMBOL, OPEN_SYMBOL, STOP)) {
518 if (!is_formal_bounds (SUB_NEXT (q))) {
519 reduce_branch (NEXT (q), FORMAL_DECLARERS);
520 }
521 }
522 } else if (IS (q, OP_SYMBOL)) {
523 if (whether (q, OP_SYMBOL, OPEN_SYMBOL, STOP)) {
524 if (!is_formal_bounds (SUB_NEXT (q))) {
525 reduce_branch (NEXT (q), FORMAL_DECLARERS);
526 }
527 }
528 }
529 }
530 }
531 // Reduce row, proc or op declarers.
532 siga = A68_TRUE;
533 while (siga) {
534 siga = A68_FALSE;
535 for (q = p; q != NO_NODE; FORWARD (q)) {
536 // FLEX DECL.
537 if (whether (q, FLEX_SYMBOL, DECLARER, STOP)) {
538 reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, DECLARER, STOP);
539 }
540 // FLEX [] DECL.
541 if (whether (q, FLEX_SYMBOL, SUB_SYMBOL, DECLARER, STOP) && SUB_NEXT (q) != NO_NODE) {
542 reduce_branch (NEXT (q), BOUNDS);
543 reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, BOUNDS, DECLARER, STOP);
544 reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, FORMAL_BOUNDS, DECLARER, STOP);
545 }
546 // FLEX () DECL.
547 if (whether (q, FLEX_SYMBOL, OPEN_SYMBOL, DECLARER, STOP) && SUB_NEXT (q) != NO_NODE) {
548 if (!whether (q, FLEX_SYMBOL, OPEN_SYMBOL, DECLARER, COLON_SYMBOL, STOP)) {
549 reduce_branch (NEXT (q), BOUNDS);
550 reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, BOUNDS, DECLARER, STOP);
551 reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, FORMAL_BOUNDS, DECLARER, STOP);
552 }
553 }
554 // [] DECL.
555 if (whether (q, SUB_SYMBOL, DECLARER, STOP) && SUB (q) != NO_NODE) {
556 reduce_branch (q, BOUNDS);
557 reduce (q, NO_NOTE, &siga, DECLARER, BOUNDS, DECLARER, STOP);
558 reduce (q, NO_NOTE, &siga, DECLARER, FORMAL_BOUNDS, DECLARER, STOP);
559 }
560 // () DECL.
561 if (whether (q, OPEN_SYMBOL, DECLARER, STOP) && SUB (q) != NO_NODE) {
562 if (whether (q, OPEN_SYMBOL, DECLARER, COLON_SYMBOL, STOP)) {
563 // Catch e.g. (INT i) () INT:.
564 if (is_formal_bounds (SUB (q))) {
565 reduce_branch (q, BOUNDS);
566 reduce (q, NO_NOTE, &siga, DECLARER, BOUNDS, DECLARER, STOP);
567 reduce (q, NO_NOTE, &siga, DECLARER, FORMAL_BOUNDS, DECLARER, STOP);
568 }
569 } else {
570 reduce_branch (q, BOUNDS);
571 reduce (q, NO_NOTE, &siga, DECLARER, BOUNDS, DECLARER, STOP);
572 reduce (q, NO_NOTE, &siga, DECLARER, FORMAL_BOUNDS, DECLARER, STOP);
573 }
574 }
575 }
576 // PROC DECL, PROC () DECL, OP () DECL.
577 for (q = p; q != NO_NODE; FORWARD (q)) {
578 int a = ATTRIBUTE (q);
579 if (a == REF_SYMBOL) {
580 reduce (q, NO_NOTE, &siga, DECLARER, REF_SYMBOL, DECLARER, STOP);
581 } else if (a == PROC_SYMBOL) {
582 reduce (q, NO_NOTE, &siga, DECLARER, PROC_SYMBOL, DECLARER, STOP);
583 reduce (q, NO_NOTE, &siga, DECLARER, PROC_SYMBOL, FORMAL_DECLARERS, DECLARER, STOP);
584 reduce (q, NO_NOTE, &siga, DECLARER, PROC_SYMBOL, VOID_SYMBOL, STOP);
585 reduce (q, NO_NOTE, &siga, DECLARER, PROC_SYMBOL, FORMAL_DECLARERS, VOID_SYMBOL, STOP);
586 } else if (a == OP_SYMBOL) {
587 reduce (q, NO_NOTE, &siga, OPERATOR_PLAN, OP_SYMBOL, FORMAL_DECLARERS, DECLARER, STOP);
588 reduce (q, NO_NOTE, &siga, OPERATOR_PLAN, OP_SYMBOL, FORMAL_DECLARERS, VOID_SYMBOL, STOP);
589 }
590 }
591 }
592 // Reduce packs etcetera.
593 if (expect == STRUCTURE_PACK) {
594 for (q = p; q != NO_NODE; FORWARD (q)) {
595 siga = A68_TRUE;
596 while (siga) {
597 siga = A68_FALSE;
598 reduce (q, NO_NOTE, &siga, STRUCTURED_FIELD, DECLARER, IDENTIFIER, STOP);
599 reduce (q, NO_NOTE, &siga, STRUCTURED_FIELD, STRUCTURED_FIELD, COMMA_SYMBOL, IDENTIFIER, STOP);
600 }
601 }
602 for (q = p; q != NO_NODE; FORWARD (q)) {
603 siga = A68_TRUE;
604 while (siga) {
605 siga = A68_FALSE;
606 reduce (q, NO_NOTE, &siga, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD, STOP);
607 reduce (q, NO_NOTE, &siga, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD_LIST, COMMA_SYMBOL, STRUCTURED_FIELD, STOP);
608 reduce (q, strange_separator, &siga, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD, STOP);
609 reduce (q, strange_separator, &siga, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD_LIST, SEMI_SYMBOL, STRUCTURED_FIELD, STOP);
610 }
611 }
612 q = p;
613 reduce (q, NO_NOTE, NO_TICK, STRUCTURE_PACK, OPEN_SYMBOL, STRUCTURED_FIELD_LIST, CLOSE_SYMBOL, STOP);
614 } else if (expect == PARAMETER_PACK) {
615 for (q = p; q != NO_NODE; FORWARD (q)) {
616 siga = A68_TRUE;
617 while (siga) {
618 siga = A68_FALSE;
619 reduce (q, NO_NOTE, &siga, PARAMETER, DECLARER, IDENTIFIER, STOP);
620 reduce (q, NO_NOTE, &siga, PARAMETER, PARAMETER, COMMA_SYMBOL, IDENTIFIER, STOP);
621 }
622 }
623 for (q = p; q != NO_NODE; FORWARD (q)) {
624 siga = A68_TRUE;
625 while (siga) {
626 siga = A68_FALSE;
627 reduce (q, NO_NOTE, &siga, PARAMETER_LIST, PARAMETER, STOP);
628 reduce (q, NO_NOTE, &siga, PARAMETER_LIST, PARAMETER_LIST, COMMA_SYMBOL, PARAMETER, STOP);
629 }
630 }
631 q = p;
632 reduce (q, NO_NOTE, NO_TICK, PARAMETER_PACK, OPEN_SYMBOL, PARAMETER_LIST, CLOSE_SYMBOL, STOP);
633 } else if (expect == FORMAL_DECLARERS) {
634 for (q = p; q != NO_NODE; FORWARD (q)) {
635 siga = A68_TRUE;
636 while (siga) {
637 siga = A68_FALSE;
638 reduce (q, NO_NOTE, &siga, FORMAL_DECLARERS_LIST, DECLARER, STOP);
639 reduce (q, NO_NOTE, &siga, FORMAL_DECLARERS_LIST, FORMAL_DECLARERS_LIST, COMMA_SYMBOL, DECLARER, STOP);
640 reduce (q, strange_separator, &siga, FORMAL_DECLARERS_LIST, FORMAL_DECLARERS_LIST, SEMI_SYMBOL, DECLARER, STOP);
641 reduce (q, strange_separator, &siga, FORMAL_DECLARERS_LIST, FORMAL_DECLARERS_LIST, DECLARER, STOP);
642 }
643 }
644 q = p;
645 reduce (q, NO_NOTE, NO_TICK, FORMAL_DECLARERS, OPEN_SYMBOL, FORMAL_DECLARERS_LIST, CLOSE_SYMBOL, STOP);
646 } else if (expect == UNION_PACK) {
647 for (q = p; q != NO_NODE; FORWARD (q)) {
648 siga = A68_TRUE;
649 while (siga) {
650 siga = A68_FALSE;
651 reduce (q, NO_NOTE, &siga, UNION_DECLARER_LIST, DECLARER, STOP);
652 reduce (q, NO_NOTE, &siga, UNION_DECLARER_LIST, VOID_SYMBOL, STOP);
653 reduce (q, NO_NOTE, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST, COMMA_SYMBOL, DECLARER, STOP);
654 reduce (q, NO_NOTE, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST, COMMA_SYMBOL, VOID_SYMBOL, STOP);
655 reduce (q, strange_separator, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST, SEMI_SYMBOL, DECLARER, STOP);
656 reduce (q, strange_separator, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST, SEMI_SYMBOL, VOID_SYMBOL, STOP);
657 reduce (q, strange_separator, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST, DECLARER, STOP);
658 reduce (q, strange_separator, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST, VOID_SYMBOL, STOP);
659 }
660 }
661 q = p;
662 reduce (q, NO_NOTE, NO_TICK, UNION_PACK, OPEN_SYMBOL, UNION_DECLARER_LIST, CLOSE_SYMBOL, STOP);
663 } else if (expect == SPECIFIER) {
664 reduce (p, NO_NOTE, NO_TICK, SPECIFIER, OPEN_SYMBOL, DECLARER, IDENTIFIER, CLOSE_SYMBOL, STOP);
665 reduce (p, NO_NOTE, NO_TICK, SPECIFIER, OPEN_SYMBOL, DECLARER, CLOSE_SYMBOL, STOP);
666 reduce (p, NO_NOTE, NO_TICK, SPECIFIER, OPEN_SYMBOL, VOID_SYMBOL, CLOSE_SYMBOL, STOP);
667 } else {
668 for (q = p; q != NO_NODE; FORWARD (q)) {
669 if (whether (q, OPEN_SYMBOL, COLON_SYMBOL, STOP) && !(expect == GENERIC_ARGUMENT || expect == BOUNDS)) {
670 if (is_one_of (p, IN_SYMBOL, THEN_BAR_SYMBOL, STOP)) {
671 reduce_branch (q, SPECIFIER);
672 }
673 }
674 if (whether (q, OPEN_SYMBOL, DECLARER, COLON_SYMBOL, STOP)) {
675 reduce_branch (q, PARAMETER_PACK);
676 }
677 if (whether (q, OPEN_SYMBOL, VOID_SYMBOL, COLON_SYMBOL, STOP)) {
678 reduce_branch (q, PARAMETER_PACK);
679 }
680 }
681 }
682 }
683
684 //! @brief Handle cases that need reducing from right-to-left.
685
686 void reduce_right_to_left_constructs (NODE_T * p)
687 {
688 // Here are cases that need reducing from right-to-left whereas many things
689 // can be reduced left-to-right. Assignations are a notable example; one could
690 // discuss whether it would not be more natural to write 1 =: k in stead of
691 // k := 1. The latter is said to be more natural, or it could be just computing
692 // history. Meanwhile we use this routine.
693 if (p != NO_NODE) {
694 reduce_right_to_left_constructs (NEXT (p));
695 // Assignations.
696 if (IS (p, TERTIARY)) {
697 reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, TERTIARY, STOP);
698 reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, IDENTITY_RELATION, STOP);
699 reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, AND_FUNCTION, STOP);
700 reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, OR_FUNCTION, STOP);
701 reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, ROUTINE_TEXT, STOP);
702 reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, JUMP, STOP);
703 reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, SKIP, STOP);
704 reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, ASSIGNATION, STOP);
705 reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, CODE_CLAUSE, STOP);
706 }
707 // Routine texts with parameter pack.
708 else if (IS (p, PARAMETER_PACK)) {
709 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, ASSIGNATION, STOP);
710 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, IDENTITY_RELATION, STOP);
711 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, AND_FUNCTION, STOP);
712 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, OR_FUNCTION, STOP);
713 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, JUMP, STOP);
714 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, SKIP, STOP);
715 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, TERTIARY, STOP);
716 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, ROUTINE_TEXT, STOP);
717 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, CODE_CLAUSE, STOP);
718 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, ASSIGNATION, STOP);
719 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, IDENTITY_RELATION, STOP);
720 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, AND_FUNCTION, STOP);
721 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, OR_FUNCTION, STOP);
722 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, JUMP, STOP);
723 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, SKIP, STOP);
724 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, TERTIARY, STOP);
725 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, ROUTINE_TEXT, STOP);
726 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, CODE_CLAUSE, STOP);
727 }
728 // Routine texts without parameter pack.
729 else if (IS (p, DECLARER)) {
730 if (!(PREVIOUS (p) != NO_NODE && IS (PREVIOUS (p), PARAMETER_PACK))) {
731 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, ASSIGNATION, STOP);
732 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, IDENTITY_RELATION, STOP);
733 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, AND_FUNCTION, STOP);
734 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, OR_FUNCTION, STOP);
735 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, JUMP, STOP);
736 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, SKIP, STOP);
737 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, TERTIARY, STOP);
738 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, ROUTINE_TEXT, STOP);
739 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, CODE_CLAUSE, STOP);
740 }
741 } else if (IS (p, VOID_SYMBOL)) {
742 if (!(PREVIOUS (p) != NO_NODE && IS (PREVIOUS (p), PARAMETER_PACK))) {
743 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, ASSIGNATION, STOP);
744 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, IDENTITY_RELATION, STOP);
745 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, AND_FUNCTION, STOP);
746 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, OR_FUNCTION, STOP);
747 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, JUMP, STOP);
748 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, SKIP, STOP);
749 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, TERTIARY, STOP);
750 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, ROUTINE_TEXT, STOP);
751 reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, CODE_CLAUSE, STOP);
752 }
753 }
754 }
755 }
756
757 //! @brief Reduce primary elements.
758
759 void reduce_primary_parts (NODE_T * p, int expect)
760 {
761 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
762 if (whether (q, IDENTIFIER, OF_SYMBOL, STOP)) {
763 ATTRIBUTE (q) = FIELD_IDENTIFIER;
764 }
765 reduce (q, NO_NOTE, NO_TICK, ENVIRON_NAME, ENVIRON_SYMBOL, ROW_CHAR_DENOTATION, STOP);
766 reduce (q, NO_NOTE, NO_TICK, NIHIL, NIL_SYMBOL, STOP);
767 reduce (q, NO_NOTE, NO_TICK, SKIP, SKIP_SYMBOL, STOP);
768 reduce (q, NO_NOTE, NO_TICK, SELECTOR, FIELD_IDENTIFIER, OF_SYMBOL, STOP);
769 // JUMPs without GOTO are resolved later.
770 reduce (q, NO_NOTE, NO_TICK, JUMP, GOTO_SYMBOL, IDENTIFIER, STOP);
771 reduce (q, NO_NOTE, NO_TICK, DENOTATION, LONGETY, INT_DENOTATION, STOP);
772 reduce (q, NO_NOTE, NO_TICK, DENOTATION, LONGETY, REAL_DENOTATION, STOP);
773 reduce (q, NO_NOTE, NO_TICK, DENOTATION, LONGETY, BITS_DENOTATION, STOP);
774 reduce (q, NO_NOTE, NO_TICK, DENOTATION, SHORTETY, INT_DENOTATION, STOP);
775 reduce (q, NO_NOTE, NO_TICK, DENOTATION, SHORTETY, REAL_DENOTATION, STOP);
776 reduce (q, NO_NOTE, NO_TICK, DENOTATION, SHORTETY, BITS_DENOTATION, STOP);
777 reduce (q, NO_NOTE, NO_TICK, DENOTATION, INT_DENOTATION, STOP);
778 reduce (q, NO_NOTE, NO_TICK, DENOTATION, REAL_DENOTATION, STOP);
779 reduce (q, NO_NOTE, NO_TICK, DENOTATION, BITS_DENOTATION, STOP);
780 reduce (q, NO_NOTE, NO_TICK, DENOTATION, ROW_CHAR_DENOTATION, STOP);
781 reduce (q, NO_NOTE, NO_TICK, DENOTATION, TRUE_SYMBOL, STOP);
782 reduce (q, NO_NOTE, NO_TICK, DENOTATION, FALSE_SYMBOL, STOP);
783 reduce (q, NO_NOTE, NO_TICK, DENOTATION, EMPTY_SYMBOL, STOP);
784 if (expect == SERIAL_CLAUSE || expect == ENQUIRY_CLAUSE || expect == SOME_CLAUSE) {
785 BOOL_T siga = A68_TRUE;
786 while (siga) {
787 siga = A68_FALSE;
788 reduce (q, NO_NOTE, &siga, LABEL, DEFINING_IDENTIFIER, COLON_SYMBOL, STOP);
789 reduce (q, NO_NOTE, &siga, LABEL, LABEL, DEFINING_IDENTIFIER, COLON_SYMBOL, STOP);
790 }
791 }
792 }
793 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
794 #if defined (BUILD_PARALLEL_CLAUSE)
795 reduce (q, NO_NOTE, NO_TICK, PARALLEL_CLAUSE, PAR_SYMBOL, COLLATERAL_CLAUSE, STOP);
796 #else
797 reduce (q, par_clause, NO_TICK, PARALLEL_CLAUSE, PAR_SYMBOL, COLLATERAL_CLAUSE, STOP);
798 #endif
799 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, PARALLEL_CLAUSE, STOP);
800 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CLOSED_CLAUSE, STOP);
801 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, COLLATERAL_CLAUSE, STOP);
802 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONDITIONAL_CLAUSE, STOP);
803 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CASE_CLAUSE, STOP);
804 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONFORMITY_CLAUSE, STOP);
805 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, LOOP_CLAUSE, STOP);
806 }
807 }
808
809 //! @brief Reduce primaries completely.
810
811 void reduce_primaries (NODE_T * p, int expect)
812 {
813 NODE_T *q = p;
814 while (q != NO_NODE) {
815 BOOL_T fwd = A68_TRUE, siga;
816 // Primaries excepts call and slice.
817 reduce (q, NO_NOTE, NO_TICK, PRIMARY, IDENTIFIER, STOP);
818 reduce (q, NO_NOTE, NO_TICK, PRIMARY, DENOTATION, STOP);
819 reduce (q, NO_NOTE, NO_TICK, CAST, DECLARER, ENCLOSED_CLAUSE, STOP);
820 reduce (q, NO_NOTE, NO_TICK, CAST, VOID_SYMBOL, ENCLOSED_CLAUSE, STOP);
821 reduce (q, NO_NOTE, NO_TICK, ASSERTION, ASSERT_SYMBOL, ENCLOSED_CLAUSE, STOP);
822 reduce (q, NO_NOTE, NO_TICK, PRIMARY, CAST, STOP);
823 reduce (q, NO_NOTE, NO_TICK, PRIMARY, ENCLOSED_CLAUSE, STOP);
824 reduce (q, NO_NOTE, NO_TICK, PRIMARY, FORMAT_TEXT, STOP);
825 // Call and slice.
826 siga = A68_TRUE;
827 while (siga) {
828 NODE_T *x = NEXT (q);
829 siga = A68_FALSE;
830 if (IS (q, PRIMARY) && x != NO_NODE) {
831 if (IS (x, OPEN_SYMBOL)) {
832 reduce_branch (NEXT (q), GENERIC_ARGUMENT);
833 reduce (q, NO_NOTE, &siga, SPECIFICATION, PRIMARY, GENERIC_ARGUMENT, STOP);
834 reduce (q, NO_NOTE, &siga, PRIMARY, SPECIFICATION, STOP);
835 } else if (IS (x, SUB_SYMBOL)) {
836 reduce_branch (NEXT (q), GENERIC_ARGUMENT);
837 reduce (q, NO_NOTE, &siga, SPECIFICATION, PRIMARY, GENERIC_ARGUMENT, STOP);
838 reduce (q, NO_NOTE, &siga, PRIMARY, SPECIFICATION, STOP);
839 }
840 }
841 }
842 // Now that call and slice are known, reduce remaining ( .. ).
843 if (IS (q, OPEN_SYMBOL) && SUB (q) != NO_NODE) {
844 reduce_branch (q, SOME_CLAUSE);
845 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CLOSED_CLAUSE, STOP);
846 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, COLLATERAL_CLAUSE, STOP);
847 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONDITIONAL_CLAUSE, STOP);
848 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CASE_CLAUSE, STOP);
849 reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONFORMITY_CLAUSE, STOP);
850 if (PREVIOUS (q) != NO_NODE) {
851 BACKWARD (q);
852 fwd = A68_FALSE;
853 }
854 }
855 // Format text items.
856 if (expect == FORMAT_TEXT) {
857 NODE_T *r;
858 for (r = p; r != NO_NODE; FORWARD (r)) {
859 reduce (r, NO_NOTE, NO_TICK, DYNAMIC_REPLICATOR, FORMAT_ITEM_N, ENCLOSED_CLAUSE, STOP);
860 reduce (r, NO_NOTE, NO_TICK, GENERAL_PATTERN, FORMAT_ITEM_G, ENCLOSED_CLAUSE, STOP);
861 reduce (r, NO_NOTE, NO_TICK, GENERAL_PATTERN, FORMAT_ITEM_H, ENCLOSED_CLAUSE, STOP);
862 reduce (r, NO_NOTE, NO_TICK, FORMAT_PATTERN, FORMAT_ITEM_F, ENCLOSED_CLAUSE, STOP);
863 }
864 }
865 if (fwd) {
866 FORWARD (q);
867 }
868 }
869 }
870
871 //! @brief Enforce that ambiguous patterns are separated by commas.
872
873 void ambiguous_patterns (NODE_T * p)
874 {
875 // Example: printf (($+d.2d +d.2d$, 1, 2)) can produce either "+1.00 +2.00" or
876 // "+1+002.00". A comma must be supplied to resolve the ambiguity.
877 //
878 // The obvious thing would be to weave this into the syntax, letting the BU parser
879 // sort it out. But the C-style patterns do not suffer from Algol 68 pattern
880 // ambiguity, so by solving it this way we maximise freedom in writing the patterns
881 // as we want without introducing two "kinds" of patterns, and so we have shorter
882 // routines for implementing formatted transput. This is a pragmatic system.
883 NODE_T *q, *last_pat = NO_NODE;
884 for (q = p; q != NO_NODE; FORWARD (q)) {
885 switch (ATTRIBUTE (q)) {
886 case INTEGRAL_PATTERN: // These are the potentially ambiguous patterns
887 case REAL_PATTERN:
888 case COMPLEX_PATTERN:
889 case BITS_PATTERN: {
890 if (last_pat != NO_NODE) {
891 diagnostic (A68_SYNTAX_ERROR, q, ERROR_COMMA_MUST_SEPARATE, ATTRIBUTE (last_pat), ATTRIBUTE (q));
892 }
893 last_pat = q;
894 break;
895 }
896 case COMMA_SYMBOL: {
897 last_pat = NO_NODE;
898 break;
899 }
900 }
901 }
902 }
903
904 //! @brief Reduce format texts completely.
905
906 void reduce_c_pattern (NODE_T * p, int pr, int let)
907 {
908 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
909 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, let, STOP);
910 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, FORMAT_ITEM_POINT, REPLICATOR, let, STOP);
911 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, REPLICATOR, let, STOP);
912 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, REPLICATOR, FORMAT_ITEM_POINT, REPLICATOR, let, STOP);
913 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, FORMAT_ITEM_PLUS, let, STOP);
914 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, FORMAT_ITEM_PLUS, FORMAT_ITEM_POINT, REPLICATOR, let, STOP);
915 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, FORMAT_ITEM_PLUS, REPLICATOR, let, STOP);
916 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, FORMAT_ITEM_PLUS, REPLICATOR, FORMAT_ITEM_POINT, REPLICATOR, let, STOP);
917 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, let, STOP);
918 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_POINT, REPLICATOR, let, STOP);
919 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, REPLICATOR, let, STOP);
920 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, REPLICATOR, FORMAT_ITEM_POINT, REPLICATOR, let, STOP);
921 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_PLUS, let, STOP);
922 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_PLUS, FORMAT_ITEM_POINT, REPLICATOR, let, STOP);
923 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_PLUS, REPLICATOR, let, STOP);
924 reduce (q, NO_NOTE, NO_TICK, pr, FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_PLUS, REPLICATOR, FORMAT_ITEM_POINT, REPLICATOR, let, STOP);
925 }
926 }
927
928 //! @brief Reduce format texts completely.
929
930 void reduce_format_texts (NODE_T * p)
931 {
932 // Replicators.
933 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
934 reduce (q, NO_NOTE, NO_TICK, REPLICATOR, STATIC_REPLICATOR, STOP);
935 reduce (q, NO_NOTE, NO_TICK, REPLICATOR, DYNAMIC_REPLICATOR, STOP);
936 }
937 // "OTHER" patterns.
938 reduce_c_pattern (p, BITS_C_PATTERN, FORMAT_ITEM_B);
939 reduce_c_pattern (p, BITS_C_PATTERN, FORMAT_ITEM_O);
940 reduce_c_pattern (p, BITS_C_PATTERN, FORMAT_ITEM_X);
941 reduce_c_pattern (p, CHAR_C_PATTERN, FORMAT_ITEM_C);
942 reduce_c_pattern (p, FIXED_C_PATTERN, FORMAT_ITEM_F);
943 reduce_c_pattern (p, FLOAT_C_PATTERN, FORMAT_ITEM_E);
944 reduce_c_pattern (p, GENERAL_C_PATTERN, FORMAT_ITEM_G);
945 reduce_c_pattern (p, INTEGRAL_C_PATTERN, FORMAT_ITEM_D);
946 reduce_c_pattern (p, INTEGRAL_C_PATTERN, FORMAT_ITEM_I);
947 reduce_c_pattern (p, STRING_C_PATTERN, FORMAT_ITEM_S);
948 // Radix frames.
949 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
950 reduce (q, NO_NOTE, NO_TICK, RADIX_FRAME, REPLICATOR, FORMAT_ITEM_R, STOP);
951 }
952 // Insertions.
953 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
954 reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_X, STOP);
955 reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_Y, STOP);
956 reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_L, STOP);
957 reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_P, STOP);
958 reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_Q, STOP);
959 reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_K, STOP);
960 reduce (q, NO_NOTE, NO_TICK, INSERTION, LITERAL, STOP);
961 }
962 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
963 reduce (q, NO_NOTE, NO_TICK, INSERTION, REPLICATOR, INSERTION, STOP);
964 }
965 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
966 BOOL_T siga = A68_TRUE;
967 while (siga) {
968 siga = A68_FALSE;
969 reduce (q, NO_NOTE, &siga, INSERTION, INSERTION, INSERTION, STOP);
970 }
971 }
972 // Replicated suppressible frames.
973 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
974 reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, REPLICATOR, FORMAT_ITEM_S, FORMAT_ITEM_A, STOP);
975 reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, REPLICATOR, FORMAT_ITEM_S, FORMAT_ITEM_Z, STOP);
976 reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, REPLICATOR, FORMAT_ITEM_S, FORMAT_ITEM_D, STOP);
977 }
978 // Suppressible frames.
979 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
980 reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_A, STOP);
981 reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_Z, STOP);
982 reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_D, STOP);
983 reduce (q, NO_NOTE, NO_TICK, FORMAT_E_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_E, STOP);
984 reduce (q, NO_NOTE, NO_TICK, FORMAT_POINT_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_POINT, STOP);
985 reduce (q, NO_NOTE, NO_TICK, FORMAT_I_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_I, STOP);
986 }
987 // Replicated frames.
988 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
989 reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, REPLICATOR, FORMAT_ITEM_A, STOP);
990 reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, REPLICATOR, FORMAT_ITEM_Z, STOP);
991 reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, REPLICATOR, FORMAT_ITEM_D, STOP);
992 }
993 // Frames.
994 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
995 reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, FORMAT_ITEM_A, STOP);
996 reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, FORMAT_ITEM_Z, STOP);
997 reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, FORMAT_ITEM_D, STOP);
998 reduce (q, NO_NOTE, NO_TICK, FORMAT_E_FRAME, FORMAT_ITEM_E, STOP);
999 reduce (q, NO_NOTE, NO_TICK, FORMAT_POINT_FRAME, FORMAT_ITEM_POINT, STOP);
1000 reduce (q, NO_NOTE, NO_TICK, FORMAT_I_FRAME, FORMAT_ITEM_I, STOP);
1001 }
1002 // Frames with an insertion.
1003 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1004 reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, INSERTION, FORMAT_A_FRAME, STOP);
1005 reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, INSERTION, FORMAT_Z_FRAME, STOP);
1006 reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, INSERTION, FORMAT_D_FRAME, STOP);
1007 reduce (q, NO_NOTE, NO_TICK, FORMAT_E_FRAME, INSERTION, FORMAT_E_FRAME, STOP);
1008 reduce (q, NO_NOTE, NO_TICK, FORMAT_POINT_FRAME, INSERTION, FORMAT_POINT_FRAME, STOP);
1009 reduce (q, NO_NOTE, NO_TICK, FORMAT_I_FRAME, INSERTION, FORMAT_I_FRAME, STOP);
1010 }
1011 // String patterns.
1012 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1013 reduce (q, NO_NOTE, NO_TICK, STRING_PATTERN, REPLICATOR, FORMAT_A_FRAME, STOP);
1014 }
1015 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1016 reduce (q, NO_NOTE, NO_TICK, STRING_PATTERN, FORMAT_A_FRAME, STOP);
1017 }
1018 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1019 BOOL_T siga = A68_TRUE;
1020 while (siga) {
1021 siga = A68_FALSE;
1022 reduce (q, NO_NOTE, &siga, STRING_PATTERN, STRING_PATTERN, STRING_PATTERN, STOP);
1023 reduce (q, NO_NOTE, &siga, STRING_PATTERN, STRING_PATTERN, INSERTION, STRING_PATTERN, STOP);
1024 }
1025 }
1026 // Integral moulds.
1027 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1028 reduce (q, NO_NOTE, NO_TICK, INTEGRAL_MOULD, FORMAT_Z_FRAME, STOP);
1029 reduce (q, NO_NOTE, NO_TICK, INTEGRAL_MOULD, FORMAT_D_FRAME, STOP);
1030 }
1031 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1032 BOOL_T siga = A68_TRUE;
1033 while (siga) {
1034 siga = A68_FALSE;
1035 reduce (q, NO_NOTE, &siga, INTEGRAL_MOULD, INTEGRAL_MOULD, INTEGRAL_MOULD, STOP);
1036 reduce (q, NO_NOTE, &siga, INTEGRAL_MOULD, INTEGRAL_MOULD, INSERTION, STOP);
1037 }
1038 }
1039 // Sign moulds.
1040 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1041 reduce (q, NO_NOTE, NO_TICK, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_ITEM_PLUS, STOP);
1042 reduce (q, NO_NOTE, NO_TICK, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_ITEM_MINUS, STOP);
1043 }
1044 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1045 reduce (q, NO_NOTE, NO_TICK, SIGN_MOULD, FORMAT_ITEM_PLUS, STOP);
1046 reduce (q, NO_NOTE, NO_TICK, SIGN_MOULD, FORMAT_ITEM_MINUS, STOP);
1047 }
1048 // Exponent frames.
1049 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1050 reduce (q, NO_NOTE, NO_TICK, EXPONENT_FRAME, FORMAT_E_FRAME, SIGN_MOULD, INTEGRAL_MOULD, STOP);
1051 reduce (q, NO_NOTE, NO_TICK, EXPONENT_FRAME, FORMAT_E_FRAME, INTEGRAL_MOULD, STOP);
1052 }
1053 // Real patterns.
1054 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1055 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, EXPONENT_FRAME, STOP);
1056 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, STOP);
1057 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_POINT_FRAME, EXPONENT_FRAME, STOP);
1058 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_POINT_FRAME, STOP);
1059 }
1060 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1061 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, EXPONENT_FRAME, STOP);
1062 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, STOP);
1063 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, FORMAT_POINT_FRAME, EXPONENT_FRAME, STOP);
1064 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, FORMAT_POINT_FRAME, STOP);
1065 }
1066 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1067 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, INTEGRAL_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, EXPONENT_FRAME, STOP);
1068 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, INTEGRAL_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, STOP);
1069 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, INTEGRAL_MOULD, FORMAT_POINT_FRAME, EXPONENT_FRAME, STOP);
1070 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, INTEGRAL_MOULD, FORMAT_POINT_FRAME, STOP);
1071 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, FORMAT_POINT_FRAME, INTEGRAL_MOULD, EXPONENT_FRAME, STOP);
1072 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, FORMAT_POINT_FRAME, INTEGRAL_MOULD, STOP);
1073 }
1074 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1075 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, EXPONENT_FRAME, STOP);
1076 reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, INTEGRAL_MOULD, EXPONENT_FRAME, STOP);
1077 }
1078 // Complex patterns.
1079 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1080 reduce (q, NO_NOTE, NO_TICK, COMPLEX_PATTERN, REAL_PATTERN, FORMAT_I_FRAME, REAL_PATTERN, STOP);
1081 }
1082 // Bits patterns.
1083 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1084 reduce (q, NO_NOTE, NO_TICK, BITS_PATTERN, RADIX_FRAME, INTEGRAL_MOULD, STOP);
1085 }
1086 // Integral patterns.
1087 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1088 reduce (q, NO_NOTE, NO_TICK, INTEGRAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, STOP);
1089 reduce (q, NO_NOTE, NO_TICK, INTEGRAL_PATTERN, INTEGRAL_MOULD, STOP);
1090 }
1091 // Patterns.
1092 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1093 reduce (q, NO_NOTE, NO_TICK, BOOLEAN_PATTERN, FORMAT_ITEM_B, COLLECTION, STOP);
1094 reduce (q, NO_NOTE, NO_TICK, CHOICE_PATTERN, FORMAT_ITEM_C, COLLECTION, STOP);
1095 }
1096 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1097 reduce (q, NO_NOTE, NO_TICK, BOOLEAN_PATTERN, FORMAT_ITEM_B, STOP);
1098 reduce (q, NO_NOTE, NO_TICK, GENERAL_PATTERN, FORMAT_ITEM_G, STOP);
1099 reduce (q, NO_NOTE, NO_TICK, GENERAL_PATTERN, FORMAT_ITEM_H, STOP);
1100 }
1101 ambiguous_patterns (p);
1102 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1103 reduce (q, a68_extension, NO_TICK, A68_PATTERN, BITS_C_PATTERN, STOP);
1104 reduce (q, a68_extension, NO_TICK, A68_PATTERN, CHAR_C_PATTERN, STOP);
1105 reduce (q, a68_extension, NO_TICK, A68_PATTERN, FIXED_C_PATTERN, STOP);
1106 reduce (q, a68_extension, NO_TICK, A68_PATTERN, FLOAT_C_PATTERN, STOP);
1107 reduce (q, a68_extension, NO_TICK, A68_PATTERN, GENERAL_C_PATTERN, STOP);
1108 reduce (q, a68_extension, NO_TICK, A68_PATTERN, INTEGRAL_C_PATTERN, STOP);
1109 reduce (q, a68_extension, NO_TICK, A68_PATTERN, STRING_C_PATTERN, STOP);
1110 reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, BITS_PATTERN, STOP);
1111 reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, BOOLEAN_PATTERN, STOP);
1112 reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, CHOICE_PATTERN, STOP);
1113 reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, COMPLEX_PATTERN, STOP);
1114 reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, FORMAT_PATTERN, STOP);
1115 reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, GENERAL_PATTERN, STOP);
1116 reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, INTEGRAL_PATTERN, STOP);
1117 reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, REAL_PATTERN, STOP);
1118 reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, STRING_PATTERN, STOP);
1119 }
1120 // Pictures.
1121 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1122 reduce (q, NO_NOTE, NO_TICK, PICTURE, INSERTION, STOP);
1123 reduce (q, NO_NOTE, NO_TICK, PICTURE, A68_PATTERN, STOP);
1124 reduce (q, NO_NOTE, NO_TICK, PICTURE, COLLECTION, STOP);
1125 reduce (q, NO_NOTE, NO_TICK, PICTURE, REPLICATOR, COLLECTION, STOP);
1126 }
1127 // Picture lists.
1128 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1129 if (IS (q, PICTURE)) {
1130 BOOL_T siga = A68_TRUE;
1131 reduce (q, NO_NOTE, NO_TICK, PICTURE_LIST, PICTURE, STOP);
1132 while (siga) {
1133 siga = A68_FALSE;
1134 reduce (q, NO_NOTE, &siga, PICTURE_LIST, PICTURE_LIST, COMMA_SYMBOL, PICTURE, STOP);
1135 // We filtered ambiguous patterns, so commas may be omitted
1136 reduce (q, NO_NOTE, &siga, PICTURE_LIST, PICTURE_LIST, PICTURE, STOP);
1137 }
1138 }
1139 }
1140 }
1141
1142 //! @brief Reduce secondaries completely.
1143
1144 void reduce_secondaries (NODE_T * p)
1145 {
1146 NODE_T *q; BOOL_T siga;
1147 for (q = p; q != NO_NODE; FORWARD (q)) {
1148 reduce (q, NO_NOTE, NO_TICK, SECONDARY, PRIMARY, STOP);
1149 reduce (q, NO_NOTE, NO_TICK, GENERATOR, LOC_SYMBOL, DECLARER, STOP);
1150 reduce (q, NO_NOTE, NO_TICK, GENERATOR, HEAP_SYMBOL, DECLARER, STOP);
1151 reduce (q, NO_NOTE, NO_TICK, GENERATOR, NEW_SYMBOL, DECLARER, STOP);
1152 reduce (q, NO_NOTE, NO_TICK, SECONDARY, GENERATOR, STOP);
1153 }
1154 siga = A68_TRUE;
1155 while (siga) {
1156 siga = A68_FALSE;
1157 for (q = p; NEXT (q) != NO_NODE; FORWARD (q)) {
1158 ;
1159 }
1160 for (; q != NO_NODE; BACKWARD (q)) {
1161 reduce (q, NO_NOTE, &siga, SELECTION, SELECTOR, SECONDARY, STOP);
1162 reduce (q, NO_NOTE, &siga, SECONDARY, SELECTION, STOP);
1163 }
1164 }
1165 }
1166
1167 //! @brief Whether "q" is an operator with priority "k".
1168
1169 int operator_with_priority (NODE_T * q, int k)
1170 {
1171 return NEXT (q) != NO_NODE && ATTRIBUTE (NEXT (q)) == OPERATOR && PRIO (INFO (NEXT (q))) == k;
1172 }
1173
1174 //! @brief Reduce formulae.
1175
1176 void reduce_formulae (NODE_T * p)
1177 {
1178 NODE_T *q = p;
1179 while (q != NO_NODE) {
1180 if (is_one_of (q, OPERATOR, SECONDARY, STOP)) {
1181 q = reduce_dyadic (q, STOP);
1182 } else {
1183 FORWARD (q);
1184 }
1185 }
1186 // Reduce the expression.
1187 for (int prio = MAX_PRIORITY; prio >= 0; prio--) {
1188 for (q = p; q != NO_NODE; FORWARD (q)) {
1189 if (operator_with_priority (q, prio)) {
1190 BOOL_T siga = A68_FALSE;
1191 NODE_T *op = NEXT (q);
1192 if (IS (q, SECONDARY)) {
1193 reduce (q, NO_NOTE, &siga, FORMULA, SECONDARY, OPERATOR, SECONDARY, STOP);
1194 reduce (q, NO_NOTE, &siga, FORMULA, SECONDARY, OPERATOR, MONADIC_FORMULA, STOP);
1195 reduce (q, NO_NOTE, &siga, FORMULA, SECONDARY, OPERATOR, FORMULA, STOP);
1196 } else if (IS (q, MONADIC_FORMULA)) {
1197 reduce (q, NO_NOTE, &siga, FORMULA, MONADIC_FORMULA, OPERATOR, SECONDARY, STOP);
1198 reduce (q, NO_NOTE, &siga, FORMULA, MONADIC_FORMULA, OPERATOR, MONADIC_FORMULA, STOP);
1199 reduce (q, NO_NOTE, &siga, FORMULA, MONADIC_FORMULA, OPERATOR, FORMULA, STOP);
1200 }
1201 if (prio == 0 && siga) {
1202 diagnostic (A68_SYNTAX_ERROR, op, ERROR_NO_PRIORITY);
1203 }
1204 siga = A68_TRUE;
1205 while (siga) {
1206 NODE_T *op2 = NEXT (q);
1207 siga = A68_FALSE;
1208 if (operator_with_priority (q, prio)) {
1209 reduce (q, NO_NOTE, &siga, FORMULA, FORMULA, OPERATOR, SECONDARY, STOP);
1210 }
1211 if (operator_with_priority (q, prio)) {
1212 reduce (q, NO_NOTE, &siga, FORMULA, FORMULA, OPERATOR, MONADIC_FORMULA, STOP);
1213 }
1214 if (operator_with_priority (q, prio)) {
1215 reduce (q, NO_NOTE, &siga, FORMULA, FORMULA, OPERATOR, FORMULA, STOP);
1216 }
1217 if (prio == 0 && siga) {
1218 diagnostic (A68_SYNTAX_ERROR, op2, ERROR_NO_PRIORITY);
1219 }
1220 }
1221 }
1222 }
1223 }
1224 }
1225
1226 //! @brief Reduce dyadic expressions.
1227
1228 NODE_T *reduce_dyadic (NODE_T * p, int u)
1229 {
1230 // We work inside out - higher priority expressions get reduced first.
1231 if (u > MAX_PRIORITY) {
1232 if (p == NO_NODE) {
1233 return NO_NODE;
1234 } else if (IS (p, OPERATOR)) {
1235 // Reduce monadic formulas.
1236 NODE_T *q = p;
1237 BOOL_T siga;
1238 do {
1239 PRIO (INFO (q)) = 10;
1240 siga = (BOOL_T) ((NEXT (q) != NO_NODE) && (IS (NEXT (q), OPERATOR)));
1241 if (siga) {
1242 FORWARD (q);
1243 }
1244 } while (siga);
1245 reduce (q, NO_NOTE, NO_TICK, MONADIC_FORMULA, OPERATOR, SECONDARY, STOP);
1246 while (q != p) {
1247 BACKWARD (q);
1248 reduce (q, NO_NOTE, NO_TICK, MONADIC_FORMULA, OPERATOR, MONADIC_FORMULA, STOP);
1249 }
1250 }
1251 FORWARD (p);
1252 } else {
1253 p = reduce_dyadic (p, u + 1);
1254 while (p != NO_NODE && IS (p, OPERATOR) && PRIO (INFO (p)) == u) {
1255 FORWARD (p);
1256 p = reduce_dyadic (p, u + 1);
1257 }
1258 }
1259 return p;
1260 }
1261
1262 //! @brief Reduce tertiaries completely.
1263
1264 void reduce_tertiaries (NODE_T * p)
1265 {
1266 BOOL_T siga;
1267 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1268 reduce (q, NO_NOTE, NO_TICK, TERTIARY, NIHIL, STOP);
1269 reduce (q, NO_NOTE, NO_TICK, FORMULA, MONADIC_FORMULA, STOP);
1270 reduce (q, NO_NOTE, NO_TICK, TERTIARY, FORMULA, STOP);
1271 reduce (q, NO_NOTE, NO_TICK, TERTIARY, SECONDARY, STOP);
1272 }
1273 siga = A68_TRUE;
1274 while (siga) {
1275 siga = A68_FALSE;
1276 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1277 reduce (q, NO_NOTE, &siga, TRANSPOSE_FUNCTION, TRANSPOSE_SYMBOL, TERTIARY, STOP);
1278 reduce (q, NO_NOTE, &siga, DIAGONAL_FUNCTION, TERTIARY, DIAGONAL_SYMBOL, TERTIARY, STOP);
1279 reduce (q, NO_NOTE, &siga, DIAGONAL_FUNCTION, DIAGONAL_SYMBOL, TERTIARY, STOP);
1280 reduce (q, NO_NOTE, &siga, COLUMN_FUNCTION, TERTIARY, COLUMN_SYMBOL, TERTIARY, STOP);
1281 reduce (q, NO_NOTE, &siga, COLUMN_FUNCTION, COLUMN_SYMBOL, TERTIARY, STOP);
1282 reduce (q, NO_NOTE, &siga, ROW_FUNCTION, TERTIARY, ROW_SYMBOL, TERTIARY, STOP);
1283 reduce (q, NO_NOTE, &siga, ROW_FUNCTION, ROW_SYMBOL, TERTIARY, STOP);
1284 }
1285 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1286 reduce (q, a68_extension, &siga, TERTIARY, TRANSPOSE_FUNCTION, STOP);
1287 reduce (q, a68_extension, &siga, TERTIARY, DIAGONAL_FUNCTION, STOP);
1288 reduce (q, a68_extension, &siga, TERTIARY, COLUMN_FUNCTION, STOP);
1289 reduce (q, a68_extension, &siga, TERTIARY, ROW_FUNCTION, STOP);
1290 }
1291 }
1292 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1293 reduce (q, NO_NOTE, NO_TICK, IDENTITY_RELATION, TERTIARY, IS_SYMBOL, TERTIARY, STOP);
1294 reduce (q, NO_NOTE, NO_TICK, IDENTITY_RELATION, TERTIARY, ISNT_SYMBOL, TERTIARY, STOP);
1295 }
1296 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1297 reduce (q, NO_NOTE, NO_TICK, AND_FUNCTION, TERTIARY, ANDF_SYMBOL, TERTIARY, STOP);
1298 reduce (q, NO_NOTE, NO_TICK, OR_FUNCTION, TERTIARY, ORF_SYMBOL, TERTIARY, STOP);
1299 }
1300 }
1301
1302 //! @brief Reduce units.
1303
1304 void reduce_units (NODE_T * p)
1305 {
1306 // Stray ~ is a SKIP.
1307 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1308 if (IS (q, OPERATOR) && IS_LITERALLY (q, "~")) {
1309 ATTRIBUTE (q) = SKIP;
1310 }
1311 }
1312 // Reduce units.
1313 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1314 reduce (q, NO_NOTE, NO_TICK, UNIT, ASSIGNATION, STOP);
1315 reduce (q, NO_NOTE, NO_TICK, UNIT, IDENTITY_RELATION, STOP);
1316 reduce (q, a68_extension, NO_TICK, UNIT, AND_FUNCTION, STOP);
1317 reduce (q, a68_extension, NO_TICK, UNIT, OR_FUNCTION, STOP);
1318 reduce (q, NO_NOTE, NO_TICK, UNIT, ROUTINE_TEXT, STOP);
1319 reduce (q, NO_NOTE, NO_TICK, UNIT, JUMP, STOP);
1320 reduce (q, NO_NOTE, NO_TICK, UNIT, SKIP, STOP);
1321 reduce (q, NO_NOTE, NO_TICK, UNIT, TERTIARY, STOP);
1322 reduce (q, NO_NOTE, NO_TICK, UNIT, ASSERTION, STOP);
1323 reduce (q, NO_NOTE, NO_TICK, UNIT, CODE_CLAUSE, STOP);
1324 }
1325 }
1326
1327 //! @brief Reduce_generic arguments.
1328
1329 void reduce_generic_arguments (NODE_T * p)
1330 {
1331 NODE_T *q; BOOL_T siga; // In this scope.
1332 for (q = p; q != NO_NODE; FORWARD (q)) {
1333 if (IS (q, UNIT)) {
1334 reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, COLON_SYMBOL, UNIT, AT_SYMBOL, UNIT, STOP);
1335 reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, COLON_SYMBOL, UNIT, STOP);
1336 reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, COLON_SYMBOL, AT_SYMBOL, UNIT, STOP);
1337 reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, COLON_SYMBOL, STOP);
1338 reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, DOTDOT_SYMBOL, UNIT, AT_SYMBOL, UNIT, STOP);
1339 reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, DOTDOT_SYMBOL, UNIT, STOP);
1340 reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, DOTDOT_SYMBOL, AT_SYMBOL, UNIT, STOP);
1341 reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, DOTDOT_SYMBOL, STOP);
1342 } else if (IS (q, COLON_SYMBOL)) {
1343 reduce (q, NO_NOTE, NO_TICK, TRIMMER, COLON_SYMBOL, UNIT, AT_SYMBOL, UNIT, STOP);
1344 reduce (q, NO_NOTE, NO_TICK, TRIMMER, COLON_SYMBOL, UNIT, STOP);
1345 reduce (q, NO_NOTE, NO_TICK, TRIMMER, COLON_SYMBOL, AT_SYMBOL, UNIT, STOP);
1346 reduce (q, NO_NOTE, NO_TICK, TRIMMER, COLON_SYMBOL, STOP);
1347 } else if (IS (q, DOTDOT_SYMBOL)) {
1348 reduce (q, NO_NOTE, NO_TICK, TRIMMER, DOTDOT_SYMBOL, UNIT, AT_SYMBOL, UNIT, STOP);
1349 reduce (q, NO_NOTE, NO_TICK, TRIMMER, DOTDOT_SYMBOL, UNIT, STOP);
1350 reduce (q, NO_NOTE, NO_TICK, TRIMMER, DOTDOT_SYMBOL, AT_SYMBOL, UNIT, STOP);
1351 reduce (q, NO_NOTE, NO_TICK, TRIMMER, DOTDOT_SYMBOL, STOP);
1352 }
1353 }
1354 for (q = p; q != NO_NODE; FORWARD (q)) {
1355 reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, AT_SYMBOL, UNIT, STOP);
1356 }
1357 for (q = p; q != NO_NODE; FORWARD (q)) {
1358 reduce (q, NO_NOTE, NO_TICK, TRIMMER, AT_SYMBOL, UNIT, STOP);
1359 }
1360 for (q = p; q && NEXT (q); FORWARD (q)) {
1361 if (IS (q, COMMA_SYMBOL)) {
1362 if (!(ATTRIBUTE (NEXT (q)) == UNIT || ATTRIBUTE (NEXT (q)) == TRIMMER)) {
1363 pad_node (q, TRIMMER);
1364 }
1365 } else {
1366 if (IS (NEXT (q), COMMA_SYMBOL)) {
1367 if (!IS (q, UNIT) && !IS (q, TRIMMER)) {
1368 pad_node (q, TRIMMER);
1369 }
1370 }
1371 }
1372 }
1373 q = NEXT (p);
1374 ABEND (q == NO_NODE, ERROR_INTERNAL_CONSISTENCY, __func__);
1375 reduce (q, NO_NOTE, NO_TICK, GENERIC_ARGUMENT_LIST, UNIT, STOP);
1376 reduce (q, NO_NOTE, NO_TICK, GENERIC_ARGUMENT_LIST, TRIMMER, STOP);
1377 do {
1378 siga = A68_FALSE;
1379 reduce (q, NO_NOTE, &siga, GENERIC_ARGUMENT_LIST, GENERIC_ARGUMENT_LIST, COMMA_SYMBOL, UNIT, STOP);
1380 reduce (q, NO_NOTE, &siga, GENERIC_ARGUMENT_LIST, GENERIC_ARGUMENT_LIST, COMMA_SYMBOL, TRIMMER, STOP);
1381 reduce (q, strange_separator, &siga, GENERIC_ARGUMENT_LIST, GENERIC_ARGUMENT_LIST, UNIT, STOP);
1382 reduce (q, strange_separator, &siga, GENERIC_ARGUMENT_LIST, GENERIC_ARGUMENT_LIST, TRIMMER, STOP);
1383 } while (siga);
1384 }
1385
1386 //! @brief Reduce bounds.
1387
1388 void reduce_bounds (NODE_T * p)
1389 {
1390 NODE_T *q; BOOL_T siga;
1391 for (q = p; q != NO_NODE; FORWARD (q)) {
1392 reduce (q, NO_NOTE, NO_TICK, BOUND, UNIT, COLON_SYMBOL, UNIT, STOP);
1393 reduce (q, NO_NOTE, NO_TICK, BOUND, UNIT, DOTDOT_SYMBOL, UNIT, STOP);
1394 reduce (q, NO_NOTE, NO_TICK, BOUND, UNIT, STOP);
1395 }
1396 q = NEXT (p);
1397 reduce (q, NO_NOTE, NO_TICK, BOUNDS_LIST, BOUND, STOP);
1398 reduce (q, NO_NOTE, NO_TICK, FORMAL_BOUNDS_LIST, COMMA_SYMBOL, STOP);
1399 reduce (q, NO_NOTE, NO_TICK, ALT_FORMAL_BOUNDS_LIST, COLON_SYMBOL, STOP);
1400 reduce (q, NO_NOTE, NO_TICK, ALT_FORMAL_BOUNDS_LIST, DOTDOT_SYMBOL, STOP);
1401 do {
1402 siga = A68_FALSE;
1403 reduce (q, NO_NOTE, &siga, BOUNDS_LIST, BOUNDS_LIST, COMMA_SYMBOL, BOUND, STOP);
1404 reduce (q, NO_NOTE, &siga, FORMAL_BOUNDS_LIST, FORMAL_BOUNDS_LIST, COMMA_SYMBOL, STOP);
1405 reduce (q, NO_NOTE, &siga, ALT_FORMAL_BOUNDS_LIST, FORMAL_BOUNDS_LIST, COLON_SYMBOL, STOP);
1406 reduce (q, NO_NOTE, &siga, ALT_FORMAL_BOUNDS_LIST, FORMAL_BOUNDS_LIST, DOTDOT_SYMBOL, STOP);
1407 reduce (q, NO_NOTE, &siga, FORMAL_BOUNDS_LIST, ALT_FORMAL_BOUNDS_LIST, COMMA_SYMBOL, STOP);
1408 reduce (q, strange_separator, &siga, BOUNDS_LIST, BOUNDS_LIST, BOUND, STOP);
1409 } while (siga);
1410 }
1411
1412 //! @brief Reduce argument packs.
1413
1414 void reduce_arguments (NODE_T * p)
1415 {
1416 if (NEXT (p) != NO_NODE) {
1417 NODE_T *q = NEXT (p);
1418 BOOL_T siga;
1419 reduce (q, NO_NOTE, NO_TICK, ARGUMENT_LIST, UNIT, STOP);
1420 do {
1421 siga = A68_FALSE;
1422 reduce (q, NO_NOTE, &siga, ARGUMENT_LIST, ARGUMENT_LIST, COMMA_SYMBOL, UNIT, STOP);
1423 reduce (q, strange_separator, &siga, ARGUMENT_LIST, ARGUMENT_LIST, UNIT, STOP);
1424 } while (siga);
1425 }
1426 }
1427
1428 //! @brief Reduce declarations.
1429
1430 void reduce_basic_declarations (NODE_T * p)
1431 {
1432 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1433 reduce (q, NO_NOTE, NO_TICK, ENVIRON_NAME, ENVIRON_SYMBOL, ROW_CHAR_DENOTATION, STOP);
1434 reduce (q, NO_NOTE, NO_TICK, PRIORITY_DECLARATION, PRIO_SYMBOL, DEFINING_OPERATOR, EQUALS_SYMBOL, PRIORITY, STOP);
1435 reduce (q, NO_NOTE, NO_TICK, MODE_DECLARATION, MODE_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, DECLARER, STOP);
1436 reduce (q, NO_NOTE, NO_TICK, MODE_DECLARATION, MODE_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, VOID_SYMBOL, STOP);
1437 reduce (q, NO_NOTE, NO_TICK, PROCEDURE_DECLARATION, PROC_SYMBOL, DEFINING_IDENTIFIER, EQUALS_SYMBOL, ROUTINE_TEXT, STOP);
1438 reduce (q, NO_NOTE, NO_TICK, PROCEDURE_VARIABLE_DECLARATION, PROC_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, ROUTINE_TEXT, STOP);
1439 reduce (q, NO_NOTE, NO_TICK, PROCEDURE_VARIABLE_DECLARATION, QUALIFIER, PROC_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, ROUTINE_TEXT, STOP);
1440 reduce (q, NO_NOTE, NO_TICK, BRIEF_OPERATOR_DECLARATION, OP_SYMBOL, DEFINING_OPERATOR, EQUALS_SYMBOL, ROUTINE_TEXT, STOP);
1441 // Errors.
1442 reduce (q, strange_tokens, NO_TICK, PRIORITY_DECLARATION, PRIO_SYMBOL, -DEFINING_OPERATOR, -EQUALS_SYMBOL, -PRIORITY, STOP);
1443 reduce (q, strange_tokens, NO_TICK, MODE_DECLARATION, MODE_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, -DECLARER, STOP);
1444 reduce (q, strange_tokens, NO_TICK, PROCEDURE_DECLARATION, PROC_SYMBOL, DEFINING_IDENTIFIER, EQUALS_SYMBOL, -ROUTINE_TEXT, STOP);
1445 reduce (q, strange_tokens, NO_TICK, PROCEDURE_VARIABLE_DECLARATION, PROC_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, -ROUTINE_TEXT, STOP);
1446 reduce (q, strange_tokens, NO_TICK, PROCEDURE_VARIABLE_DECLARATION, QUALIFIER, PROC_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, -ROUTINE_TEXT, STOP);
1447 reduce (q, strange_tokens, NO_TICK, BRIEF_OPERATOR_DECLARATION, OP_SYMBOL, DEFINING_OPERATOR, EQUALS_SYMBOL, -ROUTINE_TEXT, STOP);
1448 // Errors. WILDCARD catches TERTIARY which catches IDENTIFIER.
1449 reduce (q, strange_tokens, NO_TICK, PROCEDURE_DECLARATION, PROC_SYMBOL, WILDCARD, ROUTINE_TEXT, STOP);
1450 }
1451 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1452 BOOL_T siga;
1453 do {
1454 siga = A68_FALSE;
1455 reduce (q, NO_NOTE, &siga, ENVIRON_NAME, ENVIRON_NAME, COMMA_SYMBOL, ROW_CHAR_DENOTATION, STOP);
1456 reduce (q, NO_NOTE, &siga, PRIORITY_DECLARATION, PRIORITY_DECLARATION, COMMA_SYMBOL, DEFINING_OPERATOR, EQUALS_SYMBOL, PRIORITY, STOP);
1457 reduce (q, NO_NOTE, &siga, MODE_DECLARATION, MODE_DECLARATION, COMMA_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, DECLARER, STOP);
1458 reduce (q, NO_NOTE, &siga, MODE_DECLARATION, MODE_DECLARATION, COMMA_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, VOID_SYMBOL, STOP);
1459 reduce (q, NO_NOTE, &siga, PROCEDURE_DECLARATION, PROCEDURE_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER, EQUALS_SYMBOL, ROUTINE_TEXT, STOP);
1460 reduce (q, NO_NOTE, &siga, PROCEDURE_VARIABLE_DECLARATION, PROCEDURE_VARIABLE_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, ROUTINE_TEXT, STOP);
1461 reduce (q, NO_NOTE, &siga, BRIEF_OPERATOR_DECLARATION, BRIEF_OPERATOR_DECLARATION, COMMA_SYMBOL, DEFINING_OPERATOR, EQUALS_SYMBOL, ROUTINE_TEXT, STOP);
1462 // Errors. WILDCARD catches TERTIARY which catches IDENTIFIER.
1463 reduce (q, strange_tokens, &siga, PROCEDURE_DECLARATION, PROCEDURE_DECLARATION, COMMA_SYMBOL, WILDCARD, ROUTINE_TEXT, STOP);
1464 } while (siga);
1465 }
1466 }
1467
1468 //! @brief Reduce declaration lists.
1469
1470 void reduce_declaration_lists (NODE_T * p)
1471 {
1472 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1473 reduce (q, NO_NOTE, NO_TICK, IDENTITY_DECLARATION, DECLARER, DEFINING_IDENTIFIER, EQUALS_SYMBOL, UNIT, STOP);
1474 reduce (q, NO_NOTE, NO_TICK, VARIABLE_DECLARATION, QUALIFIER, DECLARER, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP);
1475 reduce (q, NO_NOTE, NO_TICK, VARIABLE_DECLARATION, QUALIFIER, DECLARER, DEFINING_IDENTIFIER, STOP);
1476 reduce (q, NO_NOTE, NO_TICK, VARIABLE_DECLARATION, DECLARER, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP);
1477 reduce (q, NO_NOTE, NO_TICK, VARIABLE_DECLARATION, DECLARER, DEFINING_IDENTIFIER, STOP);
1478 }
1479 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1480 BOOL_T siga;
1481 do {
1482 siga = A68_FALSE;
1483 reduce (q, NO_NOTE, &siga, IDENTITY_DECLARATION, IDENTITY_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER, EQUALS_SYMBOL, UNIT, STOP);
1484 reduce (q, NO_NOTE, &siga, VARIABLE_DECLARATION, VARIABLE_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP);
1485 if (!whether (q, VARIABLE_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP)) {
1486 reduce (q, NO_NOTE, &siga, VARIABLE_DECLARATION, VARIABLE_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER, STOP);
1487 }
1488 } while (siga);
1489 }
1490 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1491 reduce (q, NO_NOTE, NO_TICK, OPERATOR_DECLARATION, OPERATOR_PLAN, DEFINING_OPERATOR, EQUALS_SYMBOL, UNIT, STOP);
1492 }
1493 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1494 BOOL_T siga;
1495 do {
1496 siga = A68_FALSE;
1497 reduce (q, NO_NOTE, &siga, OPERATOR_DECLARATION, OPERATOR_DECLARATION, COMMA_SYMBOL, DEFINING_OPERATOR, EQUALS_SYMBOL, UNIT, STOP);
1498 } while (siga);
1499 }
1500 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1501 reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, MODE_DECLARATION, STOP);
1502 reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, PRIORITY_DECLARATION, STOP);
1503 reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, BRIEF_OPERATOR_DECLARATION, STOP);
1504 reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, OPERATOR_DECLARATION, STOP);
1505 reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, IDENTITY_DECLARATION, STOP);
1506 reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, PROCEDURE_DECLARATION, STOP);
1507 reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, PROCEDURE_VARIABLE_DECLARATION, STOP);
1508 reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, VARIABLE_DECLARATION, STOP);
1509 reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, ENVIRON_NAME, STOP);
1510 }
1511 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1512 BOOL_T siga;
1513 do {
1514 siga = A68_FALSE;
1515 reduce (q, NO_NOTE, &siga, DECLARATION_LIST, DECLARATION_LIST, COMMA_SYMBOL, DECLARATION_LIST, STOP);
1516 } while (siga);
1517 }
1518 }
1519
1520 //! @brief Reduce serial clauses.
1521
1522 void reduce_serial_clauses (NODE_T * p)
1523 {
1524 if (NEXT (p) != NO_NODE) {
1525 NODE_T *q = NEXT (p), *u;
1526 BOOL_T siga, label_seen;
1527 // Check wrong exits.
1528 for (u = q; u != NO_NODE; FORWARD (u)) {
1529 if (IS (u, EXIT_SYMBOL)) {
1530 if (NEXT (u) == NO_NODE || !IS (NEXT (u), LABELED_UNIT)) {
1531 diagnostic (A68_SYNTAX_ERROR, u, ERROR_LABELED_UNIT_MUST_FOLLOW);
1532 }
1533 }
1534 }
1535 // Check wrong jumps and declarations.
1536 for (u = q, label_seen = A68_FALSE; u != NO_NODE; FORWARD (u)) {
1537 if (IS (u, LABELED_UNIT)) {
1538 label_seen = A68_TRUE;
1539 } else if (IS (u, DECLARATION_LIST)) {
1540 if (label_seen) {
1541 diagnostic (A68_SYNTAX_ERROR, u, ERROR_LABEL_BEFORE_DECLARATION);
1542 }
1543 }
1544 }
1545 // Reduce serial clauses.
1546 reduce (q, NO_NOTE, NO_TICK, SERIAL_CLAUSE, LABELED_UNIT, STOP);
1547 reduce (q, NO_NOTE, NO_TICK, SERIAL_CLAUSE, UNIT, STOP);
1548 reduce (q, NO_NOTE, NO_TICK, INITIALISER_SERIES, DECLARATION_LIST, STOP);
1549 do {
1550 siga = A68_FALSE;
1551 if (IS (q, SERIAL_CLAUSE)) {
1552 reduce (q, NO_NOTE, &siga, SERIAL_CLAUSE, SERIAL_CLAUSE, SEMI_SYMBOL, UNIT, STOP);
1553 reduce (q, NO_NOTE, &siga, SERIAL_CLAUSE, SERIAL_CLAUSE, EXIT_SYMBOL, LABELED_UNIT, STOP);
1554 reduce (q, NO_NOTE, &siga, SERIAL_CLAUSE, SERIAL_CLAUSE, SEMI_SYMBOL, LABELED_UNIT, STOP);
1555 reduce (q, NO_NOTE, &siga, INITIALISER_SERIES, SERIAL_CLAUSE, SEMI_SYMBOL, DECLARATION_LIST, STOP);
1556 // Errors
1557 reduce (q, strange_separator, &siga, SERIAL_CLAUSE, SERIAL_CLAUSE, COMMA_SYMBOL, UNIT, STOP);
1558 reduce (q, strange_separator, &siga, SERIAL_CLAUSE, SERIAL_CLAUSE, COMMA_SYMBOL, LABELED_UNIT, STOP);
1559 reduce (q, strange_separator, &siga, INITIALISER_SERIES, SERIAL_CLAUSE, COMMA_SYMBOL, DECLARATION_LIST, STOP);
1560 reduce (q, strange_separator, &siga, SERIAL_CLAUSE, SERIAL_CLAUSE, COLON_SYMBOL, UNIT, STOP);
1561 reduce (q, strange_separator, &siga, SERIAL_CLAUSE, SERIAL_CLAUSE, COLON_SYMBOL, LABELED_UNIT, STOP);
1562 reduce (q, strange_separator, &siga, INITIALISER_SERIES, SERIAL_CLAUSE, COLON_SYMBOL, DECLARATION_LIST, STOP);
1563 reduce (q, strange_separator, &siga, SERIAL_CLAUSE, SERIAL_CLAUSE, UNIT, STOP);
1564 reduce (q, strange_separator, &siga, SERIAL_CLAUSE, SERIAL_CLAUSE, LABELED_UNIT, STOP);
1565 reduce (q, strange_separator, &siga, INITIALISER_SERIES, SERIAL_CLAUSE, DECLARATION_LIST, STOP);
1566 } else if (IS (q, INITIALISER_SERIES)) {
1567 reduce (q, NO_NOTE, &siga, SERIAL_CLAUSE, INITIALISER_SERIES, SEMI_SYMBOL, UNIT, STOP);
1568 reduce (q, NO_NOTE, &siga, SERIAL_CLAUSE, INITIALISER_SERIES, SEMI_SYMBOL, LABELED_UNIT, STOP);
1569 reduce (q, NO_NOTE, &siga, INITIALISER_SERIES, INITIALISER_SERIES, SEMI_SYMBOL, DECLARATION_LIST, STOP);
1570 // Errors
1571 reduce (q, strange_separator, &siga, SERIAL_CLAUSE, INITIALISER_SERIES, COMMA_SYMBOL, UNIT, STOP);
1572 reduce (q, strange_separator, &siga, SERIAL_CLAUSE, INITIALISER_SERIES, COMMA_SYMBOL, LABELED_UNIT, STOP);
1573 reduce (q, strange_separator, &siga, INITIALISER_SERIES, INITIALISER_SERIES, COMMA_SYMBOL, DECLARATION_LIST, STOP);
1574 reduce (q, strange_separator, &siga, SERIAL_CLAUSE, INITIALISER_SERIES, COLON_SYMBOL, UNIT, STOP);
1575 reduce (q, strange_separator, &siga, SERIAL_CLAUSE, INITIALISER_SERIES, COLON_SYMBOL, LABELED_UNIT, STOP);
1576 reduce (q, strange_separator, &siga, INITIALISER_SERIES, INITIALISER_SERIES, COLON_SYMBOL, DECLARATION_LIST, STOP);
1577 reduce (q, strange_separator, &siga, SERIAL_CLAUSE, INITIALISER_SERIES, UNIT, STOP);
1578 reduce (q, strange_separator, &siga, SERIAL_CLAUSE, INITIALISER_SERIES, LABELED_UNIT, STOP);
1579 reduce (q, strange_separator, &siga, INITIALISER_SERIES, INITIALISER_SERIES, DECLARATION_LIST, STOP);
1580 }
1581 }
1582 while (siga);
1583 }
1584 }
1585
1586 //! @brief Reduce enquiry clauses.
1587
1588 void reduce_enquiry_clauses (NODE_T * p)
1589 {
1590 if (NEXT (p) != NO_NODE) {
1591 NODE_T *q = NEXT (p);
1592 BOOL_T siga;
1593 reduce (q, NO_NOTE, NO_TICK, ENQUIRY_CLAUSE, UNIT, STOP);
1594 reduce (q, NO_NOTE, NO_TICK, INITIALISER_SERIES, DECLARATION_LIST, STOP);
1595 do {
1596 siga = A68_FALSE;
1597 if (IS (q, ENQUIRY_CLAUSE)) {
1598 reduce (q, NO_NOTE, &siga, ENQUIRY_CLAUSE, ENQUIRY_CLAUSE, SEMI_SYMBOL, UNIT, STOP);
1599 reduce (q, NO_NOTE, &siga, INITIALISER_SERIES, ENQUIRY_CLAUSE, SEMI_SYMBOL, DECLARATION_LIST, STOP);
1600 reduce (q, strange_separator, &siga, ENQUIRY_CLAUSE, ENQUIRY_CLAUSE, COMMA_SYMBOL, UNIT, STOP);
1601 reduce (q, strange_separator, &siga, INITIALISER_SERIES, ENQUIRY_CLAUSE, COMMA_SYMBOL, DECLARATION_LIST, STOP);
1602 reduce (q, strange_separator, &siga, ENQUIRY_CLAUSE, ENQUIRY_CLAUSE, COLON_SYMBOL, UNIT, STOP);
1603 reduce (q, strange_separator, &siga, INITIALISER_SERIES, ENQUIRY_CLAUSE, COLON_SYMBOL, DECLARATION_LIST, STOP);
1604 reduce (q, strange_separator, &siga, ENQUIRY_CLAUSE, ENQUIRY_CLAUSE, UNIT, STOP);
1605 reduce (q, strange_separator, &siga, INITIALISER_SERIES, ENQUIRY_CLAUSE, DECLARATION_LIST, STOP);
1606 } else if (IS (q, INITIALISER_SERIES)) {
1607 reduce (q, NO_NOTE, &siga, ENQUIRY_CLAUSE, INITIALISER_SERIES, SEMI_SYMBOL, UNIT, STOP);
1608 reduce (q, NO_NOTE, &siga, INITIALISER_SERIES, INITIALISER_SERIES, SEMI_SYMBOL, DECLARATION_LIST, STOP);
1609 reduce (q, strange_separator, &siga, ENQUIRY_CLAUSE, INITIALISER_SERIES, COMMA_SYMBOL, UNIT, STOP);
1610 reduce (q, strange_separator, &siga, INITIALISER_SERIES, INITIALISER_SERIES, COMMA_SYMBOL, DECLARATION_LIST, STOP);
1611 reduce (q, strange_separator, &siga, ENQUIRY_CLAUSE, INITIALISER_SERIES, COLON_SYMBOL, UNIT, STOP);
1612 reduce (q, strange_separator, &siga, INITIALISER_SERIES, INITIALISER_SERIES, COLON_SYMBOL, DECLARATION_LIST, STOP);
1613 reduce (q, strange_separator, &siga, ENQUIRY_CLAUSE, INITIALISER_SERIES, UNIT, STOP);
1614 reduce (q, strange_separator, &siga, INITIALISER_SERIES, INITIALISER_SERIES, DECLARATION_LIST, STOP);
1615 }
1616 }
1617 while (siga);
1618 }
1619 }
1620
1621 //! @brief Reduce collateral clauses.
1622
1623 void reduce_collateral_clauses (NODE_T * p)
1624 {
1625 if (NEXT (p) != NO_NODE) {
1626 NODE_T *q = NEXT (p);
1627 if (IS (q, UNIT)) {
1628 BOOL_T siga;
1629 reduce (q, NO_NOTE, NO_TICK, UNIT_LIST, UNIT, STOP);
1630 do {
1631 siga = A68_FALSE;
1632 reduce (q, NO_NOTE, &siga, UNIT_LIST, UNIT_LIST, COMMA_SYMBOL, UNIT, STOP);
1633 reduce (q, strange_separator, &siga, UNIT_LIST, UNIT_LIST, UNIT, STOP);
1634 } while (siga);
1635 } else if (IS (q, SPECIFIED_UNIT)) {
1636 BOOL_T siga;
1637 reduce (q, NO_NOTE, NO_TICK, SPECIFIED_UNIT_LIST, SPECIFIED_UNIT, STOP);
1638 do {
1639 siga = A68_FALSE;
1640 reduce (q, NO_NOTE, &siga, SPECIFIED_UNIT_LIST, SPECIFIED_UNIT_LIST, COMMA_SYMBOL, SPECIFIED_UNIT, STOP);
1641 reduce (q, strange_separator, &siga, SPECIFIED_UNIT_LIST, SPECIFIED_UNIT_LIST, SPECIFIED_UNIT, STOP);
1642 } while (siga);
1643 }
1644 }
1645 }
1646
1647 //! @brief Reduces enclosed clauses.
1648
1649 void reduce_enclosed_clauses (NODE_T * q, int expect)
1650 {
1651 NODE_T *p = q;
1652 if (SUB (p) == NO_NODE) {
1653 if (IS (p, FOR_SYMBOL)) {
1654 reduce (p, NO_NOTE, NO_TICK, FOR_PART, FOR_SYMBOL, DEFINING_IDENTIFIER, STOP);
1655 } else if (IS (p, OPEN_SYMBOL)) {
1656 if (expect == ENQUIRY_CLAUSE) {
1657 reduce (p, NO_NOTE, NO_TICK, OPEN_PART, OPEN_SYMBOL, ENQUIRY_CLAUSE, STOP);
1658 } else if (expect == ARGUMENT) {
1659 reduce (p, NO_NOTE, NO_TICK, ARGUMENT, OPEN_SYMBOL, CLOSE_SYMBOL, STOP);
1660 reduce (p, NO_NOTE, NO_TICK, ARGUMENT, OPEN_SYMBOL, ARGUMENT_LIST, CLOSE_SYMBOL, STOP);
1661 reduce (p, empty_clause, NO_TICK, ARGUMENT, OPEN_SYMBOL, INITIALISER_SERIES, CLOSE_SYMBOL, STOP);
1662 } else if (expect == GENERIC_ARGUMENT) {
1663 if (whether (p, OPEN_SYMBOL, CLOSE_SYMBOL, STOP)) {
1664 pad_node (p, TRIMMER);
1665 reduce (p, NO_NOTE, NO_TICK, GENERIC_ARGUMENT, OPEN_SYMBOL, TRIMMER, CLOSE_SYMBOL, STOP);
1666 }
1667 reduce (p, NO_NOTE, NO_TICK, GENERIC_ARGUMENT, OPEN_SYMBOL, GENERIC_ARGUMENT_LIST, CLOSE_SYMBOL, STOP);
1668 } else if (expect == BOUNDS) {
1669 reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, OPEN_SYMBOL, CLOSE_SYMBOL, STOP);
1670 reduce (p, NO_NOTE, NO_TICK, BOUNDS, OPEN_SYMBOL, BOUNDS_LIST, CLOSE_SYMBOL, STOP);
1671 reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, OPEN_SYMBOL, FORMAL_BOUNDS_LIST, CLOSE_SYMBOL, STOP);
1672 reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, OPEN_SYMBOL, ALT_FORMAL_BOUNDS_LIST, CLOSE_SYMBOL, STOP);
1673 } else {
1674 reduce (p, NO_NOTE, NO_TICK, CLOSED_CLAUSE, OPEN_SYMBOL, SERIAL_CLAUSE, CLOSE_SYMBOL, STOP);
1675 reduce (p, NO_NOTE, NO_TICK, COLLATERAL_CLAUSE, OPEN_SYMBOL, UNIT_LIST, CLOSE_SYMBOL, STOP);
1676 reduce (p, NO_NOTE, NO_TICK, COLLATERAL_CLAUSE, OPEN_SYMBOL, CLOSE_SYMBOL, STOP);
1677 reduce (p, empty_clause, NO_TICK, CLOSED_CLAUSE, OPEN_SYMBOL, INITIALISER_SERIES, CLOSE_SYMBOL, STOP);
1678 }
1679 } else if (IS (p, SUB_SYMBOL)) {
1680 if (expect == GENERIC_ARGUMENT) {
1681 if (whether (p, SUB_SYMBOL, BUS_SYMBOL, STOP)) {
1682 pad_node (p, TRIMMER);
1683 reduce (p, NO_NOTE, NO_TICK, GENERIC_ARGUMENT, SUB_SYMBOL, TRIMMER, BUS_SYMBOL, STOP);
1684 }
1685 reduce (p, NO_NOTE, NO_TICK, GENERIC_ARGUMENT, SUB_SYMBOL, GENERIC_ARGUMENT_LIST, BUS_SYMBOL, STOP);
1686 } else if (expect == BOUNDS) {
1687 reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, SUB_SYMBOL, BUS_SYMBOL, STOP);
1688 reduce (p, NO_NOTE, NO_TICK, BOUNDS, SUB_SYMBOL, BOUNDS_LIST, BUS_SYMBOL, STOP);
1689 reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, SUB_SYMBOL, FORMAL_BOUNDS_LIST, BUS_SYMBOL, STOP);
1690 reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, SUB_SYMBOL, ALT_FORMAL_BOUNDS_LIST, BUS_SYMBOL, STOP);
1691 }
1692 } else if (IS (p, BEGIN_SYMBOL)) {
1693 reduce (p, NO_NOTE, NO_TICK, COLLATERAL_CLAUSE, BEGIN_SYMBOL, UNIT_LIST, END_SYMBOL, STOP);
1694 reduce (p, NO_NOTE, NO_TICK, COLLATERAL_CLAUSE, BEGIN_SYMBOL, END_SYMBOL, STOP);
1695 reduce (p, NO_NOTE, NO_TICK, CLOSED_CLAUSE, BEGIN_SYMBOL, SERIAL_CLAUSE, END_SYMBOL, STOP);
1696 reduce (p, empty_clause, NO_TICK, CLOSED_CLAUSE, BEGIN_SYMBOL, INITIALISER_SERIES, END_SYMBOL, STOP);
1697 } else if (IS (p, FORMAT_DELIMITER_SYMBOL)) {
1698 reduce (p, NO_NOTE, NO_TICK, FORMAT_TEXT, FORMAT_DELIMITER_SYMBOL, PICTURE_LIST, FORMAT_DELIMITER_SYMBOL, STOP);
1699 reduce (p, NO_NOTE, NO_TICK, FORMAT_TEXT, FORMAT_DELIMITER_SYMBOL, FORMAT_DELIMITER_SYMBOL, STOP);
1700 } else if (IS (p, FORMAT_OPEN_SYMBOL)) {
1701 reduce (p, NO_NOTE, NO_TICK, COLLECTION, FORMAT_OPEN_SYMBOL, PICTURE_LIST, FORMAT_CLOSE_SYMBOL, STOP);
1702 } else if (IS (p, IF_SYMBOL)) {
1703 reduce (p, NO_NOTE, NO_TICK, IF_PART, IF_SYMBOL, ENQUIRY_CLAUSE, STOP);
1704 reduce (p, empty_clause, NO_TICK, IF_PART, IF_SYMBOL, INITIALISER_SERIES, STOP);
1705 } else if (IS (p, THEN_SYMBOL)) {
1706 reduce (p, NO_NOTE, NO_TICK, THEN_PART, THEN_SYMBOL, SERIAL_CLAUSE, STOP);
1707 reduce (p, empty_clause, NO_TICK, THEN_PART, THEN_SYMBOL, INITIALISER_SERIES, STOP);
1708 } else if (IS (p, ELSE_SYMBOL)) {
1709 reduce (p, NO_NOTE, NO_TICK, ELSE_PART, ELSE_SYMBOL, SERIAL_CLAUSE, STOP);
1710 reduce (p, empty_clause, NO_TICK, ELSE_PART, ELSE_SYMBOL, INITIALISER_SERIES, STOP);
1711 } else if (IS (p, ELIF_SYMBOL)) {
1712 reduce (p, NO_NOTE, NO_TICK, ELIF_IF_PART, ELIF_SYMBOL, ENQUIRY_CLAUSE, STOP);
1713 } else if (IS (p, CASE_SYMBOL)) {
1714 reduce (p, NO_NOTE, NO_TICK, CASE_PART, CASE_SYMBOL, ENQUIRY_CLAUSE, STOP);
1715 reduce (p, empty_clause, NO_TICK, CASE_PART, CASE_SYMBOL, INITIALISER_SERIES, STOP);
1716 } else if (IS (p, IN_SYMBOL)) {
1717 reduce (p, NO_NOTE, NO_TICK, CASE_IN_PART, IN_SYMBOL, UNIT_LIST, STOP);
1718 reduce (p, NO_NOTE, NO_TICK, CONFORMITY_IN_PART, IN_SYMBOL, SPECIFIED_UNIT_LIST, STOP);
1719 } else if (IS (p, OUT_SYMBOL)) {
1720 reduce (p, NO_NOTE, NO_TICK, OUT_PART, OUT_SYMBOL, SERIAL_CLAUSE, STOP);
1721 reduce (p, empty_clause, NO_TICK, OUT_PART, OUT_SYMBOL, INITIALISER_SERIES, STOP);
1722 } else if (IS (p, OUSE_SYMBOL)) {
1723 reduce (p, NO_NOTE, NO_TICK, OUSE_PART, OUSE_SYMBOL, ENQUIRY_CLAUSE, STOP);
1724 } else if (IS (p, THEN_BAR_SYMBOL)) {
1725 reduce (p, NO_NOTE, NO_TICK, CHOICE, THEN_BAR_SYMBOL, SERIAL_CLAUSE, STOP);
1726 reduce (p, NO_NOTE, NO_TICK, CASE_CHOICE_CLAUSE, THEN_BAR_SYMBOL, UNIT_LIST, STOP);
1727 reduce (p, NO_NOTE, NO_TICK, CONFORMITY_CHOICE, THEN_BAR_SYMBOL, SPECIFIED_UNIT_LIST, STOP);
1728 reduce (p, NO_NOTE, NO_TICK, CONFORMITY_CHOICE, THEN_BAR_SYMBOL, SPECIFIED_UNIT, STOP);
1729 reduce (p, empty_clause, NO_TICK, CHOICE, THEN_BAR_SYMBOL, INITIALISER_SERIES, STOP);
1730 } else if (IS (p, ELSE_BAR_SYMBOL)) {
1731 reduce (p, NO_NOTE, NO_TICK, ELSE_OPEN_PART, ELSE_BAR_SYMBOL, ENQUIRY_CLAUSE, STOP);
1732 reduce (p, empty_clause, NO_TICK, ELSE_OPEN_PART, ELSE_BAR_SYMBOL, INITIALISER_SERIES, STOP);
1733 } else if (IS (p, FROM_SYMBOL)) {
1734 reduce (p, NO_NOTE, NO_TICK, FROM_PART, FROM_SYMBOL, UNIT, STOP);
1735 } else if (IS (p, BY_SYMBOL)) {
1736 reduce (p, NO_NOTE, NO_TICK, BY_PART, BY_SYMBOL, UNIT, STOP);
1737 } else if (IS (p, TO_SYMBOL)) {
1738 reduce (p, NO_NOTE, NO_TICK, TO_PART, TO_SYMBOL, UNIT, STOP);
1739 } else if (IS (p, DOWNTO_SYMBOL)) {
1740 reduce (p, NO_NOTE, NO_TICK, TO_PART, DOWNTO_SYMBOL, UNIT, STOP);
1741 } else if (IS (p, WHILE_SYMBOL)) {
1742 reduce (p, NO_NOTE, NO_TICK, WHILE_PART, WHILE_SYMBOL, ENQUIRY_CLAUSE, STOP);
1743 reduce (p, empty_clause, NO_TICK, WHILE_PART, WHILE_SYMBOL, INITIALISER_SERIES, STOP);
1744 } else if (IS (p, UNTIL_SYMBOL)) {
1745 reduce (p, NO_NOTE, NO_TICK, UNTIL_PART, UNTIL_SYMBOL, ENQUIRY_CLAUSE, STOP);
1746 reduce (p, empty_clause, NO_TICK, UNTIL_PART, UNTIL_SYMBOL, INITIALISER_SERIES, STOP);
1747 } else if (IS (p, DO_SYMBOL)) {
1748 reduce (p, NO_NOTE, NO_TICK, DO_PART, DO_SYMBOL, SERIAL_CLAUSE, UNTIL_PART, OD_SYMBOL, STOP);
1749 reduce (p, NO_NOTE, NO_TICK, DO_PART, DO_SYMBOL, SERIAL_CLAUSE, OD_SYMBOL, STOP);
1750 reduce (p, NO_NOTE, NO_TICK, DO_PART, DO_SYMBOL, UNTIL_PART, OD_SYMBOL, STOP);
1751 } else if (IS (p, ALT_DO_SYMBOL)) {
1752 reduce (p, NO_NOTE, NO_TICK, ALT_DO_PART, ALT_DO_SYMBOL, SERIAL_CLAUSE, UNTIL_PART, OD_SYMBOL, STOP);
1753 reduce (p, NO_NOTE, NO_TICK, ALT_DO_PART, ALT_DO_SYMBOL, SERIAL_CLAUSE, OD_SYMBOL, STOP);
1754 reduce (p, NO_NOTE, NO_TICK, ALT_DO_PART, ALT_DO_SYMBOL, UNTIL_PART, OD_SYMBOL, STOP);
1755 }
1756 }
1757 p = q;
1758 if (SUB (p) != NO_NODE) {
1759 if (IS (p, OPEN_PART)) {
1760 reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, OPEN_PART, CHOICE, CHOICE, CLOSE_SYMBOL, STOP);
1761 reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, OPEN_PART, CHOICE, CLOSE_SYMBOL, STOP);
1762 reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, OPEN_PART, CHOICE, BRIEF_ELIF_PART, STOP);
1763 reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, OPEN_PART, CASE_CHOICE_CLAUSE, CHOICE, CLOSE_SYMBOL, STOP);
1764 reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, OPEN_PART, CASE_CHOICE_CLAUSE, CLOSE_SYMBOL, STOP);
1765 reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, OPEN_PART, CASE_CHOICE_CLAUSE, BRIEF_OUSE_PART, STOP);
1766 reduce (p, NO_NOTE, NO_TICK, CONFORMITY_CLAUSE, OPEN_PART, CONFORMITY_CHOICE, CHOICE, CLOSE_SYMBOL, STOP);
1767 reduce (p, NO_NOTE, NO_TICK, CONFORMITY_CLAUSE, OPEN_PART, CONFORMITY_CHOICE, CLOSE_SYMBOL, STOP);
1768 reduce (p, NO_NOTE, NO_TICK, CONFORMITY_CLAUSE, OPEN_PART, CONFORMITY_CHOICE, BRIEF_CONFORMITY_OUSE_PART, STOP);
1769 } else if (IS (p, ELSE_OPEN_PART)) {
1770 reduce (p, NO_NOTE, NO_TICK, BRIEF_ELIF_PART, ELSE_OPEN_PART, CHOICE, CHOICE, CLOSE_SYMBOL, STOP);
1771 reduce (p, NO_NOTE, NO_TICK, BRIEF_ELIF_PART, ELSE_OPEN_PART, CHOICE, CLOSE_SYMBOL, STOP);
1772 reduce (p, NO_NOTE, NO_TICK, BRIEF_ELIF_PART, ELSE_OPEN_PART, CHOICE, BRIEF_ELIF_PART, STOP);
1773 reduce (p, NO_NOTE, NO_TICK, BRIEF_OUSE_PART, ELSE_OPEN_PART, CASE_CHOICE_CLAUSE, CHOICE, CLOSE_SYMBOL, STOP);
1774 reduce (p, NO_NOTE, NO_TICK, BRIEF_OUSE_PART, ELSE_OPEN_PART, CASE_CHOICE_CLAUSE, CLOSE_SYMBOL, STOP);
1775 reduce (p, NO_NOTE, NO_TICK, BRIEF_OUSE_PART, ELSE_OPEN_PART, CASE_CHOICE_CLAUSE, BRIEF_OUSE_PART, STOP);
1776 reduce (p, NO_NOTE, NO_TICK, BRIEF_CONFORMITY_OUSE_PART, ELSE_OPEN_PART, CONFORMITY_CHOICE, CHOICE, CLOSE_SYMBOL, STOP);
1777 reduce (p, NO_NOTE, NO_TICK, BRIEF_CONFORMITY_OUSE_PART, ELSE_OPEN_PART, CONFORMITY_CHOICE, CLOSE_SYMBOL, STOP);
1778 reduce (p, NO_NOTE, NO_TICK, BRIEF_CONFORMITY_OUSE_PART, ELSE_OPEN_PART, CONFORMITY_CHOICE, BRIEF_CONFORMITY_OUSE_PART, STOP);
1779 } else if (IS (p, IF_PART)) {
1780 reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, IF_PART, THEN_PART, ELSE_PART, FI_SYMBOL, STOP);
1781 reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, IF_PART, THEN_PART, ELIF_PART, STOP);
1782 reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, IF_PART, THEN_PART, FI_SYMBOL, STOP);
1783 } else if (IS (p, ELIF_IF_PART)) {
1784 reduce (p, NO_NOTE, NO_TICK, ELIF_PART, ELIF_IF_PART, THEN_PART, ELSE_PART, FI_SYMBOL, STOP);
1785 reduce (p, NO_NOTE, NO_TICK, ELIF_PART, ELIF_IF_PART, THEN_PART, FI_SYMBOL, STOP);
1786 reduce (p, NO_NOTE, NO_TICK, ELIF_PART, ELIF_IF_PART, THEN_PART, ELIF_PART, STOP);
1787 } else if (IS (p, CASE_PART)) {
1788 reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, CASE_PART, CASE_IN_PART, OUT_PART, ESAC_SYMBOL, STOP);
1789 reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, CASE_PART, CASE_IN_PART, ESAC_SYMBOL, STOP);
1790 reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, CASE_PART, CASE_IN_PART, CASE_OUSE_PART, STOP);
1791 reduce (p, NO_NOTE, NO_TICK, CONFORMITY_CLAUSE, CASE_PART, CONFORMITY_IN_PART, OUT_PART, ESAC_SYMBOL, STOP);
1792 reduce (p, NO_NOTE, NO_TICK, CONFORMITY_CLAUSE, CASE_PART, CONFORMITY_IN_PART, ESAC_SYMBOL, STOP);
1793 reduce (p, NO_NOTE, NO_TICK, CONFORMITY_CLAUSE, CASE_PART, CONFORMITY_IN_PART, CONFORMITY_OUSE_PART, STOP);
1794 } else if (IS (p, OUSE_PART)) {
1795 reduce (p, NO_NOTE, NO_TICK, CASE_OUSE_PART, OUSE_PART, CASE_IN_PART, OUT_PART, ESAC_SYMBOL, STOP);
1796 reduce (p, NO_NOTE, NO_TICK, CASE_OUSE_PART, OUSE_PART, CASE_IN_PART, ESAC_SYMBOL, STOP);
1797 reduce (p, NO_NOTE, NO_TICK, CASE_OUSE_PART, OUSE_PART, CASE_IN_PART, CASE_OUSE_PART, STOP);
1798 reduce (p, NO_NOTE, NO_TICK, CONFORMITY_OUSE_PART, OUSE_PART, CONFORMITY_IN_PART, OUT_PART, ESAC_SYMBOL, STOP);
1799 reduce (p, NO_NOTE, NO_TICK, CONFORMITY_OUSE_PART, OUSE_PART, CONFORMITY_IN_PART, ESAC_SYMBOL, STOP);
1800 reduce (p, NO_NOTE, NO_TICK, CONFORMITY_OUSE_PART, OUSE_PART, CONFORMITY_IN_PART, CONFORMITY_OUSE_PART, STOP);
1801 } else if (IS (p, FOR_PART)) {
1802 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, BY_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
1803 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, BY_PART, WHILE_PART, ALT_DO_PART, STOP);
1804 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
1805 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, WHILE_PART, ALT_DO_PART, STOP);
1806 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, BY_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
1807 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, BY_PART, WHILE_PART, ALT_DO_PART, STOP);
1808 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
1809 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, WHILE_PART, ALT_DO_PART, STOP);
1810 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, BY_PART, TO_PART, ALT_DO_PART, STOP);
1811 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, BY_PART, ALT_DO_PART, STOP);
1812 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, TO_PART, ALT_DO_PART, STOP);
1813 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, ALT_DO_PART, STOP);
1814 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, BY_PART, TO_PART, ALT_DO_PART, STOP);
1815 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, BY_PART, ALT_DO_PART, STOP);
1816 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, TO_PART, ALT_DO_PART, STOP);
1817 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, ALT_DO_PART, STOP);
1818 } else if (IS (p, FROM_PART)) {
1819 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, BY_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
1820 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, BY_PART, WHILE_PART, ALT_DO_PART, STOP);
1821 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
1822 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, WHILE_PART, ALT_DO_PART, STOP);
1823 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, BY_PART, TO_PART, ALT_DO_PART, STOP);
1824 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, BY_PART, ALT_DO_PART, STOP);
1825 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, TO_PART, ALT_DO_PART, STOP);
1826 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, ALT_DO_PART, STOP);
1827 } else if (IS (p, BY_PART)) {
1828 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, BY_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
1829 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, BY_PART, WHILE_PART, ALT_DO_PART, STOP);
1830 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, BY_PART, TO_PART, ALT_DO_PART, STOP);
1831 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, BY_PART, ALT_DO_PART, STOP);
1832 } else if (IS (p, TO_PART)) {
1833 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
1834 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, TO_PART, ALT_DO_PART, STOP);
1835 } else if (IS (p, WHILE_PART)) {
1836 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, WHILE_PART, ALT_DO_PART, STOP);
1837 } else if (IS (p, DO_PART)) {
1838 reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, DO_PART, STOP);
1839 }
1840 }
1841 }
1842
1843 //! @brief Substitute reduction when a phrase could not be parsed.
1844
1845 void recover_from_error (NODE_T * p, int expect, BOOL_T suppress)
1846 {
1847 // This routine does not do fancy things as that might introduce more errors.
1848 NODE_T *q = p;
1849 if (p == NO_NODE) {
1850 return;
1851 }
1852 if (expect == SOME_CLAUSE) {
1853 expect = serial_or_collateral (p);
1854 }
1855 if (!suppress) {
1856 // Give an error message.
1857 NODE_T *w = p;
1858 char *seq = phrase_to_text (p, &w);
1859 if (strlen (seq) == 0) {
1860 if (ERROR_COUNT (&A68_JOB) == 0) {
1861 diagnostic (A68_SYNTAX_ERROR, w, ERROR_SYNTAX_EXPECTED, expect);
1862 }
1863 } else {
1864 diagnostic (A68_SYNTAX_ERROR, w, ERROR_INVALID_SEQUENCE, seq, expect);
1865 }
1866 if (ERROR_COUNT (&A68_JOB) >= MAX_ERRORS) {
1867 longjmp (A68_PARSER (bottom_up_crash_exit), 1);
1868 }
1869 }
1870 // Try to prevent spurious diagnostics by guessing what was expected.
1871 while (NEXT (q) != NO_NODE) {
1872 FORWARD (q);
1873 }
1874 if (is_one_of (p, BEGIN_SYMBOL, OPEN_SYMBOL, STOP)) {
1875 if (expect == ARGUMENT || expect == COLLATERAL_CLAUSE || expect == PARAMETER_PACK || expect == STRUCTURE_PACK || expect == UNION_PACK) {
1876 make_sub (p, q, expect);
1877 } else if (expect == ENQUIRY_CLAUSE) {
1878 make_sub (p, q, OPEN_PART);
1879 } else if (expect == FORMAL_DECLARERS) {
1880 make_sub (p, q, FORMAL_DECLARERS);
1881 } else {
1882 make_sub (p, q, CLOSED_CLAUSE);
1883 }
1884 } else if (IS (p, FORMAT_DELIMITER_SYMBOL) && expect == FORMAT_TEXT) {
1885 make_sub (p, q, FORMAT_TEXT);
1886 } else if (IS (p, CODE_SYMBOL)) {
1887 make_sub (p, q, CODE_CLAUSE);
1888 } else if (is_one_of (p, THEN_BAR_SYMBOL, CHOICE, STOP)) {
1889 make_sub (p, q, CHOICE);
1890 } else if (is_one_of (p, IF_SYMBOL, IF_PART, STOP)) {
1891 make_sub (p, q, IF_PART);
1892 } else if (is_one_of (p, THEN_SYMBOL, THEN_PART, STOP)) {
1893 make_sub (p, q, THEN_PART);
1894 } else if (is_one_of (p, ELSE_SYMBOL, ELSE_PART, STOP)) {
1895 make_sub (p, q, ELSE_PART);
1896 } else if (is_one_of (p, ELIF_SYMBOL, ELIF_IF_PART, STOP)) {
1897 make_sub (p, q, ELIF_IF_PART);
1898 } else if (is_one_of (p, CASE_SYMBOL, CASE_PART, STOP)) {
1899 make_sub (p, q, CASE_PART);
1900 } else if (is_one_of (p, OUT_SYMBOL, OUT_PART, STOP)) {
1901 make_sub (p, q, OUT_PART);
1902 } else if (is_one_of (p, OUSE_SYMBOL, OUSE_PART, STOP)) {
1903 make_sub (p, q, OUSE_PART);
1904 } else if (is_one_of (p, FOR_SYMBOL, FOR_PART, STOP)) {
1905 make_sub (p, q, FOR_PART);
1906 } else if (is_one_of (p, FROM_SYMBOL, FROM_PART, STOP)) {
1907 make_sub (p, q, FROM_PART);
1908 } else if (is_one_of (p, BY_SYMBOL, BY_PART, STOP)) {
1909 make_sub (p, q, BY_PART);
1910 } else if (is_one_of (p, TO_SYMBOL, DOWNTO_SYMBOL, TO_PART, STOP)) {
1911 make_sub (p, q, TO_PART);
1912 } else if (is_one_of (p, WHILE_SYMBOL, WHILE_PART, STOP)) {
1913 make_sub (p, q, WHILE_PART);
1914 } else if (is_one_of (p, UNTIL_SYMBOL, UNTIL_PART, STOP)) {
1915 make_sub (p, q, UNTIL_PART);
1916 } else if (is_one_of (p, DO_SYMBOL, DO_PART, STOP)) {
1917 make_sub (p, q, DO_PART);
1918 } else if (is_one_of (p, ALT_DO_SYMBOL, ALT_DO_PART, STOP)) {
1919 make_sub (p, q, ALT_DO_PART);
1920 } else if (non_terminal_string (A68 (edit_line), expect) != NO_TEXT) {
1921 make_sub (p, q, expect);
1922 }
1923 }
1924
1925 //! @brief Heuristic aid in pinpointing errors.
1926
1927 void reduce_erroneous_units (NODE_T * p)
1928 {
1929 // Constructs are reduced to units in an attempt to limit spurious diagnostics.
1930 for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) {
1931 // Some implementations allow selection from a tertiary, when there is no risk
1932 // of ambiguity. Algol68G follows RR, so some extra attention here to guide an
1933 // unsuspecting user.
1934 if (whether (q, SELECTOR, -SECONDARY, STOP)) {
1935 diagnostic (A68_SYNTAX_ERROR, NEXT (q), ERROR_SYNTAX_EXPECTED, SECONDARY);
1936 reduce (q, NO_NOTE, NO_TICK, UNIT, SELECTOR, WILDCARD, STOP);
1937 }
1938 // Attention for identity relations that require tertiaries.
1939 if (whether (q, -TERTIARY, IS_SYMBOL, TERTIARY, STOP) || whether (q, TERTIARY, IS_SYMBOL, -TERTIARY, STOP) || whether (q, -TERTIARY, IS_SYMBOL, -TERTIARY, STOP)) {
1940 diagnostic (A68_SYNTAX_ERROR, NEXT (q), ERROR_SYNTAX_EXPECTED, TERTIARY);
1941 reduce (q, NO_NOTE, NO_TICK, UNIT, WILDCARD, IS_SYMBOL, WILDCARD, STOP);
1942 } else if (whether (q, -TERTIARY, ISNT_SYMBOL, TERTIARY, STOP) || whether (q, TERTIARY, ISNT_SYMBOL, -TERTIARY, STOP) || whether (q, -TERTIARY, ISNT_SYMBOL, -TERTIARY, STOP)) {
1943 diagnostic (A68_SYNTAX_ERROR, NEXT (q), ERROR_SYNTAX_EXPECTED, TERTIARY);
1944 reduce (q, NO_NOTE, NO_TICK, UNIT, WILDCARD, ISNT_SYMBOL, WILDCARD, STOP);
1945 }
1946 }
1947 }
1948
1949 // A posteriori checks of the syntax tree built by the BU parser.
1950
1951 //! @brief Driver for a posteriori error checking.
1952
1953 void bottom_up_error_check (NODE_T * p)
1954 {
1955 for (; p != NO_NODE; FORWARD (p)) {
1956 if (IS (p, BOOLEAN_PATTERN)) {
1957 int k = 0;
1958 count_pictures (SUB (p), &k);
1959 if (!(k == 0 || k == 2)) {
1960 diagnostic (A68_SYNTAX_ERROR, p, ERROR_FORMAT_PICTURE_NUMBER, ATTRIBUTE (p));
1961 }
1962 } else {
1963 bottom_up_error_check (SUB (p));
1964 }
1965 }
1966 }
1967
1968 // Next part rearranges and checks the tree after the symbol tables are finished.
1969
1970 //! @brief Transfer IDENTIFIER to JUMP where appropriate.
1971
1972 void rearrange_goto_less_jumps (NODE_T * p)
1973 {
1974 for (; p != NO_NODE; FORWARD (p)) {
1975 if (IS (p, UNIT)) {
1976 NODE_T *q = SUB (p);
1977 if (IS (q, TERTIARY)) {
1978 NODE_T *tertiary = q;
1979 q = SUB (q);
1980 if (q != NO_NODE && IS (q, SECONDARY)) {
1981 q = SUB (q);
1982 if (q != NO_NODE && IS (q, PRIMARY)) {
1983 q = SUB (q);
1984 if (q != NO_NODE && IS (q, IDENTIFIER)) {
1985 if (is_identifier_or_label_global (TABLE (q), NSYMBOL (q)) == LABEL) {
1986 ATTRIBUTE (tertiary) = JUMP;
1987 SUB (tertiary) = q;
1988 }
1989 }
1990 }
1991 }
1992 }
1993 } else if (IS (p, TERTIARY)) {
1994 NODE_T *q = SUB (p);
1995 if (q != NO_NODE && IS (q, SECONDARY)) {
1996 NODE_T *secondary = q;
1997 q = SUB (q);
1998 if (q != NO_NODE && IS (q, PRIMARY)) {
1999 q = SUB (q);
2000 if (q != NO_NODE && IS (q, IDENTIFIER)) {
2001 if (is_identifier_or_label_global (TABLE (q), NSYMBOL (q)) == LABEL) {
2002 ATTRIBUTE (secondary) = JUMP;
2003 SUB (secondary) = q;
2004 }
2005 }
2006 }
2007 }
2008 } else if (IS (p, SECONDARY)) {
2009 NODE_T *q = SUB (p);
2010 if (q != NO_NODE && IS (q, PRIMARY)) {
2011 NODE_T *primary = q;
2012 q = SUB (q);
2013 if (q != NO_NODE && IS (q, IDENTIFIER)) {
2014 if (is_identifier_or_label_global (TABLE (q), NSYMBOL (q)) == LABEL) {
2015 ATTRIBUTE (primary) = JUMP;
2016 SUB (primary) = q;
2017 }
2018 }
2019 }
2020 } else if (IS (p, PRIMARY)) {
2021 NODE_T *q = SUB (p);
2022 if (q != NO_NODE && IS (q, IDENTIFIER)) {
2023 if (is_identifier_or_label_global (TABLE (q), NSYMBOL (q)) == LABEL) {
2024 make_sub (q, q, JUMP);
2025 }
2026 }
2027 }
2028 rearrange_goto_less_jumps (SUB (p));
2029 }
2030 }