From fed785a332bb335522a4b71ef8a68896f304e1d0 Mon Sep 17 00:00:00 2001
From: Earl Hyatt <okamsn@protonmail.com>
Date: Sun, 22 Sep 2024 19:23:36 -0400
Subject: [PATCH] Add setf support to stream.el.

* stream.el (\(setf\ stream-first\), \(setf\ stream-rest\)): Add support to
`setf' for stream-first and stream-rest.

* stream.el (\(setf\ seq-elt\)): Support `setf' with `seq-elt' for streams.

* tests/stream-tests.el (setf-stream-first, setf-stream-first-error)
(setf-stream-rest, setf-stream-rest-error, setf-stream-seq-elt)
(setf-stream-seq-elt-error): Add tests for the above features.
---
 stream.el             | 23 ++++++++++++++++
 tests/stream-tests.el | 64 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 87 insertions(+)

diff --git a/stream.el b/stream.el
index 7135ee0..eb8b179 100644
--- a/stream.el
+++ b/stream.el
@@ -212,11 +212,23 @@ (defun stream-first (stream)
 Return nil if STREAM is empty."
   (car (stream--force stream)))
 
+(defun \(setf\ stream-first\) (store stream)
+  "Set the first element of STREAM to value STORE."
+  (if (stream-empty-p stream)
+      (error "Cannot set first element of empty stream: %s" stream)
+    (setcar (stream--force stream) store)))
+
 (defun stream-rest (stream)
   "Return a stream of all but the first element of STREAM."
   (or (cdr (stream--force stream))
       (stream-empty)))
 
+(defun \(setf\ stream-rest\) (new-stream stream)
+  "Set the remainder of STREAM to NEW-STREAM."
+  (if (stream-empty-p stream)
+      (error "Cannot set remainder of empty stream: %s" stream)
+    (setcdr (stream--force stream) new-stream)))
+
 (defun stream-append (&rest streams)
   "Concatenate the STREAMS.
 Requesting elements from the resulting stream will request the
@@ -273,6 +285,17 @@ (cl-defmethod seq-elt ((stream stream) n)
     (setq n (1- n)))
   (stream-first stream))
 
+(cl-defmethod \(setf\ seq-elt\) (store (stream stream) n)
+  "Set the element of STREAM at index N to value STORE."
+  (let ((stream-for-signal stream)
+        (n-for-signal n))
+    (while (> n 0)
+      (setq stream (stream-rest stream))
+      (setq n (1- n)))
+    (if (stream-empty-p stream)
+        (signal 'args-out-of-range (list stream-for-signal n-for-signal))
+      (setf (stream-first stream) store))))
+
 (cl-defmethod seq-length ((stream stream))
   "Return the length of STREAM.
 This function will eagerly consume the entire stream."
diff --git a/tests/stream-tests.el b/tests/stream-tests.el
index ba304f1..f82c206 100644
--- a/tests/stream-tests.el
+++ b/tests/stream-tests.el
@@ -308,5 +308,69 @@ (deftest-for-delayed-evaluation (stream-scan #'* 1 (make-delayed-test-stream)))
 (deftest-for-delayed-evaluation (stream-concatenate (stream (list (make-delayed-test-stream)
                                                                   (make-delayed-test-stream)))))
 
+;; Test `setf' support
+(ert-deftest setf-stream-first ()
+  (should (= 100 (let ((test (stream (vector 0 1 2 3 4))))
+                   (setf (stream-first test) 100)
+                   (stream-first test))))
+
+  (should (= 100 (let ((test (stream-range 0 10 2)))
+                   (setf (stream-first test) 100)
+                   (stream-first test)))))
+
+(ert-deftest setf-stream-first-error ()
+  (should-error (let ((test (stream-empty)))
+                  (setf (stream-first test) 100)
+                  (stream-first test))))
+
+(ert-deftest setf-stream-rest ()
+  (should (equal '(0 11 12 13 14)
+                 (let ((test (stream (vector 0 1 2 3 4))))
+                   (setf (stream-rest test) (stream (list 11 12 13 14)))
+                   (seq-into test 'list))))
+
+  (should (equal '(0 11 12 13 14)
+                 (let ((test (stream-range  0 10 2)))
+                   (setf (stream-rest test) (stream (list 11 12 13 14)))
+                   (seq-into test 'list))))
+
+  (should (equal '(0 11 12 13 14)
+                 (let ((test (stream-range  0 10 2)))
+                   ;; Test using an evaluated stream.
+                   (setf (stream-rest test)
+                         (let ((stream (stream (list 11 12 13 14))))
+                           (seq-do #'ignore stream)
+                           stream))
+                   (seq-into test 'list)))))
+
+(ert-deftest setf-stream-rest-error ()
+  (should-error (let ((test (stream-empty)))
+                  (setf (stream-rest test) (stream (list 11 12 13 14)))
+                  (seq-into test 'list))))
+
+(ert-deftest setf-stream-seq-elt ()
+  (should (= 100 (let ((test (stream (vector 0 1 2 3 4))))
+                   (setf (seq-elt test 3) 100)
+                   (seq-elt test 3))))
+
+  (should (equal '(0 1 2 100 4)
+                 (let ((test (stream (vector 0 1 2 3 4))))
+                   (setf (seq-elt test 3) 100)
+                   (seq-into test 'list))))
+
+  (should (= 100 (let ((test (stream-range 0 10 2)))
+                   (setf (seq-elt test 3) 100)
+                   (seq-elt test 3))))
+
+  (should (equal '(0 2 4 100 8)
+                 (let ((test (stream-range 0 10 2)))
+                   (setf (seq-elt test 3) 100)
+                   (seq-into test 'list)))))
+
+(ert-deftest setf-stream-seq-elt-error ()
+  (should-error (let ((test (stream (vector 0 1 2 3 4))))
+                  (setf (seq-elt test 1000) 100))
+                :type 'args-out-of-range))
+
 (provide 'stream-tests)
 ;;; stream-tests.el ends here
-- 
2.34.1