A small demo of unwind-protect to implement a custom with-open-file macro in Common Lisp

UNWIND-PROTECT is one of Common Lisp’s “Special Operators”. A special operator is basically something that comes bundled with the language as a form of primitive functionality, and which provides support for higher-level functionality. In fact, basic macros that we use on a daily basis such as do, dolist, dotimes can all be (are arguably are) implemented using low-level special operators such as BLOCK, RETURN-FROM, TAGBODY, and GO. For instance, suppose we have the following code that simply enumerates numbers from 1 to 10:

(dotimes (i 10)
    (format t "~a~%" (+ i 1)))

is expanded (using the slime shortcut, C-C M-m to expand macro forms (the actual command used is ‘slime-macroexpand-all’) at first to:

(DO ((I 0 (1+ I)))
    ((>= I 10) NIL)
    (DECLARE (TYPE UNSIGNED-BYTE I))
     (FORMAT T "~a~%" (+ I 1)))

Ah! So as suspected, dotimes is implemented using the lower-level ‘do’ macro (at least in the Lisp implementation that i am using – SBCL). Now if we invoke C-c M-m again on this code, we finally get:

(BLOCK NIL
  (LET ((I 0))
    (DECLARE (TYPE UNSIGNED-BYTE I))
    (TAGBODY
      (GO #:G809)
     #:G808
      (TAGBODY (FORMAT T "~a~%" (+ I 1)))
      (PSETQ I (1+ I))
     #:G809
      (UNLESS (>= I 10) (GO #:G808))
      (RETURN-FROM NIL (PROGN NIL)))))

Interesting! This shows that the dotimes macro code ultimately expands into a block with no name (nil). It then binds the variable i (which is declared to be an unsigned byte) using the LET special operator, and then the whole looping code is actually bound within a TAGBODY. Of course, the RETURN-FROM is effected for the outer block and not for the TAGBODY.

Now, UNWIND-PROTECT is a special operator that is used to provide some form of cleanup facility for code that can potentially perform non-local exits, in which case crucial resources could potentially be leaked. The general form of this special operator is:

(unwind-protect protected-expression
  cleanup-form*)

The only caveat is that if there are some non-local exits in the cleanup form(s), then unwind-protect offers no protection from those scenarios. Despite this shortcoming, this feature is extremely powerful and useful. This is the basis on which a lot of WITH-* macros are built, for instance, the WITH-OPEN-FILE macro which helps ensure that file handles (stream handles) are closed no matter what happens within the actual body of code that runs on that file stream. For instance, we might have a small function to copy a binary file as follows:

(defun copy-binary-file ()
           (let* ((source-file (progn
                                (princ "Enter source file name: ")
                                (read-line)))
                  (dest-file (make-pathname
                                 :name "copy"
                                 :defaults source-file)))
             (with-open-file (in
                              source-file
                              :direction :input
                              :if-does-not-exist :error
                              :element-type '(unsigned-byte 8))
               (with-open-file (out
                                dest-file
                                :direction :output
                                :if-does-not-exist :create
                                :if-exists :overwrite
                                :element-type '(unsigned-byte 8))
                 (loop for byte = (read-byte in nil nil)
                      while byte do (write-byte byte out))))))

This function simply copies a user-supplied binary file to a backup file named “copy.”. All attributes of the backup file apart from its name are picked up from the source file itself.

Let us just examine (if we are feeling particularly masochistic) how the expanded code looks like:

(PROGN
 (EVAL-WHEN (:COMPILE-TOPLEVEL)
   (SB-C:%COMPILER-DEFUN 'COPY-BINARY-FILE 'NIL T))
 (SB-IMPL::%DEFUN 'COPY-BINARY-FILE
                  (SB-INT:NAMED-LAMBDA COPY-BINARY-FILE
                      NIL
                    (BLOCK COPY-BINARY-FILE
                      (LET* ((SOURCE-FILE
                              (PROGN
                               (PRINC "Enter source file name: ")
                               (READ-LINE)))
                             (DEST-FILE
                              (MAKE-PATHNAME
                                    :NAME "copy"
                                    :DEFAULTS SOURCE-FILE)))
                        (LET ((IN
                               (OPEN SOURCE-FILE :DIRECTION :INPUT
                                     :IF-DOES-NOT-EXIST :ERROR :ELEMENT-TYPE
                                     '(UNSIGNED-BYTE 8)))
                              (#:G841 T))
                          (UNWIND-PROTECT
                              (MULTIPLE-VALUE-PROG1
                                  (PROGN
                                   (LET ((OUT
                                          (OPEN DEST-FILE :DIRECTION :OUTPUT
                                                :IF-DOES-NOT-EXIST :CREATE
                                                :IF-EXISTS :OVERWRITE
                                                :ELEMENT-TYPE
                                                '(UNSIGNED-BYTE 8)))
                                         (#:G842 T))
                                     (UNWIND-PROTECT
                                         (MULTIPLE-VALUE-PROG1
                                             (PROGN
                                              (BLOCK NIL
                                                (LET ((BYTE NIL))
                                                  (DECLARE)
                                                  (TAGBODY
                                                   SB-LOOP::NEXT-LOOP
                                                    (SETQ BYTE
                                                            (READ-BYTE IN NIL
                                                                       NIL))
                                                    (IF BYTE
                                                        NIL
                                                        (PROGN
                                                         (GO
                                                          SB-LOOP::END-LOOP)))
                                                    (WRITE-BYTE BYTE OUT)
                                                    (GO SB-LOOP::NEXT-LOOP)
                                                   SB-LOOP::END-LOOP))))
                                           (SETQ #:G842 NIL))
                                       (IF OUT
                                           (PROGN (CLOSE OUT :ABORT #:G842))
                                           NIL))))
                                (SETQ #:G841 NIL))
                            (IF IN
                                (PROGN (CLOSE IN :ABORT #:G841))
                                NIL))))))
                  NIL 'NIL (SB-C:SOURCE-LOCATION)))

Now, if instead of the WITH-OPEN-FILE macro, we had chosen to implement the function using the OPEN and CLOSE functions, we could have been in trouble since the body forms that perform the actual copying could have exited due to errors, explicit RETURNs or RETURN-FROMs, or simply failed for some other reason. So how could we implement our own version of this macro that has more or less the same safety net? Using UNWIND-PROTECT of course! Let’s write a macro using precisely that:

(defmacro with-my-open-file ((fd fn &rest params) &body body)
           `(let ((,fd (open ,fn ,@params)))
              (unwind-protect (progn ,@body)
                (close ,fd))))

So all we are essentially doing is opening the stream, and then placing all the body forms (note how progn is needed there since the body is spliced open), and finally performing an explicit close on the stream handle as the cleanup form of the UNWIND-PROTECT special operator. We can rewrite the copy-binary-file function using this custom macro and test that it works just as well!

(defun copy-binary-file-custom ()
           (let* ((source-file (progn
                                (princ "Enter source file name: ")
                                (read-line)))
                  (dest-file (make-pathname
                                   :name "copy"
                                   :defaults source-file)))
             (with-my-open-file (in
                              source-file
                              :direction :input
                              :if-does-not-exist :error
                              :element-type '(unsigned-byte 8))
               (with-my-open-file (out
                                dest-file
                                :direction :output
                                :if-does-not-exist :create
                                :if-exists :overwrite
                                :element-type '(unsigned-byte 8))
                 (loop for byte = (read-byte in nil nil)
                      while byte do (write-byte byte out))))))

The expanded code looks something like this:

(PROGN
 (EVAL-WHEN (:COMPILE-TOPLEVEL)
   (SB-C:%COMPILER-DEFUN 'COPY-BINARY-FILE-CUSTOM 'NIL T))
 (SB-IMPL::%DEFUN 'COPY-BINARY-FILE-CUSTOM
                  (SB-INT:NAMED-LAMBDA COPY-BINARY-FILE-CUSTOM
                      NIL
                    (BLOCK COPY-BINARY-FILE-CUSTOM
                      (LET* ((SOURCE-FILE
                              (PROGN
                               (PRINC "Enter source file name: ")
                               (READ-LINE)))
                             (DEST-FILE
                              (MAKE-PATHNAME
                                     :NAME "copy"
                                     :DEFAULTS SOURCE-FILE)))
                        (LET ((IN
                               (OPEN SOURCE-FILE :DIRECTION :INPUT
                                     :IF-DOES-NOT-EXIST :ERROR :ELEMENT-TYPE
                                     '(UNSIGNED-BYTE 8))))
                          (UNWIND-PROTECT
                              (PROGN
                               (LET ((OUT
                                      (OPEN DEST-FILE :DIRECTION :OUTPUT
                                            :IF-DOES-NOT-EXIST :CREATE
                                            :IF-EXISTS :OVERWRITE :ELEMENT-TYPE
                                            '(UNSIGNED-BYTE 8))))
                                 (UNWIND-PROTECT
                                     (PROGN
                                      (BLOCK NIL
                                        (LET ((BYTE NIL))
                                          (DECLARE)
                                          (TAGBODY
                                           SB-LOOP::NEXT-LOOP
                                            (SETQ BYTE (READ-BYTE IN NIL NIL))
                                            (IF BYTE
                                                NIL
                                                (PROGN (GO SB-LOOP::END-LOOP)))
                                            (WRITE-BYTE BYTE OUT)
                                            (GO SB-LOOP::NEXT-LOOP)
                                           SB-LOOP::END-LOOP))))
                                   (CLOSE OUT))))
                            (CLOSE IN))))))
                  NIL 'NIL (SB-C:SOURCE-LOCATION)))

If we compare this expanded code with the expanded code for copy-binary-file (which uses the built-in WITH-OPEN-FILE macro), we see that this is considerably smaller and simpler (though not by much). One difference we can immediately see is how the other code uses the special operator MULTIPLE-VALUE-PROG1 for instance. No doubt the built-in macro provides a lot more protection and handling of corner case than this simple imitation macro does. That being said, for most practical cases, this macro will work just fine. Finally, some future post might actually delve deeper into the expanded code and explain how it actually works (both for the built-in macro and the custom macro) along with explanations of the role played by each of the special operators in the expanded forms. For now, that’s all, folks!

Advertisements
A small demo of unwind-protect to implement a custom with-open-file macro in Common Lisp