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 }
