aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitignore2
-rw-r--r--Readme.md1
-rw-r--r--src/interp.c41
-rw-r--r--src/interp.h4
-rw-r--r--src/main.c8
-rw-r--r--src/parser.c8
-rw-r--r--src/primitives.c6
-rw-r--r--src/sexp.h2
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 {
generated by cgit v1.0 at 2025-12-29 14:01:31 +0000