code.delx.au - gnu-emacs-elpa/blob - packages/stream/stream.el

   1 ;;; stream.el --- Implementation of streams  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Nicolas Petton <nicolas@petton.fr>
   6 ;; Keywords: stream, laziness, sequences
   7 ;; Version: 1.0
   8 ;; Package-Requires: ((emacs "25"))
   9 ;; Package: stream
  10
  11 ;; Maintainer: nicolas@petton.fr
  12
  13 ;; This program is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; This library provides an implementation of streams. Streams are
  29 ;; implemented as delayed evaluation of cons cells.
  30 ;;
  31 ;; Functions defined in `seq.el' can also take a stream as input.
  32 ;;
  33 ;; streams could be created from any sequential input data:
  34 ;; - sequences, making operation on them lazy
  35 ;; - a set of 2 forms (first and rest), making it easy to represent infinite sequences
  36 ;; - buffers (by character)
  37 ;; - buffers (by line)
  38 ;; - buffers (by page)
  39 ;; - IO streams
  40 ;; - orgmode table cells
  41 ;; - ...
  42 ;;
  43 ;; All functions are prefixed with "stream-".
  44 ;; All functions are tested in test/automated/stream-tests.el
  45 ;;
  46 ;; Here is an example implementation of the Fibonacci numbers
  47 ;; implemented as in infinite stream:
  48 ;;
  49 ;; (defun fib (a b)
  50 ;;  (stream-cons a (fib b (+ a b))))
  51 ;; (fib 0 1)
  52
  53 ;;; Code:
  54
  55 (eval-when-compile (require 'cl-lib))
  56 (require 'seq)
  57
  58 (eval-and-compile
  59   (defconst stream--identifier '--stream--
  60     "Symbol internally used to identify streams."))
  61
  62 (defmacro stream--delay (&rest body)
  63   "Delay the evaluation of BODY."
  64   (declare (debug t))
  65   (let ((forced (make-symbol "forced"))
  66         (val (make-symbol "val")))
  67     `(let (,forced ,val)
  68        (lambda ()
  69          (unless ,forced
  70            (setf ,val (progn ,@body))
  71            (setf ,forced t))
  72          ,val))))
  73
  74 (defun stream--force (delayed)
  75   "Force the evaluation of DELAYED."
  76   (funcall delayed))
  77
  78 (defmacro stream-make (&rest body)
  79   "Return a stream built from BODY.
  80 BODY must return nil or a cons cell, which cdr is itself a
  81 stream."
  82   (declare (debug t))
  83   `(list ',stream--identifier (stream--delay ,@body)))
  84
  85 (defmacro stream-cons (first rest)
  86   "Return a stream built from the cons of FIRST and REST.
  87 FIRST and REST are forms and REST must return a stream."
  88   (declare (debug t))
  89   `(stream-make (cons ,first ,rest)))
  90 \f
  91
  92 ;;; Convenient functions for creating streams
  93
  94 (cl-defgeneric stream (src)
  95   "Return a new stream from SRC.")
  96
  97 (cl-defmethod stream ((seq sequence))
  98   "Return a stream built from the sequence SEQ.
  99 SEQ can be a list, vector or string."
 100   (if (seq-empty-p seq)
 101       (stream-empty)
 102     (stream-cons
 103      (seq-elt seq 0)
 104      (stream (seq-subseq seq 1)))))
 105
 106 (cl-defmethod stream ((list list))
 107   "Return a stream built from the list LIST."
 108   (if (null list)
 109       (stream-empty)
 110     (stream-cons
 111      (car list)
 112      (stream (cdr list)))))
 113
 114 (cl-defmethod stream ((buffer buffer) &optional pos)
 115   "Return a stream of the characters of the buffer BUFFER.
 116 BUFFER-OR-NAME may be a buffer or a string (buffer name).
 117 The sequence starts at POS if non-nil, 1 otherwise."
 118   (with-current-buffer buffer
 119     (unless pos (setq pos (point-min)))
 120     (if (>= pos (point-max))
 121         (stream-empty))
 122     (stream-cons
 123      (with-current-buffer buffer
 124        (save-excursion
 125          (save-restriction
 126            (widen)
 127            (goto-char pos)
 128            (char-after (point)))))
 129      (stream buffer (1+ pos)))))
 130
 131 (defun stream-range (&optional start end step)
 132   "Return a stream of the integers from START to END, stepping by STEP.
 133 If START is nil, it defaults to 0. If STEP is nil, it defaults to
 134 1.  START is inclusive and END is exclusive.  If END is nil, the
 135 range is infinite."
 136   (unless start (setq start 0))
 137   (unless step (setq step 1))
 138   (if (equal start end)
 139       (stream-empty)
 140     (stream-cons
 141      start
 142      (stream-range (+ start step) end step))))
 143 \f
 144
 145 (defun stream-p (stream)
 146   "Return non-nil if STREAM is a stream, nil otherwise."
 147   (and (consp stream)
 148        (eq (car stream) stream--identifier)))
 149
 150 (defun stream-empty ()
 151   "Return an empty stream."
 152   (list stream--identifier (stream--delay nil)))
 153
 154 (defun stream-empty-p (stream)
 155   "Return non-nil is STREAM is empty, nil otherwise."
 156   (null (stream--force (cadr stream))))
 157
 158 (defun stream-first (stream)
 159   "Return the first element of STREAM."
 160   (car (stream--force (cadr stream))))
 161
 162 (defun stream-rest (stream)
 163   "Return a stream of all but the first element of STREAM."
 164   (cdr (stream--force (cadr stream))))
 165 \f
 166
 167 ;;; cl-generic support for streams
 168
 169 (defvar stream--generalizer
 170   (cl-generic-make-generalizer
 171    11
 172    (lambda (name)
 173      `(when (stream-p ,name)
 174         'stream))
 175    (lambda (tag)
 176      (when (eq tag 'stream)
 177        '(stream)))))
 178
 179 (cl-defmethod cl-generic-generalizers ((_specializer (eql stream)))
 180   "Support for `stream' specializers."
 181   (list stream--generalizer))
 182 \f
 183
 184 ;;; Implementation of seq.el generic functions
 185
 186 (cl-defgeneric seq-p ((_stream stream))
 187   t)
 188
 189 (cl-defgeneric seq-elt ((stream stream) n)
 190   "Return the element of STREAM at index N."
 191   (while (> n 0)
 192     (setq stream (stream-rest stream))
 193     (setq n (1- n)))
 194   (stream-first stream))
 195
 196 (cl-defgeneric seq-length ((stream stream))
 197   "Return the length of STREAM.
 198 This function will eagerly consume the entire stream."
 199   (let ((len 0))
 200     (while (not (stream-empty-p stream))
 201       (setq len (1+ len))
 202       (setq stream (stream-rest stream)))
 203     len))
 204
 205 (cl-defgeneric seq-subseq ((stream stream) start end)
 206   (seq-take (seq-drop stream start) (- end start)))
 207
 208 (cl-defgeneric seq-into-sequence ((stream stream))
 209   "Convert STREAM into a sequence"
 210   (let ((list))
 211     (seq-doseq (elt stream)
 212       (push elt list))
 213     (nreverse list)))
 214
 215 (cl-defgeneric seq-into ((stream stream) type)
 216   "Convert STREAM into a sequence of type TYPE."
 217   (seq-into (seq-into-sequence stream) type))
 218
 219 (cl-defgeneric seq-into ((stream stream) (_type (eql stream)))
 220   stream)
 221
 222 (cl-defgeneric seq-into ((seq sequence) (_type (eql stream)))
 223   (stream seq))
 224
 225 (cl-defgeneric seq-take ((stream stream) n)
 226   "Return a stream of the first N elements of STREAM."
 227   (if (zerop n)
 228       (stream-empty)
 229     (stream-cons
 230      (stream-first stream)
 231      (seq-take (stream-rest stream) (1- n)))))
 232
 233 (cl-defgeneric seq-drop ((stream stream) n)
 234   "Return a stream of STREAM without its first N elements."
 235   (stream-make
 236    (while (not (or (stream-empty-p stream) (zerop n)))
 237      (setq n (1- n))
 238      (setq stream (stream-rest stream)))
 239    (unless (stream-empty-p stream)
 240      (cons (stream-first stream)
 241            (stream-rest stream)))))
 242
 243 (cl-defgeneric seq-take-while (pred (stream stream))
 244   "Return a stream of the successive elements for which (PRED elt) is non-nil in STREAM."
 245   (stream-make
 246    (when (funcall pred (stream-first stream))
 247      (cons (stream-first stream)
 248            (seq-take-while pred (stream-rest stream))))))
 249
 250 (cl-defgeneric seq-drop-while (pred (stream stream))
 251   "Return a stream from the first element for which (PRED elt) is nil in STREAM."
 252   (stream-make
 253    (while (not (or (stream-empty-p stream)
 254                    (funcall pred (stream-first stream))))
 255      (setq stream (stream-rest stream)))
 256    (unless (stream-empty-p stream)
 257      (cons (stream-first stream)
 258            (stream-rest stream)))))
 259
 260 (cl-defgeneric seq-map (function (stream stream))
 261   "Return a stream.
 262 The elements of the produced sequence consist of the application
 263 of FUNCTION to each element of STREAM."
 264   (if (stream-empty-p stream)
 265       stream
 266     (stream-cons
 267       (funcall function (stream-first stream))
 268      (seq-map function (stream-rest stream)))))
 269
 270 (cl-defgeneric seq-do (function (stream stream))
 271   "Evaluate FUNCTION for each element of STREAM eagerly, and return nil.
 272
 273 `seq-do' should never be used on infinite streams."
 274   (while (not (stream-empty-p stream))
 275     (funcall function (stream-first stream))
 276     (setq stream (stream-rest stream))))
 277
 278 (cl-defgeneric seq-filter (pred (stream stream))
 279   "Return a stream of the elements for which (PRED element) is non-nil in STREAM."
 280   (if (stream-empty-p stream)
 281       stream
 282     (stream-make
 283      (while (not (or (stream-empty-p stream)
 284                      (funcall pred (stream-first stream))))
 285        (setq stream (stream-rest stream)))
 286      (if (stream-empty-p stream)
 287          nil
 288        (cons (stream-first stream)
 289              (seq-filter pred (stream-rest stream)))))))
 290
 291 (cl-defgeneric seq-copy ((stream stream))
 292   "Return a shallow copy of STREAM."
 293   (stream-cons (stream-first stream)
 294                (stream-rest stream)))
 295
 296 (provide 'stream)
 297 ;;; stream.el ends here