From 9a4f460d6dd476767ea211c879f115e127ee2410 Mon Sep 17 00:00:00 2001 From: Mistivia Date: Sat, 28 Jun 2025 19:54:37 +0800 Subject: exception & try-catch --- Readme.md | 1 + src/builtins.c | 5 +++++ src/builtins.h | 1 + src/interp.c | 33 +++++++++++++++++++++++++++++---- src/interp.h | 2 ++ src/main.c | 6 ++++++ src/primitives.c | 39 +++++++++++++++++++++++++++++++++++++-- src/primitives.h | 2 ++ src/sexp.h | 1 + tests/error.lisp | 20 ++++++++++++++++++++ 10 files changed, 104 insertions(+), 6 deletions(-) diff --git a/Readme.md b/Readme.md index 689e7a6..df63a2c 100644 --- a/Readme.md +++ b/Readme.md @@ -15,6 +15,7 @@ There is a WebAssembly build, you can [try it online](https://mistivia.github.io - A simple mark-sweep GC - 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 - Support C-like control flow statements - return - break diff --git a/src/builtins.c b/src/builtins.c index e39dfa4..9f605c1 100644 --- a/src/builtins.c +++ b/src/builtins.c @@ -7,6 +7,11 @@ #include #include +SExpRef builtin_throw(Interp *interp, SExpRef args) { + if (LENGTH(args) != 1) return new_error(interp, "throw: syntax error.\n"); + return new_exception(interp, CAR(args)); +} + SExpRef builtin_functionp(Interp *interp, SExpRef args) { if (LENGTH(args) != 1) { return new_error(interp, "function?: args num error.\n"); diff --git a/src/builtins.h b/src/builtins.h index 1a8e927..9cac797 100644 --- a/src/builtins.h +++ b/src/builtins.h @@ -106,6 +106,7 @@ SExpRef builtin_lt(Interp *interp, SExpRef args); SExpRef builtin_ge(Interp *interp, SExpRef args); SExpRef builtin_le(Interp *interp, SExpRef args); SExpRef builtin_princ(Interp *interp, SExpRef args); +SExpRef builtin_throw(Interp *interp, SExpRef args); SExpRef builtin_gcstat(Interp *interp, SExpRef args); SExpRef builtin_alwaysgc(Interp *interp, SExpRef args); diff --git a/src/interp.c b/src/interp.c index 4a6a455..b32b2d6 100644 --- a/src/interp.c +++ b/src/interp.c @@ -50,8 +50,13 @@ Interp *new_interp() { // for wasm void print_lisp_error(Interp *interp, SExpRef err) { - if (VALTYPE(err) != kErrSignal) return; - fprintf(stderr, "Error: %s", REF(err)->str); + if (VALTYPE(err) == kErrSignal) { + fprintf(stderr, "Error: %s", REF(err)->str); + } else if (VALTYPE(err) == kExceptionSignal) { + const char *exception_str = lisp_to_string(interp, REF(err)->ret); + fprintf(stderr, "Exception: %s\n", exception_str); + free((void*)exception_str); + } } void Interp_init(Interp *self) { @@ -121,9 +126,12 @@ void Interp_init(Interp *self) { Interp_add_primitive(self, "continue", primitive_continue); Interp_add_primitive(self, "assert", primitive_assert); Interp_add_primitive(self, "assert-error", primitive_assert_error); + Interp_add_primitive(self, "assert-exception", primitive_assert_exception); Interp_add_primitive(self, "load", primitive_load); + Interp_add_primitive(self, "try", primitive_try); Interp_add_primitive(self, "unwind-protect", primitive_unwind_protect); + Interp_add_userfunc(self, "throw", builtin_throw); Interp_add_userfunc(self, "function?", builtin_functionp); Interp_add_userfunc(self, "map", builtin_map); Interp_add_userfunc(self, "filter", builtin_filter); @@ -237,6 +245,11 @@ void Interp_init(Interp *self) { if (VALTYPE(ret) == kErrSignal) { fprintf(stderr, "Failed to load prelude: %s", REF(ret)->str); } + if (VALTYPE(ret) == kExceptionSignal) { + const char *exception_str = lisp_to_string(interp, Interp_ref(self, ret)->ret); + fprintf(stderr, "Failed to load prelude, uncatched exception: %s\n", exception_str); + free((void*)exception_str); + } } @@ -251,7 +264,8 @@ SExpRef Interp_eval_string(Interp *interp, const char * str) { goto end; } ret = lisp_eval(interp, parse_result.val, false); - if (Interp_ref(interp, ret)->type == kErrSignal) { + if (Interp_ref(interp, ret)->type == kErrSignal + || Interp_ref(interp, ret)->type == kExceptionSignal) { goto end; } if (Interp_ref(interp, ret)->type == kBreakSignal @@ -283,7 +297,8 @@ SExpRef Interp_load_file(Interp *interp, const char *filename) { goto end; } ret = lisp_eval(interp, parse_result.val, false); - if (Interp_ref(interp, ret)->type == kErrSignal) { + if (Interp_ref(interp, ret)->type == kErrSignal + || Interp_ref(interp, ret)->type == kExceptionSignal) { goto end; } if (Interp_ref(interp, ret)->type == kBreakSignal @@ -504,6 +519,8 @@ void lisp_to_string_impl(str_builder_t *sb, Int2IntHashTable *visited, Interp *i str_builder_append(sb, "()"); } else if (pe->type == kErrSignal) { str_builder_append(sb, ""); + } else if (pe->type == kExceptionSignal) { + str_builder_append(sb, ""); } else if (pe->type == kReturnSignal) { str_builder_append(sb, ""); } else if (pe->type == kBreakSignal) { @@ -840,6 +857,7 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) { || type == kBooleanSExp || type == kCharSExp || type == kErrSignal + || type == kExceptionSignal || type == kBreakSignal || type == kContinueSignal || type == kReturnSignal @@ -1080,6 +1098,13 @@ SExpRef new_primitive(Interp *interp, LispPrimitive val) { return ret; } +SExpRef new_exception(Interp *interp, SExpRef e) { + SExpRef ret = new_sexp(interp); + REF(ret)->type = kExceptionSignal; + REF(ret)->ret = e; + return ret; +} + SExpRef new_list2(Interp *interp, SExpRef e1, SExpRef e2) { return CONS(e1, CONS(e2, NIL)); } diff --git a/src/interp.h b/src/interp.h index 0a489cb..1d3a2b4 100644 --- a/src/interp.h +++ b/src/interp.h @@ -56,6 +56,7 @@ SExpRef Interp_load_file(Interp *interp, const char *filename); #define CTL_FL(_x) \ (REF((_x))->type == kErrSignal \ || REF((_x))->type == kReturnSignal \ + || REF((_x))->type == kExceptionSignal \ || REF((_x))->type == kBreakSignal \ || REF((_x))->type == kContinueSignal) #define VALTYPE(_x) (REF((_x))->type) @@ -118,6 +119,7 @@ SExpRef new_primitive(Interp *interp, LispPrimitive val); SExpRef new_lambda(Interp *interp, SExpRef param, SExpRef body, SExpRef env); SExpRef new_macro(Interp *interp, SExpRef param, SExpRef body); SExpRef new_tailcall(Interp *interp, SExpRef fn, SExpRef args); +SExpRef new_exception(Interp *interp, SExpRef e); SExpRef new_list1(Interp *ctx, SExpRef e1); SExpRef new_list2(Interp *ctx, SExpRef e1, SExpRef e2); SExpRef new_list3(Interp *ctx, SExpRef e1, SExpRef e2, SExpRef e3); diff --git a/src/main.c b/src/main.c index 4ebcd03..334f761 100644 --- a/src/main.c +++ b/src/main.c @@ -17,6 +17,12 @@ int main(int argc, char **argv) { fprintf(stderr, "Error: %s", Interp_ref(&interp, ret)->str); 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); + mainret = -1; goto end; + } if (Interp_ref(&interp, ret)->type == kBreakSignal || Interp_ref(&interp, ret)->type == kContinueSignal || Interp_ref(&interp, ret)->type == kReturnSignal) { diff --git a/src/primitives.c b/src/primitives.c index 9f3e670..0eadbb7 100644 --- a/src/primitives.c +++ b/src/primitives.c @@ -3,6 +3,16 @@ #include "sexp.h" #include "parser.h" +SExpRef primitive_assert_exception(Interp *interp, SExpRef args, bool istail) { + SExpRef eargs = lisp_eval_args(interp, args); + if (VALTYPE(eargs) == kExceptionSignal) return interp->t; + + const char *expstr = lisp_to_string(interp, CAR(args)); + SExpRef ret = new_error(interp, "assert-exception failed, no exception: %s.\n", expstr); + free((void*)expstr); + return ret; +} + SExpRef primitive_assert_error(Interp *interp, SExpRef args, bool istail) { SExpRef eargs = lisp_eval_args(interp, args); if (VALTYPE(eargs) == kErrSignal) return interp->t; @@ -13,6 +23,27 @@ SExpRef primitive_assert_error(Interp *interp, SExpRef args, bool istail) { return ret; } +SExpRef primitive_try(Interp *interp, SExpRef args, bool istail) { + if (LENGTH(args) != 2) { + return new_error(interp, "try: syntax error.\n"); + } + SExpRef exp = CAR(args), ctch = CADR(args); + SExpRef ret = EVAL(exp); + PUSH_REG(ret); + SExpRef catch_func = EVAL(ctch); + POP_REG(); + if (VALTYPE(catch_func) != kUserFuncSExp + && VALTYPE(catch_func) != kFuncSExp) { + return new_error(interp, "try: syntax error, catch is not a function.\n"); + } + if (VALTYPE(ret) == kExceptionSignal) { + PUSH_REG(catch_func); + ret = lisp_apply(interp, catch_func, CONS(REF(ret)->ret, NIL), istail); + POP_REG(); + } + return ret; +} + SExpRef primitive_load(Interp *interp, SExpRef args, bool istail) { if (CAR(interp->stack).idx != interp->top_level.idx) { return new_error(interp, "load: load can only be in top level.\n"); @@ -84,9 +115,11 @@ SExpRef primitive_unwind_protect(Interp *interp, SExpRef args, bool istail) { return new_error(interp, "unwind-protect: syntax error.\n"); } SExpRef ret = EVAL(CAR(args)); + PUSH_REG(ret); for (SExpRef i = CDR(args); !NILP(i); i = CDR(i)) { EVAL(CAR(i)); } + POP_REG(); return ret; } @@ -245,7 +278,7 @@ SExpRef primitive_while(Interp *interp, SExpRef args, bool istail) { nextloop: cond = EVAL(pred); if (CTL_FL(cond)) { - if (VALTYPE(cond) != kErrSignal) { + if (VALTYPE(cond) != kErrSignal && VALTYPE(cond) != kExceptionSignal) { return new_error(interp, "while: unexpected control flow.\n"); } return cond; @@ -255,7 +288,9 @@ nextloop: while (!NILP(iter)) { x = CAR(iter); ret = EVAL(x); - if (VALTYPE(ret) == kErrSignal || VALTYPE(ret) == kReturnSignal) { + if (VALTYPE(ret) == kErrSignal + || VALTYPE(ret) == kReturnSignal + || VALTYPE(ret) == kExceptionSignal) { return ret; } if (VALTYPE(ret) == kBreakSignal) { diff --git a/src/primitives.h b/src/primitives.h index a5aa2bc..cd686fe 100644 --- a/src/primitives.h +++ b/src/primitives.h @@ -4,6 +4,7 @@ #include "interp.h" SExpRef primitive_assert_error(Interp *interp, SExpRef sexp, bool istail); +SExpRef primitive_assert_exception(Interp *interp, SExpRef sexp, bool istail); SExpRef primitive_load(Interp *interp, SExpRef sexp, bool istail); SExpRef primitive_return(Interp *interp, SExpRef sexp, bool istail); SExpRef primitive_break(Interp *interp, SExpRef sexp, bool istail); @@ -29,5 +30,6 @@ SExpRef primitive_quasi(Interp *interp, SExpRef sexp, bool istail); SExpRef primitive_and(Interp *interp, SExpRef sexp, bool istail); SExpRef primitive_or(Interp *interp, SExpRef sexp, bool istail); SExpRef primitive_unwind_protect(Interp *interp, SExpRef sexp, bool istail); +SExpRef primitive_try(Interp *interp, SExpRef sexp, bool istail); #endif diff --git a/src/sexp.h b/src/sexp.h index d606acf..1c4016b 100644 --- a/src/sexp.h +++ b/src/sexp.h @@ -73,6 +73,7 @@ typedef enum { kBreakSignal, kContinueSignal, kTailcallSExp, + kExceptionSignal, } SExpType; VECTOR_DEF(SExpRef); diff --git a/tests/error.lisp b/tests/error.lisp index c774622..4cfd8a3 100644 --- a/tests/error.lisp +++ b/tests/error.lisp @@ -9,3 +9,23 @@ (assert-error (cond (#t (error "")))) (assert-error (cond ((error "") #t))) +(assert-exception (throw "")) +(assert-exception (let ((x (throw ""))) #t)) +(assert-exception (let () (throw "") #t)) +(assert-exception (if (throw "") #t #t)) +(assert-exception (and (throw ""))) +(assert-exception (or (throw ""))) +(assert-exception (funcall (lambda () (throw "")))) +(assert-exception (while #t (throw ""))) +(assert-exception (cond (#t (throw "")))) +(assert-exception (cond ((throw "") #t))) + +(defvar flag 1) +(try + (let () + (+ 1 2) + (throw 42)) + (lambda (e) + (assert (= e 42)) + (setq flag 0))) +(assert (= flag 0)) -- cgit v1.0