patch loader - slide from lightning talk at ILC 2009

In case I don't have time to get to this slide during my allotted five minutes, here's the full code for the patch loader. I'll blog the rest of the talk when I get home.

(defun load-patches ()
  (let ((*redefinition-action* nil))
    (catch 'load-patches
      (macrolet ((fasl-file (name) (format () "~a.~a" name sys:*binary-file-type*)))
        (when-let (patch-files (directory (installation-pathname (fasl-file "patches/*"))))
          (setf patch-files
                (sort patch-files
                      (lambda (first second)
                        (or (pathname-match-p first (fasl-file "revoke"))
                            (and (pathname-match-p first (fasl-file "revoke-*"))
                                 (not (pathname-match-p second (fasl-file "revoke-*"))))))))
          (let ((all-revoked nil)
                (revoked-count 0)
                (loaded-count 0))
            (dolist (patch patch-files)
              (let ((enough-name (make-pathname :type nil
                                                :defaults (enough-installation-namestring patch))))
                (if (loop for revoked in all-revoked thereis (pathname-match-p patch revoked))
                    (progn
                      (log-message :debug "Revoking patch ~a" enough-name)
                      (incf revoked-count))
                  (let ((more-revoked (catch 'revoke-patches
                                        (log-message :debug "Loading patch ~a" enough-name)
                                        (load patch))))
                    (when (consp more-revoked)
                      (setf all-revoked (append more-revoked all-revoked)))
                    (incf loaded-count)))))
            (log-message :notice "Loaded ~d patch~@[~a~]~@[, revoked ~d~]."
                         loaded-count
                         (when (> loaded-count 1) "es")
                         (when (plusp revoked-count) revoked-count)))))))