GNU bug report logs - #73431
Add `setf` support for `stream.el` in ELPA

Previous Next

Full log

View this message in rfc822 format

From: Philip Kaludercic <philipk <at> posteo.net>
To: Okamsn <okamsn <at> protonmail.com>
Cc: Nicolas Petton <nicolas <at> petton.fr>, 73431 <at> debbugs.gnu.org, Stefan Monnier <monnier <at> iro.umontreal.ca>
Subject: bug#73431: Add `setf` support for `stream.el` in ELPA
Date: Tue, 24 Sep 2024 10:15:08 +0000

Okamsn <okamsn <at> protonmail.com> writes:

> Hello,
>
> The attached patch adds `setf` support for `stream-first`, 
> `stream-rest`, and `seq-elt` for streams. The support for `setf` with 
> `seq-elt` for streams uses the added support for `stream-first`, 
> following the definition of `seq-elt` for streams.
>
> Would you like anything changed?
>
> Thank you.
>
> From fed785a332bb335522a4b71ef8a68896f304e1d0 Mon Sep 17 00:00:00 2001
> From: Earl Hyatt <okamsn <at> 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)))

I am not sure what the preferred practice to define generalised setters
is.  In gv.el everything is defined using `gv-define-simple-setter' or
`gv-define-setter', which /feels/ more robust?  I believe that Stefan
(as the author or gv.el) might be able to explain if this is so or not.

> +
>  (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

-- 
	Philip Kaludercic on siskin

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.