Add support for proper phase separation

François-René Rideaurequested to merge
plan into master

Add support for proper phase separation

Correctly handle incremental builds in cases where operate can be called while loading a .asd file, especially as part of a defsystem-depends-on declaration.

If a defsystem-depends-on dependency is out of date, re-load all needed .asd file that depend on it. But if a file is compiled or loaded in one of those nested calls to operate, don't perform the action twice.

Rename cache.lisp to session.lisp and move parts of plan.lisp to session.lisp and a new file forcing.lisp, to support the notion of a session made of several phases of operate(plan-then-perform). Split system-registry.lisp off of find-system.lisp.

Refine the notion of action status within a session: a stamp and three bits KEEP (from previous session), DONE (and up-to-date in this image), NEED (for the session's goal).

Backward incompatible change in internal APIs: uiop stamps now have NIL for +infinity and T for -infinity. No one in Quicklisp uses it, but just in case, it must be noted.

Merge request reports

contrib/debug-plan.lisp

+89 −59
Changes for contrib/debug-plan.lisp: 89 added lines, 59 removed lines.
Original line number Diff line number Diff line 
(defpackage :asdf/contrib/plan (:use :cl)) ;; dummy, for use as package-inferred-system



(in-package :asdf/plan)



;; NB: Whenever compute-action-stamp is changed, this file must be updated

;; to insert the let-and-DBG statements in the current version of the function.

;; So if you find this file not working, it might be out of date.



(uiop:uiop-debug)



(progn
@@ -8,81 +14,100 @@ 
    ;; or if it has just been done, return the time that it has.

    ;; Returns two values:

    ;; 1- the TIMESTAMP of the action if it has already been done and is up to date,

    ;;   or T is either hasn't been done or is out of date.

    ;;   or NIL is either hasn't been done or is out of date.

    ;;   (An ASDF extension could use a cryptographic digest instead.)

    ;; 2- the DONE-IN-IMAGE-P boolean flag that is T if the action has already been done

    ;;   in the current image, or NIL if it hasn't.

    ;; Note that if e.g. LOAD-OP only depends on up-to-date files, but

    ;; hasn't been done in the current image yet, then it can have a non-T timestamp,

    ;; yet a NIL done-in-image-p flag.

    ;; hasn't been done in the current image yet, then it can have a non-NIL timestamp,

    ;; yet a NIL done-in-image-p flag: we can predict what timestamp it will have once loaded,

    ;; i.e. that of the input-files.

    ;; If just-done is NIL, these values return are the notional fields of

    ;; a KEEP, REDO or TODO status (VOID is possible, but probably an error).

    ;; If just-done is T, they are the notional fields of DONE status

    ;; (or, if something went wrong, TODO).

    (nest

     (block ())

     (let ((dep-stamp ; collect timestamp from dependencies (or T if forced or out-of-date)

     (let* ((dep-status ; collect timestamp from dependencies (or T if forced or out-of-date)

             (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))

         (let ((outdated-deps

                 (reduce-direct-dependencies

                  plan o c

                  #'(lambda (o c deps)

                      (if (if-let (it (plan-action-status plan o c))

                            (not (eq t (action-stamp it))))

                          deps

                          (cons (cons o c) deps)))

                  nil)))

           (DBG "compute-action-stamp: forced by out of date dependency"

                (cons o c)

                outdated-deps))

         (return (values t nil))))

     ;; collect timestamps from inputs, and exit early if any is missing

     (let* ((in-files (input-files o c))

              o c

              #'(lambda (do dc status)

                  ;; out-of-date dependency: don't bother looking further

                  (let ((action-status (action-status plan do dc)))

                    (cond

                      ((and action-status (or (status-keep-p action-status)

                                              (and just-done (status-stamp action-status))))

                       (merge-action-status action-status status))

                      (just-done

                       ;; It's OK to lose some ASDF action stamps during self-upgrade

                       (unless (equal "asdf" (primary-system-name dc))

                         (warn "Computing just-done stamp in plan ~S for action ~S, but dependency ~S wasn't done yet!"

                               plan

                               (action-path (make-action o c))

                               (action-path (make-action do dc))))

                       status)

                      (t

                       (DBG "compute-action-stamp: forced by out of date dependency" (action-path (make-action o c)) (action-path (make-action do dc)) action-status)

                       (return (values nil nil))))))

              +status-good+))

            (dep-stamp (status-stamp dep-status)))

       ;; DBG

       (when (null dep-stamp)

         (let* ((action-path (action-path (cons o c)))

                (dep-statuses (loop for action in (direct-dependencies o c) for (o . c) = action collect

                                    (list (action-path action) (action-status plan o c)))))

           (DBG :nds action-path dep-statuses))))

     (let* (;; collect timestamps from inputs, and exit early if any is missing

            (in-files (input-files o c))

            (in-stamps (mapcar #'get-file-stamp in-files))

            (missing-in (loop :for f :in in-files :for s :in in-stamps :unless s :collect f))

            (latest-in (stamps-latest (cons dep-stamp in-stamps))))

       (when (and missing-in (not just-done))

         (DBG "compute-action-stamp: missing inputs"

              (cons o c)

              missing-in)

         (return (values t nil))))

     ;; collect timestamps from outputs, and exit early if any is missing

     (let* ((out-files (remove-if 'null (output-files o c)))

         (DBG "compute-action-stamp: missing inputs" (cons o c) missing-in)

         (return (values nil nil))))

     (let* (;; collect timestamps from outputs, and exit early if any is missing

            (out-files (remove-if 'null (output-files o c)))

            (out-stamps (mapcar (if just-done 'register-file-stamp 'get-file-stamp) out-files))

            (missing-out (loop :for f :in out-files :for s :in out-stamps :unless s :collect f))

            (earliest-out (stamps-earliest out-stamps)))

       (when (and missing-out (not just-done))

         (DBG "compute-action-stamp: missing outputs"

              (cons o c)

              missing-out)

         (return (values t nil))))

     (let* (;; There are three kinds of actions:

            (out-op (and out-files t)) ; those that create files on the filesystem

            ;;(image-op (and in-files (null out-files))) ; those that load stuff into the image

            ;;(null-op (and (null out-files) (null in-files))) ; placeholders that do nothing

            ;; When was the thing last actually done? (Now, or ask.)

            (op-time (or just-done (component-operation-time o c)))

            ;; Time stamps from the files at hand, and whether any is missing

         (DBG "compute-action-stamp: missing outputs" (cons o c) missing-out)

         (return (values nil nil))))

     (let (;; Time stamps from the files at hand, and whether any is missing

           (all-present (not (or missing-in missing-out)))

           ;; Has any input changed since we last generated the files?

           ;; Note that we use stamp<= instead of stamp< to play nice with generated files.

           ;; Any race condition is intrinsic to the limited timestamp resolution.

           (up-to-date-p (stamp<= latest-in earliest-out))

           ;; If everything is up to date, the latest of inputs and outputs is our stamp

           (done-stamp (stamps-latest (cons latest-in out-stamps))))

       ;; Warn if some files are missing:

       ;; either our model is wrong or some other process is messing with our files.

       (when (and just-done (not all-present))

         ;; Shouldn't that be an error instead?

         (warn "~A completed without ~:[~*~;~*its input file~:p~2:*~{ ~S~}~*~]~

                ~:[~; or ~]~:[~*~;~*its output file~:p~2:*~{ ~S~}~*~]"

               (action-description o c)

               missing-in (length missing-in) (and missing-in missing-out)

               missing-out (length missing-out)))

       (let ((already-done-p (and all-present up-to-date-p (operation-done-p o c) (not (action-forced-p plan o c))))

             (matching-stamp-p (and op-time (eql op-time done-stamp))))

               missing-out (length missing-out))))

     (let (;; There are three kinds of actions:

           (out-op (and out-files t)) ; those that create files on the filesystem

           ;;(image-op (and in-files (null out-files))) ; those that load stuff into the image

           ;;(null-op (and (null out-files) (null in-files))) ; placeholders that do nothing

           ))

     ;; Status of the action as previously performed in the image

     (progn ;; DBG

       (multiple-value-bind (perform-stamp perform-done-p)

           (if just-done

               (values done-stamp t)

               (component-operation-time o c))

         (let* ((forced (action-forced-p (forcing (or plan *asdf-session*)) o c))

                (already-done-p (and all-present up-to-date-p (operation-done-p o c)

                                     (not forced)))

                (matching-stamp-p (and perform-done-p (eql perform-stamp done-stamp)))

                (action-path (action-path (cons o c))))

           (DBG "compute-action-stamp"

            (cons o c)

                action-path

                in-files

                in-stamps

                dep-stamp
@@ -91,23 +116,28 @@ 
                latest-in

                earliest-out

                up-to-date-p

            op-time

                perform-stamp

                perform-done-p

                done-stamp

            ;; (eql op-time done-stamp)

                all-present

                forced

                already-done-p

                just-done

                out-op

            matching-stamp-p)))

     ;; Note that we use stamp<= instead of stamp< to play nice with generated files.

     ;; Any race condition is intrinsic to the limited timestamp resolution.

                matching-stamp-p))))

     (if (or just-done ;; The done-stamp is valid: if we're just done, or

             ;; if all filesystem effects are up-to-date and there's no invalidating reason.

             (and all-present up-to-date-p (operation-done-p o c) (not (action-forced-p plan o c))))

             (and all-present ;; if all filesystem effects are up-to-date

                  up-to-date-p

                  (operation-done-p o c) ;; and there's no invalidating reason.

                  (not (action-forced-p (forcing (or plan *asdf-session*)) o c))))

         (values done-stamp ;; return the hard-earned timestamp

                 (or just-done

                     out-op ;; a file-creating op is done when all files are up to date

                     ;; a image-effecting a placeholder op is done when it was actually run,

                     (and op-time (eql op-time done-stamp)))) ;; with the matching stamp

                     out-op ;; A file-creating op is done when all files are up to date.

                     ;; An image-effecting operation is done when

                     (and (status-done-p dep-status) ;; all the dependencies were done, and

                          (multiple-value-bind (perform-stamp perform-done-p)

                              (component-operation-time o c)

                            (and perform-done-p ;; the op was actually run,

                                 (equal perform-stamp done-stamp)))))) ;; with a matching stamp.

         ;; done-stamp invalid: return a timestamp in an indefinite future, action not done yet

         (values t nil)))))
 
         (values nil nil)))))

contrib/detect-multiply-used-files.lisp

+2 −2
Changes for contrib/detect-multiply-used-files.lisp: 2 added lines, 2 removed lines.
Original line number Diff line number Diff line 
(uiop:define-package :detect-multiply-used-files

  (:nicknames :asdf/contrib/detect-multiply-used-files)

  (:use :asdf :uiop :common-lisp)

  (:use :asdf/component :asdf/system-registry :uiop :common-lisp)

  (:export #:find-fishy-components #:register-component-files #:*file-components*))



(in-package :detect-multiply-used-files)
@@ -20,7 +20,7 @@ 


(defun find-fishy-components ()

  (clrhash *file-components*)

  (map () 'register-component-files (table-keys asdf::*defined-systems*))

  (map () 'register-component-files (table-keys *registered-systems*))

  (loop :for p :in (sort (table-keys *file-components*) 'string<)

        :for l = (gethash p *file-components*)

        :when (and (file-pathname-p p) (not (length=n-p l 1)))

contrib/wild-modules.lisp

+3 −0
Changes for contrib/wild-modules.lisp: 3 added lines, 0 removed lines.
Original line number Diff line number Diff line
@@ -30,4 +30,7 @@ use a wild pathname instead." module))) 
    (compute-children-by-name self)

    (values)))



(defmethod input-files ((o compile-op) (c wild-module)) ())

(defmethod input-files ((o load-op) (c wild-module)) ())



(export 'wild-module)

doc/asdf.texinfo

+21 −17
Changes for doc/asdf.texinfo: 21 added lines, 17 removed lines.
Original line number Diff line number Diff line
@@ -1490,6 +1490,12 @@ simple-component-name := string 


pathname-specifier := pathname | string | symbol



version-specifier := string

                     | (:read-file-form <pathname-specifier> <form-specifier>?)

                     | (:read-file-line <pathname-specifier> <line-specifier>?)

line-specifier := :at integer # base zero

form-specifier := :at [ integer | ( integer+ )]



method-form := (operation-name qual lambda-list @Arest{} body)

qual := method qualifier?
@@ -1689,12 +1695,17 @@ Instead of a string representing the version, 
the @code{:version} argument can be an expression that is resolved to

such a string using the following trivial domain-specific language:

in addition to being a literal string, it can be an expression of the form

@code{(:read-file-form <pathname-or-string> :at <access-at-specifier>)},

which will be resolved by reading a form in the specified pathname

(read as a subpathname of the current system if relative or a unix-namestring).

@code{(:read-file-form <pathname-or-string> [:at <access-at-specifier]>)},

or @code{(:read-file-line <pathname-or-string> [:at

<access-at-specifier]?>)}.

As the name suggests, the former will be resolved by reading a form in the specified pathname

(read as a subpathname of the current system if relative or a

unix-namestring), and the latter by reading a line.

You may use a @code{uiop:access-at} specifier

with the (optional) @code{:at} keyword,

by default the specifier is @code{0}, meaning the first form is returned;

with the @code{:at} keyword,

by default the specifier is @code{0}, meaning the first form/line is

returned.

For @code{:read-file-form},

subforms can also be specified, with e.g. @code{(1 2 2)} specifying

``the third subform (index 2) of the third subform (index 2) of the second form (index 1)''

in the file (mind the off-by-one error in the English language).
@@ -6249,24 +6260,17 @@ Here's the procedure for experimenting with tests in a REPL: 
;; Load the test script support.

(load "script-support.lisp")



;; Initialize the script support.

;; This will also change your *package* to asdf-test.

;; Initialize the script support for interaction.

;; This will also change your *package* to asdf-test

;; after frobbing the asdf-test package to make it usable.

;; NB: this function is also available from package cl-user,

;; and also available with the shorter name da in both packages.

(asdf-test::debug-asdf)



;; In case you modified ASDF since you last tested it,

;; you need to update asdf.lisp itself by evaluating 'make' in a shell,

;; or (require "asdf") (asdf:load-system :asdf) in another CL REPL,

;; if not done in this REPL above.

;; *Then*, in this REPL, you need to evaluate:

;(asdf-test::compile-load-asdf)

(asdf-test:debug-asdf)



;; Now, you may experiment with test code from a .script file.

;; See the instructions given at the end of your failing test

;; to identify which form is needed, e.g.

(frob-packages)

(asdf::with-asdf-cache () (load "test-utilities.script"))

(run-test-script "test-utilities.script")

@end example

test/defsystem-depends-on/defsystem-dependency.asd

0 → 100644
+4 −0
Changes for test/defsystem-depends-on/defsystem-dependency.asd: 4 added lines, 0 removed lines.
Original line number Diff line number Diff line 
(defsystem "defsystem-dependency"

  :depends-on ("overlapping-dependency")

  :components ((:file "defsystem-dependency"))

  :in-order-to ((test-op (test-op "test-system"))))