Make module provider wrapping idempotent

(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!