From: Nicolas Petton <nicolas@petton.fr>
Date: Wed, 14 Oct 2015 11:27:04 +0000 (+0200)
Subject: Add stream.el to ELPA
X-Git-Url: https://code.delx.au/gnu-emacs-elpa/commitdiff_plain/a519d4065cb39f910a6467e85a220f0d75c73802

Add stream.el to ELPA

* packages/stream/stream.el:
* packages/stream/tests/stream-tests.el: New files.
---

diff --git a/packages/stream/stream.el b/packages/stream/stream.el
new file mode 100644
index 000000000..6e06afda4
--- /dev/null
+++ b/packages/stream/stream.el
@@ -0,0 +1,297 @@
+;;; stream.el --- Implementation of streams  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <nicolas@petton.fr>
+;; Keywords: stream, laziness, sequences
+;; Version: 1.0
+;; Package-Requires: ((emacs "25.1"))
+;; Package: stream
+
+;; Maintainer: nicolas@petton.fr
+
+;; This program 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.
+
+;; This program 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 this program.  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-when-compile (require 'cl-lib))
+(require 'seq)
+
+(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)))
+
+
+;;; Convenient functions for creating streams
+
+(cl-defgeneric stream (src)
+  "Return a new stream from SRC.")
+
+(cl-defmethod stream ((seq sequence))
+  "Return a stream built from the sequence SEQ.
+SEQ can be a list, vector or string."
+  (if (seq-empty-p seq)
+      (stream-empty)
+    (stream-cons
+     (seq-elt seq 0)
+     (stream (seq-subseq seq 1)))))
+
+(cl-defmethod stream ((list list))
+  "Return a stream built from the list LIST."
+  (if (null list)
+      (stream-empty)
+    (stream-cons
+     (car list)
+     (stream (cdr list)))))
+
+(cl-defmethod stream ((buffer buffer) &optional pos)
+  "Return a stream of the characters of the buffer BUFFER.
+BUFFER-OR-NAME may be a buffer or a string (buffer name).
+The sequence starts at POS if non-nil, 1 otherwise."
+  (with-current-buffer buffer
+    (unless pos (setq pos (point-min)))
+    (if (>= pos (point-max))
+        (stream-empty))
+    (stream-cons
+     (with-current-buffer buffer
+       (save-excursion
+         (save-restriction
+           (widen)
+           (goto-char pos)
+           (char-after (point)))))
+     (stream buffer (1+ pos)))))
+
+(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))
+  (if (equal start end)
+      (stream-empty)
+    (stream-cons
+     start
+     (stream-range (+ start step) end step))))
+
+
+(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))))
+
+
+;;; cl-generic support for streams
+
+(defvar stream--generalizer
+  (cl-generic-make-generalizer
+   11
+   (lambda (name)
+     `(when (stream-p ,name)
+        'stream))
+   (lambda (tag)
+     (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
+
+(cl-defgeneric seq-p ((_stream stream))
+  t)
+
+(cl-defgeneric seq-elt ((stream stream) n)
+  "Return the element of STREAM at index N."
+  (while (> n 0)
+    (setq stream (stream-rest stream))
+    (setq n (1- n)))
+  (stream-first stream))
+
+(cl-defgeneric seq-length ((stream stream))
+  "Return the length of STREAM.
+This function will eagerly consume the entire stream."
+  (let ((len 0))
+    (while (not (stream-empty-p stream))
+      (setq len (1+ len))
+      (setq stream (stream-rest stream)))
+    len))
+
+(cl-defgeneric seq-subseq ((stream stream) start end)
+  (seq-take (seq-drop stream start) (- end start)))
+
+(cl-defgeneric seq-into-sequence ((stream stream))
+  "Convert STREAM into a sequence"
+  (let ((list))
+    (seq-doseq (elt stream)
+      (push elt list))
+    (nreverse list)))
+
+(cl-defgeneric seq-into ((stream stream) type)
+  "Convert STREAM into a sequence of type TYPE."
+  (seq-into (seq-into-sequence stream) type))
+
+(cl-defgeneric seq-into ((stream stream) (_type (eql stream)))
+  stream)
+
+(cl-defgeneric seq-into ((seq sequence) (_type (eql stream)))
+  (stream seq))
+
+(cl-defgeneric seq-take ((stream stream) n)
+  "Return a stream of the first N elements of STREAM."
+  (if (zerop n)
+      (stream-empty)
+    (stream-cons
+     (stream-first stream)
+     (seq-take (stream-rest stream) (1- n)))))
+
+(cl-defgeneric seq-drop ((stream 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)))))
+
+(cl-defgeneric seq-take-while (pred (stream 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)
+           (seq-take-while pred (stream-rest stream))))))
+
+(cl-defgeneric seq-drop-while (pred (stream 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)))))
+
+(cl-defgeneric seq-map (function (stream 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))
+     (seq-map function (stream-rest stream)))))
+
+(cl-defgeneric seq-do (function (stream stream))
+  "Evaluate FUNCTION for each element of STREAM eagerly, and return nil.
+
+`seq-do' should never be used on infinite streams."
+  (while (not (stream-empty-p stream))
+    (funcall function (stream-first stream))
+    (setq stream (stream-rest stream))))
+
+(cl-defgeneric seq-filter (pred (stream 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)
+             (seq-filter pred (stream-rest stream)))))))
+
+(cl-defgeneric seq-copy ((stream stream))
+  "Return a shallow copy of STREAM."
+  (stream-cons (stream-first stream)
+               (stream-rest stream)))
+
+(provide 'stream)
+;;; stream.el ends here
diff --git a/packages/stream/tests/stream-tests.el b/packages/stream/tests/stream-tests.el
new file mode 100644
index 000000000..c7b305798
--- /dev/null
+++ b/packages/stream/tests/stream-tests.el
@@ -0,0 +1,172 @@
+;;; stream-tests.el --- Unit tests for stream.el  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <nicolas@petton.fr>
+
+;; Maintainer: emacs-devel@gnu.org
+
+;; 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)
+    (seq-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-seq-p-test ()
+  (should (seq-p (stream-range))))
+
+(ert-deftest stream-seq-elt-test ()
+  (should (null (seq-elt (stream-empty) 0)))
+  (should (= 0 (seq-elt (stream-range) 0)))
+  (should (= 1 (seq-elt (stream-range) 1)))
+  (should (= 10 (seq-elt (stream-range) 10))))
+
+(ert-deftest stream-seq-length-test ()
+  (should (zerop (seq-length (stream-empty))))
+  (should (= 10 (seq-length (stream-range 0 10)))))
+
+(ert-deftest stream-seq-doseq-test ()
+  (let ((stream (stream '(a b c d)))
+        (lst '()))
+    (seq-doseq (elt stream)
+      (push elt lst))
+    (should (equal '(d c b a) lst))))
+
+(ert-deftest stream-seq-let-test ()
+  (seq-let (first _ third &rest rest) (stream-range 2 7)
+    (should (= first 2))
+    (should (= third 4))
+    ;; The rest of the stream shouldn't be consumed
+    (should (stream-p rest))
+    (should (= 5 (stream-first rest)))
+    (should (= 6 (stream-first (stream-rest rest))))
+    (should (stream-empty-p (stream-rest (stream-rest rest))))))
+
+(ert-deftest stream-seq-subseq-test ()
+  ;; TODO
+  )
+
+(ert-deftest stream-seq-into-test ()
+  (should (stream-p (seq-into (stream-empty) 'stream)))
+  (should (stream-p (seq-into '(2 4 5) 'stream)))
+  (should (= 2  (stream-first (seq-into '(2 4 5) 'stream))))
+  (should (null (seq-into (stream-empty) 'list)))
+  (should (equal '(0 1 2 3 4 5 6 7 8 9) (seq-into (stream-range 0 10) 'list))))
+
+(ert-deftest stream-seq-take-test ()
+  (should (stream-p (seq-take (stream-range) 2)))
+  (should (= 0 (stream-first (seq-take (stream-range) 2))))
+  (should (= 1 (stream-first (stream-rest (seq-take (stream-range) 2)))))
+  (should (null (stream-first (stream-rest (stream-rest (seq-take (stream-range) 2))))))
+  (should (stream-empty-p (stream-rest (stream-rest (seq-take (stream-range) 2))))))
+
+(ert-deftest stream-seq-drop-test ()
+  (should (stream-p (seq-drop (stream-range) 2)))
+  (should (= 2 (stream-first (seq-drop (stream-range) 2))))
+  (should (= 3 (stream-first (stream-rest (seq-drop (stream-range) 2)))))
+  (should (stream-empty-p (seq-drop (stream-empty) 2))))
+
+(ert-deftest stream-seq-take-while-test ()
+  (let ((stream (stream '(1 3 2 5))))
+    (should (stream-empty-p (seq-take-while #'identity (stream-empty))))
+    (should (stream-p (seq-take-while #'oddp stream)))
+    (should (= 1 (stream-first (seq-take-while #'oddp stream))))
+    (should (= 3 (stream-first (stream-rest (seq-take-while #'oddp stream)))))
+    (should (stream-empty-p (stream-rest (stream-rest (seq-take-while #'oddp stream)))))))
+
+(ert-deftest stream-seq-drop-while-test ()
+  (let ((stream (stream '(1 3 2 5))))
+    (should (stream-p (seq-drop-while #'evenp stream)))
+    (should (stream-empty-p (seq-drop-while #'identity (stream-empty))))
+    (should (= 2 (stream-first (seq-drop-while #'evenp stream))))
+    (should (= 5 (stream-first (stream-rest (seq-drop-while #'evenp stream)))))
+    (should (stream-empty-p (stream-rest (stream-rest (seq-drop-while #'evenp stream)))))))
+
+(ert-deftest stream-seq-map-test ()
+  (should (stream-empty-p (seq-map #'- (stream-empty))))
+  (should (= -1 (stream-first (seq-map #'- (stream-range 1)))))
+  (should (= -2 (stream-first (stream-rest (seq-map #'- (stream-range 1)))))))
+
+(ert-deftest stream-seq-do-test ()
+  (let ((result '()))
+    (seq-do
+     (lambda (elt)
+       (push elt result))
+     (stream-range 0 5))
+    (should (equal result '(4 3 2 1 0)))))
+
+(ert-deftest stream-seq-filter-test ()
+  (should (stream-empty-p (seq-filter #'oddp (stream-empty))))
+  (should (stream-empty-p (seq-filter #'oddp (stream-range 0 4 2))))
+  (should (= 1 (stream-first (seq-filter #'oddp (stream-range 0 4)))))
+  (should (= 3 (stream-first (stream-rest (seq-filter #'oddp (stream-range 0 4))))))
+  (should (stream-empty-p (stream-rest (stream-rest (seq-filter #'oddp (stream-range 0 4)))))))
+
+(ert-deftest stream-seq-copy-test ()
+  (should (stream-p (seq-copy (stream-range))))
+  (should (= 0 (stream-first (seq-copy (stream-range)))))
+  (should (= 1 (stream-first (stream-rest (seq-copy (stream-range)))))))
+
+(ert-deftest stream-range-test ()
+  (should (stream-empty-p (stream-range 0 0)))
+  (should (stream-empty-p (stream-range 3 3)))
+  (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))))))
+  (should (= -4 (stream-first (stream-rest (stream-rest (stream-range 0 nil -2)))))))
+
+(ert-deftest stream-list-test ()
+  (dolist (list '(nil '(1 2 3) '(a . b)))
+    (should (equal list (stream-to-list (stream list))))))
+
+(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))
+  (should (= (seq-length (seq-subseq (stream-range 2 10) 0 3)) 3))
+  (should (= (seq-elt (seq-subseq (stream-range 2 10) 0 3) 2) 4))
+  (should (= (stream-first (seq-subseq (stream-range 2 10) 1 3)) 3))
+  (should (= (seq-length (seq-subseq (stream-range 2 10) 1 3)) 2))
+  (should (= (seq-elt (seq-subseq (stream-range 2 10) 1 3) 1) 4)))
+
+(provide 'stream-tests)
+;;; stream-tests.el ends here