backward-internals.lisp 3.91 KB
Newer Older
1 2 3
;;;; -------------------------------------------------------------------------
;;; Internal hacks for backward-compatibility 

4 5
(asdf/package:define-package :asdf/backward-internals
  (:recycle :asdf/backward-internals :asdf)
6
  (:use :asdf/common-lisp :asdf/driver :asdf/upgrade
7 8
   :asdf/system :asdf/component :asdf/operation
   :asdf/find-system :asdf/action :asdf/lisp-action)
9
  (:export ;; for internal use
10
   #:load-sysdef #:make-temporary-package
11
   #:%refresh-component-inline-methods
12
   #:%resolve-if-component-dep-fails
13 14
   #:make-sub-operation
   #:load-sysdef #:make-temporary-package))
15 16 17
(in-package :asdf/backward-internals)

;;;; Backward compatibility with "inline methods"
18 19 20
(with-upgradability ()
  (defparameter +asdf-methods+
    '(perform-with-restarts perform explain output-files operation-done-p))
21

22 23 24 25 26 27 28 29 30 31 32
  (defun %remove-component-inline-methods (component)
    (dolist (name +asdf-methods+)
      (map ()
           ;; this is inefficient as most of the stored
           ;; methods will not be for this particular gf
           ;; But this is hardly performance-critical
           #'(lambda (m)
               (remove-method (symbol-function name) m))
           (component-inline-methods component)))
    ;; clear methods, then add the new ones
    (component-inline-methods component) nil)
33

34 35 36 37 38 39 40 41 42 43 44 45 46
  (defun %define-component-inline-methods (ret rest)
    (dolist (name +asdf-methods+)
      (let ((keyword (intern (symbol-name name) :keyword)))
        (loop :for data = rest :then (cddr data)
              :for key = (first data)
              :for value = (second data)
              :while data
              :when (eq key keyword) :do
                (destructuring-bind (op qual (o c) &body body) value
                  (pushnew
                   (eval `(defmethod ,name ,qual ((,o ,op) (,c (eql ,ret)))
                            ,@body))
                   (component-inline-methods ret)))))))
47

48 49 50
  (defun %refresh-component-inline-methods (component rest)
    (%remove-component-inline-methods component)
    (%define-component-inline-methods component rest)))
51 52 53 54 55 56

;;;; PARTIAL SUPPORT for the :if-component-dep-fails component attribute
;; and the companion asdf:feature pseudo-dependency.
;; This won't recurse into dependencies to accumulate feature conditions.
;; Therefore it will accept the SB-ROTATE-BYTE of an old SBCL
;; (older than 1.1.2.20-fe6da9f) but won't suffice to load an old nibbles.
57 58 59
(with-upgradability ()
  (defun %resolve-if-component-dep-fails (if-component-dep-fails component)
    (asdf-message "The system definition for ~S uses deprecated ~
60
                 ASDF option :IF-COMPONENT-DEP-DAILS. ~
61
                 Starting with ASDF 3, please use :IF-FEATURE instead"
62 63 64 65 66 67 68 69 70 71
                  (coerce-name (component-system component)))
    ;; This only supports the pattern of use of the "feature" seen in the wild
    (check-type component parent-component)
    (check-type if-component-dep-fails (member :fail :ignore :try-next))
    (unless (eq if-component-dep-fails :fail)
      (loop :with o = (make-operation 'compile-op)
            :for c :in (component-children component) :do
              (loop* :for (feature? feature) :in (component-depends-on o c)
                     :when (eq feature? 'feature) :do
                     (setf (component-if-feature c) feature))))))
72

73
(when-upgrading (:when (fboundp 'make-sub-operation))
74
  (defun make-sub-operation (c o dep-c dep-o)
75
    (declare (ignore c o dep-c dep-o)) (asdf-upgrade-error)))
76 77 78


;;;; load-sysdef
79 80 81
(with-upgradability ()
  (defun load-sysdef (name pathname)
    (load-asd pathname :name name))
82

83 84 85 86 87 88
  (defun make-temporary-package ()
    ;; For loading a .asd file, we dont't make a temporary package anymore,
    ;; but use ASDF-USER. I'd like to have this function do this,
    ;; but since whoever uses it is likely to delete-package the result afterwards,
    ;; this would be a bad idea, so preserve the old behavior.
    (make-package (fresh-package-name :prefix :asdf :index 0) :use '(:cl :asdf))))
89 90