cl: unwind-protect — cleanup frame in cl-eval-ast, 8 new tests (159 eval)

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

lib/common-lisp/eval.sx

@@ -309,6 +309,16 @@
                     (:else (run (+ i 1))))))))))
       (run 0))))
 
+;; ── UNWIND-PROTECT ───────────────────────────────────────────────
+
+(define cl-eval-unwind-protect
+  (fn (args env)
+    (let ((protected (nth args 0))
+          (cleanup   (rest args)))
+      (let ((result (cl-eval protected env)))
+        (for-each (fn (f) (cl-eval f env)) cleanup)
+        result))))
+
 ;; ── BLOCK / RETURN-FROM ───────────────────────────────────────────
 
 (define cl-eval-block
@@ -605,6 +615,7 @@
           ((= head "TAGBODY")      (cl-eval-tagbody args env))
           ((= head "GO")
             {:cl-type "go-tag" :tag (nth args 0)})
+          ((= head "UNWIND-PROTECT") (cl-eval-unwind-protect args env))
           ((= head "BLOCK")        (cl-eval-block args env))
           ((= head "RETURN-FROM")  (cl-eval-return-from args env))
           ((= head "RETURN")

lib/common-lisp/tests/eval.sx

@@ -361,3 +361,30 @@
 (cl-test "tagbody: block-return propagates out"
   (ev "(block done (tagbody (return-from done 42)) nil)")
   42)
+
+;; ── UNWIND-PROTECT ───────────────────────────────────────────────
+
+(cl-test "unwind-protect: normal returns protected"
+  (ev "(unwind-protect 42 nil)")
+  42)
+(cl-test "unwind-protect: cleanup runs"
+  (ev "(let ((x 0)) (unwind-protect 1 (setq x 99)) x)")
+  99)
+(cl-test "unwind-protect: cleanup result ignored"
+  (ev "(unwind-protect 42 777)")
+  42)
+(cl-test "unwind-protect: multiple cleanup forms"
+  (ev "(let ((x 0)) (unwind-protect 1 (setq x (+ x 1)) (setq x (+ x 1))) x)")
+  2)
+(cl-test "unwind-protect: cleanup on return-from"
+  (ev "(let ((x 0)) (block done (unwind-protect (return-from done 7) (setq x 99))) x)")
+  99)
+(cl-test "unwind-protect: return-from still propagates"
+  (ev "(block done (unwind-protect (return-from done 42) nil))")
+  42)
+(cl-test "unwind-protect: cleanup on go"
+  (ev "(let ((x 0)) (tagbody (unwind-protect (go done) (setq x 1)) done) x)")
+  1)
+(cl-test "unwind-protect: nested, inner cleanup first"
+  (ev "(let ((log (list))) (unwind-protect (unwind-protect 1 (append! log 2)) (append! log 3)) log)")
+  (list 2 3))