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