master 6f7941272b 2/3: Speed up `seq-subseq` for lists (bug#56521)

[Mattias Engdegård]

branch: master
commit 6f7941272b112f0412479ffc315352d7928e0fdf
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Speed up `seq-subseq` for lists (bug#56521)
    
    * lisp/emacs-lisp/seq.el (seq-subseq):
    Make faster by using `take` instead of a lisp loop,
    and more importantly by not front-loading the error text formatting.
    * test/lisp/emacs-lisp/seq-tests.el (seq-tests--list-subseq-ref)
    (test-seq-subseq): Test `seq-subseq` for lists more thoroughly.
---
 lisp/emacs-lisp/seq.el            | 20 ++++++++++++--------
 test/lisp/emacs-lisp/seq-tests.el | 29 ++++++++++++++++++++++++++++-
 2 files changed, 40 insertions(+), 9 deletions(-)

diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 0d9483aecb..1b8d86563a 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -168,21 +168,25 @@ if positive or too small if negative)."
    ((or (stringp sequence) (vectorp sequence)) (substring sequence start end))
    ((listp sequence)
     (let (len
-          (errtext (format "Bad bounding indices: %s, %s" start end)))
+          (orig-start start)
+          (orig-end end))
       (and end (< end 0) (setq end (+ end (setq len (length sequence)))))
       (if (< start 0) (setq start (+ start (or len (setq len (length 
sequence))))))
       (unless (>= start 0)
-        (error "%s" errtext))
+        (error "Start index out of bounds: %s" orig-start))
       (when (> start 0)
         (setq sequence (nthcdr (1- start) sequence))
-        (or sequence (error "%s" errtext))
+        (unless sequence
+          (error "Start index out of bounds: %s" orig-start))
         (setq sequence (cdr sequence)))
       (if end
-          (let ((res nil))
-            (while (and (>= (setq end (1- end)) start) sequence)
-              (push (pop sequence) res))
-            (or (= (1+ end) start) (error "%s" errtext))
-            (nreverse res))
+          (let ((n (- end start)))
+            (when (or (< n 0)
+                      (if len
+                          (> end len)
+                        (and (> n 0) (null (nthcdr (1- n) sequence)))))
+              (error "End index out of bounds: %s" orig-end))
+            (take n sequence))
         (copy-sequence sequence))))
    (t (error "Unsupported sequence: %s" sequence))))
 
diff --git a/test/lisp/emacs-lisp/seq-tests.el 
b/test/lisp/emacs-lisp/seq-tests.el
index d979604910..3b22e42df2 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -257,6 +257,19 @@ Evaluate BODY for each created sequence.
   (with-test-sequences (seq '())
     (should (equal (seq-uniq seq) '()))))
 
+(defun seq-tests--list-subseq-ref (list start &optional end)
+  "Reference implementation of `seq-subseq' for lists."
+  (let ((len (length list)))
+    (when (< start 0)
+      (setq start (+ start len)))
+    (unless end
+      (setq end len))
+    (when (< end 0)
+      (setq end (+ end len)))
+    (if (<= 0 start end len)
+        (take (- end start) (nthcdr start list))
+      (error "bad args"))))
+
 (ert-deftest test-seq-subseq ()
   (with-test-sequences (seq '(2 3 4 5))
     (should (equal (seq-subseq seq 0 4) seq))
@@ -275,7 +288,21 @@ Evaluate BODY for each created sequence.
   (should-error (seq-subseq [] -1))
   (should-error (seq-subseq "" -1))
   (should-not (seq-subseq '() 0))
-  (should-error (seq-subseq '() 0 -1)))
+  (should-error (seq-subseq '() 0 -1))
+
+  (dolist (list '(() (a b c d)))
+    (ert-info ((prin1-to-string list) :prefix "list: ")
+      (let ((len (length list)))
+        (dolist (start (number-sequence (- -2 len) (+ 2 len)))
+          (ert-info ((prin1-to-string start) :prefix "start: ")
+            (dolist (end (cons nil (number-sequence (- -2 len) (+ 2 len))))
+              (ert-info ((prin1-to-string end) :prefix "end: ")
+                (condition-case res
+                    (seq-tests--list-subseq-ref list start end)
+                  (error
+                   (should-error (seq-subseq list start end)))
+                  (:success
+                   (should (equal (seq-subseq list start end) res))))))))))))
 
 (ert-deftest test-seq-concatenate ()
   (with-test-sequences (seq '(2 4 6))