[Emacs-diffs] master eb83344: Speed up (nthcdr N L) when L is circular

[Paul Eggert]

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

    Speed up (nthcdr N L) when L is circular
    
    Also, fix bug when N is a positive bignum, a problem reported
    by Eli Zaretskii and Pip Cet in:
    https://lists.gnu.org/r/emacs-devel/2018-08/msg00690.html
    * src/fns.c (Fnthcdr): If a cycle is found, reduce the count
    modulo the cycle length before continuing.  This reduces the
    worst-case cost of (nthcdr N L) from N to min(N, C) where C is
    the number of distinct cdrs of L.  Reducing modulo the cycle
    length also allows us to do arithmetic with machine words
    instead of with GMP.
    * test/src/fns-tests.el (test-nthcdr-circular): New test.
---
 src/fns.c             | 58 +++++++++++++++++++++++++++++++++++++++++++++------
 test/src/fns-tests.el | 16 ++++++++++++++
 2 files changed, 68 insertions(+), 6 deletions(-)

diff --git a/src/fns.c b/src/fns.c
index aeb9308..8cff6b1 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1403,7 +1403,12 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
   (Lisp_Object n, Lisp_Object list)
 {
   CHECK_INTEGER (n);
-  Lisp_Object tail = list;
+
+  /* A huge but in-range EMACS_INT that can be substituted for a
+     positive bignum while counting down.  It does not introduce
+     miscounts because a list or cycle cannot possibly be this long,
+     and any counting error is fixed up later.  */
+  EMACS_INT large_num = EMACS_INT_MAX;
 
   EMACS_INT num;
   if (FIXNUMP (n))
@@ -1412,16 +1417,57 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
     {
       num = mpz_sgn (XBIGNUM (n)->value);
       if (0 < num)
-       num = EMACS_INT_MAX;  /* LIST cannot possibly be this long.  */
+       num = large_num;
     }
 
-  for (; 0 < num; num--)
+  EMACS_INT tortoise_num = num;
+  Lisp_Object tail = list, saved_tail = tail;
+  FOR_EACH_TAIL_SAFE (tail)
     {
-      if (! CONSP (tail))
+      if (num <= 0)
+       return tail;
+      if (tail == li.tortoise)
+       tortoise_num = num;
+      saved_tail = XCDR (tail);
+      num--;
+      rarely_quit (num);
+    }
+
+  tail = saved_tail;
+  if (! CONSP (tail))
+    {
+      CHECK_LIST_END (tail, list);
+      return Qnil;
+    }
+
+  /* TAIL is part of a cycle.  Reduce NUM modulo the cycle length to
+     avoid going around this cycle repeatedly.  */
+  intptr_t cycle_length = tortoise_num - num;
+  if (! FIXNUMP (n))
+    {
+      /* Undo any error introduced when LARGE_NUM was substituted for
+        N, by adding N - LARGE_NUM to NUM, using arithmetic modulo
+        CYCLE_LENGTH.  */
+      mpz_t z; /* N mod CYCLE_LENGTH.  */
+      mpz_init (z);
+      if (cycle_length <= ULONG_MAX)
+       num += mpz_mod_ui (z, XBIGNUM (n)->value, cycle_length);
+      else
        {
-         CHECK_LIST_END (tail, list);
-         return Qnil;
+         mpz_set_intmax (z, cycle_length);
+         mpz_mod (z, XBIGNUM (n)->value, z);
+         intptr_t iz;
+         mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, z);
+         num += iz;
        }
+      mpz_clear (z);
+      num += cycle_length - large_num % cycle_length;
+    }
+  num %= cycle_length;
+
+  /* One last time through the cycle.  */
+  for (; 0 < num; num--)
+    {
       tail = XCDR (tail);
       rarely_quit (num);
     }
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index f722ed6..92dc18f 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -624,4 +624,20 @@
         (should (eq (gethash b2 hash)
                     (funcall test b1 b2)))))))
 
+(ert-deftest test-nthcdr-circular ()
+  (dolist (len '(1 2 5 37 120 997 1024))
+    (let ((cycle (make-list len nil)))
+      (setcdr (last cycle) cycle)
+      (dolist (n (list (1- most-negative-fixnum) most-negative-fixnum
+                       -1 0 1
+                       (1- len) len (1+ len)
+                       most-positive-fixnum (1+ most-positive-fixnum)
+                       (* 2 most-positive-fixnum)
+                       (* most-positive-fixnum most-positive-fixnum)
+                       (ash 1 12345)))
+        (let ((a (nthcdr n cycle))
+              (b (if (<= n 0) cycle (nthcdr (mod n len) cycle))))
+          (should (equal (list (eq a b) n len)
+                         (list t n len))))))))
+
 (provide 'fns-tests)