"Fossies" - the Fresh Open Source Software Archive 
Member "seed7/src/syntax.c" (31 Dec 2020, 17976 Bytes) of package /linux/misc/seed7_05_20210223.tgz:
1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2000 Thomas Mertes */
5 /* */
6 /* This program is free software; you can redistribute it and/or */
7 /* modify it under the terms of the GNU General Public License as */
8 /* published by the Free Software Foundation; either version 2 of */
9 /* the License, or (at your option) any later version. */
10 /* */
11 /* This program is distributed in the hope that it will be useful, */
12 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
13 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
14 /* GNU General Public License for more details. */
15 /* */
16 /* You should have received a copy of the GNU General Public */
17 /* License along with this program; if not, write to the */
18 /* Free Software Foundation, Inc., 51 Franklin Street, */
19 /* Fifth Floor, Boston, MA 02110-1301, USA. */
20 /* */
21 /* Module: Analyzer - Syntax */
22 /* File: seed7/src/syntax.c */
23 /* Changes: 1990, 1991, 1992, 1993, 1994 Thomas Mertes */
24 /* Content: Generate new syntax descriptions out of expressions. */
25 /* */
26 /********************************************************************/
27
28 #define LOG_FUNCTIONS 0
29 #define VERBOSE_EXCEPTIONS 0
30
31 #include "version.h"
32
33 #include "stdlib.h"
34 #include "stdio.h"
35
36 #include "common.h"
37 #include "data.h"
38 #include "heaputl.h"
39 #include "flistutl.h"
40 #include "identutl.h"
41 #include "listutl.h"
42 #include "objutl.h"
43 #include "stat.h"
44 #include "scanner.h"
45 #include "symbol.h"
46 #include "error.h"
47 #include "token.h"
48 #include "findid.h"
49 #include "expr.h"
50 #include "object.h"
51 #if ANY_LOG_ACTIVE
52 #include "traceutl.h"
53 #endif
54
55 #undef EXTERN
56 #define EXTERN
57 #include "syntax.h"
58
59
60 typedef enum {XFX, XFY, YFX, YFY} assocType;
61
62
63
64 #ifdef WITH_PRINT_TOKENS
65 static void print_tokens (tokenType tokens)
66
67 { /* print_tokens */
68 logFunction(printf("print_tokens\n"););
69 printf("(");
70 while (tokens != NULL) {
71 if (tokens->token_category == SY_TOKEN) {
72 printf(" %s", tokens->token_value.ident->name);
73 } else if (tokens->token_category == EXPR_TOKEN) {
74 printf(" [%d]", tokens->token_value.priority);
75 } else {
76 printf(" ##");
77 } /* if */
78 if (tokens->alternative != NULL) {
79 printf(" ");
80 print_tokens(tokens->alternative);
81 } /* if */
82 tokens = tokens->next;
83 } /* while */
84 printf(" )");
85 logFunction(printf("print_tokens -->\n"););
86 } /* print_tokens */
87 #endif
88
89
90
91 static tokenType def_single_token (const_objectType statement_token,
92 priorityType token_priority, tokenType *formal_tokens,
93 boolType *after_expr_token, ustriType *name_of_last_sy_token)
94
95 {
96 tokenType new_token;
97 objectType type_object;
98 typeType typeof_token;
99 identType identifier;
100
101 /* def_single_token */
102 logFunction(printf("def_single_token\n"););
103 if (CATEGORY_OF_OBJ(statement_token) == EXPROBJECT) {
104 /* printf(" >[]<\n"); */
105 if (statement_token->value.listValue != NULL) {
106 type_object = statement_token->value.listValue->obj;
107 if (CATEGORY_OF_OBJ(type_object) == TYPEOBJECT) {
108 typeof_token = take_type(type_object);
109 } else {
110 err_object(TYPE_EXPECTED, type_object);
111 typeof_token = NULL;
112 } /* if */
113 } else {
114 typeof_token = NULL;
115 } /* if */
116 new_token = get_expr_token(formal_tokens,
117 token_priority, typeof_token);
118 if (new_token->token_value.expr_par.priority != token_priority) {
119 err_num_stri(WRONG_EXPR_PARAM_PRIORITY,
120 (int) token_priority,
121 (int) new_token->token_value.expr_par.priority,
122 *name_of_last_sy_token);
123 } /* if */
124 *after_expr_token = TRUE;
125 } else {
126 identifier = GET_ENTITY(statement_token)->ident;
127 /* printf(" >%s<\n", identifier->name); */
128 *name_of_last_sy_token = identifier->name;
129 new_token = get_sy_token(formal_tokens,
130 identifier);
131 if (*after_expr_token) {
132 if (identifier->prefix_priority == 0) {
133 identifier->prefix_priority = WEAKEST_PRIORITY;
134 } else {
135 if (identifier->prefix_priority != WEAKEST_PRIORITY) {
136 err_num_stri(FALSE_PREFIX_PRIORITY, (int) WEAKEST_PRIORITY,
137 (int) identifier->prefix_priority, identifier->name);
138 } /* if */
139 } /* if */
140 if (identifier->infix_priority == 0) {
141 identifier->infix_priority = WEAKEST_PRIORITY;
142 } else {
143 if (identifier->infix_priority != WEAKEST_PRIORITY) {
144 err_num_stri(FALSE_INFIX_PRIORITY, (int) WEAKEST_PRIORITY,
145 (int) identifier->infix_priority, identifier->name);
146 } /* if */
147 } /* if */
148 } /* if */
149 *after_expr_token = FALSE;
150 } /* if */
151 logFunction(printf("def_single_token -->\n"););
152 return new_token;
153 } /* def_single_token */
154
155
156
157 static inline int count_inner_tokens (const_listType statement_tokens)
158
159 {
160 int number_of_inner_tokens;
161 int token_number;
162
163 /* count_inner_tokens */
164 logFunction(printf("count_inner_tokens\n"););
165 number_of_inner_tokens = 0;
166 token_number = 1;
167 while (statement_tokens != NULL) {
168 if (CATEGORY_OF_OBJ(statement_tokens->obj) != EXPROBJECT) {
169 number_of_inner_tokens = token_number;
170 } /* if */
171 statement_tokens = statement_tokens->next;
172 token_number++;
173 } /* while */
174 logFunction(printf("count_inner_tokens -->\n"););
175 return number_of_inner_tokens;
176 } /* count_inner_tokens */
177
178
179
180 static tokenType def_token_list (const_listType statement_tokens,
181 priorityType right_token_priority, tokenType *formal_tokens,
182 ustriType name_of_last_sy_token)
183
184 {
185 int number_of_inner_tokens;
186 int token_number;
187 tokenType current_token;
188 boolType after_expr_token;
189 tokenType token_list_end;
190
191 /* def_token_list */
192 logFunction(printf("def_token_list\n"););
193 /* printf(" DEF_PAR_LIST: ");
194 prot_list(statement_tokens);
195 printf("\n"); */
196 if (statement_tokens != NULL) {
197 after_expr_token = FALSE;
198 if (statement_tokens->next != NULL) {
199 #ifdef OUT_OF_ORDER
200 current_token = def_single_token(
201 statement_tokens->obj, WEAKEST_PRIORITY,
202 formal_tokens, &after_expr_token,
203 &name_of_last_sy_token);
204 statement_tokens = statement_tokens->next;
205 while (statement_tokens->next != NULL) {
206 current_token = def_single_token(
207 statement_tokens->obj, WEAKEST_PRIORITY,
208 ¤t_token->next, &after_expr_token,
209 &name_of_last_sy_token);
210 statement_tokens = statement_tokens->next;
211 } /* while */
212 current_token = def_single_token(
213 statement_tokens->obj, right_token_priority,
214 ¤t_token->next, &after_expr_token,
215 &name_of_last_sy_token);
216 #endif
217 number_of_inner_tokens =
218 count_inner_tokens(statement_tokens);
219 if (number_of_inner_tokens >= 1) {
220 current_token = def_single_token(
221 statement_tokens->obj, WEAKEST_PRIORITY,
222 formal_tokens, &after_expr_token,
223 &name_of_last_sy_token);
224 } else {
225 current_token = def_single_token(
226 statement_tokens->obj, right_token_priority,
227 formal_tokens, &after_expr_token,
228 &name_of_last_sy_token);
229 } /* if */
230 statement_tokens = statement_tokens->next;
231 for (token_number = 2;
232 token_number <= number_of_inner_tokens;
233 token_number++) {
234 current_token = def_single_token(
235 statement_tokens->obj, WEAKEST_PRIORITY,
236 ¤t_token->next, &after_expr_token,
237 &name_of_last_sy_token);
238 statement_tokens = statement_tokens->next;
239 } /* for */
240 while (statement_tokens != NULL) {
241 current_token = def_single_token(
242 statement_tokens->obj, right_token_priority,
243 ¤t_token->next, &after_expr_token,
244 &name_of_last_sy_token);
245 statement_tokens = statement_tokens->next;
246 } /* while */
247 } else {
248 current_token = def_single_token(
249 statement_tokens->obj, right_token_priority,
250 formal_tokens, &after_expr_token,
251 &name_of_last_sy_token);
252 } /* if */
253 token_list_end = get_syntax_description(¤t_token->next);
254 } else {
255 token_list_end = get_syntax_description(formal_tokens);
256 } /* if */
257 logFunction(printf("def_token_list -->\n"););
258 return token_list_end;
259 } /* def_token_list */
260
261
262
263 static inline tokenType def_infix_syntax (const_listType statement_syntax,
264 priorityType statement_priority, assocType statement_associativity)
265
266 {
267 identType identifier;
268 tokenType token_list_end;
269
270 /* def_infix_syntax */
271 logFunction(printf("def_infix_syntax\n"););
272 if (CATEGORY_OF_OBJ(statement_syntax->obj) != EXPROBJECT) {
273 identifier = GET_ENTITY(statement_syntax->obj)->ident;
274 if (identifier->infix_priority == 0) {
275 identifier->infix_priority = statement_priority;
276 } else {
277 if (identifier->infix_priority != statement_priority) {
278 err_num_stri(FALSE_INFIX_PRIORITY, (int) statement_priority,
279 (int) identifier->infix_priority, identifier->name);
280 } /* if */
281 } /* if */
282 if (statement_associativity == YFX ||
283 statement_associativity == YFY) {
284 identifier->left_token_priority = statement_priority;
285 } else {
286 identifier->left_token_priority =
287 statement_priority - (priorityType) 1;
288 } /* if */
289 if (statement_associativity == XFY ||
290 statement_associativity == YFY) {
291 token_list_end = def_token_list(statement_syntax->next,
292 statement_priority,
293 &identifier->infix_token, identifier->name);
294 } else {
295 token_list_end = def_token_list(statement_syntax->next,
296 (priorityType) (((int) statement_priority) - 1),
297 &identifier->infix_token, identifier->name);
298 } /* if */
299 /* printf("[%d] %s ", identifier->left_token_priority, identifier->name);
300 print_tokens(identifier->infix_token);
301 printf("\n"); */
302 } else {
303 err_warning(TWO_PARAMETER_SYNTAX);
304 token_list_end = NULL;
305 } /* if */
306 logFunction(printf("def_infix_syntax\n"););
307 return token_list_end;
308 } /* def_infix_syntax */
309
310
311
312 static inline tokenType def_prefix_syntax (const_listType statement_syntax,
313 priorityType statement_priority, assocType statement_associativity)
314
315 {
316 identType identifier;
317 tokenType token_list_end;
318
319 /* def_prefix_syntax */
320 logFunction(printf("def_prefix_syntax\n"););
321 identifier = GET_ENTITY(statement_syntax->obj)->ident;
322 if (identifier->prefix_priority == 0) {
323 identifier->prefix_priority = statement_priority;
324 } else {
325 if (identifier->prefix_priority != statement_priority) {
326 err_num_stri(FALSE_PREFIX_PRIORITY, (int) statement_priority,
327 (int) identifier->prefix_priority, identifier->name);
328 } /* if */
329 } /* if */
330 if (statement_associativity == XFY ||
331 statement_associativity == YFY) {
332 token_list_end = def_token_list(statement_syntax->next,
333 statement_priority,
334 &identifier->prefix_token, identifier->name);
335 } else {
336 token_list_end = def_token_list(statement_syntax->next,
337 (priorityType) (((int) statement_priority) - 1),
338 &identifier->prefix_token, identifier->name);
339 } /* if */
340 /* printf("%s ", identifier->name);
341 print_tokens(identifier->prefix_token);
342 printf("\n"); */
343 logFunction(printf("def_prefix_syntax -->\n"););
344 return token_list_end;
345 } /* def_prefix_syntax */
346
347
348
349 static inline tokenType def_statement_syntax (objectType syntax_expression,
350 priorityType statement_priority, assocType statement_associativity)
351
352 {
353 listType statement_syntax;
354 identType identifier;
355 tokenType token_list_end;
356
357 /* def_statement_syntax */
358 logFunction(printf("def_statement_syntax(");
359 trace1(syntax_expression);
360 printf(")\n"););
361 /* printcategory(CATEGORY_OF_OBJ(syntax_expression)); */
362 if (CATEGORY_OF_OBJ(syntax_expression) == LISTOBJECT) {
363 /* printf("SYNTAX: ");
364 prot_list(syntax_expression->value.listValue);
365 printf("\n"); */
366 statement_syntax = syntax_expression->value.listValue;
367 if (statement_syntax != NULL) {
368 check_list_of_syntax_elements(statement_syntax);
369 if (CATEGORY_OF_OBJ(statement_syntax->obj) == EXPROBJECT) {
370 if (statement_syntax->next != NULL) {
371 token_list_end = def_infix_syntax(statement_syntax->next,
372 statement_priority, statement_associativity);
373 } else {
374 err_warning(EMPTY_SYNTAX);
375 token_list_end = NULL;
376 } /* if */
377 } else {
378 token_list_end = def_prefix_syntax(statement_syntax,
379 statement_priority, statement_associativity);
380 } /* if */
381 } else {
382 err_warning(EMPTY_SYNTAX);
383 token_list_end = NULL;
384 } /* if */
385 } else if (CATEGORY_OF_OBJ(syntax_expression) == EXPROBJECT) {
386 err_warning(DOT_EXPR_REQUESTED);
387 token_list_end = NULL;
388 } else {
389 identifier = GET_ENTITY(syntax_expression)->ident;
390 if (identifier == prog->ident.literal) {
391 err_object(IDENT_EXPECTED, syntax_expression);
392 } /* if */
393 if (identifier->prefix_priority == 0) {
394 identifier->prefix_priority = statement_priority;
395 } else {
396 if (identifier->prefix_priority != statement_priority) {
397 err_num_stri(FALSE_PREFIX_PRIORITY, (int) statement_priority,
398 (int) identifier->prefix_priority, identifier->name);
399 } /* if */
400 } /* if */
401 token_list_end = get_syntax_description(&identifier->prefix_token);
402 /* printf("%s\n", identifier->name); */
403 } /* if */
404 logFunction(printf("def_statement_syntax -->\n"););
405 return token_list_end;
406 } /* def_statement_syntax */
407
408
409
410 void decl_syntax (void)
411
412 {
413 objectType type_object;
414 typeType typeof_object;
415 objectType expression;
416 assocType assoc;
417 tokenType token_list_end;
418
419 /* decl_syntax */
420 logFunction(printf("decl_syntax\n"););
421 scan_symbol();
422 if (current_ident == prog->id_for.colon) {
423 typeof_object = NULL;
424 scan_symbol();
425 } else {
426 type_object = pars_infix_expression(WEAKEST_PRIORITY, TRUE);
427 if (CATEGORY_OF_OBJ(type_object) == TYPEOBJECT) {
428 typeof_object = take_type(type_object);
429 } else {
430 err_object(TYPE_EXPECTED, type_object);
431 typeof_object = NULL;
432 } /* if */
433 if (current_ident == prog->id_for.colon) {
434 scan_symbol();
435 } else {
436 err_ident(EXPECTED_SYMBOL, prog->id_for.colon);
437 } /* if */
438 } /* if */
439 expression = pars_infix_expression(WEAKEST_PRIORITY, FALSE);
440 if (current_ident == prog->id_for.is) {
441 scan_symbol();
442 } else {
443 err_ident(EXPECTED_SYMBOL, prog->id_for.is);
444 } /* if */
445 if (current_ident == prog->id_for.r_arrow) { /* -> */
446 assoc = YFX;
447 } else if (current_ident == prog->id_for.l_arrow) { /* <- */
448 assoc = XFY;
449 } else if (current_ident == prog->id_for.out_arrow) { /* <-> */
450 assoc = XFX;
451 } else if (current_ident == prog->id_for.in_arrow) { /* -><- */
452 assoc = YFY;
453 } else {
454 err_warning(ILLEGAL_ASSOCIATIVITY);
455 assoc = YFX;
456 } /* if */
457 scan_symbol();
458 if (symbol.sycategory != INTLITERAL) {
459 err_string(CARD_EXPECTED, symbol.name);
460 scan_symbol();
461 } else {
462 if (symbol.intValue > WEAKEST_PRIORITY) {
463 err_integer(ILLEGAL_PRIORITY, symbol.intValue);
464 scan_symbol();
465 } else {
466 token_list_end = def_statement_syntax(expression,
467 (priorityType) symbol.intValue, assoc);
468 scan_symbol();
469 if (token_list_end != NULL) {
470 if (token_list_end->token_category != UNDEF_SYNTAX) {
471 err_warning(SYNTAX_DECLARED_TWICE);
472 } else if (current_ident == prog->id_for.lbrack) {
473 scan_symbol();
474 if (symbol.sycategory != INTLITERAL) {
475 err_string(CARD_EXPECTED, symbol.name);
476 } else {
477 token_list_end->token_category = SELECT_ELEMENT_FROM_LIST_SYNTAX;
478 token_list_end->token_value.select = symbol.intValue;
479 } /* if */
480 scan_symbol();
481 if (current_ident == prog->id_for.rbrack) {
482 scan_symbol();
483 } else {
484 err_ident(EXPECTED_SYMBOL, prog->id_for.rbrack);
485 } /* if */
486 } else {
487 token_list_end->token_category = LIST_WITH_TYPEOF_SYNTAX;
488 token_list_end->token_value.type_of = typeof_object;
489 } /* if */
490 } /* if */
491 } /* if */
492 } /* if */
493 if (current_ident == prog->id_for.semicolon) {
494 scan_symbol();
495 } else {
496 err_ident(EXPECTED_SYMBOL, prog->id_for.semicolon);
497 } /* if */
498 /* printcategory(CATEGORY_OF_OBJ(expression)); */
499 free_expression(expression);
500 logFunction(printf("decl_syntax\n"););
501 } /* decl_syntax */
05_20201208_vs_05_20210106.