parser-bottom-up.c

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