pit: Backtraces

9 files changed, 62 insertions, 33 deletions

diff --git a/pit/include/lcq/pit/runtime.h b/pit/include/lcq/pit/runtime.h
index b9143cf..a55c2d2 100644
--- a/pit/include/lcq/pit/runtime.h
+++ b/pit/include/lcq/pit/runtime.h
@@ -31,6 +31,13 @@ PIT_DECLARE_HASHTABLE(pit_ref, pit_annotation)
 void pit_annotation_set(struct pit_runtime *rt, pit_ref ref, pit_annotation annotation);
 pit_annotation *pit_annotation_get(struct pit_runtime *rt, pit_ref ref);
 
+/* entry in the backtrace */
+typedef struct {
+    pit_value val;
+    pit_annotation ann;
+} pit_backtrace_entry;
+PIT_DECLARE_VEC(pit_backtrace_entry)
+
 /* entries on a stack used when traversing trees of values */
 typedef struct {
     enum {
@@ -63,6 +70,7 @@ typedef struct pit_runtime {
     pit_vec(pit_value) *expr_stack; /* stack of subexpressions to evaluate during evaluation */
     pit_vec(pit_value) *result_stack; /* stack of intermediate values during evaluation */
     pit_vec(pit_traversal_entry) *traversal; /* intermediate stack used during tree traversal */
+    pit_vec(pit_backtrace_entry) *backtrace; /* stack of enclosing function calls */
     /* bookkeeping */
     /* "frozen" values offsets: values before these offsets are immutable, and we can reset here later */
     i64 frozen_values, frozen_symtab;
diff --git a/pit/include/lcq/pit/runtime/dump.h b/pit/include/lcq/pit/runtime/dump.h
index 2aeba2f..600604e 100644
--- a/pit/include/lcq/pit/runtime/dump.h
+++ b/pit/include/lcq/pit/runtime/dump.h
@@ -3,9 +3,17 @@
 
 #include <lcq/pit/runtime.h>
 
-typedef i64 (*pit_dump_callback)(u8 *buf, i64 len, void *data);
+typedef enum {
+    PIT_DUMP_CONDITION_NORMAL = 0,
+    PIT_DUMP_CONDITION_FULL = -1,
+    PIT_DUMP_CONDITION_STACK_UNDERFLOW = -2,
+    PIT_DUMP_CONDITION_STACK_OVERFLOW = -3,
+    PIT_DUMP_CONDITION_MALFORMED_TRAVERSAL = -4,
+} pit_dump_condition;
 
-void pit_dump_with_callback(pit_runtime *rt, pit_value top, bool readable, pit_dump_callback write, void *data);
+typedef pit_dump_condition (*pit_dump_callback)(u8 *buf, i64 len, void *data);
+
+pit_dump_condition pit_dump_with_callback(pit_runtime *rt, pit_value top, bool readable, pit_dump_callback write, void *data);
 
 /* pretty-print a pit value
    if readable is true, try to produce output that can be machine-read (quotes on strings, etc) */
diff --git a/pit/src/native.c b/pit/src/native.c
index 89d9c9b..2ffba0a 100644
--- a/pit/src/native.c
+++ b/pit/src/native.c
@@ -23,9 +23,9 @@ i64 pit_lex_file(pit_lexer *ret, char *path) {
     return 0;
 }
 
-static i64 pit_dump_to_file_callback(u8 *buf, i64 len, void *data) {
-    if (fwrite(buf, sizeof(u8), (size_t) len, (FILE *) data) != (size_t) len) return -1;
-    return 0;
+static pit_dump_condition pit_dump_to_file_callback(u8 *buf, i64 len, void *data) {
+    if (fwrite(buf, sizeof(u8), (size_t) len, (FILE *) data) != (size_t) len) return PIT_DUMP_CONDITION_FULL;
+    return PIT_DUMP_CONDITION_NORMAL;
 }
 void pit_dump_to_file(pit_runtime *rt, void *vf, pit_value v, bool readable) {
     pit_dump_with_callback(rt, v, readable, pit_dump_to_file_callback, vf);
@@ -33,16 +33,19 @@ void pit_dump_to_file(pit_runtime *rt, void *vf, pit_value v, bool readable) {
 
 bool pit_runtime_print_error(pit_runtime *rt) {
     if (!pit_value_eq(rt->error, PIT_NIL)) {
-        // for (i64 i = 0; i < rt->backtrace->next; ++i) {
-        //     pit_annotated_ref *a = pit_vec_get(pit_annotated_ref)(rt->backtrace, i);
-        //     if (a == NULL) continue;
-        //     fprintf(stderr, "on line %ld, column %ld\n", a->annotation.line, a->annotation.column);
-        // }
-        fprintf(stderr, "error at line %ld, column %ld:", rt->error_line, rt->error_column);
+        for (i64 i = 0; i < rt->backtrace->next; ++i) {
+            pit_backtrace_entry *a = pit_vec_get(pit_backtrace_entry)(rt->backtrace, i);
+            if (a == NULL) continue;
+            fprintf(stderr, "on line %ld, column %ld (call to ", a->ann.line, a->ann.column);
+            pit_dump_to_file(rt, stderr, a->val, false);
+            fprintf(stderr, "):\n");
+        }
+        fprintf(stderr, "error at line %ld, column %ld: ", rt->error_line, rt->error_column);
         pit_dump_to_file(rt, stderr, rt->error, false);
         fprintf(stderr, "\n");
         return true;
     }
+    pit_vec_reset(pit_backtrace_entry)(rt->backtrace);
     return false;
 }
 
diff --git a/pit/src/runtime.c b/pit/src/runtime.c
index 1e4309e..b8ac178 100644
--- a/pit/src/runtime.c
+++ b/pit/src/runtime.c
@@ -42,6 +42,7 @@ pit_runtime *pit_runtime_new(u8 *buf, i64 len) {
     ret->expr_stack = pit_vec_new(pit_value)(pit_arena_alloc_back(a, stack_size), stack_size);
     ret->result_stack = pit_vec_new(pit_value)(pit_arena_alloc_back(a, stack_size), stack_size);
     ret->traversal = pit_vec_new(pit_traversal_entry)(pit_arena_alloc_back(a, stack_size), stack_size);
+    ret->backtrace = pit_vec_new(pit_backtrace_entry)(pit_arena_alloc_back(a, stack_size), stack_size);
     ret->saved_bindings = pit_vec_new(pit_value)(pit_arena_alloc_back(a, stack_size), stack_size);
     ret->frozen_values = 0;
     ret->frozen_symtab = 0;
@@ -76,7 +77,7 @@ void pit_error(pit_runtime *rt, char *format, ...) {
         char buf[1024] = {0};
         va_list vargs;
         va_start(vargs, format);
-        pit_libc_string_snprintf(buf, sizeof(buf), format, vargs);
+        pit_libc_string_vsnprintf(buf, sizeof(buf), format, vargs);
         va_end(vargs);
         rt->error = PIT_T; /* we set the error now to prevent infinite recursion */
         rt->error = pit_value_bytes_new_cstr(rt, buf); /* in case this errs also */
diff --git a/pit/src/runtime/dump.c b/pit/src/runtime/dump.c
index e8ba4b0..0bd605e 100644
--- a/pit/src/runtime/dump.c
+++ b/pit/src/runtime/dump.c
@@ -1,7 +1,7 @@
 #include <lcq/pit/utils.h>
 #include <lcq/pit/runtime/dump.h>
 
-void pit_dump_with_callback(
+pit_dump_condition pit_dump_with_callback(
     pit_runtime *rt, pit_value top, bool readable,
     pit_dump_callback write, void *data
 ) {
@@ -10,17 +10,17 @@ void pit_dump_with_callback(
     i64 slen = 0;
     i64 traversal_reset = rt->traversal->next;
     pit_value_heavy *h = NULL;
+    pit_dump_condition ret = PIT_DUMP_CONDITION_NORMAL;
     pit_traversal_push_value(rt, rt->traversal, top);
     while (rt->traversal->next > traversal_reset) {
         pit_traversal_entry ent;
-        if (rt->error != PIT_NIL) goto end;
-        if (pit_vec_pop(pit_traversal_entry)(rt->traversal, &ent) < 0)
-            pit_error(rt, "dump stack underflow");
-        if (rt->error != PIT_NIL) goto end;
+        if (pit_vec_pop(pit_traversal_entry)(rt->traversal, &ent) < 0) {
+            ret = PIT_DUMP_CONDITION_STACK_UNDERFLOW;
+            goto end;
+        }
         switch (ent.sort) {
         case PIT_TRAVERSAL_ENTRY_DUMP_STRING: {
-            if (write((u8 *) ent.in.dump_string, (i64) pit_libc_string_strlen(ent.in.dump_string), data) < 0)
-                goto end;
+            if ((ret = write((u8 *) ent.in.dump_string, (i64) pit_libc_string_strlen(ent.in.dump_string), data)) < 0) goto end;
             break;
         }
         case PIT_TRAVERSAL_ENTRY_VALUE: {
@@ -32,11 +32,11 @@ void pit_dump_with_callback(
 #else
                 slen = pit_libc_string_snprintf(buf, (size_t) len, "<unsupported double>");
 #endif
-                if (write((u8 *) buf, slen, data) < 0) goto end;
+                if ((ret = write((u8 *) buf, slen, data)) < 0) goto end;
                 break;
             case PIT_VALUE_SORT_INTEGER:
                 slen = pit_libc_string_snprintf(buf, (size_t) len, "%ld", pit_value_as_integer(rt, v));
-                if (write((u8 *) buf, slen, data) < 0) goto end;
+                if ((ret = write((u8 *) buf, slen, data)) < 0) goto end;
                 break;
             case PIT_VALUE_SORT_SYMBOL: {
                 pit_symtab_entry *se = pit_symtab_lookup(rt, v);
@@ -44,10 +44,10 @@ void pit_dump_with_callback(
                     && pit_value_sort(se->name) == PIT_VALUE_SORT_REF
                     && (h = pit_value_ref_deref(rt, pit_value_as_ref(rt, se->name)))
                 ) {
-                    if (write(h->in.bytes.data, h->in.bytes.len, data) < 0) goto end;
+                    if ((ret = write(h->in.bytes.data, h->in.bytes.len, data)) < 0) goto end;
                 } else {
                     slen = pit_libc_string_snprintf(buf, (size_t) len, "<broken symbol %ld>", pit_value_as_symbol(rt, v));
-                    if (write((u8 *) buf, slen, data) < 0) goto end;
+                    if ((ret = write((u8 *) buf, slen, data)) < 0) goto end;
                 }
                 break;
             }
@@ -56,7 +56,7 @@ void pit_dump_with_callback(
                 h = pit_value_ref_deref(rt, r);
                 if (!h) {
                     pit_libc_string_snprintf(buf, (size_t) len, "<ref %ld>", r);
-                    if (write((u8 *) buf, slen, data) < 0) goto end;
+                    if ((ret = write((u8 *) buf, slen, data)) < 0) goto end;
                 } else {
                     switch (h->hsort) {
                     case PIT_VALUE_HEAVY_SORT_CELL: {
@@ -71,7 +71,7 @@ void pit_dump_with_callback(
                         bool first = true;
                         while (xs != PIT_NIL && pit_value_is_cons(rt, xs)) {
                             if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons_car(rt, xs)) < 0) {
-                                pit_error(rt, "dump expr stack overflow");
+                                ret = PIT_DUMP_CONDITION_STACK_OVERFLOW;
                                 goto end;
                             }
                             xs = pit_value_cons_cdr(rt, xs);
@@ -86,7 +86,7 @@ void pit_dump_with_callback(
                             else pit_traversal_push_dump_string(rt, rt->traversal, " ");
                             pit_value x = PIT_NIL;
                             if (pit_vec_pop(pit_value)(rt->expr_stack, &x) < 0) {
-                                pit_error(rt, "dump expr stack underflow");
+                                ret = PIT_DUMP_CONDITION_STACK_UNDERFLOW;
                                 goto end;
                             }
                             pit_traversal_push_value(rt, rt->traversal, x);
@@ -119,12 +119,12 @@ void pit_dump_with_callback(
                             }
                         }
                         if (readable && i < len - 1) buf[i++] = '"';
-                        if (write((u8 *) buf, i, data) < 0) goto end;
+                        if ((ret = write((u8 *) buf, i, data)) < 0) goto end;
                         break;
                     }
                     default:
                         slen = pit_libc_string_snprintf(buf, (size_t) len, "<ref %ld>", r);
-                        if (write((u8 *) buf, slen, data) < 0) goto end;
+                        if ((ret = write((u8 *) buf, slen, data)) < 0) goto end;
                     }
                 }
                 break;
@@ -133,11 +133,13 @@ void pit_dump_with_callback(
             break;
         }
         default:
-            pit_error(rt, "unexpected traversal entry"); goto end;
+            ret = PIT_DUMP_CONDITION_MALFORMED_TRAVERSAL;
+            goto end;
         }
     }
 end:
     rt->traversal->next = traversal_reset;
+    return ret;
 }
 
 struct pit_dump_to_buf_closure {
@@ -145,15 +147,15 @@ struct pit_dump_to_buf_closure {
     i64 len;
     i64 off;
 };
-static i64 pit_dump_to_buf_callback(u8 *buf, i64 len, void *data) {
+static pit_dump_condition pit_dump_to_buf_callback(u8 *buf, i64 len, void *data) {
     struct pit_dump_to_buf_closure *cl = (struct pit_dump_to_buf_closure *) data;
     i64 i = 0;
     for (; i < len && cl->off + i < cl->len; ++i) {
         cl->buf[cl->off + i] = (char) buf[i];
     }
     cl->off += i;
-    if (cl->len - cl->off < len) return -1;
-    return 0;
+    if (cl->len - cl->off < len) return PIT_DUMP_CONDITION_FULL;
+    return PIT_DUMP_CONDITION_NORMAL;
 }
 
 i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) {
diff --git a/pit/src/runtime/eval.c b/pit/src/runtime/eval.c
index f923760..44c9a57 100644
--- a/pit/src/runtime/eval.c
+++ b/pit/src/runtime/eval.c
@@ -82,9 +82,12 @@ pit_value pit_eval(pit_runtime *rt, pit_value top) {
                 args = pit_value_cons(rt, a, args);
             }
             if (ent->in.application.annotation != NULL) {
+                pit_backtrace_entry be;
+                be.val = f;
+                be.ann = *ent->in.application.annotation;
                 rt->source_line = ent->in.application.annotation->line;
                 rt->source_column = ent->in.application.annotation->column;
-                // pit_vec_push(pit_annotated_ref)(rt->backtrace, *ent->in.application.annotation);
+                pit_vec_push(pit_backtrace_entry)(rt->backtrace, be);
             }
             if (pit_vec_push(pit_value)(rt->result_stack, pit_value_apply(rt, f, args)) < 0)
                 pit_error(rt, "evaluation result stack underflow");
diff --git a/pit/src/runtime/value/cell.c b/pit/src/runtime/value/cell.c
index 34b9226..a9cbe72 100644
--- a/pit/src/runtime/value/cell.c
+++ b/pit/src/runtime/value/cell.c
@@ -11,6 +11,7 @@ pit_value pit_value_cell_new(pit_runtime *rt, pit_value v) {
     h->in.cell = v;
     return ret;
 }
+#include <stdio.h>
 pit_value pit_value_cell_get(pit_runtime *rt, pit_value cell, pit_value sym) {
     if (pit_value_sort(cell) != PIT_VALUE_SORT_REF) {
         char buf[256];
diff --git a/pit/src/utils.c b/pit/src/utils.c
index 75d59a6..a1716b1 100644
--- a/pit/src/utils.c
+++ b/pit/src/utils.c
@@ -1,4 +1,5 @@
 #include <lcq/pit/utils.h>
+#include <stdio.h>
 
 enum vsnprintf_mode {
     VSNPRINTF_MODE_NORMAL,
diff --git a/pit/test/backtrace.pit b/pit/test/backtrace.pit
new file mode 100644
index 0000000..8a44951
--- /dev/null
+++ b/pit/test/backtrace.pit
@@ -0,0 +1,2 @@
+(defun! foo (x) (* x 2))
+(foo "bar")
\ No newline at end of file