Creates a procedure that returns a stream, and may appear anywhere a
normal define
may appear, including as an internal definition.
It may contain internal definitions of its own. The defined procedure
takes arguments in the same way as stream-lambda
.
define-stream
is syntactic sugar on stream-lambda
; see
also stream-let
, which is also a sugaring of
stream-lambda
.
A simple version of stream-map
that takes only a single input
stream calls itself recursively:
(define-stream (stream-map proc strm) (if (stream-null? strm) stream-null (stream-cons (proc (stream-car strm)) (stream-map proc (stream-cdr strm))))))
Returns a newly-allocated stream containing the elements from list.
Returns a newly-allocated stream containing in its elements the
characters on the port. If port is not given it defaults to the
current input port. The returned stream has finite length and is
terminated by stream-null
.
It looks like one use of port->stream
would be this:
(define s ;wrong! (with-input-from-file filename (lambda () (port->stream))))
But that fails, because with-input-from-file
is eager, and closes
the input port prematurely, before the first character is read. To read
a file into a stream, say:
(define-stream (file->stream filename) (let ((p (open-input-file filename))) (stream-let loop ((c (read-char p))) (if (eof-object? c) (begin (close-input-port p) stream-null) (stream-cons c (loop (read-char p)))))))
Creates a newly-allocated stream containing in its elements the objects,
in order. The object-exprs are evaluated when they are accessed,
not when the stream is created. If no objects are given, as in
(stream), the null stream is returned. See also list->stream
.
(define strm123 (stream 1 2 3)) ; (/ 1 0) not evaluated when stream is created (define s (stream 1 (/ 1 0) -1))
Returns a newly-allocated list containing in its elements the first
n items in stream. If stream has less than n
items, all the items in the stream will be included in the returned
list. If n is not given it defaults to infinity, which means that
unless stream is finite stream->list
will never return.
(stream->list 10 (stream-map (lambda (x) (* x x)) (stream-from 0))) ⇒ (0 1 4 9 16 25 36 49 64 81)
Returns a newly-allocated stream containing in its elements those
elements contained in its input streams, in order of input. If
any of the input streams is infinite, no elements of any of the
succeeding input streams will appear in the output stream. See also
stream-concat
.
Takes a stream consisting of one or more streams and returns a
newly-allocated stream containing all the elements of the input streams.
If any of the streams in the input stream is infinite, any
remaining streams in the input stream will never appear in the output
stream. See also stream-append
.
Returns a newly-allocated stream containing in its elements the objects, repeating in succession forever.
(stream-constant 1) ⇒ 1 1 1 ... (stream-constant #t #f) ⇒ #t #f #t #f #t #f ...
Returns the suffix of the input stream that starts at the next
element after the first n elements. The output stream shares
structure with the input stream; thus, promises forced in one
instance of the stream are also forced in the other instance of the
stream. If the input stream has less than n elements,
stream-drop
returns the null stream. See also
stream-take
.
Returns the suffix of the input stream that starts at the first
element x for which (pred x)
returns false. The output
stream shares structure with the input stream. See also
stream-take-while
.
Returns a newly-allocated stream that contains only those elements
x of the input stream which satisfy the predicate
pred
.
(stream-filter odd? (stream-from 0)) ⇒ 1 3 5 7 9 ...
Applies a binary procedure proc to base and the first
element of stream to compute a new base, then applies the
procedure to the new base and the next element of stream to
compute a succeeding base, and so on, accumulating a value that is
finally returned as the value of stream-fold
when the end of the
stream is reached. stream must be finite, or stream-fold
will enter an infinite loop. See also stream-scan
, which is
similar to stream-fold
, but useful for infinite streams. For
readers familiar with other functional languages, this is a left-fold;
there is no corresponding right-fold, since right-fold relies on finite
streams that are fully-evaluated, in which case they may as well be
converted to a list.
Applies proc element-wise to corresponding elements of the input
streams for side-effects; it returns nothing.
stream-for-each
stops as soon as any of its input streams is
exhausted.
Creates a newly-allocated stream that contains first as its first
element and increments each succeeding element by step. If
step is not given it defaults to 1. first and step
may be of any numeric type. stream-from
is frequently useful as
a generator in stream-of
expressions. See also
stream-range
for a similar procedure that creates finite streams.
Creates a newly-allocated stream containing base in its first
element and applies proc to each element in turn to determine the
succeeding element. See also stream-unfold
and
stream-unfolds
.
Returns the number of elements in the stream; it does not evaluate
its elements. stream-length
may only be used on finite streams;
it enters an infinite loop with infinite streams.
Creates a local scope that binds each variable to the value of its
corresponding expression. It additionally binds tag to a
procedure which takes the bound variables as arguments and body as
its defining expressions, binding the tag with
stream-lambda
. tag is in scope within body, and may be
called recursively. When the expanded expression defined by the
stream-let
is evaluated, stream-let
evaluates the
expressions in its body in an environment containing the
newly-bound variables, returning the value of the last expression
evaluated, which must yield a stream.
stream-let
provides syntactic sugar on stream-lambda
, in
the same manner as normal let
provides syntactic sugar on normal
lambda
. However, unlike normal let
, the tag is
required, not optional, because unnamed stream-let
is
meaningless.
For example, stream-member
returns the first stream-pair
of the input strm with a stream-car
x that satisfies
(eql? obj x)
, or the null stream if x is not present in
strm.
(define-stream (stream-member eql? obj strm) (stream-let loop ((strm strm)) (cond ((stream-null? strm) strm) ((eql? obj (stream-car strm)) strm) (else (loop (stream-cdr strm))))))
Applies proc element-wise to corresponding elements of the input streams, returning a newly-allocated stream containing elements that are the results of those procedure applications. The output stream has as many elements as the minimum-length input stream, and may be infinite.
Provides pattern-matching for streams. The input stream is an
expression that evaluates to a stream. Clauses are of the form
(pattern [fender] expression)
, consisting of a pattern that
matches a stream of a particular shape, an optional fender that
must succeed if the pattern is to match, and an expression that is
evaluated if the pattern matches. There are four types of patterns:
.
pat-rest) matches an
infinite stream, or a finite stream with length at least as great as the
number of pattern elements before the literal dot.
Each pattern element may be either:
_
), which matches any stream element but
creates no bindings.
The patterns are tested in order, left-to-right, until a matching pattern is found; if fender is present, it must evaluate to a true value for the match to be successful. Pattern variables are bound in the corresponding fender and expression. Once the matching pattern is found, the corresponding expression is evaluated and returned as the result of the match. An error is signaled if no pattern matches the input stream.
stream-match
is often used to distinguish null streams from
non-null streams, binding head and tail:
(define (len strm) (stream-match strm (() 0) ((head . tail) (+ 1 (len tail)))))
Fenders can test the common case where two stream elements must be
identical; the else
pattern is an identifier bound to the entire
stream, not a keyword as in cond
.
(stream-match strm ((x y . _) (equal? x y) 'ok) (else 'error))
A more complex example uses two nested matchers to match two different
stream arguments; (stream-merge lt? . strms)
stably merges two or
more streams ordered by the lt?
predicate:
(define-stream (stream-merge lt? . strms) (define-stream (merge xx yy) (stream-match xx (() yy) ((x . xs) (stream-match yy (() xx) ((y . ys) (if (lt? y x) (stream-cons y (merge xx ys)) (stream-cons x (merge xs yy)))))))) (stream-let loop ((strms strms)) (cond ((null? strms) stream-null) ((null? (cdr strms)) (car strms)) (else (merge (car strms) (apply stream-merge lt? (cdr strms)))))))
Provides the syntax of stream comprehensions, which generate streams by means of looping expressions. The result is a stream of objects of the type returned by expr. There are four types of clauses:
in
stream-expr) loops over the elements of
stream-expr, in order from the start of the stream, binding each
element of the stream in turn to var. stream-from
and
stream-range
are frequently useful as generators for
stream-expr.
is
expr) binds var to the value obtained
by evaluating expr.
The scope of variables bound in the stream comprehension is the clauses to the right of the binding clause (but not the binding clause itself) plus the result expression.
When two or more generators are present, the loops are processed as if they are nested from left to right; that is, the rightmost generator varies fastest. A consequence of this is that only the first generator may be infinite and all subsequent generators must be finite. If no generators are present, the result of a stream comprehension is a stream containing the result expression; thus, ‘(stream-of 1)’ produces a finite stream containing only the element 1.
(stream-of (* x x) (x in (stream-range 0 10)) (even? x)) ⇒ 0 4 16 36 64 (stream-of (list a b) (a in (stream-range 1 4)) (b in (stream-range 1 3))) ⇒ (1 1) (1 2) (2 1) (2 2) (3 1) (3 2) (stream-of (list i j) (i in (stream-range 1 5)) (j in (stream-range (+ i 1) 5))) ⇒ (1 2) (1 3) (1 4) (2 3) (2 4) (3 4)
Creates a newly-allocated stream that contains first as its first
element and increments each succeeding element by step. The
stream is finite and ends before past, which is not an element of
the stream. If step is not given it defaults to 1 if first
is less than past and -1 otherwise. first, past and
step may be of any real numeric type. stream-range
is
frequently useful as a generator in stream-of
expressions. See
also stream-from
for a similar procedure that creates infinite
streams.
(stream-range 0 10) ⇒ 0 1 2 3 4 5 6 7 8 9 (stream-range 0 10 2) ⇒ 0 2 4 6 8
Successive elements of the stream are calculated by adding step to
first, so if any of first, past or step are
inexact, the length of the output stream may differ from
(ceiling (- (/ (- past first) step) 1)
.
Returns the nth element of stream, counting from zero. An error is signaled if n is greater than or equal to the length of stream.
(define (fact n) (stream-ref (stream-scan * 1 (stream-from 1)) n))
Returns a newly-allocated stream containing the elements of the input
stream but in reverse order. stream-reverse
may only be
used with finite streams; it enters an infinite loop with infinite
streams. stream-reverse
does not force evaluation of the
elements of the stream.
Accumulates the partial folds of an input stream into a
newly-allocated output stream. The output stream is the base
followed by (stream-fold proc base (stream-take i stream))
for
each of the first i elements of stream.
(stream-scan + 0 (stream-from 1)) ⇒ (stream 0 1 3 6 10 15 ...) (stream-scan * 1 (stream-from 1)) ⇒ (stream 1 1 2 6 24 120 ...)
Returns a newly-allocated stream containing the first n elements
of the input stream. If the input stream has less than
n elements, so does the output stream. See also
stream-drop
.
Takes a predicate and a stream
and returns a newly-allocated
stream containing those elements x
that form the maximal prefix
of the input stream which satisfy pred. See also
stream-drop-while
.
The fundamental recursive stream constructor. It constructs a stream by
repeatedly applying gen to successive values of base, in the
manner of stream-iterate
, then applying map to each of the
values so generated, appending each of the mapped values to the output
stream as long as (pred? base)
returns a true value. See also
stream-iterate
and stream-unfolds
.
The expression below creates the finite stream ‘0 1 4 9 16 25 36 49 64 81’. Initially the base is 0, which is less than 10, so map squares the base and the mapped value becomes the first element of the output stream. Then gen increments the base by 1, so it becomes 1; this is less than 10, so map squares the new base and 1 becomes the second element of the output stream. And so on, until the base becomes 10, when pred stops the recursion and stream-null ends the output stream.
(stream-unfold (lambda (x) (expt x 2)) ; map (lambda (x) (< x 10)) ; pred? (lambda (x) (+ x 1)) ; gen 0) ; base
Returns n newly-allocated streams containing those elements produced by successive calls to the generator proc, which takes the current seed as its argument and returns n+1 values
(proc seed) ⇒ seed result_0 … result_n-1
where the returned seed is the input seed to the next call to the generator and result_i indicates how to produce the next element of the ith result stream:
#f
: no value produced by this iteration of the generator
proc for the result stream.
It may require multiple calls of proc to produce the next element
of any particular result stream. See also stream-iterate
and
stream-unfold
.
(define (stream-partition pred? strm) (stream-unfolds (lambda (s) (if (stream-null? s) (values s '() '()) (let ((a (stream-car s)) (d (stream-cdr s))) (if (pred? a) (values d (list a) #f) (values d #f (list a)))))) strm)) (call-with-values (lambda () (stream-partition odd? (stream-range 1 6))) (lambda (odds evens) (list (stream->list odds) (stream->list evens)))) ⇒ ((1 3 5) (2 4))
Returns a newly-allocated stream in which each element is a list (not a stream) of the corresponding elements of the input streams. The output stream is as long as the shortest input stream, if any of the input streams is finite, or is infinite if all the input streams are infinite.