bug#73431: Add `setf` support for `stream.el` in ELPA

[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: 535 bytes --]

Stefan Monnier wrote:
>> Is there a major downside to using `cl-defstruct` to define a stream?
> 
> Probably not major, no.  Beware: it'll come with several upsides, tho.
> 
> 
>          Stefan
> 

Hello,

Please see the attached file. It changes streams to be structs, warns 
that streams are not mutable, adds a creation method for arrays that 
doesn't create intermediate sub-arrays, and adds some methods for 
streams for more of the seq.el functions.

Please let me know what you would like changed.

Thank you.

[-- Attachment #2: 0001-Change-stream.el-to-use-structs-instead-of-cons-cell.patch --]
[-- Type: text/x-patch, Size: 16502 bytes --]

From db3ebf78167bf02b78e9865721f5b240982394ca Mon Sep 17 00:00:00 2001
From: Earl Hyatt <okamsn@protonmail.com>
Date: Sat, 28 Sep 2024 15:09:10 -0400
Subject: [PATCH] Change 'stream.el' to use structs instead of cons cells. 
 Update features.

* stream.el (stream): Define the structure using 'cl-defstruct'.

* stream.el (stream-make): Change to use new structure constructor
'stream--make-stream'.

* stream.el (stream--force, stream-first, stream-rest)
(stream-empty, stream-empty-p): Redefine to use structure slots.  Move
to be closer to the structure definition.

* stream.el (stream-first, stream-rest): Signal an error when trying to use
these functions as places for 'setf'.

* stream.el (stream--fresh-identifier, stream--evald-identifier):
Remove now unused definitions.

* stream.el (stream): Add a method that accepts a stream, returning it
unmodified.  This makes mapping across multiple sequences easier.

* stream.el (stream): Add a method that accepts an array and which does not
create sub-sequences of the array, unlike the implementation for generic
sequences.  This is a bit faster and is a good example of a custom updater
function.

* stream.el (stream--generalizer, cl-generic-generalizers): Remove
these specializers from the old, cons-based implementation.

* stream.el (seq-elt): Signal an error when trying to use this function as a
place for 'setf'.

* stream.el (seq-sort, seq-reverse, seq-concatenate, seq-remove-at-position):
Add methods that did not work as expected with the generic implementation.

* tests/stream-tests.el (stream-seq-sort-test, stream-seq-reverse-test)
(stream-seq-concatenate-test, stream-seq-mapcat-test)
(stream-seq-remove-at-position, stream-array-test): Add tests for these
features.

* tests/stream-tests.el: Test that evaluation is delayed for
seq-drop-while, seq-remove-at-position, and seq-sort
using deftest-for-delayed-evaluation.
---
 stream.el             | 248 +++++++++++++++++++++++++++++++-----------
 tests/stream-tests.el |  44 ++++++++
 2 files changed, 229 insertions(+), 63 deletions(-)

diff --git a/stream.el b/stream.el
index 7135ee0..1a26c81 100644
--- a/stream.el
+++ b/stream.el
@@ -66,36 +66,128 @@
 (eval-when-compile (require 'cl-lib))
 (require 'seq)
 
-(eval-and-compile
-  (defconst stream--fresh-identifier '--stream-fresh--
-    "Symbol internally used to streams whose head was not evaluated.")
-  (defconst stream--evald-identifier '--stream-evald--
-    "Symbol internally used to streams whose head was evaluated."))
+(cl-defstruct (stream (:constructor stream--make-stream)
+                      (:predicate streamp)
+                      :named)
+
+  "A lazily evaluated sequence, compatible with the `seq' library's functions."
+
+  (evaluated--internal
+   nil
+   :type boolean
+   :documentation "Whether the head and tail of the stream are accessible.
+
+This value is set to t via the function `stream--force' after it
+calls the updater function.")
+
+  (first--internal
+   nil
+   :type (or t null)
+   :documentation "The first element of the stream.")
+
+  (rest--internal
+   nil
+   :type (or stream null)
+   :documentation "The rest of the stream, which is itself a stream.")
+
+  (empty--internal
+   nil
+   :type boolean
+   :documentation "Whether the evaluated stream is empty.
+
+A stream is empty if the updater function returns nil when
+`stream--force' evaluates the stream.")
+
+  (updater--internal
+   nil
+   :type (or function null)
+   :documentation "Function that returns the head and tail of the stream when called.
+
+The updater function returns the head and tail in a cons cell.
+If it returns nil, then the stream is empty and `empty--internal' is
+set to t.  After this function is called, assuming no errors were signaled,
+`evaluated--internal' is set to t.
+
+In the case of the canonical empty stream (see the variable `stream-empty'),
+this slot is nil."))
+
+(defun stream--force (stream)
+  "Evaluate and return the STREAM.
+
+If the output of the updater function is nil, then STREAM is
+marked as empty.  Otherwise, the output of the updater function
+is used to set the head and the tail of the stream."
+  (if (stream-evaluated--internal stream)
+      stream
+    (pcase (funcall (stream-updater--internal stream))
+      (`(,head . ,tail)
+       (setf (stream-first--internal stream) head
+             (stream-rest--internal stream) tail))
+      ((pred null)
+       (setf (stream-empty--internal stream) t))
+      (bad-output
+       (error "Bad output from stream updater: %s"
+              bad-output)))
+    (setf (stream-evaluated--internal stream) t)
+    stream))
 
 (defmacro stream-make (&rest body)
   "Return a stream built from BODY.
-BODY must return nil or a cons cell whose cdr is itself a
-stream."
-  (declare (debug t))
-  `(cons ',stream--fresh-identifier (lambda () ,@body)))
 
-(defun stream--force (stream)
-  "Evaluate and return the first cons cell of STREAM.
-That value is the one passed to `stream-make'."
-  (cond
-   ((eq (car-safe stream) stream--evald-identifier)
-    (cdr stream))
-   ((eq (car-safe stream) stream--fresh-identifier)
-    (prog1 (setf (cdr stream) (funcall (cdr stream)))
-      ;; identifier is only updated when forcing didn't exit nonlocally
-      (setf (car stream) stream--evald-identifier)))
-   (t (signal 'wrong-type-argument (list 'streamp stream)))))
+BODY must return a cons cell whose car would be the head of a
+stream and whose cdr would be the tail of a stream.  The cdr must
+be a stream itself in order to be a valid tail.  Alternatively,
+BODY may return nil, in which case the stream is marked empty
+when the stream is evaluated."
+  (declare (debug t))
+  `(stream--make-stream :evaluated--internal nil
+                        :updater--internal (lambda () ,@body)))
 
 (defmacro stream-cons (first rest)
   "Return a stream built from the cons of FIRST and REST.
-FIRST and REST are forms and REST must return a stream."
+
+FIRST and REST are forms.  REST must return a stream."
   (declare (debug t))
   `(stream-make (cons ,first ,rest)))
+
+(defconst stream-empty
+  (stream--make-stream :evaluated--internal t
+                       :first--internal nil
+                       :rest--internal nil
+                       :empty--internal t
+                       :updater--internal nil)
+  "The empty stream.")
+
+(defun stream-empty ()
+  "Return the empty stream."
+  stream-empty)
+
+(defun stream-empty-p (stream)
+  "Return non-nil if STREAM is empty, nil otherwise."
+  (stream-empty--internal (stream--force stream)))
+
+(defun stream-first (stream)
+  "Return the first element of STREAM, evaluating if necessary.
+
+If STREAM is empty, return nil."
+  (stream-first--internal (stream--force stream)))
+
+(defun \(setf\ stream-first\) (_store _stream)
+  "Signal an error when trying to use `setf' on the head of a stream."
+  (error "Streams are not mutable"))
+
+(defun stream-rest (stream)
+  "Return the tail of STREAM, evaluating if necessary.
+
+If STREAM is empty, return the canonical empty stream."
+  (if (stream-empty-p stream)
+      stream-empty
+    (stream-rest--internal (stream--force stream))))
+
+(defun \(setf\ stream-rest\) (_store _stream)
+  "Signal an error when trying to use `setf' on the tail of a stream."
+  (error "Streams are not mutable"))
+
 \f
 
 ;;; Convenient functions for creating streams
@@ -103,6 +195,10 @@ (defmacro stream-cons (first rest)
 (cl-defgeneric stream (src)
   "Return a new stream from SRC.")
 
+(cl-defmethod stream ((stream stream))
+  "Return STREAM unmodified."
+  stream)
+
 (cl-defmethod stream ((seq sequence))
   "Return a stream built from the sequence SEQ.
 SEQ can be a list, vector or string."
@@ -112,6 +208,24 @@ (cl-defmethod stream ((seq sequence))
      (seq-elt seq 0)
      (stream (seq-subseq seq 1)))))
 
+(cl-defmethod stream ((array array))
+  "Return a stream built from the array ARRAY."
+  (let ((len (length array)))
+    (if (= len 0)
+        (stream-empty)
+      ;; This approach could avoid one level of indirection by setting
+      ;; `stream-updater--internal' directly, but using `funcall' makes for a
+      ;; good example of how to use a custom updater function using the public
+      ;; interface.
+      (let ((idx 0))
+        (cl-labels ((updater ()
+                      (if (< idx len)
+                          (prog1 (cons (aref array idx)
+                                       (stream-make (funcall #'updater)))
+                            (setq idx (1+ idx)))
+                        nil)))
+          (stream-make (funcall #'updater)))))))
+
 (cl-defmethod stream ((list list))
   "Return a stream built from the list LIST."
   (if (null list)
@@ -190,33 +304,6 @@ (defun stream-range (&optional start end step)
      (stream-range (+ start step) end step))))
 \f
 
-(defun streamp (stream)
-  "Return non-nil if STREAM is a stream, nil otherwise."
-  (let ((car (car-safe stream)))
-    (or (eq car stream--fresh-identifier)
-        (eq car stream--evald-identifier))))
-
-(defconst stream-empty (cons stream--evald-identifier nil)
-  "The empty stream.")
-
-(defun stream-empty ()
-  "Return the empty stream."
-  stream-empty)
-
-(defun stream-empty-p (stream)
-  "Return non-nil if STREAM is empty, nil otherwise."
-  (null (cdr (stream--force stream))))
-
-(defun stream-first (stream)
-  "Return the first element of STREAM.
-Return nil if STREAM is empty."
-  (car (stream--force stream)))
-
-(defun stream-rest (stream)
-  "Return a stream of all but the first element of STREAM."
-  (or (cdr (stream--force stream))
-      (stream-empty)))
-
 (defun stream-append (&rest streams)
   "Concatenate the STREAMS.
 Requesting elements from the resulting stream will request the
@@ -240,22 +327,7 @@ (defmacro stream-pop (stream)
   `(prog1
        (stream-first ,stream)
      (setq ,stream (stream-rest ,stream))))
-\f
 
-;;; cl-generic support for streams
-
-(cl-generic-define-generalizer stream--generalizer
-  11
-  (lambda (name &rest _)
-    `(when (streamp ,name)
-       'stream))
-  (lambda (tag &rest _)
-    (when (eq tag 'stream)
-      '(stream))))
-
-(cl-defmethod cl-generic-generalizers ((_specializer (eql stream)))
-  "Support for `stream' specializers."
-  (list stream--generalizer))
 \f
 
 ;;; Implementation of seq.el generic functions
@@ -273,6 +345,9 @@ (cl-defmethod seq-elt ((stream stream) n)
     (setq n (1- n)))
   (stream-first stream))
 
+(cl-defmethod (setf seq-elt) (_store (_sequence stream) _n)
+  (error "Streams are not mutable"))
+
 (cl-defmethod seq-length ((stream stream))
   "Return the length of STREAM.
 This function will eagerly consume the entire stream."
@@ -417,6 +492,53 @@ (defmacro stream-delay (expr)
 (cl-defmethod seq-copy ((stream stream))
   "Return a shallow copy of STREAM."
   (stream-delay stream))
+
+(cl-defmethod seq-sort (pred (sequence stream))
+  "Sort SEQUENCE using PRED via Quicksort."
+  (stream-delay
+   (if (stream-empty-p sequence)
+       stream-empty
+     (let* ((first (stream-first sequence))
+            (rest (stream-rest sequence)))
+       (stream-append
+        (seq-sort pred
+                  (seq-filter (lambda (elt)
+                                (funcall pred elt first))
+                              rest))
+        (stream-cons first
+                     (seq-sort pred
+                               (seq-filter (lambda (elt)
+                                             (not (funcall pred elt first)))
+                                           rest))))))))
+
+(cl-defmethod seq-reverse ((sequence stream))
+  "Force the evaluation of SEQUENCE and return a reversed stream of SEQUENCE.
+
+`seq-reverse' cannot be used with infinite streams."
+  (let ((intermediate nil))
+    (seq-doseq (x sequence)
+      (push x intermediate))
+    (stream intermediate)))
+
+(cl-defmethod seq-concatenate ((_type (eql stream)) &rest sequences)
+  "Make a stream which concatenates each sequence in SEQUENCES."
+  (apply #'stream-append (mapcar #'stream sequences)))
+
+(cl-defmethod seq-remove-at-position ((sequence stream) n)
+  "Return a copy of SEQUENCE with the element at index N removed.
+
+N is the (zero-based) index of the element that should not be in
+the result.
+
+The result is a stream."
+  (stream-delay
+   (let ((stream (stream-append
+                  (seq-take sequence n)
+                  (seq-drop sequence (1+ n)))))
+     (if (stream-empty-p stream)
+         (error "Dropped index out of bounds: %d, %s" n sequence)
+       stream))))
+
 \f
 
 ;;; More stream operations
diff --git a/tests/stream-tests.el b/tests/stream-tests.el
index ba304f1..71ec1ae 100644
--- a/tests/stream-tests.el
+++ b/tests/stream-tests.el
@@ -212,6 +212,43 @@ (ert-deftest stream-delay-test ()
             (and (equal res1 5)
                  (equal res2 5)))))
 
+(ert-deftest stream-seq-sort-test ()
+  (should (stream-empty-p (seq-sort #'< (stream-empty))))
+  (should (streamp (seq-sort #'< (stream (vector 5 4 3 1 2)))))
+  (should (equal '(1 2 3 4 5) (seq-into (seq-sort #'< (stream (vector 5 4 3 1 2))) 'list))))
+
+(ert-deftest stream-seq-reverse-test ()
+  (should (streamp (seq-reverse (stream (list 0 1 2)))))
+  (should (equal '(2 1 0) (seq-into (seq-reverse (stream (list 0 1 2))) 'list))))
+
+(ert-deftest stream-seq-concatenate-test ()
+  (should (streamp (seq-concatenate 'stream (list 1 2) (vector 3 4) (stream (list 5 6)))))
+  (should (equal '(1 2 3 4 5 6)
+                 (seq-into (seq-concatenate 'stream
+                                            (list 1 2)
+                                            (vector 3 4)
+                                            (stream (list 5 6)))
+                           'list))))
+
+(ert-deftest stream-seq-mapcat-test ()
+  (should (streamp (seq-mapcat #'stream (list (list 1 2)
+                                              (vector 3 4)
+                                              (stream (list 5 6)))
+                               'stream)))
+  (should (equal '(1 2 3 4 5 6)
+                 (seq-into (seq-mapcat #'stream (list (list 1 2)
+                                                      (vector 3 4)
+                                                      (stream (list 5 6)))
+                                       'stream)
+                           'list))))
+
+(ert-deftest stream-seq-remove-at-position ()
+  (should (streamp (seq-remove-at-position (stream (list 0 1 2 3 4)) 2)))
+  (should-error (stream-first (seq-remove-at-position (stream nil) 2)))
+  (should (equal '(0 1 3 4)
+                 (seq-into (seq-remove-at-position (stream (list 0 1 2 3 4)) 2)
+                           'list))))
+
 (ert-deftest stream-seq-copy-test ()
   (should (streamp (seq-copy (stream-range))))
   (should (= 0 (stream-first (seq-copy (stream-range)))))
@@ -234,6 +271,10 @@ (ert-deftest stream-list-test ()
   (dolist (list '(nil '(1 2 3) '(a . b)))
     (should (equal list (seq-into (stream list) 'list)))))
 
+(ert-deftest stream-array-test ()
+  (dolist (arr (list "cat" [0 1 2]))
+    (should (equal arr (seq-into (stream arr) (type-of arr))))))
+
 (ert-deftest stream-seq-subseq-test ()
   (should (stream-empty-p (seq-subseq (stream-range 2 10) 0 0)))
   (should (= (stream-first (seq-subseq (stream-range 2 10) 0 3)) 2))
@@ -296,6 +337,8 @@ (deftest-for-delayed-evaluation (stream-append  (make-delayed-test-stream) (make
 (deftest-for-delayed-evaluation (seq-take (make-delayed-test-stream) 2))
 (deftest-for-delayed-evaluation (seq-drop (make-delayed-test-stream) 2))
 (deftest-for-delayed-evaluation (seq-take-while #'numberp (make-delayed-test-stream)))
+(deftest-for-delayed-evaluation (seq-drop-while #'numberp (make-delayed-test-stream)))
+(deftest-for-delayed-evaluation (seq-remove-at-position (make-delayed-test-stream) 2))
 (deftest-for-delayed-evaluation (seq-map #'identity (make-delayed-test-stream)))
 (deftest-for-delayed-evaluation (seq-mapn #'cons
                                           (make-delayed-test-stream)
@@ -307,6 +350,7 @@ (deftest-for-delayed-evaluation (seq-subseq (make-delayed-test-stream) 2))
 (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)))))
+(deftest-for-delayed-evaluation (seq-sort #'< (make-delayed-test-stream)))
 
 (provide 'stream-tests)
 ;;; stream-tests.el ends here
-- 
2.34.1