add stacktracec

8 files changed, 68 insertions, 4 deletions

diff --git a/.gitignore b/.gitignore
index b98bb47..ba23bfc 100644
--- a/.gitignore
+++ b/.gitignore
@@ -7,7 +7,7 @@ compile_commands.json
 .cache
 todo
 fibo.lisp
-debug.lisp
+debug*
 perf.data
 perf.data.old
 web-*
diff --git a/Readme.md b/Readme.md
index d409fce..c10512b 100644
--- a/Readme.md
+++ b/Readme.md
@@ -16,6 +16,7 @@ There is a WebAssembly build, you can [try it online](https://mistivia.github.io
 - Writing macro is easy with quasiquote, unquote, and slicing-unquote
 - No global state, you can run multiple interpreters in multiple threads
 - Exception and try-catch
+- Stacktrace for debugging
 - Support C-like control flow statements
     - return
     - break
diff --git a/src/interp.c b/src/interp.c
index b1d43fa..0af16de 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -61,6 +61,20 @@ void print_lisp_error(Interp *interp, SExpRef err) {
     }
 }
 
+const char *lisp_stacktrace_to_string(Interp *interp, SExpRef stacktrace) {
+    str_builder_t sb;
+    init_str_builder(&sb);
+    str_builder_append(&sb, "Stacktrace:\n");
+    for (SExpRef iter = stacktrace; !NILP(iter); iter = CDR(iter)) {
+        SExpRef i = CAR(iter);
+        SExpRef filename = CAR(i);
+        SExpRef linenum = CADR(i);
+        SExpRef sym = CADDR(i);
+        str_builder_append(&sb, "    %s:%d %s\n", REF(filename)->str, REF(linenum)->integer, REF(sym)->str);
+    }
+    return sb.buf;
+}
+
 void Interp_init(Interp *self) {
     self->recursion_depth = 0;
     self->gensym_cnt = 42;
@@ -103,6 +117,7 @@ void Interp_init(Interp *self) {
 
     self->stack = lisp_cons(self, self->top_level, self->nil);
     self->reg = self->nil;
+    self->stacktrace = self->nil;
 
     Interp_add_primitive(self, "eval", primitive_eval);
     Interp_add_primitive(self, "apply", primitive_apply);
@@ -295,6 +310,10 @@ SExpRef Interp_load_file(Interp *interp, const char *filename) {
     Parser_set_file(interp->parser, fp);
     SExpRef sexp, ret;
     ParseResult parse_result;
+    SExpRef old_filename = interp->filename;
+    int old_linenum = interp->linenum;
+    interp->filename = new_string(interp, filename);
+    interp->linenum = 1;
     while (1) {
         parse_result = parse_sexp(interp->parser);
         if (parse_result.errmsg != NULL) {
@@ -315,6 +334,8 @@ SExpRef Interp_load_file(Interp *interp, const char *filename) {
         if (Parser_is_end(interp->parser)) goto end;
     }
 end:
+    interp->filename = old_filename;
+    interp->linenum = old_linenum;
     fclose(fp);
     return ret;
 }
@@ -379,6 +400,7 @@ void Interp_gc(Interp *interp, SExpRef tmproot) {
     SExpPtrVector_push_back(&gcstack, REF(interp->stack));
     SExpPtrVector_push_back(&gcstack, REF(interp->top_level));
     SExpPtrVector_push_back(&gcstack, REF(interp->reg));
+    SExpPtrVector_push_back(&gcstack, REF(interp->stacktrace));
     // mark
     while (!SExpPtrVector_empty(&gcstack)) {
         SExpPtr obj = *SExpPtrVector_last(&gcstack);
@@ -392,6 +414,8 @@ void Interp_gc(Interp *interp, SExpRef tmproot) {
             if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
             child = REF(obj->pair.cdr);
             if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
+            child = REF(obj->pair.filename);
+            if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
         } else if (obj->type == kFuncSExp) {
             child = REF(obj->func.args);
             if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
@@ -476,6 +500,8 @@ SExpRef lisp_cons(Interp *interp, SExpRef a, SExpRef b) {
     REF(obj)->type = kPairSExp;
     REF(obj)->pair.car = a;
     REF(obj)->pair.cdr = b;
+    REF(obj)->pair.filename = NIL;
+    REF(obj)->pair.line = -1;
     return obj;
 }
 
@@ -893,6 +919,9 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) {
         goto end;
     }
     SExpRef fn, funcallargs, args;
+    SExpRef filename = NIL;
+    SExpRef sym = NIL;
+    int line = -1;
     if (type == kPairSExp) {
         if (!lisp_check_list(interp, sexp)) {
             ret = new_error(interp, "eval: list not proper.\n");
@@ -902,6 +931,11 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) {
             ret = new_error(interp, "eval: first elem must be a symbol.\n");
             goto end;
         }
+        if (!NILP(REF(sexp)->pair.filename)) {
+            line = REF(sexp)->pair.line;
+            filename = REF(sexp)->pair.filename;
+            sym = REF(sexp)->pair.car;
+        }
         SExpRef symbol = CAR(sexp);
         fn = lisp_lookup_func(interp, symbol);
         if (CTL_FL(fn)) {
@@ -946,6 +980,13 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) {
     }
     ret = new_error(interp, "eval: unknown syntax.\n");
 end:
+    if (VALTYPE(ret) == kErrSignal || VALTYPE(ret) == kExceptionSignal) {
+        if (!NILP(filename)) {
+            interp->stacktrace =
+                CONS(CONS(filename, CONS(new_integer(interp, line), CONS(sym, NIL))),
+                     interp->stacktrace);
+        }
+    }
     POP_REG();
     Interp_gc(interp, ret);
     interp->recursion_depth--;
diff --git a/src/interp.h b/src/interp.h
index 515da15..1acd983 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -27,6 +27,9 @@ struct interp {
     SExpRef reg;
     SExpRef top_level;
     SExpRef nil;
+    SExpRef stacktrace;
+    SExpRef filename;
+    int32_t linenum;
     char *errmsg_buf;
     Parser *parser;
     int gensym_cnt;
@@ -75,6 +78,7 @@ SExpRef Interp_load_file(Interp *interp, const char *filename);
 #define PUSH_REG(_x) { interp->reg = CONS((_x), interp->reg); }
 #define POP_REG() { interp->reg = CDR(interp->reg);  }
 
+const char *lisp_stacktrace_to_string(Interp *interp, SExpRef stacktrace);
 const char* lisp_to_string(Interp *interp, SExpRef val);
 SExpRef lisp_macroexpand1(Interp *interp, SExpRef macro, SExpRef args);
 SExpRef lisp_nreverse(Interp *interp, SExpRef lst);
diff --git a/src/main.c b/src/main.c
index 334f761..250e3d3 100644
--- a/src/main.c
+++ b/src/main.c
@@ -15,12 +15,20 @@ int main(int argc, char **argv) {
         SExpRef ret = Interp_load_file(&interp, filename);
         if (Interp_ref(&interp, ret)->type == kErrSignal) {
             fprintf(stderr, "Error: %s", Interp_ref(&interp, ret)->str);
+            const char *stacktrace = lisp_stacktrace_to_string(&interp, interp.stacktrace);
+            fprintf(stderr, "%s", stacktrace);
+            free((void*)stacktrace);
+            interp.stacktrace = interp.nil;
             mainret = -1; goto end;
         }
         if (Interp_ref(&interp, ret)->type == kExceptionSignal) {
             const char *exception_str = lisp_to_string(&interp, Interp_ref(&interp, ret)->ret);
             fprintf(stderr, "Uncatched exception: %s\n", exception_str);
             free((void*)exception_str);
+            const char *stacktrace = lisp_stacktrace_to_string(&interp, interp.stacktrace);
+            fprintf(stderr, "%s", stacktrace);
+            free((void*)stacktrace);
+            interp.stacktrace = interp.nil;
             mainret = -1; goto end;
         }
         if (Interp_ref(&interp, ret)->type == kBreakSignal
diff --git a/src/parser.c b/src/parser.c
index ec21b44..f21c90b 100644
--- a/src/parser.c
+++ b/src/parser.c
@@ -103,7 +103,9 @@ int Parser_getchar(Parser *ctx) {
         ctx->str_cursor++;
         return ret;
     } else if (ctx->parse_type == kParseFile) {
-        return fgetc(ctx->fp);
+        int ret = fgetc(ctx->fp);
+        if (ret == '\n') ctx->ctx->linenum++;
+        return ret;
 #ifdef WITHREADLINE
     } else if (ctx->parse_type == kParseReadline) {
         if (ctx->readline_eof) return EOF;
@@ -240,6 +242,8 @@ static SExpRef build_list_from_vector(Interp *ctx, SExpRefVector elems) {
         SExpRef cur = *SExpRefVector_ref(&elems, i);
         ret = lisp_cons(ctx, cur, ret);
     }
+    Interp_ref(ctx, ret)->pair.filename = ctx->filename;
+    Interp_ref(ctx, ret)->pair.line = ctx->linenum;
     return ret;
 }
 
@@ -247,9 +251,9 @@ ParseResult parse_list(Parser *parser) {
     SExpRefVector elems;
     SExpRefVector_init(&elems);
     ParseResult ret;
-
     ret = expect_char(parser, '(');
     if (ParseResult_is_err(ret)) goto end;
+    int line = parser->ctx->linenum;
     skip_blank(parser);
     while (1) {
         if (Parser_peek(parser) == EOF) {
diff --git a/src/primitives.c b/src/primitives.c
index e5e65e3..971aa87 100644
--- a/src/primitives.c
+++ b/src/primitives.c
@@ -15,7 +15,10 @@ SExpRef primitive_assert_exception(Interp *interp, SExpRef args, bool istail) {
 
 SExpRef primitive_assert_error(Interp *interp, SExpRef args, bool istail) {
     SExpRef eargs = lisp_eval_args(interp, args);
-    if (VALTYPE(eargs) == kErrSignal) return interp->t;
+    if (VALTYPE(eargs) == kErrSignal) {
+        interp->stacktrace = NIL;
+        return interp->t;
+    }
 
     const char *expstr = lisp_to_string(interp, CAR(args));
     SExpRef ret = new_error(interp, "assert-error failed, no error: %s.\n", expstr);
@@ -37,6 +40,7 @@ SExpRef primitive_try(Interp *interp, SExpRef args, bool istail) {
         return new_error(interp, "try: syntax error, catch is not a function.\n");
     }
     if (VALTYPE(ret) == kExceptionSignal) {
+        interp->stacktrace = NIL;
         PUSH_REG(catch_func);
         ret = lisp_apply(interp, catch_func, CONS(REF(ret)->ret, NIL), istail);
         POP_REG();
diff --git a/src/sexp.h b/src/sexp.h
index d8d2dc9..ce47362 100644
--- a/src/sexp.h
+++ b/src/sexp.h
@@ -16,6 +16,8 @@ typedef struct {
 typedef struct {
     SExpRef car;
     SExpRef cdr;
+    SExpRef filename;
+    int32_t line;
 } SExpPair;
 
 typedef struct {