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

[Okamsn via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 1350 bytes --]

Okamsn wrote:
> 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.

Hello,

Since supporting sub-places is controversial, would you please review 
version 2 of the patch that I sent, which I have re-attached for 
convenience. This version /does not/ support sub-places.

I have added Michael Heerdegen to the recipients list in case they would 
like to comment.

Thank you.

[-- Attachment #2: v2-0001-Add-setf-support-for-seq-subseq.patch --]
[-- Type: text/x-patch, Size: 10101 bytes --]

From b06db7905f5d6dfa0d33c05fd214ef95d19814b5 Mon Sep 17 00:00:00 2001
From: Earl Hyatt <okamsn@protonmail.com>
Date: Sun, 28 Jan 2024 22:48:13 -0500
Subject: [PATCH v2] Add setf support for seq-subseq.

* lisp/emacs-lisp/seq.el (seq-subseq): Add a generic version of
calling setf on seq-subseq and add a specialized version for when the
modified sequence is a list.
* test/lisp/emacs-lisp/seq-tests.el (test-setf-seq-subseq)
(test-setf-seq-subseq-combinations): Add tests for the feature.

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
feature should signal an error in all cases where using 'seq-subseq'
would signal an error.
---
 lisp/emacs-lisp/seq.el            |  88 ++++++++++++++++++
 test/lisp/emacs-lisp/seq-tests.el | 149 ++++++++++++++++++++++++++++++
 2 files changed, 237 insertions(+)

diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 4c6553972c2..6a1fd4c35e3 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -193,6 +193,94 @@ seq-subseq
         (copy-sequence sequence))))
    (t (error "Unsupported sequence: %s" sequence))))
 
+(cl-defgeneric (setf seq-subseq) (store sequence start &optional end)
+  "Modify the elements of SEQUENCE from START to END to be those of STORE.
+END is exclusive.
+
+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).
+
+SEQUENCE is neither lengthened nor shortened."
+  (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 (funcall signal-or-val-fn start))
+         (idx-end (if (null end)
+                      len
+                    (funcall signal-or-val-fn end)))
+         (tag (gensym)))
+    (if (> idx idx-end)
+        (funcall signal-fn)
+      (catch tag
+        (seq-do (lambda (v)
+                  (if (< idx idx-end)
+                      (setf (seq-elt sequence idx) v
+                            idx (1+ idx))
+                    (throw tag nil)))
+                store))))
+  store)
+
+(cl-defmethod (setf seq-subseq) (store (sequence list) start &optional end)
+  "Modify the elements of SEQUENCE from START to END to be those of STORE.
+END is exclusive.
+
+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).
+
+SEQUENCE is neither lengthened nor shortened."
+  (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 (funcall signal-or-val-fn start))
+         (idx-end (if (null end)
+                      len
+                    (funcall signal-or-val-fn end)))
+         (tag (gensym)))
+    (if (> idx idx-end)
+        (funcall signal-fn)
+      (catch tag
+        (seq-do (let ((replaced (nthcdr idx sequence)))
+                  (lambda (v)
+                    (if (< idx idx-end)
+                        (setf (car replaced) v
+                              replaced (cdr replaced)
+                              idx (1+ idx))
+                      (throw tag nil))))
+                store))))
+  store)
+
 \f
 (cl-defgeneric seq-map (function sequence)
   "Return the result of applying FUNCTION to each element of SEQUENCE."
diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el
index c06ceb00bdb..d3e46c32f99 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -312,6 +312,155 @@ test-seq-subseq
                   (:success
                    (should (equal (seq-subseq list start end) res))))))))))))
 
+(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-seq-concatenate ()
   (with-test-sequences (seq '(2 4 6))
     (should (equal (seq-concatenate 'string seq [8]) (string 2 4 6 8)))
-- 
2.34.1