[Emacs-diffs] master 396ed88: Avoid some excess precision in time arithmetic

[Paul Eggert]

branch: master
commit 396ed88a50fba95cd3b989965defef0130a42c42
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    Avoid some excess precision in time arithmetic
    
    * doc/misc/emacs-mime.texi (time-date):
    Adjust example to match new behavior.
    * etc/NEWS: Mention this.
    * lisp/calendar/time-date.el (decoded-time-add)
    (decoded-time--alter-second):
    Don’t lose underestimate precision of seconds component.
    * src/bignum.c (mpz): Grow by 1.
    * src/timefns.c (trillion_factor): New function.
    (timeform_sub_ps_p): Remove.
    (time_arith): Avoid unnecessarily-large hz, by reducing the hz
    to a value no worse than the worse hz of the two arguments.
    The result is always exact unless an error is signaled.
    * test/src/timefns-tests.el (timefns-tests--decode-time):
    New function.
    (format-time-string-with-zone): Test (decode-time LOOK ZONE t)
    resolution as well as its numeric value.
---
 doc/misc/emacs-mime.texi   |   2 +-
 etc/NEWS                   |   4 +-
 lisp/calendar/time-date.el |  32 +++++++++-----
 src/bignum.c               |   5 ++-
 src/bignum.h               |   2 +-
 src/timefns.c              | 106 +++++++++++++++++++++++++++++++++++----------
 test/src/timefns-tests.el  |  44 +++++++++----------
 7 files changed, 135 insertions(+), 60 deletions(-)

diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index eb829b0..131a358 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -1568,7 +1568,7 @@ Here's a bunch of time/date/second/day examples:
 
 (time-subtract '(905595714000000 . 1000000)
                '(905595593000000000 . 1000000000))
-@result{} (121000000000 . 1000000000)
+@result{} (121000000 . 1000000)
 
 (days-between "Sat Sep 12 12:21:54 1998 +0200"
               "Sat Sep 07 12:21:54 1998 +0200")
diff --git a/etc/NEWS b/etc/NEWS
index 9f25cf4..3fdc185 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2166,7 +2166,9 @@ end and duration).
 +++
 *** 'time-add', 'time-subtract', and 'time-less-p' now accept
 infinities and NaNs too, and propagate them or return nil like
-floating-point operators do.
+floating-point operators do.  If both arguments are finite, these
+functions now return exact results instead of rounding in some cases,
+and they also avoid excess precision when that is easy.
 
 +++
 *** New function 'time-equal-p' compares time values for equality.
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index f3d252f..11bd469 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -421,10 +421,13 @@ changes in daylight saving time are not taken into 
account."
     ;; Do the time part, which is pretty simple (except for leap
     ;; seconds, I guess).
     ;; Time zone adjustments are basically the same as time adjustments.
-    (setq seconds (time-add (+ (* (or (decoded-time-hour delta) 0) 3600)
-                              (* (or (decoded-time-minute delta) 0) 60)
-                              (or (decoded-time-zone delta) 0))
-                           (or (decoded-time-second delta) 0)))
+    (setq seconds (time-convert (or (decoded-time-second delta) 0) t))
+    (setq seconds
+         (time-add seconds
+                   (time-convert (+ (* (or (decoded-time-hour delta) 0) 3600)
+                                    (* (or (decoded-time-minute delta) 0) 60)
+                                    (or (decoded-time-zone delta) 0))
+                                 (cdr seconds))))
 
     (decoded-time--alter-second time seconds)
     time))
@@ -461,11 +464,16 @@ changes in daylight saving time are not taken into 
account."
 
 (defun decoded-time--alter-second (time seconds)
   "Increase the time in TIME by SECONDS."
-  (let* ((secsperday 86400)
-        (old (time-add (+ (* 3600 (or (decoded-time-hour time) 0))
-                          (* 60 (or (decoded-time-minute time) 0)))
-                       (or (decoded-time-second time) 0)))
-        (new (time-add old seconds)))
+  (let* ((time-sec (time-convert (or (decoded-time-second time) 0) t))
+        (time-hz (cdr time-sec))
+        (old (time-add time-sec
+                       (time-convert
+                        (+ (* 3600 (or (decoded-time-hour time) 0))
+                           (* 60 (or (decoded-time-minute time) 0)))
+                        time-hz)))
+        (new (time-convert (time-add old seconds) t))
+        (new-hz (cdr new))
+        (secsperday (time-convert 86400 new-hz)))
     ;; Hm...  DST...
     (while (time-less-p new 0)
       (decoded-time--alter-day time nil)
@@ -474,8 +482,10 @@ changes in daylight saving time are not taken into 
account."
       (decoded-time--alter-day time t)
       (setq new (time-subtract new secsperday)))
     (let ((sec (time-convert new 'integer)))
-      (setf (decoded-time-second time) (time-add (% sec 60)
-                                                (time-subtract new sec))
+      (setf (decoded-time-second time) (time-add
+                                       (time-convert (% sec 60) new-hz)
+                                       (time-subtract
+                                        new (time-convert sec new-hz)))
            (decoded-time-minute time) (% (/ sec 60) 60)
            (decoded-time-hour time) (/ sec 3600)))))
 
diff --git a/src/bignum.c b/src/bignum.c
index 3883d3a..90b1ebe 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -31,9 +31,10 @@ along with GNU Emacs.  If not, see 
<https://www.gnu.org/licenses/>.  */
    storage is exhausted.  Admittedly this is not ideal.  An mpz value
    in a temporary is made permanent by mpz_swapping it with a bignum's
    value.  Although typically at most two temporaries are needed,
-   time_arith, rounddiv_q and rounding_driver each need four.  */
+   rounddiv_q and rounding_driver both need four and time_arith needs
+   five.  */
 
-mpz_t mpz[4];
+mpz_t mpz[5];
 
 static void *
 xrealloc_for_gmp (void *ptr, size_t ignore, size_t size)
diff --git a/src/bignum.h b/src/bignum.h
index a9c7a0a..9a32ffb 100644
--- a/src/bignum.h
+++ b/src/bignum.h
@@ -41,7 +41,7 @@ struct Lisp_Bignum
   mpz_t value;
 } GCALIGNED_STRUCT;
 
-extern mpz_t mpz[4];
+extern mpz_t mpz[5];
 
 extern void init_bignum (void);
 extern Lisp_Object make_integer_mpz (void);
diff --git a/src/timefns.c b/src/timefns.c
index 3b686eb..3c4c15b 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -99,6 +99,22 @@ mpz_t ztrillion;
 # endif
 #endif
 
+/* True if the nonzero Lisp integer HZ divides evenly into a trillion.  */
+static bool
+trillion_factor (Lisp_Object hz)
+{
+  if (FASTER_TIMEFNS)
+    {
+      if (FIXNUMP (hz))
+       return TRILLION % XFIXNUM (hz) == 0;
+      if (!FIXNUM_OVERFLOW_P (TRILLION))
+       return false;
+    }
+  verify (TRILLION <= INTMAX_MAX);
+  intmax_t ihz;
+  return integer_to_intmax (hz, &ihz) && TRILLION % ihz == 0;
+}
+
 /* Return a struct timeval that is roughly equivalent to T.
    Use the least timeval not less than T.
    Return an extremal value if the result would overflow.  */
@@ -681,18 +697,10 @@ enum timeform
    TIMEFORM_HI_LO_US, /* seconds plus microseconds (HI LO US) */
    TIMEFORM_NIL, /* current time in nanoseconds */
    TIMEFORM_HI_LO_US_PS, /* seconds plus micro and picoseconds (HI LO US PS) */
-   /* These two should be last; see timeform_sub_ps_p.  */
    TIMEFORM_FLOAT, /* time as a float */
    TIMEFORM_TICKS_HZ /* fractional time: HI is ticks, LO is ticks per second */
   };
 
-/* True if Lisp times of form FORM can express sub-picosecond timestamps.  */
-static bool
-timeform_sub_ps_p (enum timeform form)
-{
-  return TIMEFORM_FLOAT <= form;
-}
-
 /* From the valid form FORM and the time components HIGH, LOW, USEC
    and PSEC, generate the corresponding time value.  If LOW is
    floating point, the other components should be zero and FORM should
@@ -1080,9 +1088,14 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
   else
     {
       /* The plan is to decompose ta into na/da and tb into nb/db.
-        Start by computing da and db.  */
+        Start by computing da and db, their minimum (which will be
+        needed later) and the iticks temporary that will become
+        available once only their minimum is needed.  */
       mpz_t const *da = bignum_integer (&mpz[1], ta.hz);
       mpz_t const *db = bignum_integer (&mpz[2], tb.hz);
+      bool da_lt_db = mpz_cmp (*da, *db) < 0;
+      mpz_t const *hzmin = da_lt_db ? da : db;
+      mpz_t *iticks = &mpz[da_lt_db + 1];
 
       /* The plan is to compute (na * (db/g) + nb * (da/g)) / lcm (da, db)
         where g = gcd (da, db).  Start by computing g.  */
@@ -1090,34 +1103,83 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
       mpz_gcd (*g, *da, *db);
 
       /* fa = da/g, fb = db/g.  */
-      mpz_t *fa = &mpz[1], *fb = &mpz[3];
+      mpz_t *fa = &mpz[4], *fb = &mpz[3];
       mpz_tdiv_q (*fa, *da, *g);
       mpz_tdiv_q (*fb, *db, *g);
 
-      /* FIXME: Maybe omit need for extra temp by computing fa * db here?  */
-
-      /* hz = fa * db.  This is equal to lcm (da, db).  */
-      mpz_mul (mpz[0], *fa, *db);
-      hz = make_integer_mpz ();
+      /* ihz = fa * db.  This is equal to lcm (da, db).  */
+      mpz_t *ihz = &mpz[0];
+      mpz_mul (*ihz, *fa, *db);
+
+      /* When warning about obsolete timestamps, if the smaller
+        denominator comes from a non-(TICKS . HZ) timestamp and could
+        generate a (TICKS . HZ) timestamp that would look obsolete,
+        arrange for the result to have a higher HZ to avoid a
+        spurious warning by a later consumer of this function's
+        returned value.  */
+      verify (1 << LO_TIME_BITS <= ULONG_MAX);
+      if (WARN_OBSOLETE_TIMESTAMPS
+         && (da_lt_db ? aform : bform) == TIMEFORM_FLOAT
+         && (da_lt_db ? bform : aform) != TIMEFORM_TICKS_HZ
+         && mpz_cmp_ui (*hzmin, 1) > 0
+         && mpz_cmp_ui (*hzmin, 1 << LO_TIME_BITS) < 0)
+       {
+         mpz_t *hzmin1 = &mpz[2 - da_lt_db];
+         mpz_set_ui (*hzmin1, 1 << LO_TIME_BITS);
+         hzmin = hzmin1;
+       }
 
-      /* ticks = (fb * na) OPER (fa * nb), where OPER is + or -.
-        OP is the multiply-add or multiply-sub form of OPER.  */
-      mpz_t const *na = bignum_integer (&mpz[0], ta.ticks);
-      mpz_mul (mpz[0], *fb, *na);
+      /* iticks = (fb * na) OP (fa * nb), where OP is + or -.  */
+      mpz_t const *na = bignum_integer (iticks, ta.ticks);
+      mpz_mul (*iticks, *fb, *na);
       mpz_t const *nb = bignum_integer (&mpz[3], tb.ticks);
-      (subtract ? mpz_submul : mpz_addmul) (mpz[0], *fa, *nb);
+      (subtract ? mpz_submul : mpz_addmul) (*iticks, *fa, *nb);
+
+      /* Normalize iticks/ihz by dividing both numerator and
+        denominator by ig = gcd (iticks, ihz).  However, if that
+        would cause the denominator to become less than hzmin,
+        rescale the denominator upwards from its ordinary value by
+        multiplying numerator and denominator so that the denominator
+        becomes at least hzmin.  This rescaling avoids returning a
+        timestamp that is less precise than both a and b, or a
+        timestamp that looks obsolete when that might be a problem.  */
+      mpz_t *ig = &mpz[3];
+      mpz_gcd (*ig, *iticks, *ihz);
+
+      if (!FASTER_TIMEFNS || mpz_cmp_ui (*ig, 1) > 0)
+       {
+         mpz_tdiv_q (*iticks, *iticks, *ig);
+         mpz_tdiv_q (*ihz, *ihz, *ig);
+
+         if (!FASTER_TIMEFNS || mpz_cmp (*ihz, *hzmin) < 0)
+           {
+             /* Rescale straightforwardly.  Although this might not
+                yield the minimal denominator that preserves numeric
+                value and is at least hzmin, calculating such a
+                denominator would be too expensive because it would
+                require testing multisets of factors of lcm (da, db).  */
+             mpz_t *rescale = &mpz[3];
+             mpz_cdiv_q (*rescale, *hzmin, *ihz);
+             mpz_mul (*iticks, *iticks, *rescale);
+             mpz_mul (*ihz, *ihz, *rescale);
+           }
+       }
+      hz = make_integer_mpz ();
+      mpz_swap (mpz[0], *iticks);
       ticks = make_integer_mpz ();
     }
 
   /* Return an integer if the timestamp resolution is 1,
      otherwise the (TICKS . HZ) form if !CURRENT_TIME_LIST or if
-     either input form supports timestamps that cannot be expressed
+     either input used (TICKS . HZ) form or the result can't be expressed
      exactly in (HI LO US PS) form, otherwise the (HI LO US PS) form
      for backward compatibility.  */
   return (EQ (hz, make_fixnum (1))
          ? ticks
          : (!CURRENT_TIME_LIST
-            || timeform_sub_ps_p (aform) || timeform_sub_ps_p (bform))
+            || aform == TIMEFORM_TICKS_HZ
+            || bform == TIMEFORM_TICKS_HZ
+            || !trillion_factor (hz))
          ? Fcons (ticks, hz)
          : ticks_hz_list4 (ticks, hz));
 }
diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el
index 48d964d..3a18a4a 100644
--- a/test/src/timefns-tests.el
+++ b/test/src/timefns-tests.el
@@ -19,6 +19,12 @@
 
 (require 'ert)
 
+(defun timefns-tests--decode-time (look zone decoded-time)
+  (should (equal (decode-time look zone t) decoded-time))
+  (should (equal (decode-time look zone 'integer)
+                (cons (time-convert (car decoded-time) 'integer)
+                      (cdr decoded-time)))))
+
 ;;; Check format-time-string and decode-time with various TZ settings.
 ;;; Use only POSIX-compatible TZ values, since the tests should work
 ;;; even if tzdb is not in use.
@@ -40,31 +46,29 @@
                    (7879679999900 . 100000)
                    (78796799999999999999 . 1000000000000)))
       ;; UTC.
-     (let ((sec (time-add 59 (time-subtract (time-convert look t)
-                                            (time-convert look 'integer)))))
+     (let* ((look-ticks-hz (time-convert look t))
+           (hz (cdr look-ticks-hz))
+           (look-integer (time-convert look 'integer))
+           (sec (time-add (time-convert 59 hz)
+                          (time-subtract look-ticks-hz
+                                         (time-convert look-integer hz)))))
       (should (string-equal
               (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t)
               "1972-06-30 23:59:59.999 +0000"))
-      (should (equal (decode-time look t 'integer)
-                    '(59 59 23 30 6 1972 5 nil 0)))
-      (should (equal (decode-time look t t)
-                    (list sec 59 23 30 6 1972 5 nil 0)))
+      (timefns-tests--decode-time look t
+                                 (list sec 59 23 30 6 1972 5 nil 0))
       ;; "UTC0".
       (should (string-equal
               (format-time-string format look "UTC0")
               "1972-06-30 23:59:59.999 +0000 (UTC)"))
-      (should (equal (decode-time look "UTC0" 'integer)
-                    '(59 59 23 30 6 1972 5 nil 0)))
-      (should (equal (decode-time look "UTC0" t)
-                    (list sec 59 23 30 6 1972 5 nil 0)))
+      (timefns-tests--decode-time look "UTC0"
+                                 (list sec 59 23 30 6 1972 5 nil 0))
       ;; Negative UTC offset, as a Lisp list.
       (should (string-equal
               (format-time-string format look '(-28800 "PST"))
               "1972-06-30 15:59:59.999 -0800 (PST)"))
-      (should (equal (decode-time look '(-28800 "PST") 'integer)
-                    '(59 59 15 30 6 1972 5 nil -28800)))
-      (should (equal (decode-time look '(-28800 "PST") t)
-                    (list sec 59 15 30 6 1972 5 nil -28800)))
+      (timefns-tests--decode-time look '(-28800 "PST")
+                                 (list sec 59 15 30 6 1972 5 nil -28800))
       ;; Negative UTC offset, as a Lisp integer.
       (should (string-equal
               (format-time-string format look -28800)
@@ -73,18 +77,14 @@
               (if (eq system-type 'windows-nt)
                   "1972-06-30 15:59:59.999 -0800 (ZZZ)"
                 "1972-06-30 15:59:59.999 -0800 (-08)")))
-      (should (equal (decode-time look -28800 'integer)
-                    '(59 59 15 30 6 1972 5 nil -28800)))
-      (should (equal (decode-time look -28800 t)
-                    (list sec 59 15 30 6 1972 5 nil -28800)))
+      (timefns-tests--decode-time look -28800
+                                 (list sec 59 15 30 6 1972 5 nil -28800))
       ;; Positive UTC offset that is not an hour multiple, as a string.
       (should (string-equal
               (format-time-string format look "IST-5:30")
               "1972-07-01 05:29:59.999 +0530 (IST)"))
-      (should (equal (decode-time look "IST-5:30" 'integer)
-                    '(59 29 5 1 7 1972 6 nil 19800)))
-      (should (equal (decode-time look "IST-5:30" t)
-                    (list sec 29 5 1 7 1972 6 nil 19800)))))))
+      (timefns-tests--decode-time look "IST-5:30"
+                                 (list sec 29 5 1 7 1972 6 nil 19800))))))
 
 (ert-deftest decode-then-encode-time ()
   (let ((time-values (list 0 -2 1 0.0 -0.0 -2.0 1.0