[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-243-g80b80
|
From: |
Mark H Weaver |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-243-g80b809f |
|
Date: |
Wed, 27 Mar 2013 17:39:09 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=80b809f114e9f3978aa6571affd343f34732fb94
The branch, stable-2.0 has been updated
via 80b809f114e9f3978aa6571affd343f34732fb94 (commit)
via 50d08cd8943dd54762d76746d5eec53af178eeae (commit)
from ed4aa26489d33c22bcdbce2bb037a87df41bef16 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 80b809f114e9f3978aa6571affd343f34732fb94
Author: Mark H Weaver <address@hidden>
Date: Tue Mar 26 21:03:42 2013 -0400
Add full documentation for SRFI-41.
* doc/ref/misc-modules.texi (Streams): Add cross-reference to SRFI-41.
* doc/ref/srfi-modules.texi (SRFI-41): Replace stub with full
documentation.
(SRFI-41 Stream Fundamentals, SRFI-41 Stream Primitives,
SRFI-41 Stream Library): New subsubsections.
commit 50d08cd8943dd54762d76746d5eec53af178eeae
Author: Chris K. Jester-Young <address@hidden>
Date: Tue Mar 26 22:15:31 2013 -0400
Add SRFI-41.
Incorporates suggestions from Mark H Weaver <address@hidden>
and Ian Price <address@hidden>.
* module/srfi/srfi-41.scm: New file.
* module/Makefile.am (SRFI_SOURCES): Add srfi/srfi-41.scm.
* test-suite/tests/srfi-41.test: New file.
* test-suite/Makefile.am (SCM_TESTS): Add tests/srfi-41.test.
* doc/ref/srfi-modules.texi (SRFI Support): Add SRFI-41.
(SRFI-41): New node which refers the reader to
<http://srfi.schemers.org/srfi-41/srfi-41.html>.
-----------------------------------------------------------------------
Summary of changes:
doc/ref/misc-modules.texi | 3 +
doc/ref/srfi-modules.texi | 707 +++++++++++++++++++++++++++++++++++++++++
module/Makefile.am | 1 +
module/srfi/srfi-41.scm | 482 ++++++++++++++++++++++++++++
test-suite/Makefile.am | 1 +
test-suite/tests/srfi-41.test | 680 +++++++++++++++++++++++++++++++++++++++
6 files changed, 1874 insertions(+), 0 deletions(-)
create mode 100644 module/srfi/srfi-41.scm
create mode 100644 test-suite/tests/srfi-41.test
diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi
index cf1e0e4..c1e65d7 100644
--- a/doc/ref/misc-modules.texi
+++ b/doc/ref/misc-modules.texi
@@ -1573,6 +1573,9 @@ modifies the queue @var{list} then it must either maintain
@section Streams
@cindex streams
+This section documents Guile's legacy stream module. For a more
+complete and portable stream library, @pxref{SRFI-41}.
+
A stream represents a sequence of values, each of which is calculated
only when required. This allows large or even infinite sequences to
be represented and manipulated with familiar operations like ``car'',
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 513bb59..5b02aec 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -45,6 +45,7 @@ get the relevant SRFI documents from the SRFI home page
* SRFI-37:: args-fold program argument processor
* SRFI-38:: External Representation for Data With Shared
Structure
* SRFI-39:: Parameter objects
+* SRFI-41:: Streams.
* SRFI-42:: Eager comprehensions
* SRFI-45:: Primitives for expressing iterative lazy
algorithms
* SRFI-55:: Requiring Features.
@@ -3788,6 +3789,712 @@ scope and the result from that @var{thunk} is the
return from
@code{with-parameters*}.
@end defun
address@hidden SRFI-41
address@hidden SRFI-41 - Streams
address@hidden SRFI-41
+
+This subsection is based on the
address@hidden://srfi.schemers.org/srfi-41/srfi-41.html, specification of
+SRFI-41} by Philip L.@: Bewig.
+
address@hidden The copyright notice and license text of the SRFI-41
specification is
address@hidden reproduced below:
+
address@hidden Copyright (C) Philip L. Bewig (2007). All Rights Reserved.
+
address@hidden Permission is hereby granted, free of charge, to any person
obtaining a
address@hidden copy of this software and associated documentation files (the
address@hidden "Software"), to deal in the Software without restriction,
including
address@hidden without limitation the rights to use, copy, modify, merge,
publish,
address@hidden distribute, sublicense, and/or sell copies of the Software, and
to
address@hidden permit persons to whom the Software is furnished to do so,
subject to
address@hidden the following conditions:
+
address@hidden The above copyright notice and this permission notice shall be
included
address@hidden in all copies or substantial portions of the Software.
+
address@hidden THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS
address@hidden OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
address@hidden MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
address@hidden NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
HOLDERS BE
address@hidden LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
ACTION
address@hidden OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION
address@hidden WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
address@hidden
+This SRFI implements streams, sometimes called lazy lists, a sequential
+data structure containing elements computed only on demand. A stream is
+either null or is a pair with a stream in its cdr. Since elements of a
+stream are computed only when accessed, streams can be infinite. Once
+computed, the value of a stream element is cached in case it is needed
+again. SRFI-41 can be made available with:
+
address@hidden
+(use-modules (srfi srfi-41))
address@hidden example
+
address@hidden
+* SRFI-41 Stream Fundamentals::
+* SRFI-41 Stream Primitives::
+* SRFI-41 Stream Library::
address@hidden menu
+
address@hidden SRFI-41 Stream Fundamentals
address@hidden SRFI-41 Stream Fundamentals
+
+SRFI-41 Streams are based on two mutually-recursive abstract data types:
+An object of the @code{stream} abstract data type is a promise that,
+when forced, is either @code{stream-null} or is an object of type
address@hidden An object of the @code{stream-pair} abstract data
+type contains a @code{stream-car} and a @code{stream-cdr}, which must be
+a @code{stream}. The essential feature of streams is the systematic
+suspensions of the recursive promises between the two data types.
+
+The object stored in the @code{stream-car} of a @code{stream-pair} is a
+promise that is forced the first time the @code{stream-car} is accessed;
+its value is cached in case it is needed again. The object may have any
+type, and different stream elements may have different types. If the
address@hidden is never accessed, the object stored there is never
+evaluated. Likewise, the @code{stream-cdr} is a promise to return a
+stream, and is only forced on demand.
+
address@hidden SRFI-41 Stream Primitives
address@hidden SRFI-41 Stream Primitives
+
+This library provides eight operators: constructors for
address@hidden and @code{stream-pair}s, type predicates for streams
+and the two kinds of streams, accessors for both fields of a
address@hidden, and a lambda that creates procedures that return
+streams.
+
address@hidden {Constant} stream-null
+A promise that, when forced, is a single object, distinguishable from
+all other objects, that represents the null stream. @code{stream-null}
+is immutable and unique.
address@hidden deffn
+
address@hidden {Scheme Syntax} stream-cons object-expr stream-expr
+Creates a newly-allocated stream containing a promise that, when forced,
+is a @code{stream-pair} with @var{object-expr} in its @code{stream-car}
+and @var{stream-expr} in its @code{stream-cdr}. Neither
address@hidden nor @var{stream-expr} is evaluated when
address@hidden is called.
+
+Once created, a @code{stream-pair} is immutable; there is no
address@hidden or @code{stream-set-cdr!} that modifies an
+existing stream-pair. There is no dotted-pair or improper stream as
+with lists.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream? object
+Returns true if @var{object} is a stream, otherwise returns false. If
address@hidden is a stream, its promise will not be forced. If
address@hidden(stream? obj)} returns true, then one of @code{(stream-null? obj)}
+or @code{(stream-pair? obj)} will return true and the other will return
+false.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-null? object
+Returns true if @var{object} is the distinguished null stream, otherwise
+returns false. If @var{object} is a stream, its promise will be forced.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-pair? object
+Returns true if @var{object} is a @code{stream-pair} constructed by
address@hidden, otherwise returns false. If @var{object} is a
+stream, its promise will be forced.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-car stream
+Returns the object stored in the @code{stream-car} of @var{stream}. An
+error is signalled if the argument is not a @code{stream-pair}. This
+causes the @var{object-expr} passed to @code{stream-cons} to be
+evaluated if it had not yet been; the value is cached in case it is
+needed again.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-cdr stream
+Returns the stream stored in the @code{stream-cdr} of @var{stream}. An
+error is signalled if the argument is not a @code{stream-pair}.
address@hidden deffn
+
address@hidden {Scheme Syntax} stream-lambda formals body @dots{}
+Creates a procedure that returns a promise to evaluate the @var{body} of
+the procedure. The last @var{body} expression to be evaluated must
+yield a stream. As with normal @code{lambda}, @var{formals} may be a
+single variable name, in which case all the formal arguments are
+collected into a single list, or a list of variable names, which may be
+null if there are no arguments, proper if there are an exact number of
+arguments, or dotted if a fixed number of arguments is to be followed by
+zero or more arguments collected into a list. @var{Body} must contain
+at least one expression, and may contain internal definitions preceding
+any expressions to be evaluated.
address@hidden deffn
+
address@hidden
+(define strm123
+ (stream-cons 1
+ (stream-cons 2
+ (stream-cons 3
+ stream-null))))
+
+(stream-car strm123) @result{} 1
+(stream-car (stream-cdr strm123) @result{} 2
+
+(stream-pair?
+ (stream-cdr
+ (stream-cons (/ 1 0) stream-null))) @result{} #f
+
+(stream? (list 1 2 3)) @result{} #f
+
+(define iter
+ (stream-lambda (f x)
+ (stream-cons x (iter f (f x)))))
+
+(define nats (iter (lambda (x) (+ x 1)) 0))
+
+(stream-car (stream-cdr nats)) @result{} 1
+
+(define stream-add
+ (stream-lambda (s1 s2)
+ (stream-cons
+ (+ (stream-car s1) (stream-car s2))
+ (stream-add (stream-cdr s1)
+ (stream-cdr s2)))))
+
+(define evens (stream-add nats nats))
+
+(stream-car evens) @result{} 0
+(stream-car (stream-cdr evens)) @result{} 2
+(stream-car (stream-cdr (stream-cdr evens))) @result{} 4
address@hidden example
+
address@hidden SRFI-41 Stream Library
address@hidden SRFI-41 Stream Library
+
address@hidden {Scheme Syntax} define-stream (name args @dots{}) body @dots{}
+Creates a procedure that returns a stream, and may appear anywhere a
+normal @code{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 @code{stream-lambda}.
address@hidden is syntactic sugar on @code{stream-lambda}; see
+also @code{stream-let}, which is also a sugaring of
address@hidden
+
+A simple version of @code{stream-map} that takes only a single input
+stream calls itself recursively:
+
address@hidden
+(define-stream (stream-map proc strm)
+ (if (stream-null? strm)
+ stream-null
+ (stream-cons
+ (proc (stream-car strm))
+ (stream-map proc (stream-cdr strm))))))
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} list->stream list
+Returns a newly-allocated stream containing the elements from
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} port->stream [port]
+Returns a newly-allocated stream containing in its elements the
+characters on the port. If @var{port} is not given it defaults to the
+current input port. The returned stream has finite length and is
+terminated by @code{stream-null}.
+
+It looks like one use of @code{port->stream} would be this:
+
address@hidden
+(define s ;wrong!
+ (with-input-from-file filename
+ (lambda () (port->stream))))
address@hidden example
+
+But that fails, because @code{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:
+
address@hidden
+(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)))))))
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Syntax} stream object-expr @dots{}
+Creates a newly-allocated stream containing in its elements the objects,
+in order. The @var{object-expr}s 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 @code{list->stream}.
+
address@hidden
+(define strm123 (stream 1 2 3))
+
+; (/ 1 0) not evaluated when stream is created
+(define s (stream 1 (/ 1 0) -1))
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream->list [n] stream
+Returns a newly-allocated list containing in its elements the first
address@hidden items in @var{stream}. If @var{stream} has less than @var{n}
+items, all the items in the stream will be included in the returned
+list. If @var{n} is not given it defaults to infinity, which means that
+unless @var{stream} is finite @code{stream->list} will never return.
+
address@hidden
+(stream->list 10
+ (stream-map (lambda (x) (* x x))
+ (stream-from 0)))
+ @result{} (0 1 4 9 16 25 36 49 64 81)
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-append stream @dots{}
+Returns a newly-allocated stream containing in its elements those
+elements contained in its input @var{stream}s, 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
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-concat stream
+Takes a @var{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 @var{stream} is infinite, any
+remaining streams in the input stream will never appear in the output
+stream. See also @code{stream-append}.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-constant object @dots{}
+Returns a newly-allocated stream containing in its elements the
address@hidden, repeating in succession forever.
+
address@hidden
+(stream-constant 1) @result{} 1 1 1 @dots{}
+(stream-constant #t #f) @result{} #t #f #t #f #t #f @dots{}
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-drop n stream
+Returns the suffix of the input @var{stream} that starts at the next
+element after the first @var{n} elements. The output stream shares
+structure with the input @var{stream}; thus, promises forced in one
+instance of the stream are also forced in the other instance of the
+stream. If the input @var{stream} has less than @var{n} elements,
address@hidden returns the null stream. See also
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-drop-while pred stream
+Returns the suffix of the input @var{stream} that starts at the first
+element @var{x} for which @code{(pred x)} returns false. The output
+stream shares structure with the input @var{stream}. See also
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-filter pred stream
+Returns a newly-allocated stream that contains only those elements
address@hidden of the input @var{stream} which satisfy the predicate
address@hidden
+
address@hidden
+(stream-filter odd? (stream-from 0))
+ @result{} 1 3 5 7 9 @dots{}
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-fold proc base stream
+Applies a binary procedure @var{proc} to @var{base} and the first
+element of @var{stream} to compute a new @var{base}, then applies the
+procedure to the new @var{base} and the next element of @var{stream} to
+compute a succeeding @var{base}, and so on, accumulating a value that is
+finally returned as the value of @code{stream-fold} when the end of the
+stream is reached. @var{stream} must be finite, or @code{stream-fold}
+will enter an infinite loop. See also @code{stream-scan}, which is
+similar to @code{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.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-for-each proc stream @dots{}
+Applies @var{proc} element-wise to corresponding elements of the input
address@hidden for side-effects; it returns nothing.
address@hidden stops as soon as any of its input streams is
+exhausted.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-from first [step]
+Creates a newly-allocated stream that contains @var{first} as its first
+element and increments each succeeding element by @var{step}. If
address@hidden is not given it defaults to 1. @var{first} and @var{step}
+may be of any numeric type. @code{stream-from} is frequently useful as
+a generator in @code{stream-of} expressions. See also
address@hidden for a similar procedure that creates finite streams.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-iterate proc base
+Creates a newly-allocated stream containing @var{base} in its first
+element and applies @var{proc} to each element in turn to determine the
+succeeding element. See also @code{stream-unfold} and
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-length stream
+Returns the number of elements in the @var{stream}; it does not evaluate
+its elements. @code{stream-length} may only be used on finite streams;
+it enters an infinite loop with infinite streams.
address@hidden deffn
+
address@hidden {Scheme Syntax} stream-let tag ((var expr) @dots{}) body @dots{}
+Creates a local scope that binds each variable to the value of its
+corresponding expression. It additionally binds @var{tag} to a
+procedure which takes the bound variables as arguments and @var{body} as
+its defining expressions, binding the @var{tag} with
address@hidden @var{tag} is in scope within body, and may be
+called recursively. When the expanded expression defined by the
address@hidden is evaluated, @code{stream-let} evaluates the
+expressions in its @var{body} in an environment containing the
+newly-bound variables, returning the value of the last expression
+evaluated, which must yield a stream.
+
address@hidden provides syntactic sugar on @code{stream-lambda}, in
+the same manner as normal @code{let} provides syntactic sugar on normal
address@hidden However, unlike normal @code{let}, the @var{tag} is
+required, not optional, because unnamed @code{stream-let} is
+meaningless.
+
+For example, @code{stream-member} returns the first @code{stream-pair}
+of the input @var{strm} with a @code{stream-car} @var{x} that satisfies
address@hidden(eql? obj x)}, or the null stream if @var{x} is not present in
address@hidden
+
address@hidden
+(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))))))
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-map proc stream @dots{}
+Applies @var{proc} element-wise to corresponding elements of the input
address@hidden, 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.
address@hidden deffn
+
address@hidden {Scheme Syntax} stream-match stream clause @dots{}
+Provides pattern-matching for streams. The input @var{stream} is an
+expression that evaluates to a stream. Clauses are of the form
address@hidden(pattern [fender] expression)}, consisting of a @var{pattern} that
+matches a stream of a particular shape, an optional @var{fender} that
+must succeed if the pattern is to match, and an @var{expression} that is
+evaluated if the pattern matches. There are four types of patterns:
+
address@hidden @bullet
address@hidden
+() matches the null stream.
+
address@hidden
+(@var{pat0} @var{pat1} @dots{}) matches a finite stream with length
+exactly equal to the number of pattern elements.
+
address@hidden
+(@var{pat0} @var{pat1} @dots{} @code{.} @var{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.
+
address@hidden
address@hidden matches an entire stream. Should always appear last in the
+list of clauses; it's not an error to appear elsewhere, but subsequent
+clauses could never match.
address@hidden itemize
+
+Each pattern element may be either:
+
address@hidden @bullet
address@hidden
+An identifier, which matches any stream element. Additionally, the
+value of the stream element is bound to the variable named by the
+identifier, which is in scope in the @var{fender} and @var{expression}
+of the corresponding @var{clause}. Each identifier in a single pattern
+must be unique.
+
address@hidden
+A literal underscore (@code{_}), which matches any stream element but
+creates no bindings.
address@hidden itemize
+
+The @var{pattern}s are tested in order, left-to-right, until a matching
+pattern is found; if @var{fender} is present, it must evaluate to a true
+value for the match to be successful. Pattern variables are bound in
+the corresponding @var{fender} and @var{expression}. Once the matching
address@hidden is found, the corresponding @var{expression} is evaluated
+and returned as the result of the match. An error is signaled if no
+pattern matches the input @var{stream}.
+
address@hidden is often used to distinguish null streams from
+non-null streams, binding @var{head} and @var{tail}:
+
address@hidden
+(define (len strm)
+ (stream-match strm
+ (() 0)
+ ((head . tail) (+ 1 (len tail)))))
address@hidden example
+
+Fenders can test the common case where two stream elements must be
+identical; the @code{else} pattern is an identifier bound to the entire
+stream, not a keyword as in @code{cond}.
+
address@hidden
+(stream-match strm
+ ((x y . _) (equal? x y) 'ok)
+ (else 'error))
address@hidden example
+
+A more complex example uses two nested matchers to match two different
+stream arguments; @code{(stream-merge lt? . strms)} stably merges two or
+more streams ordered by the @code{lt?} predicate:
+
address@hidden
+(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)))))))
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Syntax} stream-of expr clause @dots{}
+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 @var{expr}. There are four types of clauses:
+
address@hidden @bullet
address@hidden
+(@var{var} @code{in} @var{stream-expr}) loops over the elements of
address@hidden, in order from the start of the stream, binding each
+element of the stream in turn to @var{var}. @code{stream-from} and
address@hidden are frequently useful as generators for
address@hidden
+
address@hidden
+(@var{var} @code{is} @var{expr}) binds @var{var} to the value obtained
+by evaluating @var{expr}.
+
address@hidden
+(@var{pred} @var{expr}) includes in the output stream only those
+elements @var{x} which satisfy the predicate @var{pred}.
address@hidden itemize
+
+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, @samp{(stream-of 1)} produces a
+finite stream containing only the element 1.
+
address@hidden
+(stream-of (* x x)
+ (x in (stream-range 0 10))
+ (even? x))
+ @result{} 0 4 16 36 64
+
+(stream-of (list a b)
+ (a in (stream-range 1 4))
+ (b in (stream-range 1 3)))
+ @result{} (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)))
+ @result{} (1 2) (1 3) (1 4) (2 3) (2 4) (3 4)
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-range first past [step]
+Creates a newly-allocated stream that contains @var{first} as its first
+element and increments each succeeding element by @var{step}. The
+stream is finite and ends before @var{past}, which is not an element of
+the stream. If @var{step} is not given it defaults to 1 if @var{first}
+is less than past and -1 otherwise. @var{first}, @var{past} and
address@hidden may be of any real numeric type. @code{stream-range} is
+frequently useful as a generator in @code{stream-of} expressions. See
+also @code{stream-from} for a similar procedure that creates infinite
+streams.
+
address@hidden
+(stream-range 0 10) @result{} 0 1 2 3 4 5 6 7 8 9
+(stream-range 0 10 2) @result{} 0 2 4 6 8
address@hidden example
+
+Successive elements of the stream are calculated by adding @var{step} to
address@hidden, so if any of @var{first}, @var{past} or @var{step} are
+inexact, the length of the output stream may differ from
address@hidden(ceiling (- (/ (- past first) step) 1)}.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-ref stream n
+Returns the @var{n}th element of stream, counting from zero. An error
+is signaled if @var{n} is greater than or equal to the length of stream.
+
address@hidden
+(define (fact n)
+ (stream-ref
+ (stream-scan * 1 (stream-from 1))
+ n))
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-reverse stream
+Returns a newly-allocated stream containing the elements of the input
address@hidden but in reverse order. @code{stream-reverse} may only be
+used with finite streams; it enters an infinite loop with infinite
+streams. @code{stream-reverse} does not force evaluation of the
+elements of the stream.
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-scan proc base stream
+Accumulates the partial folds of an input @var{stream} into a
+newly-allocated output stream. The output stream is the @var{base}
+followed by @code{(stream-fold proc base (stream-take i stream))} for
+each of the first @var{i} elements of @var{stream}.
+
address@hidden
+(stream-scan + 0 (stream-from 1))
+ @result{} (stream 0 1 3 6 10 15 @dots{})
+
+(stream-scan * 1 (stream-from 1))
+ @result{} (stream 1 1 2 6 24 120 @dots{})
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-take n stream
+Returns a newly-allocated stream containing the first @var{n} elements
+of the input @var{stream}. If the input @var{stream} has less than
address@hidden elements, so does the output stream. See also
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-take-while pred stream
+Takes a predicate and a @code{stream} and returns a newly-allocated
+stream containing those elements @code{x} that form the maximal prefix
+of the input stream which satisfy @var{pred}. See also
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-unfold map pred gen base
+The fundamental recursive stream constructor. It constructs a stream by
+repeatedly applying @var{gen} to successive values of @var{base}, in the
+manner of @code{stream-iterate}, then applying @var{map} to each of the
+values so generated, appending each of the mapped values to the output
+stream as long as @code{(pred? base)} returns a true value. See also
address@hidden and @code{stream-unfolds}.
+
+The expression below creates the finite stream @samp{0 1 4 9 16 25 36 49
+64 81}. Initially the @var{base} is 0, which is less than 10, so
address@hidden squares the @var{base} and the mapped value becomes the first
+element of the output stream. Then @var{gen} increments the @var{base}
+by 1, so it becomes 1; this is less than 10, so @var{map} squares the
+new @var{base} and 1 becomes the second element of the output stream.
+And so on, until the base becomes 10, when @var{pred} stops the
+recursion and stream-null ends the output stream.
+
address@hidden
+(stream-unfold
+ (lambda (x) (expt x 2)) ; map
+ (lambda (x) (< x 10)) ; pred?
+ (lambda (x) (+ x 1)) ; gen
+ 0) ; base
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-unfolds proc seed
+Returns @var{n} newly-allocated streams containing those elements
+produced by successive calls to the generator @var{proc}, which takes
+the current @var{seed} as its argument and returns @var{n}+1 values
+
+(@var{proc} @var{seed}) @result{} @var{seed} @var{result_0} @dots{}
@var{result_n-1}
+
+where the returned @var{seed} is the input @var{seed} to the next call
+to the generator and @var{result_i} indicates how to produce the next
+element of the @var{i}th result stream:
+
address@hidden @bullet
address@hidden
+(@var{value}): @var{value} is the next car of the result stream.
+
address@hidden
address@hidden: no value produced by this iteration of the generator
address@hidden for the result stream.
+
address@hidden
+(): the end of the result stream.
address@hidden itemize
+
+It may require multiple calls of @var{proc} to produce the next element
+of any particular result stream. See also @code{stream-iterate} and
address@hidden
+
address@hidden
+(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))))
+ @result{} ((1 3 5) (2 4))
address@hidden example
address@hidden deffn
+
address@hidden {Scheme Procedure} stream-zip stream @dots{}
+Returns a newly-allocated stream in which each element is a list (not a
+stream) of the corresponding elements of the input @var{stream}s. The
+output stream is as long as the shortest input @var{stream}, if any of
+the input @var{stream}s is finite, or is infinite if all the input
address@hidden are infinite.
address@hidden deffn
+
@node SRFI-42
@subsection SRFI-42 - Eager Comprehensions
@cindex SRFI-42
diff --git a/module/Makefile.am b/module/Makefile.am
index c47d0b4..416ad22 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -282,6 +282,7 @@ SRFI_SOURCES = \
srfi/srfi-35.scm \
srfi/srfi-37.scm \
srfi/srfi-38.scm \
+ srfi/srfi-41.scm \
srfi/srfi-42.scm \
srfi/srfi-39.scm \
srfi/srfi-45.scm \
diff --git a/module/srfi/srfi-41.scm b/module/srfi/srfi-41.scm
new file mode 100644
index 0000000..edf95d7
--- /dev/null
+++ b/module/srfi/srfi-41.scm
@@ -0,0 +1,482 @@
+;;; srfi-41.scm -- SRFI 41 streams
+
+;; Copyright (c) 2007 Philip L. Bewig
+;; Copyright (c) 2011, 2012, 2013 Free Software Foundation, Inc.
+
+;; Permission is hereby granted, free of charge, to any person obtaining
+;; a copy of this software and associated documentation files (the
+;; "Software"), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES, OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF, OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+(define-module (srfi srfi-41)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-8)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
+ #:export (stream-null stream-cons stream? stream-null? stream-pair?
+ stream-car stream-cdr stream-lambda define-stream
+ list->stream port->stream stream stream->list stream-append
+ stream-concat stream-constant stream-drop stream-drop-while
+ stream-filter stream-fold stream-for-each stream-from
+ stream-iterate stream-length stream-let stream-map
+ stream-match stream-of stream-range stream-ref stream-reverse
+ stream-scan stream-take stream-take-while stream-unfold
+ stream-unfolds stream-zip))
+
+(cond-expand-provide (current-module) '(srfi-41))
+
+;;; Private supporting functions and macros.
+
+(define-syntax-rule (must pred obj func msg args ...)
+ (let ((item obj))
+ (unless (pred item)
+ (throw 'wrong-type-arg func msg (list args ...) (list item)))))
+
+(define-syntax-rule (must-not pred obj func msg args ...)
+ (let ((item obj))
+ (when (pred item)
+ (throw 'wrong-type-arg func msg (list args ...) (list item)))))
+
+(define-syntax-rule (must-every pred objs func msg args ...)
+ (let ((flunk (remove pred objs)))
+ (unless (null? flunk)
+ (throw 'wrong-type-arg func msg (list args ...) flunk))))
+
+(define-syntax-rule (first-value expr)
+ (receive (first . _) expr
+ first))
+
+(define-syntax-rule (second-value expr)
+ (receive (first second . _) expr
+ second))
+
+(define-syntax-rule (third-value expr)
+ (receive (first second third . _) expr
+ third))
+
+(define-syntax define-syntax*
+ (syntax-rules ()
+ ((_ (name . args) body ...)
+ (define-syntax name (lambda* args body ...)))
+ ((_ name syntax)
+ (define-syntax name syntax))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Here we include a copy of the code of srfi-45.scm (but with renamed
+;; identifiers), in order to create a new promise type that's disjoint
+;; from the promises created by srfi-45. Ideally this should be done
+;; using a 'make-promise-type' macro that instantiates a copy of this
+;; code, but a psyntax bug in Guile 2.0 prevents this from working
+;; properly: <http://bugs.gnu.org/13995>. So for now, we duplicate the
+;; code.
+
+;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003 André van Tonder. All Rights Reserved.
+
+;; Permission is hereby granted, free of charge, to any person
+;; obtaining a copy of this software and associated documentation
+;; files (the "Software"), to deal in the Software without
+;; restriction, including without limitation the rights to use, copy,
+;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;; of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+(define-record-type stream-promise (make-stream-promise val) stream-promise?
+ (val stream-promise-val stream-promise-val-set!))
+
+(define-record-type stream-value (make-stream-value tag proc) stream-value?
+ (tag stream-value-tag stream-value-tag-set!)
+ (proc stream-value-proc stream-value-proc-set!))
+
+(define-syntax-rule (stream-lazy exp)
+ (make-stream-promise (make-stream-value 'lazy (lambda () exp))))
+
+(define (stream-eager x)
+ (make-stream-promise (make-stream-value 'eager x)))
+
+(define-syntax-rule (stream-delay exp)
+ (stream-lazy (stream-eager exp)))
+
+(define (stream-force promise)
+ (let ((content (stream-promise-val promise)))
+ (case (stream-value-tag content)
+ ((eager) (stream-value-proc content))
+ ((lazy) (let* ((promise* ((stream-value-proc content)))
+ (content (stream-promise-val promise)))
+ (if (not (eqv? (stream-value-tag content) 'eager))
+ (begin (stream-value-tag-set! content
+ (stream-value-tag
(stream-promise-val promise*)))
+ (stream-value-proc-set! content
+ (stream-value-proc
(stream-promise-val promise*)))
+ (stream-promise-val-set! promise* content)))
+ (stream-force promise))))))
+
+;;
+;; End of the copy of the code from srfi-45.scm
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Primitive stream functions and macros: (streams primitive)
+
+(define stream? stream-promise?)
+
+(define %stream-null '(stream . null))
+(define stream-null (stream-eager %stream-null))
+
+(define (stream-null? obj)
+ (and (stream-promise? obj)
+ (eqv? (stream-force obj) %stream-null)))
+
+(define-record-type stream-pare (make-stream-pare kar kdr) stream-pare?
+ (kar stream-kar)
+ (kdr stream-kdr))
+
+(define (stream-pair? obj)
+ (and (stream-promise? obj) (stream-pare? (stream-force obj))))
+
+(define-syntax-rule (stream-cons obj strm)
+ (stream-eager (make-stream-pare (stream-delay obj) (stream-lazy strm))))
+
+(define (stream-car strm)
+ (must stream? strm 'stream-car "non-stream")
+ (let ((pare (stream-force strm)))
+ (must stream-pare? pare 'stream-car "null stream")
+ (stream-force (stream-kar pare))))
+
+(define (stream-cdr strm)
+ (must stream? strm 'stream-cdr "non-stream")
+ (let ((pare (stream-force strm)))
+ (must stream-pare? pare 'stream-cdr "null stream")
+ (stream-kdr pare)))
+
+(define-syntax-rule (stream-lambda formals body0 body1 ...)
+ (lambda formals (stream-lazy (begin body0 body1 ...))))
+
+;;; Derived stream functions and macros: (streams derived)
+
+(define-syntax-rule (define-stream (name . formal) body0 body1 ...)
+ (define name (stream-lambda formal body0 body1 ...)))
+
+(define-syntax-rule (stream-let tag ((name val) ...) body1 body2 ...)
+ ((letrec ((tag (stream-lambda (name ...) body1 body2 ...))) tag) val ...))
+
+(define (list->stream objs)
+ (define (list? x)
+ (or (proper-list? x) (circular-list? x)))
+ (must list? objs 'list->stream "non-list argument")
+ (stream-let recur ((objs objs))
+ (if (null? objs) stream-null
+ (stream-cons (car objs) (recur (cdr objs))))))
+
+(define* (port->stream #:optional (port (current-input-port)))
+ (must input-port? port 'port->stream "non-input-port argument")
+ (stream-let recur ()
+ (let ((c (read-char port)))
+ (if (eof-object? c) stream-null
+ (stream-cons c (recur))))))
+
+(define-syntax stream
+ (syntax-rules ()
+ ((_) stream-null)
+ ((_ x y ...) (stream-cons x (stream y ...)))))
+
+;; Common helper for the various eager-folding functions, such as
+;; stream-fold, stream-drop, stream->list, stream-length, etc.
+(define-inlinable (stream-fold-aux proc base strm limit)
+ (do ((val base (and proc (proc val (stream-car strm))))
+ (strm strm (stream-cdr strm))
+ (limit limit (and limit (1- limit))))
+ ((or (and limit (zero? limit)) (stream-null? strm))
+ (values val strm limit))))
+
+(define stream->list
+ (case-lambda
+ ((strm) (stream->list #f strm))
+ ((n strm)
+ (must stream? strm 'stream->list "non-stream argument")
+ (when n
+ (must integer? n 'stream->list "non-integer count")
+ (must exact? n 'stream->list "inexact count")
+ (must-not negative? n 'stream->list "negative count"))
+ (reverse! (first-value (stream-fold-aux xcons '() strm n))))))
+
+(define (stream-append . strms)
+ (must-every stream? strms 'stream-append "non-stream argument")
+ (stream-let recur ((strms strms))
+ (if (null? strms) stream-null
+ (let ((strm (car strms)))
+ (if (stream-null? strm) (recur (cdr strms))
+ (stream-cons (stream-car strm)
+ (recur (cons (stream-cdr strm) (cdr strms)))))))))
+
+(define (stream-concat strms)
+ (must stream? strms 'stream-concat "non-stream argument")
+ (stream-let recur ((strms strms))
+ (if (stream-null? strms) stream-null
+ (let ((strm (stream-car strms)))
+ (must stream? strm 'stream-concat "non-stream object in input
stream")
+ (if (stream-null? strm) (recur (stream-cdr strms))
+ (stream-cons (stream-car strm)
+ (recur (stream-cons (stream-cdr strm)
+ (stream-cdr strms)))))))))
+
+(define stream-constant
+ (case-lambda
+ (() stream-null)
+ (objs (list->stream (apply circular-list objs)))))
+
+(define-syntax* (stream-do x)
+ (define (end x)
+ (syntax-case x ()
+ (() #'(if #f #f))
+ ((result) #'result)
+ ((result ...) #'(begin result ...))))
+ (define (var-step v s)
+ (syntax-case s ()
+ (() v)
+ ((e) #'e)
+ (_ (syntax-violation 'stream-do "bad step expression" x s))))
+
+ (syntax-case x ()
+ ((_ ((var init . step) ...)
+ (test result ...)
+ expr ...)
+ (with-syntax ((result (end #'(result ...)))
+ ((step ...) (map var-step #'(var ...) #'(step ...))))
+ #'(stream-let loop ((var init) ...)
+ (if test result
+ (begin
+ expr ...
+ (loop step ...))))))))
+
+(define (stream-drop n strm)
+ (must integer? n 'stream-drop "non-integer argument")
+ (must exact? n 'stream-drop "inexact argument")
+ (must-not negative? n 'stream-drop "negative argument")
+ (must stream? strm 'stream-drop "non-stream argument")
+ (second-value (stream-fold-aux #f #f strm n)))
+
+(define (stream-drop-while pred? strm)
+ (must procedure? pred? 'stream-drop-while "non-procedural argument")
+ (must stream? strm 'stream-drop-while "non-stream argument")
+ (stream-do ((strm strm (stream-cdr strm)))
+ ((or (stream-null? strm) (not (pred? (stream-car strm)))) strm)))
+
+(define (stream-filter pred? strm)
+ (must procedure? pred? 'stream-filter "non-procedural argument")
+ (must stream? strm 'stream-filter "non-stream argument")
+ (stream-let recur ((strm strm))
+ (cond ((stream-null? strm) stream-null)
+ ((pred? (stream-car strm))
+ (stream-cons (stream-car strm) (recur (stream-cdr strm))))
+ (else (recur (stream-cdr strm))))))
+
+(define (stream-fold proc base strm)
+ (must procedure? proc 'stream-fold "non-procedural argument")
+ (must stream? strm 'stream-fold "non-stream argument")
+ (first-value (stream-fold-aux proc base strm #f)))
+
+(define stream-for-each
+ (case-lambda
+ ((proc strm)
+ (must procedure? proc 'stream-for-each "non-procedural argument")
+ (must stream? strm 'stream-for-each "non-stream argument")
+ (do ((strm strm (stream-cdr strm)))
+ ((stream-null? strm))
+ (proc (stream-car strm))))
+ ((proc strm . rest)
+ (let ((strms (cons strm rest)))
+ (must procedure? proc 'stream-for-each "non-procedural argument")
+ (must-every stream? strms 'stream-for-each "non-stream argument")
+ (do ((strms strms (map stream-cdr strms)))
+ ((any stream-null? strms))
+ (apply proc (map stream-car strms)))))))
+
+(define* (stream-from first #:optional (step 1))
+ (must number? first 'stream-from "non-numeric starting number")
+ (must number? step 'stream-from "non-numeric step size")
+ (stream-let recur ((first first))
+ (stream-cons first (recur (+ first step)))))
+
+(define (stream-iterate proc base)
+ (must procedure? proc 'stream-iterate "non-procedural argument")
+ (stream-let recur ((base base))
+ (stream-cons base (recur (proc base)))))
+
+(define (stream-length strm)
+ (must stream? strm 'stream-length "non-stream argument")
+ (- -1 (third-value (stream-fold-aux #f #f strm -1))))
+
+(define stream-map
+ (case-lambda
+ ((proc strm)
+ (must procedure? proc 'stream-map "non-procedural argument")
+ (must stream? strm 'stream-map "non-stream argument")
+ (stream-let recur ((strm strm))
+ (if (stream-null? strm) stream-null
+ (stream-cons (proc (stream-car strm))
+ (recur (stream-cdr strm))))))
+ ((proc strm . rest)
+ (let ((strms (cons strm rest)))
+ (must procedure? proc 'stream-map "non-procedural argument")
+ (must-every stream? strms 'stream-map "non-stream argument")
+ (stream-let recur ((strms strms))
+ (if (any stream-null? strms) stream-null
+ (stream-cons (apply proc (map stream-car strms))
+ (recur (map stream-cdr strms)))))))))
+
+(define-syntax* (stream-match x)
+ (define (make-matcher x)
+ (syntax-case x ()
+ (() #'(? stream-null?))
+ (rest (identifier? #'rest) #'rest)
+ ((var . rest) (identifier? #'var)
+ (with-syntax ((next (make-matcher #'rest)))
+ #'(? (negate stream-null?)
+ (= stream-car var)
+ (= stream-cdr next))))))
+ (define (make-guarded x fail)
+ (syntax-case (list x fail) ()
+ (((expr) _) #'expr)
+ (((guard expr) fail) #'(if guard expr (fail)))))
+
+ (syntax-case x ()
+ ((_ strm-expr (pat . expr) ...)
+ (with-syntax (((fail ...) (generate-temporaries #'(pat ...))))
+ (with-syntax (((matcher ...) (map make-matcher #'(pat ...)))
+ ((expr ...) (map make-guarded #'(expr ...) #'(fail ...))))
+ #'(let ((strm strm-expr))
+ (must stream? strm 'stream-match "non-stream argument")
+ (match strm (matcher (=> fail) expr) ...)))))))
+
+(define-syntax-rule (stream-of expr rest ...)
+ (stream-of-aux expr stream-null rest ...))
+
+(define-syntax stream-of-aux
+ (syntax-rules (in is)
+ ((_ expr base)
+ (stream-cons expr base))
+ ((_ expr base (var in stream) rest ...)
+ (stream-let recur ((strm stream))
+ (if (stream-null? strm) base
+ (let ((var (stream-car strm)))
+ (stream-of-aux expr (recur (stream-cdr strm)) rest ...)))))
+ ((_ expr base (var is exp) rest ...)
+ (let ((var exp)) (stream-of-aux expr base rest ...)))
+ ((_ expr base pred? rest ...)
+ (if pred? (stream-of-aux expr base rest ...) base))))
+
+(define* (stream-range first past #:optional step)
+ (must number? first 'stream-range "non-numeric starting number")
+ (must number? past 'stream-range "non-numeric ending number")
+ (when step
+ (must number? step 'stream-range "non-numeric step size"))
+ (let* ((step (or step (if (< first past) 1 -1)))
+ (lt? (if (< 0 step) < >)))
+ (stream-let recur ((first first))
+ (if (lt? first past)
+ (stream-cons first (recur (+ first step)))
+ stream-null))))
+
+(define (stream-ref strm n)
+ (must stream? strm 'stream-ref "non-stream argument")
+ (must integer? n 'stream-ref "non-integer argument")
+ (must exact? n 'stream-ref "inexact argument")
+ (must-not negative? n 'stream-ref "negative argument")
+ (let ((res (stream-drop n strm)))
+ (must-not stream-null? res 'stream-ref "beyond end of stream")
+ (stream-car res)))
+
+(define (stream-reverse strm)
+ (must stream? strm 'stream-reverse "non-stream argument")
+ (stream-do ((strm strm (stream-cdr strm))
+ (rev stream-null (stream-cons (stream-car strm) rev)))
+ ((stream-null? strm) rev)))
+
+(define (stream-scan proc base strm)
+ (must procedure? proc 'stream-scan "non-procedural argument")
+ (must stream? strm 'stream-scan "non-stream argument")
+ (stream-let recur ((base base) (strm strm))
+ (if (stream-null? strm) (stream base)
+ (stream-cons base (recur (proc base (stream-car strm))
+ (stream-cdr strm))))))
+
+(define (stream-take n strm)
+ (must stream? strm 'stream-take "non-stream argument")
+ (must integer? n 'stream-take "non-integer argument")
+ (must exact? n 'stream-take "inexact argument")
+ (must-not negative? n 'stream-take "negative argument")
+ (stream-let recur ((n n) (strm strm))
+ (if (or (zero? n) (stream-null? strm)) stream-null
+ (stream-cons (stream-car strm) (recur (1- n) (stream-cdr strm))))))
+
+(define (stream-take-while pred? strm)
+ (must procedure? pred? 'stream-take-while "non-procedural argument")
+ (must stream? strm 'stream-take-while "non-stream argument")
+ (stream-let recur ((strm strm))
+ (cond ((stream-null? strm) stream-null)
+ ((pred? (stream-car strm))
+ (stream-cons (stream-car strm) (recur (stream-cdr strm))))
+ (else stream-null))))
+
+(define (stream-unfold mapper pred? generator base)
+ (must procedure? mapper 'stream-unfold "non-procedural mapper")
+ (must procedure? pred? 'stream-unfold "non-procedural pred?")
+ (must procedure? generator 'stream-unfold "non-procedural generator")
+ (stream-let recur ((base base))
+ (if (pred? base)
+ (stream-cons (mapper base) (recur (generator base)))
+ stream-null)))
+
+(define (stream-unfolds gen seed)
+ (define-stream (generator-stream seed)
+ (receive (next . items) (gen seed)
+ (stream-cons (list->vector items) (generator-stream next))))
+ (define-stream (make-result-stream genstrm index)
+ (define head (vector-ref (stream-car genstrm) index))
+ (define-stream (tail) (make-result-stream (stream-cdr genstrm) index))
+ (match head
+ (() stream-null)
+ (#f (tail))
+ ((item) (stream-cons item (tail)))
+ ((? list? items) (stream-append (list->stream items) (tail)))))
+
+ (must procedure? gen 'stream-unfolds "non-procedural argument")
+ (let ((genstrm (generator-stream seed)))
+ (apply values (list-tabulate (vector-length (stream-car genstrm))
+ (cut make-result-stream genstrm <>)))))
+
+(define (stream-zip strm . rest)
+ (let ((strms (cons strm rest)))
+ (must-every stream? strms 'stream-zip "non-stream argument")
+ (stream-let recur ((strms strms))
+ (if (any stream-null? strms) stream-null
+ (stream-cons (map stream-car strms) (recur (map stream-cdr
strms)))))))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index e7c8c41..01ffd1c 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -131,6 +131,7 @@ SCM_TESTS = tests/00-initial-env.test \
tests/srfi-37.test \
tests/srfi-38.test \
tests/srfi-39.test \
+ tests/srfi-41.test \
tests/srfi-42.test \
tests/srfi-45.test \
tests/srfi-60.test \
diff --git a/test-suite/tests/srfi-41.test b/test-suite/tests/srfi-41.test
new file mode 100644
index 0000000..f2e0864
--- /dev/null
+++ b/test-suite/tests/srfi-41.test
@@ -0,0 +1,680 @@
+;;; srfi-41.test -- test suite for SRFI 41
+
+;; Copyright (c) 2007 Philip L. Bewig
+;; Copyright (c) 2011, 2012, 2013 Free Software Foundation, Inc.
+
+;; Permission is hereby granted, free of charge, to any person obtaining
+;; a copy of this software and associated documentation files (the
+;; "Software"), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES, OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF, OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+(define-module (test-srfi-41)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-8)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-31)
+ #:use-module (srfi srfi-41)
+ #:use-module (test-suite lib))
+
+(define-stream (qsort lt? strm)
+ (if (stream-null? strm) stream-null
+ (let ((x (stream-car strm))
+ (xs (stream-cdr strm)))
+ (stream-append
+ (qsort lt? (stream-filter (cut lt? <> x) xs))
+ (stream x)
+ (qsort lt? (stream-filter (cut (negate lt?) <> x) xs))))))
+
+(define-stream (isort lt? strm)
+ (define-stream (insert strm x)
+ (stream-match strm
+ (() (stream x))
+ ((y . ys) (if (lt? y x)
+ (stream-cons y (insert ys x))
+ (stream-cons x strm)))))
+ (stream-fold insert stream-null strm))
+
+(define-stream (stream-merge lt? . strms)
+ (stream-let loop ((strms strms))
+ (cond ((null? strms) stream-null)
+ ((null? (cdr strms)) (car strms))
+ (else (stream-let merge ((xx (car strms))
+ (yy (loop (cdr strms))))
+ (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))))))))))))
+
+(define-stream (msort lt? strm)
+ (let* ((n (quotient (stream-length strm) 2))
+ (ts (stream-take n strm))
+ (ds (stream-drop n strm)))
+ (if (zero? n) strm
+ (stream-merge lt? (msort < ts) (msort < ds)))))
+
+(define-stream (stream-unique eql? strm)
+ (if (stream-null? strm) stream-null
+ (stream-cons (stream-car strm)
+ (stream-unique eql?
+ (stream-drop-while (cut eql? (stream-car strm) <>) strm)))))
+
+(define nats
+ (stream-cons 1
+ (stream-map 1+ nats)))
+
+(define hamming
+ (stream-unique =
+ (stream-cons 1
+ (stream-merge <
+ (stream-map (cut * 2 <>) hamming)
+ (stream-merge <
+ (stream-map (cut * 3 <>) hamming)
+ (stream-map (cut * 5 <>) hamming))))))
+
+(define primes (let ()
+ (define-stream (next base mult strm)
+ (let ((first (stream-car strm))
+ (rest (stream-cdr strm)))
+ (cond ((< first mult)
+ (stream-cons first
+ (next base mult rest)))
+ ((< mult first)
+ (next base (+ base mult) strm))
+ (else (next base
+ (+ base mult) rest)))))
+ (define-stream (sift base strm)
+ (next base (+ base base) strm))
+ (stream-let sieve ((strm (stream-from 2)))
+ (let ((first (stream-car strm))
+ (rest (stream-cdr strm)))
+ (stream-cons first (sieve (sift first rest)))))))
+
+(define strm123 (stream 1 2 3))
+
+(define (stream-equal? s1 s2)
+ (cond ((and (stream-null? s1) (stream-null? s2)) #t)
+ ((or (stream-null? s1) (stream-null? s2)) #f)
+ ((equal? (stream-car s1) (stream-car s2))
+ (stream-equal? (stream-cdr s1) (stream-cdr s2)))
+ (else #f)))
+
+(with-test-prefix "stream-null"
+ (pass-if "is a stream" (stream? stream-null))
+ (pass-if "is a null stream" (stream-null? stream-null))
+ (pass-if "is not a stream pair" (not (stream-pair? stream-null))))
+
+(with-test-prefix "stream-cons"
+ (pass-if "is a stream" (stream? (stream-cons 1 stream-null)))
+ (pass-if "is not a null stream" (not (stream-null? (stream-cons 1
stream-null))))
+ (pass-if "is a stream pair" (stream-pair? (stream-cons 1 stream-null))))
+
+(with-test-prefix "stream?"
+ (pass-if "is true for null stream" (stream? stream-null))
+ (pass-if "is true for stream pair" (stream? (stream-cons 1 stream-null)))
+ (pass-if "is false for non-stream" (not (stream? "four"))))
+
+(with-test-prefix "stream-null?"
+ (pass-if "is true for null stream" (stream-null? stream-null))
+ (pass-if "is false for stream pair" (not (stream-null? (stream-cons 1
stream-null))))
+ (pass-if "is false for non-stream" (not (stream-null? "four"))))
+
+(with-test-prefix "stream-pair?"
+ (pass-if "is false for null stream" (not (stream-pair? stream-null)))
+ (pass-if "is true for stream pair" (stream-pair? (stream-cons 1
stream-null)))
+ (pass-if "is false for non-stream" (not (stream-pair? "four"))))
+
+(with-test-prefix "stream-car"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream")
+ (stream-car "four"))
+ (pass-if-exception "throws for null stream"
+ '(wrong-type-arg . "null stream")
+ (stream-car stream-null))
+ (pass-if "returns first of stream" (eqv? (stream-car strm123) 1)))
+
+(with-test-prefix "stream-cdr"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream")
+ (stream-cdr "four"))
+ (pass-if-exception "throws for null stream"
+ '(wrong-type-arg . "null stream")
+ (stream-cdr stream-null))
+ (pass-if "returns rest of stream" (eqv? (stream-car (stream-cdr strm123))
2)))
+
+(with-test-prefix "stream-lambda"
+ (pass-if "returns correct result"
+ (stream-equal?
+ ((rec double (stream-lambda (strm)
+ (if (stream-null? strm) stream-null
+ (stream-cons (* 2 (stream-car strm))
+ (double (stream-cdr strm))))))
+ strm123)
+ (stream 2 4 6))))
+
+(with-test-prefix "define-stream"
+ (pass-if "returns correct result"
+ (stream-equal?
+ (let ()
+ (define-stream (double strm)
+ (if (stream-null? strm) stream-null
+ (stream-cons (* 2 (stream-car strm))
+ (double (stream-cdr strm)))))
+ (double strm123))
+ (stream 2 4 6))))
+
+(with-test-prefix "list->stream"
+ (pass-if-exception "throws for non-list"
+ '(wrong-type-arg . "non-list argument")
+ (list->stream "four"))
+ (pass-if "returns empty stream for empty list"
+ (stream-null? (list->stream '())))
+ (pass-if "returns stream with same content as given list"
+ (stream-equal? (list->stream '(1 2 3)) strm123)))
+
+(with-test-prefix "port->stream"
+ (pass-if-exception "throws for non-input-port"
+ '(wrong-type-arg . "non-input-port argument")
+ (port->stream "four"))
+ (call-with-input-string "Hello, world!"
+ (lambda (p)
+ (pass-if-equal "reads input string correctly"
+ "Hello, world!"
+ (list->string (stream->list (port->stream p)))))))
+
+(with-test-prefix "stream"
+ (pass-if-equal "with empty stream"
+ '()
+ (stream->list (stream)))
+ (pass-if-equal "with one-element stream"
+ '(1)
+ (stream->list (stream 1)))
+ (pass-if-equal "with three-element stream"
+ '(1 2 3)
+ (stream->list strm123)))
+
+(with-test-prefix "stream->list"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream->list '()))
+ (pass-if-exception "throws for non-integer count"
+ '(wrong-type-arg . "non-integer count")
+ (stream->list "four" strm123))
+ (pass-if-exception "throws for negative count"
+ '(wrong-type-arg . "negative count")
+ (stream->list -1 strm123))
+ (pass-if-equal "returns empty list for empty stream"
+ '()
+ (stream->list (stream)))
+ (pass-if-equal "without count"
+ '(1 2 3)
+ (stream->list strm123))
+ (pass-if-equal "with count longer than stream"
+ '(1 2 3)
+ (stream->list 5 strm123))
+ (pass-if-equal "with count shorter than stream"
+ '(1 2 3)
+ (stream->list 3 (stream-from 1))))
+
+(with-test-prefix "stream-append"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-append "four"))
+ (pass-if "with one stream"
+ (stream-equal? (stream-append strm123) strm123))
+ (pass-if "with two streams"
+ (stream-equal? (stream-append strm123 strm123) (stream 1 2 3 1 2
3)))
+ (pass-if "with three streams"
+ (stream-equal? (stream-append strm123 strm123 strm123)
+ (stream 1 2 3 1 2 3 1 2 3)))
+ (pass-if "append with null is noop"
+ (stream-equal? (stream-append strm123 stream-null) strm123))
+ (pass-if "prepend with null is noop"
+ (stream-equal? (stream-append stream-null strm123) strm123)))
+
+(with-test-prefix "stream-concat"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-concat "four"))
+ (pass-if "with one stream"
+ (stream-equal? (stream-concat (stream strm123)) strm123))
+ (pass-if "with two streams"
+ (stream-equal? (stream-concat (stream strm123 strm123))
+ (stream 1 2 3 1 2 3))))
+
+(with-test-prefix "stream-constant"
+ (pass-if "circular stream of 1 has >100 elements"
+ (eqv? (stream-ref (stream-constant 1) 100) 1))
+ (pass-if "circular stream of 2 has >100 elements"
+ (eqv? (stream-ref (stream-constant 1 2) 100) 1))
+ (pass-if "circular stream of 3 repeats after 3"
+ (eqv? (stream-ref (stream-constant 1 2 3) 3) 1))
+ (pass-if "circular stream of 1 repeats at 1"
+ (stream-equal? (stream-take 8 (stream-constant 1))
+ (stream 1 1 1 1 1 1 1 1)))
+ (pass-if "circular stream of 2 repeats at 2"
+ (stream-equal? (stream-take 8 (stream-constant 1 2))
+ (stream 1 2 1 2 1 2 1 2)))
+ (pass-if "circular stream of 3 repeats at 3"
+ (stream-equal? (stream-take 8 (stream-constant 1 2 3))
+ (stream 1 2 3 1 2 3 1 2))))
+
+(with-test-prefix "stream-drop"
+ (pass-if-exception "throws for non-integer count"
+ '(wrong-type-arg . "non-integer argument")
+ (stream-drop "four" strm123))
+ (pass-if-exception "throws for negative count"
+ '(wrong-type-arg . "negative argument")
+ (stream-drop -1 strm123))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-drop 2 "four"))
+ (pass-if "returns null when given null"
+ (stream-null? (stream-drop 0 stream-null)))
+ (pass-if "returns same stream when count is zero"
+ (eq? (stream-drop 0 strm123) strm123))
+ (pass-if "returns dropped-by-one stream when count is one"
+ (stream-equal? (stream-drop 1 strm123) (stream 2 3)))
+ (pass-if "returns null if count is longer than stream"
+ (stream-null? (stream-drop 5 strm123))))
+
+(with-test-prefix "stream-drop-while"
+ (pass-if-exception "throws for invalid predicate"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-drop-while "four" strm123))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-drop-while odd? "four"))
+ (pass-if "returns null when given null"
+ (stream-null? (stream-drop-while odd? stream-null)))
+ (pass-if "returns dropped stream when first element matches"
+ (stream-equal? (stream-drop-while odd? strm123) (stream 2 3)))
+ (pass-if "returns whole stream when first element doesn't match"
+ (stream-equal? (stream-drop-while even? strm123) strm123))
+ (pass-if "returns empty stream if all elements match"
+ (stream-null? (stream-drop-while positive? strm123)))
+ (pass-if "return whole stream if no elements match"
+ (stream-equal? (stream-drop-while negative? strm123) strm123)))
+
+(with-test-prefix "stream-filter"
+ (pass-if-exception "throws for invalid predicate"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-filter "four" strm123))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-filter odd? '()))
+ (pass-if "returns null when given null"
+ (stream-null? (stream-filter odd? (stream))))
+ (pass-if "filters out even numbers"
+ (stream-equal? (stream-filter odd? strm123) (stream 1 3)))
+ (pass-if "filters out odd numbers"
+ (stream-equal? (stream-filter even? strm123) (stream 2)))
+ (pass-if "returns all elements if predicate matches all"
+ (stream-equal? (stream-filter positive? strm123) strm123))
+ (pass-if "returns null if predicate matches none"
+ (stream-null? (stream-filter negative? strm123)))
+ (pass-if "all elements of an odd-filtered stream are odd"
+ (every odd? (stream->list 10 (stream-filter odd? (stream-from 0)))))
+ (pass-if "no elements of an odd-filtered stream are even"
+ (not (any even? (stream->list 10 (stream-filter odd? (stream-from
0)))))))
+
+(with-test-prefix "stream-fold"
+ (pass-if-exception "throws for invalid function"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-fold "four" 0 strm123))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-fold + 0 '()))
+ (pass-if "returns the correct result" (eqv? (stream-fold + 0 strm123) 6)))
+
+(with-test-prefix "stream-for-each"
+ (pass-if-exception "throws for invalid function"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-for-each "four" strm123))
+ (pass-if-exception "throws if given no streams" exception:wrong-num-args
+ (stream-for-each display))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-for-each display "four"))
+ (pass-if "function is called for stream elements"
+ (eqv? (let ((sum 0))
+ (stream-for-each (lambda (x)
+ (set! sum (+ sum x)))
+ strm123)
+ sum)
+ 6)))
+
+(with-test-prefix "stream-from"
+ (pass-if-exception "throws for non-numeric start"
+ '(wrong-type-arg . "non-numeric starting number")
+ (stream-from "four"))
+ (pass-if-exception "throws for non-numeric step"
+ '(wrong-type-arg . "non-numeric step size")
+ (stream-from 1 "four"))
+ (pass-if "works for default values"
+ (eqv? (stream-ref (stream-from 0) 100) 100))
+ (pass-if "works for non-default start and step"
+ (eqv? (stream-ref (stream-from 1 2) 100) 201))
+ (pass-if "works for negative step"
+ (eqv? (stream-ref (stream-from 0 -1) 100) -100)))
+
+(with-test-prefix "stream-iterate"
+ (pass-if-exception "throws for invalid function"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-iterate "four" 0))
+ (pass-if "returns correct iterated stream with 1+"
+ (stream-equal? (stream-take 3 (stream-iterate 1+ 1)) strm123))
+ (pass-if "returns correct iterated stream with exact-integer-sqrt"
+ (stream-equal? (stream-take 5 (stream-iterate exact-integer-sqrt
65536))
+ (stream 65536 256 16 4 2))))
+
+(with-test-prefix "stream-length"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-length "four"))
+ (pass-if "returns 0 for empty stream" (zero? (stream-length (stream))))
+ (pass-if "returns correct stream length" (eqv? (stream-length strm123) 3)))
+
+(with-test-prefix "stream-let"
+ (pass-if "returns correct result"
+ (stream-equal?
+ (stream-let loop ((strm strm123))
+ (if (stream-null? strm)
+ stream-null
+ (stream-cons (* 2 (stream-car strm))
+ (loop (stream-cdr strm)))))
+ (stream 2 4 6))))
+
+(with-test-prefix "stream-map"
+ (pass-if-exception "throws for invalid function"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-map "four" strm123))
+ (pass-if-exception "throws if given no streams" exception:wrong-num-args
+ (stream-map odd?))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-map odd? "four"))
+ (pass-if "works for one stream"
+ (stream-equal? (stream-map - strm123) (stream -1 -2 -3)))
+ (pass-if "works for two streams"
+ (stream-equal? (stream-map + strm123 strm123) (stream 2 4 6)))
+ (pass-if "returns finite stream for finite first stream"
+ (stream-equal? (stream-map + strm123 (stream-from 1)) (stream 2 4
6)))
+ (pass-if "returns finite stream for finite last stream"
+ (stream-equal? (stream-map + (stream-from 1) strm123) (stream 2 4
6)))
+ (pass-if "works for three streams"
+ (stream-equal? (stream-map + strm123 strm123 strm123) (stream 3 6
9))))
+
+(with-test-prefix "stream-match"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-match '(1 2 3) (_ 'ok)))
+ (pass-if-exception "throws when no pattern matches"
+ '(match-error . "no matching pattern")
+ (stream-match strm123 (() 42)))
+ (pass-if-equal "matches empty stream correctly"
+ 'ok
+ (stream-match stream-null (() 'ok)))
+ (pass-if-equal "matches non-empty stream correctly"
+ 'ok
+ (stream-match strm123 (() 'no) (else 'ok)))
+ (pass-if-equal "matches stream of one element"
+ 1
+ (stream-match (stream 1) (() 'no) ((a) a)))
+ (pass-if-equal "matches wildcard"
+ 'ok
+ (stream-match (stream 1) (() 'no) ((_) 'ok)))
+ (pass-if-equal "matches stream of three elements"
+ '(1 2 3)
+ (stream-match strm123 ((a b c) (list a b c))))
+ (pass-if-equal "matches first element with wildcard rest"
+ 1
+ (stream-match strm123 ((a . _) a)))
+ (pass-if-equal "matches first two elements with wildcard rest"
+ '(1 2)
+ (stream-match strm123 ((a b . _) (list a b))))
+ (pass-if-equal "rest variable matches as stream"
+ '(1 2 3)
+ (stream-match strm123 ((a b . c) (list a b (stream-car c)))))
+ (pass-if-equal "rest variable can match whole stream"
+ '(1 2 3)
+ (stream-match strm123 (s (stream->list s))))
+ (pass-if-equal "successful guard match"
+ 'ok
+ (stream-match strm123 ((a . _) (= a 1) 'ok)))
+ (pass-if-equal "unsuccessful guard match"
+ 'no
+ (stream-match strm123 ((a . _) (= a 2) 'yes) (_ 'no)))
+ (pass-if-equal "unsuccessful guard match with two variables"
+ 'no
+ (stream-match strm123 ((a b c) (= a b) 'yes) (_ 'no)))
+ (pass-if-equal "successful guard match with two variables"
+ 'yes
+ (stream-match (stream 1 1 2) ((a b c) (= a b) 'yes) (_ 'no))))
+
+(with-test-prefix "stream-of"
+ (pass-if "all 3 clause types work"
+ (stream-equal? (stream-of (+ y 6)
+ (x in (stream-range 1 6))
+ (odd? x)
+ (y is (* x x)))
+ (stream 7 15 31)))
+ (pass-if "using two streams creates cartesian product"
+ (stream-equal? (stream-of (* x y)
+ (x in (stream-range 1 4))
+ (y in (stream-range 1 5)))
+ (stream 1 2 3 4 2 4 6 8 3 6 9 12)))
+ (pass-if "using no clauses returns just the expression"
+ (stream-equal? (stream-of 1) (stream 1))))
+
+(with-test-prefix "stream-range"
+ (pass-if-exception "throws for non-numeric start"
+ '(wrong-type-arg . "non-numeric starting number")
+ (stream-range "four" 0))
+ (pass-if-exception "throws for non-numeric end"
+ '(wrong-type-arg . "non-numeric ending number")
+ (stream-range 0 "four"))
+ (pass-if-exception "throws for non-numeric step"
+ '(wrong-type-arg . "non-numeric step size")
+ (stream-range 1 2 "three"))
+ (pass-if "returns increasing range if start < end"
+ (stream-equal? (stream-range 0 5) (stream 0 1 2 3 4)))
+ (pass-if "returns decreasing range if start > end"
+ (stream-equal? (stream-range 5 0) (stream 5 4 3 2 1)))
+ (pass-if "returns increasing range of step 2"
+ (stream-equal? (stream-range 0 5 2) (stream 0 2 4)))
+ (pass-if "returns decreasing range of step 2"
+ (stream-equal? (stream-range 5 0 -2) (stream 5 3 1)))
+ (pass-if "returns empty range if start is past end value"
+ (stream-null? (stream-range 0 1 -1))))
+
+(with-test-prefix "stream-ref"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-ref '() 4))
+ (pass-if-exception "throws for non-integer index"
+ '(wrong-type-arg . "non-integer argument")
+ (stream-ref nats 3.5))
+ (pass-if-exception "throws for negative index"
+ '(wrong-type-arg . "negative argument")
+ (stream-ref nats -3))
+ (pass-if-exception "throws if index goes past end of stream"
+ '(wrong-type-arg . "beyond end of stream")
+ (stream-ref strm123 5))
+ (pass-if-equal "returns first element when index = 0"
+ 1
+ (stream-ref nats 0))
+ (pass-if-equal "returns second element when index = 1"
+ 2
+ (stream-ref nats 1))
+ (pass-if-equal "returns third element when index = 2"
+ 3
+ (stream-ref nats 2)))
+
+(with-test-prefix "stream-reverse"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-reverse '()))
+ (pass-if "returns null when given null"
+ (stream-null? (stream-reverse (stream))))
+ (pass-if "returns (3 2 1) for (1 2 3)"
+ (stream-equal? (stream-reverse strm123) (stream 3 2 1))))
+
+(with-test-prefix "stream-scan"
+ (pass-if-exception "throws for invalid function"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-scan "four" 0 strm123))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-scan + 0 '()))
+ (pass-if "returns the correct result"
+ (stream-equal? (stream-scan + 0 strm123) (stream 0 1 3 6))))
+
+(with-test-prefix "stream-take"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-take 5 "four"))
+ (pass-if-exception "throws for non-integer index"
+ '(wrong-type-arg . "non-integer argument")
+ (stream-take "four" strm123))
+ (pass-if-exception "throws for negative index"
+ '(wrong-type-arg . "negative argument")
+ (stream-take -4 strm123))
+ (pass-if "returns null for empty stream"
+ (stream-null? (stream-take 5 stream-null)))
+ (pass-if "using 0 index returns null for empty stream"
+ (stream-null? (stream-take 0 stream-null)))
+ (pass-if "using 0 index returns null for non-empty stream"
+ (stream-null? (stream-take 0 strm123)))
+ (pass-if "returns first 2 elements of stream"
+ (stream-equal? (stream-take 2 strm123) (stream 1 2)))
+ (pass-if "returns whole stream when index is same as length"
+ (stream-equal? (stream-take 3 strm123) strm123))
+ (pass-if "returns whole stream when index exceeds length"
+ (stream-equal? (stream-take 5 strm123) strm123)))
+
+(with-test-prefix "stream-take-while"
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-take-while odd? "four"))
+ (pass-if-exception "throws for invalid predicate"
+ '(wrong-type-arg . "non-procedural argument")
+ (stream-take-while "four" strm123))
+ (pass-if "returns stream up to first non-matching item"
+ (stream-equal? (stream-take-while odd? strm123) (stream 1)))
+ (pass-if "returns empty stream if first item doesn't match"
+ (stream-null? (stream-take-while even? strm123)))
+ (pass-if "returns whole stream if every item matches"
+ (stream-equal? (stream-take-while positive? strm123) strm123))
+ (pass-if "return empty stream if no item matches"
+ (stream-null? (stream-take-while negative? strm123))))
+
+(with-test-prefix "stream-unfold"
+ (pass-if-exception "throws for invalid mapper"
+ '(wrong-type-arg . "non-procedural mapper")
+ (stream-unfold "four" odd? + 0))
+ (pass-if-exception "throws for invalid predicate"
+ '(wrong-type-arg . "non-procedural pred?")
+ (stream-unfold + "four" + 0))
+ (pass-if-exception "throws for invalid generator"
+ '(wrong-type-arg . "non-procedural generator")
+ (stream-unfold + odd? "four" 0))
+
+ (pass-if "returns the correct result"
+ (stream-equal? (stream-unfold (cut expt <> 2) (cut < <> 10) 1+ 0)
+ (stream 0 1 4 9 16 25 36 49 64 81))))
+
+(with-test-prefix "stream-unfolds"
+ (pass-if "returns the correct result"
+ (stream-equal? (stream-unfolds
+ (lambda (x)
+ (receive (n s) (car+cdr x)
+ (if (zero? n)
+ (values 'dummy '())
+ (values
+ (cons (- n 1) (stream-cdr s))
+ (list (stream-car s))))))
+ (cons 5 (stream-from 0)))
+ (stream 0 1 2 3 4)))
+ (pass-if "handles returns of multiple elements correctly"
+ (stream-equal? (stream-take 16 (stream-unfolds
+ (lambda (n)
+ (values (1+ n) (iota n)))
+ 1))
+ (stream 0 0 1 0 1 2 0 1 2 3 0 1 2 3 4 0)))
+ (receive (p np)
+ (stream-unfolds (lambda (x)
+ (receive (n p) (car+cdr x)
+ (if (= n (stream-car p))
+ (values (cons (1+ n) (stream-cdr p))
+ (list n) #f)
+ (values (cons (1+ n) p)
+ #f (list n)))))
+ (cons 1 primes))
+ (pass-if "returns first stream correctly"
+ (stream-equal? (stream-take 15 p)
+ (stream 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47)))
+ (pass-if "returns second stream correctly"
+ (stream-equal? (stream-take 15 np)
+ (stream 1 4 6 8 9 10 12 14 15 16 18 20 21 22
24)))))
+
+(with-test-prefix "stream-zip"
+ (pass-if-exception "throws if given no streams" exception:wrong-num-args
+ (stream-zip))
+ (pass-if-exception "throws for non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-zip "four"))
+ (pass-if-exception "throws if any argument is non-stream"
+ '(wrong-type-arg . "non-stream argument")
+ (stream-zip strm123 "four"))
+ (pass-if "returns null when given null as any argument"
+ (stream-null? (stream-zip strm123 stream-null)))
+ (pass-if "returns single-element lists when given one stream"
+ (stream-equal? (stream-zip strm123) (stream '(1) '(2) '(3))))
+ (pass-if "returns double-element lists when given two streams"
+ (stream-equal? (stream-zip strm123 strm123)
+ (stream '(1 1) '(2 2) '(3 3))))
+ (pass-if "returns finite stream if at least one given stream is"
+ (stream-equal? (stream-zip strm123 (stream-from 1))
+ (stream '(1 1) '(2 2) '(3 3))))
+ (pass-if "returns triple-element lists when given three streams"
+ (stream-equal? (stream-zip strm123 strm123 strm123)
+ (stream '(1 1 1) '(2 2 2) '(3 3 3)))))
+
+(with-test-prefix "other tests"
+ (pass-if-equal "returns biggest prime under 1000"
+ 997
+ (stream-car
+ (stream-reverse (stream-take-while (cut < <> 1000) primes))))
+
+ (pass-if "quicksort returns same result as insertion sort"
+ (stream-equal? (qsort < (stream 3 1 5 2 4))
+ (isort < (stream 2 5 1 4 3))))
+
+ (pass-if "merge sort returns same result as insertion sort"
+ (stream-equal? (msort < (stream 3 1 5 2 4))
+ (isort < (stream 2 5 1 4 3))))
+
+ ;; http://www.research.att.com/~njas/sequences/A051037
+ (pass-if-equal "returns 1000th Hamming number"
+ 51200000
+ (stream-ref hamming 999)))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-243-g80b809f,
Mark H Weaver <=