parser-victal.c

     
   1  //! @file parser-victal.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-2025 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  //! Syntax check for formal, actual and virtual declarers.
  25  
  26  #include "a68g.h"
  27  #include "a68g-parser.h"
  28  
  29  BOOL_T victal_check_declarer (NODE_T *, int);
  30  
  31  //! @brief Check generator.
  32  
  33  void victal_check_generator (NODE_T * p)
  34  {
  35    if (!victal_check_declarer (NEXT (p), ACTUAL_DECLARER_MARK)) {
  36      diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "actual declarer");
  37    }
  38  }
  39  
  40  //! @brief Check formal pack.
  41  
  42  void victal_check_formal_pack (NODE_T * p, int x, BOOL_T * z)
  43  {
  44    if (p != NO_NODE) {
  45      if (IS (p, FORMAL_DECLARERS)) {
  46        victal_check_formal_pack (SUB (p), x, z);
  47      } else if (is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, STOP)) {
  48        victal_check_formal_pack (NEXT (p), x, z);
  49      } else if (IS (p, FORMAL_DECLARERS_LIST)) {
  50        victal_check_formal_pack (NEXT (p), x, z);
  51        victal_check_formal_pack (SUB (p), x, z);
  52      } else if (IS (p, DECLARER)) {
  53        victal_check_formal_pack (NEXT (p), x, z);
  54        (*z) &= victal_check_declarer (SUB (p), x);
  55      }
  56    }
  57  }
  58  
  59  //! @brief Check operator declaration.
  60  
  61  void victal_check_operator_dec (NODE_T * p)
  62  {
  63    if (IS (NEXT (p), FORMAL_DECLARERS)) {
  64      BOOL_T z = A68_TRUE;
  65      victal_check_formal_pack (NEXT (p), FORMAL_DECLARER_MARK, &z);
  66      if (!z) {
  67        diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarers");
  68      }
  69      FORWARD (p);
  70    }
  71    if (!victal_check_declarer (NEXT (p), FORMAL_DECLARER_MARK)) {
  72      diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarer");
  73    }
  74  }
  75  
  76  //! @brief Check mode declaration.
  77  
  78  void victal_check_mode_dec (NODE_T * p)
  79  {
  80    if (p != NO_NODE) {
  81      if (IS (p, MODE_DECLARATION)) {
  82        victal_check_mode_dec (SUB (p));
  83        victal_check_mode_dec (NEXT (p));
  84      } else if (is_one_of (p, MODE_SYMBOL, DEFINING_INDICANT, STOP)
  85                 || is_one_of (p, EQUALS_SYMBOL, COMMA_SYMBOL, STOP)) {
  86        victal_check_mode_dec (NEXT (p));
  87      } else if (IS (p, DECLARER)) {
  88        if (!victal_check_declarer (p, ACTUAL_DECLARER_MARK)) {
  89          diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "actual declarer");
  90        }
  91      }
  92    }
  93  }
  94  
  95  //! @brief Check variable declaration.
  96  
  97  void victal_check_variable_dec (NODE_T * p)
  98  {
  99    if (p != NO_NODE) {
 100      if (IS (p, VARIABLE_DECLARATION)) {
 101        victal_check_variable_dec (SUB (p));
 102        victal_check_variable_dec (NEXT (p));
 103      } else if (is_one_of (p, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, STOP) || IS (p, COMMA_SYMBOL)) {
 104        victal_check_variable_dec (NEXT (p));
 105      } else if (IS (p, UNIT)) {
 106        victal_checker (SUB (p));
 107      } else if (IS (p, QUALIFIER)) {
 108        victal_check_variable_dec (NEXT (p));
 109      } else if (IS (p, DECLARER)) {
 110        if (!victal_check_declarer (p, ACTUAL_DECLARER_MARK)) {
 111          diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "actual declarer");
 112        }
 113        victal_check_variable_dec (NEXT (p));
 114      }
 115    }
 116  }
 117  
 118  //! @brief Check identity declaration.
 119  
 120  void victal_check_identity_dec (NODE_T * p)
 121  {
 122    if (p != NO_NODE) {
 123      if (IS (p, IDENTITY_DECLARATION)) {
 124        victal_check_identity_dec (SUB (p));
 125        victal_check_identity_dec (NEXT (p));
 126      } else if (is_one_of (p, DEFINING_IDENTIFIER, EQUALS_SYMBOL, COMMA_SYMBOL, STOP)) {
 127        victal_check_identity_dec (NEXT (p));
 128      } else if (IS (p, UNIT)) {
 129        victal_checker (SUB (p));
 130      } else if (IS (p, DECLARER)) {
 131        if (!victal_check_declarer (p, FORMAL_DECLARER_MARK)) {
 132          diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarer");
 133        }
 134        victal_check_identity_dec (NEXT (p));
 135      }
 136    }
 137  }
 138  
 139  //! @brief Check routine pack.
 140  
 141  void victal_check_routine_pack (NODE_T * p, int x, BOOL_T * z)
 142  {
 143    if (p != NO_NODE) {
 144      if (IS (p, PARAMETER_PACK)) {
 145        victal_check_routine_pack (SUB (p), x, z);
 146      } else if (is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, STOP)) {
 147        victal_check_routine_pack (NEXT (p), x, z);
 148      } else if (is_one_of (p, PARAMETER_LIST, PARAMETER, STOP)) {
 149        victal_check_routine_pack (NEXT (p), x, z);
 150        victal_check_routine_pack (SUB (p), x, z);
 151      } else if (IS (p, DECLARER)) {
 152        *z &= victal_check_declarer (SUB (p), x);
 153      }
 154    }
 155  }
 156  
 157  //! @brief Check routine text.
 158  
 159  void victal_check_routine_text (NODE_T * p)
 160  {
 161    if (IS (p, PARAMETER_PACK)) {
 162      BOOL_T z = A68_TRUE;
 163      victal_check_routine_pack (p, FORMAL_DECLARER_MARK, &z);
 164      if (!z) {
 165        diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarers");
 166      }
 167      FORWARD (p);
 168    }
 169    if (!victal_check_declarer (p, FORMAL_DECLARER_MARK)) {
 170      diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarer");
 171    }
 172    victal_checker (NEXT (p));
 173  }
 174  
 175  //! @brief Check structure pack.
 176  
 177  void victal_check_structure_pack (NODE_T * p, int x, BOOL_T * z)
 178  {
 179    if (p != NO_NODE) {
 180      if (IS (p, STRUCTURE_PACK)) {
 181        victal_check_structure_pack (SUB (p), x, z);
 182      } else if (is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, STOP)) {
 183        victal_check_structure_pack (NEXT (p), x, z);
 184      } else if (is_one_of (p, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD, STOP)) {
 185        victal_check_structure_pack (NEXT (p), x, z);
 186        victal_check_structure_pack (SUB (p), x, z);
 187      } else if (IS (p, DECLARER)) {
 188        (*z) &= victal_check_declarer (SUB (p), x);
 189      }
 190    }
 191  }
 192  
 193  //! @brief Check union pack.
 194  
 195  void victal_check_union_pack (NODE_T * p, int x, BOOL_T * z)
 196  {
 197    if (p != NO_NODE) {
 198      if (IS (p, UNION_PACK)) {
 199        victal_check_union_pack (SUB (p), x, z);
 200      } else if (is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, VOID_SYMBOL, STOP)) {
 201        victal_check_union_pack (NEXT (p), x, z);
 202      } else if (IS (p, UNION_DECLARER_LIST)) {
 203        victal_check_union_pack (NEXT (p), x, z);
 204        victal_check_union_pack (SUB (p), x, z);
 205      } else if (IS (p, DECLARER)) {
 206        victal_check_union_pack (NEXT (p), x, z);
 207        (*z) &= victal_check_declarer (SUB (p), FORMAL_DECLARER_MARK);
 208      }
 209    }
 210  }
 211  
 212  //! @brief Check declarer.
 213  
 214  BOOL_T victal_check_declarer (NODE_T * p, int x)
 215  {
 216    if (p == NO_NODE) {
 217      return A68_FALSE;
 218    } else if (IS (p, DECLARER)) {
 219      return victal_check_declarer (SUB (p), x);
 220    } else if (is_one_of (p, LONGETY, SHORTETY, STOP)) {
 221      return A68_TRUE;
 222    } else if (is_one_of (p, VOID_SYMBOL, INDICANT, STANDARD, STOP)) {
 223      return A68_TRUE;
 224    } else if (IS_REF (p)) {
 225      return victal_check_declarer (NEXT (p), VIRTUAL_DECLARER_MARK);
 226    } else if (IS_FLEX (p)) {
 227      return victal_check_declarer (NEXT (p), x);
 228    } else if (IS (p, BOUNDS)) {
 229      victal_checker (SUB (p));
 230      if (x == FORMAL_DECLARER_MARK) {
 231        diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal bounds");
 232        (void) victal_check_declarer (NEXT (p), x);
 233        return A68_TRUE;
 234      } else if (x == VIRTUAL_DECLARER_MARK) {
 235        diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "virtual bounds");
 236        (void) victal_check_declarer (NEXT (p), x);
 237        return A68_TRUE;
 238      } else {
 239        return victal_check_declarer (NEXT (p), x);
 240      }
 241    } else if (IS (p, FORMAL_BOUNDS)) {
 242      victal_checker (SUB (p));
 243      if (x == ACTUAL_DECLARER_MARK) {
 244        diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "actual bounds");
 245        (void) victal_check_declarer (NEXT (p), x);
 246        return A68_TRUE;
 247      } else {
 248        return victal_check_declarer (NEXT (p), x);
 249      }
 250    } else if (IS (p, STRUCT_SYMBOL)) {
 251      BOOL_T z = A68_TRUE;
 252      victal_check_structure_pack (NEXT (p), x, &z);
 253      return z;
 254    } else if (IS (p, UNION_SYMBOL)) {
 255      BOOL_T z = A68_TRUE;
 256      victal_check_union_pack (NEXT (p), FORMAL_DECLARER_MARK, &z);
 257      if (!z) {
 258        diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarer pack");
 259      }
 260      return A68_TRUE;
 261    } else if (IS (p, PROC_SYMBOL)) {
 262      if (IS (NEXT (p), FORMAL_DECLARERS)) {
 263        BOOL_T z = A68_TRUE;
 264        victal_check_formal_pack (NEXT (p), FORMAL_DECLARER_MARK, &z);
 265        if (!z) {
 266          diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarer");
 267        }
 268        FORWARD (p);
 269      }
 270      if (!victal_check_declarer (NEXT (p), FORMAL_DECLARER_MARK)) {
 271        diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarer");
 272      }
 273      return A68_TRUE;
 274    } else {
 275      return A68_FALSE;
 276    }
 277  }
 278  
 279  //! @brief Check cast.
 280  
 281  void victal_check_cast (NODE_T * p)
 282  {
 283    if (!victal_check_declarer (p, FORMAL_DECLARER_MARK)) {
 284      diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarer");
 285      victal_checker (NEXT (p));
 286    }
 287  }
 288  
 289  //! @brief Driver for checking VICTALITY of declarers.
 290  
 291  void victal_checker (NODE_T * p)
 292  {
 293    for (; p != NO_NODE; FORWARD (p)) {
 294      if (IS (p, MODE_DECLARATION)) {
 295        victal_check_mode_dec (SUB (p));
 296      } else if (IS (p, VARIABLE_DECLARATION)) {
 297        victal_check_variable_dec (SUB (p));
 298      } else if (IS (p, IDENTITY_DECLARATION)) {
 299        victal_check_identity_dec (SUB (p));
 300      } else if (IS (p, GENERATOR)) {
 301        victal_check_generator (SUB (p));
 302      } else if (IS (p, ROUTINE_TEXT)) {
 303        victal_check_routine_text (SUB (p));
 304      } else if (IS (p, OPERATOR_PLAN)) {
 305        victal_check_operator_dec (SUB (p));
 306      } else if (IS (p, CAST)) {
 307        victal_check_cast (SUB (p));
 308      } else {
 309        victal_checker (SUB (p));
 310      }
 311    }
 312  }
     


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