Subject: bug#68863: Add support for using setf with seq-subseq

From: Okamsn <[email-masked]>
Date: Thu, 18 Apr 2024 02:54:46 +0000

Okamsn wrote:
> Hello,
> 
> After testing it more, I see that what I've written does not work as I
> expected in the case
> 
> (let ((v    (vector (vector 0 1)
>                       (vector 2 3)
>                       (vector 4 5))))
>     (setf (seq-subseq (seq-subseq (elt v 0) 0) 0)
>           [10])
>     v)
> 
> in which I would expect it to replace the first element of the first
> sub-vector with 10. I will take more time to continue working on this.
> 
> Thank you for your patience.
> 
> 

Hello,

I found a way to work with subplaces, like in the example in my previous 
e-mail message. Instead of creating the generic feature `(setf 
seq-subseq)` like what is done for `seq-elt`, I created a generic 
function `seq-replace`, which is used in a new `gv-expander` for 
`seq-subseq`. This way of doing it is like what is done for `substring`, 
which has the behavior that I wanted.

What do you think about this approach?

Thank you.

From 414c7689ef8735e4d2955e0f97b5ce842120883e Mon Sep 17 00:00:00 2001
From: Earl Hyatt <[email-masked]>
Date: Sun, 28 Jan 2024 22:48:13 -0500
Subject: [PATCH v3] Add seq-replace and setf support for seq-subseq.

* lisp/emacs-lisp/seq.el (seq-replace): Add function for
non-destructively replacing the elements of sequence
with those from another sequence.
* lisp/emacs-lisp/seq.el (seq-subseq): Declare the 'gv-expander'
specification using the new 'seq-replace' functions.
* test/lisp/emacs-lisp/seq-tests.el (test-seq-replace)
(test-seq-replace-combinations): Add tests for 'seq-replace'.
* test/lisp/emacs-lisp/seq-tests.el (test-setf-seq-subseq)
(test-setf-seq-subseq-combinations, test-setf-seq-subseq-recursive): Add
tests for the new gv expander.

The feature will signal 'args-out-of-range' if the starting index or
ending index (if given) is outside of the range of values from 0 through
the length of the sequence or from the negative length of the sequence
through negative 1.  If the starting index is equal to the length of the
sequence, then nothing is changed.  If the starting index is equal to
the ending index, then nothing is changed.  The 'seq-replace' and the
new 'setf' support for 'seq-subseq' should signal an error in all cases
where using 'seq-subseq' would signal an error.
---
 lisp/emacs-lisp/seq.el            |  91 +++++++++
 test/lisp/emacs-lisp/seq-tests.el | 324 ++++++++++++++++++++++++++++++
 2 files changed, 415 insertions(+)

diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index a20cff16982..37f73932cd7 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -158,6 +158,84 @@ seq-copy
   "Return a shallow copy of SEQUENCE."
   (copy-sequence sequence))
 
+(cl-defgeneric seq-replace (sequence replacements start &optional end)
+  "Replace elements of SEQUENCE from START to END with elements of REPLACEMENTS.
+END is exclusive."
+  (let* ((len (seq-length sequence))
+         (signal-fn (lambda ()
+                      (signal 'args-out-of-range
+                              (if end
+                                  (list sequence start end)
+                                (list sequence start)))))
+         (signal-or-val-fn (lambda (val)
+                             (cond
+                              ((> val len)
+                               (funcall signal-fn))
+                              ((< val 0)
+                               (let ((val2 (+ val len)))
+                                 (if (< val2 0)
+                                     (funcall signal-fn)
+                                   val2)))
+                              (t
+                               val))))
+         (idx-start (funcall signal-or-val-fn start))
+         (idx-end (if (null end)
+                      len
+                    (funcall signal-or-val-fn end))))
+    (if (> idx-start idx-end)
+        (funcall signal-fn)
+      (let ((replacement-idx 0)
+            (replacement-len (seq-length replacements)))
+        (seq-into (seq-map-indexed (lambda (elem idx)
+                                     (if (and (<= idx-start idx)
+                                              (< idx idx-end)
+                                              (< replacement-idx replacement-len))
+                                         (prog1
+                                             (seq-elt replacements replacement-idx)
+                                           (setq replacement-idx (1+ replacement-idx)))
+                                       elem))
+                                   sequence)
+                  (if (listp sequence)
+                      'list
+                    (type-of sequence)))))))
+
+(cl-defmethod seq-replace (sequence (replacements list) start &optional end)
+  "Replace elements of SEQUENCE from START to END with elements of REPLACEMENTS.
+END is exclusive."
+  (let* ((len (seq-length sequence))
+         (signal-fn (lambda ()
+                      (signal 'args-out-of-range
+                              (if end
+                                  (list sequence start end)
+                                (list sequence start)))))
+         (signal-or-val-fn (lambda (val)
+                             (cond
+                              ((> val len)
+                               (funcall signal-fn))
+                              ((< val 0)
+                               (let ((val2 (+ val len)))
+                                 (if (< val2 0)
+                                     (funcall signal-fn)
+                                   val2)))
+                              (t
+                               val))))
+         (idx-start (funcall signal-or-val-fn start))
+         (idx-end (if (null end)
+                      len
+                    (funcall signal-or-val-fn end))))
+    (if (> idx-start idx-end)
+        (funcall signal-fn)
+      (seq-into (seq-map-indexed (lambda (elem idx)
+                                   (if (and (<= idx-start idx)
+                                            (< idx idx-end)
+                                            replacements)
+                                       (pop replacements)
+                                     elem))
+                                 sequence)
+                (if (listp sequence)
+                    'list
+                  (type-of sequence))))))
+
 ;;;###autoload
 (cl-defgeneric seq-subseq (sequence start &optional end)
   "Return the sequence of elements of SEQUENCE from START to END.
@@ -167,6 +245,19 @@ seq-subseq
 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)."
+  (declare
+   (gv-expander
+    (lambda (do)
+      (gv-letplace (getter setter) `(gv-delay-error ,sequence)
+        (macroexp-let2* nil ((start start) (end end))
+          (funcall do
+                   `(seq-subseq ,getter ,start ,end)
+                   (lambda (v)
+                     (macroexp-let2 nil v v
+                       `(progn
+                          ,(funcall setter
+                                    `(seq-replace ,getter ,v ,start ,end))
+                          ,v)))))))))
   (cond
    ((or (stringp sequence) (vectorp sequence)) (substring sequence start end))
    ((listp sequence)
diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el
index c06ceb00bdb..44fd5350f72 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -312,6 +312,330 @@ test-seq-subseq
                   (:success
                    (should (equal (seq-subseq list start end) res))))))))))))
 
+(cl-defmacro test-seq-replace-combinations
+    (&key init-vals sub-vals result range error)
+  "Make a test for each combination of sequence type for `seq-subseq' using `setf'.
+
+- INIT-VALS is a list holding the initial elements.
+- RESULT is what the final value should be after substitution.
+- ERROR is whether the form should signal `args-out-of-range'.
+- SUB-VALS is a list holding the elements to be substituted in.
+- RANGE is a list of the `start' and `end' arguments of `seq-subseq'."
+  (let ((tests))
+    (dolist (type1 '(list vector string))
+      (dolist (type2 '(list vector string))
+        (push  (if error
+                   `(should-error (seq-replace (,type1 ,@init-vals)
+                                               (,type2 ,@sub-vals)
+                                               ,@range)
+                                  :type (quote args-out-of-range))
+                 `(should (equal (,type1 ,@result)
+                                 (seq-replace (,type1 ,@init-vals)
+                                              (,type2 ,@sub-vals)
+                                              ,@range))))
+               tests)))
+    `(progn ,@tests)))
+
+(ert-deftest test-seq-replace ()
+  "Test using `seq-replace' with `setf'.
+
+Any combination of sequences should work.
+
+An error should be signalled if the inclusive starting index or
+the exclusive ending index is out of the range from 0 through the
+length of the sequence, or if the starting index is greater than
+the ending index.  If the starting index is equal to the ending
+index, then nothing is changed.  If the starting index is equal
+to the length of the sequence, then nothing is changed.  It
+should signal an error in all the cases that `seq-replace' signals
+an error."
+  (test-seq-replace-combinations
+   :init-vals (0 1 2)
+   :sub-vals (10 11 12)
+   :range (0)
+   :result (10 11 12))
+
+  (test-seq-replace-combinations
+   :init-vals (0 1)
+   :sub-vals (10 11 12)
+   :range (0)
+   :result (10 11))
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2)
+   :sub-vals (10 11 12)
+   :range (1)
+   :result (0 10 11))
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2)
+   :sub-vals (10 11 12)
+   :range (1 3)
+   :result (0 10 11))
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2)
+   :sub-vals (10 11 12)
+   :range (3 1)
+   :error t)
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2)
+   :sub-vals (10 11 12)
+   :range (1 100)
+   :error t)
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2)
+   :sub-vals (10 11 12)
+   :range (7)
+   :error t)
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2 3 4)
+   :sub-vals (12 13 14 15)
+   :range (2 3)
+   :result (0 1 12 3 4))
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2 3 4)
+   :sub-vals (12 13 14 15)
+   :range (2 2)
+   :result (0 1 2 3 4))
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2 3 4)
+   :sub-vals (12 13 14 15)
+   :range (5)
+   :result (0 1 2 3 4))
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2 3 4)
+   :sub-vals (12 13 14 15)
+   :range (6)
+   :error t)
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2 3 4)
+   :sub-vals (12 13 14 15)
+   :range (5 6)
+   :error t)
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (-2)
+   :result (0 1 2 3 4 5 6 7 10 11))
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (-6 -3)
+   :result (0 1 2 3 10 11 12 7 8 9))
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (-6 -10)
+   :error t)
+
+  ;; This range might make sense, but since it would signal an error
+  ;; in `seq-subseq', we also signal an error in the `setf' feature.
+  (test-seq-replace-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (-6 0)
+   :error t)
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (100)
+   :error t)
+
+  (test-seq-replace-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (-100)
+   :error t))
+
+(cl-defmacro test-setf-seq-subseq-combinations
+    (&key init-vals sub-vals result range error)
+  "Make a test for each combination of sequence type for `seq-subseq' using `setf'.
+
+- INIT-VALS is a list holding the initial elements.
+- RESULT is what the final value should be after substitution.
+- ERROR is whether the form should signal `args-out-of-range'.
+- SUB-VALS is a list holding the elements to be substituted in.
+- RANGE is a list of the `start' and `end' arguments of `seq-subseq'."
+  (let ((tests))
+    (dolist (type1 '(list vector string))
+      (dolist (type2 '(list vector string))
+        (push  (if error
+                   `(should-error (let ((seq (,type1 ,@init-vals)))
+                                    (setf (seq-subseq seq ,@range)
+                                          (,type2 ,@sub-vals))
+                                    seq)
+                                  :type (quote args-out-of-range))
+                 `(should (equal (,type1 ,@result)
+                                 (let ((seq (,type1 ,@init-vals)))
+                                   (setf (seq-subseq seq ,@range)
+                                         (,type2 ,@sub-vals))
+                                   seq))))
+               tests)))
+    `(progn ,@tests)))
+
+(ert-deftest test-setf-seq-subseq ()
+  "Test using `seq-subseq' with `setf'.
+
+Any combination of sequences should work.
+
+An error should be signalled if the inclusive starting index or
+the exclusive ending index is out of the range from 0 through the
+length of the sequence, or if the starting index is greater than
+the ending index.  If the starting index is equal to the ending
+index, then nothing is changed.  If the starting index is equal
+to the length of the sequence, then nothing is changed.  It
+should signal an error in all the cases that `seq-subseq' signals
+an error."
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2)
+   :sub-vals (10 11 12)
+   :range (0)
+   :result (10 11 12))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1)
+   :sub-vals (10 11 12)
+   :range (0)
+   :result (10 11))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2)
+   :sub-vals (10 11 12)
+   :range (1)
+   :result (0 10 11))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2)
+   :sub-vals (10 11 12)
+   :range (1 3)
+   :result (0 10 11))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2)
+   :sub-vals (10 11 12)
+   :range (3 1)
+   :error t)
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2)
+   :sub-vals (10 11 12)
+   :range (1 100)
+   :error t)
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2)
+   :sub-vals (10 11 12)
+   :range (7)
+   :error t)
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4)
+   :sub-vals (12 13 14 15)
+   :range (2 3)
+   :result (0 1 12 3 4))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4)
+   :sub-vals (12 13 14 15)
+   :range (2 2)
+   :result (0 1 2 3 4))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4)
+   :sub-vals (12 13 14 15)
+   :range (5)
+   :result (0 1 2 3 4))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4)
+   :sub-vals (12 13 14 15)
+   :range (6)
+   :error t)
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4)
+   :sub-vals (12 13 14 15)
+   :range (5 6)
+   :error t)
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (-2)
+   :result (0 1 2 3 4 5 6 7 10 11))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (-6 -3)
+   :result (0 1 2 3 10 11 12 7 8 9))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (-6 -10)
+   :error t)
+
+  ;; This range might make sense, but since it would signal an error
+  ;; in `seq-subseq', we also signal an error in the `setf' feature.
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (-6 0)
+   :error t)
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (100)
+   :error t)
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (-100)
+   :error t))
+
+(ert-deftest test-setf-seq-subseq-recursive ()
+  "Test using `setf' with `seq-subseq' on sub-places.
+Like using `setf' with `substring'."
+  (let ((vect (vector 0 1 2 3 4 5 6)))
+    (setf (seq-subseq (seq-subseq vect 2) 2) [111 222])
+    (should (equal vect (vector 0 1 2 3 111 222 6))))
+
+  (let ((str (string ?a ?b ?c ?d ?e ?f ?g)))
+    (setf (seq-subseq (seq-subseq str 2) 0) (list ?x ?y ?z ?1 ?2 ?3))
+    (should (equal str (string ?a ?b ?x ?y ?z ?1 ?2))))
+
+  (let ((lst (list ?a ?b ?c ?d ?e ?f ?g)))
+    (setf (seq-subseq (seq-subseq (seq-subseq (seq-subseq lst 0)
+                                              0)
+                                  2)
+                      -5
+                      -3)
+          (vector ?x ?y ?z ?1 ?2 ?3))
+    (should (equal lst (list ?a ?b ?x ?y ?e ?f ?g))))
+
+  (let ((lst (list 0 1 2 3 4 5 6 7 8 9)))
+    (setf (seq-subseq (seq-subseq (seq-subseq (seq-subseq lst 1)
+                                              1)
+                                  1)
+                      1)
+          (vector 111 222 333 444 555 666 777 888))
+    (should (equal lst (list 0 1 2 3 111 222 333 444 555 666)))))
+
 (ert-deftest test-seq-concatenate ()
   (with-test-sequences (seq '(2 4 6))
     (should (equal (seq-concatenate 'string seq [8]) (string 2 4 6 8)))
-- 
2.34.1