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.

1 files changed, 29 insertions, 9 deletions

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