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: 2966 bytes --]

Philip Kaludercic wrote:
>> +(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)
> 
> Isn't this type just t?  Not a proof, but this doesn't signal:

Yes. I have changed it to just `t`.

>> +(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."
>> +  ;; Check explicitly so that we can avoid checking
>> +  ;; in accessors by setting safety to 0 via `cl-declaim'.
>> +  (unless (streamp stream)
>> +    (signal 'wrong-type-argument (list 'stream stream)))
> 
> If you are already using cl-lib, you could also make use of `cl-check-type'.

Done.

>> +  (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)
> 
> Did you change the order of the definitions?

Yes. I brought the fundamental features to the top of the file. In the 
existing version, things are defined after they are used. I know that is 
not an error, but it had me jumping around more to see how it worked.

>> +
>> +(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)
> 
> This definition also appears unchanged?  Please try to keep the diff as
> small as possible.

OK. I have broken it into several files, which I've attached. How does 
it look now?

[-- Attachment #2: 0004-Add-an-implementation-of-seq-concatenate-for-streams.patch --]
[-- Type: text/x-patch, Size: 3001 bytes --]

From d5168d49a90ba84114f0578d20e13a725743f65e Mon Sep 17 00:00:00 2001
From: Earl Hyatt <okamsn@protonmail.com>
Date: Sat, 5 Oct 2024 21:15:24 -0400
Subject: [PATCH 4/5] Add an implementation of `seq-concatenate` for streams.

* stream.el (stream): Add a method for creating a stream from a stream,
which really just returns the original stream unmodified.

* stream.el (seq-concatenate): Add implementation for streams.

* tests/stream-tests (stream-seq-concatenate-test, stream-seq-mapcat-test):
Add tests for seq-concatenate and seq-mapcat, which by default uses
seq-concatenate.
---
 stream.el             |  9 +++++++++
 tests/stream-tests.el | 21 +++++++++++++++++++++
 2 files changed, 30 insertions(+)

diff --git a/stream.el b/stream.el
index 794b309..18240c8 100644
--- a/stream.el
+++ b/stream.el
@@ -164,6 +164,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."
@@ -492,6 +496,11 @@ (defmacro stream-delay (expr)
 (cl-defmethod seq-copy ((stream stream))
   "Return a shallow copy of STREAM."
   (stream-delay stream))
+
+(cl-defmethod seq-concatenate ((_type (eql stream)) &rest sequences)
+  "Make a stream which concatenates each sequence in SEQUENCES."
+  (apply #'stream-append (mapcar #'stream sequences)))
+
 \f
 
 ;;; More stream operations
diff --git a/tests/stream-tests.el b/tests/stream-tests.el
index 997dd86..5d3f116 100644
--- a/tests/stream-tests.el
+++ b/tests/stream-tests.el
@@ -212,6 +212,27 @@ (ert-deftest stream-delay-test ()
             (and (equal res1 5)
                  (equal res2 5)))))
 
+(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-copy-test ()
   (should (streamp (seq-copy (stream-range))))
   (should (= 0 (stream-first (seq-copy (stream-range)))))
-- 
2.34.1


[-- Attachment #3: 0002-Add-more-efficient-method-for-making-streams-from-ar.patch --]
[-- Type: text/x-patch, Size: 2216 bytes --]

From a25ee8630188d92e4b23d98bea6a13c4c4f627ac Mon Sep 17 00:00:00 2001
From: Earl Hyatt <okamsn@protonmail.com>
Date: Sat, 5 Oct 2024 21:07:16 -0400
Subject: [PATCH 2/5] Add more efficient method for making streams from arrays.

* stream.el (stream): Add method for arrays that avoids creating sub-sequences.

* tests/stream-tests.el (stream-array-test): Add test for new method.
---
 stream.el             | 18 ++++++++++++++++++
 tests/stream-tests.el |  4 ++++
 2 files changed, 22 insertions(+)

diff --git a/stream.el b/stream.el
index 954373f..04b2be5 100644
--- a/stream.el
+++ b/stream.el
@@ -173,6 +173,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' 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)
diff --git a/tests/stream-tests.el b/tests/stream-tests.el
index ba304f1..997dd86 100644
--- a/tests/stream-tests.el
+++ b/tests/stream-tests.el
@@ -234,6 +234,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))
-- 
2.34.1


[-- Attachment #4: 0003-Add-generalized-variables-for-streams-that-error-whe.patch --]
[-- Type: text/x-patch, Size: 1686 bytes --]

From f853beeffa9c9b2983883ca1bfe3267c43c8edb3 Mon Sep 17 00:00:00 2001
From: Earl Hyatt <okamsn@protonmail.com>
Date: Sat, 5 Oct 2024 21:11:59 -0400
Subject: [PATCH 3/5] Add generalized variables for streams that error when
 used.

* stream.el (seq-elt, stream-first, stream-rest): Signal an error when trying to
use this function as a place for 'setf'.
---
 stream.el | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/stream.el b/stream.el
index 04b2be5..794b309 100644
--- a/stream.el
+++ b/stream.el
@@ -290,6 +290,10 @@ (defun stream-first (stream)
 Return nil if STREAM is empty."
   (stream--first (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 a stream of all but the first element of STREAM."
   (setq stream (stream--force stream))
@@ -297,6 +301,10 @@ (defun stream-rest (stream)
       (stream-empty)
     (stream--rest 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"))
+
 (defun stream-append (&rest streams)
   "Concatenate the STREAMS.
 Requesting elements from the resulting stream will request the
@@ -337,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."
-- 
2.34.1


[-- Attachment #5: 0001-Change-stream.el-to-use-structures-instead-of-cons-c.patch --]
[-- Type: text/x-patch, Size: 7218 bytes --]

From c84d3a482766a0cf39506a10c390ab77c541a09b Mon Sep 17 00:00:00 2001
From: Earl Hyatt <okamsn@protonmail.com>
Date: Sat, 5 Oct 2024 21:01:03 -0400
Subject: [PATCH 1/5] Change 'stream.el' to use structures instead of cons
 cells.

* stream.el (stream): Define the structure using 'cl-defstruct'.  Set
safety to 0 using 'cl-declaim' to avoid checking the type of the argument
to 'stream--force' multiple times.  Instead, explicitly check a single time
in 'stream--force', which must be used inside the public functions anyway.

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

* stream.el (streamp): Delete existing definition to avoid conflicts
with definition generated for structures.

* stream.el (stream--force, stream-first, stream-rest)
(stream-empty, stream-empty-p): Redefine to use structure slots.

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

* stream.el (stream--generalizer, cl-generic-generalizers): Remove
these specializers from the old, cons-based implementation.
---
 stream.el | 138 ++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 92 insertions(+), 46 deletions(-)

diff --git a/stream.el b/stream.el
index 7135ee0..954373f 100644
--- a/stream.el
+++ b/stream.el
@@ -63,33 +63,94 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile
+  (require 'cl-lib)
+  ;; Set safety to 0 to avoid checking the type of the argument multiple times
+  ;; within `stream--force', which is used frequently.
+  (cl-declaim (optimize (safety 0))))
+
 (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)
+                      (:conc-name stream--)
+                      (:predicate streamp)
+                      :named)
+
+  "A lazily evaluated sequence, compatible with the `seq' library's functions."
+
+  (evaluated
+   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
+   nil
+   :type t
+   :documentation "The first element of the stream.")
+
+  (rest
+   nil
+   :type (or stream null)
+   :documentation "The rest of the stream, which is itself a stream.")
+
+  (empty
+   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
+   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' is
+set to t.  After this function is called, assuming no errors were signaled,
+`evaluated' is set to t.
+
+In the case of the canonical empty stream (see the variable `stream-empty'),
+this slot is nil."))
 
 (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."
+
+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))
-  `(cons ',stream--fresh-identifier (lambda () ,@body)))
+  `(stream--make-stream :evaluated nil
+                        :updater (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)))))
+  "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."
+  ;; Check explicitly so that we can avoid checking
+  ;; in accessors by setting safety to 0 via `cl-declaim'.
+  (cl-check-type stream stream)
+  (if (stream--evaluated stream)
+      stream
+    (pcase (funcall (stream--updater stream))
+      (`(,head . ,tail)
+       (setf (stream--first stream) head
+             (stream--rest stream) tail))
+      ((pred null)
+       (setf (stream--empty stream) t))
+      (bad-output
+       (error "Bad output from stream updater: %s"
+              bad-output)))
+    (setf (stream--evaluated stream) t)
+    stream))
 
 (defmacro stream-cons (first rest)
   "Return a stream built from the cons of FIRST and REST.
@@ -190,13 +251,12 @@ (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)
+(defconst stream-empty
+  (stream--make-stream :evaluated t
+                       :first nil
+                       :rest nil
+                       :empty t
+                       :updater nil)
   "The empty stream.")
 
 (defun stream-empty ()
@@ -205,17 +265,19 @@ (defun stream-empty ()
 
 (defun stream-empty-p (stream)
   "Return non-nil if STREAM is empty, nil otherwise."
-  (null (cdr (stream--force stream))))
+  (stream--empty (stream--force stream)))
 
 (defun stream-first (stream)
   "Return the first element of STREAM.
 Return nil if STREAM is empty."
-  (car (stream--force stream)))
+  (stream--first (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)))
+  (setq stream (stream--force stream))
+  (if (stream--empty stream)
+      (stream-empty)
+    (stream--rest stream)))
 
 (defun stream-append (&rest streams)
   "Concatenate the STREAMS.
@@ -242,22 +304,6 @@ (defmacro stream-pop (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
 
 (cl-defmethod seqp ((_stream stream))
-- 
2.34.1


[-- Attachment #6: 0005-Add-test-for-delayed-evaluation-for-seq-drop-while-f.patch --]
[-- Type: text/x-patch, Size: 1175 bytes --]

From fe65d95041cb9ab67c853dfc7e8e34a870a5892b Mon Sep 17 00:00:00 2001
From: Earl Hyatt <okamsn@protonmail.com>
Date: Sat, 5 Oct 2024 21:19:18 -0400
Subject: [PATCH 5/5] Add test for delayed evaluation for seq-drop-while for
 streams.

* tests/stream-tests.el (deftest-for-delayed-evaluation): Add a test
for seq-drop-while.
---
 tests/stream-tests.el | 1 +
 1 file changed, 1 insertion(+)

diff --git a/tests/stream-tests.el b/tests/stream-tests.el
index 5d3f116..defc544 100644
--- a/tests/stream-tests.el
+++ b/tests/stream-tests.el
@@ -321,6 +321,7 @@ (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-map #'identity (make-delayed-test-stream)))
 (deftest-for-delayed-evaluation (seq-mapn #'cons
                                           (make-delayed-test-stream)
-- 
2.34.1