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: 2.0.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 streamp (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   (or (cdr (stream--force (cadr stream)))
 165       (stream-empty)))
 166 \f
 167
 168 ;;; cl-generic support for streams
 169
 170 (defvar stream--generalizer
 171   (cl-generic-make-generalizer
 172    11
 173    (lambda (name)
 174      `(when (streamp ,name)
 175         'stream))
 176    (lambda (tag)
 177      (when (eq tag 'stream)
 178        '(stream)))))
 179
 180 (cl-defmethod cl-generic-generalizers ((_specializer (eql stream)))
 181   "Support for `stream' specializers."
 182   (list stream--generalizer))
 183 \f
 184
 185 ;;; Implementation of seq.el generic functions
 186
 187 (cl-defmethod seq-p ((_stream stream))
 188   t)
 189
 190 (cl-defmethod seq-elt ((stream stream) n)
 191   "Return the element of STREAM at index N."
 192   (while (> n 0)
 193     (setq stream (stream-rest stream))
 194     (setq n (1- n)))
 195   (stream-first stream))
 196
 197 (cl-defmethod seq-length ((stream stream))
 198   "Return the length of STREAM.
 199 This function will eagerly consume the entire stream."
 200   (let ((len 0))
 201     (while (not (stream-empty-p stream))
 202       (setq len (1+ len))
 203       (setq stream (stream-rest stream)))
 204     len))
 205
 206 (cl-defmethod seq-subseq ((stream stream) start end)
 207   (seq-take (seq-drop stream start) (- end start)))
 208
 209 (cl-defmethod seq-into-sequence ((stream stream))
 210   "Convert STREAM into a sequence"
 211   (let ((list))
 212     (seq-doseq (elt stream)
 213       (push elt list))
 214     (nreverse list)))
 215
 216 (cl-defmethod seq-into ((stream stream) type)
 217   "Convert STREAM into a sequence of type TYPE."
 218   (seq-into (seq-into-sequence stream) type))
 219
 220 (cl-defmethod seq-into ((stream stream) (_type (eql stream)))
 221   stream)
 222
 223 (cl-defmethod seq-into ((seq sequence) (_type (eql stream)))
 224   (stream seq))
 225
 226 (cl-defmethod seq-take ((stream stream) n)
 227   "Return a stream of the first N elements of STREAM."
 228   (if (or (zerop n)
 229           (stream-empty-p stream))
 230       (stream-empty)
 231     (stream-cons
 232      (stream-first stream)
 233      (seq-take (stream-rest stream) (1- n)))))
 234
 235 (cl-defmethod seq-drop ((stream stream) n)
 236   "Return a stream of STREAM without its first N elements."
 237   (stream-make
 238    (while (not (or (stream-empty-p stream) (zerop n)))
 239      (setq n (1- n))
 240      (setq stream (stream-rest stream)))
 241    (unless (stream-empty-p stream)
 242      (cons (stream-first stream)
 243            (stream-rest stream)))))
 244
 245 (cl-defmethod seq-take-while (pred (stream stream))
 246   "Return a stream of the successive elements for which (PRED elt) is non-nil in STREAM."
 247   (stream-make
 248    (when (funcall pred (stream-first stream))
 249      (cons (stream-first stream)
 250            (seq-take-while pred (stream-rest stream))))))
 251
 252 (cl-defmethod seq-drop-while (pred (stream stream))
 253   "Return a stream from the first element for which (PRED elt) is nil in STREAM."
 254   (stream-make
 255    (while (not (or (stream-empty-p stream)
 256                    (funcall pred (stream-first stream))))
 257      (setq stream (stream-rest stream)))
 258    (unless (stream-empty-p stream)
 259      (cons (stream-first stream)
 260            (stream-rest stream)))))
 261
 262 (cl-defmethod seq-map (function (stream stream))
 263   "Return a stream.
 264 The elements of the produced sequence consist of the application
 265 of FUNCTION to each element of STREAM."
 266   (if (stream-empty-p stream)
 267       stream
 268     (stream-cons
 269       (funcall function (stream-first stream))
 270      (seq-map function (stream-rest stream)))))
 271
 272 (cl-defmethod seq-do (function (stream stream))
 273   "Evaluate FUNCTION for each element of STREAM eagerly, and return nil.
 274
 275 `seq-do' should never be used on infinite streams."
 276   (while (not (stream-empty-p stream))
 277     (funcall function (stream-first stream))
 278     (setq stream (stream-rest stream))))
 279
 280 (cl-defmethod seq-filter (pred (stream stream))
 281   "Return a stream of the elements for which (PRED element) is non-nil in STREAM."
 282   (if (stream-empty-p stream)
 283       stream
 284     (stream-make
 285      (while (not (or (stream-empty-p stream)
 286                      (funcall pred (stream-first stream))))
 287        (setq stream (stream-rest stream)))
 288      (if (stream-empty-p stream)
 289          nil
 290        (cons (stream-first stream)
 291              (seq-filter pred (stream-rest stream)))))))
 292
 293 (cl-defmethod seq-copy ((stream stream))
 294   "Return a shallow copy of STREAM."
 295   (stream-cons (stream-first stream)
 296                (stream-rest stream)))
 297
 298 (provide 'stream)
 299 ;;; stream.el ends here