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

Rename stamp to timestamp in uiop/utility

Restore backward compatibility with older versions of ASDF (before 3.3.0)
by renaming stamp< and its friends to timestamp<, etc.
Sometime in the lead-up to ASDF 3.3.0, I changed the encoding of infinities
from NIL is -infinity and T is +infinity to T is -infinity and T is +infinity
which made the code notably nicer on the ASDF side, because file-write-date
would return directly the correct result instead of having to constantly switch
between inverse conventions. However --- big mistake --- I kept the same
function name, after checking that the functions had no user in Quicklisp,
no one who had ever discussed them but me, and no documentation before 3.2.0
except a single comment line for the entire family of functions.
This doesn't matter as long as ASDF and UIOP are kept in synch, but such is
not the case with Quicklisp, where Xach both welcomes recent UIOP releases
but refuses to include updates to ASDF itself. Then, loading a new UIOP
with reverse conventions totally confuses the old ASDF, and causes spurious
rebuilds of everything after UIOP is loaded -- multiple times if present
in multiple phases (that and slower build times is how Xach noticed the bug).
The solution adopted is to give a new name to the functions with a different
convention -- timestamp< instead of stamp<, and so on. Therefore,
the new ASDF 3.3.1 will expect the new convention from UIOP 3.3.1,
that will no longer overwrite the functions from ASDF 3.2.1 and older with
backward-incompatible variants. If an old ASDF 3.2.1 or earlier loads
a newer UIOP 3.3.1 or later, it will keep using the old functions:
the symbols for these functions will be uninterned, but
the values for these functions which won't be clobbered anymore.
Backward compatibility is a strong requirement not to to break lightly,
not even in a subtle way, not even if "nobody else is using it" ---
an older version of ASDF is already "somebody else" with respect to UIOP.
parent 40020f7d
...@@ -61,7 +61,7 @@ ...@@ -61,7 +61,7 @@
(in-files (input-files o c)) (in-files (input-files o c))
(in-stamps (mapcar #'get-file-stamp in-files)) (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)) (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)) (when (and missing-in (not just-done))
(DBG "compute-action-stamp: missing inputs" (cons o c) missing-in) (DBG "compute-action-stamp: missing inputs" (cons o c) missing-in)
(return (values nil nil)))) (return (values nil nil))))
...@@ -69,18 +69,18 @@ ...@@ -69,18 +69,18 @@
(out-files (remove-if 'null (output-files o c))) (out-files (remove-if 'null (output-files o c)))
(out-stamps (mapcar (if just-done 'register-file-stamp 'get-file-stamp) out-files)) (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)) (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)) (when (and missing-out (not just-done))
(DBG "compute-action-stamp: missing outputs" (cons o c) missing-out) (DBG "compute-action-stamp: missing outputs" (cons o c) missing-out)
(return (values nil nil)))) (return (values nil nil))))
(let (;; Time stamps from the files at hand, and whether any is missing (let (;; Time stamps from the files at hand, and whether any is missing
(all-present (not (or missing-in missing-out))) (all-present (not (or missing-in missing-out)))
;; Has any input changed since we last generated the files? ;; 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. ;; 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 ;; 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: ;; Warn if some files are missing:
;; either our model is wrong or some other process is messing with our files. ;; either our model is wrong or some other process is messing with our files.
(when (and just-done (not all-present)) (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. ...@@ -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))) (let ((o (make-operation 'define-op)))
(multiple-value-bind (stamp done-p) (multiple-value-bind (stamp done-p)
(compute-action-stamp plan o system) (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))))) done-p)))))
(system-out-of-date () nil))) (system-out-of-date () nil)))
...@@ -269,7 +269,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. ...@@ -269,7 +269,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(pathname-equal (pathname-equal
(physicalize-pathname pathname) (physicalize-pathname pathname)
(physicalize-pathname previous-pathname)))) (physicalize-pathname previous-pathname))))
(stamp<= stamp previous-time) (timestamp<= stamp previous-time)
;; TODO: check that all dependencies are up-to-date. ;; TODO: check that all dependencies are up-to-date.
;; This necessitates traversing them without triggering ;; This necessitates traversing them without triggering
;; the adding of nodes to the plan. ;; the adding of nodes to the plan.
......
...@@ -139,7 +139,7 @@ or NIL if no the status is considered outside of a specific 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" "Return the earliest status later than both status1 and status2"
(make-action-status (make-action-status
:bits (logand (status-bits status1) (status-bits status2)) :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)) :level (min (status-level status1) (status-level status2))
:index (or (status-index status1) (status-index status2)))) :index (or (status-index status1) (status-index status2))))
...@@ -292,22 +292,22 @@ initialized with SEED." ...@@ -292,22 +292,22 @@ initialized with SEED."
(in-files (input-files o c)) (in-files (input-files o c))
(in-stamps (mapcar #'get-file-stamp in-files)) (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)) (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)))) (when (and missing-in (not just-done)) (return (values nil nil))))
(let* (;; collect timestamps from outputs, and exit early if any is missing (let* (;; collect timestamps from outputs, and exit early if any is missing
(out-files (remove-if 'null (output-files o c))) (out-files (remove-if 'null (output-files o c)))
(out-stamps (mapcar (if just-done 'register-file-stamp 'get-file-stamp) out-files)) (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)) (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)))) (when (and missing-out (not just-done)) (return (values nil nil))))
(let (;; Time stamps from the files at hand, and whether any is missing (let (;; Time stamps from the files at hand, and whether any is missing
(all-present (not (or missing-in missing-out))) (all-present (not (or missing-in missing-out)))
;; Has any input changed since we last generated the files? ;; 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. ;; 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 ;; 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: ;; Warn if some files are missing:
;; either our model is wrong or some other process is messing with our files. ;; either our model is wrong or some other process is messing with our files.
(when (and just-done (not all-present)) (when (and just-done (not all-present))
......
...@@ -54,7 +54,7 @@ ...@@ -54,7 +54,7 @@
;; (trace asdf/action::component-operation-time) ;; (trace asdf/action::component-operation-time)
;; #+allegro #+allegro ;; #+allegro #+allegro
;; (trace (asdf:input-files :inside asdf/plan::compute-action-stamp) ;; (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)) ;; (asdf/plan::get-file-stamp :inside asdf/plan::compute-action-stamp))
;;; bump the version ;;; bump the version
...@@ -91,7 +91,7 @@ ...@@ -91,7 +91,7 @@
:inside asdf:find-system) :inside asdf:find-system)
(asdf/find-system::get-file-stamp (asdf/find-system::get-file-stamp
:inside find-system) :inside find-system)
(asdf/find-system::stamp<= (asdf/find-system::timestamp<=
:inside find-system)) :inside find-system))
;; AFAICT, the :WHEREIN in SBCL TRACE does not work ;; AFAICT, the :WHEREIN in SBCL TRACE does not work
;; properly. In my copious free time, I should see if I ;; properly. In my copious free time, I should see if I
......
...@@ -25,9 +25,9 @@ ...@@ -25,9 +25,9 @@
#:string-prefix-p #:string-enclosed-p #:string-suffix-p #:string-prefix-p #:string-enclosed-p #:string-suffix-p
#:standard-case-symbol-name #:find-standard-case-symbol ;; symbols #:standard-case-symbol-name #:find-standard-case-symbol ;; symbols
#:coerce-class ;; CLOS #:coerce-class ;; CLOS
#:stamp< #:stamps< #:stamp*< #:stamp<= ;; stamps #:timestamp< #:timestamps< #:timestamp*< #:timestamp<= ;; timestamps
#:earlier-stamp #:stamps-earliest #:earliest-stamp #:earlier-timestamp #:timestamps-earliest #:earliest-timestamp
#:later-stamp #:stamps-latest #:latest-stamp #:latest-stamp-f #:later-timestamp #:timestamps-latest #:latest-timestamp #:latest-timestamp-f
#:list-to-hash-set #:ensure-gethash ;; hash-table #:list-to-hash-set #:ensure-gethash ;; hash-table
#:ensure-function #:access-at #:access-at-count ;; functions #:ensure-function #:access-at #:access-at-count ;; functions
#:call-function #:call-functions #:register-hook-function #: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 ...@@ -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))) (string (standard-case-symbol-name package-designator)))
error))) 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) (eval-when (#-lispworks :compile-toplevel :load-toplevel :execute)
(deftype stamp () '(or real boolean))) (deftype timestamp () '(or real boolean)))
(with-upgradability () (with-upgradability ()
(defun stamp< (x y) (defun timestamp< (x y)
(etypecase x (etypecase x
((eql t) (not (eql y t))) ((eql t) (not (eql y t)))
(real (etypecase y (real (etypecase y
...@@ -387,16 +387,16 @@ If optional ERROR argument is NIL, return NIL instead of an error when the symbo ...@@ -387,16 +387,16 @@ If optional ERROR argument is NIL, return NIL instead of an error when the symbo
(real (< x y)) (real (< x y))
(null t))) (null t)))
(null nil))) (null nil)))
(defun stamps< (list) (loop :for y :in list :for x = nil :then y :always (stamp< x y))) (defun timestamps< (list) (loop :for y :in list :for x = nil :then y :always (timestamp< x y)))
(defun stamp*< (&rest list) (stamps< list)) (defun timestamp*< (&rest list) (timestamps< list))
(defun stamp<= (x y) (not (stamp< y x))) (defun timestamp<= (x y) (not (timestamp< y x)))
(defun earlier-stamp (x y) (if (stamp< x y) x y)) (defun earlier-timestamp (x y) (if (timestamp< x y) x y))
(defun stamps-earliest (list) (reduce 'earlier-stamp list :initial-value nil)) (defun timestamps-earliest (list) (reduce 'earlier-timestamp list :initial-value nil))
(defun earliest-stamp (&rest list) (stamps-earliest list)) (defun earliest-timestamp (&rest list) (timestamps-earliest list))
(defun later-stamp (x y) (if (stamp< x y) y x)) (defun later-timestamp (x y) (if (timestamp< x y) y x))
(defun stamps-latest (list) (reduce 'later-stamp list :initial-value t)) (defun timestamps-latest (list) (reduce 'later-timestamp list :initial-value t))
(defun latest-stamp (&rest list) (stamps-latest list)) (defun latest-timestamp (&rest list) (timestamps-latest list))
(define-modify-macro latest-stamp-f (&rest stamps) latest-stamp)) (define-modify-macro latest-timestamp-f (&rest timestamps) latest-timestamp))
;;; Function designators ;;; 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