From 016d6baec89099f369452446c1848c3a3693b86c Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Sun, 11 Sep 2016 23:51:12 -0400 Subject: [PATCH] Make module provider wrapping idempotent Tweak the footer a little bit. --- footer.lisp | 54 ++++++++++++++++++++++++++++------------------------- 1 file changed, 29 insertions(+), 25 deletions(-) diff --git a/footer.lisp b/footer.lisp index 21213f99f..5b5ca4fbf 100644 --- a/footer.lisp +++ b/footer.lisp @@ -4,44 +4,48 @@ (uiop/package:define-package :asdf/footer (:recycle :asdf/footer :asdf) (:use :uiop/common-lisp :uiop - :asdf/upgrade :asdf/find-system :asdf/operate :asdf/bundle)) + :asdf/upgrade :asdf/find-system :asdf/operate :asdf/bundle) + ;; Happily, all those implementations all have the same module-provider hook interface. + #+(or abcl clasp cmucl clozure ecl mkcl sbcl) + (:import-from #+abcl :sys #+(or clasp cmucl ecl) :ext #+clozure :ccl #+mkcl :mk-ext #+sbcl sb-ext + #:*module-provider-functions* + #+(or clasp ecl mkcl) #:*load-hooks*) + #+mkcl (:import-from :si #:*load-hooks*)) + (in-package :asdf/footer) ;;;; Hook ASDF into the implementation's REQUIRE and other entry points. #+(or abcl clasp clisp clozure cmucl ecl mkcl sbcl) (with-upgradability () - (if-let (x (and #+clisp (find-symbol* '#:*module-provider-functions* :custom nil))) - (eval `(pushnew 'module-provide-asdf - #+abcl sys::*module-provider-functions* - #+(or clasp cmucl ecl) ext:*module-provider-functions* - #+clisp ,x - #+clozure ccl:*module-provider-functions* - #+mkcl mk-ext:*module-provider-functions* - #+sbcl sb-ext:*module-provider-functions*))) + #-clisp (pushnew 'module-provide-asdf *module-provider-functions*) + #+clisp (if-let (x (and #+clisp (find-symbol* '#:*module-provider-functions* :custom nil))) + (eval `(pushnew 'module-provide-asdf ,x))) #+(or clasp ecl mkcl) (progn - (pushnew '("fasb" . si::load-binary) si::*load-hooks* :test 'equal :key 'car) - - #+(or (and clasp windows) (and ecl win32) (and mkcl windows)) - (unless (assoc "asd" #+(or clasp ecl) ext:*load-hooks* #+mkcl si::*load-hooks* :test 'equal) - (appendf #+(or clasp ecl) ext:*load-hooks* #+mkcl si::*load-hooks* '(("asd" . si::load-source)))) - - (setf #+(or clasp ecl) ext:*module-provider-functions* #+mkcl mk-ext::*module-provider-functions* - (loop :for f :in #+(or clasp ecl) ext:*module-provider-functions* - #+mkcl mk-ext::*module-provider-functions* - :collect - (if (eq f 'module-provide-asdf) f - #'(lambda (name) - (let ((l (multiple-value-list (funcall f name)))) - (and (first l) (register-preloaded-system (coerce-name name))) - (values-list l)))))))) + (pushnew '("fasb" . si::load-binary) *load-hooks* :test 'equal :key 'car) + + #+os-windows + (unless (assoc "asd" *load-hooks* :test 'equal) + (appendf *load-hooks* '(("asd" . si::load-source)))) + + ;; Wrap module provider functions in an idempotent, upgrade friendly way + (defvar *wrapped-module-provider* (make-hash-table)) + (setf (gethash 'module-provide-asdf *wrapped-module-provider*) 'module-provide-asdf) + (defun wrap-module-provider (provider name) + (let ((results (multiple-value-list (funcall provider name)))) + (when (first results) (register-preloaded-system (coerce-name name))) + (values-list results))) + (setf *module-provider-functions* + (loop :for provider :in *module-provider-functions* :collect + (ensure-gethash provider *wrapped-module-provider* + #'(lambda (module-name) (wrap-module-provider provider module-name))))))) #+cmucl ;; Hook into the CMUCL herald. (with-upgradability () (defun herald-asdf (stream) (format stream " ASDF ~A" (asdf-version))) - (setf (getf ext:*herald-items* :asdf) `(herald-asdf))) + (setf (getf ext:*herald-items* :asdf) '(herald-asdf))) ;;;; Done! -- GitLab