Commit 016d6bae authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Make module provider wrapping idempotent

Tweak the footer a little bit.
parent 8480c6ee
......@@ -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!
......
  • As JCB pointed out in https://mailman.common-lisp.net/pipermail/asdf-devel/2016-September/005473.html, there's a copy&paste bug here:*load-hooks* resides in the si package, so that line 13 is correct for MKCL and lines 10-12 are not. This might also be a good time to fix the same issue for clasp: there, *load-hooks* lives in the core package (synonymous with si, I believe) rather than ext (see also !4 (diffs))

    Edited by Elias Pipping
  • This gets us further:

    --- a/footer.lisp
    +++ b/footer.lisp
    @@ -9,8 +9,8 @@
       #+(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*))
    +               #+ecl #:*load-hooks*)
    +  #+(or clasp mkcl) (:import-from :si #:*load-hooks*))
     
     (in-package :asdf/footer)
     
    Edited by Elias Pipping
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment