From: Paul Eggert <eggert@cs.ucla.edu>
To: Pip Cet <pipcet@gmail.com>, eliz@gnu.org
Cc: kfogel@red-bean.com, tom@tromey.com, emacs-devel@gnu.org
Subject: Re: Some vars now limited to fixnum size. (Was: Merging bignum to master)
Date: Mon, 20 Aug 2018 16:15:29 -0700 [thread overview]
Message-ID: <71e06938-2b8c-74f8-ae55-756931613e84@cs.ucla.edu> (raw)
In-Reply-To: <CAOqdjBek7zG90A9PwDr23qUb8NigB3e4QA=hT2KsdA70wUPd5g@mail.gmail.com>
[-- Attachment #1: Type: text/plain, Size: 958 bytes --]
Pip Cet wrote:
>> So we now silently replace the argument with another, smaller value,
>> and then go ahead as if business as usual? Is that a good,
>> user-friendly behavior?
> It's certainly incorrect for circular lists.
Yes, sorry, I forgot the circular case. Fixed by installing the attached patch.
This patch improves circular-list nthcdr performance for fixnums too. For
example, on my Fedora 28 x86-64 platform (AMD Phenom II X4 910e, circa 2010) the
third line of the following benchmark runs about 8 million times faster:
(setq bench-circular (list 1 2 3 4 5 6))
(setcdr (nthcdr 5 bench-circular) bench-circular)
(nthcdr 536870911 bench-circular)
Normally I wouldn't bother with this sort of performance improvement (I mean,
how often to people write code that deliberately goes around in circles? :-),
but nthcdr is used so often that it seemed worth doing. Plus it was fun to fix
this mostly by using machine arithmetic rather than GMP.
[-- Attachment #2: 0001-Speed-up-nthcdr-N-L-when-L-is-circular.patch --]
[-- Type: text/x-patch, Size: 4225 bytes --]
From eb83344fc7c08ec08b51e7700f1ac2632afa462c Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Mon, 20 Aug 2018 15:52:29 -0700
Subject: [PATCH] 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 aeb9308d22..8cff6b1b6c 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 f722ed6333..92dc18fa03 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -624,4 +624,20 @@ dot2
(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)
--
2.17.1
next prev parent reply other threads:[~2018-08-20 23:15 UTC|newest]
Thread overview: 58+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-08-11 19:47 Merging bignum to master Tom Tromey
2018-08-11 21:28 ` Basil L. Contovounesios
2018-08-12 16:34 ` Tom Tromey
2018-08-13 12:21 ` Basil L. Contovounesios
2018-08-14 0:21 ` Andy Moreton
2018-08-15 23:41 ` Andy Moreton
2018-08-16 15:38 ` Basil L. Contovounesios
2018-08-19 8:26 ` Paul Eggert
2018-08-17 14:58 ` Eli Zaretskii
2018-08-12 6:29 ` Ulrich Mueller
2018-08-12 8:09 ` Paul Eggert
2018-08-12 17:21 ` Ulrich Mueller
2018-08-12 18:20 ` Eli Zaretskii
2018-08-12 19:30 ` Ulrich Mueller
2018-08-13 0:15 ` Paul Eggert
2018-08-12 18:05 ` Eli Zaretskii
2018-08-12 23:53 ` Paul Eggert
2018-08-13 0:20 ` Tom Tromey
2018-08-13 7:51 ` Andreas Schwab
2018-08-13 8:06 ` Ulrich Mueller
2018-08-13 9:14 ` Paul Eggert
2018-08-14 23:09 ` Paul Eggert
2018-08-16 2:46 ` Richard Stallman
2018-08-13 23:31 ` Richard Stallman
2018-08-14 1:41 ` Paul Eggert
2018-08-16 2:41 ` Richard Stallman
2018-08-16 19:31 ` Paul Eggert
2018-08-16 22:02 ` Stefan Monnier
2018-08-12 7:37 ` John Wiegley
2018-08-12 18:21 ` Eli Zaretskii
2018-08-12 11:48 ` Pip Cet
2018-08-12 16:02 ` Tom Tromey
2018-08-13 22:58 ` Paul Eggert
2018-08-14 1:12 ` Noam Postavsky
2018-08-14 13:04 ` Pip Cet
2018-08-14 18:01 ` Paul Eggert
2018-08-15 15:20 ` Pip Cet
2018-08-15 16:17 ` Paul Eggert
2018-08-15 23:57 ` Andy Moreton
2018-08-16 22:00 ` Stefan Monnier
2018-08-20 16:28 ` Some vars now limited to fixnum size. (Was: Merging bignum to master) Karl Fogel
2018-08-20 16:54 ` Paul Eggert
2018-08-20 17:27 ` Eli Zaretskii
2018-08-20 17:27 ` Paul Eggert
2018-08-20 18:00 ` Eli Zaretskii
2018-08-20 19:55 ` Pip Cet
2018-08-20 23:15 ` Paul Eggert [this message]
2018-08-21 15:01 ` Some vars now limited to fixnum size Tom Tromey
2018-08-21 16:36 ` Andy Moreton
2018-08-21 18:46 ` Paul Eggert
2018-08-22 15:39 ` Tom Tromey
2018-08-21 3:38 ` Some vars now limited to fixnum size. (Was: Merging bignum to master) Richard Stallman
2018-08-21 4:09 ` Paul Eggert
2018-08-22 4:03 ` Richard Stallman
2018-08-22 4:53 ` Paul Eggert
2018-08-20 17:25 ` Eli Zaretskii
2018-08-14 0:51 ` Merging bignum to master Andy Moreton
2018-08-15 15:46 ` Andy Moreton
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=71e06938-2b8c-74f8-ae55-756931613e84@cs.ucla.edu \
--to=eggert@cs.ucla.edu \
--cc=eliz@gnu.org \
--cc=emacs-devel@gnu.org \
--cc=kfogel@red-bean.com \
--cc=pipcet@gmail.com \
--cc=tom@tromey.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.