From db3ebf78167bf02b78e9865721f5b240982394ca Mon Sep 17 00:00:00 2001 From: Earl Hyatt 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")) + ;;; 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)))) -(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)))) - -;;; 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)) ;;; 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)))) + ;;; 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