1 files changed, 43 insertions, 45 deletions

diff --git a/pit/src/runtime/eval.c b/pit/src/runtime/eval.c
index 3903a64..b0b53b6 100644
--- a/pit/src/runtime/eval.c
+++ b/pit/src/runtime/eval.c
@@ -9,7 +9,6 @@ static void vm_push_code_func(pit_runtime *rt, pit_value code, pit_value tag, pi
     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,7 +23,6 @@ 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");
     }
@@ -35,7 +33,6 @@ 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");
     return ret;
 }
 
@@ -46,8 +43,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);
@@ -109,76 +104,75 @@ static bool vm_call(pit_runtime *rt, pit_value f, pit_value args) {
     return true;
 }
 
+static void vm_erase_empty(pit_runtime *rt) {
+    pit_callstack_entry *ent = NULL;
+    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 */
+    }
+}
+
 /* run one instruction of the VM */
 bool pit_vm_run_one(pit_runtime *rt) {
     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;
-    }
-    // fprintf(stderr, "code: "); pit_dump_to_file(rt, stderr, ent->code, false); fprintf(stderr, "\n");
+    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);
-    if (ins == PIT_NIL) {
-        pit_error(rt, "malformed vm instruction");
-        return false;
-    }
-    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");
+    // 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"); return false; }
+    ent->code = pit_value_cons_cdr(rt, ent->code);
     pit_value op = pit_value_cons_car(rt, ins);
     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_erase_empty(rt);
+        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)));
         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;
     } 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");
-        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 +180,11 @@ 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) {
+            pit_gc(rt); /* TODO hack to avoid running GC during macroexpansion */
+        }
+    }
     return vm_pop(rt);
 }