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