--- /dev/null
+;;; 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: stream
+
+;; 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:
+
+;; 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
--- /dev/null
+;;; 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)
+ (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
projects / emacs.git / commitdiff