1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2013 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 - Parser */
22 /* File: seed7/src/expr.c */
23 /* Changes: 1990, 1991, 1992, 1993, 1994 Thomas Mertes */
24 /* Content: Read the next expression from the source file. */
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 "listutl.h"
41 #include "syvarutl.h"
42 #include "datautl.h"
43 #include "traceutl.h"
44 #include "infile.h"
45 #include "scanner.h"
46 #include "symbol.h"
47 #include "object.h"
48 #include "findid.h"
49 #include "error.h"
50 #include "atom.h"
51 #include "match.h"
52
53 #undef EXTERN
54 #define EXTERN
55 #define DO_INIT
56 #include "expr.h"
57
58 #undef TRACE_EXPR
59
60
61
select_element(objectType expression,intType position)62 static objectType select_element (objectType expression,
63 intType position)
64
65 {
66 listType list_element;
67 intType number;
68 objectType result;
69
70 /* select_element */
71 logFunction(printf("select_element\n"););
72 list_element = expression->value.listValue;
73 if (position >= 1) {
74 number = 1;
75 while (number < position && list_element != NULL) {
76 number++;
77 list_element = list_element->next;
78 } /* while */
79 if (list_element != NULL) {
80 result = list_element->obj;
81 } else {
82 result = SYS_EMPTY_OBJECT;
83 } /* if */
84 } else {
85 result = SYS_EMPTY_OBJECT;
86 } /* if */
87 free_list(expression->value.listValue);
88 FREE_OBJECT(expression);
89 logFunction(printf("select_element -->\n"););
90 return result;
91 } /* select_element */
92
93
94
read_call_expression(boolType do_match_expr)95 static objectType read_call_expression (boolType do_match_expr)
96
97 {
98 objectType expression;
99 fileNumType file_number;
100 lineNumType line;
101 listType helplist;
102 objectType procnameobject;
103
104 /* read_call_expression */
105 logFunction(printf("read_call_expression(%d) %s\n",
106 do_match_expr, id_string(current_ident)););
107 if (current_ident == prog->id_for.lparen) {
108 scan_symbol();
109 if (current_ident == prog->id_for.rparen) {
110 err_warning(EXPR_EXPECTED);
111 scan_symbol();
112 expression = SYS_EMPTY_OBJECT;
113 } else {
114 expression = pars_infix_expression(WEAKEST_PRIORITY,
115 do_match_expr);
116 if (current_ident == prog->id_for.rparen) {
117 scan_symbol();
118 } else {
119 err_ident(EXPECTED_SYMBOL, prog->id_for.rparen);
120 } /* if */
121 } /* if */
122 } else {
123 file_number = in_file.file_number;
124 line = in_file.line;
125 expression = read_atom();
126 if (current_ident == prog->id_for.lparen) {
127 scan_symbol();
128 if (current_ident == prog->id_for.rparen) {
129 scan_symbol();
130 } else {
131 procnameobject = expression;
132 expression = new_nonempty_expression_object(
133 pars_infix_expression(COM_PRIORITY, do_match_expr),
134 &helplist, SYS_EXPR_TYPE);
135 expression->descriptor.posinfo = CREATE_POSINFO(line, file_number);
136 while (current_ident == prog->id_for.comma) {
137 scan_symbol();
138 helplist = add_element_to_list(helplist,
139 pars_infix_expression(COM_PRIORITY, do_match_expr));
140 } /* while */
141 helplist = add_element_to_list(helplist, procnameobject);
142 if (current_ident == prog->id_for.rparen) {
143 scan_symbol();
144 } else {
145 err_ident(EXPECTED_SYMBOL, prog->id_for.rparen);
146 } /* if */
147 } /* if */
148 } /* if */
149 } /* if */
150 logFunction(printf("read_call_expression --> " FMT_U_MEM ", ",
151 (memSizeType) expression);
152 trace1(expression);
153 printf("\n"););
154 return expression;
155 } /* read_call_expression */
156
157
158
read_dot_subexpression(boolType do_match_expr)159 static objectType read_dot_subexpression (boolType do_match_expr)
160
161 {
162 objectType expression;
163 listType helplist;
164
165 /* read_dot_subexpression */
166 logFunction(printf("read_dot_subexpression(%d)\n", do_match_expr););
167 if (current_ident == prog->id_for.lparen) {
168 scan_symbol();
169 if (current_ident == prog->id_for.rparen) {
170 scan_symbol();
171 expression = new_empty_list_object(SYS_EXPR_TYPE);
172 } else {
173 expression = new_nonempty_expression_object(
174 pars_infix_expression(COM_PRIORITY, FALSE), &helplist,
175 SYS_EXPR_TYPE);
176 #ifdef OUT_OF_ORDER
177 SET_CATEGORY_OF_OBJ(expression, LISTOBJECT);
178 while (current_ident == prog->id_for.comma) {
179 scan_symbol();
180 helplist = add_element_to_list(helplist,
181 pars_infix_expression(COM_PRIORITY, FALSE));
182 } /* while */
183 #endif
184 if (current_ident == prog->id_for.rparen) {
185 scan_symbol();
186 } else {
187 err_ident(EXPECTED_SYMBOL, prog->id_for.rparen);
188 } /* if */
189 } /* if */
190 } else {
191 expression = read_call_expression(do_match_expr);
192 } /* if */
193 logFunction(printf("read_dot_subexpression --> " FMT_U_MEM ", ",
194 (memSizeType) expression);
195 trace1(expression);
196 printf("\n"););
197 return expression;
198 } /* read_dot_subexpression */
199
200
201
read_dot_expression(boolType do_match_expr)202 static objectType read_dot_expression (boolType do_match_expr)
203
204 {
205 objectType expression;
206 objectType sub_expr;
207 listType helplist;
208
209 /* read_dot_expression */
210 logFunction(printf("read_dot_expression(%d) %s\n",
211 do_match_expr, id_string(current_ident)););
212 if (current_ident == prog->id_for.dot) {
213 scan_symbol();
214 expression = read_dot_subexpression(do_match_expr);
215 if (current_ident == prog->id_for.dot) {
216 expression = new_nonempty_expression_object(expression, &helplist,
217 SYS_EXPR_TYPE);
218 SET_CATEGORY_OF_OBJ(expression, LISTOBJECT);
219 do {
220 scan_symbol();
221 sub_expr = read_dot_subexpression(do_match_expr);
222 #ifdef TRACE_EXPR
223 printf("%lu ", (unsigned long) expression);
224 trace1(expression);
225 printf("\n");
226 #endif
227 helplist = add_element_to_list(helplist, sub_expr);
228 #ifdef TRACE_EXPR
229 printf("%lu ", (unsigned long) expression);
230 trace1(expression);
231 printf("\n");
232 #endif
233 } while (current_ident == prog->id_for.dot);
234 } /* if */
235 } else {
236 expression = read_call_expression(do_match_expr);
237 } /* if */
238 logFunction(printf("read_dot_expression --> " FMT_U_MEM ", ",
239 (memSizeType) expression);
240 trace1(expression);
241 printf("\n"););
242 return expression;
243 } /* read_dot_expression */
244
245
246
pars_token(objectType expression,const_tokenType formal_token,listType actual_parameter)247 static objectType pars_token (objectType expression,
248 const_tokenType formal_token, listType actual_parameter)
249
250 {
251 boolType okay;
252 objectType actual_param;
253 listType helplist;
254 posType posinfo;
255
256 /* pars_token */
257 logFunction(printf("pars_token\n"););
258 okay = FALSE;
259 while (formal_token != NULL) {
260 switch (formal_token->token_category) {
261 case SY_TOKEN:
262 /* printf("!SY_TOKEN >%s< \n", formal_token->token_value.ident->name); */
263 if (current_ident == formal_token->token_value.ident) {
264 actual_parameter = add_element_to_list(actual_parameter, read_name());
265 formal_token = formal_token->next;
266 } else {
267 if (formal_token->alternative != NULL) {
268 formal_token = formal_token->alternative;
269 } else {
270 err_string(EXPECTED_SYMBOL,
271 formal_token->token_value.ident->name);
272 scan_symbol();
273 formal_token = formal_token->next;
274 } /* if */
275 } /* if */
276 break;
277 case EXPR_TOKEN:
278 /* printf("!EXPR_TOKEN [] %d >%s< %d\n", formal_token->token_value.expr_par.priority,
279 symbol.name, current_ident->prefix_priority); */
280 if (current_ident->prefix_priority <=
281 formal_token->token_value.expr_par.priority) {
282 if (formal_token->token_value.expr_par.type_of == NULL) {
283 actual_param = pars_infix_expression(
284 formal_token->token_value.expr_par.priority, FALSE);
285 } else {
286 posinfo = CREATE_POSINFO(in_file.line, in_file.file_number);
287 actual_param = pars_infix_expression(
288 formal_token->token_value.expr_par.priority, FALSE);
289 if (CATEGORY_OF_OBJ(actual_param) != EXPROBJECT) {
290 actual_param = new_type_of_expression_object(
291 actual_param, &helplist,
292 formal_token->token_value.expr_par.type_of);
293 actual_param->descriptor.posinfo = posinfo;
294 } /* if */
295 } /* if */
296 actual_parameter = add_element_to_list(actual_parameter, actual_param);
297 formal_token = formal_token->next;
298 } else {
299 formal_token = formal_token->alternative;
300 } /* if */
301 break;
302 case UNDEF_SYNTAX:
303 break;
304 case LIST_WITH_TYPEOF_SYNTAX:
305 expression->type_of = formal_token->token_value.type_of;
306 formal_token = NULL;
307 okay = TRUE;
308 break;
309 case SELECT_ELEMENT_FROM_LIST_SYNTAX:
310 expression = select_element(expression,
311 formal_token->token_value.select);
312 formal_token = NULL;
313 okay = TRUE;
314 break;
315 } /* switch */
316 } /* while */
317 if (!okay) {
318 err_warning(EXPR_EXPECTED);
319 } /* if */
320 logFunction(printf("pars_token --> " FMT_U_MEM ", ",
321 (memSizeType) expression);
322 trace1(expression);
323 printf("\n"););
324 return expression;
325 } /* pars_token */
326
327
328
pars_infix_expression(priorityType priority,boolType do_match_expr)329 objectType pars_infix_expression (priorityType priority,
330 boolType do_match_expr)
331
332 {
333 objectType expression;
334 priorityType expr_prior;
335 tokenType formal_token;
336 listType helplist;
337
338 /* pars_infix_expression */
339 logFunction(printf("pars_infix_expression %d \"%s\"\n",
340 priority, id_string(current_ident)););
341 expr_prior = current_ident->prefix_priority;
342 if (expr_prior == STRONGEST_PRIORITY) {
343 expression = read_dot_expression(do_match_expr);
344 } else {
345 if (expr_prior <= priority) {
346 formal_token = current_ident->prefix_token;
347 expression = new_expression_object(&helplist);
348 helplist->obj = read_name();
349 if (current_ident == prog->id_for.dot) {
350 err_num_stri(DOT_EXPR_ILLEGAL,
351 (int) GET_ENTITY(helplist->obj)->ident->prefix_priority,
352 (int) STRONGEST_PRIORITY, GET_ENTITY(helplist->obj)->ident->name);
353 expression = read_dot_expression(do_match_expr);
354 } else {
355 expression = pars_token(expression,
356 formal_token, helplist);
357 } /* if */
358 } else {
359 err_num_stri(WRONG_PREFIX_PRIORITY, (int) expr_prior,
360 priority, symbol.name);
361 scan_symbol();
362 expression = pars_infix_expression(priority, do_match_expr);
363 } /* if */
364 } /* if */
365 if (do_match_expr) {
366 if (CATEGORY_OF_OBJ(expression) == EXPROBJECT) {
367 if (match_expression(expression) == NULL) {
368 err_object(NO_MATCH, expression);
369 } /* if */
370 } /* if */
371 } /* if */
372 while (expr_prior <= current_ident->left_token_priority &&
373 current_ident->infix_priority <= priority) {
374 expr_prior = current_ident->infix_priority;
375 formal_token = current_ident->infix_token;
376 expression = new_type_of_expression_object(expression,
377 &helplist, NULL);
378 helplist = add_element_to_list(helplist, read_name());
379 expression = pars_token(expression,
380 formal_token, helplist);
381 if (do_match_expr) {
382 if (CATEGORY_OF_OBJ(expression) == EXPROBJECT) {
383 if (match_expression(expression) == NULL) {
384 err_object(NO_MATCH, expression);
385 } /* if */
386 } /* if */
387 } /* if */
388 } /* while */
389 logFunction(printf("pars_infix_expression --> " FMT_U_MEM ", ",
390 (memSizeType) expression);
391 trace1(expression);
392 printf("\n"););
393 return expression;
394 } /* pars_infix_expression */
395