procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Minimize ‘equal’ calls in (delete x vector)

Browse source 
* 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.
This commit is contained in:
Paul Eggert 2020-08-15 10:48:37 -07:00
parent e97def2bbc
commit b467bb531e
2 changed files with 35 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
src/fns.c
View file

@ -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;
if (n != ASIZE (seq))
for (ptrdiff_t i = 0; i < size; i++)
{
struct Lisp_Vector *p = allocate_nil_vector (n);
bool neq = NILP (Fequal (AREF (seq, i), elt));
n += neq;
neqbits[i / BITS_PER_BITS_WORD] = neqword = (neqword << 1) + neq;
}
for (i = n = 0; i < ASIZE (seq); ++i)
if (NILP (Fequal (AREF (seq, i), elt)))
p->contents[n++] = AREF (seq, i);
if (n != size)
{
struct Lisp_Vector *p = allocate_vector (n);
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))
{

5
test/src/fns-tests.el
View file

@ -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))))