source: mainline/uspace/app/sbi/src/stype_expr.c@ 23de644

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

Update SBI to rev. 174.
  • Property mode set to 100644
File size: 25.1 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);
55static void stype_binop_tprimitive(stype_t *stype, stree_binop_t *binop,
56 tdata_item_t *ta, tdata_item_t *tb, tdata_item_t **rtitem);
57static void stype_binop_tobject(stype_t *stype, stree_binop_t *binop,
58 tdata_item_t *ta, tdata_item_t *tb, tdata_item_t **rtitem);
59
60static void stype_unop(stype_t *stype, stree_unop_t *unop,
61 tdata_item_t **rtitem);
62static void stype_unop_tprimitive(stype_t *stype, stree_unop_t *unop,
63 tdata_item_t *ta, tdata_item_t **rtitem);
64static void stype_new(stype_t *stype, stree_new_t *new,
65 tdata_item_t **rtitem);
66
67static void stype_access(stype_t *stype, stree_access_t *access,
68 tdata_item_t **rtitem);
69static void stype_access_tprimitive(stype_t *stype, stree_access_t *access,
70 tdata_item_t *arg_ti, tdata_item_t **rtitem);
71static void stype_access_tobject(stype_t *stype, stree_access_t *access,
72 tdata_item_t *arg_ti, tdata_item_t **rtitem);
73static void stype_access_tarray(stype_t *stype, stree_access_t *access,
74 tdata_item_t *arg_ti, tdata_item_t **rtitem);
75static void stype_access_tgeneric(stype_t *stype, stree_access_t *access,
76 tdata_item_t *arg_ti, tdata_item_t **rtitem);
77
78static void stype_call(stype_t *stype, stree_call_t *call,
79 tdata_item_t **rtitem);
80
81static void stype_index(stype_t *stype, stree_index_t *index,
82 tdata_item_t **rtitem);
83static void stype_index_tprimitive(stype_t *stype, stree_index_t *index,
84 tdata_item_t *base_ti, tdata_item_t **rtitem);
85static void stype_index_tobject(stype_t *stype, stree_index_t *index,
86 tdata_item_t *base_ti, tdata_item_t **rtitem);
87static void stype_index_tarray(stype_t *stype, stree_index_t *index,
88 tdata_item_t *base_ti, tdata_item_t **rtitem);
89static void stype_index_tgeneric(stype_t *stype, stree_index_t *index,
90 tdata_item_t *base_ti, tdata_item_t **rtitem);
91
92static void stype_assign(stype_t *stype, stree_assign_t *assign,
93 tdata_item_t **rtitem);
94static void stype_as(stype_t *stype, stree_as_t *as_op, tdata_item_t **rtitem);
95
96
97/** Type expression. */
98void stype_expr(stype_t *stype, stree_expr_t *expr)
99{
100 tdata_item_t *et;
101
102#ifdef DEBUG_TYPE_TRACE
103 printf("Type expression.\n");
104#endif
105 /* Silence warning. */
106 et = NULL;
107
108 switch (expr->ec) {
109 case ec_nameref: stype_nameref(stype, expr->u.nameref, &et); break;
110 case ec_literal: stype_literal(stype, expr->u.literal, &et); break;
111 case ec_self_ref: stype_self_ref(stype, expr->u.self_ref, &et); break;
112 case ec_binop: stype_binop(stype, expr->u.binop, &et); break;
113 case ec_unop: stype_unop(stype, expr->u.unop, &et); break;
114 case ec_new: stype_new(stype, expr->u.new_op, &et); break;
115 case ec_access: stype_access(stype, expr->u.access, &et); break;
116 case ec_call: stype_call(stype, expr->u.call, &et); break;
117 case ec_index: stype_index(stype, expr->u.index, &et); break;
118 case ec_assign: stype_assign(stype, expr->u.assign, &et); break;
119 case ec_as: stype_as(stype, expr->u.as_op, &et); break;
120 }
121
122 expr->titem = et;
123
124#ifdef DEBUG_TYPE_TRACE
125 printf("Expression type is '");
126 tdata_item_print(et);
127 printf("'.\n");
128#endif
129}
130
131/** Type name reference. */
132static void stype_nameref(stype_t *stype, stree_nameref_t *nameref,
133 tdata_item_t **rtitem)
134{
135 stree_symbol_t *sym;
136 stree_vdecl_t *vdecl;
137 stree_proc_arg_t *proc_arg;
138 tdata_item_t *titem;
139 tdata_object_t *tobject;
140 stree_csi_t *csi;
141 stree_fun_t *fun;
142
143#ifdef DEBUG_TYPE_TRACE
144 printf("Evaluate type of name reference '%s'.\n",
145 strtab_get_str(nameref->name->sid));
146#endif
147 /*
148 * Look for a local variable declaration.
149 */
150
151 vdecl = stype_local_vars_lookup(stype, nameref->name->sid);
152 if (vdecl != NULL) {
153 /* Found a local variable declaration. */
154#ifdef DEBUG_RUN_TRACE
155 printf("Found local variable declaration.\n");
156#endif
157 run_texpr(stype->program, stype->current_csi, vdecl->type,
158 &titem);
159 *rtitem = titem;
160 return;
161 }
162
163 /*
164 * Look for a procedure argument.
165 */
166
167 proc_arg = stype_proc_args_lookup(stype, nameref->name->sid);
168 if (proc_arg != NULL) {
169 /* Found a procedure argument. */
170#ifdef DEBUG_RUN_TRACE
171 printf("Found procedure argument.\n");
172#endif
173 run_texpr(stype->program, stype->current_csi, proc_arg->type,
174 &titem);
175 *rtitem = titem;
176 return;
177 }
178
179 /*
180 * Look for a class-wide or global symbol.
181 */
182
183 sym = symbol_lookup_in_csi(stype->program, stype->current_csi,
184 nameref->name);
185
186 if (sym == NULL) {
187 /* Not found. */
188 if (stype->current_csi != NULL) {
189 printf("Error: Symbol '%s' not found in '",
190 strtab_get_str(nameref->name->sid));
191 symbol_print_fqn(csi_to_symbol(stype->current_csi));
192 printf("'.\n");
193 } else {
194 printf("Error: Symbol '%s' not found.\n",
195 strtab_get_str(nameref->name->sid));
196 }
197 stype_note_error(stype);
198 *rtitem = stype_recovery_titem(stype);
199 return;
200 }
201
202 switch (sym->sc) {
203 case sc_var:
204 run_texpr(stype->program, stype->current_csi,
205 sym->u.var->type, &titem);
206 break;
207 case sc_prop:
208 run_texpr(stype->program, stype->current_csi,
209 sym->u.prop->type, &titem);
210 break;
211 case sc_csi:
212 csi = symbol_to_csi(sym);
213 assert(csi != NULL);
214
215 titem = tdata_item_new(tic_tobject);
216 tobject = tdata_object_new();
217 titem->u.tobject = tobject;
218
219 /* This is a static CSI reference. */
220 tobject->static_ref = b_true;
221 tobject->csi = csi;
222 break;
223 case sc_fun:
224 fun = symbol_to_fun(sym);
225 assert(fun != NULL);
226
227 titem = tdata_item_new(tic_tfun);
228 titem->u.tfun = tdata_fun_new();
229 titem->u.tfun->fun = fun;
230 break;
231 }
232
233 *rtitem = titem;
234}
235
236/** Type a literal. */
237static void stype_literal(stype_t *stype, stree_literal_t *literal,
238 tdata_item_t **rtitem)
239{
240 tdata_item_t *titem;
241 tdata_primitive_t *tprimitive;
242 tprimitive_class_t tpc;
243
244#ifdef DEBUG_TYPE_TRACE
245 printf("Evaluate type of literal.\n");
246#endif
247 (void) stype;
248
249 switch (literal->ltc) {
250 case ltc_int: tpc = tpc_int; break;
251 case ltc_ref: tpc = tpc_nil; break;
252 case ltc_string: tpc = tpc_string; break;
253 }
254
255 titem = tdata_item_new(tic_tprimitive);
256 tprimitive = tdata_primitive_new(tpc);
257 titem->u.tprimitive = tprimitive;
258
259 *rtitem = titem;
260}
261
262/** Type a self reference. */
263static void stype_self_ref(stype_t *stype, stree_self_ref_t *self_ref,
264 tdata_item_t **rtitem)
265{
266#ifdef DEBUG_TYPE_TRACE
267 printf("Evaluate type of self reference.\n");
268#endif
269 (void) stype;
270 (void) self_ref;
271
272 *rtitem = NULL;
273}
274
275/** Type a binary operation. */
276static void stype_binop(stype_t *stype, stree_binop_t *binop,
277 tdata_item_t **rtitem)
278{
279 bool_t equal;
280 tdata_item_t *titem1, *titem2;
281
282#ifdef DEBUG_TYPE_TRACE
283 printf("Evaluate type of binary operation.\n");
284#endif
285 stype_expr(stype, binop->arg1);
286 stype_expr(stype, binop->arg2);
287
288 titem1 = binop->arg1->titem;
289 titem2 = binop->arg2->titem;
290
291 if (titem1 == NULL || titem2 == NULL) {
292 printf("Error: Binary operand has no value.\n");
293 stype_note_error(stype);
294 *rtitem = stype_recovery_titem(stype);
295 return;
296 }
297
298 if (titem1->tic == tic_ignore || titem2->tic == tic_ignore) {
299 *rtitem = stype_recovery_titem(stype);
300 return;
301 }
302
303 equal = tdata_item_equal(titem1, titem2);
304 if (equal != b_true) {
305 printf("Error: Binary operation arguments "
306 "have different types ('");
307 tdata_item_print(titem1);
308 printf("' and '");
309 tdata_item_print(titem2);
310 printf("').\n");
311 stype_note_error(stype);
312 *rtitem = stype_recovery_titem(stype);
313 return;
314 }
315
316 switch (titem1->tic) {
317 case tic_tprimitive:
318 stype_binop_tprimitive(stype, binop, titem1, titem2, rtitem);
319 break;
320 case tic_tobject:
321 stype_binop_tobject(stype, binop, titem1, titem2, rtitem);
322 break;
323 default:
324 printf("Error: Binary operation on value which is not of a "
325 "supported type (found '");
326 tdata_item_print(titem1);
327 printf("').\n");
328 stype_note_error(stype);
329 *rtitem = stype_recovery_titem(stype);
330 break;
331 }
332
333}
334
335/** Type a binary operation arguments of primitive type. */
336static void stype_binop_tprimitive(stype_t *stype, stree_binop_t *binop,
337 tdata_item_t *ta, tdata_item_t *tb, tdata_item_t **rtitem)
338{
339 tprimitive_class_t rtpc;
340 tdata_item_t *res_ti;
341
342 (void) stype;
343
344 assert(ta->tic == tic_tprimitive);
345 assert(tb->tic == tic_tprimitive);
346
347 switch (ta->u.tprimitive->tpc) {
348 case tpc_int:
349 rtpc = tpc_int;
350 break;
351 case tpc_nil:
352 printf("Unimplemented; Binary operation on nil.\n");
353 stype_note_error(stype);
354 rtpc = tpc_nil;
355 break;
356 case tpc_string:
357 if (binop->bc != bo_plus) {
358 printf("Unimplemented: Binary operation(%d) "
359 "on strings.\n", binop->bc);
360 stype_note_error(stype);
361 }
362 rtpc = tpc_string;
363 break;
364 case tpc_resource:
365 printf("Error: Cannot apply operator to resource type.\n");
366 stype_note_error(stype);
367 rtpc = tpc_resource;
368 }
369
370 res_ti = tdata_item_new(tic_tprimitive);
371 res_ti->u.tprimitive = tdata_primitive_new(rtpc);
372
373 *rtitem = res_ti;
374}
375
376/** Type a binary operation arguments of an object type. */
377static void stype_binop_tobject(stype_t *stype, stree_binop_t *binop,
378 tdata_item_t *ta, tdata_item_t *tb, tdata_item_t **rtitem)
379{
380 tdata_item_t *res_ti;
381
382 (void) stype;
383
384 assert(ta->tic == tic_tobject || (ta->tic == tic_tprimitive &&
385 ta->u.tprimitive->tpc == tpc_nil));
386 assert(tb->tic == tic_tobject || (tb->tic == tic_tprimitive &&
387 tb->u.tprimitive->tpc == tpc_nil));
388
389 switch (binop->bc) {
390 case bo_equal:
391 case bo_notequal:
392 /* Comparing objects -> boolean (XXX int for now) type */
393 res_ti = tdata_item_new(tic_tprimitive);
394 res_ti->u.tprimitive = tdata_primitive_new(tpc_int);
395 break;
396 default:
397 printf("Error: Binary operation (%d) on objects.\n",
398 binop->bc);
399 res_ti = NULL;
400 return;
401 }
402
403 *rtitem = res_ti;
404}
405
406
407/** Type a unary operation. */
408static void stype_unop(stype_t *stype, stree_unop_t *unop,
409 tdata_item_t **rtitem)
410{
411 tdata_item_t *titem;
412
413#ifdef DEBUG_TYPE_TRACE
414 printf("Evaluate type of unary operation.\n");
415#endif
416 stype_expr(stype, unop->arg);
417
418 titem = unop->arg->titem;
419
420 if (titem->tic == tic_ignore) {
421 *rtitem = stype_recovery_titem(stype);
422 return;
423 }
424
425 switch (titem->tic) {
426 case tic_tprimitive:
427 stype_unop_tprimitive(stype, unop, titem, rtitem);
428 break;
429 default:
430 printf("Error: Unary operation on value which is not of a "
431 "supported type (found '");
432 tdata_item_print(titem);
433 printf("').\n");
434 stype_note_error(stype);
435 *rtitem = stype_recovery_titem(stype);
436 break;
437 }
438}
439
440/** Type a binary operation arguments of primitive type. */
441static void stype_unop_tprimitive(stype_t *stype, stree_unop_t *unop,
442 tdata_item_t *ta, tdata_item_t **rtitem)
443{
444 tprimitive_class_t rtpc;
445 tdata_item_t *res_ti;
446
447 (void) stype;
448 (void) unop;
449
450 assert(ta->tic == tic_tprimitive);
451
452 switch (ta->u.tprimitive->tpc) {
453 case tpc_int:
454 rtpc = tpc_int;
455 break;
456 default:
457 printf("Error: Unary operator applied on unsupported "
458 "primitive type %d.\n", ta->u.tprimitive->tpc);
459 stype_note_error(stype);
460 *rtitem = stype_recovery_titem(stype);
461 return;
462 }
463
464 res_ti = tdata_item_new(tic_tprimitive);
465 res_ti->u.tprimitive = tdata_primitive_new(rtpc);
466
467 *rtitem = res_ti;
468}
469
470/** Type a @c new operation. */
471static void stype_new(stype_t *stype, stree_new_t *new_op,
472 tdata_item_t **rtitem)
473{
474#ifdef DEBUG_TYPE_TRACE
475 printf("Evaluate type of 'new' operation.\n");
476#endif
477 /*
478 * Type of @c new expression is exactly the type supplied as parameter
479 * to the @c new operator.
480 */
481 run_texpr(stype->program, stype->current_csi, new_op->texpr, rtitem);
482}
483
484/** Type a field access operation */
485static void stype_access(stype_t *stype, stree_access_t *access,
486 tdata_item_t **rtitem)
487{
488 tdata_item_t *arg_ti;
489
490#ifdef DEBUG_TYPE_TRACE
491 printf("Evaluate type of access operation.\n");
492#endif
493 stype_expr(stype, access->arg);
494 arg_ti = access->arg->titem;
495
496 if (arg_ti == NULL) {
497 printf("Error: Argument of access has no value.\n");
498 stype_note_error(stype);
499 *rtitem = stype_recovery_titem(stype);
500 return;
501 }
502
503 switch (arg_ti->tic) {
504 case tic_tprimitive:
505 stype_access_tprimitive(stype, access, arg_ti, rtitem);
506 break;
507 case tic_tobject:
508 stype_access_tobject(stype, access, arg_ti, rtitem);
509 break;
510 case tic_tarray:
511 stype_access_tarray(stype, access, arg_ti, rtitem);
512 break;
513 case tic_tgeneric:
514 stype_access_tgeneric(stype, access, arg_ti, rtitem);
515 break;
516 case tic_tfun:
517 printf("Error: Using '.' operator on a function.\n");
518 stype_note_error(stype);
519 *rtitem = stype_recovery_titem(stype);
520 break;
521 case tic_ignore:
522 *rtitem = stype_recovery_titem(stype);
523 break;
524 }
525}
526
527/** Type a primitive type access operation. */
528static void stype_access_tprimitive(stype_t *stype, stree_access_t *access,
529 tdata_item_t *arg_ti, tdata_item_t **rtitem)
530{
531 (void) stype;
532 (void) access;
533 (void) rtitem;
534
535 printf("Error: Unimplemented: Accessing primitive type '");
536 tdata_item_print(arg_ti);
537 printf("'.\n");
538 stype_note_error(stype);
539 *rtitem = stype_recovery_titem(stype);
540}
541
542/** Type an object access operation. */
543static void stype_access_tobject(stype_t *stype, stree_access_t *access,
544 tdata_item_t *arg_ti, tdata_item_t **rtitem)
545{
546 stree_symbol_t *member_sym;
547 stree_var_t *var;
548 stree_fun_t *fun;
549 stree_prop_t *prop;
550 tdata_object_t *tobject;
551
552#ifdef DEBUG_TYPE_TRACE
553 printf("Type a CSI access operation.\n");
554#endif
555 assert(arg_ti->tic == tic_tobject);
556 tobject = arg_ti->u.tobject;
557
558 /* Look for a member with the specified name. */
559 member_sym = symbol_search_csi(stype->program, tobject->csi,
560 access->member_name);
561
562 if (member_sym == NULL) {
563 /* No such member found. */
564 printf("Error: CSI '");
565 symbol_print_fqn(csi_to_symbol(tobject->csi));
566 printf("' has no member named '%s'.\n",
567 strtab_get_str(access->member_name->sid));
568 *rtitem = stype_recovery_titem(stype);
569 return;
570 }
571
572#ifdef DEBUG_RUN_TRACE
573 printf("Found member '%s'.\n",
574 strtab_get_str(access->member_name->sid));
575#endif
576
577 switch (member_sym->sc) {
578 case sc_csi:
579 printf("Error: Accessing object member which is nested "
580 "CSI.\n");
581 stype_note_error(stype);
582 *rtitem = stype_recovery_titem(stype);
583 break;
584 case sc_fun:
585 fun = symbol_to_fun(member_sym);
586 assert(fun != NULL);
587 *rtitem = tdata_item_new(tic_tfun);
588 (*rtitem)->u.tfun = tdata_fun_new();
589 (*rtitem)->u.tfun->fun = fun;
590 break;
591 case sc_var:
592 var = symbol_to_var(member_sym);
593 assert(var != NULL);
594 /* XXX Memoize to avoid recomputing every time. */
595 run_texpr(stype->program, member_sym->outer_csi,
596 var->type, rtitem);
597 break;
598 case sc_prop:
599 prop = symbol_to_prop(member_sym);
600 assert(prop != NULL);
601 /* XXX Memoize to avoid recomputing every time. */
602 run_texpr(stype->program, member_sym->outer_csi,
603 prop->type, rtitem);
604 break;
605 }
606}
607
608/** Type an array access operation. */
609static void stype_access_tarray(stype_t *stype, stree_access_t *access,
610 tdata_item_t *arg_ti, tdata_item_t **rtitem)
611{
612 (void) stype;
613 (void) access;
614 (void) rtitem;
615
616 printf("Error: Unimplemented: Accessing array type '");
617 tdata_item_print(arg_ti);
618 printf("'.\n");
619 stype_note_error(stype);
620 *rtitem = stype_recovery_titem(stype);
621}
622
623/** Type a generic access operation. */
624static void stype_access_tgeneric(stype_t *stype, stree_access_t *access,
625 tdata_item_t *arg_ti, tdata_item_t **rtitem)
626{
627 (void) stype;
628 (void) access;
629 (void) rtitem;
630
631 printf("Error: Unimplemented: Accessing generic type '");
632 tdata_item_print(arg_ti);
633 printf("'.\n");
634 stype_note_error(stype);
635 *rtitem = stype_recovery_titem(stype);
636}
637
638/** Type a call operation. */
639static void stype_call(stype_t *stype, stree_call_t *call,
640 tdata_item_t **rtitem)
641{
642 list_node_t *farg_n;
643 stree_proc_arg_t *farg;
644 tdata_item_t *farg_ti;
645 tdata_item_t *varg_ti;
646
647 list_node_t *arg_n;
648 stree_expr_t *arg;
649 stree_expr_t *carg;
650
651 tdata_item_t *fun_ti;
652 stree_fun_t *fun;
653 stree_symbol_t *fun_sym;
654
655#ifdef DEBUG_TYPE_TRACE
656 printf("Evaluate type of call operation.\n");
657#endif
658 /* Type the function */
659 stype_expr(stype, call->fun);
660
661 /* Check type item class */
662
663 fun_ti = call->fun->titem;
664 switch (fun_ti->tic) {
665 case tic_tfun:
666 /* The expected case */
667 break;
668 case tic_ignore:
669 *rtitem = stype_recovery_titem(stype);
670 return;
671 default:
672 printf("Error: Calling something which is not a function ");
673 printf("(found '");
674 tdata_item_print(fun_ti);
675 printf("').\n");
676 stype_note_error(stype);
677 *rtitem = stype_recovery_titem(stype);
678 return;
679 }
680
681 fun = fun_ti->u.tfun->fun;
682 fun_sym = fun_to_symbol(fun);
683
684 /* Type and check the arguments. */
685 farg_n = list_first(&fun->args);
686 arg_n = list_first(&call->args);
687 while (farg_n != NULL && arg_n != NULL) {
688 farg = list_node_data(farg_n, stree_proc_arg_t *);
689 arg = list_node_data(arg_n, stree_expr_t *);
690 stype_expr(stype, arg);
691
692 /* XXX Because of overloaded bultin WriteLine */
693 if (farg->type == NULL) {
694 /* Skip the check */
695 farg_n = list_next(&fun->args, farg_n);
696 arg_n = list_next(&call->args, arg_n);
697 continue;
698 }
699
700 /* XXX Memoize to avoid recomputing every time. */
701 run_texpr(stype->program, fun_sym->outer_csi, farg->type,
702 &farg_ti);
703
704 /* Convert expression to type of formal argument. */
705 carg = stype_convert(stype, arg, farg_ti);
706
707 /* Patch code with augmented expression. */
708 list_node_setdata(arg_n, carg);
709
710 farg_n = list_next(&fun->args, farg_n);
711 arg_n = list_next(&call->args, arg_n);
712 }
713
714 /* Type and check variadic arguments. */
715 if (fun->varg != NULL) {
716 /* XXX Memoize to avoid recomputing every time. */
717 run_texpr(stype->program, fun_sym->outer_csi, fun->varg->type,
718 &farg_ti);
719
720 /* Get array element type */
721 assert(farg_ti->tic == tic_tarray);
722 varg_ti = farg_ti->u.tarray->base_ti;
723
724 while (arg_n != NULL) {
725 arg = list_node_data(arg_n, stree_expr_t *);
726 stype_expr(stype, arg);
727
728 /* Convert expression to type of formal argument. */
729 carg = stype_convert(stype, arg, varg_ti);
730
731 /* Patch code with augmented expression. */
732 list_node_setdata(arg_n, carg);
733
734 arg_n = list_next(&call->args, arg_n);
735 }
736 }
737
738 if (farg_n != NULL) {
739 printf("Error: Too few arguments to function '");
740 symbol_print_fqn(fun_to_symbol(fun));
741 printf("'.\n");
742 stype_note_error(stype);
743 }
744
745 if (arg_n != NULL) {
746 printf("Error: Too many arguments to function '");
747 symbol_print_fqn(fun_to_symbol(fun));
748 printf("'.\n");
749 stype_note_error(stype);
750 }
751
752 if (fun->rtype != NULL) {
753 /* XXX Memoize to avoid recomputing every time. */
754 run_texpr(stype->program, fun_sym->outer_csi, fun->rtype,
755 rtitem);
756 } else {
757 *rtitem = NULL;
758 }
759}
760
761/** Type an indexing operation. */
762static void stype_index(stype_t *stype, stree_index_t *index,
763 tdata_item_t **rtitem)
764{
765 tdata_item_t *base_ti;
766 list_node_t *arg_n;
767 stree_expr_t *arg;
768
769#ifdef DEBUG_TYPE_TRACE
770 printf("Evaluate type of index operation.\n");
771#endif
772 stype_expr(stype, index->base);
773 base_ti = index->base->titem;
774
775 /* Type the arguments (indices). */
776 arg_n = list_first(&index->args);
777 while (arg_n != NULL) {
778 arg = list_node_data(arg_n, stree_expr_t *);
779 stype_expr(stype, arg);
780
781 arg_n = list_next(&index->args, arg_n);
782 }
783
784 switch (base_ti->tic) {
785 case tic_tprimitive:
786 stype_index_tprimitive(stype, index, base_ti, rtitem);
787 break;
788 case tic_tobject:
789 stype_index_tobject(stype, index, base_ti, rtitem);
790 break;
791 case tic_tarray:
792 stype_index_tarray(stype, index, base_ti, rtitem);
793 break;
794 case tic_tgeneric:
795 stype_index_tgeneric(stype, index, base_ti, rtitem);
796 break;
797 case tic_tfun:
798 printf("Error: Indexing a function.\n");
799 stype_note_error(stype);
800 *rtitem = stype_recovery_titem(stype);
801 break;
802 case tic_ignore:
803 *rtitem = stype_recovery_titem(stype);
804 break;
805 }
806}
807
808/** Type a primitive indexing operation. */
809static void stype_index_tprimitive(stype_t *stype, stree_index_t *index,
810 tdata_item_t *base_ti, tdata_item_t **rtitem)
811{
812 tdata_primitive_t *tprimitive;
813 tdata_item_t *titem;
814
815 (void) stype;
816 (void) index;
817
818 assert(base_ti->tic == tic_tprimitive);
819 tprimitive = base_ti->u.tprimitive;
820
821 if (tprimitive->tpc == tpc_string) {
822 titem = tdata_item_new(tic_tprimitive);
823 titem->u.tprimitive = tdata_primitive_new(tpc_int);
824 *rtitem = titem;
825 return;
826 }
827
828 printf("Error: Indexing primitive type '");
829 tdata_item_print(base_ti);
830 printf("'.\n");
831 stype_note_error(stype);
832 *rtitem = stype_recovery_titem(stype);
833}
834
835/** Type an object indexing operation. */
836static void stype_index_tobject(stype_t *stype, stree_index_t *index,
837 tdata_item_t *base_ti, tdata_item_t **rtitem)
838{
839 tdata_object_t *tobject;
840 stree_symbol_t *idx_sym;
841 stree_prop_t *idx;
842 stree_ident_t *idx_ident;
843
844 (void) index;
845
846#ifdef DEBUG_TYPE_TRACE
847 printf("Indexing object type '");
848 tdata_item_print(base_ti);
849 printf("'.\n");
850#endif
851
852 assert(base_ti->tic == tic_tobject);
853 tobject = base_ti->u.tobject;
854
855 /* Find indexer symbol. */
856 idx_ident = stree_ident_new();
857 idx_ident->sid = strtab_get_sid(INDEXER_IDENT);
858 idx_sym = symbol_search_csi(stype->program, tobject->csi, idx_ident);
859
860 if (idx_sym == NULL) {
861 printf("Error: Indexing object of type '");
862 tdata_item_print(base_ti);
863 printf("' which does not have an indexer.\n");
864 stype_note_error(stype);
865 *rtitem = stype_recovery_titem(stype);
866 return;
867 }
868
869 idx = symbol_to_prop(idx_sym);
870 assert(idx != NULL);
871
872 /* XXX Memoize to avoid recomputing every time. */
873 run_texpr(stype->program, idx_sym->outer_csi, idx->type, rtitem);
874}
875
876/** Type an array indexing operation. */
877static void stype_index_tarray(stype_t *stype, stree_index_t *index,
878 tdata_item_t *base_ti, tdata_item_t **rtitem)
879{
880 list_node_t *arg_n;
881 stree_expr_t *arg;
882 int arg_count;
883
884 (void) stype;
885 assert(base_ti->tic == tic_tarray);
886
887 /*
888 * Check that type of all indices is @c int and that the number of
889 * indices matches array rank.
890 */
891 arg_count = 0;
892 arg_n = list_first(&index->args);
893 while (arg_n != NULL) {
894 ++arg_count;
895
896 arg = list_node_data(arg_n, stree_expr_t *);
897 if (arg->titem->tic != tic_tprimitive ||
898 arg->titem->u.tprimitive->tpc != tpc_int) {
899
900 printf("Error: Array index is not an integer.\n");
901 stype_note_error(stype);
902 }
903
904 arg_n = list_next(&index->args, arg_n);
905 }
906
907 if (arg_count != base_ti->u.tarray->rank) {
908 printf("Error: Using %d indices with array of rank %d.\n",
909 arg_count, base_ti->u.tarray->rank);
910 stype_note_error(stype);
911 }
912
913 *rtitem = base_ti->u.tarray->base_ti;
914}
915
916/** Type a generic indexing operation. */
917static void stype_index_tgeneric(stype_t *stype, stree_index_t *index,
918 tdata_item_t *base_ti, tdata_item_t **rtitem)
919{
920 (void) stype;
921 (void) index;
922 (void) rtitem;
923
924 printf("Error: Unimplemented: Indexing generic type '");
925 tdata_item_print(base_ti);
926 printf("'.\n");
927 stype_note_error(stype);
928 *rtitem = stype_recovery_titem(stype);
929}
930
931/** Type an assignment. */
932static void stype_assign(stype_t *stype, stree_assign_t *assign,
933 tdata_item_t **rtitem)
934{
935 stree_expr_t *csrc;
936
937#ifdef DEBUG_TYPE_TRACE
938 printf("Evaluate type of assignment.\n");
939#endif
940 stype_expr(stype, assign->dest);
941 stype_expr(stype, assign->src);
942
943 csrc = stype_convert(stype, assign->src, assign->dest->titem);
944
945 /* Patch code with the augmented expression. */
946 assign->src = csrc;
947 *rtitem = NULL;
948}
949
950/** Type @c as conversion. */
951static void stype_as(stype_t *stype, stree_as_t *as_op, tdata_item_t **rtitem)
952{
953 tdata_item_t *titem;
954
955#ifdef DEBUG_TYPE_TRACE
956 printf("Evaluate type of @c as conversion.\n");
957#endif
958 stype_expr(stype, as_op->arg);
959 run_texpr(stype->program, stype->current_csi, as_op->dtype, &titem);
960
961 /* Check that target type is derived from argument type. */
962 if (tdata_is_ti_derived_from_ti(titem, as_op->arg->titem) != b_true) {
963 printf("Error: Target of 'as' operator '");
964 tdata_item_print(titem);
965 printf("' is not derived from '");
966 tdata_item_print(as_op->arg->titem);
967 printf("'.\n");
968 stype_note_error(stype);
969 }
970
971 *rtitem = titem;
972}
Note: See TracBrowser for help on using the repository browser.