parser-refinement.c

     
   1  //! @file parser-refinement.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  //! Refinement preprocessor.
  25  
  26  #include "a68g.h"
  27  #include "a68g-parser.h"
  28  
  29  // This code implements a small refinement preprocessor for A68G.
  30  // It is included for educational purposes only.
  31  // At the University of Nijmegen a preprocessor much like this one
  32  // was used as a front-end to FLACC in freshman programming courses.
  33  //
  34  // See: 
  35  //   C.H.A. Koster et al., 
  36  //   Systematisch programmeren in Algol 68, Deel I en II.
  37  //   Kluwer, Deventer [1978, 1981]
  38  //
  39  // The superimposed 'refinement grammar' is trivial:
  40  //   refined-program-option:
  41  //     refined-algol-68-source-code;
  42  //     point-symbol;
  43  //     refinement-definition-sequence-option.
  44  //   refinement-definition:
  45  //     defining-identifier;
  46  //     colon-symbol;
  47  //     refined-Algol-68-source-code;
  48  //     point-symbol.
  49  //   refined-algol-68-source-code:
  50  //     # valid source code,
  51  //       with applied-refinements,
  52  //       without refinement-definitions #.
  53  //   applied-refinement:
  54  //     identifier.
  55  //
  56  // An applied-refinement is textually substituted for its definition.
  57  // Note that refinement-definitions cannot be nested.
  58  // Nested refinement-definitions would allow conflict with Algol 68 labels.
  59  // The naive approach (no nesting) was chosen here to keep matters simple.
  60  //
  61  // Wirth had another approach to refinements in Pascal: procedures.
  62  // That works for Algol 68 as well, of course.
  63  
  64  //! @brief Whether refinement terminator.
  65  
  66  BOOL_T is_refinement_terminator (NODE_T * p)
  67  {
  68    if (IS (p, POINT_SYMBOL)) {
  69      if (IN_PRELUDE (NEXT (p))) {
  70        return A68_TRUE;
  71      } else {
  72        return whether (p, POINT_SYMBOL, IDENTIFIER, COLON_SYMBOL, STOP);
  73      }
  74    } else {
  75      return A68_FALSE;
  76    }
  77  }
  78  
  79  //! @brief Get refinement definitions in the internal source.
  80  
  81  void get_refinements (void)
  82  {
  83    TOP_REFINEMENT (&A68_JOB) = NO_REFINEMENT;
  84  // First look where the prelude ends.
  85    NODE_T *p = TOP_NODE (&A68_JOB);
  86    while (p != NO_NODE && IN_PRELUDE (p)) {
  87      FORWARD (p);
  88    }
  89  // Determine whether the program contains refinements at all.
  90    while (p != NO_NODE && !IN_PRELUDE (p) && !is_refinement_terminator (p)) {
  91      FORWARD (p);
  92    }
  93    if (p == NO_NODE || IN_PRELUDE (p)) {
  94      return;
  95    }
  96    FORWARD (p);
  97    if (p == NO_NODE || IN_PRELUDE (p)) {
  98  // A program without refinements.
  99      return;
 100    }
 101  // Apparently this is code with refinements.
 102    while (p != NO_NODE && !IN_PRELUDE (p) && whether (p, IDENTIFIER, COLON_SYMBOL, STOP)) {
 103      REFINEMENT_T *new_one = (REFINEMENT_T *) get_fixed_heap_space ((size_t) SIZE_ALIGNED (REFINEMENT_T));
 104      NEXT (new_one) = NO_REFINEMENT;
 105      NAME (new_one) = NSYMBOL (p);
 106      APPLICATIONS (new_one) = 0;
 107      LINE_DEFINED (new_one) = LINE (INFO (p));
 108      LINE_APPLIED (new_one) = NO_LINE;
 109      NODE_DEFINED (new_one) = p;
 110      BEGIN (new_one) = END (new_one) = NO_NODE;
 111      p = NEXT_NEXT (p);
 112      if (p == NO_NODE) {
 113        diagnostic (A68_SYNTAX_ERROR, NODE_DEFINED (new_one), ERROR_REFINEMENT_EMPTY);
 114        return;
 115      } else {
 116        BEGIN (new_one) = p;
 117      }
 118      while (p != NO_NODE && ATTRIBUTE (p) != POINT_SYMBOL) {
 119        END (new_one) = p;
 120        FORWARD (p);
 121      }
 122      if (p == NO_NODE) {
 123        diagnostic (A68_SYNTAX_ERROR, NODE_DEFINED (new_one), ERROR_REFINEMENT_INVALID);
 124        return;
 125      } else {
 126        FORWARD (p);
 127      }
 128  // Do we already have one by this name.
 129      REFINEMENT_T *x = TOP_REFINEMENT (&A68_JOB);
 130      BOOL_T exists = A68_FALSE;
 131      while (x != NO_REFINEMENT && !exists) {
 132        if (NAME (x) == NAME (new_one)) {
 133          diagnostic (A68_SYNTAX_ERROR, NODE_DEFINED (new_one), ERROR_REFINEMENT_DEFINED);
 134          exists = A68_TRUE;
 135        }
 136        FORWARD (x);
 137      }
 138  // Straight insertion in chain.
 139      if (!exists) {
 140        NEXT (new_one) = TOP_REFINEMENT (&A68_JOB);
 141        TOP_REFINEMENT (&A68_JOB) = new_one;
 142      }
 143    }
 144    if (p != NO_NODE && !IN_PRELUDE (p)) {
 145      diagnostic (A68_SYNTAX_ERROR, p, ERROR_REFINEMENT_INVALID);
 146    }
 147  }
 148  
 149  //! @brief Put refinement applications in the internal source.
 150  
 151  void put_refinements (void)
 152  {
 153  // If there are no refinements, there's little to do.
 154    if (TOP_REFINEMENT (&A68_JOB) == NO_REFINEMENT) {
 155      return;
 156    }
 157  // Initialisation.
 158    REFINEMENT_T *x = TOP_REFINEMENT (&A68_JOB);
 159    while (x != NO_REFINEMENT) {
 160      APPLICATIONS (x) = 0;
 161      FORWARD (x);
 162    }
 163  // Before we introduce infinite loops, find where closing-prelude starts.
 164    NODE_T *p = TOP_NODE (&A68_JOB);
 165    while (p != NO_NODE && IN_PRELUDE (p)) {
 166      FORWARD (p);
 167    }
 168    while (p != NO_NODE && !IN_PRELUDE (p)) {
 169      FORWARD (p);
 170    }
 171    ABEND (p == NO_NODE, ERROR_INTERNAL_CONSISTENCY, __func__);
 172    NODE_T *point = p;
 173  // We need to substitute until the first point.
 174    p = TOP_NODE (&A68_JOB);
 175    while (p != NO_NODE && ATTRIBUTE (p) != POINT_SYMBOL) {
 176      if (IS (p, IDENTIFIER)) {
 177  // See if we can find its definition.
 178        REFINEMENT_T *y = NO_REFINEMENT;
 179        x = TOP_REFINEMENT (&A68_JOB);
 180        while (x != NO_REFINEMENT && y == NO_REFINEMENT) {
 181          if (NAME (x) == NSYMBOL (p)) {
 182            y = x;
 183          } else {
 184            FORWARD (x);
 185          }
 186        }
 187        if (y != NO_REFINEMENT) {
 188  // We found its definition.
 189          APPLICATIONS (y)++;
 190          if (APPLICATIONS (y) > 1) {
 191            diagnostic (A68_SYNTAX_ERROR, NODE_DEFINED (y), ERROR_REFINEMENT_APPLIED);
 192            FORWARD (p);
 193          } else {
 194  // Tie the definition in the tree.
 195            LINE_APPLIED (y) = LINE (INFO (p));
 196            if (PREVIOUS (p) != NO_NODE) {
 197              NEXT (PREVIOUS (p)) = BEGIN (y);
 198            }
 199            if (BEGIN (y) != NO_NODE) {
 200              PREVIOUS (BEGIN (y)) = PREVIOUS (p);
 201            }
 202            if (NEXT (p) != NO_NODE) {
 203              PREVIOUS (NEXT (p)) = END (y);
 204            }
 205            if (END (y) != NO_NODE) {
 206              NEXT (END (y)) = NEXT (p);
 207            }
 208            p = BEGIN (y);        // So we can substitute the refinements within
 209          }
 210        } else {
 211          FORWARD (p);
 212        }
 213      } else {
 214        FORWARD (p);
 215      }
 216    }
 217  // After the point we ignore it all until the prelude.
 218    if (p != NO_NODE && IS (p, POINT_SYMBOL)) {
 219      if (PREVIOUS (p) != NO_NODE) {
 220        NEXT (PREVIOUS (p)) = point;
 221      }
 222      if (PREVIOUS (point) != NO_NODE) {
 223        PREVIOUS (point) = PREVIOUS (p);
 224      }
 225    } else {
 226      diagnostic (A68_SYNTAX_ERROR, p, ERROR_SYNTAX_EXPECTED, POINT_SYMBOL);
 227    }
 228  // Has the programmer done it well?.
 229    if (ERROR_COUNT (&A68_JOB) == 0) {
 230      x = TOP_REFINEMENT (&A68_JOB);
 231      while (x != NO_REFINEMENT) {
 232        if (APPLICATIONS (x) == 0) {
 233          diagnostic (A68_SYNTAX_ERROR, NODE_DEFINED (x), ERROR_REFINEMENT_NOT_APPLIED);
 234        }
 235        FORWARD (x);
 236      }
 237    }
 238  }
     


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