diff options
| author | Nicolas Petton | 2015-08-14 22:33:10 +0200 |
|---|---|---|
| committer | Nicolas Petton | 2015-08-23 19:50:26 +0200 |
| commit | e7be9861962a5a399047e86a254c2534d5d4d146 (patch) | |
| tree | d34e43a6223522794a55aecedccffdc1769896f1 | |
| parent | 58c3762a8b8cfcf714539bda7114f52b6f615258 (diff) | |
| download | emacs-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.el | 24 | ||||
| -rw-r--r-- | lisp/emacs-lisp/seq.el | 412 | ||||
| -rw-r--r-- | test/automated/seq-tests.el | 7 |
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', | |||
| 520 | If END is omitted, it defaults to the length of the sequence. | 519 | If END is omitted, it defaults to the length of the sequence. |
| 521 | If START or END is negative, it counts from the end. | 520 | If START or END is negative, it counts from the end. |
| 522 | Signal an error if START or END are outside of the sequence (i.e | 521 | Signal an error if START or END are outside of the sequence (i.e |
| 523 | too large if positive or too small if negative)" | 522 | too 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. |
| 47 | Similar to `dolist' but can be applied to lists, strings, and vectors. | 63 | Similar 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. | ||
| 74 | Matches if the object is a sequence (list, string or vector), and | 75 | Matches if the object is a sequence (list, string or vector), and |
| 75 | binds each element of ARGS to the corresponding element of the | 76 | binds each element of ARGS to the corresponding element of the |
| 76 | sequence." | 77 | sequence." |
| 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 | ||
| 83 | ARGS can also include the `&rest' marker followed by a variable | 84 | ARGS can also include the `&rest' marker followed by a variable |
| 84 | name to be bound to the rest of SEQ." | 85 | name 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. | ||
| 111 | Return 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 | ||
| 93 | ARGS can also include the `&rest' marker followed by a variable | 116 | (cl-defgeneric seq-p (seq) |
| 94 | name 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. | ||
| 126 | If END is omitted, it defaults to the length of the sequence. | ||
| 127 | If START or END is negative, it counts from the end. | ||
| 128 | Signal an error if START or END are outside of the sequence (i.e | ||
| 129 | too 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. |
| 103 | The result is a sequence of the same type as SEQ. | 147 | The result is a sequence of the same type as SEQ. |
| 104 | 148 | ||
| 105 | If N is a negative integer or zero, SEQ is returned." | 149 | If 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. |
| 115 | The result is a sequence of the same type as SEQ. | 157 | The result is a sequence of the same type as SEQ. |
| 116 | 158 | ||
| 117 | If N is a negative integer or zero, an empty sequence is | 159 | If N is a negative integer or zero, an empty sequence is |
| 118 | returned." | 160 | returned." |
| 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. |
| 125 | The result is a sequence of the same type as SEQ." | 165 | The 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. |
| 132 | The result is a sequence of the same type as SEQ." | 170 | The 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. | ||
| 179 | The 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. | ||
| 200 | TYPE 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. | ||
| 218 | TYPE 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 | ||
| 154 | Return the result of calling FUNCTION with INITIAL-VALUE and the | 242 | Return 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. | ||
| 199 | The 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. |
| 207 | Equality is defined by TESTFN if non-nil or by `equal' if nil." | 281 | Equality 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. |
| 214 | TESTFN is used to compare elements, or `equal' if TESTFN is nil." | 288 | TESTFN 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. | ||
| 223 | If END is omitted, it defaults to the length of the sequence. | ||
| 224 | If START or END is negative, it counts from the end. | ||
| 225 | |||
| 226 | Signal an error if START or END are outside of the sequence (i.e | ||
| 227 | too 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. | ||
| 250 | TYPE 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. |
| 261 | The result is a sequence of type TYPE, or a list if TYPE is nil." | 297 | The 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. |
| 267 | The last sequence may contain less than N elements. If N is a | 303 | The last sequence may contain less than N elements. If N is a |
| 268 | negative integer or 0, nil is returned." | 304 | negative 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. |
| 278 | Equality is defined by TESTFN if non-nil or by `equal' if nil." | 314 | Equality 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. |
| 288 | Equality is defined by TESTFN if non-nil or by `equal' if nil." | 324 | Equality 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. |
| 298 | Separate the elements of SEQ into an alist using the results as | 334 | Separate the elements of SEQ into an alist using the results as |
| 299 | keys. Keys are compared using `equal'." | 335 | keys. 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. | ||
| 316 | See 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. | ||
| 326 | TYPE 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. |
| 335 | SEQ must be a sequence of numbers or markers." | 349 | SEQ 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. |
| 340 | SEQ must be a sequence of numbers or markers." | 354 | SEQ 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. | ||
| 345 | This 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. | ||
| 353 | This 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. | ||
| 362 | This 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. | ||
| 369 | This 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. | ||
| 415 | if BINDINGS is non-nil, append new bindings to it, and return | ||
| 416 | BINDINGS." | ||
| 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. |
| 438 | If no element is found, return nil." | 396 | If 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)) |