pit: Improve backtraces

6 files changed, 40 insertions, 18 deletions

diff --git a/pit/include/lcq/pit/runtime/value.h b/pit/include/lcq/pit/runtime/value.h
index fa59a46..e3596fe 100644
--- a/pit/include/lcq/pit/runtime/value.h
+++ b/pit/include/lcq/pit/runtime/value.h
@@ -36,7 +36,8 @@ typedef struct {
         struct { pit_value car, cdr; } cons;
         struct { pit_value *data; i64 len; } array;
         struct { u8 *data; i64 len; } bytes;
-        struct { pit_value env; pit_value args; pit_value arg_rest_nm; pit_value body; } func;
+        struct { pit_value nm; pit_value closure; } func; /* pit array of env, args, arg_rest_nm, body */
+        // struct { pit_value env; pit_value args; pit_value arg_rest_nm; pit_value body; } func;
         struct { pit_nativefunc f; void *data; } nativefunc;
         struct { pit_value tag; void *data; } nativedata;
         i64 forwarding_pointer;
diff --git a/pit/src/runtime/dump.c b/pit/src/runtime/dump.c
index 0bd605e..9627a36 100644
--- a/pit/src/runtime/dump.c
+++ b/pit/src/runtime/dump.c
@@ -122,9 +122,26 @@ pit_dump_condition pit_dump_with_callback(
                         if ((ret = write((u8 *) buf, i, data)) < 0) goto end;
                         break;
                     }
+                    case PIT_VALUE_HEAVY_SORT_FUNC: {
+                        if (h->in.func.nm == PIT_NIL) {
+                            slen = pit_libc_string_snprintf(buf, (size_t) len, "<anonymous function: %ld>", r);
+                            if ((ret = write((u8 *) buf, slen, data)) < 0) goto end;
+                        } else {
+                            pit_traversal_push_dump_string(rt, rt->traversal, ">");
+                            pit_traversal_push_value(rt, rt->traversal, h->in.func.nm);
+                            pit_traversal_push_dump_string(rt, rt->traversal, "<function: ");
+                        }
+                        break;
+                    }
+                    case PIT_VALUE_HEAVY_SORT_NATIVEFUNC: {
+                        slen = pit_libc_string_snprintf(buf, (size_t) len, "<native function: %ld>", r);
+                        if ((ret = write((u8 *) buf, slen, data)) < 0) goto end;
+                        break;
+                    }
                     default:
-                        slen = pit_libc_string_snprintf(buf, (size_t) len, "<ref %ld>", r);
+                        slen = pit_libc_string_snprintf(buf, (size_t) len, "<ref: %ld>", r);
                         if ((ret = write((u8 *) buf, slen, data)) < 0) goto end;
+                        break;
                     }
                 }
                 break;
diff --git a/pit/src/runtime/gc.c b/pit/src/runtime/gc.c
index 671202d..0880592 100644
--- a/pit/src/runtime/gc.c
+++ b/pit/src/runtime/gc.c
@@ -76,10 +76,8 @@ void pit_gc(pit_runtime *rt) {
             break;
         }
         case PIT_VALUE_HEAVY_SORT_FUNC:
-            h->in.func.env = gc_copy_value(rt, h->in.func.env);
-            h->in.func.args = gc_copy_value(rt, h->in.func.args);
-            h->in.func.arg_rest_nm = gc_copy_value(rt, h->in.func.arg_rest_nm);
-            h->in.func.body = gc_copy_value(rt, h->in.func.body);
+            h->in.func.nm = gc_copy_value(rt, h->in.func.nm);
+            h->in.func.closure = gc_copy_value(rt, h->in.func.closure);
             break;
         case PIT_VALUE_HEAVY_SORT_NATIVEFUNC: break;
         case PIT_VALUE_HEAVY_SORT_NATIVEDATA:
diff --git a/pit/src/runtime/symtab.c b/pit/src/runtime/symtab.c
index d2bc51e..33ed3ba 100644
--- a/pit/src/runtime/symtab.c
+++ b/pit/src/runtime/symtab.c
@@ -72,6 +72,12 @@ void pit_symtab_fset(pit_runtime *rt, pit_value sym, pit_value v) {
     if (pit_value_sort(ent->function) != PIT_VALUE_SORT_REF) {
         ent->function = pit_value_cell_new(rt, PIT_NIL);
     }
+    if (pit_value_sort(v) == PIT_VALUE_SORT_REF) {
+        pit_value_heavy *h = pit_value_ref_deref(rt, pit_value_as_ref(rt, v));
+        if (h && h->hsort == PIT_VALUE_HEAVY_SORT_FUNC) {
+            h->in.func.nm = sym;
+        }
+    }
     pit_value_cell_set(rt, ent->function, v, sym);
 }
 bool pit_symtab_is_symbol_macro(pit_runtime *rt, pit_value sym) {
diff --git a/pit/src/runtime/value.c b/pit/src/runtime/value.c
index 1e9d543..b32d154 100644
--- a/pit/src/runtime/value.c
+++ b/pit/src/runtime/value.c
@@ -56,10 +56,8 @@ bool pit_value_equal(pit_runtime *rt, pit_value a, pit_value b) {
             return true;
         }
         case PIT_VALUE_HEAVY_SORT_FUNC:
-            return
-                pit_value_equal(rt, ha->in.func.env, hb->in.func.env)
-                && pit_value_equal(rt, ha->in.func.args, hb->in.func.args)
-                && pit_value_equal(rt, ha->in.func.body, hb->in.func.body);
+            return pit_value_equal(rt, ha->in.func.nm, hb->in.func.nm)
+                && pit_value_equal(rt, ha->in.func.closure, hb->in.func.closure);
         case PIT_VALUE_HEAVY_SORT_NATIVEFUNC:
             return ha->in.nativefunc.f == hb->in.nativefunc.f
                 && ha->in.nativefunc.data == hb->in.nativefunc.data;
diff --git a/pit/src/runtime/value/func.c b/pit/src/runtime/value/func.c
index af039eb..3843553 100644
--- a/pit/src/runtime/value/func.c
+++ b/pit/src/runtime/value/func.c
@@ -94,10 +94,9 @@ pit_value pit_value_func_lambda(pit_runtime *rt, pit_value args, pit_value body)
         }
     }
     arg_cells = pit_value_list_reverse(rt, arg_cells);
-    h->in.func.args = arg_cells;
-    h->in.func.arg_rest_nm = arg_rest_nm;
-    h->in.func.env = env;
-    h->in.func.body = expanded;
+    pit_value closure[4] = {env, arg_cells, arg_rest_nm, expanded};
+    h->in.func.nm = PIT_NIL;
+    h->in.func.closure = pit_value_array_from_buf(rt, closure, 4);
     return ret;
 }
 pit_value pit_value_nativefunc_new_with_data(pit_runtime *rt, pit_nativefunc f, void *data) {
@@ -127,7 +126,11 @@ pit_value pit_value_apply(pit_runtime *rt, pit_value f, pit_value args) {
         if (h->hsort == PIT_VALUE_HEAVY_SORT_FUNC) {
             /* calling a Lisp function is simple! */
             pit_value bound = PIT_NIL;
-            pit_value env = h->in.func.env;
+            pit_value env = pit_value_array_get(rt, h->in.func.closure, 0);
+            pit_value anames = pit_value_array_get(rt, h->in.func.closure, 1);
+            pit_value arg_rest_nm = pit_value_array_get(rt, h->in.func.closure, 2);
+            pit_value body = pit_value_array_get(rt, h->in.func.closure, 3);
+            if (rt->error != PIT_NIL) return PIT_NIL;
             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);
@@ -135,11 +138,10 @@ pit_value pit_value_apply(pit_runtime *rt, pit_value f, pit_value args) {
                 bound = pit_value_cons(rt, nm, bound);
                 env = pit_value_cons_cdr(rt, env);
             }
-            pit_value anames = h->in.func.args;
             while (anames != PIT_NIL) { /* bind all argument names to their values */
                 pit_value nm = pit_value_cons_car(rt, anames);
                 pit_value cell = pit_value_cell_new(rt, PIT_NIL);
-                if (h->in.func.arg_rest_nm != PIT_NIL && pit_value_eq(nm, h->in.func.arg_rest_nm)) {
+                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);
                     break;
@@ -151,7 +153,7 @@ pit_value pit_value_apply(pit_runtime *rt, pit_value f, pit_value args) {
                 args = pit_value_cons_cdr(rt, args);
                 anames = pit_value_cons_cdr(rt, anames);
             }
-            pit_value ret = pit_eval(rt, h->in.func.body); /* evaluate the body */
+            pit_value ret = pit_eval(rt, body); /* evaluate the body */
             while (bound != PIT_NIL) { /* unbind everything we bound earlier, in reverse */
                 pit_symtab_unbind(rt, pit_value_cons_car(rt, bound));
                 bound = pit_value_cons_cdr(rt, bound);