Commit 78da6e12 authored by Robert Goldman's avatar Robert Goldman

Add pseudo-accessors for ACTIONs.

Currently, ACTIONs are pairs of an OPERATION and a COMPONENT, and are
accessed with CAR and CDR.  Try to future-proof these by replacing with
ACTION-OP and ACTION-COMPONENT.
parent 2a764194
......@@ -14,6 +14,7 @@
#:component-depends-on
#:input-files #:output-files #:output-file #:operation-done-p
#:action-status #:action-stamp #:action-done-p
#:action-op #:action-component
#:component-operation-time #:mark-operation-done #:compute-action-stamp
#:perform #:perform-with-restarts #:retry #:accept
#:action-path #:find-action #:stamp #:done-p
......@@ -43,6 +44,13 @@ and a class-name or class designates the canonical instance of the designated cl
"Reconstitute an action from its action-path"
(destructuring-bind (o . c) path (cons (make-operation o) (find-component () c)))))
;;; these are pseudo accessors -- let us abstract away the CONS cell representation of plan
;;; actions.
(with-upgradability ()
(defun action-op (action)
(car action))
(defun action-component (action)
(cdr action)))
;;;; Convenience methods
(with-upgradability ()
......
......@@ -473,7 +473,9 @@ initialized with SEED."
(apply 'perform-plan (plan-actions plan) keys))
(defmethod perform-plan ((steps list) &key force &allow-other-keys)
(loop* :for (o . c) :in steps
(loop* :for action :in steps
:as o = (action-op action)
:as c = (action-component action)
:when (or force (not (nth-value 1 (compute-action-stamp nil o c))))
:do (perform-with-restarts o c)))
......@@ -481,7 +483,7 @@ initialized with SEED."
(plan-operates-on-p (plan-actions plan) component-path))
(defmethod plan-operates-on-p ((plan list) (component-path list))
(find component-path (mapcar 'cdr plan)
(find component-path (mapcar 'action-component plan)
:test 'equal :key 'component-find-path)))
......@@ -517,7 +519,10 @@ initialized with SEED."
(defun* (traverse-actions) (actions &rest keys &key plan-class &allow-other-keys)
"Given a list of actions, build a plan with these actions as roots."
(let ((plan (apply 'make-instance (or plan-class 'filtered-sequential-plan) keys)))
(loop* :for (o . c) :in actions :do (traverse-action plan o c t))
(loop* :for action :in actions
:as o = (action-op action)
:as c = (action-component action)
:do (traverse-action plan o c t))
plan))
(defgeneric traverse-sub-actions (operation component &key &allow-other-keys))
......@@ -529,7 +534,9 @@ initialized with SEED."
(defmethod plan-actions ((plan filtered-sequential-plan))
(with-slots (keep-operation keep-component) plan
(loop* :for (o . c) :in (call-next-method)
(loop* :for action :in (call-next-method)
:as o = (action-op action)
:as c = (action-component action)
:when (and (typep o keep-operation) (typep c keep-component))
:collect (cons o c))))
......@@ -537,7 +544,7 @@ initialized with SEED."
"Given a SYSTEM and a GOAL-OPERATION (default LOAD-OP), traverse the dependencies and
return a list of the components involved in building the desired action."
(remove-duplicates
(mapcar 'cdr (plan-actions
(mapcar 'action-component (plan-actions
(apply 'traverse-sub-actions goal-operation system
(remove-plist-key :goal-operation keys))))
:from-end t)))
......
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