diff options
Diffstat (limited to 'lisp/emacs-lisp/seq.el')
| -rw-r--r-- | lisp/emacs-lisp/seq.el | 412 |
1 files changed, 197 insertions, 215 deletions
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 @@ ;; Author: Nicolas Petton <nicolas@petton.fr> ;; Keywords: sequences -;; Version: 1.8 +;; Version: 2.0 ;; Package: seq ;; Maintainer: emacs-devel@gnu.org @@ -38,10 +38,26 @@ ;; the sequence as their second argument. All other functions take ;; the sequence as their first argument. ;; +;; While seq.el version 1.8 is in GNU ELPA for convenience, seq.el +;; version 2.0 requires Emacs>=25.1. +;; +;; seq.el can be extended to support new type of sequences. Here are +;; the generic functions that must be implemented by new seq types: +;; - `seq-elt' +;; - `seq-length' +;; - `seq-do' +;; - `seq-p' +;; - `seq-subseq' +;; - `seq-copy' +;; - `seq-into' +;; ;; All functions are tested in test/automated/seq-tests.el ;;; Code: +(eval-when-compile (require 'cl-generic)) +(require 'cl-extra) ;; for cl-subseq + (defmacro seq-doseq (spec &rest body) "Loop over a sequence. 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. \(fn (VAR SEQ) BODY...)" (declare (indent 1) (debug ((symbolp form &optional form) body))) - (let ((length (make-symbol "length")) - (seq (make-symbol "seq")) - (index (make-symbol "index"))) - `(let* ((,seq ,(cadr spec)) - (,length (if (listp ,seq) nil (seq-length ,seq))) - (,index (if ,length 0 ,seq))) - (while (if ,length - (< ,index ,length) - (consp ,index)) - (let ((,(car spec) (if ,length - (prog1 (seq-elt ,seq ,index) - (setq ,index (+ ,index 1))) - (pop ,index)))) - ,@body))))) - -(if (fboundp 'pcase-defmacro) - ;; Implementation of `seq-let' based on a `pcase' - ;; pattern. Requires Emacs>=25.1. - (progn - (pcase-defmacro seq (&rest args) - "pcase pattern matching sequence elements. + `(seq-do (lambda (,(car spec)) + ,@body) + ,(cadr spec))) + +(pcase-defmacro seq (&rest args) + "pcase pattern matching sequence elements. Matches if the object is a sequence (list, string or vector), and binds each element of ARGS to the corresponding element of the sequence." - `(and (pred seq-p) - ,@(seq--make-pcase-bindings args))) + `(and (pred seq-p) + ,@(seq--make-pcase-bindings args))) - (defmacro seq-let (args seq &rest body) - "Bind the variables in ARGS to the elements of SEQ then evaluate BODY. +(defmacro seq-let (args seq &rest body) + "Bind the variables in ARGS to the elements of SEQ then evaluate BODY. ARGS can also include the `&rest' marker followed by a variable name to be bound to the rest of SEQ." - (declare (indent 2) (debug t)) - `(pcase-let ((,(seq--make-pcase-patterns args) ,seq)) - ,@body))) + (declare (indent 2) (debug t)) + `(pcase-let ((,(seq--make-pcase-patterns args) ,seq)) + ,@body)) + + +;;; Basic seq functions that have to be implemented by new seq types +(cl-defgeneric seq-elt (seq n) + "Return the element of SEQ at index N." + (elt seq n)) + +;; Default gv setters for `seq-elt'. +;; It can be a good idea for new sequence impelentations to provide a +;; "gv-setter" for `seq-elt'. +(cl-defmethod (setf seq-elt) (store (seq array) n) + (aset seq n store)) + +(cl-defmethod (setf seq-elt) (store (seq cons) n) + (setcar (nthcdr n seq) store)) + +(cl-defgeneric seq-length (seq) + "Return the length of the sequence SEQ." + (length seq)) + +(cl-defgeneric seq-do (function seq) + "Apply FUNCTION to each element of SEQ, presumably for side effects. +Return SEQ." + (mapc function seq)) - ;; Implementation of `seq-let' compatible with Emacs<25.1. - (defmacro seq-let (args seq &rest body) - "Bind the variables in ARGS to the elements of SEQ then evaluate BODY. +(defalias 'seq-each #'seq-do) -ARGS can also include the `&rest' marker followed by a variable -name to be bound to the rest of SEQ." - (declare (indent 2) (debug t)) - (let ((seq-var (make-symbol "seq"))) - `(let* ((,seq-var ,seq) - ,@(seq--make-bindings args seq-var)) - ,@body)))) +(cl-defgeneric seq-p (seq) + "Return non-nil if SEQ is a sequence, nil otherwise." + (sequencep seq)) + +(cl-defgeneric seq-copy (seq) + "Return a shallow copy of SEQ." + (copy-sequence seq)) + +(cl-defgeneric seq-subseq (seq start &optional end) + "Return the subsequence of SEQ from START to END. +If END is omitted, it defaults to the length of the sequence. +If START or END is negative, it counts from the end. +Signal an error if START or END are outside of the sequence (i.e +too large if positive or too small if negative)." + (cl-subseq seq start end)) + + +(cl-defgeneric seq-map (function seq) + "Return the result of applying FUNCTION to each element of SEQ." + (let (result) + (seq-do (lambda (elt) + (push (funcall function elt) result)) + seq) + (nreverse result))) + +;; faster implementation for sequences (sequencep) +(cl-defmethod seq-map (function (seq sequence)) + (mapcar function seq)) -(defun seq-drop (seq n) +(cl-defgeneric seq-drop (seq n) "Return a subsequence of SEQ without its first N elements. The result is a sequence of the same type as SEQ. If N is a negative integer or zero, SEQ is returned." (if (<= n 0) seq - (if (listp seq) - (seq--drop-list seq n) - (let ((length (seq-length seq))) - (seq-subseq seq (min n length) length))))) + (let ((length (seq-length seq))) + (seq-subseq seq (min n length) length)))) -(defun seq-take (seq n) +(cl-defgeneric seq-take (seq n) "Return a subsequence of SEQ with its first N elements. The result is a sequence of the same type as SEQ. If N is a negative integer or zero, an empty sequence is returned." - (if (listp seq) - (seq--take-list seq n) - (seq-subseq seq 0 (min (max n 0) (seq-length seq))))) + (seq-subseq seq 0 (min (max n 0) (seq-length seq)))) -(defun seq-drop-while (pred seq) +(cl-defgeneric seq-drop-while (pred seq) "Return a sequence from the first element for which (PRED element) is nil in SEQ. The result is a sequence of the same type as SEQ." - (if (listp seq) - (seq--drop-while-list pred seq) - (seq-drop seq (seq--count-successive pred seq)))) + (seq-drop seq (seq--count-successive pred seq))) -(defun seq-take-while (pred seq) +(cl-defgeneric seq-take-while (pred seq) "Return the successive elements for which (PRED element) is non-nil in SEQ. The result is a sequence of the same type as SEQ." - (if (listp seq) - (seq--take-while-list pred seq) - (seq-take seq (seq--count-successive pred seq)))) + (seq-take seq (seq--count-successive pred seq))) -(defun seq-filter (pred seq) +(cl-defgeneric seq-empty-p (seq) + "Return non-nil if the sequence SEQ is empty, nil otherwise." + (= 0 (seq-length seq))) + +(cl-defgeneric seq-sort (pred seq) + "Return a sorted sequence comparing using PRED the elements of SEQ. +The result is a sequence of the same type as SEQ." + (let ((result (seq-sort pred (append seq nil)))) + (seq-into result (type-of seq)))) + +(cl-defmethod seq-sort (pred (list list)) + (sort (seq-copy list) pred)) + +(cl-defgeneric seq-reverse (seq) + "Return the reversed shallow copy of SEQ." + (let ((result '())) + (seq-map (lambda (elt) + (push elt result)) + seq) + (seq-into result (type-of seq)))) + +;; faster implementation for sequences (sequencep) +(cl-defmethod seq-reverse ((seq sequence)) + (reverse seq)) + +(cl-defgeneric seq-concatenate (type &rest seqs) + "Concatenate, into a sequence of type TYPE, the sequences SEQS. +TYPE must be one of following symbols: vector, string or list. + +\n(fn TYPE SEQUENCE...)" + ;; Since new seq types might be defined, we need to make sure that + ;; all seqs are actual sequences. + (let ((sequences (seq-map (lambda (s) + (if (sequencep s) + s + (seq-into s 'list))) + seqs))) + (pcase type + (`vector (apply #'vconcat sequences)) + (`string (apply #'concat sequences)) + (`list (apply #'append (append sequences '(nil)))) + (_ (error "Not a sequence type name: %S" type))))) + +(cl-defgeneric seq-into (seq type) + "Convert the sequence SEQ into a sequence of type TYPE. +TYPE can be one of the following symbols: vector, string or list." + (pcase type + (`vector (vconcat seq)) + (`string (concat seq)) + (`list (append seq nil)) + (_ (error "Not a sequence type name: %S" type)))) + +(cl-defgeneric seq-filter (pred seq) "Return a list of all the elements for which (PRED element) is non-nil in SEQ." (let ((exclude (make-symbol "exclude"))) (delq exclude (seq-map (lambda (elt) @@ -143,12 +231,12 @@ The result is a sequence of the same type as SEQ." exclude)) seq)))) -(defun seq-remove (pred seq) +(cl-defgeneric seq-remove (pred seq) "Return a list of all the elements for which (PRED element) is nil in SEQ." (seq-filter (lambda (elt) (not (funcall pred elt))) seq)) -(defun seq-reduce (function seq initial-value) +(cl-defgeneric seq-reduce (function seq initial-value) "Reduce the function FUNCTION across SEQ, starting with INITIAL-VALUE. 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." (setq acc (funcall function acc elt))) acc))) -(defun seq-some-p (pred seq) +(cl-defgeneric seq-some-p (pred seq) "Return any element for which (PRED element) is non-nil in SEQ, nil otherwise." (catch 'seq--break (seq-doseq (elt seq) @@ -172,7 +260,7 @@ If SEQ is empty, return INITIAL-VALUE and FUNCTION is not called." (throw 'seq--break elt))) nil)) -(defun seq-every-p (pred seq) +(cl-defgeneric seq-every-p (pred seq) "Return non-nil if (PRED element) is non-nil for all elements of the sequence SEQ." (catch 'seq--break (seq-doseq (elt seq) @@ -180,7 +268,7 @@ If SEQ is empty, return INITIAL-VALUE and FUNCTION is not called." (throw 'seq--break nil))) t)) -(defun seq-count (pred seq) +(cl-defgeneric seq-count (pred seq) "Return the number of elements for which (PRED element) is non-nil in SEQ." (let ((count 0)) (seq-doseq (elt seq) @@ -188,28 +276,14 @@ If SEQ is empty, return INITIAL-VALUE and FUNCTION is not called." (setq count (+ 1 count)))) count)) -(defun seq-empty-p (seq) - "Return non-nil if the sequence SEQ is empty, nil otherwise." - (if (listp seq) - (null seq) - (= 0 (seq-length seq)))) - -(defun seq-sort (pred seq) - "Return a sorted sequence comparing using PRED the elements of SEQ. -The result is a sequence of the same type as SEQ." - (if (listp seq) - (sort (seq-copy seq) pred) - (let ((result (seq-sort pred (append seq nil)))) - (seq-into result (type-of seq))))) - -(defun seq-contains-p (seq elt &optional testfn) +(cl-defgeneric seq-contains-p (seq elt &optional testfn) "Return the first element in SEQ that equals to ELT. Equality is defined by TESTFN if non-nil or by `equal' if nil." (seq-some-p (lambda (e) (funcall (or testfn #'equal) elt e)) seq)) -(defun seq-uniq (seq &optional testfn) +(cl-defgeneric seq-uniq (seq &optional testfn) "Return a list of the elements of SEQ with duplicates removed. TESTFN is used to compare elements, or `equal' if TESTFN is nil." (let ((result '())) @@ -218,51 +292,13 @@ TESTFN is used to compare elements, or `equal' if TESTFN is nil." (setq result (cons elt result)))) (nreverse result))) -(defun seq-subseq (seq start &optional end) - "Return the subsequence of SEQ from START to END. -If END is omitted, it defaults to the length of the sequence. -If START or END is negative, it counts from the end. - -Signal an error if START or END are outside of the sequence (i.e -too large if positive or too small if negative)" - (cond ((or (stringp seq) (vectorp seq)) (substring seq start end)) - ((listp seq) - (let (len (errtext (format "Bad bounding indices: %s, %s" start end))) - (and end (< end 0) (setq end (+ end (setq len (seq-length seq))))) - (if (< start 0) (setq start (+ start (or len (setq len (seq-length seq)))))) - (unless (>= start 0) - (error "%s" errtext)) - (when (> start 0) - (setq seq (nthcdr (1- start) seq)) - (or seq (error "%s" errtext)) - (setq seq (cdr seq))) - (if end - (let ((res nil)) - (while (and (>= (setq end (1- end)) start) seq) - (push (pop seq) res)) - (or (= (1+ end) start) (error "%s" errtext)) - (nreverse res)) - (seq-copy seq)))) - (t (error "Unsupported sequence: %s" seq)))) - -(defun seq-concatenate (type &rest seqs) - "Concatenate, into a sequence of type TYPE, the sequences SEQS. -TYPE must be one of following symbols: vector, string or list. - -\n(fn TYPE SEQUENCE...)" - (pcase type - (`vector (apply #'vconcat seqs)) - (`string (apply #'concat seqs)) - (`list (apply #'append (append seqs '(nil)))) - (_ (error "Not a sequence type name: %S" type)))) - -(defun seq-mapcat (function seq &optional type) +(cl-defgeneric seq-mapcat (function seq &optional type) "Concatenate the result of applying FUNCTION to each element of SEQ. The result is a sequence of type TYPE, or a list if TYPE is nil." (apply #'seq-concatenate (or type 'list) (seq-map function seq))) -(defun seq-partition (seq n) +(cl-defgeneric seq-partition (seq n) "Return a list of the elements of SEQ grouped into sub-sequences of length N. The last sequence may contain less than N elements. If N is a negative integer or 0, nil is returned." @@ -273,7 +309,7 @@ negative integer or 0, nil is returned." (setq seq (seq-drop seq n))) (nreverse result)))) -(defun seq-intersection (seq1 seq2 &optional testfn) +(cl-defgeneric seq-intersection (seq1 seq2 &optional testfn) "Return a list of the elements that appear in both SEQ1 and SEQ2. Equality is defined by TESTFN if non-nil or by `equal' if nil." (seq-reduce (lambda (acc elt) @@ -283,7 +319,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." (seq-reverse seq1) '())) -(defun seq-difference (seq1 seq2 &optional testfn) +(cl-defgeneric seq-difference (seq1 seq2 &optional testfn) "Return a list of the elements that appear in SEQ1 but not in SEQ2. Equality is defined by TESTFN if non-nil or by `equal' if nil." (seq-reduce (lambda (acc elt) @@ -293,7 +329,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." (seq-reverse seq1) '())) -(defun seq-group-by (function seq) +(cl-defgeneric seq-group-by (function seq) "Apply FUNCTION to each element of SEQ. Separate the elements of SEQ into an alist using the results as keys. Keys are compared using `equal'." @@ -308,70 +344,16 @@ keys. Keys are compared using `equal'." (seq-reverse seq) nil)) -(defalias 'seq-reverse - (if (ignore-errors (reverse [1 2])) - #'reverse - (lambda (seq) - "Return the reversed copy of list, vector, or string SEQ. -See also the function `nreverse', which is used more often." - (let ((result '())) - (seq-map (lambda (elt) (push elt result)) - seq) - (if (listp seq) - result - (seq-into result (type-of seq))))))) - -(defun seq-into (seq type) - "Convert the sequence SEQ into a sequence of type TYPE. -TYPE can be one of the following symbols: vector, string or list." - (pcase type - (`vector (vconcat seq)) - (`string (concat seq)) - (`list (append seq nil)) - (_ (error "Not a sequence type name: %S" type)))) - -(defun seq-min (seq) +(cl-defgeneric seq-min (seq) "Return the smallest element of SEQ. SEQ must be a sequence of numbers or markers." (apply #'min (seq-into seq 'list))) -(defun seq-max (seq) - "Return the largest element of SEQ. +(cl-defgeneric seq-max (seq) + "Return the largest element of SEQ. SEQ must be a sequence of numbers or markers." (apply #'max (seq-into seq 'list))) -(defun seq--drop-list (list n) - "Return a list from LIST without its first N elements. -This is an optimization for lists in `seq-drop'." - (while (and list (> n 0)) - (setq list (cdr list) - n (1- n))) - list) - -(defun seq--take-list (list n) - "Return a list from LIST made of its first N elements. -This is an optimization for lists in `seq-take'." - (let ((result '())) - (while (and list (> n 0)) - (setq n (1- n)) - (push (pop list) result)) - (nreverse result))) - -(defun seq--drop-while-list (pred list) - "Return a list from the first element for which (PRED element) is nil in LIST. -This is an optimization for lists in `seq-drop-while'." - (while (and list (funcall pred (car list))) - (setq list (cdr list))) - list) - -(defun seq--take-while-list (pred list) - "Return the successive elements for which (PRED element) is non-nil in LIST. -This is an optimization for lists in `seq-take-while'." - (let ((result '())) - (while (and list (funcall pred (car list))) - (push (pop list) result)) - (nreverse result))) - (defun seq--count-successive (pred seq) "Return the number of successive elements for which (PRED element) is non-nil in SEQ." (let ((n 0) @@ -408,52 +390,52 @@ This is an optimization for lists in `seq-take-while'." elt)) args))) -;; Helper function for the Backward-compatible version of `seq-let' -;; for Emacs<25.1. -(defun seq--make-bindings (args seq &optional bindings) - "Return a list of bindings of the variables in ARGS to the elements of a sequence. -if BINDINGS is non-nil, append new bindings to it, and return -BINDINGS." - (let ((index 0) - (rest-marker nil)) - (seq-doseq (name args) - (unless rest-marker - (pcase name - ((pred seq-p) - (setq bindings (seq--make-bindings (seq--elt-safe args index) - `(seq--elt-safe ,seq ,index) - bindings))) - (`&rest - (progn (push `(,(seq--elt-safe args (1+ index)) - (seq-drop ,seq ,index)) - bindings) - (setq rest-marker t))) - (_ - (push `(,name (seq--elt-safe ,seq ,index)) bindings)))) - (setq index (1+ index))) - bindings)) - +;; TODO: make public? (defun seq--elt-safe (seq n) "Return element of SEQ at the index N. If no element is found, return nil." - (when (or (listp seq) - (and (sequencep seq) - (> (seq-length seq) n))) - (seq-elt seq n))) + (ignore-errors (seq-elt seq n))) + + +;;; Optimized implementations for lists + +(cl-defmethod seq-drop ((list list) n) + "Optimized implementation of `seq-drop' for lists." + (while (and list (> n 0)) + (setq list (cdr list) + n (1- n))) + list) + +(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))) + +(cl-defmethod seq-drop-while (pred (list list)) + "Optimized implementation of `seq-drop-while' for lists" + (while (and list (funcall pred (car list))) + (setq list (cdr list))) + list) + +(cl-defmethod seq-drop-while (pred (list list)) + "Optimized implementation of `seq-drop-while' for lists" + (while (and list (funcall pred (car list))) + (setq list (cdr list))) + list) + +(cl-defmethod seq-empty-p ((list list)) + "Optimized implementation of `seq-empty-p' for lists." + (null list)) + (defun seq--activate-font-lock-keywords () "Activate font-lock keywords for some symbols defined in seq." (font-lock-add-keywords 'emacs-lisp-mode '("\\<seq-doseq\\>" "\\<seq-let\\>"))) -(defalias 'seq-copy #'copy-sequence) -(defalias 'seq-elt #'elt) -(defalias 'seq-length #'length) -(defalias 'seq-do #'mapc) -(defalias 'seq-each #'seq-do) -(defalias 'seq-map #'mapcar) -(defalias 'seq-p #'sequencep) - (unless (fboundp 'elisp--font-lock-flush-elisp-buffers) ;; In Emacsā„25, (via elisp--font-lock-flush-elisp-buffers and a few others) ;; we automatically highlight macros. |