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.

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.