add unwind-protect

5 files changed, 33 insertions, 0 deletions

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))