Commit 8e41713c authored by Robert Goldman's avatar Robert Goldman

Make MAKE-ACTION a BOA constructor.

parent f19b8160
......@@ -37,8 +37,7 @@ and a class-name or class designates the canonical instance of the designated cl
;;; these are pseudo accessors -- let us abstract away the CONS cell representation of plan
;;; actions.
(with-upgradability ()
(defun make-action (&key operation component)
(assert (and operation component))
(defun make-action (operation component)
(cons operation component))
(defun action-operation (action)
(car action))
......@@ -54,7 +53,7 @@ and a class-name or class designates the canonical instance of the designated cl
(cons (type-of o) (component-find-path c))))
(defun find-action (path)
"Reconstitute an action from its action-path"
(destructuring-bind (o . c) path (make-action :operation (make-operation o) :component (find-component () c)))))
(destructuring-bind (o . c) path (make-action (make-operation o) (find-component () c)))))
;;;; Convenience methods
(with-upgradability ()
......@@ -104,7 +103,7 @@ and a class-name or class designates the canonical instance of the designated cl
(defmethod ,function (,@prefix (,operation operation) ,component ,@suffix ,@more-args)
(if (typep ,component 'component)
(error "No defined method for ~S on ~/asdf-action:format-action/"
',function (make-action :operation ,operation :component ,component))
',function (make-action ,operation ,component))
(if-let (,found (find-component () ,component))
,(next-method operation found)
,if-no-component))))))))
......@@ -426,7 +425,7 @@ in some previous image, or T if it needs to be done.")
selfward-operation non-propagating-operation))
(sysdef-error
(compatfmt "~@<Required method ~S not implemented for ~/asdf-action:format-action/~@:>")
'perform (make-action :operation o :component c))))
'perform (make-action o c))))
;; The restarts of the perform-with-restarts variant matter in an interactive context.
;; The retry strategies of p-w-r itself, and/or the background workers of a multiprocess build
......
......@@ -342,7 +342,7 @@ initialized with SEED."
(defmethod call-while-visiting-action ((plan plan-traversal) operation component fun)
(with-accessors ((action-set plan-visiting-action-set)
(action-list plan-visiting-action-list)) plan
(let ((action (make-action :operation operation :component component)))
(let ((action (make-action operation component)))
(when (gethash action action-set)
(error 'circular-dependency :actions
(member action (reverse action-list) :test 'equal)))
......@@ -439,7 +439,7 @@ initialized with SEED."
(defmethod (setf plan-action-status) :after
(new-status (p sequential-plan) (o operation) (c component))
(when (action-planned-p new-status)
(push (make-action :operation o :component c) (plan-actions-r p)))))
(push (make-action o c) (plan-actions-r p)))))
;;;; High-level interface: traverse, perform-plan, plan-operates-on-p
......@@ -538,7 +538,7 @@ initialized with SEED."
:as o = (action-operation action)
:as c = (action-component action)
:when (and (typep o keep-operation) (typep c keep-component))
:collect (make-action :operation o :component c))))
:collect (make-action o c))))
(defun* (required-components) (system &rest keys &key (goal-operation 'load-op) &allow-other-keys)
"Given a SYSTEM and a GOAL-OPERATION (default LOAD-OP), traverse the dependencies and
......
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