Commit 26239652 authored by Robert Goldman's avatar Robert Goldman

Use DEFINE-CONVENIENCE-ACTION-METHODS.

Remove hand-written boilerplate in favor of existing macro.
parent 11f8e39d
...@@ -83,27 +83,36 @@ and a class-name or class designates the canonical instance of the designated cl ...@@ -83,27 +83,36 @@ and a class-name or class designates the canonical instance of the designated cl
(component 'component) (component 'component)
(opix (position operation formals)) (opix (position operation formals))
(coix (position component formals)) (coix (position component formals))
(prefix (subseq formals 0 opix)) (first-arg (if (< opix coix) operation component))
(suffix (subseq formals (1+ coix) len)) (prefix (subseq formals 0 (min opix coix)))
(suffix (subseq formals (1+ (max opix coix)) len))
(more-args (when keyp `(&rest ,rest &key &allow-other-keys)))) (more-args (when keyp `(&rest ,rest &key &allow-other-keys))))
(assert (and (integerp opix) (integerp coix) (= coix (1+ opix)))) (assert (and (integerp opix) (integerp coix)
(or (= coix (1+ opix)) (= opix (1+ coix)))))
(flet ((next-method (o c) (flet ((next-method (o c)
(if keyp (if keyp
`(apply ',function ,@prefix ,o ,c ,@suffix ,rest) `(apply ',function ,@prefix ,(if (eq first-arg operation) o c)
`(,function ,@prefix ,o ,c ,@suffix)))) ,(if (eq first-arg operation) c o)
,@suffix ,rest)
`(,function ,@prefix
,(if (eq first-arg operation) o c)
,(if (eq first-arg operation) c o) ,@suffix))))
`(progn `(progn
(defmethod ,function (,@prefix (,operation string) ,component ,@suffix ,@more-args) (defmethod ,function (,@prefix ,(if (eq first-arg operation) `(,operation string) component)
,(if (eq first-arg operation) component `(,operation string)) ,@suffix ,@more-args)
(declare (notinline ,function)) (declare (notinline ,function))
(let ((,component (find-component () ,component))) ;; do it first, for defsystem-depends-on (let ((,component (find-component () ,component))) ;; do it first, for defsystem-depends-on
,(next-method `(safe-read-from-string ,operation :package :asdf/interface) component))) ,(next-method `(safe-read-from-string ,operation :package :asdf/interface) component)))
(defmethod ,function (,@prefix (,operation symbol) ,component ,@suffix ,@more-args) (defmethod ,function (,@prefix ,(if (eq first-arg operation) `(,operation symbol) component)
,(if (eq first-arg operation) component `(,operation symbol)) ,@suffix ,@more-args)
(declare (notinline ,function)) (declare (notinline ,function))
(if ,operation (if ,operation
,(next-method ,(next-method
`(make-operation ,operation) `(make-operation ,operation)
`(or (find-component () ,component) ,if-no-component)) `(or (find-component () ,component) ,if-no-component))
,if-no-operation)) ,if-no-operation))
(defmethod ,function (,@prefix (,operation operation) ,component ,@suffix ,@more-args) (defmethod ,function (,@prefix ,(if (eq first-arg operation) `(,operation operation) component)
,(if (eq first-arg operation) component `(,operation operation)) ,@suffix ,@more-args)
(declare (notinline ,function)) (declare (notinline ,function))
(if (typep ,component 'component) (if (typep ,component 'component)
(error "No defined method for ~S on ~/asdf-action:format-action/" (error "No defined method for ~S on ~/asdf-action:format-action/"
...@@ -381,14 +390,13 @@ They may rely on the order of the files to discriminate between inputs. ...@@ -381,14 +390,13 @@ They may rely on the order of the files to discriminate between inputs.
(assert (length=n-p files 1)) (assert (length=n-p files 1))
(first files))) (first files)))
(defgeneric additional-input-files (component op) (defgeneric additional-input-files (operation component)
(:documentation "Additional input files for the operation on this (:documentation "Additional input files for the operation on this
component. These are files that are inferred, rather than component. These are files that are inferred, rather than
explicitly specified.") explicitly specified."))
(:method (comp (op symbol)) (define-convenience-action-methods additional-input-files (operation component))
(additional-input-files comp (make-operation op))) (defmethod additional-input-files ((op operation) (comp component))
(:method ((comp component) (op operation)) (cdr (assoc op (%additional-input-files comp))))
(cdr (assoc op (%additional-input-files comp)))))
;; Memoize input files. ;; Memoize input files.
(defmethod input-files :around (operation component) (defmethod input-files :around (operation component)
...@@ -397,7 +405,7 @@ They may rely on the order of the files to discriminate between inputs. ...@@ -397,7 +405,7 @@ They may rely on the order of the files to discriminate between inputs.
(append (call-next-method) (append (call-next-method)
;; must come after the first, for other code that ;; must come after the first, for other code that
;; assumes the first will be the "key" file ;; assumes the first will be the "key" file
(additional-input-files component operation)))) (additional-input-files operation component))))
;; By default an action has no input-files. ;; By default an action has no input-files.
(defmethod input-files ((o operation) (c component)) (defmethod input-files ((o operation) (c component))
......
...@@ -296,10 +296,6 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. ...@@ -296,10 +296,6 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
;;; additional methods for additional-input-files that are responsible for looking up systems. ;;; additional methods for additional-input-files that are responsible for looking up systems.
(with-upgradability () (with-upgradability ()
(defmethod additional-input-files ((comp symbol) op)
(additional-input-files (find-system comp) op))
(defmethod additional-input-files ((comp string) op)
(additional-input-files (find-system comp) op))
(defmethod %additional-input-files ((comp symbol)) (defmethod %additional-input-files ((comp symbol))
(%additional-input-files (find-system comp))) (%additional-input-files (find-system comp)))
(defmethod %additional-input-files ((comp string)) (defmethod %additional-input-files ((comp string))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment