Line data Source code
1 : ;;; seq.el --- Sequence manipulation functions -*- lexical-binding: t -*-
2 :
3 : ;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Nicolas Petton <nicolas@petton.fr>
6 : ;; Keywords: sequences
7 : ;; Version: 2.20
8 : ;; Package: seq
9 :
10 : ;; Maintainer: emacs-devel@gnu.org
11 :
12 : ;; This file is part of GNU Emacs.
13 :
14 : ;; GNU Emacs is free software: you can redistribute it and/or modify
15 : ;; it under the terms of the GNU General Public License as published by
16 : ;; the Free Software Foundation, either version 3 of the License, or
17 : ;; (at your option) any later version.
18 :
19 : ;; GNU Emacs is distributed in the hope that it will be useful,
20 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 : ;; GNU General Public License for more details.
23 :
24 : ;; You should have received a copy of the GNU General Public License
25 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 :
27 : ;;; Commentary:
28 :
29 : ;; Sequence-manipulation functions that complement basic functions
30 : ;; provided by subr.el.
31 : ;;
32 : ;; All functions are prefixed with "seq-".
33 : ;;
34 : ;; All provided functions work on lists, strings and vectors.
35 : ;;
36 : ;; Functions taking a predicate or iterating over a sequence using a
37 : ;; function as argument take the function as their first argument and
38 : ;; the sequence as their second argument. All other functions take
39 : ;; the sequence as their first argument.
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 : ;; - `seqp'
50 : ;; - `seq-subseq'
51 : ;; - `seq-into-sequence'
52 : ;; - `seq-copy'
53 : ;; - `seq-into'
54 : ;;
55 : ;; All functions are tested in test/lisp/emacs-lisp/seq-tests.el
56 :
57 : ;;; Code:
58 :
59 : (eval-when-compile (require 'cl-generic))
60 : (require 'cl-lib) ;; for cl-subseq
61 :
62 : (defmacro seq-doseq (spec &rest body)
63 : "Loop over a sequence.
64 : Evaluate BODY with VAR bound to each element of SEQUENCE, in turn.
65 :
66 : Similar to `dolist' but can be applied to lists, strings, and vectors.
67 :
68 : \(fn (VAR SEQUENCE) BODY...)"
69 : (declare (indent 1) (debug ((symbolp form &optional form) body)))
70 8 : `(seq-do (lambda (,(car spec))
71 8 : ,@body)
72 8 : ,(cadr spec)))
73 :
74 : (pcase-defmacro seq (&rest patterns)
75 : "Build a `pcase' pattern that matches elements of SEQUENCE.
76 :
77 : The `pcase' pattern will match each element of PATTERNS against the
78 : corresponding element of SEQUENCE.
79 :
80 : Extra elements of the sequence are ignored if fewer PATTERNS are
81 : given, and the match does not fail."
82 0 : `(and (pred seqp)
83 0 : ,@(seq--make-pcase-bindings patterns)))
84 :
85 : (defmacro seq-let (args sequence &rest body)
86 : "Bind the variables in ARGS to the elements of SEQUENCE, then evaluate BODY.
87 :
88 : ARGS can also include the `&rest' marker followed by a variable
89 : name to be bound to the rest of SEQUENCE."
90 : (declare (indent 2) (debug (sexp form body)))
91 0 : `(pcase-let ((,(seq--make-pcase-patterns args) ,sequence))
92 0 : ,@body))
93 :
94 :
95 : ;;; Basic seq functions that have to be implemented by new sequence types
96 : (cl-defgeneric seq-elt (sequence n)
97 : "Return Nth element of SEQUENCE."
98 : (elt sequence n))
99 :
100 : ;; Default gv setters for `seq-elt'.
101 : ;; It can be a good idea for new sequence implementations to provide a
102 : ;; "gv-setter" for `seq-elt'.
103 : (cl-defmethod (setf seq-elt) (store (sequence array) n)
104 0 : (aset sequence n store))
105 :
106 : (cl-defmethod (setf seq-elt) (store (sequence cons) n)
107 0 : (setcar (nthcdr n sequence) store))
108 :
109 : (cl-defgeneric seq-length (sequence)
110 : "Return the number of elements of SEQUENCE."
111 : (length sequence))
112 :
113 : (cl-defgeneric seq-do (function sequence)
114 : "Apply FUNCTION to each element of SEQUENCE, presumably for side effects.
115 : Return SEQUENCE."
116 : (mapc function sequence))
117 :
118 : (defalias 'seq-each #'seq-do)
119 :
120 : (defun seq-do-indexed (function sequence)
121 : "Apply FUNCTION to each element of SEQUENCE and return nil.
122 : Unlike `seq-map', FUNCTION takes two arguments: the element of
123 : the sequence, and its index within the sequence."
124 0 : (let ((index 0))
125 0 : (seq-do (lambda (elt)
126 0 : (funcall function elt index)
127 0 : (setq index (1+ index)))
128 0 : sequence)))
129 :
130 : (cl-defgeneric seqp (sequence)
131 : "Return non-nil if SEQUENCE is a sequence, nil otherwise."
132 : (sequencep sequence))
133 :
134 : (cl-defgeneric seq-copy (sequence)
135 : "Return a shallow copy of SEQUENCE."
136 : (copy-sequence sequence))
137 :
138 : (cl-defgeneric seq-subseq (sequence start &optional end)
139 : "Return the sequence of elements of SEQUENCE from START to END.
140 : END is exclusive.
141 :
142 : If END is omitted, it defaults to the length of the sequence. If
143 : START or END is negative, it counts from the end. Signal an
144 : error if START or END are outside of the sequence (i.e too large
145 : if positive or too small if negative)."
146 : (cl-subseq sequence start end))
147 :
148 :
149 : (cl-defgeneric seq-map (function sequence)
150 : "Return the result of applying FUNCTION to each element of SEQUENCE."
151 : (let (result)
152 : (seq-do (lambda (elt)
153 : (push (funcall function elt) result))
154 : sequence)
155 : (nreverse result)))
156 :
157 : (defun seq-map-indexed (function sequence)
158 : "Return the result of applying FUNCTION to each element of SEQUENCE.
159 : Unlike `seq-map', FUNCTION takes two arguments: the element of
160 : the sequence, and its index within the sequence."
161 0 : (let ((index 0))
162 0 : (seq-map (lambda (elt)
163 0 : (prog1
164 0 : (funcall function elt index)
165 0 : (setq index (1+ index))))
166 0 : sequence)))
167 :
168 :
169 : ;; faster implementation for sequences (sequencep)
170 : (cl-defmethod seq-map (function (sequence sequence))
171 0 : (mapcar function sequence))
172 :
173 : (cl-defgeneric seq-mapn (function sequence &rest sequences)
174 : "Like `seq-map' but FUNCTION is mapped over all SEQUENCES.
175 : The arity of FUNCTION must match the number of SEQUENCES, and the
176 : mapping stops on the shortest sequence.
177 : Return a list of the results.
178 :
179 : \(fn FUNCTION SEQUENCES...)"
180 : (let ((result nil)
181 : (sequences (seq-map (lambda (s)
182 : (seq-into s 'list))
183 : (cons sequence sequences))))
184 : (while (not (memq nil sequences))
185 : (push (apply function (seq-map #'car sequences)) result)
186 : (setq sequences (seq-map #'cdr sequences)))
187 : (nreverse result)))
188 :
189 : (cl-defgeneric seq-drop (sequence n)
190 : "Remove the first N elements of SEQUENCE and return the result.
191 : The result is a sequence of the same type as SEQUENCE.
192 :
193 : If N is a negative integer or zero, SEQUENCE is returned."
194 : (if (<= n 0)
195 : sequence
196 : (let ((length (seq-length sequence)))
197 : (seq-subseq sequence (min n length) length))))
198 :
199 : (cl-defgeneric seq-take (sequence n)
200 : "Take the first N elements of SEQUENCE and return the result.
201 : The result is a sequence of the same type as SEQUENCE.
202 :
203 : If N is a negative integer or zero, an empty sequence is
204 : returned."
205 : (seq-subseq sequence 0 (min (max n 0) (seq-length sequence))))
206 :
207 : (cl-defgeneric seq-drop-while (pred sequence)
208 : "Remove the successive elements of SEQUENCE for which PRED returns non-nil.
209 : PRED is a function of one argument. The result is a sequence of
210 : the same type as SEQUENCE."
211 : (seq-drop sequence (seq--count-successive pred sequence)))
212 :
213 : (cl-defgeneric seq-take-while (pred sequence)
214 : "Take the successive elements of SEQUENCE for which PRED returns non-nil.
215 : PRED is a function of one argument. The result is a sequence of
216 : the same type as SEQUENCE."
217 : (seq-take sequence (seq--count-successive pred sequence)))
218 :
219 : (cl-defgeneric seq-empty-p (sequence)
220 : "Return non-nil if the SEQUENCE is empty, nil otherwise."
221 : (= 0 (seq-length sequence)))
222 :
223 : (cl-defgeneric seq-sort (pred sequence)
224 : "Sort SEQUENCE using PRED as comparison function.
225 : The result is a sequence of the same type as SEQUENCE."
226 : (let ((result (seq-sort pred (append sequence nil))))
227 : (seq-into result (type-of sequence))))
228 :
229 : (cl-defmethod seq-sort (pred (list list))
230 0 : (sort (seq-copy list) pred))
231 :
232 : (defun seq-sort-by (function pred sequence)
233 : "Sort SEQUENCE using PRED as a comparison function.
234 : Elements of SEQUENCE are transformed by FUNCTION before being
235 : sorted. FUNCTION must be a function of one argument."
236 0 : (seq-sort (lambda (a b)
237 0 : (funcall pred
238 0 : (funcall function a)
239 0 : (funcall function b)))
240 0 : sequence))
241 :
242 : (cl-defgeneric seq-reverse (sequence)
243 : "Return a sequence with elements of SEQUENCE in reverse order."
244 : (let ((result '()))
245 : (seq-map (lambda (elt)
246 : (push elt result))
247 : sequence)
248 : (seq-into result (type-of sequence))))
249 :
250 : ;; faster implementation for sequences (sequencep)
251 : (cl-defmethod seq-reverse ((sequence sequence))
252 0 : (reverse sequence))
253 :
254 : (cl-defgeneric seq-concatenate (type &rest sequences)
255 : "Concatenate SEQUENCES into a single sequence of type TYPE.
256 : TYPE must be one of following symbols: vector, string or list.
257 :
258 : \n(fn TYPE SEQUENCE...)"
259 : (apply #'cl-concatenate type (seq-map #'seq-into-sequence sequences)))
260 :
261 : (cl-defgeneric seq-into-sequence (sequence)
262 : "Convert SEQUENCE into a sequence.
263 :
264 : The default implementation is to signal an error if SEQUENCE is not a
265 : sequence, specific functions should be implemented for new types
266 : of sequence."
267 : (unless (sequencep sequence)
268 : (error "Cannot convert %S into a sequence" sequence))
269 : sequence)
270 :
271 : (cl-defgeneric seq-into (sequence type)
272 : "Concatenate the elements of SEQUENCE into a sequence of type TYPE.
273 : TYPE can be one of the following symbols: vector, string or
274 : list."
275 : (pcase type
276 : (`vector (seq--into-vector sequence))
277 : (`string (seq--into-string sequence))
278 : (`list (seq--into-list sequence))
279 : (_ (error "Not a sequence type name: %S" type))))
280 :
281 : (cl-defgeneric seq-filter (pred sequence)
282 : "Return a list of all the elements for which (PRED element) is non-nil in SEQUENCE."
283 : (let ((exclude (make-symbol "exclude")))
284 : (delq exclude (seq-map (lambda (elt)
285 : (if (funcall pred elt)
286 : elt
287 : exclude))
288 : sequence))))
289 :
290 : (cl-defgeneric seq-remove (pred sequence)
291 : "Return a list of all the elements for which (PRED element) is nil in SEQUENCE."
292 : (seq-filter (lambda (elt) (not (funcall pred elt)))
293 : sequence))
294 :
295 : (cl-defgeneric seq-reduce (function sequence initial-value)
296 : "Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE.
297 :
298 : Return the result of calling FUNCTION with INITIAL-VALUE and the
299 : first element of SEQUENCE, then calling FUNCTION with that result and
300 : the second element of SEQUENCE, then with that result and the third
301 : element of SEQUENCE, etc.
302 :
303 : If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called."
304 : (if (seq-empty-p sequence)
305 : initial-value
306 : (let ((acc initial-value))
307 : (seq-doseq (elt sequence)
308 : (setq acc (funcall function acc elt)))
309 : acc)))
310 :
311 : (cl-defgeneric seq-every-p (pred sequence)
312 : "Return non-nil if (PRED element) is non-nil for all elements of SEQUENCE."
313 : (catch 'seq--break
314 : (seq-doseq (elt sequence)
315 : (or (funcall pred elt)
316 : (throw 'seq--break nil)))
317 : t))
318 :
319 : (cl-defgeneric seq-some (pred sequence)
320 : "Return non-nil if PRED is satisfied for at least one element of SEQUENCE.
321 : If so, return the first non-nil value returned by PRED."
322 : (catch 'seq--break
323 : (seq-doseq (elt sequence)
324 : (let ((result (funcall pred elt)))
325 : (when result
326 : (throw 'seq--break result))))
327 : nil))
328 :
329 : (cl-defgeneric seq-find (pred sequence &optional default)
330 : "Return the first element for which (PRED element) is non-nil in SEQUENCE.
331 : If no element is found, return DEFAULT.
332 :
333 : Note that `seq-find' has an ambiguity if the found element is
334 : identical to DEFAULT, as it cannot be known if an element was
335 : found or not."
336 : (catch 'seq--break
337 : (seq-doseq (elt sequence)
338 : (when (funcall pred elt)
339 : (throw 'seq--break elt)))
340 : default))
341 :
342 : (cl-defgeneric seq-count (pred sequence)
343 : "Return the number of elements for which (PRED element) is non-nil in SEQUENCE."
344 : (let ((count 0))
345 : (seq-doseq (elt sequence)
346 : (when (funcall pred elt)
347 : (setq count (+ 1 count))))
348 : count))
349 :
350 : (cl-defgeneric seq-contains (sequence elt &optional testfn)
351 : "Return the first element in SEQUENCE that is equal to ELT.
352 : Equality is defined by TESTFN if non-nil or by `equal' if nil."
353 : (seq-some (lambda (e)
354 : (when (funcall (or testfn #'equal) elt e)
355 : e))
356 : sequence))
357 :
358 : (cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn)
359 : "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of order.
360 : Equality is defined by TESTFN if non-nil or by `equal' if nil."
361 : (and (seq-every-p (lambda (item1) (seq-contains sequence2 item1 testfn)) sequence1)
362 : (seq-every-p (lambda (item2) (seq-contains sequence1 item2 testfn)) sequence2)))
363 :
364 : (cl-defgeneric seq-position (sequence elt &optional testfn)
365 : "Return the index of the first element in SEQUENCE that is equal to ELT.
366 : Equality is defined by TESTFN if non-nil or by `equal' if nil."
367 : (let ((index 0))
368 : (catch 'seq--break
369 : (seq-doseq (e sequence)
370 : (when (funcall (or testfn #'equal) e elt)
371 : (throw 'seq--break index))
372 : (setq index (1+ index)))
373 : nil)))
374 :
375 : (cl-defgeneric seq-uniq (sequence &optional testfn)
376 : "Return a list of the elements of SEQUENCE with duplicates removed.
377 : TESTFN is used to compare elements, or `equal' if TESTFN is nil."
378 : (let ((result '()))
379 : (seq-doseq (elt sequence)
380 : (unless (seq-contains result elt testfn)
381 : (setq result (cons elt result))))
382 : (nreverse result)))
383 :
384 : (cl-defgeneric seq-mapcat (function sequence &optional type)
385 : "Concatenate the result of applying FUNCTION to each element of SEQUENCE.
386 : The result is a sequence of type TYPE, or a list if TYPE is nil."
387 : (apply #'seq-concatenate (or type 'list)
388 : (seq-map function sequence)))
389 :
390 : (cl-defgeneric seq-partition (sequence n)
391 : "Return a list of the elements of SEQUENCE grouped into sub-sequences of length N.
392 : The last sequence may contain less than N elements. If N is a
393 : negative integer or 0, nil is returned."
394 : (unless (< n 1)
395 : (let ((result '()))
396 : (while (not (seq-empty-p sequence))
397 : (push (seq-take sequence n) result)
398 : (setq sequence (seq-drop sequence n)))
399 : (nreverse result))))
400 :
401 : (cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn)
402 : "Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2.
403 : Equality is defined by TESTFN if non-nil or by `equal' if nil."
404 : (seq-reduce (lambda (acc elt)
405 : (if (seq-contains sequence2 elt testfn)
406 : (cons elt acc)
407 : acc))
408 : (seq-reverse sequence1)
409 : '()))
410 :
411 : (cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn)
412 : "Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2.
413 : Equality is defined by TESTFN if non-nil or by `equal' if nil."
414 : (seq-reduce (lambda (acc elt)
415 : (if (not (seq-contains sequence2 elt testfn))
416 : (cons elt acc)
417 : acc))
418 : (seq-reverse sequence1)
419 : '()))
420 :
421 : (cl-defgeneric seq-group-by (function sequence)
422 : "Apply FUNCTION to each element of SEQUENCE.
423 : Separate the elements of SEQUENCE into an alist using the results as
424 : keys. Keys are compared using `equal'."
425 : (seq-reduce
426 : (lambda (acc elt)
427 : (let* ((key (funcall function elt))
428 : (cell (assoc key acc)))
429 : (if cell
430 : (setcdr cell (push elt (cdr cell)))
431 : (push (list key elt) acc))
432 : acc))
433 : (seq-reverse sequence)
434 : nil))
435 :
436 : (cl-defgeneric seq-min (sequence)
437 : "Return the smallest element of SEQUENCE.
438 : SEQUENCE must be a sequence of numbers or markers."
439 : (apply #'min (seq-into sequence 'list)))
440 :
441 : (cl-defgeneric seq-max (sequence)
442 : "Return the largest element of SEQUENCE.
443 : SEQUENCE must be a sequence of numbers or markers."
444 : (apply #'max (seq-into sequence 'list)))
445 :
446 : (defun seq--count-successive (pred sequence)
447 : "Return the number of successive elements for which (PRED element) is non-nil in SEQUENCE."
448 0 : (let ((n 0)
449 0 : (len (seq-length sequence)))
450 0 : (while (and (< n len)
451 0 : (funcall pred (seq-elt sequence n)))
452 0 : (setq n (+ 1 n)))
453 0 : n))
454 :
455 : (defun seq--make-pcase-bindings (args)
456 : "Return a list of bindings of the variables in ARGS to the elements of a sequence."
457 0 : (let ((bindings '())
458 : (index 0)
459 : (rest-marker nil))
460 0 : (seq-doseq (name args)
461 0 : (unless rest-marker
462 0 : (pcase name
463 : (`&rest
464 0 : (progn (push `(app (pcase--flip seq-drop ,index)
465 0 : ,(seq--elt-safe args (1+ index)))
466 0 : bindings)
467 0 : (setq rest-marker t)))
468 : (_
469 0 : (push `(app (pcase--flip seq--elt-safe ,index) ,name) bindings))))
470 0 : (setq index (1+ index)))
471 0 : bindings))
472 :
473 : (defun seq--make-pcase-patterns (args)
474 : "Return a list of `(seq ...)' pcase patterns from the argument list ARGS."
475 0 : (cons 'seq
476 0 : (seq-map (lambda (elt)
477 0 : (if (seqp elt)
478 0 : (seq--make-pcase-patterns elt)
479 0 : elt))
480 0 : args)))
481 :
482 : ;; TODO: make public?
483 : (defun seq--elt-safe (sequence n)
484 : "Return element of SEQUENCE at the index N.
485 : If no element is found, return nil."
486 0 : (ignore-errors (seq-elt sequence n)))
487 :
488 : (cl-defgeneric seq-random-elt (sequence)
489 : "Return a random element from SEQUENCE.
490 : Signal an error if SEQUENCE is empty."
491 : (if (seq-empty-p sequence)
492 : (error "Sequence cannot be empty")
493 : (seq-elt sequence (random (seq-length sequence)))))
494 :
495 :
496 : ;;; Optimized implementations for lists
497 :
498 : (cl-defmethod seq-drop ((list list) n)
499 : "Optimized implementation of `seq-drop' for lists."
500 0 : (nthcdr n list))
501 :
502 : (cl-defmethod seq-take ((list list) n)
503 : "Optimized implementation of `seq-take' for lists."
504 0 : (let ((result '()))
505 0 : (while (and list (> n 0))
506 0 : (setq n (1- n))
507 0 : (push (pop list) result))
508 0 : (nreverse result)))
509 :
510 : (cl-defmethod seq-drop-while (pred (list list))
511 : "Optimized implementation of `seq-drop-while' for lists."
512 0 : (while (and list (funcall pred (car list)))
513 0 : (setq list (cdr list)))
514 0 : list)
515 :
516 : (cl-defmethod seq-empty-p ((list list))
517 : "Optimized implementation of `seq-empty-p' for lists."
518 0 : (null list))
519 :
520 :
521 : (defun seq--into-list (sequence)
522 : "Concatenate the elements of SEQUENCE into a list."
523 0 : (if (listp sequence)
524 0 : sequence
525 0 : (append sequence nil)))
526 :
527 : (defun seq--into-vector (sequence)
528 : "Concatenate the elements of SEQUENCE into a vector."
529 0 : (if (vectorp sequence)
530 0 : sequence
531 0 : (vconcat sequence)))
532 :
533 : (defun seq--into-string (sequence)
534 : "Concatenate the elements of SEQUENCE into a string."
535 0 : (if (stringp sequence)
536 0 : sequence
537 0 : (concat sequence)))
538 :
539 : (defun seq--activate-font-lock-keywords ()
540 : "Activate font-lock keywords for some symbols defined in seq."
541 0 : (font-lock-add-keywords 'emacs-lisp-mode
542 0 : '("\\<seq-doseq\\>" "\\<seq-let\\>")))
543 :
544 : (unless (fboundp 'elisp--font-lock-flush-elisp-buffers)
545 : ;; In Emacsā„25, (via elisp--font-lock-flush-elisp-buffers and a few others)
546 : ;; we automatically highlight macros.
547 : (add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords))
548 :
549 : (provide 'seq)
550 : ;;; seq.el ends here
|