Commit 50b839d3 by Robert Goldman

Merge branch 'stamp' into 'master'

Rename stamp to timestamp in uiop/utility

See merge request !87
parents c380acd1 c6654583
......@@ -61,7 +61,7 @@
(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))))
(latest-in (timestamps-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 nil nil))))
......@@ -69,18 +69,18 @@
(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)))
(earliest-out (timestamps-earliest out-stamps)))
(when (and missing-out (not just-done))
(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.
;; Note that we use timestamp<= instead of timestamp< 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))
(up-to-date-p (timestamp<= 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))))
(done-stamp (timestamps-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))
......
......@@ -242,7 +242,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(let ((o (make-operation 'define-op)))
(multiple-value-bind (stamp done-p)
(compute-action-stamp plan o system)
(return (and (stamp<= stamp (component-operation-time o system))
(return (and (timestamp<= stamp (component-operation-time o system))
done-p)))))
(system-out-of-date () nil)))
......@@ -269,7 +269,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(pathname-equal
(physicalize-pathname pathname)
(physicalize-pathname previous-pathname))))
(stamp<= stamp previous-time)
(timestamp<= stamp previous-time)
;; TODO: check that all dependencies are up-to-date.
;; This necessitates traversing them without triggering
;; the adding of nodes to the plan.
......
......@@ -139,7 +139,7 @@ or NIL if no the status is considered outside of a specific plan."))
"Return the earliest status later than both status1 and status2"
(make-action-status
:bits (logand (status-bits status1) (status-bits status2))
:stamp (latest-stamp (status-stamp status1) (status-stamp status2))
:stamp (latest-timestamp (status-stamp status1) (status-stamp status2))
:level (min (status-level status1) (status-level status2))
:index (or (status-index status1) (status-index status2))))
......@@ -292,22 +292,22 @@ initialized with SEED."
(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))))
(latest-in (timestamps-latest (cons dep-stamp in-stamps))))
(when (and missing-in (not just-done)) (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)))
(earliest-out (timestamps-earliest out-stamps)))
(when (and missing-out (not just-done)) (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.
;; Note that we use timestamp<= instead of timestamp< 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))
(up-to-date-p (timestamp<= 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))))
(done-stamp (timestamps-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))
......
......@@ -687,6 +687,10 @@ is bound, write a message and exit on an error. If
(format t "CR ~S~%" (symbol-value (asym :*central-registry*)))
(format t "loading test-module-depend~%")
(acall :oos (asym :load-op) :test-module-depend)
(assert-equal (asymval :*f2c* :test-package) 1)
(format t "loading test-module-depend again -- shouldn't rebuild anything~%")
(acall :oos (asym :load-op) :test-module-depend)
(assert-equal (asymval :*f2c* :test-package) 1)
(format t "done loading~%"))
(defun load-asdf (&optional tag)
......
......@@ -54,7 +54,7 @@
;; (trace asdf/action::component-operation-time)
;; #+allegro #+allegro
;; (trace (asdf:input-files :inside asdf/plan::compute-action-stamp)
;; (asdf/plan::stamp<= :inside asdf/plan::compute-action-stamp)
;; (asdf/plan::timestamp<= :inside asdf/plan::compute-action-stamp)
;; (asdf/plan::get-file-stamp :inside asdf/plan::compute-action-stamp))
;;; bump the version
......@@ -91,7 +91,7 @@
:inside asdf:find-system)
(asdf/find-system::get-file-stamp
:inside find-system)
(asdf/find-system::stamp<=
(asdf/find-system::timestamp<=
:inside find-system))
;; AFAICT, the :WHEREIN in SBCL TRACE does not work
;; properly. In my copious free time, I should see if I
......
......@@ -25,9 +25,9 @@
#:string-prefix-p #:string-enclosed-p #:string-suffix-p
#:standard-case-symbol-name #:find-standard-case-symbol ;; symbols
#:coerce-class ;; CLOS
#:stamp< #:stamps< #:stamp*< #:stamp<= ;; stamps
#:earlier-stamp #:stamps-earliest #:earliest-stamp
#:later-stamp #:stamps-latest #:latest-stamp #:latest-stamp-f
#:timestamp< #:timestamps< #:timestamp*< #:timestamp<= ;; timestamps
#:earlier-timestamp #:timestamps-earliest #:earliest-timestamp
#:later-timestamp #:timestamps-latest #:latest-timestamp #:latest-timestamp-f
#:list-to-hash-set #:ensure-gethash ;; hash-table
#:ensure-function #:access-at #:access-at-count ;; functions
#:call-function #:call-functions #:register-hook-function
......@@ -375,11 +375,11 @@ If optional ERROR argument is NIL, return NIL instead of an error when the symbo
(string (standard-case-symbol-name package-designator)))
error)))
;;; stamps: a REAL or a boolean where T=-infinity, NIL=+infinity
;;; timestamps: a REAL or a boolean where T=-infinity, NIL=+infinity
(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute)
(deftype stamp () '(or real boolean)))
(deftype timestamp () '(or real boolean)))
(with-upgradability ()
(defun stamp< (x y)
(defun timestamp< (x y)
(etypecase x
((eql t) (not (eql y t)))
(real (etypecase y
......@@ -387,16 +387,16 @@ If optional ERROR argument is NIL, return NIL instead of an error when the symbo
(real (< x y))
(null t)))
(null nil)))
(defun stamps< (list) (loop :for y :in list :for x = nil :then y :always (stamp< x y)))
(defun stamp*< (&rest list) (stamps< list))
(defun stamp<= (x y) (not (stamp< y x)))
(defun earlier-stamp (x y) (if (stamp< x y) x y))
(defun stamps-earliest (list) (reduce 'earlier-stamp list :initial-value nil))
(defun earliest-stamp (&rest list) (stamps-earliest list))
(defun later-stamp (x y) (if (stamp< x y) y x))
(defun stamps-latest (list) (reduce 'later-stamp list :initial-value t))
(defun latest-stamp (&rest list) (stamps-latest list))
(define-modify-macro latest-stamp-f (&rest stamps) latest-stamp))
(defun timestamps< (list) (loop :for y :in list :for x = nil :then y :always (timestamp< x y)))
(defun timestamp*< (&rest list) (timestamps< list))
(defun timestamp<= (x y) (not (timestamp< y x)))
(defun earlier-timestamp (x y) (if (timestamp< x y) x y))
(defun timestamps-earliest (list) (reduce 'earlier-timestamp list :initial-value nil))
(defun earliest-timestamp (&rest list) (timestamps-earliest list))
(defun later-timestamp (x y) (if (timestamp< x y) y x))
(defun timestamps-latest (list) (reduce 'later-timestamp list :initial-value t))
(defun latest-timestamp (&rest list) (timestamps-latest list))
(define-modify-macro latest-timestamp-f (&rest timestamps) latest-timestamp))
;;; Function designators
......
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