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