From 71bfa9094a4a25f762d681bb07f79f92a95dbb87 Mon Sep 17 00:00:00 2001 From: LLLL Colonq Date: Sun, 6 Sep 2026 17:40:51 -0400 Subject: pit: Fix evaluator bug --- pit/src/runtime/eval.c | 102 ++++++++++++++++++++++++++++--------------------- 1 file changed, 58 insertions(+), 44 deletions(-) (limited to 'pit/src/runtime/eval.c') diff --git a/pit/src/runtime/eval.c b/pit/src/runtime/eval.c index 5966fdb..7c64418 100644 --- a/pit/src/runtime/eval.c +++ b/pit/src/runtime/eval.c @@ -1,7 +1,5 @@ #include -#include - /* add a new stack frame to the vm (with a tag and callsite annotation) */ static void vm_push_code_func(pit_runtime *rt, pit_value code, pit_value tag, pit_annotation ann, pit_value bound) { pit_callstack_entry ent; @@ -15,11 +13,11 @@ static void vm_push_code_func(pit_runtime *rt, pit_value code, pit_value tag, pi } /* add a new stack frame to the vm (with no annotation) */ -static void vm_push_code(pit_runtime *rt, pit_value code) { +static void vm_push_code(pit_runtime *rt, pit_value code, pit_value bound) { pit_annotation ann; ann.line = -1; ann.column = -1; - vm_push_code_func(rt, code, PIT_NIL, ann, PIT_NIL); + vm_push_code_func(rt, code, PIT_NIL, ann, bound); } static void vm_push(pit_runtime *rt, pit_value v) { @@ -36,8 +34,19 @@ static pit_value vm_pop(pit_runtime *rt) { return ret; } -static void vm_call_lisp(pit_runtime *rt, pit_value tag, pit_value closure, pit_value args) { - pit_value bound = PIT_NIL; +static pit_value vm_bind_or_replace(pit_runtime *rt, pit_value nm, pit_value cell, pit_value bound) { + if (pit_value_list_contains_eq(rt, nm, bound)) { + /* if we're already responsible for unbinding this symbol (e.g. in a tail call), */ + /* simply replace the old binding - this keeps the binding stack from growing for TCO purposes */ + pit_symtab_replace(rt, nm, cell); + } else { + pit_symtab_bind(rt, nm, cell); + bound = pit_value_cons(rt, nm, bound); + } + return bound; +} + +static void vm_call_lisp(pit_runtime *rt, pit_value tag, pit_value closure, pit_value args, pit_value bound) { pit_value env = pit_value_array_get(rt, closure, 0); pit_value anames = pit_value_array_get(rt, closure, 1); pit_value arg_rest_nm = pit_value_array_get(rt, closure, 2); @@ -46,8 +55,7 @@ static void vm_call_lisp(pit_runtime *rt, pit_value tag, pit_value closure, pit_ while (env != PIT_NIL) { /* first, bind all entries in the closure */ pit_value b = pit_value_cons_car(rt, env); pit_value nm = pit_value_cons_car(rt, b); - pit_symtab_bind(rt, nm, pit_value_cons_cdr(rt, b)); - bound = pit_value_cons(rt, nm, bound); + bound = vm_bind_or_replace(rt, nm, pit_value_cons_cdr(rt, b), bound); env = pit_value_cons_cdr(rt, env); } while (anames != PIT_NIL) { /* bind all argument names to their values */ @@ -55,13 +63,12 @@ static void vm_call_lisp(pit_runtime *rt, pit_value tag, pit_value closure, pit_ pit_value cell = pit_value_cell_new(rt, PIT_NIL); if (arg_rest_nm != PIT_NIL && pit_value_eq(nm, arg_rest_nm)) { pit_value_cell_set(rt, cell, args, nm); - pit_symtab_bind(rt, nm, cell); + bound = vm_bind_or_replace(rt, nm, cell, bound); break; } else { pit_value_cell_set(rt, cell, pit_value_cons_car(rt, args), nm); - pit_symtab_bind(rt, nm, cell); + bound = vm_bind_or_replace(rt, nm, cell, bound); } - bound = pit_value_cons(rt, nm, bound); args = pit_value_cons_cdr(rt, args); anames = pit_value_cons_cdr(rt, anames); } @@ -71,7 +78,7 @@ static void vm_call_lisp(pit_runtime *rt, pit_value tag, pit_value closure, pit_ vm_push_code_func(rt, body, tag, ann, bound); } -static bool vm_call(pit_runtime *rt, pit_value f, pit_value args) { +static bool vm_call(pit_runtime *rt, pit_value f, pit_value args, pit_value bound) { char buf[256] = {0}; if (pit_value_is_symbol(rt, f)) f = pit_symtab_fget(rt, f); switch (pit_value_sort(f)) { @@ -79,11 +86,17 @@ static bool vm_call(pit_runtime *rt, pit_value f, pit_value args) { pit_value_heavy *h = pit_value_ref_deref(rt, pit_value_as_ref(rt, f)); if (!h) { pit_error(rt, "bad ref for function"); return false; } switch (h->hsort) { - case PIT_VALUE_HEAVY_SORT_NATIVEFUNC: + case PIT_VALUE_HEAVY_SORT_NATIVEFUNC: { vm_push(rt, h->in.nativefunc.f(rt, args, h->in.nativefunc.data)); + /* if we've performed a native call, the frame is over - unbind everything left over */ + while (bound != PIT_NIL) { + pit_symtab_unbind(rt, pit_value_cons_car(rt, bound)); + bound = pit_value_cons_cdr(rt, bound); + } break; + } case PIT_VALUE_HEAVY_SORT_FUNC: - vm_call_lisp(rt, h->in.func.nm, h->in.func.closure, args); + vm_call_lisp(rt, h->in.func.nm, h->in.func.closure, args, bound); break; default: { i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); @@ -104,33 +117,40 @@ static bool vm_call(pit_runtime *rt, pit_value f, pit_value args) { return true; } -static void vm_erase_empty(pit_runtime *rt) { +/* remove all empty frames atop the stack. if unbind is true, unbind all associated bindings */ +/* if unbind is false, return all the bindings that need to be unbound, in order */ +/* the intention is that if we're finishing a frame "normally", we can just unbind everything */ +/* if we're finishing a frame by pushing another frame that should run within this frame's context */ +/* (e.g. a tail call or other control flow), we can give that new frame responsibility for this frame's */ +/* bindings. this allows us to avoid growing the call stack while also ensuring that things are unbound */ +/* at the correct time. */ +static pit_value vm_erase_empty(pit_runtime *rt, bool unbind) { pit_callstack_entry *ent = NULL; + pit_value ret = PIT_NIL; + if (rt->callstack->next < 1) return ret; while ((ent = pit_vec_get(pit_callstack_entry)(rt->callstack, rt->callstack->next - 1)) && ent->code == PIT_NIL) { - pit_value bound = ent->bound; - while (bound != PIT_NIL) { /* unbind everything we bound for the frame, in reverse */ - pit_symtab_unbind(rt, pit_value_cons_car(rt, bound)); - bound = pit_value_cons_cdr(rt, bound); - } - pit_vec_pop(pit_callstack_entry)(rt->callstack, NULL); /* pop the frame, and try again */ + pit_value bound = ent->bound; + if (unbind) { /* we only unbind unconditionally when searching for the next instruction */ + while (bound != PIT_NIL) { /* unbind everything we bound for the frame, in reverse */ + pit_symtab_unbind(rt, pit_value_cons_car(rt, bound)); + bound = pit_value_cons_cdr(rt, bound); + } + } else { + ret = pit_value_list_append(rt, bound, ret); + } + pit_vec_pop(pit_callstack_entry)(rt->callstack, NULL); /* pop the frame, and try again */ } + return ret; } /* run one instruction of the VM */ bool pit_vm_run_one(pit_runtime *rt) { + vm_erase_empty(rt, true); if (rt->callstack->next < 1) return false; - vm_erase_empty(rt); pit_callstack_entry *ent = pit_vec_get(pit_callstack_entry)(rt->callstack, rt->callstack->next - 1); if (ent == NULL) { pit_error(rt, "malformed call stack"); return false; } - // for (i64 i = 0; i < rt->callstack->next; ++i) { - // pit_callstack_entry *e = pit_vec_get(pit_callstack_entry)(rt->callstack, i); - // fprintf(stderr, "frame: "); pit_dump_to_file(rt, stderr, e->code, false); fprintf(stderr, "\n"); - // } pit_value ins = pit_value_cons_car(rt, ent->code); - fprintf(stderr, "ins: "); pit_dump_to_file(rt, stderr, ins, false); fprintf(stderr, "\n"); - fprintf(stderr, "code: "); pit_dump_to_file(rt, stderr, ent->code, false); fprintf(stderr, "\n"); - // fprintf(stderr, "foo: "); pit_dump_to_file(rt, stderr, pit_symtab_get_function_cell(rt, pit_symtab_intern_cstr(rt, "foo")), false); fprintf(stderr, "\n"); if (ins == PIT_NIL) { pit_error(rt, "malformed vm instruction: %v %v", ins); return false; } ent->code = pit_value_cons_cdr(rt, ent->code); pit_value op = pit_value_cons_car(rt, ins); @@ -160,42 +180,36 @@ bool pit_vm_run_one(pit_runtime *rt) { pit_value c = vm_pop(rt); pit_value t = vm_pop(rt); pit_value e = vm_pop(rt); - vm_erase_empty(rt); - vm_push_code(rt, c != PIT_NIL ? t : e); + pit_value bindings = vm_erase_empty(rt, false); + vm_push_code(rt, c != PIT_NIL ? t : e, bindings); } else if (pit_symtab_symbol_name_match_cstr(rt, op, "apply")) { /* pop an arity n and a function, and then n arguments, and apply the function */ i64 arity = pit_value_as_integer(rt, pit_value_cons_car(rt, pit_value_cons_cdr(rt, ins))); pit_value f = vm_pop(rt); pit_value args = PIT_NIL; while (arity-- > 0) args = pit_value_cons(rt, vm_pop(rt), args); - vm_erase_empty(rt); - if (!vm_call(rt, f, args)) return false; + pit_value bindings = vm_erase_empty(rt, false); + if (!vm_call(rt, f, args, bindings)) return false; } else { pit_error(rt, "unknown vm operation"); return false; } + vm_erase_empty(rt, true); return true; } /* run the VM until evaluation of this code finishes, returning the result */ pit_value pit_vm_eval(pit_runtime *rt, pit_value v) { i64 start = rt->callstack->next; - vm_push_code(rt, v); - i64 gc = 0; - while (pit_vm_run_one(rt) && rt->callstack->next > start) { - gc += 1; - if (gc > 100 && rt->expr_stack->next == 0 && rt->compilation_stack->next == 0) { - gc = 0; - pit_gc(rt); /* TODO hack to avoid running GC during macroexpansion */ - } - } + vm_push_code(rt, v, PIT_NIL); + while (rt->callstack->next > start && pit_vm_run_one(rt)) pit_gc_if_necessary(rt); return vm_pop(rt); } /* run the VM until this function call finishes, returning the result */ pit_value pit_vm_apply(pit_runtime *rt, pit_value f, pit_value args) { i64 start = rt->callstack->next; - vm_call(rt, f, args); - while (pit_vm_run_one(rt) && rt->callstack->next > start); + vm_call(rt, f, args, PIT_NIL); + while (rt->callstack->next > start && pit_vm_run_one(rt)) pit_gc_if_necessary(rt); return vm_pop(rt); } -- cgit v1.3.1