From 5f73d4d761132cbceb1dd06c2f54fb7632a78b8a Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Sat, 8 Jun 2013 10:36:55 +0200 Subject: [PATCH] 3.0.1.4: factor MAKE-PLAN out of TRAVERSE. For consistency, MAKE-PLAN always returns a plan. For backward compatibility, TRAVERSE always returns a list of actions. OPERATE now calls MAKE-PLAN, not TRAVERSE anymore. Happily, no one in quicklisp defines *useful* methods on TRAVERSE. Thanks to foom for suggesting this cleanup. --- action.lisp | 17 +++++++++++------ asdf.asd | 2 +- header.lisp | 2 +- operate.lisp | 6 +++--- plan.lisp | 24 ++++++++++++++++++------ test/script-support.lisp | 2 +- upgrade.lisp | 2 +- version.lisp-expr | 2 +- 8 files changed, 37 insertions(+), 20 deletions(-) diff --git a/action.lisp b/action.lisp index 6f464665..0c975f7e 100644 --- a/action.lisp +++ b/action.lisp @@ -38,17 +38,22 @@ ;;;; Convenience methods (with-upgradability () (defmacro define-convenience-action-methods - (function (operation component &optional keyp) - &key if-no-operation if-no-component operation-initargs) + (function formals &key if-no-operation if-no-component operation-initargs) (let* ((rest (gensym "REST")) (found (gensym "FOUND")) + (keyp (equal (last formals) '(&key))) + (formals-no-key (if keyp (butlast formals) formals)) + (len (length formals-no-key)) + (prefix (subseq formals 0 (- len 2))) + (operation (nth (- len 2) formals)) + (component (nth (- len 1) formals)) (more-args (when keyp `(&rest ,rest &key &allow-other-keys)))) (flet ((next-method (o c) (if keyp - `(apply ',function ,o ,c ,rest) - `(,function ,o ,c)))) + `(apply ',function ,@prefix ,o ,c ,rest) + `(,function ,@prefix ,o ,c)))) `(progn - (defmethod ,function ((,operation symbol) ,component ,@more-args) + (defmethod ,function (,@prefix (,operation symbol) ,component ,@more-args) (if ,operation ,(next-method (if operation-initargs ;backward-compatibility with ASDF1's operate. Yuck. @@ -56,7 +61,7 @@ `(make-operation ,operation)) `(or (find-component () ,component) ,if-no-component)) ,if-no-operation)) - (defmethod ,function ((,operation operation) ,component ,@more-args) + (defmethod ,function (,@prefix (,operation operation) ,component ,@more-args) (if (typep ,component 'component) (error "No defined method for ~S on ~/asdf-action:format-action/" ',function (cons ,operation ,component)) diff --git a/asdf.asd b/asdf.asd index eb16c317..67b445cb 100644 --- a/asdf.asd +++ b/asdf.asd @@ -74,7 +74,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "3.0.1.3" ;; to be automatically updated by make bump-version + :version "3.0.1.4" ;; to be automatically updated by make bump-version :depends-on () #+asdf3 :encoding #+asdf3 :utf-8 ;; For most purposes, asdf itself specially counts as a builtin system. diff --git a/header.lisp b/header.lisp index d75114ff..2b59d8f6 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- -;;; This is ASDF 3.0.1.3: Another System Definition Facility. +;;; This is ASDF 3.0.1.4: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/operate.lisp b/operate.lisp index 004632ad..8bd54ea8 100644 --- a/operate.lisp +++ b/operate.lisp @@ -86,10 +86,10 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be: (error 'missing-component-of-version :requires component :version version))) (defmethod operate ((operation operation) (component component) - &rest keys &key &allow-other-keys) - (let ((plan (apply 'traverse operation component keys))) + &rest keys &key plan-class &allow-other-keys) + (let ((plan (apply 'make-plan plan-class operation component keys))) (apply 'perform-plan plan keys) - (values operation plan))) + (values operation (plan-actions plan) plan))) (defun oos (operation component &rest args &key &allow-other-keys) (apply 'operate operation component args)) diff --git a/plan.lisp b/plan.lisp index bdf26513..7b7caa75 100644 --- a/plan.lisp +++ b/plan.lisp @@ -20,7 +20,7 @@ #:visit-dependencies #:compute-action-stamp #:traverse-action #:circular-dependency #:circular-dependency-actions #:call-while-visiting-action #:while-visiting-action - #:traverse #:plan-actions #:perform-plan #:plan-operates-on-p + #:make-plan #:traverse #:plan-actions #:perform-plan #:plan-operates-on-p #:planned-p #:index #:forced #:forced-not #:total-action-count #:planned-action-count #:planned-output-action-count #:visited-actions #:visiting-action-set #:visiting-action-list #:plan-actions-r @@ -342,6 +342,8 @@ the action of OPERATION on COMPONENT in the PLAN")) ((actions-r :initform nil :accessor plan-actions-r))) (defgeneric plan-actions (plan)) + (defmethod plan-actions ((plan list)) + plan) (defmethod plan-actions ((plan sequential-plan)) (reverse (plan-actions-r plan))) @@ -358,6 +360,11 @@ the action of OPERATION on COMPONENT in the PLAN")) ;;;; high-level interface: traverse, perform-plan, plan-operates-on-p (with-upgradability () + (defgeneric make-plan (plan-class operation component &key &allow-other-keys) + (:documentation + "Generate and return a plan for performing OPERATION on COMPONENT.")) + (define-convenience-action-methods make-plan (plan-class operation component &key)) + (defgeneric* (traverse) (operation component &key &allow-other-keys) (:documentation "Generate and return a plan for performing OPERATION on COMPONENT. @@ -372,20 +379,25 @@ processed in order by OPERATE.")) (defvar *default-plan-class* 'sequential-plan) - (defmethod traverse ((o operation) (c component) &rest keys &key plan-class &allow-other-keys) + (defmethod make-plan (plan-class (o operation) (c component) &rest keys &key &allow-other-keys) (let ((plan (apply 'make-instance (or plan-class *default-plan-class*) - :system (component-system c) (remove-plist-key :plan-class keys)))) + :system (component-system c) keys))) (traverse-action plan o c t) - (plan-actions plan))) + plan)) - (defmethod perform-plan :around (plan &key) - (declare (ignorable plan)) + (defmethod traverse ((o operation) (c component) &rest keys &key plan-class &allow-other-keys) + (plan-actions (apply 'make-plan plan-class o c keys))) + + (defmethod perform-plan :around ((plan t) &key) (let ((*package* *package*) (*readtable* *readtable*)) (with-compilation-unit () ;; backward-compatibility. (call-next-method)))) ;; Going forward, see deferred-warning support in lisp-build. + (defmethod perform-plan ((plan t) &rest keys &key &allow-other-keys) + (apply 'perform-plan (plan-actions plan) keys)) + (defmethod perform-plan ((steps list) &key force &allow-other-keys) (loop* :for (o . c) :in steps :when (or force (not (nth-value 1 (compute-action-stamp nil o c)))) diff --git a/test/script-support.lisp b/test/script-support.lisp index ea471638..84df1f85 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -559,7 +559,7 @@ is bound, write a message and exit on an error. If `(apply (asym :register-system-definition) ',name :pathname ,*test-directory* :source-file nil ',rest)) -(defun in-plan-p (plan x) (member x plan :key (asym :action-path) :test 'equal)) +(defun in-plan-p (plan x) (member x (acall :plan-actions plan) :key (asym :action-path) :test 'equal)) (defmacro test-load-systems (&rest x) `(do-test-load-systems ',x)) diff --git a/upgrade.lisp b/upgrade.lisp index cba4b396..700746f9 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO ;; "3.4.5.67" would be a development version in the official upstream of 3.4.5. ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 - (asdf-version "3.0.1.3") + (asdf-version "3.0.1.4") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) diff --git a/version.lisp-expr b/version.lisp-expr index 57757f6c..b61ff923 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"3.0.1.3" +"3.0.1.4" -- GitLab