From c73835feab90ba8ffa4350b6a708ae8b29f8fe49 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Sun, 5 Mar 2017 22:53:05 -0500 Subject: [PATCH] Export mark-as-done and action-already-done-p Refactor plan to define and export two functions that make POIU's life easier. --- plan.lisp | 51 ++++++++++++++++++++++++++++++++------------------- 1 file changed, 32 insertions(+), 19 deletions(-) diff --git a/plan.lisp b/plan.lisp index d959d3bc0..3621eec35 100644 --- a/plan.lisp +++ b/plan.lisp @@ -11,13 +11,14 @@ (:export #:plan #:plan-traversal #:sequential-plan #:*plan-class* #:action-status #:status-stamp #:status-index #:status-done-p #:status-keep-p #:status-need-p + #:action-already-done-p #:+status-good+ #:+status-todo+ #:+status-void+ #:system-out-of-date #:action-up-to-date-p #:circular-dependency #:circular-dependency-actions #:needed-in-image-p #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies #:compute-action-stamp #:traverse-action #:record-dependency - #:make-plan #:plan-actions #:plan-actions-r #:perform-plan + #:make-plan #:plan-actions #:plan-actions-r #:perform-plan #:mark-as-done #:required-components #:filtered-sequential-plan #:plan-component-type #:plan-keep-operation #:plan-keep-component)) (in-package :asdf/plan) @@ -172,13 +173,14 @@ the action of OPERATION on COMPONENT in the PLAN")) (defmethod action-status ((p plan) (o operation) (c component)) ;; TODO: should we instead test something like: ;; (action-forced-not-p plan operation (primary-system component)) - (if (action-forced-not-p (forcing p) o c) - (let ((status (action-status nil o c))) - (if (= +good-bits+ (status-bits status)) - status - (make-action-status :bits +good-bits+ - :stamp (or (and status (status-stamp status)) t)))) - (values (gethash (make-action o c) (visited-actions *asdf-session*))))) + (or (gethash (make-action o c) (visited-actions *asdf-session*)) + (when (action-forced-not-p (forcing p) o c) + (let ((status (action-status nil o c))) + (setf (gethash (make-action o c) (visited-actions *asdf-session*)) + (make-action-status + :bits +good-bits+ + :stamp (or (and status (status-stamp status)) t) + :index (incf (total-action-count *asdf-session*)))))))) (defmethod (setf action-status) (new-status (p plan) (o operation) (c component)) (setf (gethash (make-action o c) (visited-actions *asdf-session*)) new-status)) @@ -504,6 +506,10 @@ return a list of the components involved in building the desired action." (:documentation "Generate and return a plan for performing OPERATION on COMPONENT.")) (define-convenience-action-methods make-plan (plan-class operation component &key)) + (defgeneric mark-as-done (plan-class operation component) + (:documentation "Mark an action as done in a plan, after performing it.")) + (define-convenience-action-methods mark-as-done (plan-class operation component)) + (defgeneric perform-plan (plan &key) (:documentation "Actually perform a plan and build the requested actions")) @@ -523,18 +529,25 @@ return a list of the components involved in building the desired action." (with-compilation-unit () ;; backward-compatibility. (call-next-method)))) ;; Going forward, see deferred-warning support in lisp-build. + (defun action-already-done-p (plan operation component) + (if-let (status (action-status plan operation component)) + (status-done-p status))) + (defmethod perform-plan ((plan t) &key) (loop :for action :in (plan-actions plan) :as o = (action-operation action) :as c = (action-component action) :do - (let ((plan-status (action-status plan o c))) - (unless (status-done-p plan-status) - (perform-with-restarts o c) - (let ((perform-status (action-status nil o c))) - (assert (and (status-stamp perform-status) (status-done-p perform-status)) () - "Just performed ~A but failed to mark it done" (action-description o c)) - (setf (action-status plan o c) - (make-action-status - :bits (logior (status-bits perform-status) +done-bit+) - :stamp (status-stamp perform-status) - :index (status-index plan-status))))))))) + (unless (action-already-done-p plan o c) + (perform-with-restarts o c) + (mark-as-done plan o c)))) + + (defmethod mark-as-done ((plan plan) (o operation) (c component)) + (let ((plan-status (action-status plan o c)) + (perform-status (action-status nil o c))) + (assert (and (status-stamp perform-status) (status-done-p perform-status)) () + "Just performed ~A but failed to mark it done" (action-description o c)) + (setf (action-status plan o c) + (make-action-status + :bits (logior (status-bits perform-status) +done-bit+) + :stamp (status-stamp perform-status) + :index (status-index plan-status)))))) -- GitLab