aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNicolas Petton2015-08-14 22:33:10 +0200
committerNicolas Petton2015-08-23 19:50:26 +0200
commite7be9861962a5a399047e86a254c2534d5d4d146 (patch)
treed34e43a6223522794a55aecedccffdc1769896f1
parent58c3762a8b8cfcf714539bda7114f52b6f615258 (diff)
downloademacs-e7be9861962a5a399047e86a254c2534d5d4d146.tar.gz
emacs-e7be9861962a5a399047e86a254c2534d5d4d146.zip
Make seq.el more extensible by using cl-defmethod
* lisp/emacs-lisp/seq.el: Define seq.el functions using cl-defmethod to make it easier to extend seq.el with new "seq types". * test/automated/seq-tests.el (test-setf-seq-elt): New test. * lisp/emacs-lisp/cl-extra.el (cl-subseq): Move back the definition of subseq in cl-extra.el, and use it in seq.el.
-rw-r--r--lisp/emacs-lisp/cl-extra.el24
-rw-r--r--lisp/emacs-lisp/seq.el412
-rw-r--r--test/automated/seq-tests.el7
3 files changed, 224 insertions, 219 deletions
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 8ed50f4f530..90ca531ae7a 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -38,7 +38,6 @@
38;;; Code: 38;;; Code:
39 39
40(require 'cl-lib) 40(require 'cl-lib)
41(require 'seq)
42 41
43;;; Type coercion. 42;;; Type coercion.
44 43
@@ -520,13 +519,32 @@ This sets the values of: `cl-most-positive-float', `cl-most-negative-float',
520If END is omitted, it defaults to the length of the sequence. 519If END is omitted, it defaults to the length of the sequence.
521If START or END is negative, it counts from the end. 520If START or END is negative, it counts from the end.
522Signal an error if START or END are outside of the sequence (i.e 521Signal an error if START or END are outside of the sequence (i.e
523too large if positive or too small if negative)" 522too large if positive or too small if negative)."
524 (declare (gv-setter 523 (declare (gv-setter
525 (lambda (new) 524 (lambda (new)
526 (macroexp-let2 nil new new 525 (macroexp-let2 nil new new
527 `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end) 526 `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end)
528 ,new))))) 527 ,new)))))
529 (seq-subseq seq start end)) 528 (cond ((or (stringp seq) (vectorp seq)) (substring seq start end))
529 ((listp seq)
530 (let (len
531 (errtext (format "Bad bounding indices: %s, %s" start end)))
532 (and end (< end 0) (setq end (+ end (setq len (seq-length seq)))))
533 (if (< start 0) (setq start (+ start (or len (setq len (seq-length seq))))))
534 (unless (>= start 0)
535 (error "%s" errtext))
536 (when (> start 0)
537 (setq seq (nthcdr (1- start) seq))
538 (or seq (error "%s" errtext))
539 (setq seq (cdr seq)))
540 (if end
541 (let ((res nil))
542 (while (and (>= (setq end (1- end)) start) seq)
543 (push (pop seq) res))
544 (or (= (1+ end) start) (error "%s" errtext))
545 (nreverse res))
546 (seq-copy seq))))
547 (t (error "Unsupported sequence: %s" seq))))
530 548
531;;;###autoload 549;;;###autoload
532(defalias 'cl-concatenate #'seq-concatenate 550(defalias 'cl-concatenate #'seq-concatenate
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 038b20e3b5e..f9e0e9c0fa8 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -4,7 +4,7 @@
4 4
5;; Author: Nicolas Petton <nicolas@petton.fr> 5;; Author: Nicolas Petton <nicolas@petton.fr>
6;; Keywords: sequences 6;; Keywords: sequences
7;; Version: 1.8 7;; Version: 2.0
8;; Package: seq 8;; Package: seq
9 9
10;; Maintainer: emacs-devel@gnu.org 10;; Maintainer: emacs-devel@gnu.org
@@ -38,10 +38,26 @@
38;; the sequence as their second argument. All other functions take 38;; the sequence as their second argument. All other functions take
39;; the sequence as their first argument. 39;; the sequence as their first argument.
40;; 40;;
41;; While seq.el version 1.8 is in GNU ELPA for convenience, seq.el
42;; version 2.0 requires Emacs>=25.1.
43;;
44;; seq.el can be extended to support new type of sequences. Here are
45;; the generic functions that must be implemented by new seq types:
46;; - `seq-elt'
47;; - `seq-length'
48;; - `seq-do'
49;; - `seq-p'
50;; - `seq-subseq'
51;; - `seq-copy'
52;; - `seq-into'
53;;
41;; All functions are tested in test/automated/seq-tests.el 54;; All functions are tested in test/automated/seq-tests.el
42 55
43;;; Code: 56;;; Code:
44 57
58(eval-when-compile (require 'cl-generic))
59(require 'cl-extra) ;; for cl-subseq
60
45(defmacro seq-doseq (spec &rest body) 61(defmacro seq-doseq (spec &rest body)
46 "Loop over a sequence. 62 "Loop over a sequence.
47Similar to `dolist' but can be applied to lists, strings, and vectors. 63Similar to `dolist' but can be applied to lists, strings, and vectors.
@@ -50,91 +66,163 @@ Evaluate BODY with VAR bound to each element of SEQ, in turn.
50 66
51\(fn (VAR SEQ) BODY...)" 67\(fn (VAR SEQ) BODY...)"
52 (declare (indent 1) (debug ((symbolp form &optional form) body))) 68 (declare (indent 1) (debug ((symbolp form &optional form) body)))
53 (let ((length (make-symbol "length")) 69 `(seq-do (lambda (,(car spec))
54 (seq (make-symbol "seq")) 70 ,@body)
55 (index (make-symbol "index"))) 71 ,(cadr spec)))
56 `(let* ((,seq ,(cadr spec)) 72
57 (,length (if (listp ,seq) nil (seq-length ,seq))) 73(pcase-defmacro seq (&rest args)
58 (,index (if ,length 0 ,seq))) 74 "pcase pattern matching sequence elements.
59 (while (if ,length
60 (< ,index ,length)
61 (consp ,index))
62 (let ((,(car spec) (if ,length
63 (prog1 (seq-elt ,seq ,index)
64 (setq ,index (+ ,index 1)))
65 (pop ,index))))
66 ,@body)))))
67
68(if (fboundp 'pcase-defmacro)
69 ;; Implementation of `seq-let' based on a `pcase'
70 ;; pattern. Requires Emacs>=25.1.
71 (progn
72 (pcase-defmacro seq (&rest args)
73 "pcase pattern matching sequence elements.
74Matches if the object is a sequence (list, string or vector), and 75Matches if the object is a sequence (list, string or vector), and
75binds each element of ARGS to the corresponding element of the 76binds each element of ARGS to the corresponding element of the
76sequence." 77sequence."
77 `(and (pred seq-p) 78 `(and (pred seq-p)
78 ,@(seq--make-pcase-bindings args))) 79 ,@(seq--make-pcase-bindings args)))
79 80
80 (defmacro seq-let (args seq &rest body) 81(defmacro seq-let (args seq &rest body)
81 "Bind the variables in ARGS to the elements of SEQ then evaluate BODY. 82 "Bind the variables in ARGS to the elements of SEQ then evaluate BODY.
82 83
83ARGS can also include the `&rest' marker followed by a variable 84ARGS can also include the `&rest' marker followed by a variable
84name to be bound to the rest of SEQ." 85name to be bound to the rest of SEQ."
85 (declare (indent 2) (debug t)) 86 (declare (indent 2) (debug t))
86 `(pcase-let ((,(seq--make-pcase-patterns args) ,seq)) 87 `(pcase-let ((,(seq--make-pcase-patterns args) ,seq))
87 ,@body))) 88 ,@body))
89
90
91;;; Basic seq functions that have to be implemented by new seq types
92(cl-defgeneric seq-elt (seq n)
93 "Return the element of SEQ at index N."
94 (elt seq n))
95
96;; Default gv setters for `seq-elt'.
97;; It can be a good idea for new sequence impelentations to provide a
98;; "gv-setter" for `seq-elt'.
99(cl-defmethod (setf seq-elt) (store (seq array) n)
100 (aset seq n store))
101
102(cl-defmethod (setf seq-elt) (store (seq cons) n)
103 (setcar (nthcdr n seq) store))
104
105(cl-defgeneric seq-length (seq)
106 "Return the length of the sequence SEQ."
107 (length seq))
108
109(cl-defgeneric seq-do (function seq)
110 "Apply FUNCTION to each element of SEQ, presumably for side effects.
111Return SEQ."
112 (mapc function seq))
88 113
89 ;; Implementation of `seq-let' compatible with Emacs<25.1. 114(defalias 'seq-each #'seq-do)
90 (defmacro seq-let (args seq &rest body)
91 "Bind the variables in ARGS to the elements of SEQ then evaluate BODY.
92 115
93ARGS can also include the `&rest' marker followed by a variable 116(cl-defgeneric seq-p (seq)
94name to be bound to the rest of SEQ." 117 "Return non-nil if SEQ is a sequence, nil otherwise."
95 (declare (indent 2) (debug t)) 118 (sequencep seq))
96 (let ((seq-var (make-symbol "seq"))) 119
97 `(let* ((,seq-var ,seq) 120(cl-defgeneric seq-copy (seq)
98 ,@(seq--make-bindings args seq-var)) 121 "Return a shallow copy of SEQ."
99 ,@body)))) 122 (copy-sequence seq))
123
124(cl-defgeneric seq-subseq (seq start &optional end)
125 "Return the subsequence of SEQ from START to END.
126If END is omitted, it defaults to the length of the sequence.
127If START or END is negative, it counts from the end.
128Signal an error if START or END are outside of the sequence (i.e
129too large if positive or too small if negative)."
130 (cl-subseq seq start end))
131
132
133(cl-defgeneric seq-map (function seq)
134 "Return the result of applying FUNCTION to each element of SEQ."
135 (let (result)
136 (seq-do (lambda (elt)
137 (push (funcall function elt) result))
138 seq)
139 (nreverse result)))
140
141;; faster implementation for sequences (sequencep)
142(cl-defmethod seq-map (function (seq sequence))
143 (mapcar function seq))
100 144
101(defun seq-drop (seq n) 145(cl-defgeneric seq-drop (seq n)
102 "Return a subsequence of SEQ without its first N elements. 146 "Return a subsequence of SEQ without its first N elements.
103The result is a sequence of the same type as SEQ. 147The result is a sequence of the same type as SEQ.
104 148
105If N is a negative integer or zero, SEQ is returned." 149If N is a negative integer or zero, SEQ is returned."
106 (if (<= n 0) 150 (if (<= n 0)
107 seq 151 seq
108 (if (listp seq) 152 (let ((length (seq-length seq)))
109 (seq--drop-list seq n) 153 (seq-subseq seq (min n length) length))))
110 (let ((length (seq-length seq)))
111 (seq-subseq seq (min n length) length)))))
112 154
113(defun seq-take (seq n) 155(cl-defgeneric seq-take (seq n)
114 "Return a subsequence of SEQ with its first N elements. 156 "Return a subsequence of SEQ with its first N elements.
115The result is a sequence of the same type as SEQ. 157The result is a sequence of the same type as SEQ.
116 158
117If N is a negative integer or zero, an empty sequence is 159If N is a negative integer or zero, an empty sequence is
118returned." 160returned."
119 (if (listp seq) 161 (seq-subseq seq 0 (min (max n 0) (seq-length seq))))
120 (seq--take-list seq n)
121 (seq-subseq seq 0 (min (max n 0) (seq-length seq)))))
122 162
123(defun seq-drop-while (pred seq) 163(cl-defgeneric seq-drop-while (pred seq)
124 "Return a sequence from the first element for which (PRED element) is nil in SEQ. 164 "Return a sequence from the first element for which (PRED element) is nil in SEQ.
125The result is a sequence of the same type as SEQ." 165The result is a sequence of the same type as SEQ."
126 (if (listp seq) 166 (seq-drop seq (seq--count-successive pred seq)))
127 (seq--drop-while-list pred seq)
128 (seq-drop seq (seq--count-successive pred seq))))
129 167
130(defun seq-take-while (pred seq) 168(cl-defgeneric seq-take-while (pred seq)
131 "Return the successive elements for which (PRED element) is non-nil in SEQ. 169 "Return the successive elements for which (PRED element) is non-nil in SEQ.
132The result is a sequence of the same type as SEQ." 170The result is a sequence of the same type as SEQ."
133 (if (listp seq) 171 (seq-take seq (seq--count-successive pred seq)))
134 (seq--take-while-list pred seq)
135 (seq-take seq (seq--count-successive pred seq))))
136 172
137(defun seq-filter (pred seq) 173(cl-defgeneric seq-empty-p (seq)
174 "Return non-nil if the sequence SEQ is empty, nil otherwise."
175 (= 0 (seq-length seq)))
176
177(cl-defgeneric seq-sort (pred seq)
178 "Return a sorted sequence comparing using PRED the elements of SEQ.
179The result is a sequence of the same type as SEQ."
180 (let ((result (seq-sort pred (append seq nil))))
181 (seq-into result (type-of seq))))
182
183(cl-defmethod seq-sort (pred (list list))
184 (sort (seq-copy list) pred))
185
186(cl-defgeneric seq-reverse (seq)
187 "Return the reversed shallow copy of SEQ."
188 (let ((result '()))
189 (seq-map (lambda (elt)
190 (push elt result))
191 seq)
192 (seq-into result (type-of seq))))
193
194;; faster implementation for sequences (sequencep)
195(cl-defmethod seq-reverse ((seq sequence))
196 (reverse seq))
197
198(cl-defgeneric seq-concatenate (type &rest seqs)
199 "Concatenate, into a sequence of type TYPE, the sequences SEQS.
200TYPE must be one of following symbols: vector, string or list.
201
202\n(fn TYPE SEQUENCE...)"
203 ;; Since new seq types might be defined, we need to make sure that
204 ;; all seqs are actual sequences.
205 (let ((sequences (seq-map (lambda (s)
206 (if (sequencep s)
207 s
208 (seq-into s 'list)))
209 seqs)))
210 (pcase type
211 (`vector (apply #'vconcat sequences))
212 (`string (apply #'concat sequences))
213 (`list (apply #'append (append sequences '(nil))))
214 (_ (error "Not a sequence type name: %S" type)))))
215
216(cl-defgeneric seq-into (seq type)
217 "Convert the sequence SEQ into a sequence of type TYPE.
218TYPE can be one of the following symbols: vector, string or list."
219 (pcase type
220 (`vector (vconcat seq))
221 (`string (concat seq))
222 (`list (append seq nil))
223 (_ (error "Not a sequence type name: %S" type))))
224
225(cl-defgeneric seq-filter (pred seq)
138 "Return a list of all the elements for which (PRED element) is non-nil in SEQ." 226 "Return a list of all the elements for which (PRED element) is non-nil in SEQ."
139 (let ((exclude (make-symbol "exclude"))) 227 (let ((exclude (make-symbol "exclude")))
140 (delq exclude (seq-map (lambda (elt) 228 (delq exclude (seq-map (lambda (elt)
@@ -143,12 +231,12 @@ The result is a sequence of the same type as SEQ."
143 exclude)) 231 exclude))
144 seq)))) 232 seq))))
145 233
146(defun seq-remove (pred seq) 234(cl-defgeneric seq-remove (pred seq)
147 "Return a list of all the elements for which (PRED element) is nil in SEQ." 235 "Return a list of all the elements for which (PRED element) is nil in SEQ."
148 (seq-filter (lambda (elt) (not (funcall pred elt))) 236 (seq-filter (lambda (elt) (not (funcall pred elt)))
149 seq)) 237 seq))
150 238
151(defun seq-reduce (function seq initial-value) 239(cl-defgeneric seq-reduce (function seq initial-value)
152 "Reduce the function FUNCTION across SEQ, starting with INITIAL-VALUE. 240 "Reduce the function FUNCTION across SEQ, starting with INITIAL-VALUE.
153 241
154Return the result of calling FUNCTION with INITIAL-VALUE and the 242Return the result of calling FUNCTION with INITIAL-VALUE and the
@@ -164,7 +252,7 @@ If SEQ is empty, return INITIAL-VALUE and FUNCTION is not called."
164 (setq acc (funcall function acc elt))) 252 (setq acc (funcall function acc elt)))
165 acc))) 253 acc)))
166 254
167(defun seq-some-p (pred seq) 255(cl-defgeneric seq-some-p (pred seq)
168 "Return any element for which (PRED element) is non-nil in SEQ, nil otherwise." 256 "Return any element for which (PRED element) is non-nil in SEQ, nil otherwise."
169 (catch 'seq--break 257 (catch 'seq--break
170 (seq-doseq (elt seq) 258 (seq-doseq (elt seq)
@@ -172,7 +260,7 @@ If SEQ is empty, return INITIAL-VALUE and FUNCTION is not called."
172 (throw 'seq--break elt))) 260 (throw 'seq--break elt)))
173 nil)) 261 nil))
174 262
175(defun seq-every-p (pred seq) 263(cl-defgeneric seq-every-p (pred seq)
176 "Return non-nil if (PRED element) is non-nil for all elements of the sequence SEQ." 264 "Return non-nil if (PRED element) is non-nil for all elements of the sequence SEQ."
177 (catch 'seq--break 265 (catch 'seq--break
178 (seq-doseq (elt seq) 266 (seq-doseq (elt seq)
@@ -180,7 +268,7 @@ If SEQ is empty, return INITIAL-VALUE and FUNCTION is not called."
180 (throw 'seq--break nil))) 268 (throw 'seq--break nil)))
181 t)) 269 t))
182 270
183(defun seq-count (pred seq) 271(cl-defgeneric seq-count (pred seq)
184 "Return the number of elements for which (PRED element) is non-nil in SEQ." 272 "Return the number of elements for which (PRED element) is non-nil in SEQ."
185 (let ((count 0)) 273 (let ((count 0))
186 (seq-doseq (elt seq) 274 (seq-doseq (elt seq)
@@ -188,28 +276,14 @@ If SEQ is empty, return INITIAL-VALUE and FUNCTION is not called."
188 (setq count (+ 1 count)))) 276 (setq count (+ 1 count))))
189 count)) 277 count))
190 278
191(defun seq-empty-p (seq) 279(cl-defgeneric seq-contains-p (seq elt &optional testfn)
192 "Return non-nil if the sequence SEQ is empty, nil otherwise."
193 (if (listp seq)
194 (null seq)
195 (= 0 (seq-length seq))))
196
197(defun seq-sort (pred seq)
198 "Return a sorted sequence comparing using PRED the elements of SEQ.
199The result is a sequence of the same type as SEQ."
200 (if (listp seq)
201 (sort (seq-copy seq) pred)
202 (let ((result (seq-sort pred (append seq nil))))
203 (seq-into result (type-of seq)))))
204
205(defun seq-contains-p (seq elt &optional testfn)
206 "Return the first element in SEQ that equals to ELT. 280 "Return the first element in SEQ that equals to ELT.
207Equality is defined by TESTFN if non-nil or by `equal' if nil." 281Equality is defined by TESTFN if non-nil or by `equal' if nil."
208 (seq-some-p (lambda (e) 282 (seq-some-p (lambda (e)
209 (funcall (or testfn #'equal) elt e)) 283 (funcall (or testfn #'equal) elt e))
210 seq)) 284 seq))
211 285
212(defun seq-uniq (seq &optional testfn) 286(cl-defgeneric seq-uniq (seq &optional testfn)
213 "Return a list of the elements of SEQ with duplicates removed. 287 "Return a list of the elements of SEQ with duplicates removed.
214TESTFN is used to compare elements, or `equal' if TESTFN is nil." 288TESTFN is used to compare elements, or `equal' if TESTFN is nil."
215 (let ((result '())) 289 (let ((result '()))
@@ -218,51 +292,13 @@ TESTFN is used to compare elements, or `equal' if TESTFN is nil."
218 (setq result (cons elt result)))) 292 (setq result (cons elt result))))
219 (nreverse result))) 293 (nreverse result)))
220 294
221(defun seq-subseq (seq start &optional end) 295(cl-defgeneric seq-mapcat (function seq &optional type)
222 "Return the subsequence of SEQ from START to END.
223If END is omitted, it defaults to the length of the sequence.
224If START or END is negative, it counts from the end.
225
226Signal an error if START or END are outside of the sequence (i.e
227too large if positive or too small if negative)"
228 (cond ((or (stringp seq) (vectorp seq)) (substring seq start end))
229 ((listp seq)
230 (let (len (errtext (format "Bad bounding indices: %s, %s" start end)))
231 (and end (< end 0) (setq end (+ end (setq len (seq-length seq)))))
232 (if (< start 0) (setq start (+ start (or len (setq len (seq-length seq))))))
233 (unless (>= start 0)
234 (error "%s" errtext))
235 (when (> start 0)
236 (setq seq (nthcdr (1- start) seq))
237 (or seq (error "%s" errtext))
238 (setq seq (cdr seq)))
239 (if end
240 (let ((res nil))
241 (while (and (>= (setq end (1- end)) start) seq)
242 (push (pop seq) res))
243 (or (= (1+ end) start) (error "%s" errtext))
244 (nreverse res))
245 (seq-copy seq))))
246 (t (error "Unsupported sequence: %s" seq))))
247
248(defun seq-concatenate (type &rest seqs)
249 "Concatenate, into a sequence of type TYPE, the sequences SEQS.
250TYPE must be one of following symbols: vector, string or list.
251
252\n(fn TYPE SEQUENCE...)"
253 (pcase type
254 (`vector (apply #'vconcat seqs))
255 (`string (apply #'concat seqs))
256 (`list (apply #'append (append seqs '(nil))))
257 (_ (error "Not a sequence type name: %S" type))))
258
259(defun seq-mapcat (function seq &optional type)
260 "Concatenate the result of applying FUNCTION to each element of SEQ. 296 "Concatenate the result of applying FUNCTION to each element of SEQ.
261The result is a sequence of type TYPE, or a list if TYPE is nil." 297The result is a sequence of type TYPE, or a list if TYPE is nil."
262 (apply #'seq-concatenate (or type 'list) 298 (apply #'seq-concatenate (or type 'list)
263 (seq-map function seq))) 299 (seq-map function seq)))
264 300
265(defun seq-partition (seq n) 301(cl-defgeneric seq-partition (seq n)
266 "Return a list of the elements of SEQ grouped into sub-sequences of length N. 302 "Return a list of the elements of SEQ grouped into sub-sequences of length N.
267The last sequence may contain less than N elements. If N is a 303The last sequence may contain less than N elements. If N is a
268negative integer or 0, nil is returned." 304negative integer or 0, nil is returned."
@@ -273,7 +309,7 @@ negative integer or 0, nil is returned."
273 (setq seq (seq-drop seq n))) 309 (setq seq (seq-drop seq n)))
274 (nreverse result)))) 310 (nreverse result))))
275 311
276(defun seq-intersection (seq1 seq2 &optional testfn) 312(cl-defgeneric seq-intersection (seq1 seq2 &optional testfn)
277 "Return a list of the elements that appear in both SEQ1 and SEQ2. 313 "Return a list of the elements that appear in both SEQ1 and SEQ2.
278Equality is defined by TESTFN if non-nil or by `equal' if nil." 314Equality is defined by TESTFN if non-nil or by `equal' if nil."
279 (seq-reduce (lambda (acc elt) 315 (seq-reduce (lambda (acc elt)
@@ -283,7 +319,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil."
283 (seq-reverse seq1) 319 (seq-reverse seq1)
284 '())) 320 '()))
285 321
286(defun seq-difference (seq1 seq2 &optional testfn) 322(cl-defgeneric seq-difference (seq1 seq2 &optional testfn)
287 "Return a list of the elements that appear in SEQ1 but not in SEQ2. 323 "Return a list of the elements that appear in SEQ1 but not in SEQ2.
288Equality is defined by TESTFN if non-nil or by `equal' if nil." 324Equality is defined by TESTFN if non-nil or by `equal' if nil."
289 (seq-reduce (lambda (acc elt) 325 (seq-reduce (lambda (acc elt)
@@ -293,7 +329,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil."
293 (seq-reverse seq1) 329 (seq-reverse seq1)
294 '())) 330 '()))
295 331
296(defun seq-group-by (function seq) 332(cl-defgeneric seq-group-by (function seq)
297 "Apply FUNCTION to each element of SEQ. 333 "Apply FUNCTION to each element of SEQ.
298Separate the elements of SEQ into an alist using the results as 334Separate the elements of SEQ into an alist using the results as
299keys. Keys are compared using `equal'." 335keys. Keys are compared using `equal'."
@@ -308,70 +344,16 @@ keys. Keys are compared using `equal'."
308 (seq-reverse seq) 344 (seq-reverse seq)
309 nil)) 345 nil))
310 346
311(defalias 'seq-reverse 347(cl-defgeneric seq-min (seq)
312 (if (ignore-errors (reverse [1 2]))
313 #'reverse
314 (lambda (seq)
315 "Return the reversed copy of list, vector, or string SEQ.
316See also the function `nreverse', which is used more often."
317 (let ((result '()))
318 (seq-map (lambda (elt) (push elt result))
319 seq)
320 (if (listp seq)
321 result
322 (seq-into result (type-of seq)))))))
323
324(defun seq-into (seq type)
325 "Convert the sequence SEQ into a sequence of type TYPE.
326TYPE can be one of the following symbols: vector, string or list."
327 (pcase type
328 (`vector (vconcat seq))
329 (`string (concat seq))
330 (`list (append seq nil))
331 (_ (error "Not a sequence type name: %S" type))))
332
333(defun seq-min (seq)
334 "Return the smallest element of SEQ. 348 "Return the smallest element of SEQ.
335SEQ must be a sequence of numbers or markers." 349SEQ must be a sequence of numbers or markers."
336 (apply #'min (seq-into seq 'list))) 350 (apply #'min (seq-into seq 'list)))
337 351
338(defun seq-max (seq) 352(cl-defgeneric seq-max (seq)
339 "Return the largest element of SEQ. 353 "Return the largest element of SEQ.
340SEQ must be a sequence of numbers or markers." 354SEQ must be a sequence of numbers or markers."
341 (apply #'max (seq-into seq 'list))) 355 (apply #'max (seq-into seq 'list)))
342 356
343(defun seq--drop-list (list n)
344 "Return a list from LIST without its first N elements.
345This is an optimization for lists in `seq-drop'."
346 (while (and list (> n 0))
347 (setq list (cdr list)
348 n (1- n)))
349 list)
350
351(defun seq--take-list (list n)
352 "Return a list from LIST made of its first N elements.
353This is an optimization for lists in `seq-take'."
354 (let ((result '()))
355 (while (and list (> n 0))
356 (setq n (1- n))
357 (push (pop list) result))
358 (nreverse result)))
359
360(defun seq--drop-while-list (pred list)
361 "Return a list from the first element for which (PRED element) is nil in LIST.
362This is an optimization for lists in `seq-drop-while'."
363 (while (and list (funcall pred (car list)))
364 (setq list (cdr list)))
365 list)
366
367(defun seq--take-while-list (pred list)
368 "Return the successive elements for which (PRED element) is non-nil in LIST.
369This is an optimization for lists in `seq-take-while'."
370 (let ((result '()))
371 (while (and list (funcall pred (car list)))
372 (push (pop list) result))
373 (nreverse result)))
374
375(defun seq--count-successive (pred seq) 357(defun seq--count-successive (pred seq)
376 "Return the number of successive elements for which (PRED element) is non-nil in SEQ." 358 "Return the number of successive elements for which (PRED element) is non-nil in SEQ."
377 (let ((n 0) 359 (let ((n 0)
@@ -408,52 +390,52 @@ This is an optimization for lists in `seq-take-while'."
408 elt)) 390 elt))
409 args))) 391 args)))
410 392
411;; Helper function for the Backward-compatible version of `seq-let' 393;; TODO: make public?
412;; for Emacs<25.1.
413(defun seq--make-bindings (args seq &optional bindings)
414 "Return a list of bindings of the variables in ARGS to the elements of a sequence.
415if BINDINGS is non-nil, append new bindings to it, and return
416BINDINGS."
417 (let ((index 0)
418 (rest-marker nil))
419 (seq-doseq (name args)
420 (unless rest-marker
421 (pcase name
422 ((pred seq-p)
423 (setq bindings (seq--make-bindings (seq--elt-safe args index)
424 `(seq--elt-safe ,seq ,index)
425 bindings)))
426 (`&rest
427 (progn (push `(,(seq--elt-safe args (1+ index))
428 (seq-drop ,seq ,index))
429 bindings)
430 (setq rest-marker t)))
431 (_
432 (push `(,name (seq--elt-safe ,seq ,index)) bindings))))
433 (setq index (1+ index)))
434 bindings))
435
436(defun seq--elt-safe (seq n) 394(defun seq--elt-safe (seq n)
437 "Return element of SEQ at the index N. 395 "Return element of SEQ at the index N.
438If no element is found, return nil." 396If no element is found, return nil."
439 (when (or (listp seq) 397 (ignore-errors (seq-elt seq n)))
440 (and (sequencep seq) 398
441 (> (seq-length seq) n))) 399
442 (seq-elt seq n))) 400;;; Optimized implementations for lists
401
402(cl-defmethod seq-drop ((list list) n)
403 "Optimized implementation of `seq-drop' for lists."
404 (while (and list (> n 0))
405 (setq list (cdr list)
406 n (1- n)))
407 list)
408
409(cl-defmethod seq-take ((list list) n)
410 "Optimized implementation of `seq-take' for lists."
411 (let ((result '()))
412 (while (and list (> n 0))
413 (setq n (1- n))
414 (push (pop list) result))
415 (nreverse result)))
416
417(cl-defmethod seq-drop-while (pred (list list))
418 "Optimized implementation of `seq-drop-while' for lists"
419 (while (and list (funcall pred (car list)))
420 (setq list (cdr list)))
421 list)
422
423(cl-defmethod seq-drop-while (pred (list list))
424 "Optimized implementation of `seq-drop-while' for lists"
425 (while (and list (funcall pred (car list)))
426 (setq list (cdr list)))
427 list)
428
429(cl-defmethod seq-empty-p ((list list))
430 "Optimized implementation of `seq-empty-p' for lists."
431 (null list))
432
443 433
444(defun seq--activate-font-lock-keywords () 434(defun seq--activate-font-lock-keywords ()
445 "Activate font-lock keywords for some symbols defined in seq." 435 "Activate font-lock keywords for some symbols defined in seq."
446 (font-lock-add-keywords 'emacs-lisp-mode 436 (font-lock-add-keywords 'emacs-lisp-mode
447 '("\\<seq-doseq\\>" "\\<seq-let\\>"))) 437 '("\\<seq-doseq\\>" "\\<seq-let\\>")))
448 438
449(defalias 'seq-copy #'copy-sequence)
450(defalias 'seq-elt #'elt)
451(defalias 'seq-length #'length)
452(defalias 'seq-do #'mapc)
453(defalias 'seq-each #'seq-do)
454(defalias 'seq-map #'mapcar)
455(defalias 'seq-p #'sequencep)
456
457(unless (fboundp 'elisp--font-lock-flush-elisp-buffers) 439(unless (fboundp 'elisp--font-lock-flush-elisp-buffers)
458 ;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others) 440 ;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others)
459 ;; we automatically highlight macros. 441 ;; we automatically highlight macros.
diff --git a/test/automated/seq-tests.el b/test/automated/seq-tests.el
index 74c0700759e..163935b5432 100644
--- a/test/automated/seq-tests.el
+++ b/test/automated/seq-tests.el
@@ -54,6 +54,11 @@ Evaluate BODY for each created sequence.
54 "Return t if INTEGER is odd." 54 "Return t if INTEGER is odd."
55 (not (test-sequences-evenp integer))) 55 (not (test-sequences-evenp integer)))
56 56
57(ert-deftest test-setf-seq-elt ()
58 (with-test-sequences (seq '(1 2 3))
59 (setf (seq-elt seq 1) 4)
60 (should (= 4 (seq-elt seq 1)))))
61
57(ert-deftest test-seq-drop () 62(ert-deftest test-seq-drop ()
58 (with-test-sequences (seq '(1 2 3 4)) 63 (with-test-sequences (seq '(1 2 3 4))
59 (should (equal (seq-drop seq 0) seq)) 64 (should (equal (seq-drop seq 0) seq))
@@ -192,7 +197,7 @@ Evaluate BODY for each created sequence.
192 (should-error (seq-subseq [] -1)) 197 (should-error (seq-subseq [] -1))
193 (should-error (seq-subseq "" -1)) 198 (should-error (seq-subseq "" -1))
194 (should-not (seq-subseq '() 0)) 199 (should-not (seq-subseq '() 0))
195 (should-error(seq-subseq '() 0 -1))) 200 (should-error (seq-subseq '() 0 -1)))
196 201
197(ert-deftest test-seq-concatenate () 202(ert-deftest test-seq-concatenate ()
198 (with-test-sequences (seq '(2 4 6)) 203 (with-test-sequences (seq '(2 4 6))