Skip to content
Snippets Groups Projects
Commit 5f73d4d7 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

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.
parent 49dd3325
No related branches found
No related tags found
No related merge requests found
...@@ -38,17 +38,22 @@ ...@@ -38,17 +38,22 @@
;;;; Convenience methods ;;;; Convenience methods
(with-upgradability () (with-upgradability ()
(defmacro define-convenience-action-methods (defmacro define-convenience-action-methods
(function (operation component &optional keyp) (function formals &key if-no-operation if-no-component operation-initargs)
&key if-no-operation if-no-component operation-initargs)
(let* ((rest (gensym "REST")) (let* ((rest (gensym "REST"))
(found (gensym "FOUND")) (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)))) (more-args (when keyp `(&rest ,rest &key &allow-other-keys))))
(flet ((next-method (o c) (flet ((next-method (o c)
(if keyp (if keyp
`(apply ',function ,o ,c ,rest) `(apply ',function ,@prefix ,o ,c ,rest)
`(,function ,o ,c)))) `(,function ,@prefix ,o ,c))))
`(progn `(progn
(defmethod ,function ((,operation symbol) ,component ,@more-args) (defmethod ,function (,@prefix (,operation symbol) ,component ,@more-args)
(if ,operation (if ,operation
,(next-method ,(next-method
(if operation-initargs ;backward-compatibility with ASDF1's operate. Yuck. (if operation-initargs ;backward-compatibility with ASDF1's operate. Yuck.
...@@ -56,7 +61,7 @@ ...@@ -56,7 +61,7 @@
`(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 ((,operation operation) ,component ,@more-args) (defmethod ,function (,@prefix (,operation operation) ,component ,@more-args)
(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/"
',function (cons ,operation ,component)) ',function (cons ,operation ,component))
......
...@@ -74,7 +74,7 @@ ...@@ -74,7 +74,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :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 () :depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8 #+asdf3 :encoding #+asdf3 :utf-8
;; For most purposes, asdf itself specially counts as a builtin system. ;; For most purposes, asdf itself specially counts as a builtin system.
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- ;;; -*- 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: ;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>.
......
...@@ -86,10 +86,10 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be: ...@@ -86,10 +86,10 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be:
(error 'missing-component-of-version :requires component :version version))) (error 'missing-component-of-version :requires component :version version)))
(defmethod operate ((operation operation) (component component) (defmethod operate ((operation operation) (component component)
&rest keys &key &allow-other-keys) &rest keys &key plan-class &allow-other-keys)
(let ((plan (apply 'traverse operation component keys))) (let ((plan (apply 'make-plan plan-class operation component keys)))
(apply 'perform-plan plan 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) (defun oos (operation component &rest args &key &allow-other-keys)
(apply 'operate operation component args)) (apply 'operate operation component args))
......
...@@ -20,7 +20,7 @@ ...@@ -20,7 +20,7 @@
#:visit-dependencies #:compute-action-stamp #:traverse-action #:visit-dependencies #:compute-action-stamp #:traverse-action
#:circular-dependency #:circular-dependency-actions #:circular-dependency #:circular-dependency-actions
#:call-while-visiting-action #:while-visiting-action #: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-p #:index #:forced #:forced-not #:total-action-count
#:planned-action-count #:planned-output-action-count #:visited-actions #:planned-action-count #:planned-output-action-count #:visited-actions
#:visiting-action-set #:visiting-action-list #:plan-actions-r #:visiting-action-set #:visiting-action-list #:plan-actions-r
...@@ -342,6 +342,8 @@ the action of OPERATION on COMPONENT in the PLAN")) ...@@ -342,6 +342,8 @@ the action of OPERATION on COMPONENT in the PLAN"))
((actions-r :initform nil :accessor plan-actions-r))) ((actions-r :initform nil :accessor plan-actions-r)))
(defgeneric plan-actions (plan)) (defgeneric plan-actions (plan))
(defmethod plan-actions ((plan list))
plan)
(defmethod plan-actions ((plan sequential-plan)) (defmethod plan-actions ((plan sequential-plan))
(reverse (plan-actions-r plan))) (reverse (plan-actions-r plan)))
...@@ -358,6 +360,11 @@ the action of OPERATION on COMPONENT in the PLAN")) ...@@ -358,6 +360,11 @@ the action of OPERATION on COMPONENT in the PLAN"))
;;;; high-level interface: traverse, perform-plan, plan-operates-on-p ;;;; high-level interface: traverse, perform-plan, plan-operates-on-p
(with-upgradability () (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) (defgeneric* (traverse) (operation component &key &allow-other-keys)
(:documentation (:documentation
"Generate and return a plan for performing OPERATION on COMPONENT. "Generate and return a plan for performing OPERATION on COMPONENT.
...@@ -372,20 +379,25 @@ processed in order by OPERATE.")) ...@@ -372,20 +379,25 @@ processed in order by OPERATE."))
(defvar *default-plan-class* 'sequential-plan) (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 (let ((plan (apply 'make-instance
(or plan-class *default-plan-class*) (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) (traverse-action plan o c t)
(plan-actions plan))) plan))
(defmethod perform-plan :around (plan &key) (defmethod traverse ((o operation) (c component) &rest keys &key plan-class &allow-other-keys)
(declare (ignorable plan)) (plan-actions (apply 'make-plan plan-class o c keys)))
(defmethod perform-plan :around ((plan t) &key)
(let ((*package* *package*) (let ((*package* *package*)
(*readtable* *readtable*)) (*readtable* *readtable*))
(with-compilation-unit () ;; backward-compatibility. (with-compilation-unit () ;; backward-compatibility.
(call-next-method)))) ;; Going forward, see deferred-warning support in lisp-build. (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) (defmethod perform-plan ((steps list) &key force &allow-other-keys)
(loop* :for (o . c) :in steps (loop* :for (o . c) :in steps
:when (or force (not (nth-value 1 (compute-action-stamp nil o c)))) :when (or force (not (nth-value 1 (compute-action-stamp nil o c))))
......
...@@ -559,7 +559,7 @@ is bound, write a message and exit on an error. If ...@@ -559,7 +559,7 @@ is bound, write a message and exit on an error. If
`(apply (asym :register-system-definition) ',name :pathname ,*test-directory* `(apply (asym :register-system-definition) ',name :pathname ,*test-directory*
:source-file nil ',rest)) :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) (defmacro test-load-systems (&rest x)
`(do-test-load-systems ',x)) `(do-test-load-systems ',x))
......
...@@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO ...@@ -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.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.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 ;; "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))) (existing-version (asdf-version)))
(setf *asdf-version* asdf-version) (setf *asdf-version* asdf-version)
(when (and existing-version (not (equal asdf-version existing-version))) (when (and existing-version (not (equal asdf-version existing-version)))
......
"3.0.1.3" "3.0.1.4"
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment