liamoc.net
the hito embeddable programming language
1#include "eval.h"
2#include "builtins.h"
3#include "env.h"
4#include "syntax.h"
5#include "util.h"
6#include "value.h"
7#include <string.h>
8#include <stdlib.h>
9#include <stdio.h>
10
11
12
13typedef union amb_ptr {
14 expr_t *unevaled;
15 value_t *evaled;
16} amb_ptr;
17
18
19typedef struct {
20 enum {
21 FRAME_CALL_ARGS,
22 FRAME_CALL_CALLEE,
23 FRAME_CALL_ARGS_GROUP,
24 FRAME_CALL_ARGS_TUPLE,
25 FRAME_ALT,
26 FRAME_FGROUP_ALT,
27 FRAME_SEQ,
28 FRAME_LET,
29 FRAME_ENV
30 } tag;
31 source_t *source;
32 pos_t pos;
33 union {
34 struct {
35 expr_t **arguments;
36 size_t nargs;
37 } call_callee;
38 struct {
39 expr_t **arguments;
40 size_t nargs;
41 size_t arg_base;
42 } call_args;
43 struct {
44 expr_t *orelse;
45 } alt;
46 struct {
47 value_t *orelse;
48 } fgroup_alt;
49 struct {
50 expr_t *after;
51 } seq;
52 struct {
53 pattern_t pattern;
54 expr_t *in;
55 } let_binding;
56 struct {
57 size_t locals_top;
58 size_t locals_frame;
59 value_t *captures; /* should be an env value */
60 } env;
61 } as;
62} frame_t;
63typedef enum {
64 MODE_EVAL, MODE_RETURN
65} eval_mode_t;
66
67void _frame_debug_dump(frame_t *it) {
68 switch (it->tag) {
69 case FRAME_ALT:
70 printf("ALT(");
71 syntax_dump_expr(it->as.alt.orelse);
72 printf(")");
73 break;
74 case FRAME_SEQ:
75 printf("SEQ(");
76 syntax_dump_expr(it->as.seq.after);
77 printf(")");
78 break;
79 case FRAME_FGROUP_ALT:
80 printf("ALTF(");
81 value_debug_dump(it->as.fgroup_alt.orelse);
82 printf("..?)");
83 break;
84
85 case FRAME_ENV:
86 printf("ENV ..");
87 break;
88 case FRAME_LET:
89 printf("LET");
90 break;
91 case FRAME_CALL_ARGS_GROUP:
92 case FRAME_CALL_ARGS_TUPLE:
93 printf("CAT");
94 break;
95 case FRAME_CALL_ARGS:
96 printf("CA");
97 break;
98 case FRAME_CALL_CALLEE:
99 printf("CC");
100 break;
101 }
102}
103static inline size_t stack_bump(frame_t **stack, size_t stack_size, size_t stack_capacity) {
104 if (stack_size == stack_capacity) {
105 stack_capacity *= 2;
106 *stack = realloc(*stack, stack_capacity);
107 if (*stack == NULL)
108 die("Out of memory: cannot enlarge stack");
109 }
110 return stack_capacity;
111}
112
113static inline size_t arg_stack_bump(value_t ***stack, size_t stack_size, size_t stack_capacity) {
114 if (stack_size == stack_capacity) {
115 stack_capacity *= 2;
116 *stack = realloc(*stack, stack_capacity);
117 if (*stack == NULL)
118 die("Out of memory: cannot enlarge arg stack");
119 }
120 return stack_capacity;
121}
122
123bool _pattern_match(value_t *value,value_t ***bindings, expr_t *pattern) {
124 switch (pattern->tag) {
125 case EXPR_CALL:
126 if (pattern->as.call.callee->tag == EXPR_CONSTRUCTOR
127 && value->tag == VALUE_CONSTRUCTOR
128 && pattern->as.call.nargs == value->as.constructor.num_args
129 && pattern->as.call.callee->as.constructor == value->as.constructor.name) {
130 for (int i = 0; i < pattern->as.call.nargs; i++) {
131 if (!_pattern_match(value->as.constructor.args[i], bindings, pattern->as.call.arguments[i])) {
132 return false;
133 }
134 }
135 return true;
136 } else return false;
137 case EXPR_TUPLE:
138 // TODO
139 return false;
140 case EXPR_CONSTRUCTOR:
141 return (value->tag == VALUE_CONSTRUCTOR
142 && pattern->as.call.nargs == 0
143 && pattern->as.constructor == value->as.constructor.name);
144 case EXPR_PAT_IDENT: {
145 printf("%s:",pattern->as.ident);
146 (*bindings)[0] = value;
147 value_debug_dump(value);
148 (*bindings)++;
149 printf("\n");
150 return true;
151 }
152 case EXPR_INT_LIT: return (value->tag == VALUE_INT && value->as.integer == pattern->as.int_lit);
153 case EXPR_FLOAT_LIT: return (value->tag == VALUE_FLOAT && value->as.floating == pattern->as.float_lit);
154 case EXPR_STRING_LIT: return (value->tag == VALUE_STRING && strcmp(value->as.string.string, pattern->as.string_lit) == 0);
155 default:
156 break;
157 }
158 return false;
159}
160
161value_t *eval(expr_t *expr, gc_t *gc) {
162
163 frame_t *stack = malloc(sizeof(frame_t) * 32);
164 if (stack == NULL)
165 die("Out of memory: cannot allocate control stack");
166 value_t** locals = malloc(sizeof(value_t *) * 64);
167 if (locals == NULL)
168 die("Out of memory: cannot allocate locals stack");
169 value_t** arguments = malloc(sizeof(value_t *) * 64);
170 if (arguments == NULL)
171 die("Out of memory: cannot allocate arguments stack");
172
173 size_t stack_size = 0;
174 size_t stack_capacity = 32;
175 size_t locals_capacity = 64;
176 size_t locals_frame = 0;
177 size_t locals_size = 0;
178
179 size_t arguments_capacity = 64;
180 size_t arguments_size = 0;
181
182 eval_mode_t mode = MODE_EVAL;
183 amb_ptr focus;
184 focus.unevaled = expr;
185 value_t *env_val = value_alloc(gc);
186 env_val->tag = VALUE_ENV;
187 env_val->as.env = NULL;
188 while (!(mode == MODE_RETURN && stack_size == 0)) {
189 /* debugging code: */
190 for (int i = 0; i < stack_size; i++) {
191 _frame_debug_dump(stack + i);
192 if (i < stack_size - 1)
193 printf(", ");
194 }
195 printf(" | ");
196 for (int i = 0; i < locals_size; i++) {
197 if (i == locals_size - locals_frame - 1) {
198 printf("[");
199 }
200 value_debug_dump(locals[i]);
201 if (i == locals_size - locals_frame - 1) {
202 printf("]");
203 }
204 if (i < locals_size - 1)
205 printf(", ");
206 }
207 printf("{");
208 if (env_val->as.env) {env_debug_dump(env_val->as.env);};
209 printf("}");
210 printf(" | ");
211 for (int i = 0; i < arguments_size; i++) {
212 value_debug_dump(arguments[i]);
213 if (i < stack_size - 1)
214 printf(", ");
215 }
216 if (mode == MODE_EVAL) {
217 printf(" > ");
218 syntax_dump_expr(focus.unevaled);
219 printf("\n");
220 } else {
221 printf(" < ");
222 value_debug_dump(focus.evaled);
223 printf("\n");
224 }
225
226 switch (mode) {
227 case MODE_EVAL: switch (focus.unevaled->tag) {
228 case EXPR_VAR: {
229 value_t *val = (focus.unevaled->as.var >= locals_frame) ?
230 env_lookup(env_val->as.env, focus.unevaled->as.var - locals_frame) :
231 locals[locals_size - 1 - focus.unevaled->as.var];
232 mode = MODE_RETURN;
233 focus.evaled = val;
234 break;
235 }
236 case EXPR_BUILTIN: {
237 builtin_func_t *func = focus.unevaled->as.builtin;
238 value_t * val = value_alloc(gc);
239 val->tag = VALUE_BUILTIN;
240 val->as.builtin = func;
241 focus.evaled = val;
242 mode = MODE_RETURN;
243 break;
244 }
245 case EXPR_INT_LIT: {
246 focus.evaled = value_alloc_int(gc,focus.unevaled->as.int_lit);
247 mode = MODE_RETURN;
248 break;
249 }
250 case EXPR_FLOAT_LIT: {
251 focus.evaled = value_alloc_int(gc,focus.unevaled->as.float_lit);
252 mode = MODE_RETURN;
253 break;
254 }
255 case EXPR_STRING_LIT: {
256 focus.evaled = value_alloc_string(gc,focus.unevaled->as.string_lit,true);
257 mode = MODE_RETURN;
258 break;
259 }
260 case EXPR_CONSTRUCTOR: {
261 value_t *val = value_alloc(gc);
262 val->tag = VALUE_CONSTRUCTOR;
263 val->as.constructor.args = NULL;
264 val->as.constructor.num_args = 0;
265 val->as.constructor.name = focus.unevaled->as.constructor;
266 focus.evaled = val;
267 mode = MODE_RETURN;
268 break;
269 }
270 case EXPR_LAMBDA_COMPILED: {
271 value_t *val = value_alloc(gc);
272 val->tag = VALUE_CLOSURE;
273 val->as.closure.body = focus.unevaled->as.lambda.body;
274 val->as.closure.env = value_alloc(gc);
275 env_t *captured = env_capture(env_val->as.env, locals, locals_frame,locals_size, focus.unevaled->as.lambda.mask);
276 val->as.closure.env->tag = VALUE_ENV;
277 val->as.closure.env->as.env = captured;
278 val->as.closure.next = NULL;
279 val->as.closure.arity = focus.unevaled->as.lambda.args;
280 focus.evaled = val;
281 mode = MODE_RETURN;
282 break;
283 }
284 case EXPR_ALT:
285 stack_capacity = stack_bump(&stack, stack_size, stack_capacity);
286 stack[stack_size].as.alt.orelse = focus.unevaled->as.alt.orelse;
287 stack[stack_size].tag = FRAME_ALT;
288 stack_size++;
289 focus.unevaled = focus.unevaled->as.alt.try;
290 break;
291 case EXPR_SEQ:
292 stack_capacity = stack_bump(&stack, stack_size, stack_capacity);
293 stack[stack_size].as.seq.after = focus.unevaled->as.seq.then;
294 stack[stack_size].tag = FRAME_SEQ;
295 focus.unevaled = focus.unevaled->as.seq.first;
296 stack_size++;
297 break;
298 case EXPR_GROUP:
299 stack_capacity = stack_bump(&stack, stack_size, stack_capacity);
300 stack[stack_size].as.call_args.arguments = focus.unevaled->as.group.clauses + 1;
301 stack[stack_size].as.call_args.nargs = focus.unevaled->as.group.nclauses - 1;
302 stack[stack_size].as.call_args.arg_base = arguments_size;
303 stack[stack_size].tag = FRAME_CALL_ARGS_GROUP;
304 stack_size++;
305 focus.unevaled = focus.unevaled->as.group.clauses[0];
306 break;
307 case EXPR_CALL:
308 stack_capacity = stack_bump(&stack, stack_size, stack_capacity);
309 stack[stack_size].as.call_callee.arguments = focus.unevaled->as.call.arguments;
310 stack[stack_size].as.call_callee.nargs = focus.unevaled->as.call.nargs;
311 stack[stack_size].tag = FRAME_CALL_CALLEE;
312 stack_size++;
313 focus.unevaled = focus.unevaled->as.call.callee;
314 break;
315 case EXPR_LET_BINDING:
316 stack_capacity = stack_bump(&stack, stack_size, stack_capacity);
317 stack[stack_size].as.let_binding.in = focus.unevaled->as.let_binding.in;
318 stack[stack_size].as.let_binding.pattern = focus.unevaled->as.let_binding.pattern;
319 stack[stack_size].tag = FRAME_LET;
320 stack_size++;
321 focus.unevaled = focus.unevaled->as.let_binding.expr;
322 break;
323 case EXPR_PAT_IDENT:
324 case EXPR_LAMBDA:
325 die("Impossible: uncompiled expression found while evaluating");
326 }
327 break;
328 case MODE_RETURN: switch (stack[--stack_size].tag) {
329 case FRAME_ENV:
330 env_val = stack[stack_size].as.env.captures;
331 locals_frame = stack[stack_size].as.env.locals_frame;
332 locals_size = stack[stack_size].as.env.locals_top;
333 break;
334 case FRAME_ALT:
335 if (focus.evaled == NULL) {
336 focus.unevaled = stack[stack_size].as.alt.orelse;
337 mode = MODE_EVAL;
338 }
339 break;
340 case FRAME_FGROUP_ALT:
341 if (focus.evaled == NULL) {
342 env_val = stack[stack_size].as.fgroup_alt.orelse->as.closure.env;
343 focus.unevaled = stack[stack_size].as.fgroup_alt.orelse->as.closure.body;
344 mode = MODE_EVAL;
345 }
346 break;
347 case FRAME_SEQ:
348 if (focus.evaled != NULL) {
349 focus.unevaled = stack[stack_size].as.seq.after;
350 mode = MODE_EVAL;
351 }
352 break;
353 case FRAME_LET: {
354 size_t bound_vars = stack[stack_size].as.let_binding.pattern.bound_vars;
355 locals_capacity = arg_stack_bump(&locals, locals_size + bound_vars - 1, locals_capacity);
356 value_t **write_to = locals + locals_size;
357 if (_pattern_match(focus.evaled,&write_to, stack[stack_size].as.let_binding.pattern.expr)) {
358 locals_size += bound_vars;
359 locals_frame += bound_vars;
360 focus.unevaled = stack[stack_size].as.let_binding.in;
361 mode = MODE_EVAL;
362 if (stack_size > 0 && stack[stack_size-1].tag != FRAME_ENV || stack_size == 0) {
363 stack[stack_size].tag = FRAME_ENV;
364 stack[stack_size].as.env.captures = env_val;
365 stack[stack_size].as.env.locals_top = locals_size - 1;
366 stack[stack_size].as.env.locals_frame = locals_frame;
367 stack_size++;
368 }
369 } else {
370 focus.evaled = NULL;
371 }
372 break;
373 }
374 case FRAME_CALL_CALLEE: {
375 expr_t ** args = stack[stack_size].as.call_callee.arguments;
376 size_t nargs = stack[stack_size].as.call_callee.nargs;
377 stack[stack_size].tag = FRAME_CALL_ARGS;
378 stack[stack_size].as.call_args.arg_base = arguments_size;
379 stack[stack_size].as.call_args.arguments = args;
380 stack[stack_size].as.call_args.nargs = nargs;
381 // fall through
382 }
383 case FRAME_CALL_ARGS_GROUP:
384 case FRAME_CALL_ARGS: {
385 arguments_capacity = arg_stack_bump(&arguments, arguments_size, arguments_capacity);
386 arguments[arguments_size] = focus.evaled;
387 arguments_size++;
388 if (stack[stack_size].as.call_args.nargs > 0) {
389 focus.unevaled = stack[stack_size].as.call_args.arguments[0];
390 stack[stack_size].as.call_args.nargs--;
391 stack[stack_size].as.call_args.arguments++;
392 mode = MODE_EVAL;
393 stack_size++;
394 } else if (stack[stack_size].tag == FRAME_CALL_ARGS_GROUP) {
395 size_t num_args = arguments_size - stack[stack_size].as.call_args.arg_base;
396 value_t **args_start = arguments + stack[stack_size].as.call_args.arg_base;
397 printf("num_args %zu arg_base %zu\n",num_args,stack[stack_size].as.call_args.arg_base);
398 arguments_size = stack[stack_size].as.call_args.arg_base;
399 value_t *ret = args_start[num_args-1];
400 if (ret->tag != VALUE_CLOSURE) {
401 focus.evaled = NULL;
402 break;
403 }
404 size_t i = num_args;
405 while (i >= 2) {
406 if (args_start[i-2]->tag != VALUE_CLOSURE || args_start[i-2]->as.closure.arity != ret->as.closure.arity) {
407 ret = NULL;
408 break;
409 }
410 value_t *nret = value_alloc(gc);
411 nret->tag = VALUE_CLOSURE;
412 nret->as.closure.arity = ret->as.closure.arity;
413 nret->as.closure.env = args_start[i-2]->as.closure.env;
414 nret->as.closure.body = args_start[i-2]->as.closure.body;
415 nret->as.closure.next = ret;
416 ret = nret;
417 i--;
418 }
419 focus.evaled = ret;
420 } else if (stack[stack_size].tag == FRAME_CALL_ARGS) {
421 value_t *callee = arguments[stack[stack_size].as.call_args.arg_base];
422 size_t num_args = arguments_size - stack[stack_size].as.call_args.arg_base - 1;
423 value_t **args_start = arguments + stack[stack_size].as.call_args.arg_base + 1;
424 arguments_size = stack[stack_size].as.call_args.arg_base;
425 printf("num_args %zu arg_base %zu\n",num_args,stack[stack_size].as.call_args.arg_base);
426 printf("callee %d\n",callee->as.closure.arity);
427 if (callee == NULL) {
428 focus.evaled = NULL;
429 } else switch (callee->tag) {
430 case VALUE_BUILTIN:
431 focus.evaled = callee->as.builtin(gc,args_start, num_args);
432 break;
433 case VALUE_CLOSURE:
434 if (callee->as.closure.arity == num_args) {
435 printf("ARITY CHECK\n");
436 if (stack_size > 0 && stack[stack_size-1].tag != FRAME_ENV || stack_size == 0) {
437 stack[stack_size].as.env.captures = env_val;
438 stack[stack_size].as.env.locals_frame = locals_frame;
439 stack[stack_size].as.env.locals_top = locals_size;
440 stack[stack_size].tag = FRAME_ENV;
441 stack_size++;
442 }
443 locals_frame = num_args;
444 locals_capacity = arg_stack_bump(&locals, locals_size + num_args, locals_capacity);
445 memcpy(locals + locals_size, args_start, sizeof(value_t*) * num_args);
446 locals_size += num_args;
447
448 env_val = callee->as.closure.env;
449 focus.unevaled = callee->as.closure.body;
450 if (callee->as.closure.next != NULL) {
451 stack_bump(&stack, stack_size, stack_capacity);
452 stack[stack_size].as.fgroup_alt.orelse = callee->as.closure.next;
453 stack[stack_size].tag = FRAME_FGROUP_ALT;
454 stack_size++;
455 }
456 mode = MODE_EVAL;
457 } else {
458 focus.evaled = NULL;
459 }
460 break;
461 case VALUE_CONSTRUCTOR:
462 if (callee->as.constructor.args == NULL) {
463 value_t *val = value_alloc(gc);
464 val->tag = VALUE_CONSTRUCTOR;
465 val->as.constructor.args = malloc(sizeof(value_t*) * num_args);
466 if (val->as.constructor.args == NULL) {
467 die("Out of memory, can't allocate args buffer");
468 }
469 memcpy(val->as.constructor.args,args_start, sizeof(value_t*) * num_args);
470 val->as.constructor.num_args = num_args;
471 val->as.constructor.name = callee->as.constructor.name;
472 focus.evaled = val;
473 break;
474 }
475 //fall through
476 case VALUE_INT:
477 case VALUE_FLOAT:
478 case VALUE_STRING:
479 focus.evaled = NULL;
480 case VALUE_ENV: // should be impossible
481 focus.evaled = NULL;
482 }
483 }
484 break;
485 }
486 }
487 break;
488 }
489 }
490 free(arguments);
491 free(locals);
492 free(stack);
493 return focus.evaled;
494}
495