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