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.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 (require 'thunk)
  58
  59 (eval-and-compile
  60   (defconst stream--identifier '--stream--
  61     "Symbol internally used to identify streams."))
  62
  63 (defmacro stream-make (&rest body)
  64   "Return a stream built from BODY.
  65 BODY must return nil or a cons cell whose cdr is itself a
  66 stream."
  67   (declare (debug t))
  68   `(list ',stream--identifier (thunk-delay ,@body)))
  69
  70 (defmacro stream-cons (first rest)
  71   "Return a stream built from the cons of FIRST and REST.
  72 FIRST and REST are forms and REST must return a stream."
  73   (declare (debug t))
  74   `(stream-make (cons ,first ,rest)))
  75 \f
  76
  77 ;;; Convenient functions for creating streams
  78
  79 (cl-defgeneric stream (src)
  80   "Return a new stream from SRC.")
  81
  82 (cl-defmethod stream ((seq sequence))
  83   "Return a stream built from the sequence SEQ.
  84 SEQ can be a list, vector or string."
  85   (if (seq-empty-p seq)
  86       (stream-empty)
  87     (stream-cons
  88      (seq-elt seq 0)
  89      (stream (seq-subseq seq 1)))))
  90
  91 (cl-defmethod stream ((list list))
  92   "Return a stream built from the list LIST."
  93   (if (null list)
  94       (stream-empty)
  95     (stream-cons
  96      (car list)
  97      (stream (cdr list)))))
  98
  99 (cl-defmethod stream ((buffer buffer) &optional pos)
 100   "Return a stream of the characters of the buffer BUFFER.
 101 BUFFER may be a buffer or a string (buffer name).
 102 The sequence starts at POS if non-nil, 1 otherwise."
 103   (with-current-buffer buffer
 104     (unless pos (setq pos (point-min)))
 105     (if (>= pos (point-max))
 106         (stream-empty))
 107     (stream-cons
 108      (with-current-buffer buffer
 109        (save-excursion
 110          (save-restriction
 111            (widen)
 112            (goto-char pos)
 113            (char-after (point)))))
 114      (stream buffer (1+ pos)))))
 115
 116 (defun stream-regexp (buffer regexp)
 117   (stream-make
 118    (let (match)
 119      (with-current-buffer buffer
 120        (setq match (re-search-forward regexp nil t)))
 121      (when match
 122        (cons (match-data) (stream-regexp buffer regexp))))))
 123
 124 (defun stream-range (&optional start end step)
 125   "Return a stream of the integers from START to END, stepping by STEP.
 126 If START is nil, it defaults to 0. If STEP is nil, it defaults to
 127 1.  START is inclusive and END is exclusive.  If END is nil, the
 128 range is infinite."
 129   (unless start (setq start 0))
 130   (unless step (setq step 1))
 131   (if (equal start end)
 132       (stream-empty)
 133     (stream-cons
 134      start
 135      (stream-range (+ start step) end step))))
 136 \f
 137
 138 (defun streamp (stream)
 139   "Return non-nil if STREAM is a stream, nil otherwise."
 140   (eq (car-safe stream) stream--identifier))
 141
 142 (defun stream-empty ()
 143   "Return an empty stream."
 144   (list stream--identifier (thunk-delay nil)))
 145
 146 (defun stream-empty-p (stream)
 147   "Return non-nil is STREAM is empty, nil otherwise."
 148   (null (thunk-force (cadr stream))))
 149
 150 (defun stream-first (stream)
 151   "Return the first element of STREAM."
 152   (car (thunk-force (cadr stream))))
 153
 154 (defun stream-rest (stream)
 155   "Return a stream of all but the first element of STREAM."
 156   (or (cdr (thunk-force (cadr stream)))
 157       (stream-empty)))
 158
 159 (defmacro stream-pop (stream)
 160   "Return the first element of STREAM and set the value of STREAM to its rest."
 161   (unless (symbolp stream)
 162     (error "STREAM must be a symbol"))
 163   `(prog1
 164        (stream-first ,stream)
 165      (setq ,stream (stream-rest ,stream))))
 166 \f
 167
 168 ;;; cl-generic support for streams
 169
 170 (cl-generic-define-generalizer stream--generalizer
 171   11
 172   (lambda (name)
 173     `(when (streamp ,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-defmethod seqp ((_stream stream))
 187   t)
 188
 189 (cl-defmethod 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-defmethod 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-defmethod seq-subseq ((stream stream) start end)
 206   (seq-take (seq-drop stream start) (- end start)))
 207
 208 (cl-defmethod 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-defmethod 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-defmethod seq-into ((stream stream) (_type (eql stream)))
 220   stream)
 221
 222 (cl-defmethod seq-into ((seq sequence) (_type (eql stream)))
 223   (stream seq))
 224
 225 (cl-defmethod seq-take ((stream stream) n)
 226   "Return a stream of the first N elements of STREAM."
 227   (if (or (zerop n)
 228           (stream-empty-p stream))
 229       (stream-empty)
 230     (stream-cons
 231      (stream-first stream)
 232      (seq-take (stream-rest stream) (1- n)))))
 233
 234 (cl-defmethod seq-drop ((stream stream) n)
 235   "Return a stream of STREAM without its first N elements."
 236   (stream-make
 237    (while (not (or (stream-empty-p stream) (zerop n)))
 238      (setq n (1- n))
 239      (setq stream (stream-rest stream)))
 240    (unless (stream-empty-p stream)
 241      (cons (stream-first stream)
 242            (stream-rest stream)))))
 243
 244 (cl-defmethod seq-take-while (pred (stream stream))
 245   "Return a stream of the successive elements for which (PRED elt) is non-nil in STREAM."
 246   (stream-make
 247    (when (funcall pred (stream-first stream))
 248      (cons (stream-first stream)
 249            (seq-take-while pred (stream-rest stream))))))
 250
 251 (cl-defmethod seq-drop-while (pred (stream stream))
 252   "Return a stream from the first element for which (PRED elt) is nil in STREAM."
 253   (stream-make
 254    (while (not (or (stream-empty-p stream)
 255                    (funcall pred (stream-first stream))))
 256      (setq stream (stream-rest stream)))
 257    (unless (stream-empty-p stream)
 258      (cons (stream-first stream)
 259            (stream-rest stream)))))
 260
 261 (cl-defmethod seq-map (function (stream stream))
 262     "Return a stream representing the mapping of FUNCTION over STREAM.
 263 The elements of the produced stream are the results of the
 264 applications of FUNCTION on each element of STREAM in succession."
 265   (stream-make
 266    (when (not (stream-empty-p stream))
 267      (cons (funcall function (stream-first stream))
 268            (seq-map function (stream-rest stream))))))
 269
 270 (cl-defmethod 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 without some
 274 kind of nonlocal exit."
 275   (while (not (stream-empty-p stream))
 276     (funcall function (stream-first stream))
 277     (setq stream (stream-rest stream))))
 278
 279 (cl-defmethod seq-filter (pred (stream stream))
 280   "Return a stream of the elements for which (PRED element) is non-nil in STREAM."
 281   (if (stream-empty-p stream)
 282       stream
 283     (stream-make
 284      (while (not (or (stream-empty-p stream)
 285                      (funcall pred (stream-first stream))))
 286        (setq stream (stream-rest stream)))
 287      (if (stream-empty-p stream)
 288          nil
 289        (cons (stream-first stream)
 290              (seq-filter pred (stream-rest stream)))))))
 291
 292 (cl-defmethod seq-copy ((stream stream))
 293   "Return a shallow copy of STREAM."
 294   (stream-cons (stream-first stream)
 295                (stream-rest stream)))
 296
 297 (provide 'stream)
 298 ;;; stream.el ends here