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-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  //! 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)
 104                 || IS (p, COMMA_SYMBOL)) {
 105        victal_check_variable_dec (NEXT (p));
 106      } else if (IS (p, UNIT)) {
 107        victal_checker (SUB (p));
 108      } else if (IS (p, DECLARER)) {
 109        if (!victal_check_declarer (p, ACTUAL_DECLARER_MARK)) {
 110          diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "actual declarer");
 111        }
 112        victal_check_variable_dec (NEXT (p));
 113      }
 114    }
 115  }
 116  
 117  //! @brief Check identity declaration.
 118  
 119  void victal_check_identity_dec (NODE_T * p)
 120  {
 121    if (p != NO_NODE) {
 122      if (IS (p, IDENTITY_DECLARATION)) {
 123        victal_check_identity_dec (SUB (p));
 124        victal_check_identity_dec (NEXT (p));
 125      } else if (is_one_of (p, DEFINING_IDENTIFIER, EQUALS_SYMBOL, COMMA_SYMBOL, STOP)) {
 126        victal_check_identity_dec (NEXT (p));
 127      } else if (IS (p, UNIT)) {
 128        victal_checker (SUB (p));
 129      } else if (IS (p, DECLARER)) {
 130        if (!victal_check_declarer (p, FORMAL_DECLARER_MARK)) {
 131          diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarer");
 132        }
 133        victal_check_identity_dec (NEXT (p));
 134      }
 135    }
 136  }
 137  
 138  //! @brief Check routine pack.
 139  
 140  void victal_check_routine_pack (NODE_T * p, int x, BOOL_T * z)
 141  {
 142    if (p != NO_NODE) {
 143      if (IS (p, PARAMETER_PACK)) {
 144        victal_check_routine_pack (SUB (p), x, z);
 145      } else if (is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, STOP)) {
 146        victal_check_routine_pack (NEXT (p), x, z);
 147      } else if (is_one_of (p, PARAMETER_LIST, PARAMETER, STOP)) {
 148        victal_check_routine_pack (NEXT (p), x, z);
 149        victal_check_routine_pack (SUB (p), x, z);
 150      } else if (IS (p, DECLARER)) {
 151        *z &= victal_check_declarer (SUB (p), x);
 152      }
 153    }
 154  }
 155  
 156  //! @brief Check routine text.
 157  
 158  void victal_check_routine_text (NODE_T * p)
 159  {
 160    if (IS (p, PARAMETER_PACK)) {
 161      BOOL_T z = A68_TRUE;
 162      victal_check_routine_pack (p, FORMAL_DECLARER_MARK, &z);
 163      if (!z) {
 164        diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarers");
 165      }
 166      FORWARD (p);
 167    }
 168    if (!victal_check_declarer (p, FORMAL_DECLARER_MARK)) {
 169      diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarer");
 170    }
 171    victal_checker (NEXT (p));
 172  }
 173  
 174  //! @brief Check structure pack.
 175  
 176  void victal_check_structure_pack (NODE_T * p, int x, BOOL_T * z)
 177  {
 178    if (p != NO_NODE) {
 179      if (IS (p, STRUCTURE_PACK)) {
 180        victal_check_structure_pack (SUB (p), x, z);
 181      } else if (is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, STOP)) {
 182        victal_check_structure_pack (NEXT (p), x, z);
 183      } else if (is_one_of (p, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD, STOP)) {
 184        victal_check_structure_pack (NEXT (p), x, z);
 185        victal_check_structure_pack (SUB (p), x, z);
 186      } else if (IS (p, DECLARER)) {
 187        (*z) &= victal_check_declarer (SUB (p), x);
 188      }
 189    }
 190  }
 191  
 192  //! @brief Check union pack.
 193  
 194  void victal_check_union_pack (NODE_T * p, int x, BOOL_T * z)
 195  {
 196    if (p != NO_NODE) {
 197      if (IS (p, UNION_PACK)) {
 198        victal_check_union_pack (SUB (p), x, z);
 199      } else if (is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, VOID_SYMBOL, STOP)) {
 200        victal_check_union_pack (NEXT (p), x, z);
 201      } else if (IS (p, UNION_DECLARER_LIST)) {
 202        victal_check_union_pack (NEXT (p), x, z);
 203        victal_check_union_pack (SUB (p), x, z);
 204      } else if (IS (p, DECLARER)) {
 205        victal_check_union_pack (NEXT (p), x, z);
 206        (*z) &= victal_check_declarer (SUB (p), FORMAL_DECLARER_MARK);
 207      }
 208    }
 209  }
 210  
 211  //! @brief Check declarer.
 212  
 213  BOOL_T victal_check_declarer (NODE_T * p, int x)
 214  {
 215    if (p == NO_NODE) {
 216      return A68_FALSE;
 217    } else if (IS (p, DECLARER)) {
 218      return victal_check_declarer (SUB (p), x);
 219    } else if (is_one_of (p, LONGETY, SHORTETY, STOP)) {
 220      return A68_TRUE;
 221    } else if (is_one_of (p, VOID_SYMBOL, INDICANT, STANDARD, STOP)) {
 222      return A68_TRUE;
 223    } else if (IS_REF (p)) {
 224      return victal_check_declarer (NEXT (p), VIRTUAL_DECLARER_MARK);
 225    } else if (IS_FLEX (p)) {
 226      return victal_check_declarer (NEXT (p), x);
 227    } else if (IS (p, BOUNDS)) {
 228      victal_checker (SUB (p));
 229      if (x == FORMAL_DECLARER_MARK) {
 230        diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal bounds");
 231        (void) victal_check_declarer (NEXT (p), x);
 232        return A68_TRUE;
 233      } else if (x == VIRTUAL_DECLARER_MARK) {
 234        diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "virtual bounds");
 235        (void) victal_check_declarer (NEXT (p), x);
 236        return A68_TRUE;
 237      } else {
 238        return victal_check_declarer (NEXT (p), x);
 239      }
 240    } else if (IS (p, FORMAL_BOUNDS)) {
 241      victal_checker (SUB (p));
 242      if (x == ACTUAL_DECLARER_MARK) {
 243        diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "actual bounds");
 244        (void) victal_check_declarer (NEXT (p), x);
 245        return A68_TRUE;
 246      } else {
 247        return victal_check_declarer (NEXT (p), x);
 248      }
 249    } else if (IS (p, STRUCT_SYMBOL)) {
 250      BOOL_T z = A68_TRUE;
 251      victal_check_structure_pack (NEXT (p), x, &z);
 252      return z;
 253    } else if (IS (p, UNION_SYMBOL)) {
 254      BOOL_T z = A68_TRUE;
 255      victal_check_union_pack (NEXT (p), FORMAL_DECLARER_MARK, &z);
 256      if (!z) {
 257        diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarer pack");
 258      }
 259      return A68_TRUE;
 260    } else if (IS (p, PROC_SYMBOL)) {
 261      if (IS (NEXT (p), FORMAL_DECLARERS)) {
 262        BOOL_T z = A68_TRUE;
 263        victal_check_formal_pack (NEXT (p), FORMAL_DECLARER_MARK, &z);
 264        if (!z) {
 265          diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarer");
 266        }
 267        FORWARD (p);
 268      }
 269      if (!victal_check_declarer (NEXT (p), FORMAL_DECLARER_MARK)) {
 270        diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarer");
 271      }
 272      return A68_TRUE;
 273    } else {
 274      return A68_FALSE;
 275    }
 276  }
 277  
 278  //! @brief Check cast.
 279  
 280  void victal_check_cast (NODE_T * p)
 281  {
 282    if (!victal_check_declarer (p, FORMAL_DECLARER_MARK)) {
 283      diagnostic (A68_SYNTAX_ERROR, p, ERROR_EXPECTED, "formal declarer");
 284      victal_checker (NEXT (p));
 285    }
 286  }
 287  
 288  //! @brief Driver for checking VICTALITY of declarers.
 289  
 290  void victal_checker (NODE_T * p)
 291  {
 292    for (; p != NO_NODE; FORWARD (p)) {
 293      if (IS (p, MODE_DECLARATION)) {
 294        victal_check_mode_dec (SUB (p));
 295      } else if (IS (p, VARIABLE_DECLARATION)) {
 296        victal_check_variable_dec (SUB (p));
 297      } else if (IS (p, IDENTITY_DECLARATION)) {
 298        victal_check_identity_dec (SUB (p));
 299      } else if (IS (p, GENERATOR)) {
 300        victal_check_generator (SUB (p));
 301      } else if (IS (p, ROUTINE_TEXT)) {
 302        victal_check_routine_text (SUB (p));
 303      } else if (IS (p, OPERATOR_PLAN)) {
 304        victal_check_operator_dec (SUB (p));
 305      } else if (IS (p, CAST)) {
 306        victal_check_cast (SUB (p));
 307      } else {
 308        victal_checker (SUB (p));
 309      }
 310    }
 311  }