From ff7407c146b8129c2f1cc7ebe3b5771ad2f5dfdd Mon Sep 17 00:00:00 2001 From: LLLL Colonq Date: Tue, 1 Sep 2026 06:26:13 -0400 Subject: pit: Fix evaluator --- pit/src/runtime/eval.c | 78 +++++++++++++++++++++++--------------------------- 1 file changed, 36 insertions(+), 42 deletions(-) (limited to 'pit/src/runtime/eval.c') diff --git a/pit/src/runtime/eval.c b/pit/src/runtime/eval.c index 3903a64..f149246 100644 --- a/pit/src/runtime/eval.c +++ b/pit/src/runtime/eval.c @@ -4,12 +4,12 @@ /* 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) { + fprintf(stderr, "running: "); pit_dump_to_file(rt, stderr, code, false); fprintf(stderr, "\n"); pit_callstack_entry ent; ent.tag = tag; ent.ann = ann; ent.code = code; ent.bound = bound; - fprintf(stderr, "push code: "); pit_dump_to_file(rt, stderr, code, false); fprintf(stderr, "\n"); if (pit_vec_push(pit_callstack_entry)(rt->callstack, ent) < 0) { pit_error(rt, "call stack overflow"); } @@ -24,10 +24,10 @@ static void vm_push_code(pit_runtime *rt, pit_value code) { } static void vm_push(pit_runtime *rt, pit_value v) { - // fprintf(stderr, "push: "); pit_dump_to_file(rt, stderr, v, false); fprintf(stderr, "\n"); if (pit_vec_push(pit_value)(rt->result_stack, v) < 0) { pit_error(rt, "vm stack overflow"); } + fprintf(stderr, "result push!: %ld\n", rt->result_stack->next); } static pit_value vm_pop(pit_runtime *rt) { @@ -35,7 +35,7 @@ static pit_value vm_pop(pit_runtime *rt) { if (pit_vec_pop(pit_value)(rt->result_stack, &ret) < 0) { pit_error(rt, "vm stack underflow"); } - // fprintf(stderr, "pop: "); pit_dump_to_file(rt, stderr, ret, false); fprintf(stderr, "\n"); + fprintf(stderr, "result pop!: %ld\n", rt->result_stack->next); return ret; } @@ -46,8 +46,6 @@ static void vm_call_lisp(pit_runtime *rt, pit_value tag, pit_value closure, pit_ pit_value arg_rest_nm = pit_value_array_get(rt, closure, 2); pit_value body = pit_value_array_get(rt, closure, 3); if (rt->error != PIT_NIL) return; - // fprintf(stderr, "call lisp: "); pit_dump_to_file(rt, stderr, closure, false); fprintf(stderr, "\n"); - // fprintf(stderr, "binding: "); pit_dump_to_file(rt, stderr, env, false); fprintf(stderr, "\n"); 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); @@ -111,56 +109,54 @@ static bool vm_call(pit_runtime *rt, pit_value f, pit_value args) { /* run one instruction of the VM */ bool pit_vm_run_one(pit_runtime *rt) { +start: if (rt->callstack->next < 1) return false; 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; } - // fprintf(stderr, "code: "); pit_dump_to_file(rt, stderr, ent->code, false); fprintf(stderr, "\n"); - pit_value ins = pit_value_cons_car(rt, ent->code); - if (ins == PIT_NIL) { - pit_error(rt, "malformed vm instruction"); - return false; + if (ent->code == PIT_NIL) { /* if we encounter an empty stack frame... */ + 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 */ + goto start; } - pit_value bound = ent->bound; - pit_value rest = pit_value_cons_cdr(rt, ent->code); - bool final = false; - if (rest == PIT_NIL) { - final = true; - pit_vec_pop(pit_callstack_entry)(rt->callstack, NULL); - } else ent->code = rest; - // fprintf(stderr, "ins: "); pit_dump_to_file(rt, stderr, ins, false); fprintf(stderr, "\n"); + pit_value ins = pit_value_cons_car(rt, ent->code); + if (ins == PIT_NIL) { pit_error(rt, "malformed vm instruction"); return false; } + ent->code = pit_value_cons_cdr(rt, ent->code); pit_value op = pit_value_cons_car(rt, ins); + fprintf(stderr, "ins: "); pit_dump_to_file(rt, stderr, ins, false); fprintf(stderr, "\n"); if (pit_symtab_symbol_name_match_cstr(rt, op, "literal")) { /* push a lisp value to the vm stack */ vm_push(rt, pit_value_cons_car(rt, pit_value_cons_cdr(rt, ins))); } else if (pit_symtab_symbol_name_match_cstr(rt, op, "lambda")) { - /* create and push a function with the given arguments, free variables, and (compiled) body */ + /* pop an argument list, a free variable list, and a body block */ + /* create and push a function */ /* notably, this builds the closure by recording the currently-bound cells for each free variable! */ - pit_value args = pit_value_cons_cdr(rt, ins); - pit_value as = pit_value_cons_car(rt, args); - args = pit_value_cons_cdr(rt, args); - pit_value freevars = pit_value_cons_car(rt, args); - args = pit_value_cons_cdr(rt, args); - pit_value body = pit_value_cons_car(rt, args); - vm_push(rt, pit_value_func_lambda(rt, as, freevars, body)); + pit_value args = vm_pop(rt); + pit_value freevars = vm_pop(rt); + pit_value body = vm_pop(rt); + vm_push(rt, pit_value_func_lambda(rt, args, freevars, body)); + } else if (pit_symtab_symbol_name_match_cstr(rt, op, "drop")) { + /* pop a value and ignore it */ + vm_pop(rt); } else if (pit_symtab_symbol_name_match_cstr(rt, op, "get")) { - pit_value nm = vm_pop(rt); - // fprintf(stderr, "get: "); pit_dump_to_file(rt, stderr, nm, false); fprintf(stderr, "\n"); - vm_push(rt, pit_symtab_get(rt, nm)); /* pop a symbol and look up its value */ - // vm_push(rt, pit_symtab_get(rt, vm_pop(rt))); + vm_push(rt, pit_symtab_get(rt, vm_pop(rt))); } else if (pit_symtab_symbol_name_match_cstr(rt, op, "fget")) { /* pop a symbol and look up its function value */ vm_push(rt, pit_symtab_fget(rt, vm_pop(rt))); } else if (pit_symtab_symbol_name_match_cstr(rt, op, "if")) { - /* pop a then-function, an else-function, and a condition */ - /* call (no args) the then-function if the condition is true, otherwise call the else-function */ + /* pop a condition, a then-block, and an else-block */ + /* run the then-block if the condition is true, otherwise run the else-block */ + pit_value c = vm_pop(rt); pit_value t = vm_pop(rt); pit_value e = vm_pop(rt); - pit_value c = vm_pop(rt); - if (!vm_call(rt, c != PIT_NIL ? t : e, PIT_NIL)) return false; + vm_push_code(rt, c != PIT_NIL ? t : e); } 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))); @@ -172,13 +168,6 @@ bool pit_vm_run_one(pit_runtime *rt) { pit_error(rt, "unknown vm operation"); return false; } - if (final) { /* if we have finished this stack frame */ - // fprintf(stderr, "unbinding: "); pit_dump_to_file(rt, stderr, bound, false); fprintf(stderr, "\n"); - 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); - } - } return true; } @@ -186,7 +175,12 @@ bool pit_vm_run_one(pit_runtime *rt) { pit_value pit_vm_eval(pit_runtime *rt, pit_value v) { i64 start = rt->callstack->next; vm_push_code(rt, v); - while (pit_vm_run_one(rt) && rt->callstack->next > start); + while (pit_vm_run_one(rt) && rt->callstack->next > start) { + // if (rt->expr_stack->next == 0 && rt->compilation_stack->next == 0) { + // fprintf(stderr, "running gc\n"); + // pit_gc(rt); /* TODO hack to avoid running GC during macroexpansion */ + // } + } return vm_pop(rt); } -- cgit v1.3.1