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

Speed up seq-subseq for lists (bug#56521)

Browse source 
* 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.
This commit is contained in:
Mattias Engdegård 2022-07-18 11:32:22 +02:00
parent 5ad8f3e570
commit 6f7941272b
2 changed files with 40 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
lisp/emacs-lisp/seq.el
View file

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

29
test/lisp/emacs-lisp/seq-tests.el
View file

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