From fece4fc3d4decb70c94b49ab854fa9ae93b4d887 Mon Sep 17 00:00:00 2001 From: LLLL Colonq Date: Fri, 14 Aug 2026 14:51:01 -0400 Subject: pit: More VM-style evaluation --- pit/src/runtime/eval.c | 238 +++++++++++++------------------------------------ 1 file changed, 61 insertions(+), 177 deletions(-) (limited to 'pit/src/runtime/eval.c') diff --git a/pit/src/runtime/eval.c b/pit/src/runtime/eval.c index 1822bc5..3903a64 100644 --- a/pit/src/runtime/eval.c +++ b/pit/src/runtime/eval.c @@ -2,127 +2,8 @@ #include -void pit_vm_call_special_form(pit_runtime *rt, pit_value f, pit_value args) { - char buf[256] = {0}; - switch (pit_value_sort(f)) { - case PIT_VALUE_SORT_REF: { - pit_value_heavy *h = pit_value_ref_deref(rt, pit_value_as_ref(rt, f)); - if (!h) { pit_error(rt, "bad ref for special form"); return; } - switch (h->hsort) { - case PIT_VALUE_HEAVY_SORT_NATIVEFUNC: - h->in.nativefunc.f(rt, args, h->in.nativefunc.data); - break; - default: { - i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); - buf[end] = 0; - pit_error(rt, "attempted to apply non-nativefunc special form: %s", buf); - return; - } - } - break; - } - default: { - i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); - buf[end] = 0; - pit_error(rt, "attempted to apply non-function special form: %s", buf); - return; - } - } -} - -pit_value pit_vm_compile(pit_runtime *rt, pit_value top) { - pit_value ret = PIT_NIL; - i64 expr_stack_reset = rt->expr_stack->next; - i64 traversal_reset = rt->traversal->next; - if (pit_vec_push(pit_value)(rt->expr_stack, top) < 0) - pit_error(rt, "evaluation stack overflow"); - /* first, convert the expression tree into "polish notation" in traversal */ - while (rt->expr_stack->next > expr_stack_reset) { - pit_value cur = PIT_NIL; - if (rt->error != PIT_NIL) goto end; - if (pit_vec_pop(pit_value)(rt->expr_stack, &cur) < 0) - pit_error(rt, "evaluation stack underflow"); - fprintf(stderr, "cur: "); pit_dump_to_file(rt, stderr, cur, false); fprintf(stderr, "\n"); - if (pit_value_is_cons(rt, cur)) { - pit_value fsym = pit_value_cons_car(rt, cur); - bool is_symbol = pit_value_is_symbol(rt, fsym); - pit_annotation *ann = pit_annotation_get(rt, pit_value_as_ref(rt, cur)); - if (is_symbol && pit_symtab_is_symbol_special_form(rt, fsym)) { /* special forms */ - pit_value f = pit_symtab_fget(rt, fsym); - pit_value args = pit_value_cons_cdr(rt, cur); - pit_vm_call_special_form(rt, f, args); - } else if (is_symbol && pit_symtab_is_symbol_macro(rt, fsym)) { /* macros */ - pit_error(rt, "encountered a macro while evaluating"); - } else { /* normal functions */ - pit_value args = pit_value_cons_cdr(rt, cur); - i64 argcount = 0; - while (args != PIT_NIL) { - if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons_car(rt, args)) < 0) - pit_error(rt, "evaluation stack overflow"); - args = pit_value_cons_cdr(rt, args); - argcount += 1; - } - if (!is_symbol) { - if (pit_vec_push(pit_value)(rt->expr_stack, fsym) < 0) - pit_error(rt, "evaluation stack overflow"); - } - pit_traversal_push_value(rt, rt->traversal, - pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "apply"), pit_value_integer_new(rt, argcount)) - ); - if (is_symbol) { - pit_traversal_push_value(rt, rt->traversal, - pit_value_list(rt, 1, pit_symtab_intern_cstr(rt, "fget")) - ); - pit_traversal_push_value(rt, rt->traversal, - pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), fsym) - ); - } - } - } else if (pit_value_is_symbol(rt, cur)) { /* unquoted symbols: variable lookup */ - pit_symtab_entry *ent = pit_symtab_lookup(rt, cur); - if (ent->is_keyword) { - pit_traversal_push_value(rt, rt->traversal, - pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), cur) - ); - } else { - pit_traversal_push_value(rt, rt->traversal, - pit_value_list(rt, 1, pit_symtab_intern_cstr(rt, "get")) - ); - pit_traversal_push_value(rt, rt->traversal, - pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), cur) - ); - } - } else { /* other expressions evaluate to themselves! */ - pit_traversal_push_value(rt, rt->traversal, - pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), cur) - ); - } - } - for (i64 idx = traversal_reset; idx < rt->traversal->next; idx++) { - pit_traversal_entry *ent = pit_vec_get(pit_traversal_entry)(rt->traversal, idx); - if (ent == NULL) pit_error(rt, "evaluation traversal invalid"); - if (rt->error != PIT_NIL) goto end; - switch (ent->sort) { - case PIT_TRAVERSAL_ENTRY_VALUE: { - ret = pit_value_cons(rt, ent->in.value, ret); - break; - } - default: - pit_error(rt, "unknown traversal entry"); - ret = PIT_NIL; - goto end; - } - } -end: { - rt->expr_stack->next = expr_stack_reset; - rt->traversal->next = traversal_reset; - fprintf(stderr, "compiled: "); pit_dump_to_file(rt, stderr, ret, false); fprintf(stderr, "\n"); - return ret; - } -} - /* add a new stack frame to the vm (with a tag and callsite annotation) */ -void pit_vm_push_code_func(pit_runtime *rt, pit_value code, pit_value tag, pit_annotation ann, pit_value bound) { +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; ent.tag = tag; ent.ann = ann; @@ -135,36 +16,38 @@ void pit_vm_push_code_func(pit_runtime *rt, pit_value code, pit_value tag, pit_a } /* add a new stack frame to the vm (with no annotation) */ -void pit_vm_push_code(pit_runtime *rt, pit_value code) { +static void vm_push_code(pit_runtime *rt, pit_value code) { pit_annotation ann; ann.line = -1; ann.column = -1; - pit_vm_push_code_func(rt, code, PIT_NIL, ann, PIT_NIL); + vm_push_code_func(rt, code, PIT_NIL, ann, PIT_NIL); } -void pit_vm_push(pit_runtime *rt, pit_value v) { - fprintf(stderr, "push: "); pit_dump_to_file(rt, stderr, v, false); fprintf(stderr, "\n"); +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"); } } -pit_value pit_vm_pop(pit_runtime *rt) { +static pit_value vm_pop(pit_runtime *rt) { pit_value ret = PIT_NIL; 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, "pop: "); pit_dump_to_file(rt, stderr, ret, false); fprintf(stderr, "\n"); return ret; } -void pit_vm_call_lisp(pit_runtime *rt, pit_value tag, pit_value closure, pit_value args) { +static void vm_call_lisp(pit_runtime *rt, pit_value tag, pit_value closure, pit_value args) { pit_value bound = PIT_NIL; 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); 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); @@ -190,28 +73,28 @@ void pit_vm_call_lisp(pit_runtime *rt, pit_value tag, pit_value closure, pit_val pit_annotation ann; ann.line = -1; ann.column = -1; - pit_vm_push_code_func(rt, body, tag, ann, bound); + vm_push_code_func(rt, body, tag, ann, bound); } -void pit_vm_call(pit_runtime *rt, pit_value f, pit_value args) { +static bool vm_call(pit_runtime *rt, pit_value f, pit_value args) { char buf[256] = {0}; if (pit_value_is_symbol(rt, f)) f = pit_symtab_fget(rt, f); switch (pit_value_sort(f)) { case PIT_VALUE_SORT_REF: { 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; } + if (!h) { pit_error(rt, "bad ref for function"); return false; } switch (h->hsort) { case PIT_VALUE_HEAVY_SORT_NATIVEFUNC: - pit_vm_push(rt, h->in.nativefunc.f(rt, args, h->in.nativefunc.data)); + vm_push(rt, h->in.nativefunc.f(rt, args, h->in.nativefunc.data)); break; case PIT_VALUE_HEAVY_SORT_FUNC: - pit_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); break; default: { i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); buf[end] = 0; pit_error(rt, "attempted to apply non-function ref: %s", buf); - return; + return false; } } break; @@ -220,20 +103,21 @@ void pit_vm_call(pit_runtime *rt, pit_value f, pit_value args) { i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); buf[end] = 0; pit_error(rt, "attempted to apply non-function value: %s", buf); - return; + return false; } } + return true; } /* run one instruction of the VM */ bool pit_vm_run_one(pit_runtime *rt) { - char buf[256] = {0}; 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"); @@ -246,53 +130,50 @@ bool pit_vm_run_one(pit_runtime *rt) { 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"); + // fprintf(stderr, "ins: "); pit_dump_to_file(rt, stderr, ins, false); fprintf(stderr, "\n"); pit_value op = pit_value_cons_car(rt, ins); if (pit_symtab_symbol_name_match_cstr(rt, op, "literal")) { - pit_vm_push(rt, pit_value_cons_car(rt, pit_value_cons_cdr(rt, ins))); + /* 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 */ + /* 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)); } else if (pit_symtab_symbol_name_match_cstr(rt, op, "get")) { - pit_vm_push(rt, pit_symtab_get(rt, pit_vm_pop(rt))); + 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))); } else if (pit_symtab_symbol_name_match_cstr(rt, op, "fget")) { - pit_vm_push(rt, pit_symtab_fget(rt, pit_vm_pop(rt))); + /* 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 */ + 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; } 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 = pit_vm_pop(rt); + pit_value f = vm_pop(rt); pit_value args = PIT_NIL; - while (arity-- > 0) args = pit_value_cons(rt, pit_vm_pop(rt), args); - if (pit_value_is_symbol(rt, f)) f = pit_symtab_fget(rt, f); - switch (pit_value_sort(f)) { - case PIT_VALUE_SORT_REF: { - 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 PIT_NIL; } - switch (h->hsort) { - case PIT_VALUE_HEAVY_SORT_NATIVEFUNC: - pit_vm_push(rt, h->in.nativefunc.f(rt, args, h->in.nativefunc.data)); - break; - case PIT_VALUE_HEAVY_SORT_FUNC: - pit_vm_call_lisp(rt, h->in.func.nm, h->in.func.closure, args); - break; - default: { - i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); - buf[end] = 0; - pit_error(rt, "attempted to apply non-function ref: %s", buf); - return false; - } - } - break; - } - default: { - i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); - buf[end] = 0; - pit_error(rt, "attempted to apply non-function value: %s", buf); - return false; - } - } + while (arity-- > 0) args = pit_value_cons(rt, vm_pop(rt), args); + if (!vm_call(rt, f, args)) return false; } else { 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"); + // 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); @@ -301,15 +182,18 @@ bool pit_vm_run_one(pit_runtime *rt) { return true; } -/* run the VM until evaluation finishes, returning the result */ +/* run the VM until evaluation of this code finishes, returning the result */ pit_value pit_vm_eval(pit_runtime *rt, pit_value v) { - pit_vm_push_code(rt, v); - while (pit_vm_run_one(rt)); - pit_vm_pop(rt); + i64 start = rt->callstack->next; + vm_push_code(rt, v); + while (pit_vm_run_one(rt) && rt->callstack->next > start); + 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) { - pit_vm_call(rt, f, args); - while (pit_vm_run_one(rt)); - pit_vm_pop(rt); + i64 start = rt->callstack->next; + vm_call(rt, f, args); + while (pit_vm_run_one(rt) && rt->callstack->next > start); + return vm_pop(rt); } -- cgit v1.3.1