summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/seq.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp/seq.el')
-rw-r--r--lisp/emacs-lisp/seq.el78
1 files changed, 63 insertions, 15 deletions
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 133d3c9e118..b6f0f66e5b1 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -59,8 +59,8 @@
(eval-when-compile (require 'cl-generic))
;; We used to use some sequence functions from cl-lib, but this
-;; dependency was swapped around so that it will be easier to make
-;; seq.el preloaded in the future. See also Bug#39761#26.
+;; dependency was swapped around so that it's easier to make seq.el
+;; preloaded. See also Bug#39761#26.
(defmacro seq-doseq (spec &rest body)
"Loop over a sequence.
@@ -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))))
@@ -451,6 +455,33 @@ TESTFN is used to compare elements, or `equal' if TESTFN is nil."
(setq result (cons elt result))))
(nreverse result)))
+(cl-defmethod seq-uniq ((sequence list) &optional testfn)
+ (let ((result nil))
+ (if (not testfn)
+ ;; Fast path. If the list is long, use a hash table to speed
+ ;; things up even more.
+ (let ((l (length sequence)))
+ (if (> l 100)
+ (let ((hash (make-hash-table :test #'equal :size l)))
+ (while sequence
+ (unless (gethash (car sequence) hash)
+ (setf (gethash (car sequence) hash) t)
+ (push (car sequence) result))
+ (setq sequence (cdr sequence))))
+ ;; Short list.
+ (while sequence
+ (unless (member (car sequence) result)
+ (push (car sequence) result))
+ (pop sequence))))
+ ;; Slower path.
+ (while sequence
+ (unless (seq-find (lambda (elem)
+ (funcall testfn elem (car sequence)))
+ result)
+ (push (car sequence) result))
+ (pop sequence)))
+ (nreverse result)))
+
(cl-defgeneric seq-mapcat (function sequence &optional type)
"Concatenate the result of applying FUNCTION to each element of SEQUENCE.
The result is a sequence of type TYPE, or a list if TYPE is nil."
@@ -587,11 +618,13 @@ Signal an error if SEQUENCE is empty."
(cl-defmethod seq-take ((list list) n)
"Optimized implementation of `seq-take' for lists."
- (let ((result '()))
- (while (and list (> n 0))
- (setq n (1- n))
- (push (pop list) result))
- (nreverse result)))
+ (if (eval-when-compile (fboundp 'take))
+ (take n list)
+ (let ((result '()))
+ (while (and list (> n 0))
+ (setq n (1- n))
+ (push (pop list) result))
+ (nreverse result))))
(cl-defmethod seq-drop-while (pred (list list))
"Optimized implementation of `seq-drop-while' for lists."
@@ -632,5 +665,20 @@ Signal an error if SEQUENCE is empty."
;; we automatically highlight macros.
(add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords))
+(defun seq-split (sequence length)
+ "Split SEQUENCE into a list of sub-sequences of at most LENGTH.
+All the sub-sequences will be of LENGTH, except the last one,
+which may be shorter."
+ (when (< length 1)
+ (error "Sub-sequence length must be larger than zero"))
+ (let ((result nil)
+ (seq-length (length sequence))
+ (start 0))
+ (while (< start seq-length)
+ (push (seq-subseq sequence start
+ (setq start (min seq-length (+ start length))))
+ result))
+ (nreverse result)))
+
(provide 'seq)
;;; seq.el ends here