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

4
(uiop/package:define-package :asdf/footer
5
  (:recycle :asdf/footer :asdf)
Robert P. Goldman's avatar
Robert P. Goldman committed
6
  (:use :uiop/common-lisp :uiop
7
8
9
10
11
        :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*
12
		#+(or clasp ecl) #:*load-hooks*)
13
14
  #+mkcl (:import-from :si #:*load-hooks*))

15
16
17
(in-package :asdf/footer)

;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
18
#+(or abcl clasp clisp clozure cmucl ecl mkcl sbcl)
19
(with-upgradability ()
20
21
22
  #-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)))
23

Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
24
  #+(or clasp ecl mkcl)
25
  (progn
26
27
28
29
30
31
32
33
34
35
36
37
38
    (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)))
39
40
41
42
43
    (defun wrap-module-provider-function (provider)
      (ensure-gethash provider *wrapped-module-provider*
		      (constantly
		       #'(lambda (module-name)
			   (wrap-module-provider provider module-name)))))
44
    (setf *module-provider-functions*
45
	  (mapcar #'wrap-module-provider-function *module-provider-functions*))))
46

47
#+cmucl ;; Hook into the CMUCL herald.
48
49
50
(with-upgradability ()
  (defun herald-asdf (stream)
    (format stream "    ASDF ~A" (asdf-version)))
51
  (setf (getf ext:*herald-items* :asdf) '(herald-asdf)))
52

53
54

;;;; Done!
55
56
(with-upgradability ()
  #+allegro
57
  (when (boundp 'excl:*warn-on-nested-reader-conditionals*)
58
    (setf excl:*warn-on-nested-reader-conditionals* uiop/common-lisp::*acl-warn-save*))
59

60
  (dolist (f '(:asdf :asdf2 :asdf3 :asdf3.1 :asdf-package-system)) (pushnew f *features*))
61

62
63
  ;; Provide both lowercase and uppercase, to satisfy more people, especially LispWorks users.
  (provide "asdf") (provide "ASDF")
64

65
  (cleanup-upgraded-asdf))
66

67
68
(when *load-verbose*
  (asdf-message ";; ASDF, version ~a~%" (asdf-version)))