parser-moids-equivalence.c

     
   1  //! @file parser-moids-equivalence.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  //! Prove equivalence of modes.
  25  
  26  #include "a68g.h"
  27  #include "a68g-postulates.h"
  28  #include "a68g-parser.h"
  29  
  30  // Routines for establishing equivalence of modes.
  31  //
  32  // After I made this mode equivalencer (in 1993), I found:
  33  // Algol Bulletin 30.3.3 C.H.A. Koster: On infinite modes, 86-89 [1969],
  34  // which essentially concurs with this test on mode equivalence I wrote.
  35  // It is elementary logic anyway: prove equivalence, assuming equivalence.
  36  
  37  //! @brief Whether packs are equivalent, same sequence of equivalence modes.
  38  
  39  BOOL_T is_packs_equivalent (PACK_T * s, PACK_T * t)
  40  {
  41    for (; s != NO_PACK && t != NO_PACK; FORWARD (s), FORWARD (t)) {
  42      if (!is_modes_equivalent (MOID (s), MOID (t))) {
  43        return A68_FALSE;
  44      }
  45      if (TEXT (s) != TEXT (t)) {
  46        return A68_FALSE;
  47      }
  48    }
  49    return (BOOL_T) (s == NO_PACK && t == NO_PACK);
  50  }
  51  
  52  //! @brief Whether packs are equivalent, must be subsets.
  53  
  54  BOOL_T is_united_packs_equivalent (PACK_T * s, PACK_T * t)
  55  {
  56    PACK_T *p;
  57  // whether s is a subset of t ....
  58    for (p = s; p != NO_PACK; FORWARD (p)) {
  59      BOOL_T f;
  60      PACK_T *q;
  61      for (f = A68_FALSE, q = t; q != NO_PACK && !f; FORWARD (q)) {
  62        f = is_modes_equivalent (MOID (p), MOID (q));
  63      }
  64      if (!f) {
  65        return A68_FALSE;
  66      }
  67    }
  68  // ... and whether t is a subset of s.
  69    for (p = t; p != NO_PACK; FORWARD (p)) {
  70      BOOL_T f;
  71      PACK_T *q;
  72      for (f = A68_FALSE, q = s; q != NO_PACK && !f; FORWARD (q)) {
  73        f = is_modes_equivalent (MOID (p), MOID (q));
  74      }
  75      if (!f) {
  76        return A68_FALSE;
  77      }
  78    }
  79    return A68_TRUE;
  80  }
  81  
  82  //! @brief Whether moids a and b are structurally equivalent.
  83  
  84  BOOL_T is_modes_equivalent (MOID_T * a, MOID_T * b)
  85  {
  86    if (a == NO_MOID || b == NO_MOID) {
  87  // Modes can be NO_MOID in partial argument lists.
  88      return A68_FALSE;
  89    } else if (a == b) {
  90      return A68_TRUE;
  91    } else if (a == M_ERROR || b == M_ERROR) {
  92      return A68_FALSE;
  93    } else if (ATTRIBUTE (a) != ATTRIBUTE (b)) {
  94      return A68_FALSE;
  95    } else if (DIM (a) != DIM (b)) {
  96      return A68_FALSE;
  97    } else if (IS (a, STANDARD)) {
  98      return (BOOL_T) (a == b);
  99    } else if (EQUIVALENT (a) == b || EQUIVALENT (b) == a) {
 100      return A68_TRUE;
 101    } else if (is_postulated_pair (A68 (top_postulate), a, b) || is_postulated_pair (A68 (top_postulate), b, a)) {
 102      return A68_TRUE;
 103    } else if (IS (a, INDICANT)) {
 104      if (NODE (a) == NO_NODE || NODE (b) == NO_NODE) {
 105        return A68_FALSE;
 106      } else {
 107        return NODE (a) == NODE (b);
 108      }
 109    }
 110    switch (ATTRIBUTE (a)) {
 111    case REF_SYMBOL:
 112    case ROW_SYMBOL:
 113    case FLEX_SYMBOL:{
 114        return is_modes_equivalent (SUB (a), SUB (b));
 115      }
 116    }
 117    if (IS (a, PROC_SYMBOL) && PACK (a) == NO_PACK && PACK (b) == NO_PACK) {
 118      return is_modes_equivalent (SUB (a), SUB (b));
 119    } else if (IS (a, STRUCT_SYMBOL)) {
 120      POSTULATE_T *save;
 121      BOOL_T z;
 122      save = A68 (top_postulate);
 123      make_postulate (&A68 (top_postulate), a, b);
 124      z = is_packs_equivalent (PACK (a), PACK (b));
 125      free_postulate_list (A68 (top_postulate), save);
 126      A68 (top_postulate) = save;
 127      return z;
 128    } else if (IS (a, UNION_SYMBOL)) {
 129      return is_united_packs_equivalent (PACK (a), PACK (b));
 130    } else if (IS (a, PROC_SYMBOL) && PACK (a) != NO_PACK && PACK (b) != NO_PACK) {
 131      POSTULATE_T *save;
 132      BOOL_T z;
 133      save = A68 (top_postulate);
 134      make_postulate (&A68 (top_postulate), a, b);
 135      z = is_modes_equivalent (SUB (a), SUB (b));
 136      if (z) {
 137        z = is_packs_equivalent (PACK (a), PACK (b));
 138      }
 139      free_postulate_list (A68 (top_postulate), save);
 140      A68 (top_postulate) = save;
 141      return z;
 142    } else if (IS (a, SERIES_MODE) || IS (a, STOWED_MODE)) {
 143      return is_packs_equivalent (PACK (a), PACK (b));
 144    }
 145    return A68_FALSE;
 146  }
 147  
 148  //! @brief Whether modes 1 and 2 are structurally equivalent.
 149  
 150  BOOL_T prove_moid_equivalence (MOID_T * p, MOID_T * q)
 151  {
 152  // Prove two modes to be equivalent under assumption that they indeed are.
 153    POSTULATE_T *save = A68 (top_postulate);
 154    BOOL_T z = is_modes_equivalent (p, q);
 155    free_postulate_list (A68 (top_postulate), save);
 156    A68 (top_postulate) = save;
 157    return z;
 158  }