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-2024 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 }
