Patching made easy - lisp wins again

Nick Levine
Ravenbrook Limited

(Occasional sponsors of mid-morning cookies at lisp conferences since 2009)

This is a concatenation of the slides from my lightning talk at ILC 2009

Here's (most of) the original patch loader.

(defun load-patches ()
  (when-let (patch-files (directory
			  (installation-pathname "patches/*.fsl")))
    ;; stuff cut out here - see next slide
    (dolist (patch patch-files)
      (load patch))))

Almost good enough — the above would have been something of a blunt stick —

Here's what I did about that (deployed and worked fine for first 30 patches)

(defun load-patches ()
  (catch 'load-patches
    (when-let (patch-files (directory
                            (installation-pathname "patches/*.fsl")))
      (when-let (revoke (find-if (lambda (patch)
                                   (pathname-match-p patch "revoke"))
        (setf patch-files (cons revoke (remove revoke patch-files))))
      (dolist (patch patch-files)
        (load patch)))))

Solution: choose a special name and if a file with that name is present load it first.

Note the catch tag.

I didn't know when I wrote this whether I'd ever need anything more sophisticated and if so what. When the time came, the above gave me sufficient control over loading order that more complex behaviour could be bootstrapped as a "revoke" patch — rewrite load-patches and call the new one instead.

Here's the current version:

(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))
                      (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~]."
                         (when (> loaded-count 1) "es")
                         (when (plusp revoked-count) revoked-count)))))))

And here's how you revoke a patch:

(in-package "PROFILER-PLUS")

;;           Nick Levine, Ravenbrook Limited, 2008-10-21
;; The purpose of this document is to patch Profiler 6.0.0, revoking
;; patch build-global-environment.lisp
;; This patch accompanies patch file build-global-environment-redux.lisp.

(throw 'revoke-patches

Why revoke?

Copyright (c) 2009 Nick Levine.

This document is provided "as is", without any express or implied warranty. In no event will the author be held liable for any damages arising from the use of this document. You may make and distribute verbatim copies of this document provided that you do not charge a fee for this document or for its distribution.