diff options
Diffstat (limited to 'src/runtime.c')
| -rw-r--r-- | src/runtime.c | 42 |
1 files changed, 29 insertions, 13 deletions
diff --git a/src/runtime.c b/src/runtime.c index abfd480..57e3335 100644 --- a/src/runtime.c +++ b/src/runtime.c @@ -349,6 +349,7 @@ pit_value pit_intern(pit_runtime *rt, u8 *nm, i64 len) { ent->name = pit_bytes_new(rt, nm, len); ent->value = PIT_NIL; ent->function = PIT_NIL; + ent->is_macro = false; rt->symtab_len += 1; return pit_symbol_new(rt, idx); } @@ -381,6 +382,20 @@ void pit_fset(pit_runtime *rt, pit_value sym, pit_value v) { if (!ent) { pit_error(rt, "bad symbol"); return; } ent->function = v; } +bool pit_is_symbol_macro(pit_runtime *rt, pit_value sym) { + pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); + if (!ent) { pit_error(rt, "bad symbol"); return false; } + return ent->is_macro; +} +void pit_symbol_is_macro(pit_runtime *rt, pit_value sym) { + pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); + if (!ent) { pit_error(rt, "bad symbol"); return; } + ent->is_macro = true; +} +void pit_mset(pit_runtime *rt, pit_value sym, pit_value v) { + pit_fset(rt, sym, v); + pit_symbol_is_macro(rt, sym); +} pit_value pit_cons(pit_runtime *rt, pit_value car, pit_value cdr) { pit_value ret = pit_heavy_new(rt); @@ -485,26 +500,27 @@ pit_value pit_eval(pit_runtime *rt, pit_value top) { pit_value fsym = pit_car(rt, cur); pit_value f = pit_fget(rt, fsym); pit_value args = pit_cdr(rt, cur); - i64 argcount = 0; - while (args != PIT_NIL) { - eval_stack_push(rt, expr_stack, pit_car(rt, args)); - args = pit_cdr(rt, args); - argcount += 1; + if (pit_is_symbol_macro(rt, fsym)) { + pit_value res = pit_apply(rt, f, args); + eval_stack_push(rt, expr_stack, res); + } else { + i64 argcount = 0; + while (args != PIT_NIL) { + eval_stack_push(rt, expr_stack, pit_car(rt, args)); + args = pit_cdr(rt, args); + argcount += 1; + } + eval_stack_push(rt, program, pit_cons(rt, f, pit_integer_new(rt, argcount))); } - eval_stack_push(rt, program, pit_cons(rt, f, pit_integer_new(rt, argcount))); } else if (pit_is_symbol(rt, cur)) { // unquoted symbols: variable lookup eval_stack_push(rt, program, pit_get(rt, cur)); - } else if (pit_is_double(rt, cur)) { // double literals + } else { // other values: used literally eval_stack_push(rt, program, cur); - } else if (pit_is_integer(rt, cur)) { // integer literals - eval_stack_push(rt, program, cur); - } else { - pit_error(rt, "unknown expression in eval"); - goto end; } } struct eval_stack *result_stack = eval_stack_new(); // then, execute the polish notation program from right to left + // this has the nice consequence of putting the arguments in the right order for (i64 idx = program->top - 1; idx >= 0; --idx) { pit_value expr = program->data[idx]; if (pit_is_cons(rt, expr)) { // this is a function call @@ -517,9 +533,9 @@ pit_value pit_eval(pit_runtime *rt, pit_value top) { eval_stack_push(rt, result_stack, expr); } } -end: pit_value ret = eval_stack_pop(rt, result_stack); eval_stack_destroy(expr_stack); + eval_stack_destroy(program); eval_stack_destroy(result_stack); return ret; } |
