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

action.lisp

+11 −6
Original line number Diff line number Diff line
@@ -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))

asdf.asd

+1 −1
Original line number Diff line number Diff line
@@ -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.

header.lisp

+1 −1
Original line number Diff line number Diff line 
;;; -*- 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>.

operate.lisp

+3 −3
Original line number Diff line number Diff line
@@ -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))

plan.lisp

+18 −6
Original line number Diff line number Diff line
@@ -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))))