From b570ee9f55413605bd79dcf1108476417d65b3e4 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Fri, 7 Mar 2014 14:33:18 -0500 Subject: [PATCH] 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. --- bundle.lisp | 8 +++---- plan.lisp | 57 +++++++++++++++++++++------------------------- test/test-asdf.asd | 4 +++- upgrade.lisp | 1 + 4 files changed, 34 insertions(+), 36 deletions(-) diff --git a/bundle.lisp b/bundle.lisp index 68d7bd05..fe020bf3 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -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))))))) diff --git a/plan.lisp b/plan.lisp index df88e3af..e7939498 100644 --- a/plan.lisp +++ b/plan.lisp @@ -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)) diff --git a/test/test-asdf.asd b/test/test-asdf.asd index 331e2edf..027002ba 100644 --- a/test/test-asdf.asd +++ b/test/test-asdf.asd @@ -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) diff --git a/upgrade.lisp b/upgrade.lisp index fa8e578b..52792f37 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -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 -- GitLab