[Emacs-diffs] stream ee7138a: Add a new streaming library stream.el

[Nicolas Petton]

branch: stream
commit ee7138acd38a4328b075e11e23bc0a3721fc2d08
Author: Nicolas Petton <address@hidden>
Commit: Nicolas Petton <address@hidden>

    Add a new streaming library stream.el
    
    stream.el provides an implementation of streams.  Streams are
    implemented as delayed evaluation of cons cells.
    
    The implementation is close to the one in the SICP
    book (https://mitpress.mit.edu/sicp/full-text/book/book-Z-H-24.html).
    
    Streams could be created from any sequencial input data, including
    sequences, , making operation on them lazy, a set of 2 forms (first and
    rest), making it easy to represent infinite sequences, buffers (by
    character), buffers (by line), buffers (by page), IO streams, orgmode
    table cells, etc.
    
    * lisp/emacs-lisp/stream.el: New file.
    * test/automated/stream-tests.el: New file.
---
 etc/NEWS                       |   14 +++
 lisp/emacs-lisp/stream.el      |  232 ++++++++++++++++++++++++++++++++++++++++
 test/automated/stream-tests.el |  117 ++++++++++++++++++++
 3 files changed, 363 insertions(+), 0 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 666cccf..a50db04 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -523,6 +523,20 @@ prefixed with `seq-' and work on lists, strings and 
vectors.
 The map library provides map-manipulation functions that work on alists,
 hash-table and arrays.  All functions are prefixed with "map-".
 
+** stream
+*** New stream library:
+The stream library provides an implementation of streams.  Streams are
+implemented as delayed evaluation of cons cells.
+
+The implementation is close to the one in the SICP book
+(https://mitpress.mit.edu/sicp/full-text/book/book-Z-H-24.html).
+
+Streams could be created from any sequencial input data, including
+sequences, , making operation on them lazy, a set of 2 forms (first
+and rest), making it easy to represent infinite sequences, buffers (by
+character), buffers (by line), buffers (by page), IO streams, orgmode
+table cells, etc.
+
 ** Calendar and diary
 
 +++
diff --git a/lisp/emacs-lisp/stream.el b/lisp/emacs-lisp/stream.el
new file mode 100644
index 0000000..0cf3e93
--- /dev/null
+++ b/lisp/emacs-lisp/stream.el
@@ -0,0 +1,232 @@
+;;; stream.el --- Implementation of streams  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <address@hidden>
+;; Keywords: stream, laziness, sequences
+;; Version: 1.0
+;; Package: stream
+
+;; Maintainer: address@hidden
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library provides an implementation of streams. Streams are
+;; implemented as delayed evaluation of cons cells.
+;;
+;; Functions defined in `seq.el' can also take a stream as input.
+;;
+;; streams could be created from any sequential input data:
+;; - sequences, making operation on them lazy
+;; - a set of 2 forms (first and rest), making it easy to represent infinite 
sequences
+;; - buffers (by character)
+;; - buffers (by line)
+;; - buffers (by page)
+;; - IO streams
+;; - orgmode table cells
+;; - ...
+;;
+;; All functions are prefixed with "stream-".
+;; All functions are tested in test/automated/stream-tests.el
+;;
+;; Here is an example implementation of the Fibonacci numbers
+;; implemented as in infinite stream:
+;;
+;; (defun fib (a b)
+;;  (stream-cons a (fib b (+ a b))))
+;; (fib 0 1)
+
+;;; Code:
+
+(eval-and-compile
+  (defconst stream--identifier '--stream--
+   "Symbol internally used to identify streams."))
+
+(defmacro stream--delay (&rest body)
+  "Delay the evaluation of BODY."
+  (declare (debug t))
+  (let ((forced (make-symbol "forced"))
+        (val (make-symbol "val")))
+    `(let (,forced ,val)
+       (lambda ()
+         (unless ,forced
+           (setf ,val (progn ,@body))
+           (setf ,forced t))
+         ,val))))
+
+(defun stream--force (delayed)
+  "Force the evaluation of DELAYED."
+  (funcall delayed))
+
+(defmacro stream-make (&rest body)
+  "Return a stream built from BODY.
+BODY must return nil or a cons cell, which cdr is itself a
+stream."
+  (declare (debug t))
+  `(list ',stream--identifier (stream--delay ,@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."
+  (declare (debug t))
+  `(stream-make (cons ,first ,rest)))
+
+(defun stream-p (stream)
+  "Return non-nil if STREAM is a stream, nil otherwise."
+  (and (consp stream)
+       (eq (car stream) stream--identifier)))
+
+(defun stream-empty ()
+  "Return an empty stream."
+  (list stream--identifier (stream--delay nil)))
+
+(defun stream-empty-p (stream)
+  "Return non-nil is STREAM is empty, nil otherwise."
+  (null (stream--force (cadr stream))))
+
+(defun stream-first (stream)
+  "Return the first element of STREAM."
+  (car (stream--force (cadr stream))))
+
+(defun stream-rest (stream)
+  "Return a stream of all but the first element of STREAM."
+  (cdr (stream--force (cadr stream))))
+
+(defun stream-take (stream n)
+  "Return a stream of the first N elements of STREAM."
+  (if (zerop n)
+      (stream-empty)
+    (stream-cons
+     (stream-first stream)
+     (stream-take (stream-rest stream) (1- n)))))
+
+(defun stream-drop (stream n)
+  "Return a stream of STREAM without its first N elements."
+  (stream-make
+   (while (not (or (stream-empty-p stream) (zerop n)))
+     (setq n (1- n))
+     (setq stream (stream-rest stream)))
+   (unless (stream-empty-p stream)
+     (cons (stream-first stream)
+           (stream-rest stream)))))
+
+(defun stream-take-while (pred stream)
+  "Return a stream of the successive elements for which (PRED elt) is non-nil 
in STREAM."
+  (stream-make
+   (when (funcall pred (stream-first stream))
+       (cons (stream-first stream)
+             (stream-take-while pred (stream-rest stream))))))
+
+(defun stream-drop-while (pred stream)
+  "Return a stream from the first element for which (PRED elt) is nil in 
STREAM."
+  (stream-make
+   (while (not (or (stream-empty-p stream)
+                   (funcall pred (stream-first stream))))
+     (setq stream (stream-rest stream)))
+   (unless (stream-empty-p stream)
+     (cons (stream-first stream)
+           (stream-rest stream)))))
+
+(defun stream-map (function stream)
+  "Return a stream.
+The elements of the produced sequence consist of the application
+of FUNCTION to each element of STREAM."
+  (if (stream-empty-p stream)
+      stream
+    (stream-cons
+     (funcall function (stream-first stream))
+     (stream-map function (stream-rest stream)))))
+
+(defun stream-do (function stream)
+  "Evaluate FUNCTION for each element of STREAM eagerly, and return nil.
+
+`stream-do' should never be used on infinite streams."
+  (while (not (stream-empty-p stream))
+    (funcall function (stream-first stream))
+    (setq stream (stream-rest stream))))
+
+(defun stream-filter (pred stream)
+  "Return a stream of the elements for which (PRED element) is non-nil in 
STREAM."
+  (if (stream-empty-p stream)
+      stream
+    (stream-make
+     (while (not (or (stream-empty-p stream)
+                     (funcall pred (stream-first stream))))
+       (setq stream (stream-rest stream)))
+     (if (stream-empty-p stream)
+         nil
+       (cons (stream-first stream)
+             (stream-filter pred (stream-rest stream)))))))
+
+
+;;; Convenient functions for creating streams
+
+(defun stream-range (&optional start end step)
+  "Return a stream of the integers from START to END, stepping by STEP.
+If START is nil, it defaults to 0. If STEP is nil, it defaults to
+1.  START is inclusive and END is exclusive.  If END is nil, the
+range is infinite."
+  (unless start (setq start 0))
+  (unless step (setq step 1))
+  (cond
+   ((equal start end) (stream-empty))
+   ((and end (> start end)) (error "Invalid range boundaries"))
+   (t
+    (stream-cons
+     start
+     (stream-range (+ start step) end step)))))
+
+(defun stream-seq (seq)
+  "Return a stream built from the sequence SEQ.
+SEQ can be a list, vector or string."
+  (cond
+   ((listp seq)
+    (stream-list seq))
+   ((seq-empty-p seq)
+    (stream-empty))
+   (t
+    (stream-cons
+     (seq-elt seq 0)
+     (stream-seq (seq-subseq seq 1))))))
+
+(defun stream-list (list)
+  "Return a stream built from the list LIST."
+  (if (null list)
+      (stream-empty)
+    (stream-cons
+     (car list)
+     (stream-list (cdr list)))))
+
+(defun stream-buffer (buffer-or-name &optional pos)
+  "Return a stream of the characters of the buffer BUFFER-OR-NAME.
+BUFFER-OR-NAME may be a buffer or a string (buffer name).
+The sequence starts at POS if non-nil, 1 otherwise."
+  (unless pos (setq pos 1))
+  (if (>= pos (point-max))
+      (stream-empty)
+    (stream-cons
+     (with-current-buffer buffer-or-name
+       (save-excursion
+         (save-restriction
+           (widen)
+           (goto-char pos)
+           (char-after (point)))))
+     (stream-buffer buffer-or-name (1+ pos)))))
+
+(provide 'stream)
+;;; stream.el ends here
diff --git a/test/automated/stream-tests.el b/test/automated/stream-tests.el
new file mode 100644
index 0000000..a763410
--- /dev/null
+++ b/test/automated/stream-tests.el
@@ -0,0 +1,117 @@
+;;; stream-tests.el --- Unit tests for stream.el  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <address@hidden>
+
+;; Maintainer: address@hidden
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;; Code:
+
+(require 'ert)
+(require 'stream)
+
+(defun stream-to-list (stream)
+  "Eagerly traverse STREAM and return a list of its elements."
+  (let (result)
+    (stream-do (lambda (elt)
+                 (push elt result))
+               stream)
+    (reverse result)))
+
+(ert-deftest stream-empty-test ()
+  (should (stream-p (stream-empty)))
+  (should (stream-empty-p (stream-empty))))
+
+(ert-deftest stream-make-test ()
+  (should (stream-p (stream-range)))
+  (should (not (stream-empty-p (stream-range))))) ;; Should use stream-list or 
something
+
+(ert-deftest stream-first-test ()
+  (should (= 3 (stream-first (stream-range 3))))
+  (should (null (stream-first (stream-empty)))))
+
+(ert-deftest stream-rest-test ()
+  (should (= 4 (stream-first (stream-rest (stream-range 3)))))
+  (should (= 5 (stream-first (stream-rest (stream-rest (stream-range 3)))))))
+
+(ert-deftest stream-take-test ()
+  (should (stream-p (stream-take (stream-range) 2)))
+  (should (= 0 (stream-first (stream-take (stream-range) 2))))
+  (should (= 1 (stream-first (stream-rest (stream-take (stream-range) 2)))))
+  (should (null (stream-first (stream-rest (stream-rest (stream-take 
(stream-range) 2))))))
+  (should (stream-empty-p (stream-rest (stream-rest (stream-take 
(stream-range) 2))))))
+
+(ert-deftest stream-drop-test ()
+  (should (stream-p (stream-drop (stream-range) 2)))
+  (should (= 2 (stream-first (stream-drop (stream-range) 2))))
+  (should (= 3 (stream-first (stream-rest (stream-drop (stream-range) 2)))))
+  (should (stream-empty-p (stream-drop (stream-empty) 2))))
+
+(ert-deftest stream-take-while-test ()
+  (let ((stream (stream-list '(1 3 2 5))))
+    (should (stream-empty-p (stream-take-while #'identity (stream-empty))))
+    (should (stream-p (stream-take-while #'oddp stream)))
+    (should (= 1 (stream-first (stream-take-while #'oddp stream))))
+    (should (= 3 (stream-first (stream-rest (stream-take-while #'oddp 
stream)))))
+    (should (stream-empty-p (stream-rest (stream-rest (stream-take-while 
#'oddp stream)))))))
+
+(ert-deftest stream-drop-while-test ()
+  (let ((stream (stream-list '(1 3 2 5))))
+    (should (stream-p (stream-drop-while #'evenp stream)))
+    (should (stream-empty-p (stream-drop-while #'identity (stream-empty))))
+    (should (= 2 (stream-first (stream-drop-while #'evenp stream))))
+    (should (= 5 (stream-first (stream-rest (stream-drop-while #'evenp 
stream)))))
+    (should (stream-empty-p (stream-rest (stream-rest (stream-drop-while 
#'evenp stream)))))))
+
+(ert-deftest stream-map-test ()
+  (should (stream-empty-p (stream-map #'- (stream-empty))))
+  (should (= -1 (stream-first (stream-map #'- (stream-range 1)))))
+  (should (= -2 (stream-first (stream-rest (stream-map #'- (stream-range 
1)))))))
+
+(ert-deftest stream-do-test ()
+  (let ((result '()))
+    (stream-do
+     (lambda (elt)
+       (push elt result))
+     (stream-range 0 5))
+    (should (equal result '(4 3 2 1 0)))))
+
+(ert-deftest stream-filter-test ()
+  (should (stream-empty-p (stream-filter #'oddp (stream-empty))))
+  (should (stream-empty-p (stream-filter #'oddp (stream-range 0 4 2))))
+  (should (= 1 (stream-first (stream-filter #'oddp (stream-range 0 4)))))
+  (should (= 3 (stream-first (stream-rest (stream-filter #'oddp (stream-range 
0 4))))))
+  (should (stream-empty-p (stream-rest (stream-rest (stream-filter #'oddp 
(stream-range 0 4)))))))
+
+(ert-deftest stream-range-test ()
+  (should (stream-empty-p (stream-range 0 0)))
+  (should (stream-empty-p (stream-range 3 3)))
+  (should-error (stream-range 3 2))
+  (should (= 0 (stream-first (stream-range 0 6 2))))
+  (should (= 2 (stream-first (stream-rest (stream-range 0 6 2)))))
+  (should (= 4 (stream-first (stream-rest (stream-rest (stream-range 0 6 
2))))))
+  (should (stream-empty-p (stream-rest (stream-rest (stream-rest (stream-range 
0 6 2)))))))
+
+(ert-deftest stream-list-test ()
+  (dolist (list '(nil '(1 2 3) '(a . b)))
+    (should (equal list (stream-to-list (stream-list list))))))
+
+(provide 'stream-tests)
+;;; stream-tests.el ends here