parser-top-down.c

     
   1  //! @file parser-top-down.c
   2  //! @author J. Marcel van der Veer
   3  //!
   4  //! @section Copyright
   5  //!
   6  //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
   7  //! Copyright 2001-2023 J. Marcel van der Veer [algol68g@xs4all.nl].
   8  //!
   9  //! @section License
  10  //!
  11  //! This program is free software; you can redistribute it and/or modify it 
  12  //! under the terms of the GNU General Public License as published by the 
  13  //! Free Software Foundation; either version 3 of the License, or 
  14  //! (at your option) any later version.
  15  //!
  16  //! This program is distributed in the hope that it will be useful, but 
  17  //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
  18  //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 
  19  //! more details. You should have received a copy of the GNU General Public 
  20  //! License along with this program. If not, see [http://www.gnu.org/licenses/].
  21  
  22  //! @section Synopsis 
  23  //!
  24  //! Top-down parser for control structure.
  25  
  26  #include "a68g.h"
  27  #include "a68g-parser.h"
  28  
  29  // Top-down parser, elaborates the control structure.
  30  
  31  //! @brief Substitute brackets.
  32  
  33  void substitute_brackets (NODE_T * p)
  34  {
  35    for (; p != NO_NODE; FORWARD (p)) {
  36      substitute_brackets (SUB (p));
  37      switch (ATTRIBUTE (p)) {
  38      case ACCO_SYMBOL:
  39        {
  40          ATTRIBUTE (p) = OPEN_SYMBOL;
  41          break;
  42        }
  43      case OCCA_SYMBOL:
  44        {
  45          ATTRIBUTE (p) = CLOSE_SYMBOL;
  46          break;
  47        }
  48      case SUB_SYMBOL:
  49        {
  50          ATTRIBUTE (p) = OPEN_SYMBOL;
  51          break;
  52        }
  53      case BUS_SYMBOL:
  54        {
  55          ATTRIBUTE (p) = CLOSE_SYMBOL;
  56          break;
  57        }
  58      }
  59    }
  60  }
  61  
  62  //! @brief Intelligible diagnostic from syntax tree branch.
  63  
  64  char *phrase_to_text (NODE_T * p, NODE_T ** w)
  65  {
  66  #define MAX_TERMINALS 8
  67    int count = 0, line = -1;
  68    static BUFFER buffer;
  69    for (buffer[0] = NULL_CHAR; p != NO_NODE && count < MAX_TERMINALS; FORWARD (p)) {
  70      if (LINE_NUMBER (p) > 0) {
  71        int gatt = get_good_attribute (p);
  72        char *z = non_terminal_string (A68 (input_line), gatt);
  73  // Where to put the error message? Bob Uzgalis noted that actual content of a 
  74  // diagnostic is not as important as accurately indicating *were* the problem is! 
  75        if (w != NO_VAR) {
  76          if (count == 0 || (*w) == NO_NODE) {
  77            *w = p;
  78          } else if (dont_mark_here (*w)) {
  79            *w = p;
  80          }
  81        }
  82  // Add initiation.
  83        if (count == 0) {
  84          if (w != NO_VAR) {
  85            bufcat (buffer, "construct beginning with", BUFFER_SIZE);
  86          }
  87        } else if (count == 1) {
  88          bufcat (buffer, " followed by", BUFFER_SIZE);
  89        } else if (count == 2) {
  90          bufcat (buffer, " and then", BUFFER_SIZE);
  91        } else if (count >= 3) {
  92          bufcat (buffer, " and", BUFFER_SIZE);
  93        }
  94  // Attribute or symbol.
  95        if (z != NO_TEXT && SUB (p) != NO_NODE) {
  96          if (gatt == IDENTIFIER || gatt == OPERATOR || gatt == DENOTATION) {
  97            ASSERT (snprintf (A68 (edit_line), SNPRINTF_SIZE, " \"%s\"", NSYMBOL (p)) >= 0);
  98            bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
  99          } else {
 100            if (strchr ("aeio", z[0]) != NO_TEXT) {
 101              bufcat (buffer, " an", BUFFER_SIZE);
 102            } else {
 103              bufcat (buffer, " a", BUFFER_SIZE);
 104            }
 105            ASSERT (snprintf (A68 (edit_line), SNPRINTF_SIZE, " %s", z) >= 0);
 106            bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
 107          }
 108        } else if (z != NO_TEXT && SUB (p) == NO_NODE) {
 109          ASSERT (snprintf (A68 (edit_line), SNPRINTF_SIZE, " \"%s\"", NSYMBOL (p)) >= 0);
 110          bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
 111        } else if (NSYMBOL (p) != NO_TEXT) {
 112          ASSERT (snprintf (A68 (edit_line), SNPRINTF_SIZE, " \"%s\"", NSYMBOL (p)) >= 0);
 113          bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
 114        }
 115  // Add "starting in line nn".
 116        if (z != NO_TEXT && line != LINE_NUMBER (p)) {
 117          line = LINE_NUMBER (p);
 118          if (gatt == SERIAL_CLAUSE || gatt == ENQUIRY_CLAUSE || gatt == INITIALISER_SERIES) {
 119            bufcat (buffer, " starting", BUFFER_SIZE);
 120          }
 121          ASSERT (snprintf (A68 (edit_line), SNPRINTF_SIZE, " in line %d", line) >= 0);
 122          bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
 123        }
 124        count++;
 125      }
 126    }
 127    if (p != NO_NODE && count == MAX_TERMINALS) {
 128      bufcat (buffer, " etcetera", BUFFER_SIZE);
 129    }
 130    return buffer;
 131  }
 132  
 133  // Next is a top-down parser that branches out the basic blocks.
 134  // After this we can assign symbol tables to basic blocks.
 135  // This renders the two-level grammar LALR.
 136  
 137  //! @brief Give diagnose from top-down parser.
 138  
 139  void top_down_diagnose (NODE_T * start, NODE_T * posit, int clause, int expected)
 140  {
 141    NODE_T *issue = (posit != NO_NODE ? posit : start);
 142    if (expected != 0) {
 143      diagnostic (A68_SYNTAX_ERROR, issue, ERROR_EXPECTED_NEAR, expected, clause, NSYMBOL (start), LINE (INFO (start)));
 144    } else {
 145      diagnostic (A68_SYNTAX_ERROR, issue, ERROR_UNBALANCED_KEYWORD, clause, NSYMBOL (start), LINE (INFO (start)));
 146    }
 147  }
 148  
 149  //! @brief Check for premature exhaustion of tokens.
 150  
 151  void tokens_exhausted (NODE_T * p, NODE_T * q)
 152  {
 153    if (p == NO_NODE) {
 154      diagnostic (A68_SYNTAX_ERROR, q, ERROR_KEYWORD);
 155      longjmp (A68_PARSER (top_down_crash_exit), 1);
 156    }
 157  }
 158  
 159  // This part specifically branches out loop clauses.
 160  
 161  //! @brief Whether in cast or formula with loop clause.
 162  
 163  int is_loop_cast_formula (NODE_T * p)
 164  {
 165  // Accept declarers that can appear in such casts but not much more.
 166    if (IS (p, VOID_SYMBOL)) {
 167      return 1;
 168    } else if (IS (p, INT_SYMBOL)) {
 169      return 1;
 170    } else if (IS_REF (p)) {
 171      return 1;
 172    } else if (is_one_of (p, OPERATOR, BOLD_TAG, STOP)) {
 173      return 1;
 174    } else if (whether (p, UNION_SYMBOL, OPEN_SYMBOL, STOP)) {
 175      return 2;
 176    } else if (is_one_of (p, OPEN_SYMBOL, SUB_SYMBOL, STOP)) {
 177      int k;
 178      for (k = 0; p != NO_NODE && (is_one_of (p, OPEN_SYMBOL, SUB_SYMBOL, STOP)); FORWARD (p), k++) {
 179        ;
 180      }
 181      return p != NO_NODE && (whether (p, UNION_SYMBOL, OPEN_SYMBOL, STOP) ? k : 0);
 182    }
 183    return 0;
 184  }
 185  
 186  //! @brief Skip a unit in a loop clause (FROM u BY u TO u).
 187  
 188  NODE_T *top_down_skip_loop_unit (NODE_T * p)
 189  {
 190  // Unit may start with, or consist of, a loop.
 191    if (is_loop_keyword (p)) {
 192      p = top_down_loop (p);
 193    }
 194  // Skip rest of unit.
 195    while (p != NO_NODE) {
 196      int k = is_loop_cast_formula (p);
 197      if (k != 0) {
 198  // operator-cast series ...
 199        while (p != NO_NODE && k != 0) {
 200          while (k != 0) {
 201            FORWARD (p);
 202            k--;
 203          }
 204          k = is_loop_cast_formula (p);
 205        }
 206  // ... may be followed by a loop clause.
 207        if (is_loop_keyword (p)) {
 208          p = top_down_loop (p);
 209        }
 210      } else if (is_loop_keyword (p) || IS (p, OD_SYMBOL)) {
 211  // new loop or end-of-loop.
 212        return p;
 213      } else if (IS (p, COLON_SYMBOL)) {
 214        FORWARD (p);
 215  // skip routine header: loop clause.
 216        if (p != NO_NODE && is_loop_keyword (p)) {
 217          p = top_down_loop (p);
 218        }
 219      } else if (is_one_of (p, SEMI_SYMBOL, COMMA_SYMBOL, STOP) || IS (p, EXIT_SYMBOL)) {
 220  // Statement separators.
 221        return p;
 222      } else {
 223        FORWARD (p);
 224      }
 225    }
 226    return NO_NODE;
 227  }
 228  
 229  //! @brief Skip a loop clause.
 230  
 231  NODE_T *top_down_skip_loop_series (NODE_T * p)
 232  {
 233    BOOL_T siga;
 234    do {
 235      p = top_down_skip_loop_unit (p);
 236      siga = (BOOL_T) (p != NO_NODE && (is_one_of (p, SEMI_SYMBOL, EXIT_SYMBOL, COMMA_SYMBOL, COLON_SYMBOL, STOP)));
 237      if (siga) {
 238        FORWARD (p);
 239      }
 240    } while (!(p == NO_NODE || !siga));
 241    return p;
 242  }
 243  
 244  //! @brief Make branch of loop parts.
 245  
 246  NODE_T *top_down_loop (NODE_T * p)
 247  {
 248    NODE_T *start = p, *q = p, *save;
 249    if (IS (q, FOR_SYMBOL)) {
 250      tokens_exhausted (FORWARD (q), start);
 251      if (IS (q, IDENTIFIER)) {
 252        ATTRIBUTE (q) = DEFINING_IDENTIFIER;
 253      } else {
 254        top_down_diagnose (start, q, LOOP_CLAUSE, IDENTIFIER);
 255        longjmp (A68_PARSER (top_down_crash_exit), 1);
 256      }
 257      tokens_exhausted (FORWARD (q), start);
 258      if (is_one_of (q, FROM_SYMBOL, BY_SYMBOL, TO_SYMBOL, DOWNTO_SYMBOL, WHILE_SYMBOL, STOP)) {
 259        ;
 260      } else if (IS (q, DO_SYMBOL)) {
 261        ATTRIBUTE (q) = ALT_DO_SYMBOL;
 262      } else {
 263        top_down_diagnose (start, q, LOOP_CLAUSE, STOP);
 264        longjmp (A68_PARSER (top_down_crash_exit), 1);
 265      }
 266    }
 267    if (IS (q, FROM_SYMBOL)) {
 268      start = q;
 269      q = top_down_skip_loop_unit (NEXT (q));
 270      tokens_exhausted (q, start);
 271      if (is_one_of (q, BY_SYMBOL, TO_SYMBOL, DOWNTO_SYMBOL, WHILE_SYMBOL, STOP)) {
 272        ;
 273      } else if (IS (q, DO_SYMBOL)) {
 274        ATTRIBUTE (q) = ALT_DO_SYMBOL;
 275      } else {
 276        top_down_diagnose (start, q, LOOP_CLAUSE, STOP);
 277        longjmp (A68_PARSER (top_down_crash_exit), 1);
 278      }
 279      make_sub (start, PREVIOUS (q), FROM_SYMBOL);
 280    }
 281    if (IS (q, BY_SYMBOL)) {
 282      start = q;
 283      q = top_down_skip_loop_series (NEXT (q));
 284      tokens_exhausted (q, start);
 285      if (is_one_of (q, TO_SYMBOL, DOWNTO_SYMBOL, WHILE_SYMBOL, STOP)) {
 286        ;
 287      } else if (IS (q, DO_SYMBOL)) {
 288        ATTRIBUTE (q) = ALT_DO_SYMBOL;
 289      } else {
 290        top_down_diagnose (start, q, LOOP_CLAUSE, STOP);
 291        longjmp (A68_PARSER (top_down_crash_exit), 1);
 292      }
 293      make_sub (start, PREVIOUS (q), BY_SYMBOL);
 294    }
 295    if (is_one_of (q, TO_SYMBOL, DOWNTO_SYMBOL, STOP)) {
 296      start = q;
 297      q = top_down_skip_loop_series (NEXT (q));
 298      tokens_exhausted (q, start);
 299      if (IS (q, WHILE_SYMBOL)) {
 300        ;
 301      } else if (IS (q, DO_SYMBOL)) {
 302        ATTRIBUTE (q) = ALT_DO_SYMBOL;
 303      } else {
 304        top_down_diagnose (start, q, LOOP_CLAUSE, STOP);
 305        longjmp (A68_PARSER (top_down_crash_exit), 1);
 306      }
 307      make_sub (start, PREVIOUS (q), TO_SYMBOL);
 308    }
 309    if (IS (q, WHILE_SYMBOL)) {
 310      start = q;
 311      q = top_down_skip_loop_series (NEXT (q));
 312      tokens_exhausted (q, start);
 313      if (IS (q, DO_SYMBOL)) {
 314        ATTRIBUTE (q) = ALT_DO_SYMBOL;
 315      } else {
 316        top_down_diagnose (start, q, LOOP_CLAUSE, DO_SYMBOL);
 317        longjmp (A68_PARSER (top_down_crash_exit), 1);
 318      }
 319      make_sub (start, PREVIOUS (q), WHILE_SYMBOL);
 320    }
 321    if (is_one_of (q, DO_SYMBOL, ALT_DO_SYMBOL, STOP)) {
 322      int k = ATTRIBUTE (q);
 323      start = q;
 324      q = top_down_skip_loop_series (NEXT (q));
 325      tokens_exhausted (q, start);
 326      if (!IS (q, OD_SYMBOL)) {
 327        top_down_diagnose (start, q, LOOP_CLAUSE, OD_SYMBOL);
 328        longjmp (A68_PARSER (top_down_crash_exit), 1);
 329      }
 330      make_sub (start, q, k);
 331    }
 332    save = NEXT (start);
 333    make_sub (p, start, LOOP_CLAUSE);
 334    return save;
 335  }
 336  
 337  //! @brief Driver for making branches of loop parts.
 338  
 339  void top_down_loops (NODE_T * p)
 340  {
 341    NODE_T *q = p;
 342    for (; q != NO_NODE; FORWARD (q)) {
 343      if (SUB (q) != NO_NODE) {
 344        top_down_loops (SUB (q));
 345      }
 346    }
 347    q = p;
 348    while (q != NO_NODE) {
 349      if (is_loop_keyword (q) != STOP) {
 350        q = top_down_loop (q);
 351      } else {
 352        FORWARD (q);
 353      }
 354    }
 355  }
 356  
 357  //! @brief Driver for making branches of until parts.
 358  
 359  void top_down_untils (NODE_T * p)
 360  {
 361    NODE_T *q = p;
 362    for (; q != NO_NODE; FORWARD (q)) {
 363      if (SUB (q) != NO_NODE) {
 364        top_down_untils (SUB (q));
 365      }
 366    }
 367    q = p;
 368    while (q != NO_NODE) {
 369      if (IS (q, UNTIL_SYMBOL)) {
 370        NODE_T *u = q;
 371        while (NEXT (u) != NO_NODE) {
 372          FORWARD (u);
 373        }
 374        make_sub (q, PREVIOUS (u), UNTIL_SYMBOL);
 375        return;
 376      } else {
 377        FORWARD (q);
 378      }
 379    }
 380  }
 381  
 382  // Branch anything except parts of a loop.
 383  
 384  //! @brief Skip serial/enquiry clause (unit series).
 385  
 386  NODE_T *top_down_series (NODE_T * p)
 387  {
 388    BOOL_T siga = A68_TRUE;
 389    while (siga) {
 390      siga = A68_FALSE;
 391      p = top_down_skip_unit (p);
 392      if (p != NO_NODE) {
 393        if (is_one_of (p, SEMI_SYMBOL, EXIT_SYMBOL, COMMA_SYMBOL, STOP)) {
 394          siga = A68_TRUE;
 395          FORWARD (p);
 396        }
 397      }
 398    }
 399    return p;
 400  }
 401  
 402  //! @brief Make branch of BEGIN .. END.
 403  
 404  NODE_T *top_down_begin (NODE_T * begin_p)
 405  {
 406    NODE_T *end_p = top_down_series (NEXT (begin_p));
 407    if (end_p == NO_NODE || !IS (end_p, END_SYMBOL)) {
 408      top_down_diagnose (begin_p, end_p, ENCLOSED_CLAUSE, END_SYMBOL);
 409      longjmp (A68_PARSER (top_down_crash_exit), 1);
 410      return NO_NODE;
 411    } else {
 412      make_sub (begin_p, end_p, BEGIN_SYMBOL);
 413      return NEXT (begin_p);
 414    }
 415  }
 416  
 417  //! @brief Make branch of CODE .. EDOC.
 418  
 419  NODE_T *top_down_code (NODE_T * code_p)
 420  {
 421    NODE_T *edoc_p = top_down_series (NEXT (code_p));
 422    if (edoc_p == NO_NODE || !IS (edoc_p, EDOC_SYMBOL)) {
 423      diagnostic (A68_SYNTAX_ERROR, code_p, ERROR_KEYWORD);
 424      longjmp (A68_PARSER (top_down_crash_exit), 1);
 425      return NO_NODE;
 426    } else {
 427      make_sub (code_p, edoc_p, CODE_SYMBOL);
 428      return NEXT (code_p);
 429    }
 430  }
 431  
 432  //! @brief Make branch of ( .. ).
 433  
 434  NODE_T *top_down_open (NODE_T * open_p)
 435  {
 436    NODE_T *then_bar_p = top_down_series (NEXT (open_p)), *elif_bar_p;
 437    if (then_bar_p != NO_NODE && IS (then_bar_p, CLOSE_SYMBOL)) {
 438      make_sub (open_p, then_bar_p, OPEN_SYMBOL);
 439      return NEXT (open_p);
 440    }
 441    if (then_bar_p == NO_NODE || !IS (then_bar_p, THEN_BAR_SYMBOL)) {
 442      top_down_diagnose (open_p, then_bar_p, ENCLOSED_CLAUSE, STOP);
 443      longjmp (A68_PARSER (top_down_crash_exit), 1);
 444    }
 445    make_sub (open_p, PREVIOUS (then_bar_p), OPEN_SYMBOL);
 446    elif_bar_p = top_down_series (NEXT (then_bar_p));
 447    if (elif_bar_p != NO_NODE && IS (elif_bar_p, CLOSE_SYMBOL)) {
 448      make_sub (then_bar_p, PREVIOUS (elif_bar_p), THEN_BAR_SYMBOL);
 449      make_sub (open_p, elif_bar_p, OPEN_SYMBOL);
 450      return NEXT (open_p);
 451    }
 452    if (elif_bar_p != NO_NODE && IS (elif_bar_p, THEN_BAR_SYMBOL)) {
 453      NODE_T *close_p = top_down_series (NEXT (elif_bar_p));
 454      if (close_p == NO_NODE || !IS (close_p, CLOSE_SYMBOL)) {
 455        top_down_diagnose (open_p, elif_bar_p, ENCLOSED_CLAUSE, CLOSE_SYMBOL);
 456        longjmp (A68_PARSER (top_down_crash_exit), 1);
 457      }
 458      make_sub (then_bar_p, PREVIOUS (elif_bar_p), THEN_BAR_SYMBOL);
 459      make_sub (elif_bar_p, PREVIOUS (close_p), THEN_BAR_SYMBOL);
 460      make_sub (open_p, close_p, OPEN_SYMBOL);
 461      return NEXT (open_p);
 462    }
 463    if (elif_bar_p != NO_NODE && IS (elif_bar_p, ELSE_BAR_SYMBOL)) {
 464      NODE_T *close_p = top_down_open (elif_bar_p);
 465      make_sub (then_bar_p, PREVIOUS (elif_bar_p), THEN_BAR_SYMBOL);
 466      make_sub (open_p, elif_bar_p, OPEN_SYMBOL);
 467      return close_p;
 468    } else {
 469      top_down_diagnose (open_p, elif_bar_p, ENCLOSED_CLAUSE, CLOSE_SYMBOL);
 470      longjmp (A68_PARSER (top_down_crash_exit), 1);
 471      return NO_NODE;
 472    }
 473  }
 474  
 475  //! @brief Make branch of [ .. ].
 476  
 477  NODE_T *top_down_sub (NODE_T * sub_p)
 478  {
 479    NODE_T *bus_p = top_down_series (NEXT (sub_p));
 480    if (bus_p != NO_NODE && IS (bus_p, BUS_SYMBOL)) {
 481      make_sub (sub_p, bus_p, SUB_SYMBOL);
 482      return NEXT (sub_p);
 483    } else {
 484      top_down_diagnose (sub_p, bus_p, 0, BUS_SYMBOL);
 485      longjmp (A68_PARSER (top_down_crash_exit), 1);
 486      return NO_NODE;
 487    }
 488  }
 489  
 490  //! @brief Make branch of { .. }.
 491  
 492  NODE_T *top_down_acco (NODE_T * acco_p)
 493  {
 494    NODE_T *occa_p = top_down_series (NEXT (acco_p));
 495    if (occa_p != NO_NODE && IS (occa_p, OCCA_SYMBOL)) {
 496      make_sub (acco_p, occa_p, ACCO_SYMBOL);
 497      return NEXT (acco_p);
 498    } else {
 499      top_down_diagnose (acco_p, occa_p, ENCLOSED_CLAUSE, OCCA_SYMBOL);
 500      longjmp (A68_PARSER (top_down_crash_exit), 1);
 501      return NO_NODE;
 502    }
 503  }
 504  
 505  //! @brief Make branch of IF .. THEN .. ELSE .. FI.
 506  
 507  NODE_T *top_down_if (NODE_T * if_p)
 508  {
 509    NODE_T *then_p = top_down_series (NEXT (if_p)), *elif_p;
 510    if (then_p == NO_NODE || !IS (then_p, THEN_SYMBOL)) {
 511      top_down_diagnose (if_p, then_p, CONDITIONAL_CLAUSE, THEN_SYMBOL);
 512      longjmp (A68_PARSER (top_down_crash_exit), 1);
 513    }
 514    make_sub (if_p, PREVIOUS (then_p), IF_SYMBOL);
 515    elif_p = top_down_series (NEXT (then_p));
 516    if (elif_p != NO_NODE && IS (elif_p, FI_SYMBOL)) {
 517      make_sub (then_p, PREVIOUS (elif_p), THEN_SYMBOL);
 518      make_sub (if_p, elif_p, IF_SYMBOL);
 519      return NEXT (if_p);
 520    }
 521    if (elif_p != NO_NODE && IS (elif_p, ELSE_SYMBOL)) {
 522      NODE_T *fi_p = top_down_series (NEXT (elif_p));
 523      if (fi_p == NO_NODE || !IS (fi_p, FI_SYMBOL)) {
 524        top_down_diagnose (if_p, fi_p, CONDITIONAL_CLAUSE, FI_SYMBOL);
 525        longjmp (A68_PARSER (top_down_crash_exit), 1);
 526      } else {
 527        make_sub (then_p, PREVIOUS (elif_p), THEN_SYMBOL);
 528        make_sub (elif_p, PREVIOUS (fi_p), ELSE_SYMBOL);
 529        make_sub (if_p, fi_p, IF_SYMBOL);
 530        return NEXT (if_p);
 531      }
 532    }
 533    if (elif_p != NO_NODE && IS (elif_p, ELIF_SYMBOL)) {
 534      NODE_T *fi_p = top_down_if (elif_p);
 535      make_sub (then_p, PREVIOUS (elif_p), THEN_SYMBOL);
 536      make_sub (if_p, elif_p, IF_SYMBOL);
 537      return fi_p;
 538    } else {
 539      top_down_diagnose (if_p, elif_p, CONDITIONAL_CLAUSE, FI_SYMBOL);
 540      longjmp (A68_PARSER (top_down_crash_exit), 1);
 541      return NO_NODE;
 542    }
 543  }
 544  
 545  //! @brief Make branch of CASE .. IN .. OUT .. ESAC.
 546  
 547  NODE_T *top_down_case (NODE_T * case_p)
 548  {
 549    NODE_T *in_p = top_down_series (NEXT (case_p)), *ouse_p;
 550    if (in_p == NO_NODE || !IS (in_p, IN_SYMBOL)) {
 551      top_down_diagnose (case_p, in_p, ENCLOSED_CLAUSE, IN_SYMBOL);
 552      longjmp (A68_PARSER (top_down_crash_exit), 1);
 553    }
 554    make_sub (case_p, PREVIOUS (in_p), CASE_SYMBOL);
 555    ouse_p = top_down_series (NEXT (in_p));
 556    if (ouse_p != NO_NODE && IS (ouse_p, ESAC_SYMBOL)) {
 557      make_sub (in_p, PREVIOUS (ouse_p), IN_SYMBOL);
 558      make_sub (case_p, ouse_p, CASE_SYMBOL);
 559      return NEXT (case_p);
 560    }
 561    if (ouse_p != NO_NODE && IS (ouse_p, OUT_SYMBOL)) {
 562      NODE_T *esac_p = top_down_series (NEXT (ouse_p));
 563      if (esac_p == NO_NODE || !IS (esac_p, ESAC_SYMBOL)) {
 564        top_down_diagnose (case_p, esac_p, ENCLOSED_CLAUSE, ESAC_SYMBOL);
 565        longjmp (A68_PARSER (top_down_crash_exit), 1);
 566      } else {
 567        make_sub (in_p, PREVIOUS (ouse_p), IN_SYMBOL);
 568        make_sub (ouse_p, PREVIOUS (esac_p), OUT_SYMBOL);
 569        make_sub (case_p, esac_p, CASE_SYMBOL);
 570        return NEXT (case_p);
 571      }
 572    }
 573    if (ouse_p != NO_NODE && IS (ouse_p, OUSE_SYMBOL)) {
 574      NODE_T *esac_p = top_down_case (ouse_p);
 575      make_sub (in_p, PREVIOUS (ouse_p), IN_SYMBOL);
 576      make_sub (case_p, ouse_p, CASE_SYMBOL);
 577      return esac_p;
 578    } else {
 579      top_down_diagnose (case_p, ouse_p, ENCLOSED_CLAUSE, ESAC_SYMBOL);
 580      longjmp (A68_PARSER (top_down_crash_exit), 1);
 581      return NO_NODE;
 582    }
 583  }
 584  
 585  //! @brief Skip a unit.
 586  
 587  NODE_T *top_down_skip_unit (NODE_T * p)
 588  {
 589    while (p != NO_NODE && !is_unit_terminator (p)) {
 590      if (IS (p, BEGIN_SYMBOL)) {
 591        p = top_down_begin (p);
 592      } else if (IS (p, SUB_SYMBOL)) {
 593        p = top_down_sub (p);
 594      } else if (IS (p, OPEN_SYMBOL)) {
 595        p = top_down_open (p);
 596      } else if (IS (p, IF_SYMBOL)) {
 597        p = top_down_if (p);
 598      } else if (IS (p, CASE_SYMBOL)) {
 599        p = top_down_case (p);
 600      } else if (IS (p, CODE_SYMBOL)) {
 601        p = top_down_code (p);
 602      } else if (IS (p, ACCO_SYMBOL)) {
 603        p = top_down_acco (p);
 604      } else {
 605        FORWARD (p);
 606      }
 607    }
 608    return p;
 609  }
 610  
 611  NODE_T *top_down_skip_format (NODE_T *);
 612  
 613  //! @brief Make branch of ( .. ) in a format.
 614  
 615  NODE_T *top_down_format_open (NODE_T * open_p)
 616  {
 617    NODE_T *close_p = top_down_skip_format (NEXT (open_p));
 618    if (close_p != NO_NODE && IS (close_p, FORMAT_CLOSE_SYMBOL)) {
 619      make_sub (open_p, close_p, FORMAT_OPEN_SYMBOL);
 620      return NEXT (open_p);
 621    } else {
 622      top_down_diagnose (open_p, close_p, 0, FORMAT_CLOSE_SYMBOL);
 623      longjmp (A68_PARSER (top_down_crash_exit), 1);
 624      return NO_NODE;
 625    }
 626  }
 627  
 628  //! @brief Skip a format text.
 629  
 630  NODE_T *top_down_skip_format (NODE_T * p)
 631  {
 632    while (p != NO_NODE) {
 633      if (IS (p, FORMAT_OPEN_SYMBOL)) {
 634        p = top_down_format_open (p);
 635      } else if (is_one_of (p, FORMAT_CLOSE_SYMBOL, FORMAT_DELIMITER_SYMBOL, STOP)) {
 636        return p;
 637      } else {
 638        FORWARD (p);
 639      }
 640    }
 641    return NO_NODE;
 642  }
 643  
 644  //! @brief Make branch of $ .. $.
 645  
 646  void top_down_formats (NODE_T * p)
 647  {
 648    NODE_T *q;
 649    for (q = p; q != NO_NODE; FORWARD (q)) {
 650      if (SUB (q) != NO_NODE) {
 651        top_down_formats (SUB (q));
 652      }
 653    }
 654    for (q = p; q != NO_NODE; FORWARD (q)) {
 655      if (IS (q, FORMAT_DELIMITER_SYMBOL)) {
 656        NODE_T *f = NEXT (q);
 657        while (f != NO_NODE && !IS (f, FORMAT_DELIMITER_SYMBOL)) {
 658          if (IS (f, FORMAT_OPEN_SYMBOL)) {
 659            f = top_down_format_open (f);
 660          } else {
 661            f = NEXT (f);
 662          }
 663        }
 664        if (f == NO_NODE) {
 665          top_down_diagnose (p, f, FORMAT_TEXT, FORMAT_DELIMITER_SYMBOL);
 666          longjmp (A68_PARSER (top_down_crash_exit), 1);
 667        } else {
 668          make_sub (q, f, FORMAT_DELIMITER_SYMBOL);
 669        }
 670      }
 671    }
 672  }
 673  
 674  //! @brief Make branches of phrases for the bottom-up parser.
 675  
 676  void top_down_parser (NODE_T * p)
 677  {
 678    if (p != NO_NODE) {
 679      if (!setjmp (A68_PARSER (top_down_crash_exit))) {
 680        (void) top_down_series (p);
 681        top_down_loops (p);
 682        top_down_untils (p);
 683        top_down_formats (p);
 684      }
 685    }
 686  }