summaryrefslogtreecommitdiff
path: root/pit/src/runtime/eval.c
diff options
context:
space:
mode:
Diffstat (limited to 'pit/src/runtime/eval.c')
-rw-r--r--pit/src/runtime/eval.c102
1 files changed, 58 insertions, 44 deletions
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 <lcq/pit/runtime/eval.h>
-#include <stdio.h>
-
/* 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);
}
generated by cgit v1.3.1 (git 2.54.0) at 2026-10-31 02:42:49 +0000