Create packages in a way that is more compatible with hot-upgrade.

#+ecl (require 'cmp)

(defpackage #:asdf-utilities

  (:nicknames :asdf-extensions)

  (:use #:common-lisp)

  (:export

   #:absolute-pathname-p

;;;; Create packages in a way that is compatible with hot-upgrade.

;;;; See https://bugs.launchpad.net/asdf/+bug/485687

;;;; See more at the end of the file.

(eval-when (:load-toplevel :compile-toplevel :execute)

  (labels ((rename-away (package)

             (loop :with name = (package-name package)

               :for i :from 1 :for n = (format nil "~A.~D" name i)

               :unless (find-package n) :do (rename-package package name)))

           (ensure-exists (name nicknames)

             (let* ((previous

                     (remove-duplicates

                      (remove-if

                       #'null

                       (mapcar #'find-package (cons name nicknames)))

                      :from-end t)))

               (cond

                 (previous

                  (map () #'rename-away (cdr previous))

                  (rename-package (car previous) name nicknames)

                  (car previous))

                 (t

                  (make-package name :nicknames nicknames)))))

           (remove-symbol (symbol package)

             (let ((sym (find-symbol (string symbol) package)))

               (when sym

                 (unexport sym package)

                 (unintern sym package))))

           (ensure-unintern (package symbols)

             (dolist (sym symbols) (remove-symbol sym package)))

           (ensure-use (package use)

             (dolist (used use)

               (do-external-symbols (sym used)

                 (unless (eq sym (find-symbol (string sym) package))

                   (remove-symbol sym package)))

               (use-package used package)))

           (ensure-export (package export)

             (let ((syms (loop :for x :in export :collect

                           (intern (string x) package))))

               (do-external-symbols (sym package)

                 (unless (member sym syms)

                   (remove-symbol sym package)))

               (dolist (sym syms)

                 (export sym package))))

           (ensure-package (name &key nicknames use export unintern)

             (let* ((p (ensure-exists name nicknames)))

               (ensure-use p use)

               (ensure-unintern p unintern)

               (ensure-export p export)

               p)))

    (ensure-package

     ':asdf-utilities

     :nicknames '(#:asdf-extensions)

     :use '(#:common-lisp)

     :export

     '(#:absolute-pathname-p

       #:aif

       #:appendf

       #:asdf-message

       #:component-name-to-pathname-components

       #:system-registered-p

       #:truenamize))

;;;; -------------------------------------------------------------------------

;;;; Cleanups in case of hot-upgrade.

;;;; Things to do in case we're upgrading from a previous version of ASDF.

;;;; See https://bugs.launchpad.net/asdf/+bug/485687

;;;; These must come *before* the defpackage form.

;;;; See more at the end of the file.

(eval-when (:compile-toplevel :load-toplevel :execute)

  (block nil

    (let ((asdf (or (find-package :asdf) (return))))

      (flet ((frob (name)

               (let ((sym (find-symbol (string name) asdf)))

                 (when sym

                   (unexport sym asdf)

                   (unintern sym asdf)))))

        (frob '#:*asdf-revision*)

        (do-external-symbols (sym (or (find-package :asdf-utilities) (return)))

          (unless (eq sym (find-symbol (string sym) asdf))

            (frob sym)))))))

(defpackage #:asdf

  (:documentation "Another System Definition Facility")

  (:use :common-lisp :asdf-utilities)

  (:export #:defsystem #:oos #:operate #:find-system #:run-shell-command

    (ensure-package

     ':asdf

     :use '(:common-lisp :asdf-utilities)

     :unintern '(#:*asdf-revision*)

     :export

     '(#:defsystem #:oos #:operate #:find-system #:run-shell-command

       #:system-definition-pathname #:find-component ; miscellaneous

       #:compile-system #:load-system #:test-system

       #:compile-op #:load-op #:load-source-op

       #:compute-source-registry

       #:clear-source-registry

       #:ensure-source-registry

           #:process-source-registry))

       #:process-source-registry))))

#+nil

(error "The author of this file habitually uses #+nil to comment out ~