footer.lisp 2.36 KB
Newer Older
1 2 3
;;;; -----------------------------------------------------------------------
;;;; ASDF Footer: last words and cleanup

4 5
(asdf/package:define-package :asdf/footer
  (:recycle :asdf/footer :asdf)
6
  (:use :asdf/common-lisp :asdf/driver :asdf/upgrade
7 8
   :asdf/find-system :asdf/find-component :asdf/operation :asdf/action :asdf/lisp-action
   :asdf/operate :asdf/bundle :asdf/concatenate-source
9
   :asdf/output-translations :asdf/source-registry
10
   :asdf/backward-internals :asdf/defsystem :asdf/backward-interface))
11 12 13 14
(in-package :asdf/footer)

;;;; Hook ASDF into the implementation's REQUIRE and other entry points.

15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
(with-upgradability ()
  #+(or abcl clisp clozure cmu ecl mkcl sbcl)
  (if-let (x (and #+clisp (find-symbol* '#:*module-provider-functions* :custom nil)))
    (eval `(pushnew 'module-provide-asdf
                    #+abcl sys::*module-provider-functions*
                    #+clisp ,x
                    #+clozure ccl:*module-provider-functions*
                    #+(or cmu ecl) ext:*module-provider-functions*
                    #+mkcl mk-ext:*module-provider-functions*
                    #+sbcl sb-ext:*module-provider-functions*)))

  #+(or ecl mkcl)
  (progn
    (pushnew '("fasb" . si::load-binary) si:*load-hooks* :test 'equal :key 'car)

    #+(or (and ecl win32) (and mkcl windows))
    (unless (assoc "asd" #+ecl ext:*load-hooks* #+mkcl si::*load-hooks* :test 'equal)
      (appendf #+ecl ext:*load-hooks* #+mkcl si::*load-hooks* '(("asd" . si::load-source))))

    (setf #+ecl ext:*module-provider-functions* #+mkcl mk-ext::*module-provider-functions*
          (loop :for f :in #+ecl ext:*module-provider-functions*
                #+mkcl mk-ext::*module-provider-functions*
37 38 39 40 41 42
                :collect
                (if (eq f 'module-provide-asdf) f
                    #'(lambda (name)
                        (let ((l (multiple-value-list (funcall f name))))
                          (and (first l) (register-pre-built-system (coerce-name name)))
                          (values-list l))))))))
43 44 45


;;;; Done!
46 47
(with-upgradability ()
  #+allegro
48
  (when (boundp 'excl:*warn-on-nested-reader-conditionals*)
49
    (setf excl:*warn-on-nested-reader-conditionals* asdf/common-lisp::*acl-warn-save*))
50

51
  (dolist (f '(:asdf :asdf2 :asdf3)) (pushnew f *features*))
52

53
  (provide :asdf)
54

55
  (cleanup-upgraded-asdf))
56

57 58 59
(when *load-verbose*
  (asdf-message ";; ASDF, version ~a~%" (asdf-version)))

60