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


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