Commit c5a68a2e authored by Robert Goldman's avatar Robert Goldman

Revert unnecessary generality.

Made DEFINE-CONVENIENCE-ACTION-METHODS unnecessarily general.  Reverted.
parent 26239652
...@@ -83,36 +83,27 @@ and a class-name or class designates the canonical instance of the designated cl ...@@ -83,36 +83,27 @@ 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))
(first-arg (if (< opix coix) operation component)) (prefix (subseq formals 0 opix))
(prefix (subseq formals 0 (min opix coix))) (suffix (subseq formals (1+ coix) len))
(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) (assert (and (integerp opix) (integerp coix) (= coix (1+ opix))))
(or (= coix (1+ opix)) (= opix (1+ coix)))))
(flet ((next-method (o c) (flet ((next-method (o c)
(if keyp (if keyp
`(apply ',function ,@prefix ,(if (eq first-arg operation) o c) `(apply ',function ,@prefix ,o ,c ,@suffix ,rest)
,(if (eq first-arg operation) c o) `(,function ,@prefix ,o ,c ,@suffix))))
,@suffix ,rest)
`(,function ,@prefix
,(if (eq first-arg operation) o c)
,(if (eq first-arg operation) c o) ,@suffix))))
`(progn `(progn
(defmethod ,function (,@prefix ,(if (eq first-arg operation) `(,operation string) component) (defmethod ,function (,@prefix (,operation string) ,component ,@suffix ,@more-args)
,(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 ,(if (eq first-arg operation) `(,operation symbol) component) (defmethod ,function (,@prefix (,operation symbol) ,component ,@suffix ,@more-args)
,(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 ,(if (eq first-arg operation) `(,operation operation) component) (defmethod ,function (,@prefix (,operation operation) ,component ,@suffix ,@more-args)
,(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/"
......
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