From 0633c6c2797bc9182b2c1888385eac6cb6caed10 Mon Sep 17 00:00:00 2001 From: Mistivia Date: Sat, 28 Jun 2025 15:49:31 +0800 Subject: add unwind-protect --- .gitignore | 1 + src/interp.c | 1 + src/primitives.c | 11 +++++++++++ src/primitives.h | 1 + tests/control-flow.lisp | 19 +++++++++++++++++++ 5 files changed, 33 insertions(+) diff --git a/.gitignore b/.gitignore index 3054e2d..b98bb47 100644 --- a/.gitignore +++ b/.gitignore @@ -12,3 +12,4 @@ perf.data perf.data.old web-* index.html +ghpages/ diff --git a/src/interp.c b/src/interp.c index 8b5c15f..4a6a455 100644 --- a/src/interp.c +++ b/src/interp.c @@ -122,6 +122,7 @@ void Interp_init(Interp *self) { Interp_add_primitive(self, "assert", primitive_assert); Interp_add_primitive(self, "assert-error", primitive_assert_error); Interp_add_primitive(self, "load", primitive_load); + Interp_add_primitive(self, "unwind-protect", primitive_unwind_protect); Interp_add_userfunc(self, "function?", builtin_functionp); Interp_add_userfunc(self, "map", builtin_map); diff --git a/src/primitives.c b/src/primitives.c index a8bb62a..9f3e670 100644 --- a/src/primitives.c +++ b/src/primitives.c @@ -79,6 +79,17 @@ SExpRef primitive_eval(Interp *interp, SExpRef args, bool istail) { return lisp_eval(interp, args, istail); } +SExpRef primitive_unwind_protect(Interp *interp, SExpRef args, bool istail) { + if (LENGTH(args) < 2) { + return new_error(interp, "unwind-protect: syntax error.\n"); + } + SExpRef ret = EVAL(CAR(args)); + for (SExpRef i = CDR(args); !NILP(i); i = CDR(i)) { + EVAL(CAR(i)); + } + return ret; +} + SExpRef primitive_if(Interp *interp, SExpRef args, bool istail) { SExpRef cond, tb, fb; diff --git a/src/primitives.h b/src/primitives.h index f5dd8e8..a5aa2bc 100644 --- a/src/primitives.h +++ b/src/primitives.h @@ -28,5 +28,6 @@ SExpRef primitive_quote(Interp *interp, SExpRef sexp, bool istail); 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); #endif diff --git a/tests/control-flow.lisp b/tests/control-flow.lisp index 965213e..2b4f6f1 100644 --- a/tests/control-flow.lisp +++ b/tests/control-flow.lisp @@ -70,3 +70,22 @@ (assert (= 1 (funcall (lambda () (while #t (return 1)))))) (assert (= 1 (funcall (lambda () (let () (return 1)))))) (assert (= 1 (funcall (lambda () (let ((x (return 1))) (return 2)))))) + +(defvar flag 0) + +(assert-error + (unwind-protect + (progn + (+ 1 1) + (error "err")) + (setq flag 1))) + +(assert (= flag 1)) + +(assert (= 2 + (unwind-protect + (progn + (+ 1 1)) + (setq flag 1)))) + +(assert (= flag 1)) -- cgit v1.0