From 46e18c3122caadfdb6a62b97f8c1f9f749ee9a8c Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Thu, 3 Mar 2016 15:33:10 +0100 Subject: [PATCH] Add stream stream-delay and stream-of-directory-files * packages/stream/stream.el (stream-delay, stream-of-directory-files): New functions. * packages/stream/tests/stream-tests.el: Add test for stream-delay. --- packages/stream/stream.el | 65 +++++++++++++++++++++++++-- packages/stream/tests/stream-tests.el | 32 ++++++++++++- 2 files changed, 93 insertions(+), 4 deletions(-) diff --git a/packages/stream/stream.el b/packages/stream/stream.el index 567a9e354..4d61cf151 100644 --- a/packages/stream/stream.el +++ b/packages/stream/stream.el @@ -152,7 +152,7 @@ range is infinite." (eq (car stream) stream--identifier))) (defun stream-empty () - "Return an empty stream." + "Return a new empty stream." (list stream--identifier (thunk-delay nil))) (defun stream-empty-p (stream) @@ -317,10 +317,69 @@ kind of nonlocal exit." (cons (stream-first stream) (seq-filter pred (stream-rest stream))))))) +(defmacro stream-delay (expr) + "Return a new stream to be obtained by evaluating EXPR. +EXPR will be evaluated once when an element of the resulting +stream is requested for the first time, and must return a stream. +EXPR will be evaluated in the lexical environment present when +calling this function." + (let ((stream (make-symbol "stream"))) + `(stream-make (let ((,stream ,expr)) + (if (stream-empty-p ,stream) + nil + (cons (stream-first ,stream) + (stream-rest ,stream))))))) + (cl-defmethod seq-copy ((stream stream)) "Return a shallow copy of STREAM." - (stream-cons (stream-first stream) - (stream-rest stream))) + (stream-delay stream)) + +(defun stream-of-directory-files-1 (directory &optional nosort recurse follow-links) + "Helper for `stream-of-directory-files'." + (stream-delay + (if (file-accessible-directory-p directory) + (let (files dirs (reverse-fun (if nosort #'identity #'nreverse))) + (dolist (file (directory-files directory t nil nosort)) + (let ((is-dir (file-directory-p file))) + (unless (and is-dir + (member (file-name-nondirectory (directory-file-name file)) + '("." ".."))) + (push file files) + (when (and is-dir + (or follow-links (not (file-symlink-p file))) + (if (functionp recurse) (funcall recurse file) recurse)) + (push file dirs))))) + (apply #'stream-append + (stream (funcall reverse-fun files)) + (mapcar + (lambda (dir) (stream-of-directory-files-1 dir nosort recurse follow-links)) + (funcall reverse-fun dirs)))) + (stream-empty)))) + +(defun stream-of-directory-files (directory &optional full nosort recurse follow-links filter) + "Return a stream of names of files in DIRECTORY. +Call `directory-files' to list file names in DIRECTORY and make +the result a stream. Don't include files named \".\" or \"..\". +The arguments FULL and NOSORT are directly passed to +`directory-files'. + +Third optional argument RECURSE non-nil means recurse on +subdirectories. If RECURSE is a function, it should be a +predicate accepting one argument, an absolute file name of a +directory, and return non-nil when the returned stream should +recurse into that directory. Any other non-nil value means +recurse into every readable subdirectory. + +Even with recurse non-nil, don't descent into directories by +following symlinks unless FOLLOW-LINKS is non-nil. + +If FILTER is non-nil, it should be a predicate accepting one +argument, an absolute file name. It is used to limit the +resulting stream to the files fulfilling this predicate." + (let* ((stream (stream-of-directory-files-1 directory nosort recurse follow-links)) + (filtered-stream (if filter (seq-filter filter stream) stream))) + (if full filtered-stream + (seq-map (lambda (file) (file-relative-name file directory)) filtered-stream)))) (provide 'stream) ;;; stream.el ends here diff --git a/packages/stream/tests/stream-tests.el b/packages/stream/tests/stream-tests.el index 88edf918c..23a54b5ec 100644 --- a/packages/stream/tests/stream-tests.el +++ b/packages/stream/tests/stream-tests.el @@ -171,10 +171,40 @@ (should (= 3 (stream-first (stream-rest (seq-filter #'cl-oddp (stream-range 0 4)))))) (should (stream-empty-p (stream-rest (stream-rest (seq-filter #'cl-oddp (stream-range 0 4))))))) +(ert-deftest stream-delay-test () + (should (streamp (stream-delay (stream-range)))) + (should (= 0 (stream-first (stream-delay (stream-range))))) + (should (= 1 (stream-first (stream-rest (stream-delay (stream-range)))))) + (should (let ((stream (stream-range 3 7))) + (equal (seq-into (stream-delay stream) 'list) + (seq-into stream 'list)))) + (should (null (seq-into (stream-delay (stream-empty)) 'list))) + (should (let* ((evaluated nil) + (one-plus (lambda (el) + (setq evaluated t) + (1+ el))) + (stream (seq-map one-plus (stream '(1))))) + (equal '(nil 2 t) + (list evaluated (stream-first stream) evaluated)))) + (should (let* ((a 0) + (set-a (lambda (x) (setq a x))) + (s (stream-delay (stream (list a)))) + res1 res2) + (funcall set-a 5) + (setq res1 (stream-first s)) + (funcall set-a 11) + (setq res2 (stream-first s)) + (and (equal res1 5) + (equal res2 5))))) + (ert-deftest stream-seq-copy-test () (should (streamp (seq-copy (stream-range)))) (should (= 0 (stream-first (seq-copy (stream-range))))) - (should (= 1 (stream-first (stream-rest (seq-copy (stream-range))))))) + (should (= 1 (stream-first (stream-rest (seq-copy (stream-range)))))) + (should (let ((stream (stream-range 3 7))) + (equal (seq-into (seq-copy stream) 'list) + (seq-into stream 'list)))) + (should (null (seq-into (seq-copy (stream-empty)) 'list)))) (ert-deftest stream-range-test () (should (stream-empty-p (stream-range 0 0))) -- 2.39.2