Allow deferring to a particular named scope

README.md

@@ -428,6 +428,33 @@ Even more usefully, we don’t have to worry about bugs caused by misspellings:
 [This article](https://dev.to/vindarel/compile-time-exhaustiveness-checking-in-common-lisp-with-serapeum-5c5i) has more about exhaustiveness checking in Serapeum.
 
 
+## Defer, scope guards, and RAII
+
+Some programming languages provide a way to register code to run later. Typically the programmer registers how to release a resource at the time the resource is allocated. Some languages provide this feature along lexical scopes using special syntax (Go’s and Zig’s `defer`, D’s `scope_guard`) and other languages (C++, Rust) provide it along lifetimes (“RAII”) but limit it to objects with special methods (destructors, `Drop`).
+
+Serapeum’s implementation looks like the Go/Zig/D style:
+
+``` lisp
+(with-guarded-scope ()
+ (local
+   (def x (open "foo"))
+   (defer (close x))
+   ...
+   ;; `x` is implicitly closed at the end of the block.
+))
+```
+
+But actually, Serapeum scope guards are tied to *dynamic* rather than *lexical* extents, so they implement the full generality of RAII:
+
+``` lisp
+(defun open-managed-file (&rest args)
+ (let ((handle (apply #'open args)))
+   (defer (close handle))
+   handle))
+```
+
+This is useful for working with FFIs.
+
 ## CLOS
 
 Serapeum includes some utilities for CLOS. These utilities do nothing

defer.lisp

@@ -3,14 +3,30 @@
 (deftype scope-condition ()
   '(member :exit :success :failure))
 
-(defvar-unbound *guarded-scope*
-  "The current guarded scope.")
-
 (declaim (inline make-guarded-scope))
 (defstruct guarded-scope
+  (name nil :type symbol)
   (guards nil :type list)
   (success nil :type boolean))
 
+(defvar *static-scope* (make-guarded-scope))
+
+(defun execute-static-scope ()
+  (execute-scope-guards *static-scope*))
+
+(exit-hooks:add-exit-hook #'execute-static-scope)
+
+(defvar *guarded-scopes* (list *static-scope*)
+  "The current guarded scopes.")
+
+(defun enclosing-scope ()
+  (car *guarded-scopes*))
+
+(defun find-guarded-scope (name)
+  (if name
+      (cdr (assoc name *guarded-scopes* :key #'guarded-scope-name))
+      (first *guarded-scopes*)))
+
 (declaim (inline %make-scope-guard))
 (defstruct-read-only (scope-guard (:constructor %make-scope-guard))
   (thunk :type (function () (values &optional)))
@@ -58,19 +74,22 @@ interrupted."
   #-(or ccl sbcl)
   `(unwind-protect ,protected ,@cleanup))
 
-(defmacro with-guarded-scope ((&key) &body body)
+(defmacro with-guarded-scope ((&key (name nil)) &body body)
   (with-unique-names (guarded-scope)
-    `(let* ((,guarded-scope (make-guarded-scope))
-            (*guarded-scope* ,guarded-scope))
+    `(let* ((,guarded-scope (make-guarded-scope :name ',name))
+            (*guarded-scopes* (cons ,guarded-scope *guarded-scopes*)))
        (unwind-protect/without-interrupts
-        (multiple-value-prog1
-            (locally ,@body)
-          (setf (guard-scope-success ,guarded-scope) t))
-        (execute-scope-guards ,guarded-scope)))))
+           (multiple-value-prog1
+               (locally ,@body)
+             (setf (guard-scope-success ,guarded-scope) t))
+         (execute-scope-guards ,guarded-scope)))))
 
-(defmacro with-scope-guard ((&key (on :exit)) &body body)
+(defmacro with-scope-guard ((&key (on :exit) (scope nil scope-provided-p)) &body body)
   (with-unique-names (guarded-scope)
-    `(let ((,guarded-scope *guarded-scope*))
+    `(let ((,guarded-scope
+             ,(if scope-provided-p
+                  `(find-guarded-scope ,scope)
+                  `(enclosing-scope))))
        ,(ecase-of scope-condition on
           (:exit
            `(push
@@ -80,20 +99,20 @@ interrupted."
                 (values)))
              ,guarded-scope))
           (:success
-           `(with-scope-guard ()
+           `(with-scope-guard (:scope ,scope)
               (when (guarded-scope-success ,guarded-scope)
                 ,@body)))
           (:failure
-           `(with-scope-guard ()
+           `(with-scope-guard (:scope ,scope)
               (unless (guarded-scope-success ,guarded-scope)
                 ,@body)))))))
 
-(defun call-deferred (fn &rest args)
-  (with-scope-guard (:on :exit)
+(defun call-deferred (scope-name fn &rest args)
+  (with-scope-guard (:on :exit :scope scope-name)
     (apply fn args)))
 
 (defmacro defer ((fn . args))
-  "Define a single function call as an uncondiional scope
+  "Define a single function call as an unconditional scope
 guard.
 
     (defer (fn x y z))
@@ -102,12 +121,27 @@ guard.
 
 The function's arguments are executed immediately, but the
 function itself is not called until the scope guard is run."
+  `(defer-to nil (,fn ,@args)))
+
+(defmacro defer-to (name (fn . args))
   (with-unique-names (temp-args)
     `(let ((,temp-args (list ,@args)))
-       (call-deferred #',fn ,temp-args))))
+       (call-deferred ,name #',fn ,temp-args))))
+
+(comment
+  (lambda ()
+    (with-guarded-scope ()
+      (local
+        (def x (open "foo"))
+        (defer (close x))
+        (with-scope-guard () (close x))))))
 
 (comment
   (lambda ()
+    (defun open-managed-file (&rest args)
+      (let ((handle (apply #'open args)))
+        (defer (close handle))
+        handle))
     (with-guarded-scope ()
       (local
         (def x (open "foo"))

serapeum.asd

@@ -15,6 +15,7 @@
                "string-case"
                "parse-number"
                ;;; Portability libraries.
+               "exit-hooks"
                "trivial-garbage"
                "bordeaux-threads"
                "parse-declarations-1.0"