Don't refer directly to symbols in systems we don't depend on.

The reader conditional for using quicklisp code only does half the job. You
will still get unpleasant build errors with the following common scenario:
1. The user loads this library, once, with quicklisp. The reader
   condition selects the quicklisp loader code.
2. ASDF caches a fasl file for this code, which uses the quicklisp
   functions.
3. The user loads this library again, without quicklisp.
4. ASDF loads the cached fasl, which refers to symbols in packages that
   don't exist in the current image, badness ensues.

This change avoids all read-time references to symbols in quicklisp by
looking up the symbols in question at run time. The symbol lookups go out
of their way to give good error messages if a symbol can't be found, since
FUNCALL-ing NIL doesn't tell you anything very helpful. The error type is
checked dynamically by using a HANDLER-BIND that traps every condition --
conditions of other types simply go unhandled, and are propagated normally.

The reader conditional has been replaced by a run-time features check, so
ASDF/quicklisp will be used based on what's present at the time the system
is loaded, and not what was available the first time this library was
loaded.
This commit is contained in:
Matthew Stickney 2018-07-05 14:46:22 -04:00
parent 824436ac3c
commit 6e2c315b32

View file

@ -13,15 +13,36 @@
:generate-random-id))
(in-package :lack.util)
(defun locate-symbol (symbol pkg)
(check-type symbol (or symbol string))
(let* ((sym-name (if (symbolp symbol) (symbol-name symbol) symbol))
(sym (find-symbol sym-name pkg)))
(unless sym
(error "Unable to find symbol ~A in package ~S." symbol pkg))
sym))
(defun load-with-quicklisp (system)
(let* ((load-sym (locate-symbol '#:quickload '#:ql))
(error-sym (locate-symbol '#:system-not-found '#:ql)))
;; We're going to trap on every condition, but only actually
;; handle ones of the type we're interested in. Conditions that we
;; don't explicitly handle will be propagated normally, because
;; HANDLER-BIND is cool like that.
(handler-bind
((t (lambda (c)
(when (typep c error-sym)
(return-from load-with-quicklisp (values))))))
(funcall load-sym system :silent t))))
(defun find-package-or-load (package-name)
(check-type package-name string)
(let ((package (find-package package-name)))
(or package
(let ((system-name (string-downcase (substitute #\- #\. package-name :test #'char=))))
#+quicklisp (handler-case (ql:quickload system-name :silent t)
(ql:system-not-found ()))
#-quicklisp (when (asdf:find-system system-name nil)
(asdf:load-system system-name :verbose nil))
(if (member :quicklisp *features*)
(load-with-quicklisp system-name)
(when (asdf:find-system system-name nil)
(asdf:load-system system-name :verbose nil)))
(find-package package-name)))))
(defun find-middleware (identifier)