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

Optimize away unneeded filesystem queries during planning.

parent bbad91e8
...@@ -213,52 +213,59 @@ the action of OPERATION on COMPONENT in the PLAN")) ...@@ -213,52 +213,59 @@ the action of OPERATION on COMPONENT in the PLAN"))
;; Note that if e.g. LOAD-OP only depends on up-to-date files, but ;; 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, ;; 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. ;; yet a NIL done-in-image-p flag.
(let* ((stamp-lookup #'(lambda (o c) (nest
(if-let (it (plan-action-status plan o c)) (action-stamp it) t))) (block ())
(out-files (output-files o c)) (let ((dep-stamp ; collect timestamp from dependencies (or T if forced or out-of-date)
(in-files (input-files o c)) (visit-dependencies plan o c #'(lambda (o c)
;; Three kinds of actions: (if-let (it (plan-action-status plan o c))
(out-op (and out-files t)) ; those that create files on the filesystem (action-stamp it)
;;(image-op (and in-files (null out-files))) ; those that load stuff into the image t)))))
;;(null-op (and (null out-files) (null in-files))) ; placeholders that do nothing ;; out-of-date dependency: don't bother expensively querying the filesystem
;; When was the thing last actually done? (Now, or ask.) (when (and (eq dep-stamp t) (not just-done)) (return (values t nil))))
(op-time (or just-done (component-operation-time o c))) ;; collect timestamps from inputs, and exit early if any is missing
;; Accumulated timestamp from dependencies (or T if forced or out-of-date) (let* ((in-files (input-files o c))
(dep-stamp (visit-dependencies plan o c stamp-lookup)) (in-stamps (mapcar #'get-file-stamp in-files))
;; Time stamps from the files at hand, and whether any is missing (missing-in (loop :for f :in in-files :for s :in in-stamps :unless s :collect f))
(out-stamps (mapcar (if just-done 'register-file-stamp 'get-file-stamp) out-files)) (latest-in (stamps-latest (cons dep-stamp in-stamps))))
(in-stamps (mapcar #'get-file-stamp in-files)) (when (and missing-in (not just-done)) (return (values t nil))))
(missing-in ;; collect timestamps from outputs, and exit early if any is missing
(loop :for f :in in-files :for s :in in-stamps :unless s :collect f)) (let* ((out-files (output-files o c))
(missing-out (out-stamps (mapcar (if just-done 'register-file-stamp 'get-file-stamp) out-files))
(loop :for f :in out-files :for s :in out-stamps :unless s :collect f)) (missing-out (loop :for f :in out-files :for s :in out-stamps :unless s :collect f))
(all-present (not (or missing-in missing-out))) (earliest-out (stamps-earliest out-stamps)))
;; Has any input changed since we last generated the files? (when (and missing-out (not just-done)) (return (values t nil))))
(earliest-out (stamps-earliest out-stamps)) (let* (;; There are three kinds of actions:
(latest-in (stamps-latest (cons dep-stamp in-stamps))) (out-op (and out-files t)) ; those that create files on the filesystem
(up-to-date-p (stamp<= latest-in earliest-out)) ;;(image-op (and in-files (null out-files))) ; those that load stuff into the image
;; If everything is up to date, the latest of inputs and outputs is our stamp ;;(null-op (and (null out-files) (null in-files))) ; placeholders that do nothing
(done-stamp (stamps-latest (cons latest-in out-stamps)))) ;; When was the thing last actually done? (Now, or ask.)
;; Warn if some files are missing: (op-time (or just-done (component-operation-time o c)))
;; either our model is wrong or some other process is messing with our files. ;; Time stamps from the files at hand, and whether any is missing
(when (and just-done (not all-present)) (all-present (not (or missing-in missing-out)))
(warn "~A completed without ~:[~*~;~*its input file~:p~2:*~{ ~S~}~*~]~ ;; Has any input changed since we last generated the files?
~:[~; or ~]~:[~*~;~*its output file~:p~2:*~{ ~S~}~*~]" (up-to-date-p (stamp<= latest-in earliest-out))
(action-description o c) ;; If everything is up to date, the latest of inputs and outputs is our stamp
missing-in (length missing-in) (and missing-in missing-out) (done-stamp (stamps-latest (cons latest-in out-stamps))))
missing-out (length missing-out))) ;; Warn if some files are missing:
;; Note that we use stamp<= instead of stamp< to play nice with generated files. ;; either our model is wrong or some other process is messing with our files.
;; Any race condition is intrinsic to the limited timestamp resolution. (when (and just-done (not all-present))
(if (or just-done ;; The done-stamp is valid: if we're just done, or (warn "~A completed without ~:[~*~;~*its input file~:p~2:*~{ ~S~}~*~]~
;; if all filesystem effects are up-to-date and there's no invalidating reason. ~:[~; or ~]~:[~*~;~*its output file~:p~2:*~{ ~S~}~*~]"
(and all-present up-to-date-p (operation-done-p o c) (not (action-forced-p plan o c)))) (action-description o c)
(values done-stamp ;; return the hard-earned timestamp missing-in (length missing-in) (and missing-in missing-out)
(or just-done missing-out (length missing-out))))
out-op ;; a file-creating op is done when all files are up to date ;; Note that we use stamp<= instead of stamp< to play nice with generated files.
;; a image-effecting a placeholder op is done when it was actually run, ;; Any race condition is intrinsic to the limited timestamp resolution.
(and op-time (eql op-time done-stamp)))) ;; with the matching stamp (if (or just-done ;; The done-stamp is valid: if we're just done, or
;; done-stamp invalid: return a timestamp in an indefinite future, action not done yet ;; if all filesystem effects are up-to-date and there's no invalidating reason.
(values t nil))))) (and all-present up-to-date-p (operation-done-p o c) (not (action-forced-p plan 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
;; done-stamp invalid: return a timestamp in an indefinite future, action not done yet
(values t nil)))))
;;;; Generic support for plan-traversal ;;;; Generic support for plan-traversal
......
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