aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Readme.md1
-rw-r--r--src/builtins.c5
-rw-r--r--src/builtins.h1
-rw-r--r--src/interp.c33
-rw-r--r--src/interp.h2
-rw-r--r--src/main.c6
-rw-r--r--src/primitives.c39
-rw-r--r--src/primitives.h2
-rw-r--r--src/sexp.h1
-rw-r--r--tests/error.lisp20
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 <float.h>
#include <math.h>
+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, "<ERROR>");
+ } else if (pe->type == kExceptionSignal) {
+ str_builder_append(sb, "<EXCEPTION>");
} else if (pe->type == kReturnSignal) {
str_builder_append(sb, "<RETURN>");
} 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))
generated by cgit v1.0 at 2025-12-29 14:16:34 +0000