From: Paul Eggert Date: Sat, 15 Aug 2020 17:48:37 +0000 (-0700) Subject: Minimize ‘equal’ calls in (delete x vector) X-Git-Tag: emacs-28.0.90~6584^2~9 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b467bb531e1ab0eed57e1889004d2115e80e4292;p=emacs.git Minimize ‘equal’ calls in (delete x vector) * src/fns.c (Fdelete): When deleting from a vector, call Fequal only once per vector element. This is faster when Fequal is slow, and avoids the need to preinitialize the vector result. Finish when the result is exhausted, not when the input is exhausted; the two are equivalent but the former may be faster. * test/src/fns-tests.el (test-vector-delete): New test. --- diff --git a/src/fns.c b/src/fns.c index c89bd8144e7..069edbe90e2 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1747,22 +1747,42 @@ changing the value of a sequence `foo'. */) { if (VECTORP (seq)) { - ptrdiff_t i, n; + ptrdiff_t n = 0; + ptrdiff_t size = ASIZE (seq); + ptrdiff_t neqbits_words = ((size + BITS_PER_BITS_WORD - 1) + / BITS_PER_BITS_WORD); + USE_SAFE_ALLOCA; + bits_word *neqbits = SAFE_ALLOCA (neqbits_words * sizeof *neqbits); + bits_word neqword = 0; - for (i = n = 0; i < ASIZE (seq); ++i) - if (NILP (Fequal (AREF (seq, i), elt))) - ++n; + for (ptrdiff_t i = 0; i < size; i++) + { + bool neq = NILP (Fequal (AREF (seq, i), elt)); + n += neq; + neqbits[i / BITS_PER_BITS_WORD] = neqword = (neqword << 1) + neq; + } - if (n != ASIZE (seq)) + if (n != size) { - struct Lisp_Vector *p = allocate_nil_vector (n); + struct Lisp_Vector *p = allocate_vector (n); - for (i = n = 0; i < ASIZE (seq); ++i) - if (NILP (Fequal (AREF (seq, i), elt))) - p->contents[n++] = AREF (seq, i); + if (n != 0) + { + ptrdiff_t j = 0; + for (ptrdiff_t i = 0; ; i++) + if (neqbits[i / BITS_PER_BITS_WORD] + & ((bits_word) 1 << (i % BITS_PER_BITS_WORD))) + { + p->contents[j++] = AREF (seq, i); + if (j == n) + break; + } + } XSETVECTOR (seq, p); } + + SAFE_FREE (); } else if (STRINGP (seq)) { diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index f1faf58659a..141de1d226c 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -895,3 +895,8 @@ ;; This does not test randomness; it's merely a format check. (should (string-match "\\`[0-9a-f]\\{128\\}\\'" (secure-hash 'sha512 'iv-auto 100)))) + +(ert-deftest test-vector-delete () + (let ((v1 (make-vector 1000 1))) + (should (equal (delete 1 v1) (vector))) + (should (equal (delete 2 v1) v1))))