git @ Cat's Eye Technologies Bhuna / rel_0_4
Import of Bhuna 0.4 sources. catseye 9 years ago
31 changed file(s) with 1409 addition(s) and 256 deletion(s). Raw diff Collapse all Expand all
1111 }
1212
1313 Num = 7
14 // Print "Ack(3,", Num, "): ", Ack(3, Num), EoL
15 Print "Ack(3,"
16 Print Num
17 Print "): "
18 Print Ack(3, Num)
19 Print EoL
14 Print "Ack(3,", Num, "): ", Ack(3, Num), EoL
0 S = "lessthanten"
1
2 F = ^ A {
3 if A > 10
4 return A
5 else
6 return S
7 }
8
9 B = F(8)
0 F = ^ A {
1 if A = 0
2 return A
3 else
4 return [F(A-1)]
5 }
6
7 Print F(10)
0 A = [1, 2, 3]
1 B = A
2
3 PrintAB = ^ {
4 Print "A = ", A, EoL
5 Print "B = ", B, EoL
6 }
7
8 PrintAB;
9
10 B[2] = "foo"
11 PrintAB;
0 // A = [1, 5, 4]
1 // B = A[2]
2
3 F = ^ A { return A + 1 }
4
5 G = F(10)
0 A = 1 * 8
0 Print 1 + 3, " is ", 4
0 Print 7 + 3, " is ", 4
11
0 H = 1
1 F = ^ A, B {
2 Print A + B
3 return A - B
4 }
5
6 H 5, 6
7
0 F = ^ A {
1 if A < 10
2 Print "return 5"
3 else {
4 Print "I dunno, man...", EoL
5 // return "string!"
6 }
7 // return 100
8 }
9
10 Print F(4)
11
00 PROG= bhuna
1 SRCS= scan.c parse.c \
1 SRCS= report.c \
2 scan.c parse.c \
23 symbol.c ast.c \
4 type.c \
35 mem.c pool.c \
46 list.c atom.c buffer.c closure.c dict.c value.c \
57 activation.c eval.c \
810 main.c
911
1012 CFLAGS+=-DPOOL_VALUES
13 CFLAGS+=-DREFCOUNTING_MACROS
1114 CFLAGS+=-DINLINE_BUILTINS
1215 CFLAGS+=-Wall -I/usr/local/include
1316 .ifndef NODEBUG
161161 a_sp -= (sizeof(struct activation) + sizeof(struct value *) * a->size);
162162 }
163163
164 /*#ifndef REFCOUNTING_MACROS*/
164165 struct value *
165166 activation_get_value(struct activation *a, int index, int upcount)
166167 {
207208 value_grab(v);
208209 VALARY(a, index) = v;
209210 }
211 /*#endif*/
210212
211213 void
212214 activation_dump(struct activation *a, int detail)
77 #include "builtin.h"
88 #include "activation.h"
99 #include "vm.h"
10
11 #ifdef DEBUG
10 #include "type.h"
11 #include "scan.h"
12
1213 #include "symbol.h"
13 #endif
1414
1515 extern unsigned char program[];
16 extern int trace_type_inference;
1617
1718 /***** constructors *****/
1819
2324
2425 a = malloc(sizeof(struct ast));
2526 a->type = type;
27 a->sc = NULL;
2628 a->label = NULL;
27
28 return(a);
29 }
30
31 struct ast *
32 ast_new_local(int index, int upcount, void *sym)
29 a->datatype = NULL;
30
31 return(a);
32 }
33
34 struct ast *
35 ast_new_local(struct symbol_table *stab, struct symbol *sym)
3336 {
3437 struct ast *a;
3538
3639 a = ast_new(AST_LOCAL);
37 a->u.local.index = index;
38 a->u.local.upcount = upcount;
39 #ifdef DEBUG
40 a->u.local.index = sym->index;
41 a->u.local.upcount = stab->level - sym->in->level;
4042 a->u.local.sym = sym;
41 #endif
42
43 return(a);
44 }
45
46 struct ast *
47 ast_new_value(struct value *v)
43 a->datatype = sym->type;
44
45 #ifdef DEBUG
46 if (trace_type_inference) {
47 printf("(new-local)*****\n");
48 printf("type is: ");
49 type_print(stdout, a->datatype);
50 printf("\n*******\n");
51 }
52 #endif
53
54 return(a);
55 }
56
57 struct ast *
58 ast_new_value(struct value *v, struct type *t)
4859 {
4960 struct ast *a;
5061
5162 a = ast_new(AST_VALUE);
5263 value_grab(v);
5364 a->u.value.value = v;
54
55 return(a);
56 }
57
58 struct ast *
59 ast_new_builtin(struct builtin *bi, struct ast *right)
60 {
61 struct ast *a;
65 a->datatype = t;
66
67 #ifdef DEBUG
68 if (trace_type_inference) {
69 printf("(value)*****\n");
70 printf("type is: ");
71 type_print(stdout, a->datatype);
72 printf("\n*******\n");
73 }
74 #endif
75
76 return(a);
77 }
78
79 struct ast *
80 ast_new_builtin(struct scan_st *sc, struct builtin *bi, struct ast *right)
81 {
82 struct ast *a;
83 struct type *t;
84 int unify = 0;
85
86 t = bi->ty();
87 type_ensure_routine(t);
88
89 #ifdef DEBUG
90 if (trace_type_inference) {
91 printf("(builtin `%s`)*****\n", bi->name);
92 printf("type of args is: ");
93 type_print(stdout, right->datatype);
94 printf("\ntype of builtin is: ");
95 type_print(stdout, t);
96 }
97 #endif
98
99 unify = type_unify_crit(sc,
100 type_representative(t)->t.closure.domain,
101 right->datatype);
102
103 #ifdef DEBUG
104 if (trace_type_inference) {
105 printf("\nthese unify? --> %d <--", unify);
106 printf("\n****\n");
107 }
108 #endif
62109
63110 /*
64111 * Fold constants.
75122 } else {
76123 varity = bi->arity;
77124 }
78 ar = activation_new_on_stack(varity, NULL, NULL);
79 for (g = right, i = 0;
80 g != NULL && g->type == AST_ARG && i < varity;
81 g = g->u.arg.right, i++) {
82 if (g->u.arg.left != NULL)
83 activation_initialize_value(ar, i,
84 g->u.arg.left->u.value.value);
125
126 if (unify) {
127 ar = activation_new_on_stack(varity, NULL, NULL);
128 for (g = right, i = 0;
129 g != NULL && g->type == AST_ARG && i < varity;
130 g = g->u.arg.right, i++) {
131 if (g->u.arg.left != NULL)
132 activation_initialize_value(ar, i,
133 g->u.arg.left->u.value.value);
134 }
135 bi->fn(ar, &v);
136 activation_free_from_stack(ar);
137 } else {
138 a = NULL;
85139 }
86 bi->fn(ar, &v);
87 activation_free_from_stack(ar);
88 a = ast_new_value(v);
140
141 a = ast_new_value(v, type_representative(t)->t.closure.range);
89142 value_release(v);
90143
91144 return(a);
95148
96149 a->u.builtin.bi = bi;
97150 a->u.builtin.right = right;
98
99 return(a);
100 }
101
102 struct ast *
103 ast_new_apply(struct ast *fn, struct ast *args, int is_pure)
104 {
105 struct ast *a;
151 a->datatype = type_representative(t)->t.closure.range;
152
153 return(a);
154 }
155
156 struct ast *
157 ast_new_apply(struct scan_st *sc, struct ast *fn, struct ast *args, int is_pure)
158 {
159 struct ast *a;
160 int unify;
106161
107162 a = ast_new(AST_APPLY);
108163 a->u.apply.left = fn;
109164 a->u.apply.right = args;
110165 a->u.apply.is_pure = is_pure;
111166
167 type_ensure_routine(fn->datatype);
168
169 #ifdef DEBUG
170 if (trace_type_inference) {
171 printf("(apply)*****\n");
172 printf("type of args is: ");
173 if (args == NULL) printf("N/A"); else type_print(stdout, args->datatype);
174 printf("\ntype of closure is: ");
175 type_print(stdout, fn->datatype);
176 }
177 #endif
178
179 if (args == NULL) {
180 unify = type_unify_crit(sc,
181 type_representative(fn->datatype)->t.closure.domain,
182 type_new(TYPE_VOID)); /* XXX need not be new */
183 } else {
184 unify = type_unify_crit(sc,
185 type_representative(fn->datatype)->t.closure.domain,
186 args->datatype);
187 }
188
189 #ifdef DEBUG
190 if (trace_type_inference) {
191 printf("\nthese unify? --> %d <--", unify);
192 printf("\n****\n");
193 }
194 #endif
195
196 a->datatype = type_representative(fn->datatype)->t.closure.range;
197
112198 return(a);
113199 }
114200
120206 a = ast_new(AST_ARG);
121207 a->u.arg.left = left;
122208 a->u.arg.right = right;
123
209 if (a->u.arg.right == NULL) {
210 a->datatype = a->u.arg.left->datatype;
211 } else {
212 a->datatype = type_new_arg(
213 a->u.arg.left->datatype,
214 a->u.arg.right->datatype);
215 }
124216 return(a);
125217 }
126218
134226 a->u.routine.locals = locals;
135227 a->u.routine.cc = cc;
136228 a->u.routine.body = body;
229
230 a->datatype = a->u.routine.body->datatype;
231
232 #ifdef DEBUG
233 if (trace_type_inference) {
234 printf("(routine)*****\n");
235 printf("type is: ");
236 type_print(stdout, a->datatype);
237 printf("\n****\n");
238 }
239 #endif
137240
138241 return(a);
139242 }
153256 a = ast_new(AST_STATEMENT);
154257 a->u.statement.left = left;
155258 a->u.statement.right = right;
156
157 return(a);
158 }
159
160 struct ast *
161 ast_new_assignment(struct ast *left, struct ast *right)
162 {
163 struct ast *a;
259 /* XXX check that a->u.statement.left->datatype is VOID ?? */
260 a->datatype = a->u.statement.right->datatype;
261 /* haha... */
262 /*
263 a->datatype = type_new_set(a->u.statement.left->datatype,
264 a->u.statement.right->datatype);
265 */
266
267 #ifdef DEBUG
268 if (trace_type_inference) {
269 printf("(statement)*****\n");
270 printf("type is: ");
271 type_print(stdout, a->datatype);
272 printf("\n****\n");
273 }
274 #endif
275
276 return(a);
277 }
278
279 struct ast *
280 ast_new_assignment(struct scan_st *sc, struct ast *left, struct ast *right)
281 {
282 struct ast *a;
283 int unify;
284
285 /*
286 * Do some 'self-repairing' in the case of syntax errors that
287 * generate a corrupt AST (e.g. Foo = <eof>)
288 */
289 if (right == NULL)
290 return(left);
164291
165292 a = ast_new(AST_ASSIGNMENT);
166293 a->u.assignment.left = left;
167294 a->u.assignment.right = right;
168295
169 return(a);
170 }
171
172 struct ast *
173 ast_new_conditional(struct ast *test, struct ast *yes, struct ast *no)
174 {
175 struct ast *a;
296 unify = type_unify_crit(sc, left->datatype, right->datatype);
297
298 #ifdef DEBUG
299 if (trace_type_inference) {
300 printf("(assign)*****\n");
301 printf("type of LHS is: ");
302 type_print(stdout, left->datatype);
303 printf("\ntype of RHS is: ");
304 type_print(stdout, right->datatype);
305 printf("\nthese unify? --> %d <--", unify);
306 printf("\ntype of LHS is now: ");
307 type_print(stdout, left->datatype);
308 printf("\n****\n");
309 }
310 #endif
311
312 return(a);
313 }
314
315 struct ast *
316 ast_new_conditional(struct scan_st *sc, struct ast *test, struct ast *yes, struct ast *no)
317 {
318 struct ast *a;
319 int unify;
176320
177321 a = ast_new(AST_CONDITIONAL);
178322 a->u.conditional.test = test;
179323 a->u.conditional.yes = yes;
180324 a->u.conditional.no = no;
181
182 return(a);
183 }
184
185 struct ast *
186 ast_new_while_loop(struct ast *test, struct ast *body)
187 {
188 struct ast *a;
325 /* check that a->u.conditional.test is BOOLEAN */
326
327 /* XXX need not be new boolean - reuse an old one */
328 unify = type_unify_crit(sc, test->datatype, type_new(TYPE_BOOLEAN));
329
330 #ifdef DEBUG
331 if (trace_type_inference) {
332 printf("(if)*****\n");
333 printf("type of YES is: ");
334 type_print(stdout, yes->datatype);
335 printf("\ntype of NO is: ");
336 type_print(stdout, no->datatype);
337 }
338 #endif
339
340 /* XXX check that a->u.conditional.yes is VOID */
341 /* XXX check that a->u.conditional.no is VOID */
342
343 /* actually, either of these can be VOID, in which case, pick the other */
344 /* unify = type_unify_crit(sc, yes->datatype, no->datatype); */
345 /* haha */
346 a->datatype = type_new_set(a->u.conditional.yes->datatype,
347 a->u.conditional.no->datatype);
348
349 #ifdef DEBUG
350 if (trace_type_inference) {
351 printf("\nresult type is: ");
352 type_print(stdout, a->datatype);
353 printf("\n****\n");
354 }
355 #endif
356
357 return(a);
358 }
359
360 struct ast *
361 ast_new_while_loop(struct scan_st *sc, struct ast *test, struct ast *body)
362 {
363 struct ast *a;
364 int unify;
189365
190366 a = malloc(sizeof(struct ast));
191367 a->type = AST_WHILE_LOOP;
192368
193369 a->u.while_loop.test = test;
194370 a->u.while_loop.body = body;
371 /* XXX need not be new boolean - reuse an old one */
372 unify = type_unify_crit(sc, test->datatype, type_new(TYPE_BOOLEAN));
373
374 /* XXX check that a->u.while_loop.body is VOID */
375 /* a->datatype = type_new(TYPE_VOID); */
376 a->datatype = body->datatype;
195377
196378 return(a);
197379 }
203385
204386 a = ast_new(AST_RETR);
205387 a->u.retr.body = body;
388 /* XXX check against other return statements in same function... somehow... */
389 a->datatype = a->u.retr.body->datatype;
390
391 #ifdef DEBUG
392 if (trace_type_inference) {
393 printf("(retr)*****\n");
394 printf("type is: ");
395 type_print(stdout, a->datatype);
396 printf("\n****\n");
397 }
398 #endif
206399
207400 return(a);
208401 }
256449 ast_free(a->u.retr.body);
257450 break;
258451 }
452 if (a->sc != NULL)
453 scan_close(a->sc);
259454 free(a);
260455 }
261456
336531 if (a->label != NULL) {
337532 printf("@#%d -> ", a->label - (vm_label_t)program);
338533 }
534 printf(ast_name(a));
535 printf("=");
536 type_print(stdout, a->datatype);
339537 switch (a->type) {
340538 case AST_LOCAL:
341 printf("local(%d,%d)=", a->u.local.index, a->u.local.upcount);
539 printf("(%d,%d)=", a->u.local.index, a->u.local.upcount);
342540 if (a->u.local.sym != NULL)
343541 symbol_dump(a->u.local.sym, 0);
344542 printf("\n");
345543 break;
346544 case AST_VALUE:
347 printf("value(");
545 printf("(");
348546 value_print(a->u.value.value);
349547 printf(")\n");
350548 break;
351549 case AST_BUILTIN:
352 printf("builtin `%s`{\n", a->u.builtin.bi->name);
550 printf("`%s`{\n", a->u.builtin.bi->name);
353551 ast_dump(a->u.builtin.right, indent + 1);
354552 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
355553 break;
356554 case AST_APPLY:
357 printf("apply {\n");
555 printf("{\n");
358556 ast_dump(a->u.apply.left, indent + 1);
359557 ast_dump(a->u.apply.right, indent + 1);
360558 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
361559 break;
362560 case AST_ARG:
363 printf("arg {\n");
561 printf("{\n");
364562 ast_dump(a->u.arg.left, indent + 1);
365563 ast_dump(a->u.arg.right, indent + 1);
366564 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
367565 break;
368566 case AST_ROUTINE:
369 printf("routine/%d (contains %d) {\n",
567 printf("/%d (contains %d) {\n",
370568 a->u.routine.arity, a->u.routine.cc);
371569 ast_dump(a->u.routine.body, indent + 1);
372570 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
373571 break;
374572 case AST_STATEMENT:
375 printf("statement {\n");
573 printf("{\n");
376574 ast_dump(a->u.statement.left, indent + 1);
377575 ast_dump(a->u.statement.right, indent + 1);
378576 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
379577 break;
380578 case AST_ASSIGNMENT:
381 printf("assign {\n");
579 printf("{\n");
382580 ast_dump(a->u.assignment.left, indent + 1);
383581 ast_dump(a->u.assignment.right, indent + 1);
384582 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
385583 break;
386584 case AST_CONDITIONAL:
387 printf("conditional {\n"); /* a->u.conditional.index); */
585 printf("{\n");
388586 ast_dump(a->u.conditional.test, indent + 1);
389587 ast_dump(a->u.conditional.yes, indent + 1);
390588 if (a->u.conditional.no != NULL)
392590 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
393591 break;
394592 case AST_WHILE_LOOP:
395 printf("while {\n");
593 printf("{\n");
396594 ast_dump(a->u.while_loop.test, indent + 1);
397595 ast_dump(a->u.while_loop.body, indent + 1);
398596 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
399597 break;
400598 case AST_RETR:
401 printf("retr {\n");
599 printf("{\n");
402600 ast_dump(a->u.retr.body, indent + 1);
403601 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
404602 break;
44
55 struct value;
66 struct builtin;
7 struct type;
8 struct symbol;
9 struct symbol_table;
10 struct scan_st;
711
812 struct ast_local {
913 int index;
1014 int upcount;
11 #ifdef DEBUG
1215 struct symbol *sym;
13 #endif
1416 };
1517
1618 struct ast_value {
9395 };
9496
9597 struct ast {
96 int type;
97 vm_label_t label;
98 union ast_union u;
98 int type;
99 struct scan_st *sc;
100 struct type *datatype;
101 vm_label_t label;
102 union ast_union u;
99103 };
100104
101 struct ast *ast_new_local(int, int, void *);
102 struct ast *ast_new_value(struct value *);
103 struct ast *ast_new_builtin(struct builtin *, struct ast *);
104 struct ast *ast_new_apply(struct ast *, struct ast *, int);
105 struct ast *ast_new_local(struct symbol_table *, struct symbol *);
106 struct ast *ast_new_value(struct value *, struct type *);
107 struct ast *ast_new_builtin(struct scan_st *, struct builtin *, struct ast *);
108 struct ast *ast_new_apply(struct scan_st *, struct ast *, struct ast *, int);
105109 struct ast *ast_new_arg(struct ast *, struct ast *);
106110 struct ast *ast_new_routine(int, int, int, struct ast *);
107111 struct ast *ast_new_statement(struct ast *, struct ast *);
108 struct ast *ast_new_assignment(struct ast *, struct ast *);
109 struct ast *ast_new_conditional(struct ast *, struct ast *, struct ast *);
110 struct ast *ast_new_while_loop(struct ast *, struct ast *);
112 struct ast *ast_new_assignment(struct scan_st *, struct ast *, struct ast *);
113 struct ast *ast_new_conditional(struct scan_st *, struct ast *, struct ast *, struct ast *);
114 struct ast *ast_new_while_loop(struct scan_st *, struct ast *, struct ast *);
111115 struct ast *ast_new_retr(struct ast *);
112116 void ast_free(struct ast *);
113117
66 #include "dict.h"
77 #include "closure.h"
88 #include "activation.h"
9 #include "type.h"
910
1011 /*
1112 * Built-in operations.
1213 */
1314
1415 struct builtin builtins[] = {
15 {"Print", builtin_print, -1, 0, 1, 0},
16 {"!", builtin_not, 1, 1, 1, 1},
17 {"&", builtin_and, 2, 1, 1, 2},
18 {"|", builtin_or, 2, 1, 1, 3},
19 {"=", builtin_equ, 2, 1, 1, 4},
20 {"!=", builtin_neq, 2, 1, 1, 5},
21 {">", builtin_gt, 2, 1, 1, 6},
22 {"<", builtin_lt, 2, 1, 1, 7},
23 {">=", builtin_gte, 2, 1, 1, 8},
24 {"<=", builtin_lte, 2, 1, 1, 9},
25 {"+", builtin_add, 2, 1, 1, 10},
26 {"-", builtin_sub, 2, 1, 1, 11},
27 {"*", builtin_mul, 2, 1, 1, 12},
28 {"/", builtin_div, 2, 1, 1, 13},
29 {"%", builtin_mod, 2, 1, 1, 14},
30 {"List", builtin_list, -1, 1, 1, 15},
31 {"Fetch", builtin_fetch, 2, 1, 1, 16},
32 {"Store", builtin_store, 3, 0, 1, 17},
33 {"Dict", builtin_dict, -1, 1, 1, 18},
34 {NULL, NULL, 0, 0, 0, 19}
16 {"Print", builtin_print, btype_print, -1, 0, 1, 0},
17 {"!", builtin_not, btype_unary_logic, 1, 1, 1, 1},
18 {"&", builtin_and, btype_binary_logic, 2, 1, 1, 2},
19 {"|", builtin_or, btype_binary_logic, 2, 1, 1, 3},
20 {"=", builtin_equ, btype_compare, 2, 1, 1, 4},
21 {"!=", builtin_neq, btype_compare, 2, 1, 1, 5},
22 {">", builtin_gt, btype_compare, 2, 1, 1, 6},
23 {"<", builtin_lt, btype_compare, 2, 1, 1, 7},
24 {">=", builtin_gte, btype_compare, 2, 1, 1, 8},
25 {"<=", builtin_lte, btype_compare, 2, 1, 1, 9},
26 {"+", builtin_add, btype_arith, 2, 1, 1, 10},
27 {"-", builtin_sub, btype_arith, 2, 1, 1, 11},
28 {"*", builtin_mul, btype_arith, 2, 1, 1, 12},
29 {"/", builtin_div, btype_arith, 2, 1, 1, 13},
30 {"%", builtin_mod, btype_arith, 2, 1, 1, 14},
31 {"List", builtin_list, btype_list, -1, 1, 1, 15},
32 {"Fetch", builtin_fetch, btype_fetch, 2, 1, 1, 16},
33 {"Store", builtin_store, btype_store, 3, 0, 1, 17},
34 {"Dict", builtin_dict, btype_dict, -1, 1, 1, 18},
35 {NULL, NULL, NULL, 0, 0, 0, 19}
3536 };
3637
3738 void
390391 }
391392 }
392393 }
394
395 struct type *
396 btype_print(void)
397 {
398 return(
399 type_new_closure(
400 type_new_var(1),
401 type_new(TYPE_VOID)
402 )
403 );
404 }
405
406 struct type *
407 btype_unary_logic(void)
408 {
409 return(
410 type_new_closure(
411 type_new(TYPE_BOOLEAN),
412 type_new(TYPE_BOOLEAN)
413 )
414 );
415 }
416
417 struct type *
418 btype_binary_logic(void)
419 {
420 return(
421 type_new_closure(
422 type_new_arg(type_new(TYPE_BOOLEAN), type_new(TYPE_BOOLEAN)),
423 type_new(TYPE_BOOLEAN)
424 )
425 );
426 }
427
428 struct type *
429 btype_compare(void)
430 {
431 return(
432 type_new_closure(
433 type_new_arg(type_new(TYPE_INTEGER), type_new(TYPE_INTEGER)),
434 type_new(TYPE_BOOLEAN)
435 )
436 );
437 }
438
439 struct type *
440 btype_arith(void)
441 {
442 return(
443 type_new_closure(
444 type_new_arg(type_new(TYPE_INTEGER), type_new(TYPE_INTEGER)),
445 type_new(TYPE_INTEGER)
446 )
447 );
448 }
449
450 struct type *
451 btype_list(void)
452 {
453 return(
454 type_new_closure(
455 type_new_var(2),
456 type_new_list(type_new(TYPE_INTEGER))
457 )
458 );
459 }
460
461 struct type *
462 btype_fetch(void)
463 {
464 return(
465 type_new_closure(
466 type_new_arg(type_new_var(5), type_new(TYPE_INTEGER)),
467 type_new_var(5)
468 )
469 );
470 }
471
472 struct type *
473 btype_store(void)
474 {
475 return(
476 type_new_closure(
477 type_new_arg(
478 type_new_var(6),
479 type_new_arg(type_new_var(7), type_new_var(8))
480 ),
481 type_new(TYPE_VOID)
482 )
483 );
484 }
485
486 struct type *
487 btype_dict(void)
488 {
489 return(NULL);
490 }
22
33 struct value;
44 struct activation;
5 struct type;
56
67 struct builtin {
78 char *name;
89 void (*fn)(struct activation *, struct value **);
10 struct type *(*ty)(void);
911 int arity;
1012 int is_pure;
1113 int is_const;
6163
6264 void builtin_dict(struct activation *, struct value **);
6365
66 struct type *btype_print(void);
67 struct type *btype_unary_logic(void);
68 struct type *btype_binary_logic(void);
69 struct type *btype_compare(void);
70 struct type *btype_arith(void);
71 struct type *btype_list(void);
72 struct type *btype_fetch(void);
73 struct type *btype_store(void);
74 struct type *btype_dict(void);
75
6476 #endif
88 #include "activation.h"
99 #include "vm.h"
1010
11 #include "type.h"
12
1113 struct closure *
1214 closure_new(struct ast *a, struct activation *ar)
1315 {
1416 struct closure *c;
1517
1618 c = bhuna_malloc(sizeof(struct closure));
19
1720 c->ast = a;
1821 c->ar = ar;
1922
1010 #include "value.h"
1111 #include "activation.h"
1212 #include "vm.h"
13 #include "type.h"
14 #include "report.h"
1315
1416 #ifdef POOL_VALUES
1517 #include "pool.h"
2628 int trace_vm = 0;
2729 int trace_gen = 0;
2830 int trace_pool = 0;
31 int trace_type_inference = 0;
2932
3033 int num_vars_created = 0;
3134 int num_vars_grabbed = 0;
3942 #endif
4043
4144 #ifdef DEBUG
42 #define OPTS "acdfg:klmnoprstvxz"
45 #define OPTS "acdfg:klmnoprstvxyz"
4346 #define RUN_PROGRAM run_program
4447 #else
4548 #define OPTS "g:x"
7780 #endif
7881 fprintf(stderr, " -x: execute bytecode (unless -n)\n");
7982 #ifdef DEBUG
83 fprintf(stderr, " -y: trace type inference\n");
8084 fprintf(stderr, " -z: dump symbol table after run\n");
8185 #endif
8286 exit(1);
9498 sym = symbol_define(stab, b[i].name, SYM_KIND_COMMAND, v);
9599 sym->is_pure = b[i].is_pure;
96100 sym->builtin = &b[i];
101 sym->type = b[i].ty();
97102 value_release(v);
98103 }
99104
100105 /* XXX */
101106 v = value_new_string("\n");
102107 sym = symbol_define(stab, "EoL", SYM_KIND_VARIABLE, v);
108 sym->type = type_new(TYPE_STRING);
103109 value_release(v);
104110
105111 v = value_new_boolean(1);
106112 sym = symbol_define(stab, "True", SYM_KIND_VARIABLE, v);
113 sym->type = type_new(TYPE_BOOLEAN);
107114 value_release(v);
108115
109116 v = value_new_boolean(0);
110117 sym = symbol_define(stab, "False", SYM_KIND_VARIABLE, v);
118 sym->type = type_new(TYPE_BOOLEAN);
111119 value_release(v);
112120 }
113121
121129 char *source = NULL;
122130 int opt;
123131 int use_vm = 0;
132 int err_count = 0;
124133 #ifdef DEBUG
125134 int run_program = 1;
126135 int dump_symbols_beforehand = 0;
199208 use_vm = 1;
200209 break;
201210 #ifdef DEBUG
211 case 'y':
212 trace_type_inference++;
213 break;
202214 case 'z':
203215 dump_symbols_afterwards = 1;
204216 break;
221233 stab = symbol_table_new(NULL, 0);
222234 global_ar = activation_new_on_stack(100, NULL, NULL);
223235 load_builtins(stab, builtins);
236 report_start();
224237 a = parse_program(sc, stab);
225238 scan_close(sc);
226239 current_ar = global_ar;
234247 #ifndef DEBUG
235248 symbol_table_free(stab);
236249 #endif
237 if (sc->errors == 0 && use_vm) {
250 err_count = report_finish();
251 if (err_count == 0 && use_vm) {
238252 unsigned char *program;
239253
240254 program = ast_gen(a);
245259 vm_release(program);
246260 /*value_dump_global_table();*/
247261 #ifdef RECURSIVE_AST_EVALUATOR
248 } else if (sc->errors == 0 && RUN_PROGRAM) {
262 } else if (err_count == 0 && RUN_PROGRAM) {
249263 v = value_new_integer(76);
250264 ast_eval_init();
251265 ast_eval(a, &v);
4747 char *bhuna_strdup(char *);
4848 void bhuna_free(void *);
4949 #else*/
50 #include <stdlib.h>
5051 #define bhuna_malloc(x) malloc(x)
5152 #define bhuna_strdup(x) strdup(x)
5253 #define bhuna_free(x) free(x)
4747 #include "value.h"
4848 #include "atom.h"
4949 #include "ast.h"
50 #include "type.h"
51 #include "report.h"
5052
5153 #define VAR_LOCAL 0
5254 #define VAR_GLOBAL 1
6163 * Convenience function to create AST for a named arity-2 function call.
6264 */
6365 static struct ast *
64 ast_new_call2(char *name, struct symbol_table *stab,
66 ast_new_call2(char *name, struct scan_st *sc, struct symbol_table *stab,
6567 struct ast *left, struct ast *right)
6668 {
6769 struct symbol *sym;
6870 struct ast *a;
6971
70 left = ast_new_arg(left, NULL);
7172 right = ast_new_arg(right, NULL);
72 left->u.arg.right = right;
73 left = ast_new_arg(left, right);
7374
7475 sym = symbol_lookup(stab, name, VAR_GLOBAL);
7576 assert(sym != NULL && sym->builtin != NULL);
76 a = ast_new_builtin(sym->builtin, left);
77 a = ast_new_builtin(sc, sym->builtin, left);
7778
7879 return(a);
7980 }
8081
8182 static struct ast *
82 ast_new_call3(char *name, struct symbol_table *stab,
83 ast_new_call3(char *name, struct scan_st *sc, struct symbol_table *stab,
8384 struct ast *left, struct ast *index, struct ast *right)
8485 {
8586 struct symbol *sym;
8687 struct ast *a;
8788
88 left = ast_new_arg(left, NULL);
89 index = ast_new_arg(index, NULL);
9089 right = ast_new_arg(right, NULL);
91 left->u.arg.right = index;
92 index->u.arg.right = right;
90 index = ast_new_arg(index, right);
91 left = ast_new_arg(left, index);
9392
9493 sym = symbol_lookup(stab, name, VAR_GLOBAL);
9594 assert(sym != NULL && sym->builtin != NULL);
96 a = ast_new_builtin(sym->builtin, left);
95 a = ast_new_builtin(sc, sym->builtin, left);
9796
9897 return(a);
9998 }
169168 } else {
170169 r = NULL;
171170 }
172 a = ast_new_conditional(a, l, r);
171 a = ast_new_conditional(sc, a, l, r);
173172 } else if (tokeq(sc, "while")) {
174173 scan(sc);
175174 l = parse_expr(sc, stab, 0, NULL, cc);
176175 istab = symbol_table_new(stab, 0);
177176 r = parse_block(sc, stab, &istab, cc);
178 a = ast_new_while_loop(l, r);
177 a = ast_new_while_loop(sc, l, r);
179178 } else if (tokeq(sc, "return")) {
180179 scan(sc);
181180 a = parse_expr(sc, stab, 0, NULL, cc);
234233 r = parse_expr(sc, stab, 0, sym, cc);
235234 if (is_const) {
236235 if (r == NULL || r->type != AST_VALUE) {
237 scan_error(sc, "Expression must be constant");
236 report(REPORT_ERROR, sc, "Expression must be constant");
238237 } else {
239238 symbol_set_value(sym, r->u.value.value);
240239 ast_free(l);
242241 }
243242 return(NULL);
244243 } else {
245 return(ast_new_assignment(l, r));
244 return(ast_new_assignment(sc, l, r));
246245 }
247246 }
248247
251250 int *cc)
252251 {
253252 struct symbol *sym;
254 struct ast *a, *l, *r, *z;
253 struct ast *a, *l, *r;
255254
256255 a = parse_var(sc, stab, &sym, VAR_GLOBAL, VAR_MUST_EXIST, NULL);
257256
272271 */
273272 scan(sc);
274273 r = parse_expr(sc, stab, 0, NULL, cc);
275 a = ast_new_call3("Store", stab, a, l, r);
274 a = ast_new_call3("Store", sc, stab, a, l, r);
276275 return(a);
277276 } else if (tokne(sc, "[") && tokne(sc, ".")) {
278277 /*
283282 /*
284283 * Still more to go.
285284 */
286 a = ast_new_call2("Fetch", stab, a, l);
285 a = ast_new_call2("Fetch", sc, stab, a, l);
287286 }
288287 } else if (tokeq(sc, ".")) {
289288 scan(sc);
290289 r = parse_literal(sc, stab);
291 a = ast_new_call2("Fetch", stab, a, r);
290 a = ast_new_call2("Fetch", sc, stab, a, r);
292291 }
293292 }
294293
298297 */
299298 if (tokeq(sc, "=")) {
300299 if (sym->value != NULL) {
301 scan_error(sc, "Value not modifiable");
300 report(REPORT_ERROR, sc, "Value not modifiable");
302301 } else {
303302 scan(sc);
304303 r = parse_expr(sc, stab, 0, NULL, cc);
305 a = ast_new_assignment(a, r);
304 a = ast_new_assignment(sc, a, r);
306305 }
307306 return(a);
307 }
308
309 if (tokne(sc, "}") && tokne(sc, ";") && sc->type != TOKEN_EOF) {
310 l = parse_expr_list(sc, stab, NULL, cc);
311 } else {
312 l = NULL;
308313 }
309314
310315 /*
311316 * Otherwise, it's a command.
312317 */
313 if (tokne(sc, "}") && tokne(sc, ";") && sc->type != TOKEN_EOF) {
314 l = parse_expr(sc, stab, 0, NULL, cc);
315 l = ast_new_arg(l, NULL);
316 z = l;
317 while (tokeq(sc, ",")) {
318 scan_expect(sc, ",");
319 r = parse_expr(sc, stab, 0, NULL, cc);
320 r = ast_new_arg(r, NULL);
321 z->u.arg.right = r;
322 z = r;
323 }
324 } else {
325 l = NULL;
326 }
318 if (!type_is_possibly_routine(sym->type)) {
319 report(REPORT_ERROR, sc, "Command application of non-routine variable");
320 /*return(NULL);*/
321 }
322 type_ensure_routine(sym->type);
323 if (!type_is_void(type_representative(sym->type)->t.closure.range)) {
324 report(REPORT_ERROR, sc, "Command application of function variable");
325 /*return(NULL);*/
326 }
327
327328 if (sym->builtin != NULL) {
328 a = ast_new_builtin(sym->builtin, l);
329 } else {
330 a = ast_new_apply(a, l, 0);
331 }
332
333 return(a);
329 a = ast_new_builtin(sc, sym->builtin, l);
330 } else {
331 a = ast_new_apply(sc, a, l, 0);
332 }
333
334 return(a);
335 }
336
337 struct ast *
338 parse_expr_list(struct scan_st *sc, struct symbol_table *stab,
339 struct symbol *excl, int *cc)
340 {
341 struct ast *a, *b;
342
343 a = parse_expr(sc, stab, 0, excl, cc);
344 if (tokeq(sc, ",")) {
345 scan(sc);
346 b = parse_expr_list(sc, stab, excl, cc);
347 } else {
348 b = NULL;
349 }
350 return(ast_new_arg(a, b));
334351 }
335352
336353 /* ------------------------- EXPRESSIONS ------------------------ */
365382 scan(sc);
366383 done = 0;
367384 r = parse_expr(sc, stab, level + 1, excl, cc);
368 l = ast_new_call2(the_op, stab, l, r);
385 l = ast_new_call2(the_op, sc, stab, l, r);
369386 break;
370387 }
371388 }
378395 parse_primitive(struct scan_st *sc, struct symbol_table *stab,
379396 struct symbol *excl, int *cc)
380397 {
381 struct ast *a, *l, *r, *z;
398 struct ast *a, *l, *r;
382399 struct value *v;
383400 struct symbol *sym;
384401 struct symbol_table *istab;
390407 } else if (tokeq(sc, "^")) {
391408 int my_cc = 0;
392409 int my_arity = 0;
410 struct type *a_type = NULL;
393411
394412 /*
395413 * Enclosing block contains a closure:
401419 a = parse_var(sc, istab, &sym,
402420 VAR_LOCAL, VAR_MUST_NOT_EXIST, NULL);
403421 ast_free(a);
422 if (a_type == NULL)
423 a_type = sym->type;
424 else
425 a_type = type_new_arg(sym->type, a_type);
404426 my_arity++;
427 /*
428 printf("ARG TYPE:");
429 type_print(stdout, a_type);
430 printf("\n");
431 */
405432 if (tokeq(sc, ","))
406433 scan(sc);
407434 }
435 if (a_type == NULL)
436 a_type = type_new(TYPE_VOID);
408437 a = parse_block(sc, stab, &istab, &my_cc);
409438 a = ast_new_routine(my_arity, symbol_table_size(istab) - my_arity, my_cc, a);
439 if (type_is_set(a->datatype) && type_set_contains_void(a->datatype)) {
440 report(REPORT_ERROR, sc, "Routine must be either function or command");
441 }
410442 v = value_new_closure(a, NULL);
411 a = ast_new_value(v);
443 a = ast_new_value(v,
444 type_new_closure(a_type, a->datatype));
412445 value_release(v);
413446 } else if (tokeq(sc, "!")) {
414447 scan(sc);
415448 a = parse_primitive(sc, stab, excl, cc);
416449 sym = symbol_lookup(stab, "!", 1);
417 a = ast_new_apply(ast_new_local(
418 sym->index,
419 stab->level - sym->in->level,
420 sym), a, 1);
450 /* XXX builtin */
451 a = ast_new_apply(sc, ast_new_local(stab, sym), a, 1);
421452 } else if (tokeq(sc, "[")) {
422453 scan(sc);
423454 v = value_new_list();
424 a = ast_new_value(v);
455 a = ast_new_value(v, NULL); /* XXX list */
425456 value_release(v);
426457 if (tokne(sc, "]")) {
427 ast_free(a);
428 l = parse_expr(sc, stab, 0, excl, cc);
429 r = ast_new_arg(l, NULL);
430 z = r;
431 while (tokeq(sc, ",")) {
432 scan(sc);
433 l = parse_expr(sc, stab, 0, excl, cc);
434 l = ast_new_arg(l, NULL);
435 z->u.arg.right = l;
436 z = l;
437 }
458 l = parse_expr_list(sc, stab, excl, cc);
438459 sym = symbol_lookup(stab, "List", VAR_GLOBAL);
439460 assert(sym->builtin != NULL);
440 a = ast_new_builtin(sym->builtin, r);
461 a = ast_new_builtin(sc, sym->builtin, l);
441462 }
442463 scan_expect(sc, "]");
443464 } else if (sc->type == TOKEN_BAREWORD && isupper(sc->token[0])) {
444465 a = parse_var(sc, stab, &sym, VAR_GLOBAL, VAR_MUST_EXIST, NULL);
445466 if (sym == excl) {
446 scan_error(sc, "Initializer cannot refer to variable being defined");
467 report(REPORT_ERROR, sc, "Initializer cannot refer to variable being defined");
447468 return(NULL);
448469 }
449470 while (tokeq(sc, "(") || tokeq(sc, "[") || tokeq(sc, ".")) {
450471 if (tokeq(sc, "(")) {
451472 scan(sc);
452473 if (tokne(sc, ")")) {
453 l = parse_expr(sc, stab, 0, excl, cc);
454 l = ast_new_arg(l, NULL);
455 z = l;
456 while (tokeq(sc, ",")) {
457 scan(sc);
458 r = parse_expr(sc, stab, 0, excl, cc);
459 r = ast_new_arg(r, NULL);
460 z->u.arg.right = r;
461 z = r;
462 }
474 l = parse_expr_list(sc, stab, excl, cc);
463475 } else {
464476 l = NULL;
465477 }
466478 scan_expect(sc, ")");
479
480 if (!type_is_possibly_routine(sym->type)) {
481 report(REPORT_ERROR, sc, "Function application of non-routine variable");
482 /*return(NULL);*/
483 }
484 type_ensure_routine(sym->type);
485 if (type_is_void(type_representative(sym->type)->t.closure.range)) {
486 report(REPORT_ERROR, sc, "Function application of command variable");
487 /*return(NULL);*/
488 }
489
467490 if (sym->builtin != NULL) {
468 a = ast_new_builtin(sym->builtin, l);
491 a = ast_new_builtin(sc, sym->builtin, l);
469492 } else {
470 a = ast_new_apply(a, l, sym->is_pure);
493 a = ast_new_apply(sc, a, l, sym->is_pure);
471494 }
472495 } else if (tokeq(sc, "[")) {
473496 scan(sc);
474497 r = parse_expr(sc, stab, 0, excl, cc);
475498 scan_expect(sc, "]");
476 a = ast_new_call2("Fetch", stab, a, r);
499 a = ast_new_call2("Fetch", sc, stab, a, r);
477500 } else if (tokeq(sc, ".")) {
478501 scan(sc);
479502 r = parse_literal(sc, stab);
480 a = ast_new_call2("Fetch", stab, a, r);
503 a = ast_new_call2("Fetch", sc, stab, a, r);
481504 }
482505 }
483506 } else {
495518
496519 if (sc->type == TOKEN_BAREWORD && islower(sc->token[0])) {
497520 v = value_new_atom(atom_resolve(sc->token));
498 a = ast_new_value(v);
521 a = ast_new_value(v, type_new(TYPE_ATOM));
499522 value_release(v);
500523 scan(sc);
501524 } else if (sc->type == TOKEN_NUMBER) {
502525 v = value_new_integer(atoi(sc->token));
503 a = ast_new_value(v);
526 a = ast_new_value(v, type_new(TYPE_INTEGER));
504527 value_release(v);
505528 scan(sc);
506529 } else if (sc->type == TOKEN_QSTRING) {
507530 v = value_new_string(sc->token);
508 a = ast_new_value(v);
531 a = ast_new_value(v, type_new(TYPE_STRING));
509532 value_release(v);
510533 scan(sc);
511534 } else {
512 scan_error(sc, "Illegal literal");
535 report(REPORT_ERROR, sc, "Illegal literal");
513536 scan(sc);
514537 a = NULL;
515538 }
528551 *sym = symbol_lookup(stab, sc->token, globality);
529552 if (*sym == NULL) {
530553 if (existence == VAR_MUST_EXIST) {
531 scan_error(sc, "Undefined symbol");
554 report(REPORT_ERROR, sc, "Undefined symbol");
532555 }
533556 *sym = symbol_define(stab, sc->token, SYM_KIND_VARIABLE, v);
557 symbol_set_type(*sym, type_brand_new_var());
534558 } else {
535559 if (existence == VAR_MUST_NOT_EXIST) {
536 scan_error(sc, "Symbol already defined");
560 report(REPORT_ERROR, sc, "Symbol already defined");
537561 }
538562 }
539563 scan(sc);
540564
541565 if ((*sym)->value != NULL) {
542 a = ast_new_value((*sym)->value);
543 } else {
544 a = ast_new_local((*sym)->index, stab->level - (*sym)->in->level, (*sym));
545 }
546 return(a);
547 }
566 a = ast_new_value((*sym)->value, (*sym)->type);
567 } else {
568 a = ast_new_local(stab, (*sym));
569 }
570 return(a);
571 }
2121 int *);
2222 struct ast *parse_command_or_assignment(struct scan_st *, struct symbol_table *,
2323 int *);
24 struct ast *parse_expr_list(struct scan_st *, struct symbol_table *,
25 struct symbol *, int *);
2426 struct ast *parse_expr(struct scan_st *, struct symbol_table *, int,
2527 struct symbol *, int *);
2628 struct ast *parse_primitive(struct scan_st *, struct symbol_table *,
2729 struct symbol *, int *);
28 /*struct ast *parse_list_elem(struct scan_st *, struct symbol_table *);*/
2930 struct ast *parse_literal(struct scan_st *, struct symbol_table *);
3031 struct ast *parse_var(struct scan_st *, struct symbol_table *,
3132 struct symbol **, int, int, struct value *);
0 /*
1 * Copyright (c)2004 Cat's Eye Technologies. All rights reserved.
2 *
3 * Redistribution and use in source and binary forms, with or without
4 * modification, are permitted provided that the following conditions
5 * are met:
6 *
7 * Redistributions of source code must retain the above copyright
8 * notice, this list of conditions and the following disclaimer.
9 *
10 * Redistributions in binary form must reproduce the above copyright
11 * notice, this list of conditions and the following disclaimer in
12 * the documentation and/or other materials provided with the
13 * distribution.
14 *
15 * Neither the name of Cat's Eye Technologies nor the names of its
16 * contributors may be used to endorse or promote products derived
17 * from this software without specific prior written permission.
18 *
19 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
20 * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
21 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
22 * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
23 * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
24 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
25 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
27 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
28 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
29 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
30 * OF THE POSSIBILITY OF SUCH DAMAGE.
31 */
32 /*
33 * report.c
34 * Translation error/warning reporter for Bhuna.
35 * $Id: scan.c 54 2004-04-23 22:51:09Z catseye $
36 */
37
38 #include <stdarg.h>
39 #include <stdio.h>
40 /*
41 #include <stdlib.h>
42 #include <string.h>
43 */
44
45 #include "mem.h"
46 #include "scan.h"
47 #include "report.h"
48
49 #include "type.h"
50 #include "symbol.h"
51
52 static int errors;
53 static int warnings;
54 static FILE *rfile;
55
56 void
57 report_start(void)
58 {
59 rfile = stderr;
60 errors = 0;
61 warnings = 0;
62 }
63
64 int
65 report_finish(void)
66 {
67 /* if verbose */
68 fprintf(rfile, "Translation finished with %d errors and %d warnings\n",
69 errors, warnings);
70 return(errors);
71 }
72
73 void
74 report(int rtype, struct scan_st *sc, char *fmt, ...)
75 {
76 va_list args;
77 int i;
78
79 if (sc != NULL) {
80 fprintf(rfile, "%s (line %d, column %d, token '%s'): ",
81 rtype == REPORT_ERROR ? "Error" : "Warning",
82 sc->lino, sc->columno, sc->token);
83 } else {
84 fprintf(rfile, "%s (line ?, column ?, token ?): ",
85 rtype == REPORT_ERROR ? "Error" : "Warning");
86 }
87
88 va_start(args, fmt);
89 for (i = 0; fmt[i] != '\0'; i++) {
90 if (fmt[i] == '%') {
91 i++;
92 switch (fmt[i]) {
93 case 't':
94 type_print(rfile, va_arg(args, struct type *));
95 break;
96 case 'S':
97 symbol_print(rfile, va_arg(args, struct symbol *));
98 break;
99 case 's':
100 fprintf(stderr, "%s", va_arg(args, char *));
101 break;
102 case 'd':
103 fprintf(stderr, "%d", va_arg(args, int));
104 break;
105 }
106 } else {
107 fprintf(rfile, "%c", fmt[i]);
108 }
109 }
110 va_end(args);
111
112 fprintf(rfile, ".\n");
113
114 if (rtype == REPORT_ERROR) {
115 errors++;
116 } else {
117 warnings++;
118 }
119 }
0 /*
1 * report.h
2 * Error/warning reporter for Bhuna.
3 * $Id$
4 */
5
6 #ifndef __REPORT_H_
7 #define __REPORT_H_
8
9 #include <stdio.h>
10
11 struct scan_st;
12
13 #define REPORT_ERROR 1
14 #define REPORT_WARNING 0
15
16 extern void report_start(void);
17 extern int report_finish(void);
18
19 extern void report(int, struct scan_st *, char *, ...);
20
21 #endif /* !__SCAN_H_ */
4242
4343 #include "mem.h"
4444 #include "scan.h"
45 #include "report.h"
4546
4647 struct scan_st *
4748 scan_open(char *filename)
4849 {
4950 struct scan_st *sc;
5051
51 if ((sc = bhuna_malloc(sizeof(struct scan_st))) == 0) {
52 return(NULL);
53 }
54 if ((sc->token = (char *)bhuna_malloc(256 * sizeof(char))) == NULL) {
55 bhuna_free(sc);
56 return(NULL);
57 }
52 sc = bhuna_malloc(sizeof(struct scan_st));
53 sc->token = (char *)bhuna_malloc(256 * sizeof(char));
54
5855 if ((sc->in = fopen(filename, "r")) == NULL) {
5956 bhuna_free(sc->token);
6057 bhuna_free(sc);
6360
6461 sc->lino = 1;
6562 sc->columno = 1;
66 sc->errors = 0;
6763 scan(sc); /* prime the pump */
6864
6965 return(sc);
7066 }
7167
68 /*
69 * This is just to ease error reporting, so we don't copy the file or nothin'.
70 */
71 struct scan_st *
72 scan_dup(struct scan_st *orig)
73 {
74 struct scan_st *sc;
75
76 sc = bhuna_malloc(sizeof(struct scan_st));
77 sc->token = bhuna_strdup(orig->token);
78 sc->in = NULL;
79 sc->lino = orig->lino;
80 sc->columno = orig->columno;
81
82 return(sc);
83 }
84
7285 void
7386 scan_close(struct scan_st *sc)
74 {
75 fclose(sc->in);
87 {
88 if (sc->in != NULL)
89 fclose(sc->in);
7690 bhuna_free(sc->token);
7791 bhuna_free(sc);
78 }
79
80 void
81 scan_error(struct scan_st *sc, char *fmt, ...)
82 {
83 va_list args;
84 char err[256];
85
86 va_start(args, fmt);
87 vsnprintf(err, 255, fmt, args);
88
89 printf("Error (line %d, column %d, token '%s'): %s.\n",
90 sc->lino, sc->columno, sc->token, err);
91
92 sc->errors++;
9392 }
9493
9594 void
231230 if (!strcmp(sc->token, x)) {
232231 scan(sc);
233232 } else {
234 scan_error(sc, "Expected '%s'", x);
235 }
236 }
233 report(REPORT_ERROR, sc, "Expected '%s'", x);
234 }
235 }
2424 int type; /* type of token that was scanned */
2525 int lino; /* current line number, 1-based */
2626 int columno; /* current column number, 1-based */
27 int errors; /* # of errors encountered so far */
2827 };
2928
3029 #define tokeq(sc, x) (strcmp(sc->token, x) == 0)
3130 #define tokne(sc, x) (strcmp(sc->token, x) != 0)
3231
3332 extern struct scan_st *scan_open(char *);
33 extern struct scan_st *scan_dup(struct scan_st *);
3434 extern void scan_close(struct scan_st *);
35 extern void scan_error(struct scan_st *, char *, ...);
3635 extern void scan(struct scan_st *);
3736 extern void scan_expect(struct scan_st *, char *);
3837
4444
4545 #include "mem.h"
4646 #include "symbol.h"
47 #include "type.h"
4748 #include "value.h"
4849
4950 /*** GLOBALS ***/
6970 sym->in = NULL;
7071 sym->index = -1;
7172 sym->is_pure = 0;
73 sym->type = NULL;
7274 sym->value = NULL;
7375 sym->builtin = NULL;
7476
7880 static void
7981 symbol_free(struct symbol *sym)
8082 {
83 type_free(&sym->type);
8184 value_release(sym->value);
8285 bhuna_free(sym->token);
8386 bhuna_free(sym);
205208 }
206209
207210 void
211 symbol_set_type(struct symbol *sym, struct type *t)
212 {
213 if (sym->type != NULL) {
214 type_free(&sym->type);
215 }
216 sym->type = t;
217 }
218
219 void
208220 symbol_set_value(struct symbol *sym, struct value *v)
209221 {
210222 assert(sym->value != NULL);
247259 for (i = 0; i < stab_indent; i++)
248260 printf(" ");
249261 printf("`%s'(%08lx)", sym->token, (unsigned long)sym);
262 type_print(stdout, sym->type);
250263 if (sym->value != NULL) {
251264 printf("=");
252265 value_print(sym->value);
253266 }
254267 #endif
255268 }
269
270 void
271 symbol_print(FILE *f, struct symbol *sym)
272 {
273 #ifdef DEBUG
274 fprintf(f, "symbol `%s' (type = ", sym->token);
275 type_print(f, sym->type);
276 fprintf(f, ")");
277 #endif
278 }
66 #ifndef __SYMBOL_H_
77 #define __SYMBOL_H_
88
9 #include <stdio.h>
10
911 struct value;
12 struct type;
1013
1114 struct symbol_table {
1215 struct symbol_table *parent; /* link to scopes above us */
2023 struct symbol *next; /* next symbol in symbol table */
2124 char *token; /* lexeme making up the symbol */
2225 int kind; /* kind of symbol */
26 struct type *type; /* data type */
2327
2428 struct builtin *builtin;
2529 int is_pure; /* if true, symbol represents a function which is ref.transp. */
4650
4751 int symbol_is_global(struct symbol *);
4852
53 void symbol_set_type(struct symbol *, struct type *);
4954 void symbol_set_value(struct symbol *, struct value *);
5055
5156 void symbol_table_dump(struct symbol_table *, int);
5257 void symbol_dump(struct symbol *, int);
5358
59 void symbol_print(FILE *f, struct symbol *);
60
5461 #endif /* !__SYMBOL_H_ */
0 #include <assert.h>
1 #include <stdio.h>
2
3 #include "mem.h"
4 #include "type.h"
5 #include "report.h"
6 #include "scan.h"
7
8 static struct type *t_head = NULL;
9
10 struct type *
11 type_new(int tclass)
12 {
13 struct type *t;
14
15 t = bhuna_malloc(sizeof(struct type));
16 t->tclass = tclass;
17 t->unifier = NULL;
18 t->next = t_head;
19 t_head = NULL;
20
21 return(t);
22 }
23
24 struct type *
25 type_new_list(struct type *contents)
26 {
27 struct type *t = type_new(TYPE_LIST);
28
29 t->t.list.contents = contents;
30
31 return(t);
32 }
33
34 struct type *
35 type_new_dict(struct type *index, struct type *contents)
36 {
37 struct type *t = type_new(TYPE_DICT);
38
39 t->t.dict.index = index;
40 t->t.dict.contents = contents;
41
42 return(t);
43 }
44
45 struct type *
46 type_new_closure(struct type *domain, struct type *range)
47 {
48 struct type *t = type_new(TYPE_CLOSURE);
49
50 t->t.closure.domain = domain;
51 t->t.closure.range = range;
52
53 return(t);
54 }
55
56 struct type *
57 type_new_arg(struct type *left, struct type *right)
58 {
59 struct type *t = type_new(TYPE_ARG);
60
61 t->t.arg.left = left;
62 t->t.arg.right = right;
63
64 return(t);
65 }
66
67 struct type *
68 type_new_set(struct type *left, struct type *right)
69 {
70 struct type *t;
71
72 /*
73 printf("constructing set from:\n1: ");
74 type_print(stdout, left);
75 printf("\n2: ");
76 type_print(stdout, right);
77 printf("\n");
78 */
79
80 if (type_equal(type_representative(left), type_representative(right)))
81 return(left);
82
83 /* ???
84 if (type_is_void(left))
85 return(right);
86 if (type_is_void(right))
87 return(left);
88 */
89
90 t = type_new(TYPE_SET);
91 t->t.set.left = left;
92 t->t.set.right = right;
93
94 return(t);
95 }
96
97 struct type *
98 type_new_var(int num)
99 {
100 struct type *t = type_new(TYPE_VAR);
101
102 t->t.var.num = num;
103
104 return(t);
105 }
106
107 static int next_var_num = 10;
108
109 struct type *
110 type_brand_new_var(void)
111 {
112 struct type *t = type_new(TYPE_VAR);
113
114 t->t.var.num = next_var_num++;
115
116 return(t);
117 }
118
119 void
120 type_free(struct type **ty)
121 {
122 /*
123 struct type *t;
124
125 if (ty == NULL || *ty == NULL)
126 return;
127
128 t = *ty;
129 printf("freeing ");
130 type_print(stdout, t);
131 printf("...\n");
132
133 switch (t->tclass) {
134 case TYPE_LIST:
135 type_free(&t->t.list.contents);
136 break;
137 case TYPE_DICT:
138 type_free(&t->t.dict.index);
139 type_free(&t->t.dict.contents);
140 break;
141 case TYPE_CLOSURE:
142 type_free(&t->t.closure.domain);
143 type_free(&t->t.closure.range);
144 break;
145 case TYPE_ARG:
146 type_free(&t->t.arg.left);
147 type_free(&t->t.arg.right);
148 break;
149 }
150
151 bhuna_free(t);
152 *ty = NULL;
153 */
154 }
155
156 /*
157 struct type *
158 type_dup(struct type *t)
159 {
160 struct type *n;
161
162 if (t == NULL)
163 return(NULL);
164
165 n = type_new(t->tclass);
166 switch (t->tclass) {
167 case TYPE_VAR:
168 n->t.var.num = t->t.var.num; unless...
169 n->unifier = t->unifier;
170 break;
171 case TYPE_LIST:
172 n->t.list.contents = type_dup(t->t.list.contents);
173 break;
174 case TYPE_DICT:
175 n->t.dict.index = type_dup(t->t.dict.index);
176 n->t.dict.contents = type_dup(t->t.dict.contents);
177 break;
178 case TYPE_CLOSURE:
179 n->t.closure.domain = type_dup(t->t.closure.domain);
180 n->t.closure.range = type_dup(t->t.closure.range);
181 case TYPE_ARG:
182 n->t.arg.left = type_dup(t->t.arg.left);
183 n->t.arg.right = type_dup(t->t.arg.right);
184 }
185
186 return(n);
187 }
188 */
189
190 /*
191 * Structural equivalence.
192 */
193 int
194 type_equal(struct type *a, struct type *b)
195 {
196 if (a == NULL && b == NULL)
197 return(1);
198 if (a == NULL || b == NULL)
199 return(0);
200 if (a->tclass != b->tclass)
201 return(0);
202
203 switch (a->tclass) {
204 case TYPE_LIST:
205 return(type_equal(a->t.list.contents, b->t.list.contents));
206 case TYPE_DICT:
207 return(type_equal(a->t.dict.index, b->t.dict.index) &&
208 type_equal(a->t.dict.contents, b->t.dict.contents));
209 case TYPE_CLOSURE:
210 return(type_equal(a->t.closure.domain, b->t.closure.domain) &&
211 type_equal(a->t.closure.range, b->t.closure.range));
212 case TYPE_ARG:
213 return(type_equal(a->t.arg.left, b->t.arg.left) &&
214 type_equal(a->t.arg.right, b->t.arg.right));
215 case TYPE_SET:
216 return(type_equal(a->t.set.left, b->t.set.left) &&
217 type_equal(a->t.set.right, b->t.set.right));
218 }
219 return(1);
220 }
221
222 /************ TYPE INFERENCE *************/
223
224 /*
225 * Unification algorithm
226 * Shamelessly adapted from the Dragon Book.
227 */
228
229 /*
230 * Find the representative of the equivalence class of a type.
231 * This is used by external code to get the concrete type
232 * lurking behind a (bound) type variable.
233 */
234 struct type *
235 type_representative(struct type *q)
236 {
237 struct type *p = q;
238
239 while (p->unifier != NULL) {
240 p = p->unifier;
241 }
242
243 return(p);
244 }
245
246 /*
247 * Merge the two equivalence classes of the two types.
248 */
249 void
250 type_union(struct type *m, struct type *n)
251 {
252 struct type *s, *t;
253
254 s = type_representative(m);
255 t = type_representative(n);
256
257 if (s->tclass != TYPE_VAR) {
258 t->unifier = s;
259 } else if (t->tclass != TYPE_VAR) {
260 s->unifier = t;
261 } else {
262 s->unifier = t;
263 }
264 }
265
266 /*
267 * Make two type expressions equal through substitutions.
268 */
269 int
270 type_unify(struct type *m, struct type *n)
271 {
272 struct type *s, *t;
273
274 s = type_representative(m);
275 t = type_representative(n);
276
277 if (s == t) {
278 return(1);
279 } else if (s->tclass == TYPE_DICT && t->tclass == TYPE_DICT) {
280 type_union(s, t);
281 return(type_unify(s->t.dict.index, t->t.dict.index) &&
282 type_unify(s->t.dict.contents, t->t.dict.contents));
283 } else if (s->tclass == TYPE_LIST && t->tclass == TYPE_LIST) {
284 type_union(s, t);
285 return(type_unify(s->t.list.contents, t->t.list.contents));
286 } else if (s->tclass == TYPE_CLOSURE && t->tclass == TYPE_CLOSURE) {
287 type_union(s, t);
288 return(type_unify(s->t.closure.domain, t->t.closure.domain) &&
289 type_unify(s->t.closure.range, t->t.closure.range));
290 } else if (s->tclass == TYPE_ARG && t->tclass == TYPE_ARG) {
291 type_union(s, t);
292 return(type_unify(s->t.arg.left, t->t.arg.left) &&
293 type_unify(s->t.arg.right, t->t.arg.right));
294 } else if (s->tclass == TYPE_SET && t->tclass == TYPE_SET) {
295 /* XXX actually we should also check when one is a set and one isn't,
296 and succeed if the one that isn't the set is *in* the set... */
297 type_union(s, t);
298 return(type_unify(s->t.set.left, t->t.set.left) &&
299 type_unify(s->t.set.right, t->t.set.right));
300 } else if (s->tclass == TYPE_VAR || t->tclass == TYPE_VAR) {
301 type_union(s, t);
302 return(1);
303 } else if (s->tclass == t->tclass) {
304 return(1);
305 } else {
306 return(0);
307 }
308 }
309
310 int
311 type_unify_crit(struct scan_st *sc, struct type *m, struct type *n)
312 {
313 int unified;
314
315 if (!(unified = type_unify(m, n))) {
316 report(REPORT_ERROR, sc,
317 "Failed to unify types %t and %t",
318 m, n);
319 }
320
321 return(unified);
322 }
323
324 /*
325 * If the given type is an unbound variable, unify it with a function
326 * from a (fresh) unbound variable to another (fresh) unbound variable.
327 * This way we can handle unifying just the domain or just the range
328 * part of a (variable) type with another type.
329 */
330 void
331 type_ensure_routine(struct type *t)
332 {
333 struct type *r, *n;
334
335 /*
336 printf("ENSURING ROUTINE:");
337 type_print(stdout, t);
338 printf("\n");
339 */
340
341 r = type_representative(t);
342 if (r->tclass == TYPE_VAR) {
343 n = type_new_closure(type_brand_new_var(), type_brand_new_var());
344 r->unifier = n;
345 }
346 }
347
348 int
349 type_is_possibly_routine(struct type *t)
350 {
351 struct type *r;
352
353 r = type_representative(t);
354 return(r->tclass == TYPE_VAR || r->tclass == TYPE_CLOSURE);
355 }
356
357 int
358 type_is_void(struct type *t)
359 {
360 struct type *r;
361
362 r = type_representative(t);
363 return(r->tclass == TYPE_VOID);
364 }
365
366 int
367 type_is_set(struct type *t)
368 {
369 struct type *r;
370
371 r = type_representative(t);
372 return(r->tclass == TYPE_SET);
373 }
374
375 int
376 type_set_contains_void(struct type *t)
377 {
378 struct type *r;
379
380 r = type_representative(t);
381 if (r->tclass == TYPE_VOID) {
382 return(1);
383 } else if (r->tclass == TYPE_SET) {
384 return(type_set_contains_void(r->t.set.left) ||
385 type_set_contains_void(r->t.set.right));
386 } else {
387 return(0);
388 }
389 }
390
391 void
392 type_print(FILE *f, struct type *t)
393 {
394 #ifdef DEBUG
395 if (t == NULL) {
396 fprintf(f, "(?null?)");
397 return;
398 }
399 switch (t->tclass) {
400 case TYPE_VOID:
401 fprintf(f, "void");
402 break;
403 case TYPE_INTEGER:
404 fprintf(f, "integer");
405 break;
406 case TYPE_BOOLEAN:
407 fprintf(f, "boolean");
408 break;
409 case TYPE_ATOM:
410 fprintf(f, "atom");
411 break;
412 case TYPE_STRING:
413 fprintf(f, "string");
414 break;
415 case TYPE_LIST:
416 fprintf(f, "list of ");
417 type_print(f, t->t.list.contents);
418 break;
419 case TYPE_ERROR:
420 fprintf(f, "error");
421 break;
422 case TYPE_BUILTIN:
423 fprintf(f, "builtin");
424 break;
425 case TYPE_OPAQUE:
426 fprintf(f, "opaque");
427 break;
428 case TYPE_VAR:
429 fprintf(f, "Type%d", t->t.var.num);
430 if (t->unifier != NULL) {
431 fprintf(f, "=(");
432 type_print(f, t->unifier);
433 fprintf(f, ")");
434 }
435 break;
436 case TYPE_ARG:
437 type_print(f, t->t.arg.left);
438 fprintf(f, ", ");
439 type_print(f, t->t.arg.right);
440 break;
441 case TYPE_SET:
442 fprintf(f, "(");
443 type_print(f, t->t.arg.left);
444 fprintf(f, " | ");
445 type_print(f, t->t.arg.right);
446 fprintf(f, ")");
447 break;
448 case TYPE_DICT:
449 fprintf(f, "dict from ");
450 type_print(f, t->t.dict.index);
451 fprintf(f, " to ");
452 type_print(f, t->t.dict.contents);
453 break;
454 case TYPE_CLOSURE:
455 fprintf(f, "fn from ");
456 type_print(f, t->t.closure.domain);
457 fprintf(f, " to ");
458 type_print(f, t->t.closure.range);
459 break;
460 }
461 #endif
462 }
0 #include <stdio.h>
1
2 struct scan_st;
3
4 #define TYPE_VOID 0
5 #define TYPE_INTEGER 1
6 #define TYPE_BOOLEAN 2
7 #define TYPE_ATOM 3
8 #define TYPE_STRING 4
9 #define TYPE_LIST 5
10 #define TYPE_ERROR 6
11 #define TYPE_BUILTIN 7
12 #define TYPE_CLOSURE 8
13 #define TYPE_DICT 9
14 #define TYPE_OPAQUE 15
15 #define TYPE_VAR 16
16 #define TYPE_ARG 17
17 #define TYPE_SET 18
18
19 struct type_list {
20 struct type *contents;
21 };
22
23 struct type_dict {
24 struct type *index;
25 struct type *contents;
26 };
27
28 struct type_closure {
29 struct type *domain;
30 struct type *range;
31 };
32
33 /* type of a list of arguments given to a function, c.f. ast_arg */
34 struct type_arg {
35 struct type *left;
36 struct type *right;
37 };
38
39 /* union of several heterogenous types... :) */
40 struct type_set {
41 struct type *left;
42 struct type *right;
43 };
44
45 struct type_var {
46 int num;
47 };
48
49 union type_union {
50 struct type_list list;
51 struct type_dict dict;
52 struct type_closure closure;
53 struct type_arg arg;
54 struct type_set set;
55 struct type_var var;
56 };
57
58 struct type {
59 struct type *next; /* for freein' */
60 int tclass;
61 struct type *unifier; /* equiv. class under type unif. */
62 union type_union t;
63 };
64
65 struct type *type_new(int);
66 struct type *type_new_list(struct type *);
67 struct type *type_new_dict(struct type *, struct type *);
68 struct type *type_new_closure(struct type *, struct type *);
69 struct type *type_new_arg(struct type *, struct type *);
70 struct type *type_new_set(struct type *, struct type *);
71 struct type *type_new_var(int);
72 struct type *type_brand_new_var(void);
73
74 void type_free(struct type **);
75 /*struct type *type_dup(struct type *);*/
76
77 int type_equal(struct type *, struct type *);
78 int type_unify(struct type *, struct type *);
79 struct type *type_representative(struct type *);
80
81 void type_ensure_routine(struct type *);
82 int type_is_possibly_routine(struct type *);
83 int type_unify_crit(struct scan_st *, struct type *, struct type *);
84 int type_is_void(struct type *);
85 int type_is_set(struct type *);
86 int type_set_contains_void(struct type *);
87
88 void type_print(FILE *, struct type *);
4747 #include "dict.h"
4848 #include "closure.h"
4949
50 #include "type.h"
51
5052 #ifdef POOL_VALUES
5153 #include "pool.h"
5254 #endif
252254
253255 /*** DESTRUCTOR ***/
254256
255 static void
257 void
256258 value_free(struct value *v)
257259 {
258260 if (v == NULL)
286288
287289 /*** REFCOUNTERS ***/
288290
291 #ifndef REFCOUNTING_MACROS
289292 void
290293 value_grab(struct value *v)
291294 {
321324 if (v->refcount == 0)
322325 value_free(v);
323326 }
327 #endif
324328
325329 /*** SPECIFIC CONSTRUCTORS ***/
326330
2525 #define VALUE_ATOM 3
2626 #define VALUE_STRING 4
2727 #define VALUE_LIST 5
28 #define VALUE_STAB 6
29 #define VALUE_ERROR 7
30 #define VALUE_BUILTIN 8
31 #define VALUE_CLOSURE 9
32 #define VALUE_DICT 10
28 #define VALUE_ERROR 6
29 #define VALUE_BUILTIN 7
30 #define VALUE_CLOSURE 8
31 #define VALUE_DICT 9
3332 #define VALUE_OPAQUE 15
3433
3534 union value_union {
5049 union value_union v;
5150 };
5251
52 #ifdef REFCOUNTING_MACROS
53 #define value_release(v) \
54 if ((v) != NULL && (--((v)->refcount)) == 0) value_free((v));
55 #define value_grab(v) \
56 if ((v) != NULL) (v)->refcount++;
57 #else
5358 void value_grab(struct value *);
5459 void value_release(struct value *);
60 #endif
61
62 void value_free(struct value *);
5563
5664 struct value *value_dup(struct value *);
5765
3636
3737 extern int trace_vm;
3838 static int i;
39
39 /*static int subs = 0;*/
40
41 #ifdef DEBUG
4042 static void
4143 dump_stack()
4244 {
4951 printf("\n");
5052 }
5153 }
54 #endif
5255
5356 void
5457 vm_run(vm_label_t program)
5861 struct value *l = NULL, *r = NULL, *v = NULL;
5962 struct activation *ar;
6063 int varity;
64 /*int upcount, index; */
6165
6266 #ifdef DEBUG
6367 if (trace_vm) {
113117 case INDEX_BUILTIN_EQU:
114118 POP_VALUE(r);
115119 POP_VALUE(l);
116 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
120 //if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
117121 v = value_new_boolean(l->v.i == r->v.i);
118 } else {
119 v = value_new_error("type mismatch");
120 }
122 //} else {
123 // v = value_new_error("type mismatch");
124 //}
121125 PUSH_VALUE(v);
122126 value_release(l);
123127 value_release(r);
186190 case INDEX_BUILTIN_ADD:
187191 POP_VALUE(r);
188192 POP_VALUE(l);
189 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
193 //if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
190194 v = value_new_integer(l->v.i + r->v.i);
191 } else {
192 v = value_new_error("type mismatch");
193 }
195 //} else {
196 // v = value_new_error("type mismatch");
197 //}
194198 PUSH_VALUE(v);
195199 value_release(l);
196200 value_release(r);
210214 case INDEX_BUILTIN_SUB:
211215 POP_VALUE(r);
212216 POP_VALUE(l);
217 //subs++;
213218 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
214219 v = value_new_integer(l->v.i - r->v.i);
215220 } else {
267272
268273 case INSTR_PUSH_LOCAL:
269274 l = activation_get_value(current_ar, *(pc + 1), *(pc + 2));
275
270276 #ifdef DEBUG
271277 if (trace_vm) {
272278 printf("INSTR_PUSH_LOCAL:\n");
476482 if (trace_vm) {
477483 printf("___ virtual machine finished ___\n");
478484 }
485 /*printf("subs = %d\n", subs);*/
479486 #endif
480487 }
481488