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

   1 ;;; stream.el --- Implementation of streams  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2016 Free Software Foundation, Inc.
   4
   5 ;; Author: Nicolas Petton <nicolas@petton.fr>
   6 ;; Keywords: stream, laziness, sequences
   7 ;; Version: 2.2.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 (declare-function iter-next "generator")
 117
 118 (defun stream-from-iterator (iterator)
 119   "Return a stream generating new elements through ITERATOR.
 120 ITERATOR is an iterator object in terms of the \"generator\"
 121 package."
 122   (stream-make
 123    (condition-case nil
 124        (cons (iter-next iterator) (stream-from-iterator iterator))
 125      (iter-end-of-sequence nil))))
 126
 127 (defun stream-regexp (buffer regexp)
 128   (stream-make
 129    (let (match)
 130      (with-current-buffer buffer
 131        (setq match (re-search-forward regexp nil t)))
 132      (when match
 133        (cons (match-data) (stream-regexp buffer regexp))))))
 134
 135 (defun stream-range (&optional start end step)
 136   "Return a stream of the integers from START to END, stepping by STEP.
 137 If START is nil, it defaults to 0. If STEP is nil, it defaults to
 138 1.  START is inclusive and END is exclusive.  If END is nil, the
 139 range is infinite."
 140   (unless start (setq start 0))
 141   (unless step (setq step 1))
 142   (if (equal start end)
 143       (stream-empty)
 144     (stream-cons
 145      start
 146      (stream-range (+ start step) end step))))
 147 \f
 148
 149 (defun streamp (stream)
 150   "Return non-nil if STREAM is a stream, nil otherwise."
 151   (and (consp stream)
 152        (eq (car stream) stream--identifier)))
 153
 154 (defun stream-empty ()
 155   "Return a new empty stream."
 156   (list stream--identifier (thunk-delay nil)))
 157
 158 (defun stream-empty-p (stream)
 159   "Return non-nil is STREAM is empty, nil otherwise."
 160   (null (thunk-force (cadr stream))))
 161
 162 (defun stream-first (stream)
 163   "Return the first element of STREAM."
 164   (car (thunk-force (cadr stream))))
 165
 166 (defun stream-rest (stream)
 167   "Return a stream of all but the first element of STREAM."
 168   (or (cdr (thunk-force (cadr stream)))
 169       (stream-empty)))
 170
 171 (defun stream-append (&rest streams)
 172   "Concatenate the STREAMS.
 173 Requesting elements from the resulting stream will request the
 174 elements in the STREAMS in order."
 175   (if (null streams)
 176       (stream-empty)
 177     (stream-make
 178      (let ((first (pop streams)))
 179        (while (and (stream-empty-p first) streams)
 180          (setq first (pop streams)))
 181        (if (stream-empty-p first)
 182            nil
 183          (cons (stream-first first)
 184                (if streams (apply #'stream-append (stream-rest first) streams)
 185                  (stream-rest first))))))))
 186
 187 (defmacro stream-pop (stream)
 188   "Return the first element of STREAM and set the value of STREAM to its rest."
 189   (unless (symbolp stream)
 190     (error "STREAM must be a symbol"))
 191   `(prog1
 192        (stream-first ,stream)
 193      (setq ,stream (stream-rest ,stream))))
 194 \f
 195
 196 ;;; cl-generic support for streams
 197
 198 (cl-generic-define-generalizer stream--generalizer
 199   11
 200   (lambda (name)
 201     `(when (streamp ,name)
 202        'stream))
 203   (lambda (tag)
 204     (when (eq tag 'stream)
 205       '(stream))))
 206
 207 (cl-defmethod cl-generic-generalizers ((_specializer (eql stream)))
 208   "Support for `stream' specializers."
 209   (list stream--generalizer))
 210 \f
 211
 212 ;;; Implementation of seq.el generic functions
 213
 214 (cl-defmethod seqp ((_stream stream))
 215   t)
 216
 217 (cl-defmethod seq-elt ((stream stream) n)
 218   "Return the element of STREAM at index N."
 219   (while (> n 0)
 220     (setq stream (stream-rest stream))
 221     (setq n (1- n)))
 222   (stream-first stream))
 223
 224 (cl-defmethod seq-length ((stream stream))
 225   "Return the length of STREAM.
 226 This function will eagerly consume the entire stream."
 227   (let ((len 0))
 228     (while (not (stream-empty-p stream))
 229       (setq len (1+ len))
 230       (setq stream (stream-rest stream)))
 231     len))
 232
 233 (cl-defmethod seq-subseq ((stream stream) start end)
 234   (seq-take (seq-drop stream start) (- end start)))
 235
 236 (cl-defmethod seq-into-sequence ((stream stream))
 237   "Convert STREAM into a sequence."
 238   (let ((list))
 239     (seq-doseq (elt stream)
 240       (push elt list))
 241     (nreverse list)))
 242
 243 (cl-defmethod seq-into ((stream stream) type)
 244   "Convert STREAM into a sequence of type TYPE."
 245   (seq-into (seq-into-sequence stream) type))
 246
 247 (cl-defmethod seq-into ((stream stream) (_type (eql stream)))
 248   stream)
 249
 250 (cl-defmethod seq-into ((seq sequence) (_type (eql stream)))
 251   (stream seq))
 252
 253 (cl-defmethod seq-take ((stream stream) n)
 254   "Return a stream of the first N elements of STREAM."
 255   (if (or (zerop n)
 256           (stream-empty-p stream))
 257       (stream-empty)
 258     (stream-cons
 259      (stream-first stream)
 260      (seq-take (stream-rest stream) (1- n)))))
 261
 262 (cl-defmethod seq-drop ((stream stream) n)
 263   "Return a stream of STREAM without its first N elements."
 264   (stream-make
 265    (while (not (or (stream-empty-p stream) (zerop n)))
 266      (setq n (1- n))
 267      (setq stream (stream-rest stream)))
 268    (unless (stream-empty-p stream)
 269      (cons (stream-first stream)
 270            (stream-rest stream)))))
 271
 272 (cl-defmethod seq-take-while (pred (stream stream))
 273   "Return a stream of the successive elements for which (PRED elt) is non-nil in STREAM."
 274   (stream-make
 275    (when (funcall pred (stream-first stream))
 276      (cons (stream-first stream)
 277            (seq-take-while pred (stream-rest stream))))))
 278
 279 (cl-defmethod seq-drop-while (pred (stream stream))
 280   "Return a stream from the first element for which (PRED elt) is nil in STREAM."
 281   (stream-make
 282    (while (not (or (stream-empty-p stream)
 283                    (funcall pred (stream-first stream))))
 284      (setq stream (stream-rest stream)))
 285    (unless (stream-empty-p stream)
 286      (cons (stream-first stream)
 287            (stream-rest stream)))))
 288
 289 (cl-defmethod seq-map (function (stream stream))
 290     "Return a stream representing the mapping of FUNCTION over STREAM.
 291 The elements of the produced stream are the results of the
 292 applications of FUNCTION on each element of STREAM in succession."
 293   (stream-make
 294    (when (not (stream-empty-p stream))
 295      (cons (funcall function (stream-first stream))
 296            (seq-map function (stream-rest stream))))))
 297
 298 (cl-defmethod seq-do (function (stream stream))
 299   "Evaluate FUNCTION for each element of STREAM eagerly, and return nil.
 300
 301 `seq-do' should never be used on infinite streams without some
 302 kind of nonlocal exit."
 303   (while (not (stream-empty-p stream))
 304     (funcall function (stream-first stream))
 305     (setq stream (stream-rest stream))))
 306
 307 (cl-defmethod seq-filter (pred (stream stream))
 308   "Return a stream of the elements for which (PRED element) is non-nil in STREAM."
 309   (if (stream-empty-p stream)
 310       stream
 311     (stream-make
 312      (while (not (or (stream-empty-p stream)
 313                      (funcall pred (stream-first stream))))
 314        (setq stream (stream-rest stream)))
 315      (if (stream-empty-p stream)
 316          nil
 317        (cons (stream-first stream)
 318              (seq-filter pred (stream-rest stream)))))))
 319
 320 (defmacro stream-delay (expr)
 321   "Return a new stream to be obtained by evaluating EXPR.
 322 EXPR will be evaluated once when an element of the resulting
 323 stream is requested for the first time, and must return a stream.
 324 EXPR will be evaluated in the lexical environment present when
 325 calling this function."
 326   (let ((stream (make-symbol "stream")))
 327     `(stream-make (let ((,stream ,expr))
 328                     (if (stream-empty-p ,stream)
 329                         nil
 330                       (cons (stream-first ,stream)
 331                             (stream-rest ,stream)))))))
 332
 333 (cl-defmethod seq-copy ((stream stream))
 334   "Return a shallow copy of STREAM."
 335   (stream-delay stream))
 336 \f
 337
 338 ;;; More stream operations
 339
 340 (defun stream-scan (function init stream)
 341   "Return a stream of successive reduced values for STREAM.
 342
 343 If the elements of a stream s are s_1, s_2, ..., the elements
 344 S_1, S_2, ... of the stream returned by \(stream-scan f init s\)
 345 are defined recursively by
 346
 347   S_1     = init
 348   S_(n+1) = (funcall f S_n s_n)
 349
 350 as long as s_n exists.
 351
 352 Example:
 353
 354    (stream-scan #'* 1 (stream-range 1))
 355
 356 returns a stream of the factorials."
 357   (let ((res init))
 358     (stream-cons
 359      res
 360      (seq-map (lambda (el) (setq res (funcall function res el)))
 361               stream))))
 362
 363 (defun stream-flush (stream)
 364   "Request all elements from STREAM in order for side effects only."
 365   (while (not (stream-empty-p stream))
 366     (cl-callf stream-rest stream)))
 367
 368 (defun stream-iterate-function (function value)
 369   "Return a stream of repeated applications of FUNCTION to VALUE.
 370 The returned stream starts with VALUE.  Any successive element
 371 will be found by calling FUNCTION on the preceding element."
 372   (stream-cons
 373    value
 374    (stream-iterate-function function (funcall function value))))
 375
 376 (defun stream-concatenate (stream-of-streams)
 377   "Concatenate all streams in STREAM-OF-STREAMS and return the result.
 378 All elements in STREAM-OF-STREAMS must be streams.  The result is
 379 a stream."
 380   (seq-reduce #'stream-append stream-of-streams (stream-empty)))
 381
 382 (defun stream-of-directory-files-1 (directory &optional nosort recurse follow-links)
 383   "Helper for `stream-of-directory-files'."
 384   (stream-delay
 385    (if (file-accessible-directory-p directory)
 386        (let (files dirs (reverse-fun (if nosort #'identity #'nreverse)))
 387          (dolist (file (directory-files directory t nil nosort))
 388            (let ((is-dir (file-directory-p file)))
 389              (unless (and is-dir
 390                           (member (file-name-nondirectory (directory-file-name file))
 391                                   '("." "..")))
 392                (push file files)
 393                (when (and is-dir
 394                           (or follow-links (not (file-symlink-p file)))
 395                           (if (functionp recurse) (funcall recurse file) recurse))
 396                  (push file dirs)))))
 397          (apply #'stream-append
 398                 (stream (funcall reverse-fun files))
 399                 (mapcar
 400                  (lambda (dir) (stream-of-directory-files-1 dir nosort recurse follow-links))
 401                  (funcall reverse-fun dirs))))
 402      (stream-empty))))
 403
 404 (defun stream-of-directory-files (directory &optional full nosort recurse follow-links filter)
 405   "Return a stream of names of files in DIRECTORY.
 406 Call `directory-files' to list file names in DIRECTORY and make
 407 the result a stream.  Don't include files named \".\" or \"..\".
 408 The arguments FULL and NOSORT are directly passed to
 409 `directory-files'.
 410
 411 Third optional argument RECURSE non-nil means recurse on
 412 subdirectories.  If RECURSE is a function, it should be a
 413 predicate accepting one argument, an absolute file name of a
 414 directory, and return non-nil when the returned stream should
 415 recurse into that directory.  Any other non-nil value means
 416 recurse into every readable subdirectory.
 417
 418 Even with recurse non-nil, don't descent into directories by
 419 following symlinks unless FOLLOW-LINKS is non-nil.
 420
 421 If FILTER is non-nil, it should be a predicate accepting one
 422 argument, an absolute file name.  It is used to limit the
 423 resulting stream to the files fulfilling this predicate."
 424   (let* ((stream (stream-of-directory-files-1 directory nosort recurse follow-links))
 425          (filtered-stream (if filter (seq-filter filter stream) stream)))
 426     (if full filtered-stream
 427       (seq-map (lambda (file) (file-relative-name file directory)) filtered-stream))))
 428
 429 (provide 'stream)
 430 ;;; stream.el ends here