Commit b570ee9f authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

plan changes:

* move *all* timestamp management to COMPUTE-ACTION-STAMP.
* goodbye visit-dependencies, move its functionality to map-direct-dependencies,
* refactored map-direct-dependencies and co to always take a plan object.
* modified clients of map-direct-dependencies and co to pass a proper plan, or t.
Add invalid file with false if-feature to bundle.
parent bb911b65
Loading
Loading
Loading
Loading
+4 −4
Original line number Diff line number Diff line
@@ -240,9 +240,9 @@ itself.")) ;; operation on a system and its dependencies
    ;; your component-depends-on method better gathered the correct dependencies in the correct order.
    (while-collecting (collect)
      (map-direct-dependencies
       o c #'(lambda (sub-o sub-c)
               (loop :for f :in (funcall key sub-o sub-c)
                     :when (funcall test f) :do (collect f))))))
       t o c #'(lambda (sub-o sub-c)
                 (loop :for f :in (funcall key sub-o sub-c)
                       :when (funcall test f) :do (collect f))))))

  (defmethod input-files ((o gather-op) (c system))
    (unless (eq (bundle-type o) :no-output-file)
@@ -368,7 +368,7 @@ itself.")) ;; operation on a system and its dependencies
                                                       :keep-operation 'load-op))
                 (while-collecting (x) ;; resolve the sideway-dependencies of s
                   (map-direct-dependencies
                    'load-op s
                    t 'load-op s
                    #'(lambda (o c)
                        (when (and (typep o 'load-op) (typep c 'system))
                          (x c)))))))
+26 −31
Original line number Diff line number Diff line
@@ -9,7 +9,7 @@
   :asdf/operation :asdf/action :asdf/lisp-action)
  (:export
   #:component-operation-time #:mark-operation-done
   #:plan-traversal #:sequential-plan #:*default-plan-class*
   #:plan #:plan-traversal #:sequential-plan #:*default-plan-class*
   #:planned-action-status #:plan-action-status #:action-already-done-p
   #:circular-dependency #:circular-dependency-actions
   #:node-for #:needed-in-image-p
@@ -17,7 +17,7 @@
   #:plan-record-dependency
   #:normalize-forced-systems #:action-forced-p #:action-forced-not-p
   #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies
   #:visit-dependencies #:compute-action-stamp #:traverse-action
   #:compute-action-stamp #:traverse-action
   #:circular-dependency #:circular-dependency-actions
   #:call-while-visiting-action #:while-visiting-action
   #:make-plan #:plan-actions #:perform-plan #:plan-operates-on-p
@@ -32,7 +32,8 @@

;;;; Generic plan traversal class
(with-upgradability ()
  (defclass plan-traversal ()
  (defclass plan () ())
  (defclass plan-traversal (plan)
    ((system :initform nil :initarg :system :accessor plan-system)
     (forced :initform nil :initarg :force :accessor plan-forced)
     (forced-not :initform nil :initarg :force-not :accessor plan-forced-not)
@@ -146,13 +147,12 @@ the action of OPERATION on COMPONENT in the PLAN"))
(with-upgradability ()
  (defgeneric action-valid-p (plan operation component)
    (:documentation "Is this action valid to include amongst dependencies?"))
  (defmethod action-valid-p ((plan plan-traversal) (o operation) (c component))
  (defmethod action-valid-p ((plan t) (o operation) (c component))
    (if-let (it (component-if-feature c)) (featurep it) t))
  (defmethod action-valid-p ((plan t) (o null) (c t)) nil)
  (defmethod action-valid-p ((plan t) (o t) (c null)) nil)
  (defmethod action-valid-p ((plan null) (o operation) (c component)) t))


;;;; Is the action needed in this image?
(with-upgradability ()
  (defgeneric needed-in-image-p (operation component)
@@ -169,38 +169,30 @@ the action of OPERATION on COMPONENT in the PLAN"))

;;;; Visiting dependencies of an action and computing action stamps
(with-upgradability ()
  (defun map-direct-dependencies (operation component fun)
  (defun (map-direct-dependencies) (plan operation component fun)
    (loop* :for (dep-o-spec . dep-c-specs) :in (component-depends-on operation component)
           :for dep-o = (find-operation operation dep-o-spec)
           :when dep-o
           :do (loop :for dep-c-spec :in dep-c-specs
                     :for dep-c = (and dep-c-spec (resolve-dependency-spec component dep-c-spec))
                     :when dep-c
                     :when (and dep-c (action-valid-p plan dep-o dep-c))
                       :do (funcall fun dep-o dep-c))))

  (defun reduce-direct-dependencies (operation component combinator seed)
  (defun (reduce-direct-dependencies) (plan operation component combinator seed)
    (map-direct-dependencies
     operation component
     plan operation component
     #'(lambda (dep-o dep-c)
         (setf seed (funcall combinator dep-o dep-c seed))))
    seed)

  (defun direct-dependencies (operation component)
    (reduce-direct-dependencies operation component #'acons nil))
  (defun (direct-dependencies) (plan operation component)
    (reduce-direct-dependencies plan operation component #'acons nil))

  ;; In a distant future, get-file-stamp, component-operation-time and latest-stamp
  ;; shall also be parametrized by the plan, or by a second model object,
  ;; so they need not refer to the state of the filesystem,
  ;; and the stamps could be cryptographic checksums rather than timestamps.
  ;; Such a change remarkably would only affect VISIT-DEPENDENCIES and COMPUTE-ACTION-STAMP.

  (defun visit-dependencies (plan operation component dependency-stamper &aux stamp)
    (map-direct-dependencies
     operation component
     #'(lambda (dep-o dep-c)
         (when (action-valid-p plan dep-o dep-c)
           (latest-stamp-f stamp (funcall dependency-stamper dep-o dep-c)))))
    stamp)
  ;; Such a change remarkably would only affect COMPUTE-ACTION-STAMP.

  (defmethod compute-action-stamp (plan (o operation) (c component) &key just-done)
    ;; Given an action, figure out at what time in the past it has been done,
@@ -216,10 +208,13 @@ the action of OPERATION on COMPONENT in the PLAN"))
    (nest
     (block ())
     (let ((dep-stamp ; collect timestamp from dependencies (or T if forced or out-of-date)
             (visit-dependencies plan o c #'(lambda (o c)
                                              (if-let (it (plan-action-status plan o c))
                                                (action-stamp it)
                                                t)))))
             (reduce-direct-dependencies
              plan o c
              #'(lambda (o c stamp)
                  (if-let (it (plan-action-status plan o c))
                    (latest-stamp stamp (action-stamp it))
                    t))
              nil)))
       ;; out-of-date dependency: don't bother expensively querying the filesystem
       (when (and (eq dep-stamp t) (not just-done)) (return (values t nil))))
     ;; collect timestamps from inputs, and exit early if any is missing
@@ -352,8 +347,8 @@ the action of OPERATION on COMPONENT in the PLAN"))
        (when (and status (or (action-done-p status) (action-planned-p status) (not eniip)))
          (return (action-stamp status))) ; Already visited with sufficient need-in-image level!
        (labels ((visit-action (niip) ; We may visit the action twice, once with niip NIL, then T
                   (visit-dependencies plan operation component ; recursively traverse dependencies
                                       #'(lambda (o c) (traverse-action plan o c niip)))
                   (map-direct-dependencies ; recursively traverse dependencies
                    plan operation component #'(lambda (o c) (traverse-action plan o c niip)))
                   (multiple-value-bind (stamp done-p) ; AFTER dependencies have been traversed,
                       (compute-action-stamp plan operation component) ; compute action stamp
                     (let ((add-to-plan-p (or (eql stamp t) (and niip (not done-p)))))
@@ -398,7 +393,7 @@ the action of OPERATION on COMPONENT in the PLAN"))
    (when (action-planned-p new-status)
      (push (cons o c) (plan-actions-r p)))))

;;;; high-level interface: traverse, perform-plan, plan-operates-on-p
;;;; High-level interface: traverse, perform-plan, plan-operates-on-p
(with-upgradability ()
  (defgeneric make-plan (plan-class operation component &key &allow-other-keys)
    (:documentation
@@ -411,8 +406,7 @@ the action of OPERATION on COMPONENT in the PLAN"))
  (defvar *default-plan-class* 'sequential-plan)

  (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*)
    (let ((plan (apply 'make-instance (or plan-class *default-plan-class*)
                       :system (component-system c) keys)))
      (traverse-action plan o c t)
      plan))
@@ -471,8 +465,9 @@ the action of OPERATION on COMPONENT in the PLAN"))
      plan))

  (define-convenience-action-methods traverse-sub-actions (operation component &key))
  (defmethod traverse-sub-actions ((operation operation) (component component) &rest keys &key &allow-other-keys)
    (apply 'traverse-actions (direct-dependencies operation component)
  (defmethod traverse-sub-actions ((operation operation) (component component)
                                   &rest keys &key &allow-other-keys)
    (apply 'traverse-actions (direct-dependencies t operation component)
           :system (component-system component) keys))

  (defmethod plan-actions ((plan filtered-sequential-plan))
+3 −1
Original line number Diff line number Diff line
@@ -66,7 +66,9 @@
  :components ((:file "file1") (:file "file3")))

(defsystem :test-asdf/bundle-2
  :depends-on (:test-asdf/bundle-1) :components ((:file "file2")))
  :depends-on (:test-asdf/bundle-1) :components
  ((:file "file2")
   (:file "invalid-file" :if-feature (:not :common-lisp))))

(defsystem :test-asdf/force
  :depends-on (:test-asdf/force1)
+1 −0
Original line number Diff line number Diff line
@@ -89,6 +89,7 @@ previously-loaded version of ASDF."
	    #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action
	    #:component-depends-on #:operation-done-p #:component-depends-on
	    #:traverse ;; backward-interface
            #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies ;; plan
	    #:operate  ;; operate
	    #:parse-component-form ;; defsystem
	    #:apply-output-translations ;; output-translations