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.
This commit is contained in:
Nicolas Petton
parent
58c3762a8b
commit
e7be986196
3 changed files with 223 additions and 218 deletions
|
|
@ -38,7 +38,6 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'seq)
|
||||
|
||||
;;; Type coercion.
|
||||
|
||||
|
|
@ -520,13 +519,32 @@ This sets the values of: `cl-most-positive-float', `cl-most-negative-float',
|
|||
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)"
|
||||
too large if positive or too small if negative)."
|
||||
(declare (gv-setter
|
||||
(lambda (new)
|
||||
(macroexp-let2 nil new new
|
||||
`(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end)
|
||||
,new)))))
|
||||
(seq-subseq seq start end))
|
||||
(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))))
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'cl-concatenate #'seq-concatenate
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
`(seq-do (lambda (,(car spec))
|
||||
,@body)
|
||||
,(cadr spec)))
|
||||
|
||||
(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.
|
||||
(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))
|
||||
|
||||
|
||||
;; 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.
|
||||
;;; 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))
|
||||
|
||||
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))))
|
||||
;; 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))
|
||||
|
||||
(defun seq-drop (seq n)
|
||||
(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))
|
||||
|
||||
(defalias 'seq-each #'seq-do)
|
||||
|
||||
(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))
|
||||
|
||||
(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.
|
||||
|
|
|
|||
|
|
@ -54,6 +54,11 @@ Evaluate BODY for each created sequence.
|
|||
"Return t if INTEGER is odd."
|
||||
(not (test-sequences-evenp integer)))
|
||||
|
||||
(ert-deftest test-setf-seq-elt ()
|
||||
(with-test-sequences (seq '(1 2 3))
|
||||
(setf (seq-elt seq 1) 4)
|
||||
(should (= 4 (seq-elt seq 1)))))
|
||||
|
||||
(ert-deftest test-seq-drop ()
|
||||
(with-test-sequences (seq '(1 2 3 4))
|
||||
(should (equal (seq-drop seq 0) seq))
|
||||
|
|
@ -192,7 +197,7 @@ Evaluate BODY for each created sequence.
|
|||
(should-error (seq-subseq [] -1))
|
||||
(should-error (seq-subseq "" -1))
|
||||
(should-not (seq-subseq '() 0))
|
||||
(should-error(seq-subseq '() 0 -1)))
|
||||
(should-error (seq-subseq '() 0 -1)))
|
||||
|
||||
(ert-deftest test-seq-concatenate ()
|
||||
(with-test-sequences (seq '(2 4 6))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue