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


© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)