source: mainline/uspace/app/sbi/src/stype_expr.c@ 074444f

lfn serial ticket/834-toolchain-update topic/msim-upgrade topic/simplify-dev-export
Last change on this file since 074444f was 074444f, checked in by Jiri Svoboda <jiri@…>, 16 years ago

Update SBI to rev. 184.
  • Property mode set to 100644
File size: 27.8 KB
Line 
1/*
2 * Copyright (c) 2010 Jiri Svoboda
3 * All rights reserved.
4 *
5 * Redistribution and use in source and binary forms, with or without
6 * modification, are permitted provided that the following conditions
7 * are met:
8 *
9 * - Redistributions of source code must retain the above copyright
10 * notice, this list of conditions and the following disclaimer.
11 * - Redistributions in binary form must reproduce the above copyright
12 * notice, this list of conditions and the following disclaimer in the
13 * documentation and/or other materials provided with the distribution.
14 * - The name of the author may not be used to endorse or promote products
15 * derived from this software without specific prior written permission.
16 *
17 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
18 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
19 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
20 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
21 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
22 * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
23 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
24 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
25 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
26 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 */
28
29/** @file Type expressions. */
30
31#include <stdio.h>
32#include <stdlib.h>
33#include <assert.h>
34#include "debug.h"
35#include "list.h"
36#include "mytypes.h"
37#include "run_texpr.h"
38#include "stree.h"
39#include "strtab.h"
40#include "stype.h"
41#include "symbol.h"
42#include "tdata.h"
43
44#include "stype_expr.h"
45
46static void stype_nameref(stype_t *stype, stree_nameref_t *nameref,
47 tdata_item_t **rtitem);
48static void stype_literal(stype_t *stype, stree_literal_t *literal,
49 tdata_item_t **rtitem);
50static void stype_self_ref(stype_t *stype, stree_self_ref_t *self_ref,
51 tdata_item_t **rtitem);
52
53static void stype_binop(stype_t *stype, stree_binop_t *binop,
54 tdata_item_t **rtitem);
55
56static void stype_binop_tprimitive(stype_t *stype, stree_binop_t *binop,
57 tdata_item_t *ta, tdata_item_t *tb, tdata_item_t **rtitem);
58static void stype_binop_bool(stype_t *stype, stree_binop_t *binop,
59 tdata_item_t **rtitem);
60static void stype_binop_char(stype_t *stype, stree_binop_t *binop,
61 tdata_item_t **rtitem);
62static void stype_binop_int(stype_t *stype, stree_binop_t *binop,
63 tdata_item_t **rtitem);
64static void stype_binop_nil(stype_t *stype, stree_binop_t *binop,
65 tdata_item_t **rtitem);
66static void stype_binop_string(stype_t *stype, stree_binop_t *binop,
67 tdata_item_t **rtitem);
68static void stype_binop_resource(stype_t *stype, stree_binop_t *binop,
69 tdata_item_t **rtitem);
70
71static void stype_binop_tobject(stype_t *stype, stree_binop_t *binop,
72 tdata_item_t *ta, tdata_item_t *tb, tdata_item_t **rtitem);
73
74static void stype_unop(stype_t *stype, stree_unop_t *unop,
75 tdata_item_t **rtitem);
76static void stype_unop_tprimitive(stype_t *stype, stree_unop_t *unop,
77 tdata_item_t *ta, tdata_item_t **rtitem);
78static void stype_new(stype_t *stype, stree_new_t *new,
79 tdata_item_t **rtitem);
80
81static void stype_access(stype_t *stype, stree_access_t *access,
82 tdata_item_t **rtitem);
83static void stype_access_tprimitive(stype_t *stype, stree_access_t *access,
84 tdata_item_t *arg_ti, tdata_item_t **rtitem);
85static void stype_access_tobject(stype_t *stype, stree_access_t *access,
86 tdata_item_t *arg_ti, tdata_item_t **rtitem);
87static void stype_access_tarray(stype_t *stype, stree_access_t *access,
88 tdata_item_t *arg_ti, tdata_item_t **rtitem);
89
90static void stype_call(stype_t *stype, stree_call_t *call,
91 tdata_item_t **rtitem);
92
93static void stype_index(stype_t *stype, stree_index_t *index,
94 tdata_item_t **rtitem);
95static void stype_index_tprimitive(stype_t *stype, stree_index_t *index,
96 tdata_item_t *base_ti, tdata_item_t **rtitem);
97static void stype_index_tobject(stype_t *stype, stree_index_t *index,
98 tdata_item_t *base_ti, tdata_item_t **rtitem);
99static void stype_index_tarray(stype_t *stype, stree_index_t *index,
100 tdata_item_t *base_ti, tdata_item_t **rtitem);
101
102static void stype_assign(stype_t *stype, stree_assign_t *assign,
103 tdata_item_t **rtitem);
104static void stype_as(stype_t *stype, stree_as_t *as_op, tdata_item_t **rtitem);
105
106
107/** Type expression. */
108void stype_expr(stype_t *stype, stree_expr_t *expr)
109{
110 tdata_item_t *et;
111
112#ifdef DEBUG_TYPE_TRACE
113 printf("Type expression.\n");
114#endif
115 /* Silence warning. */
116 et = NULL;
117
118 switch (expr->ec) {
119 case ec_nameref: stype_nameref(stype, expr->u.nameref, &et); break;
120 case ec_literal: stype_literal(stype, expr->u.literal, &et); break;
121 case ec_self_ref: stype_self_ref(stype, expr->u.self_ref, &et); break;
122 case ec_binop: stype_binop(stype, expr->u.binop, &et); break;
123 case ec_unop: stype_unop(stype, expr->u.unop, &et); break;
124 case ec_new: stype_new(stype, expr->u.new_op, &et); break;
125 case ec_access: stype_access(stype, expr->u.access, &et); break;
126 case ec_call: stype_call(stype, expr->u.call, &et); break;
127 case ec_index: stype_index(stype, expr->u.index, &et); break;
128 case ec_assign: stype_assign(stype, expr->u.assign, &et); break;
129 case ec_as: stype_as(stype, expr->u.as_op, &et); break;
130 }
131
132 expr->titem = et;
133
134#ifdef DEBUG_TYPE_TRACE
135 printf("Expression type is '");
136 tdata_item_print(et);
137 printf("'.\n");
138#endif
139}
140
141/** Type name reference. */
142static void stype_nameref(stype_t *stype, stree_nameref_t *nameref,
143 tdata_item_t **rtitem)
144{
145 stree_symbol_t *sym;
146 stree_vdecl_t *vdecl;
147 stree_proc_arg_t *proc_arg;
148 tdata_item_t *titem;
149 tdata_object_t *tobject;
150 stree_csi_t *csi;
151 stree_fun_t *fun;
152
153#ifdef DEBUG_TYPE_TRACE
154 printf("Evaluate type of name reference '%s'.\n",
155 strtab_get_str(nameref->name->sid));
156#endif
157 /*
158 * Look for a local variable declaration.
159 */
160
161 vdecl = stype_local_vars_lookup(stype, nameref->name->sid);
162 if (vdecl != NULL) {
163 /* Found a local variable declaration. */
164#ifdef DEBUG_RUN_TRACE
165 printf("Found local variable declaration.\n");
166#endif
167 run_texpr(stype->program, stype->current_csi, vdecl->type,
168 &titem);
169 *rtitem = titem;
170 return;
171 }
172
173 /*
174 * Look for a procedure argument.
175 */
176
177 proc_arg = stype_proc_args_lookup(stype, nameref->name->sid);
178 if (proc_arg != NULL) {
179 /* Found a procedure argument. */
180#ifdef DEBUG_RUN_TRACE
181 printf("Found procedure argument.\n");
182#endif
183 run_texpr(stype->program, stype->current_csi, proc_arg->type,
184 &titem);
185 *rtitem = titem;
186 return;
187 }
188
189 /*
190 * Look for a class-wide or global symbol.
191 */
192
193 sym = symbol_lookup_in_csi(stype->program, stype->current_csi,
194 nameref->name);
195
196 if (sym == NULL) {
197 /* Not found. */
198 if (stype->current_csi != NULL) {
199 printf("Error: Symbol '%s' not found in '",
200 strtab_get_str(nameref->name->sid));
201 symbol_print_fqn(csi_to_symbol(stype->current_csi));
202 printf("'.\n");
203 } else {
204 printf("Error: Symbol '%s' not found.\n",
205 strtab_get_str(nameref->name->sid));
206 }
207 stype_note_error(stype);
208 *rtitem = stype_recovery_titem(stype);
209 return;
210 }
211
212 switch (sym->sc) {
213 case sc_var:
214 run_texpr(stype->program, stype->current_csi,
215 sym->u.var->type, &titem);
216 break;
217 case sc_prop:
218 run_texpr(stype->program, stype->current_csi,
219 sym->u.prop->type, &titem);
220 break;
221 case sc_csi:
222 csi = symbol_to_csi(sym);
223 assert(csi != NULL);
224
225 titem = tdata_item_new(tic_tobject);
226 tobject = tdata_object_new();
227 titem->u.tobject = tobject;
228
229 /* This is a static CSI reference. */
230 tobject->static_ref = b_true;
231 tobject->csi = csi;
232 break;
233 case sc_fun:
234 fun = symbol_to_fun(sym);
235 assert(fun != NULL);
236
237 titem = tdata_item_new(tic_tfun);
238 titem->u.tfun = tdata_fun_new();
239 titem->u.tfun->fun = fun;
240 break;
241 }
242
243 *rtitem = titem;
244}
245
246/** Type a literal. */
247static void stype_literal(stype_t *stype, stree_literal_t *literal,
248 tdata_item_t **rtitem)
249{
250 tdata_item_t *titem;
251 tdata_primitive_t *tprimitive;
252 tprimitive_class_t tpc;
253
254#ifdef DEBUG_TYPE_TRACE
255 printf("Evaluate type of literal.\n");
256#endif
257 (void) stype;
258
259 switch (literal->ltc) {
260 case ltc_bool: tpc = tpc_bool; break;
261 case ltc_char: tpc = tpc_char; break;
262 case ltc_int: tpc = tpc_int; break;
263 case ltc_ref: tpc = tpc_nil; break;
264 case ltc_string: tpc = tpc_string; break;
265 }
266
267 titem = tdata_item_new(tic_tprimitive);
268 tprimitive = tdata_primitive_new(tpc);
269 titem->u.tprimitive = tprimitive;
270
271 *rtitem = titem;
272}
273
274/** Type a self reference. */
275static void stype_self_ref(stype_t *stype, stree_self_ref_t *self_ref,
276 tdata_item_t **rtitem)
277{
278#ifdef DEBUG_TYPE_TRACE
279 printf("Evaluate type of self reference.\n");
280#endif
281 (void) stype;
282 (void) self_ref;
283
284 *rtitem = NULL;
285}
286
287/** Type a binary operation. */
288static void stype_binop(stype_t *stype, stree_binop_t *binop,
289 tdata_item_t **rtitem)
290{
291 bool_t equal;
292 tdata_item_t *titem1, *titem2;
293
294#ifdef DEBUG_TYPE_TRACE
295 printf("Evaluate type of binary operation.\n");
296#endif
297 stype_expr(stype, binop->arg1);
298 stype_expr(stype, binop->arg2);
299
300 titem1 = binop->arg1->titem;
301 titem2 = binop->arg2->titem;
302
303 if (titem1 == NULL || titem2 == NULL) {
304 printf("Error: Binary operand has no value.\n");
305 stype_note_error(stype);
306 *rtitem = stype_recovery_titem(stype);
307 return;
308 }
309
310 if (titem1->tic == tic_ignore || titem2->tic == tic_ignore) {
311 *rtitem = stype_recovery_titem(stype);
312 return;
313 }
314
315 equal = tdata_item_equal(titem1, titem2);
316 if (equal != b_true) {
317 printf("Error: Binary operation arguments "
318 "have different types ('");
319 tdata_item_print(titem1);
320 printf("' and '");
321 tdata_item_print(titem2);
322 printf("').\n");
323 stype_note_error(stype);
324 *rtitem = stype_recovery_titem(stype);
325 return;
326 }
327
328 switch (titem1->tic) {
329 case tic_tprimitive:
330 stype_binop_tprimitive(stype, binop, titem1, titem2, rtitem);
331 break;
332 case tic_tobject:
333 stype_binop_tobject(stype, binop, titem1, titem2, rtitem);
334 break;
335 default:
336 printf("Error: Binary operation on value which is not of a "
337 "supported type (found '");
338 tdata_item_print(titem1);
339 printf("').\n");
340 stype_note_error(stype);
341 *rtitem = stype_recovery_titem(stype);
342 break;
343 }
344
345}
346
347/** Type a binary operation with arguments of primitive type. */
348static void stype_binop_tprimitive(stype_t *stype, stree_binop_t *binop,
349 tdata_item_t *ta, tdata_item_t *tb, tdata_item_t **rtitem)
350{
351 assert(ta->tic == tic_tprimitive);
352 assert(tb->tic == tic_tprimitive);
353
354 switch (ta->u.tprimitive->tpc) {
355 case tpc_bool:
356 stype_binop_bool(stype, binop, rtitem);
357 break;
358 case tpc_char:
359 stype_binop_char(stype, binop, rtitem);
360 break;
361 case tpc_int:
362 stype_binop_int(stype, binop, rtitem);
363 break;
364 case tpc_nil:
365 stype_binop_nil(stype, binop, rtitem);
366 break;
367 case tpc_string:
368 stype_binop_string(stype, binop, rtitem);
369 break;
370 case tpc_resource:
371 stype_binop_resource(stype, binop, rtitem);
372 break;
373 }
374}
375
376/** Type a binary operation with bool arguments. */
377static void stype_binop_bool(stype_t *stype, stree_binop_t *binop,
378 tdata_item_t **rtitem)
379{
380 tprimitive_class_t rtpc;
381 tdata_item_t *res_ti;
382
383 switch (binop->bc) {
384 case bo_equal:
385 case bo_notequal:
386 case bo_lt:
387 case bo_gt:
388 case bo_lt_equal:
389 case bo_gt_equal:
390 /* Comparison -> boolean type */
391 rtpc = tpc_bool;
392 break;
393 case bo_plus:
394 case bo_minus:
395 case bo_mult:
396 /* Arithmetic -> error */
397 printf("Error: Binary operation (%d) on booleans.\n",
398 binop->bc);
399 stype_note_error(stype);
400 *rtitem = stype_recovery_titem(stype);
401 return;
402 }
403
404 res_ti = tdata_item_new(tic_tprimitive);
405 res_ti->u.tprimitive = tdata_primitive_new(rtpc);
406
407 *rtitem = res_ti;
408}
409
410/** Type a binary operation with char arguments. */
411static void stype_binop_char(stype_t *stype, stree_binop_t *binop,
412 tdata_item_t **rtitem)
413{
414 tprimitive_class_t rtpc;
415 tdata_item_t *res_ti;
416
417 (void) stype;
418
419 switch (binop->bc) {
420 case bo_equal:
421 case bo_notequal:
422 case bo_lt:
423 case bo_gt:
424 case bo_lt_equal:
425 case bo_gt_equal:
426 /* Comparison -> boolean type */
427 rtpc = tpc_bool;
428 break;
429 case bo_plus:
430 case bo_minus:
431 case bo_mult:
432 /* Arithmetic -> error */
433 printf("Error: Binary operation (%d) on characters.\n",
434 binop->bc);
435 stype_note_error(stype);
436 rtpc = tpc_char;
437 break;
438 }
439
440 res_ti = tdata_item_new(tic_tprimitive);
441 res_ti->u.tprimitive = tdata_primitive_new(rtpc);
442
443 *rtitem = res_ti;
444}
445
446/** Type a binary operation with int arguments. */
447static void stype_binop_int(stype_t *stype, stree_binop_t *binop,
448 tdata_item_t **rtitem)
449{
450 tprimitive_class_t rtpc;
451 tdata_item_t *res_ti;
452
453 (void) stype;
454
455 switch (binop->bc) {
456 case bo_equal:
457 case bo_notequal:
458 case bo_lt:
459 case bo_gt:
460 case bo_lt_equal:
461 case bo_gt_equal:
462 /* Comparison -> boolean type */
463 rtpc = tpc_bool;
464 break;
465 case bo_plus:
466 case bo_minus:
467 case bo_mult:
468 /* Arithmetic -> int type */
469 rtpc = tpc_int;
470 break;
471 }
472
473 res_ti = tdata_item_new(tic_tprimitive);
474 res_ti->u.tprimitive = tdata_primitive_new(rtpc);
475
476 *rtitem = res_ti;
477}
478
479/** Type a binary operation with nil arguments. */
480static void stype_binop_nil(stype_t *stype, stree_binop_t *binop,
481 tdata_item_t **rtitem)
482{
483 (void) binop;
484
485 printf("Unimplemented; Binary operation on nil.\n");
486 stype_note_error(stype);
487 *rtitem = stype_recovery_titem(stype);
488}
489
490/** Type a binary operation with string arguments. */
491static void stype_binop_string(stype_t *stype, stree_binop_t *binop,
492 tdata_item_t **rtitem)
493{
494 tprimitive_class_t rtpc;
495 tdata_item_t *res_ti;
496
497 if (binop->bc != bo_plus) {
498 printf("Unimplemented: Binary operation(%d) "
499 "on strings.\n", binop->bc);
500 stype_note_error(stype);
501 *rtitem = stype_recovery_titem(stype);
502 return;
503 }
504
505 rtpc = tpc_string;
506
507 res_ti = tdata_item_new(tic_tprimitive);
508 res_ti->u.tprimitive = tdata_primitive_new(rtpc);
509
510 *rtitem = res_ti;
511}
512
513/** Type a binary operation with resource arguments. */
514static void stype_binop_resource(stype_t *stype, stree_binop_t *binop,
515 tdata_item_t **rtitem)
516{
517 tprimitive_class_t rtpc;
518 tdata_item_t *res_ti;
519
520 (void) binop;
521
522 printf("Error: Cannot apply operator to resource type.\n");
523 stype_note_error(stype);
524 rtpc = tpc_resource;
525
526 res_ti = tdata_item_new(tic_tprimitive);
527 res_ti->u.tprimitive = tdata_primitive_new(rtpc);
528
529 *rtitem = res_ti;
530}
531
532/** Type a binary operation with arguments of an object type. */
533static void stype_binop_tobject(stype_t *stype, stree_binop_t *binop,
534 tdata_item_t *ta, tdata_item_t *tb, tdata_item_t **rtitem)
535{
536 tdata_item_t *res_ti;
537
538 (void) stype;
539
540 assert(ta->tic == tic_tobject || (ta->tic == tic_tprimitive &&
541 ta->u.tprimitive->tpc == tpc_nil));
542 assert(tb->tic == tic_tobject || (tb->tic == tic_tprimitive &&
543 tb->u.tprimitive->tpc == tpc_nil));
544
545 switch (binop->bc) {
546 case bo_equal:
547 case bo_notequal:
548 /* Comparing objects -> boolean type */
549 res_ti = stype_boolean_titem(stype);
550 break;
551 default:
552 printf("Error: Binary operation (%d) on objects.\n",
553 binop->bc);
554 stype_note_error(stype);
555 *rtitem = stype_recovery_titem(stype);
556 return;
557 }
558
559 *rtitem = res_ti;
560}
561
562
563/** Type a unary operation. */
564static void stype_unop(stype_t *stype, stree_unop_t *unop,
565 tdata_item_t **rtitem)
566{
567 tdata_item_t *titem;
568
569#ifdef DEBUG_TYPE_TRACE
570 printf("Evaluate type of unary operation.\n");
571#endif
572 stype_expr(stype, unop->arg);
573
574 titem = unop->arg->titem;
575
576 if (titem->tic == tic_ignore) {
577 *rtitem = stype_recovery_titem(stype);
578 return;
579 }
580
581 switch (titem->tic) {
582 case tic_tprimitive:
583 stype_unop_tprimitive(stype, unop, titem, rtitem);
584 break;
585 default:
586 printf("Error: Unary operation on value which is not of a "
587 "supported type (found '");
588 tdata_item_print(titem);
589 printf("').\n");
590 stype_note_error(stype);
591 *rtitem = stype_recovery_titem(stype);
592 break;
593 }
594}
595
596/** Type a binary operation arguments of primitive type. */
597static void stype_unop_tprimitive(stype_t *stype, stree_unop_t *unop,
598 tdata_item_t *ta, tdata_item_t **rtitem)
599{
600 tprimitive_class_t rtpc;
601 tdata_item_t *res_ti;
602
603 (void) stype;
604 (void) unop;
605
606 assert(ta->tic == tic_tprimitive);
607
608 switch (ta->u.tprimitive->tpc) {
609 case tpc_bool:
610 rtpc = tpc_bool;
611 break;
612 case tpc_int:
613 rtpc = tpc_int;
614 break;
615 default:
616 printf("Error: Unary operator applied on unsupported "
617 "primitive type %d.\n", ta->u.tprimitive->tpc);
618 stype_note_error(stype);
619 *rtitem = stype_recovery_titem(stype);
620 return;
621 }
622
623 res_ti = tdata_item_new(tic_tprimitive);
624 res_ti->u.tprimitive = tdata_primitive_new(rtpc);
625
626 *rtitem = res_ti;
627}
628
629/** Type a @c new operation. */
630static void stype_new(stype_t *stype, stree_new_t *new_op,
631 tdata_item_t **rtitem)
632{
633#ifdef DEBUG_TYPE_TRACE
634 printf("Evaluate type of 'new' operation.\n");
635#endif
636 /*
637 * Type of @c new expression is exactly the type supplied as parameter
638 * to the @c new operator.
639 */
640 run_texpr(stype->program, stype->current_csi, new_op->texpr, rtitem);
641
642 if ((*rtitem)->tic == tic_ignore) {
643 /* An error occured when evaluating the type expression. */
644 stype_note_error(stype);
645 }
646}
647
648/** Type a field access operation */
649static void stype_access(stype_t *stype, stree_access_t *access,
650 tdata_item_t **rtitem)
651{
652 tdata_item_t *arg_ti;
653
654#ifdef DEBUG_TYPE_TRACE
655 printf("Evaluate type of access operation.\n");
656#endif
657 stype_expr(stype, access->arg);
658 arg_ti = access->arg->titem;
659
660 if (arg_ti == NULL) {
661 printf("Error: Argument of access has no value.\n");
662 stype_note_error(stype);
663 *rtitem = stype_recovery_titem(stype);
664 return;
665 }
666
667 switch (arg_ti->tic) {
668 case tic_tprimitive:
669 stype_access_tprimitive(stype, access, arg_ti, rtitem);
670 break;
671 case tic_tobject:
672 stype_access_tobject(stype, access, arg_ti, rtitem);
673 break;
674 case tic_tarray:
675 stype_access_tarray(stype, access, arg_ti, rtitem);
676 break;
677 case tic_tfun:
678 printf("Error: Using '.' operator on a function.\n");
679 stype_note_error(stype);
680 *rtitem = stype_recovery_titem(stype);
681 break;
682 case tic_ignore:
683 *rtitem = stype_recovery_titem(stype);
684 break;
685 }
686}
687
688/** Type a primitive type access operation. */
689static void stype_access_tprimitive(stype_t *stype, stree_access_t *access,
690 tdata_item_t *arg_ti, tdata_item_t **rtitem)
691{
692 (void) stype;
693 (void) access;
694 (void) rtitem;
695
696 printf("Error: Unimplemented: Accessing primitive type '");
697 tdata_item_print(arg_ti);
698 printf("'.\n");
699 stype_note_error(stype);
700 *rtitem = stype_recovery_titem(stype);
701}
702
703/** Type an object access operation. */
704static void stype_access_tobject(stype_t *stype, stree_access_t *access,
705 tdata_item_t *arg_ti, tdata_item_t **rtitem)
706{
707 stree_symbol_t *member_sym;
708 stree_var_t *var;
709 stree_fun_t *fun;
710 stree_prop_t *prop;
711 tdata_object_t *tobject;
712
713#ifdef DEBUG_TYPE_TRACE
714 printf("Type a CSI access operation.\n");
715#endif
716 assert(arg_ti->tic == tic_tobject);
717 tobject = arg_ti->u.tobject;
718
719 /* Look for a member with the specified name. */
720 member_sym = symbol_search_csi(stype->program, tobject->csi,
721 access->member_name);
722
723 if (member_sym == NULL) {
724 /* No such member found. */
725 printf("Error: CSI '");
726 symbol_print_fqn(csi_to_symbol(tobject->csi));
727 printf("' has no member named '%s'.\n",
728 strtab_get_str(access->member_name->sid));
729 stype_note_error(stype);
730 *rtitem = stype_recovery_titem(stype);
731 return;
732 }
733
734#ifdef DEBUG_RUN_TRACE
735 printf("Found member '%s'.\n",
736 strtab_get_str(access->member_name->sid));
737#endif
738
739 switch (member_sym->sc) {
740 case sc_csi:
741 printf("Error: Accessing object member which is nested "
742 "CSI.\n");
743 stype_note_error(stype);
744 *rtitem = stype_recovery_titem(stype);
745 break;
746 case sc_fun:
747 fun = symbol_to_fun(member_sym);
748 assert(fun != NULL);
749 *rtitem = tdata_item_new(tic_tfun);
750 (*rtitem)->u.tfun = tdata_fun_new();
751 (*rtitem)->u.tfun->fun = fun;
752 break;
753 case sc_var:
754 var = symbol_to_var(member_sym);
755 assert(var != NULL);
756 /* XXX Memoize to avoid recomputing every time. */
757 run_texpr(stype->program, member_sym->outer_csi,
758 var->type, rtitem);
759 break;
760 case sc_prop:
761 prop = symbol_to_prop(member_sym);
762 assert(prop != NULL);
763 /* XXX Memoize to avoid recomputing every time. */
764 run_texpr(stype->program, member_sym->outer_csi,
765 prop->type, rtitem);
766 break;
767 }
768}
769
770/** Type an array access operation. */
771static void stype_access_tarray(stype_t *stype, stree_access_t *access,
772 tdata_item_t *arg_ti, tdata_item_t **rtitem)
773{
774 (void) stype;
775 (void) access;
776 (void) rtitem;
777
778 printf("Error: Unimplemented: Accessing array type '");
779 tdata_item_print(arg_ti);
780 printf("'.\n");
781 stype_note_error(stype);
782 *rtitem = stype_recovery_titem(stype);
783}
784
785/** Type a call operation. */
786static void stype_call(stype_t *stype, stree_call_t *call,
787 tdata_item_t **rtitem)
788{
789 list_node_t *farg_n;
790 stree_proc_arg_t *farg;
791 tdata_item_t *farg_ti;
792 tdata_item_t *varg_ti;
793
794 list_node_t *arg_n;
795 stree_expr_t *arg;
796 stree_expr_t *carg;
797
798 tdata_item_t *fun_ti;
799 stree_fun_t *fun;
800 stree_symbol_t *fun_sym;
801
802#ifdef DEBUG_TYPE_TRACE
803 printf("Evaluate type of call operation.\n");
804#endif
805 /* Type the function */
806 stype_expr(stype, call->fun);
807
808 /* Check type item class */
809
810 fun_ti = call->fun->titem;
811 switch (fun_ti->tic) {
812 case tic_tfun:
813 /* The expected case */
814 break;
815 case tic_ignore:
816 *rtitem = stype_recovery_titem(stype);
817 return;
818 default:
819 printf("Error: Calling something which is not a function ");
820 printf("(found '");
821 tdata_item_print(fun_ti);
822 printf("').\n");
823 stype_note_error(stype);
824 *rtitem = stype_recovery_titem(stype);
825 return;
826 }
827
828 fun = fun_ti->u.tfun->fun;
829 fun_sym = fun_to_symbol(fun);
830
831 /* Type and check the arguments. */
832 farg_n = list_first(&fun->args);
833 arg_n = list_first(&call->args);
834 while (farg_n != NULL && arg_n != NULL) {
835 farg = list_node_data(farg_n, stree_proc_arg_t *);
836 arg = list_node_data(arg_n, stree_expr_t *);
837 stype_expr(stype, arg);
838
839 /* XXX Because of overloaded bultin WriteLine */
840 if (farg->type == NULL) {
841 /* Skip the check */
842 farg_n = list_next(&fun->args, farg_n);
843 arg_n = list_next(&call->args, arg_n);
844 continue;
845 }
846
847 /* XXX Memoize to avoid recomputing every time. */
848 run_texpr(stype->program, fun_sym->outer_csi, farg->type,
849 &farg_ti);
850
851 /* Convert expression to type of formal argument. */
852 carg = stype_convert(stype, arg, farg_ti);
853
854 /* Patch code with augmented expression. */
855 list_node_setdata(arg_n, carg);
856
857 farg_n = list_next(&fun->args, farg_n);
858 arg_n = list_next(&call->args, arg_n);
859 }
860
861 /* Type and check variadic arguments. */
862 if (fun->varg != NULL) {
863 /* XXX Memoize to avoid recomputing every time. */
864 run_texpr(stype->program, fun_sym->outer_csi, fun->varg->type,
865 &farg_ti);
866
867 /* Get array element type */
868 assert(farg_ti->tic == tic_tarray);
869 varg_ti = farg_ti->u.tarray->base_ti;
870
871 while (arg_n != NULL) {
872 arg = list_node_data(arg_n, stree_expr_t *);
873 stype_expr(stype, arg);
874
875 /* Convert expression to type of formal argument. */
876 carg = stype_convert(stype, arg, varg_ti);
877
878 /* Patch code with augmented expression. */
879 list_node_setdata(arg_n, carg);
880
881 arg_n = list_next(&call->args, arg_n);
882 }
883 }
884
885 if (farg_n != NULL) {
886 printf("Error: Too few arguments to function '");
887 symbol_print_fqn(fun_to_symbol(fun));
888 printf("'.\n");
889 stype_note_error(stype);
890 }
891
892 if (arg_n != NULL) {
893 printf("Error: Too many arguments to function '");
894 symbol_print_fqn(fun_to_symbol(fun));
895 printf("'.\n");
896 stype_note_error(stype);
897 }
898
899 if (fun->rtype != NULL) {
900 /* XXX Memoize to avoid recomputing every time. */
901 run_texpr(stype->program, fun_sym->outer_csi, fun->rtype,
902 rtitem);
903 } else {
904 *rtitem = NULL;
905 }
906}
907
908/** Type an indexing operation. */
909static void stype_index(stype_t *stype, stree_index_t *index,
910 tdata_item_t **rtitem)
911{
912 tdata_item_t *base_ti;
913 list_node_t *arg_n;
914 stree_expr_t *arg;
915
916#ifdef DEBUG_TYPE_TRACE
917 printf("Evaluate type of index operation.\n");
918#endif
919 stype_expr(stype, index->base);
920 base_ti = index->base->titem;
921
922 /* Type the arguments (indices). */
923 arg_n = list_first(&index->args);
924 while (arg_n != NULL) {
925 arg = list_node_data(arg_n, stree_expr_t *);
926 stype_expr(stype, arg);
927
928 arg_n = list_next(&index->args, arg_n);
929 }
930
931 switch (base_ti->tic) {
932 case tic_tprimitive:
933 stype_index_tprimitive(stype, index, base_ti, rtitem);
934 break;
935 case tic_tobject:
936 stype_index_tobject(stype, index, base_ti, rtitem);
937 break;
938 case tic_tarray:
939 stype_index_tarray(stype, index, base_ti, rtitem);
940 break;
941 case tic_tfun:
942 printf("Error: Indexing a function.\n");
943 stype_note_error(stype);
944 *rtitem = stype_recovery_titem(stype);
945 break;
946 case tic_ignore:
947 *rtitem = stype_recovery_titem(stype);
948 break;
949 }
950}
951
952/** Type a primitive indexing operation. */
953static void stype_index_tprimitive(stype_t *stype, stree_index_t *index,
954 tdata_item_t *base_ti, tdata_item_t **rtitem)
955{
956 tdata_primitive_t *tprimitive;
957 tdata_item_t *titem;
958
959 (void) stype;
960 (void) index;
961
962 assert(base_ti->tic == tic_tprimitive);
963 tprimitive = base_ti->u.tprimitive;
964
965 if (tprimitive->tpc == tpc_string) {
966 titem = tdata_item_new(tic_tprimitive);
967 titem->u.tprimitive = tdata_primitive_new(tpc_char);
968 *rtitem = titem;
969 return;
970 }
971
972 printf("Error: Indexing primitive type '");
973 tdata_item_print(base_ti);
974 printf("'.\n");
975 stype_note_error(stype);
976 *rtitem = stype_recovery_titem(stype);
977}
978
979/** Type an object indexing operation. */
980static void stype_index_tobject(stype_t *stype, stree_index_t *index,
981 tdata_item_t *base_ti, tdata_item_t **rtitem)
982{
983 tdata_object_t *tobject;
984 stree_symbol_t *idx_sym;
985 stree_prop_t *idx;
986 stree_ident_t *idx_ident;
987
988 (void) index;
989
990#ifdef DEBUG_TYPE_TRACE
991 printf("Indexing object type '");
992 tdata_item_print(base_ti);
993 printf("'.\n");
994#endif
995
996 assert(base_ti->tic == tic_tobject);
997 tobject = base_ti->u.tobject;
998
999 /* Find indexer symbol. */
1000 idx_ident = stree_ident_new();
1001 idx_ident->sid = strtab_get_sid(INDEXER_IDENT);
1002 idx_sym = symbol_search_csi(stype->program, tobject->csi, idx_ident);
1003
1004 if (idx_sym == NULL) {
1005 printf("Error: Indexing object of type '");
1006 tdata_item_print(base_ti);
1007 printf("' which does not have an indexer.\n");
1008 stype_note_error(stype);
1009 *rtitem = stype_recovery_titem(stype);
1010 return;
1011 }
1012
1013 idx = symbol_to_prop(idx_sym);
1014 assert(idx != NULL);
1015
1016 /* XXX Memoize to avoid recomputing every time. */
1017 run_texpr(stype->program, idx_sym->outer_csi, idx->type, rtitem);
1018}
1019
1020/** Type an array indexing operation. */
1021static void stype_index_tarray(stype_t *stype, stree_index_t *index,
1022 tdata_item_t *base_ti, tdata_item_t **rtitem)
1023{
1024 list_node_t *arg_n;
1025 stree_expr_t *arg;
1026 int arg_count;
1027
1028 (void) stype;
1029 assert(base_ti->tic == tic_tarray);
1030
1031 /*
1032 * Check that type of all indices is @c int and that the number of
1033 * indices matches array rank.
1034 */
1035 arg_count = 0;
1036 arg_n = list_first(&index->args);
1037 while (arg_n != NULL) {
1038 ++arg_count;
1039
1040 arg = list_node_data(arg_n, stree_expr_t *);
1041 if (arg->titem->tic != tic_tprimitive ||
1042 arg->titem->u.tprimitive->tpc != tpc_int) {
1043
1044 printf("Error: Array index is not an integer.\n");
1045 stype_note_error(stype);
1046 }
1047
1048 arg_n = list_next(&index->args, arg_n);
1049 }
1050
1051 if (arg_count != base_ti->u.tarray->rank) {
1052 printf("Error: Using %d indices with array of rank %d.\n",
1053 arg_count, base_ti->u.tarray->rank);
1054 stype_note_error(stype);
1055 }
1056
1057 *rtitem = base_ti->u.tarray->base_ti;
1058}
1059
1060/** Type an assignment. */
1061static void stype_assign(stype_t *stype, stree_assign_t *assign,
1062 tdata_item_t **rtitem)
1063{
1064 stree_expr_t *csrc;
1065
1066#ifdef DEBUG_TYPE_TRACE
1067 printf("Evaluate type of assignment.\n");
1068#endif
1069 stype_expr(stype, assign->dest);
1070 stype_expr(stype, assign->src);
1071
1072 csrc = stype_convert(stype, assign->src, assign->dest->titem);
1073
1074 /* Patch code with the augmented expression. */
1075 assign->src = csrc;
1076 *rtitem = NULL;
1077}
1078
1079/** Type @c as conversion. */
1080static void stype_as(stype_t *stype, stree_as_t *as_op, tdata_item_t **rtitem)
1081{
1082 tdata_item_t *titem;
1083
1084#ifdef DEBUG_TYPE_TRACE
1085 printf("Evaluate type of @c as conversion.\n");
1086#endif
1087 stype_expr(stype, as_op->arg);
1088 run_texpr(stype->program, stype->current_csi, as_op->dtype, &titem);
1089
1090 /* Check that target type is derived from argument type. */
1091 if (tdata_is_ti_derived_from_ti(titem, as_op->arg->titem) != b_true) {
1092 printf("Error: Target of 'as' operator '");
1093 tdata_item_print(titem);
1094 printf("' is not derived from '");
1095 tdata_item_print(as_op->arg->titem);
1096 printf("'.\n");
1097 stype_note_error(stype);
1098 }
1099
1100 *rtitem = titem;
1101}
Note: See TracBrowser for help on using the repository browser.