civodul pushed a commit to branch master
in repository guile.
commit 5f60eb6bb5af418b332101c69c88da639b117ae4
Author: Linus Björnstam <linus.bjorns...@fastmail.se>
AuthorDate: Mon Mar 23 14:59:39 2020 +0100
Add SRFI-171 to guile
This adds SRFI-171 (transducers) to guile.
The two guile-specific additions are powerful transducers which can be
used to generalize transducers like tsegment. They are hard to get
right, but powerful and useful enough to warrant inclusion.
* doc/ref/srfi-modules.texi: added srfi-171 section
* module/Makefile.am (SOURCES):
* module/srfi/srfi-171.scm:
* module/srfi/srfi-171/meta.scm: Add SRFI-171
* module/srfi/srfi-171/gnu.scm: Add 2 guile-specific extensions.
* test-suite/Makefile.am (SCM_TESTS):
* test-suite/tests/srfi-171.test: Add tests.
Signed-off-by: Ludovic Courtès <l...@gnu.org>
---
doc/ref/srfi-modules.texi | 487 +++++++++++++++++++++++++++++++++++++++++
module/Makefile.am | 3 +
module/srfi/srfi-171.scm | 457 ++++++++++++++++++++++++++++++++++++++
module/srfi/srfi-171/gnu.scm | 65 ++++++
module/srfi/srfi-171/meta.scm | 113 ++++++++++
test-suite/Makefile.am | 1 +
test-suite/tests/srfi-171.test | 267 ++++++++++++++++++++++
7 files changed, 1393 insertions(+)
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 8f5b643..fd19079 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -64,6 +64,7 @@ get the relevant SRFI documents from the SRFI home page
* SRFI-98:: Accessing environment variables.
* SRFI-105:: Curly-infix expressions.
* SRFI-111:: Boxes.
+* SRFI-171:: Transducers
@end menu
@@ -5602,6 +5603,492 @@ Return the current contents of @var{box}.
Set the contents of @var{box} to @var{value}.
@end deffn
+@node SRFI-171
+@subsection Transducers
+@cindex SRFI-171
+@cindex transducers
+
+Some of the most common operations used in the Scheme language are those
+transforming lists: map, filter, take and so on. They work well, are well
+understood, and are used daily by most Scheme programmers. They are however
not
+general because they only work on lists, and they do not compose very well
+since combining N of them builds @code{(- N 1)} intermediate lists.
+
+Transducers are oblivious to what kind of process they are used in, and
+are composable without building intermediate collections. This means we
+can create a transducer that squares all even numbers:
+
+@example
+(compose (tfilter odd?) (tmap (lambda (x) (* x x))))
+@end example
+
+and reuse it with lists, vectors, or in just about any context where
+data flows in one direction. We could use it as a processing step for
+asynchronous channels, with an event framework as a pre-processing step,
+or even in lazy contexts where you pass a lazy collection and a
+transducer to a function and get a new lazy collection back.
+
+The traditional Scheme approach of having collection-specific procedures
+is not changed. We instead specify a general form of transformations
+that complement these procedures. The benefits are obvious: a clear,
+well-understood way of describing common transformations in a way that
+is faster than just chaining the collection-specific counterparts. For
+guile in particular this means a lot better GC performance.
+
+Notice however that @code{(compose @dots{})} composes transducers
+left-to-right, due to how transducers are initiated.
+
+@menu
+* SRFI-171 General Discussion:: General information about transducers
+* SRFI-171 Applying Transducers:: Documentation of collection-specific
forms
+* SRFI-171 Reducers:: Reducers specified by the SRFI
+* SRFI-171 Transducers:: Transducers specified by the SRFI
+* SRFI-171 Helpers:: Utilities for writing your own
transducers
+@end menu
+
+@node SRFI-171 General Discussion
+@subsubsection SRFI-171 General Discussion
+@cindex transducers discussion
+
+@subheading The concept of reducers
+The central part of transducers are 3-arity reducing procedures.
+
+@itemize
+@item
+no arguments: Produces the identity of the reducer.
+
+@item
+(result-so-far): completion. Returns @code{result-so-far} either with or
+without transforming it first.
+
+@item
+(result-so-far input) combines @code{result-so-far} and @code{input} to produce
+a new @code{result-so-far}.
+@end itemize
+
+In the case of a summing @code{+} reducer, the reducer would produce, in
+arity order: @code{0}, @code{result-so-far}, @code{(+ result-so-far
+input)}. This happens to be exactly what the regular @code{+} does.
+
+@subheading The concept of transducers
+A transducer is a one-arity procedure that takes a reducer and produces a
+reducing function that behaves as follows:
+
+@itemize
+@item
+no arguments: calls reducer with no arguments (producing its identity)
+
+@item
+(result-so-far): Maybe transform the result-so-far and call reducer with it.
+
+@item
+(result-so-far input) Maybe do something to input and maybe call the
+reducer with result-so-far and the maybe-transformed input.
+@end itemize
+
+A simple example is as following:
+
+@example
+(list-transduce (tfilter odd?)+ '(1 2 3 4 5)).
+@end example
+
+This first returns a transducer filtering all odd
+elements, then it runs @code{+} without arguments to retrieve its
+identity. It then starts the transduction by passing @code{+} to the
+transducer returned by @code{(tfilter odd?)} which returns a reducing
+function. It works not unlike reduce from SRFI 1, but also checks
+whether one of the intermediate transducers returns a "reduced" value
+(implemented as a SRFI 9 record), which means the reduction finished
+early.
+
+Because transducers compose and the final reduction is only executed in
+the last step, composed transducers will not build any intermediate
+result or collections. Although the normal way of thinking about
+application of composed functions is right to left, due to how the
+transduction is built it is applied left to right. @code{(compose
+(tfilter odd?) (tmap sqrt))} will create a transducer that first filters
+out any odd values and then computes the square root of the rest.
+
+
+@subheading State
+Even though transducers appear to be somewhat of a generalisation of
+@code{map} and friends, this is not really true. Since transducers don't
+know in which context they are being used, some transducers must keep
+state where their collection-specific counterparts do not. The
+transducers that keep state do so using hidden mutable state, and as
+such all the caveats of mutation, parallelism, and multi-shot
+continuations apply. Each transducer keeping state is clearly described
+as doing so in the documentation.
+
+@subheading Naming
+
+Reducers exported from the transducers module are named as in their
+SRFI-1 counterpart, but prepended with an r. Transducers also follow
+that naming, but are prepended with a t.
+
+
+@node SRFI-171 Applying Transducers
+@subsubsection Applying Transducers
+@cindex transducers applying
+
+@deffn {Scheme Procedure} list-transduce xform f lst
+@deffnx {Scheme Procedure} list-transduce xform f identity lst
+Initialize the transducer @var{xform} by passing the reducer @var{f}
+to it. If no identity is provided, @var{f} runs without arguments to
+return the reducer identity. It then reduces over @var{lst} using the
+identity as the seed.
+
+If one of the transducers finishes early (such as @code{ttake} or
+@code{tdrop}), it communicates this by returning a reduced value, which
+in the guile implementation is just a value wrapped in a SRFI 9 record
+type named ``reduced''. If such a value is returned by the transducer,
+@code{list-transduce} must stop execution and return an unreduced value
+immediately.
+@end deffn
+
+@deffn {Scheme Procedure} vector-transduce xform f vec
+@deffnx {Scheme Procedure} vector-transduce xform f identity vec
+@deffnx {Scheme Procedure} string-transduce xform f str
+@deffnx {Scheme Procedure} string-transduce xform f identity str
+@deffnx {Scheme Procedure} bytevector-u8-transduce xform f bv
+@deffnx {Scheme Procedure} bytevector-u8-transduce xform f identity bv
+@deffnx {Scheme Procedure} generator-transduce xform f gen
+@deffnx {Scheme Procedure} generator-transduce xform f identity gen
+
+Same as @code{list-transduce}, but for vectors, strings, u8-bytevectors
+and SRFI-158-styled generators respectively.
+@end deffn
+
+@deffn {Scheme Procedure} port-transduce xform f reader
+@deffnx {Scheme Procedure} port-transduce xform f reader port
+@deffnx {Scheme Procedure} port-transduce xform f identity reader port
+
+Same as @code{list-reduce} but for ports. Called without a port, it
+reduces over the results of applying @var{(reader)} until the
+EOF-object is returned, presumably to read from
+@code{current-input-port}. With a port @var{reader} is applied to
+@var{port} instead of without any arguments. If @var{identity} is
+provided, that is used as the initial identity in the reduction.
+@end deffn
+
+
+@node SRFI-171 Reducers
+@subsubsection Reducers
+@cindex transducers reducers
+
+@deffn {Scheme Procedure} rcons
+a simple consing reducer. When called without values, it returns its
+identity, @code{'()}. With one value, which will be a list, it reverses
+the list (using @code{reverse!}). When called with two values, it conses
+the second value to the first.
+
+@example
+(list-transduce (tmap (lambda (x) (+ x 1)) rcons (list 0 1 2 3))
+@result{} (1 2 3 4)
+@end example
+@end deffn
+
+@deffn {Scheme Procedure} reverse-rcons
+same as rcons, but leaves the values in their reversed order.
+@example
+(list-transduce (tmap (lambda (x) (+ x 1))) reverse-rcons (list 0 1 2 3))
+@result{} (4 3 2 1)
+@end example
+@end deffn
+
+@deffn {Scheme Procedure} rany pred?
+The reducer version of any. Returns @code{(reduced (pred? value))} if
+any @code{(pred? value)} returns non-#f. The identity is #f.
+
+@example
+(list-transduce (tmap (lambda (x) (+ x 1))) (rany odd?) (list 1 3 5))
+@result{} #f
+
+(list-transduce (tmap (lambda (x) (+ x 1))) (rany odd?) (list 1 3 4 5))
+@result{} #t
+@end example
+@end deffn
+
+@deffn {Scheme Procedure} revery pred?
+The reducer version of every. Stops the transduction and returns
+@code{(reduced #f)} if any @code{(pred? value)} returns #f. If every
+@code{(pred? value)} returns true, it returns the result of the last
+invocation of @code{(pred? value)}. The identity is #t.
+
+@example
+(list-transduce
+ (tmap (lambda (x) (+ x 1)))
+ (revery (lambda (v) (if (odd? v) v #f)))
+ (list 2 4 6))
+ @result{} 7
+
+(list-transduce (tmap (lambda (x) (+ x 1)) (revery odd?) (list 2 4 5 6))
+@result{} #f
+@end example
+@end deffn
+
+@deffn {Scheme Procedure} rcount
+A simple counting reducer. Counts the values that pass through the
+transduction.
+@example
+(list-transduce (tfilter odd?) rcount (list 1 2 3 4)) @result{} 2.
+@end example
+@end deffn
+
+
+@node SRFI-171 Transducers
+@subsubsection Transducers
+@cindex transducers transducers
+
+@deffn {Scheme Procedure} tmap proc
+Returns a transducer that applies @var{proc} to all values. Stateless.
+@end deffn
+
+@deffn tfilter pred?
+Returns a transducer that removes values for which @var{pred?} returns #f.
+
+Stateless.
+@end deffn
+
+@deffn {Scheme Procedure} tremove pred?
+Returns a transducer that removes values for which @var{pred?} returns non-#f.
+
+Stateless
+@end deffn
+
+@deffn {Scheme Procedure} tfilter-map proc
+The same as @code{(compose (tmap proc) (tfilter values))}. Stateless.
+@end deffn
+
+@deffn {Scheme Procedure} treplace mapping
+The argument @var{mapping} is an association list (using @code{equal?}
+to compare keys), a hash-table, a one-argument procedure taking one
+argument and either producing that same argument or a replacement value.
+
+Returns a transducer which checks for the presence of any value passed
+through it in mapping. If a mapping is found, the value of that mapping
+is returned, otherwise it just returns the original value.
+
+Does not keep internal state, but modifying the mapping while it's in
+use by treplace is an error.
+@end deffn
+
+@deffn {Scheme Procedure} tdrop n
+Returns a transducer that discards the first @var{n} values.
+
+Stateful.
+@end deffn
+
+@deffn {Scheme Procedure} ttake n
+Returns a transducer that discards all values and stops the transduction
+after the first @var{n} values have been let through. Any subsequent values
+are ignored.
+
+Stateful.
+@end deffn
+
+
+@deffn {Scheme Procedure} tdrop-while pred?
+Returns a transducer that discards the the first values for which
+@var{pred?} returns true.
+
+Stateful.
+@end deffn
+
+
+@deffn {Scheme Procedure} ttake-while pred?
+@deffnx {Scheme Procedure} ttake-while pred? retf
+Returns a transducer that stops the transduction after @var{pred?} has
+returned #f. Any subsequent values are ignored and the last successful
+value is returned. @var{retf} is a function that gets called whenever
+@var{pred?} returns false. The arguments passed are the result so far
+and the input for which pred? returns @code{#f}. The default function is
+@code{(lambda (result input) result)}.
+
+Stateful.
+@end deffn
+
+
+@deffn {Scheme Procedure} tconcatenate
+tconcatenate @emph{is} a transducer that concatenates the content of
+each value (that must be a list) into the reduction.
+@example
+(list-transduce tconcatenate rcons '((1 2) (3 4 5) (6 (7 8) 9)))
+@result{} (1 2 3 4 5 6 (7 8) 9)
+@end example
+@end deffn
+
+@deffn {Scheme Procedure} tappend-map proc
+The same as @code{(compose (tmap proc) tconcatenate)}.
+@end deffn
+
+@deffn {Scheme Procedure} tflatten
+tflatten @emph{is} a transducer that flattens an input consisting of lists.
+
+@example
+(list-transduce tflatten rcons '((1 2) 3 (4 (5 6) 7 8) 9)
+@result{} (1 2 3 4 5 6 7 8 9)
+@end example
+@end deffn
+
+@deffn {Scheme Procedure} tdelete-neighbor-duplicates
+@deffnx {Scheme Procedure} tdelete-neighbor-duplicates equality-predicate
+Returns a transducer that removes any directly following duplicate
+elements. The default @var{equality-predicate} is @code{equal?}.
+
+Stateful.
+@end deffn
+
+@deffn {Scheme Procedure} tdelete-duplicates
+@deffnx {Scheme Procedure} tdelete-duplicates equality-predicate
+Returns a transducer that removes any subsequent duplicate elements
+compared using @var{equality-predicate}. The default
+@var{equality-predicate} is @code{equal?}.
+
+Stateful.
+@end deffn
+
+@deffn {Scheme Procedure} tsegment n
+Returns a transducer that groups @var{n} inputs in lists of @var{n}
+elements. When the transduction stops, it flushes any remaining
+collection, even if it contains fewer than @var{n} elements.
+
+Stateful.
+@end deffn
+
+@deffn {Scheme Procedure} tpartition pred?
+Returns a transducer that groups inputs in lists by whenever
+@code{(pred? input)} changes value.
+
+Stateful.
+@end deffn
+
+@deffn {Scheme Procedure} tadd-between value
+Returns a transducer which interposes @var{value} between each value
+and the next. This does not compose gracefully with transducers like
+@code{ttake}, as you might end up ending the transduction on
+@code{value}.
+
+Stateful.
+@end deffn
+
+@deffn {Scheme Procedure} tenumerate
+@deffnx {Scheme Procedure} tenumerate start
+Returns a transducer that indexes values passed through it, starting at
+@var{start}, which defaults to 0. The indexing is done through cons
+pairs like @code{(index . input)}.
+
+@example
+(list-transduce (tenumerate 1) rcons (list 'first 'second 'third))
+@result{} ((1 . first) (2 . second) (3 . third))
+@end example
+
+Stateful.
+@end deffn
+
+@deffn {Scheme Procedure} tlog
+@deffnx {Scheme Procedure} tlog logger
+Returns a transducer that can be used to log or print values and
+results. The result of the @var{logger} procedure is discarded. The
+default @var{logger} is @code{(lambda (result input) (write input)
+(newline))}.
+
+Stateless.
+@end deffn
+
+@subheading Guile-specific transducers
+These transducers are available in the @code{(srfi srfi-171 gnu)}
+library, and are provided outside the standard described by the SRFI-171
+document.
+
+@deffn {Scheme Procedure} tbatch reducer
+@deffnx {Scheme Procedure} tbatch transducer reducer
+A batching transducer that accumulates results using @var{reducer} or
+@code{((transducer) reducer)} until it returns a reduced value. This can
+be used to generalize something like @code{tsegment}:
+
+@example
+;; This behaves exactly like (tsegment 4).
+(list-transduce (tbatch (ttake 4) rcons) rcons (iota 10))
+@result {} ((0 1 2 3) (4 5 6 7) (8 9))
+@end example
+@end deffn
+
+@deffn {Scheme Procedure} tfold reducer
+@deffnx {Scheme Procedure} tfold reducer seed
+
+A folding transducer that yields the result of @code{(reducer seed
+value)}, saving it's result between iterations.
+
+@example
+(list-transduce (tfold +) rcons (iota 10))
+@result{} (0 1 3 6 10 15 21 28 36 45)
+@end example
+@end deffn
+
+
+@node SRFI-171 Helpers
+@subsubsection Helper functions for writing transducers
+@cindex transducers helpers
+
+These functions are in the @code{(srfi srfi-171 meta)} module and are only
+usable when you want to write your own transducers.
+
+@deffn {Scheme Procedure} reduced value
+Wraps a value in a @code{<reduced>} container, signalling that the
+reduction should stop.
+@end deffn
+
+@deffn {Scheme Procedure} reduced? value
+Returns #t if value is a @code{<reduced>} record.
+@end deffn
+
+@deffn {Scheme Procedure} unreduce reduced-container
+Returns the value in reduced-container.
+@end deffn
+
+@deffn {Scheme Procedure} ensure-reduced value
+Wraps value in a @code{<reduced>} container if it is not already reduced.
+@end deffn
+
+@deffn {Scheme Procedure} preserving-reduced reducer
+Wraps @code{reducer} in another reducer that encapsulates any returned
+reduced value in another reduced container. This is useful in places
+where you re-use a reducer with [collection]-reduce. If the reducer
+returns a reduced value, [collection]-reduce unwraps it. Unless handled,
+this leads to the reduction continuing.
+@end deffn
+
+@deffn {Scheme Procedure} list-reduce f identity lst
+The reducing function used internally by @code{list-transduce}. @var{f}
+is a reducer as returned by a transducer. @var{identity} is the
+identity (sometimes called "seed") of the reduction. @var{lst} is a
+list. If @var{f} returns a reduced value, the reduction stops
+immediately and the unreduced value is returned.
+@end deffn
+
+@deffn {Scheme Procedure} vector-reduce f identity vec
+The vector version of list-reduce.
+@end deffn
+
+@deffn {Scheme Procedure} string-reduce f identity str
+The string version of list-reduce.
+@end deffn
+
+@deffn {Scheme Procedure} bytevector-u8-reduce f identity bv
+The bytevector-u8 version of list-reduce.
+@end deffn
+
+@deffn {Scheme Procedure} port-reduce f identity reader port
+The port version of list-reducer. It reduces over port using reader
+until reader returns the EOF object.
+@end deffn
+
+@deffn {Scheme Procedure} generator-reduce f identity gen
+The port version of list-reduce. It reduces over @code{gen} until it
+returns the EOF object
+@end deffn
+
@c srfi-modules.texi ends here
@c Local Variables:
diff --git a/module/Makefile.am b/module/Makefile.am
index 1d9d524..40b4b56 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -312,6 +312,9 @@ SOURCES = \
srfi/srfi-88.scm \
srfi/srfi-98.scm \
srfi/srfi-111.scm \
+ srfi/srfi-171.scm \
+ srfi/srfi-171/gnu.scm \
+ srfi/srfi-171/meta.scm \
\
statprof.scm \
\
diff --git a/module/srfi/srfi-171.scm b/module/srfi/srfi-171.scm
new file mode 100644
index 0000000..eb2d4d4
--- /dev/null
+++ b/module/srfi/srfi-171.scm
@@ -0,0 +1,457 @@
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (srfi srfi-171)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-9)
+ #:use-module ((srfi srfi-43) #:select (vector->list))
+ #:use-module ((srfi srfi-69) #:prefix srfi69:)
+ #:use-module ((rnrs hashtables) #:prefix rnrs:)
+ #:use-module (srfi srfi-171 meta)
+ #:export (rcons
+ reverse-rcons
+ rcount
+ rany
+ revery
+ list-transduce
+ vector-transduce
+ string-transduce
+ bytevector-u8-transduce
+ port-transduce
+ generator-transduce
+
+ tmap
+ tfilter
+ tremove
+ treplace
+ tfilter-map
+ tdrop
+ tdrop-while
+ ttake
+ ttake-while
+ tconcatenate
+ tappend-map
+ tdelete-neighbor-duplicates
+ tdelete-duplicates
+ tflatten
+ tsegment
+ tpartition
+ tadd-between
+ tenumerate
+ tlog))
+(cond-expand-provide (current-module) '(srfi-171))
+
+
+;; A placeholder for a unique "nothing".
+(define nothing (list 'nothing))
+(define (nothing? val)
+ (eq? val nothing))
+
+;;; Reducing functions meant to be used at the end at the transducing process.
+(define rcons
+ (case-lambda
+ "A transducer-friendly consing reducer with '() as identity."
+ (() '())
+ ((lst) (reverse! lst))
+ ((lst x) (cons x lst))))
+
+(define reverse-rcons
+ (case-lambda
+ "A transducer-friendly consing reducer with '() as identity.
+The resulting list is in reverse order."
+ (() '())
+ ((lst) lst)
+ ((lst x) (cons x lst))))
+
+(define rcount
+ (case-lambda
+ "A counting reducer that counts any elements that made it through the
+transduction.
+@example
+(transduce (tfilter odd?) tcount (list 1 2 3)) @result{} 2
+@end example"
+ (() 0)
+ ((result) result)
+ ((result input)
+ (+ 1 result))))
+
+(define (rany pred)
+ (case-lambda
+ "Return a reducer that tests input using @var{pred}. If any input satisfies
+@var{pred}, return @code{(reduced value)}."
+ (() #f)
+ ((result) result)
+ ((result input)
+ (let ((test (pred input)))
+ (if test
+ (reduced test)
+ #f)))))
+
+(define (revery pred)
+ (case-lambda
+ "Returns a reducer that tests input using @var{pred}. If any input
satisfies
+@var{pred}, it returns @code{(reduced #f)}."
+ (() #t)
+ ((result) result)
+ ((result input)
+ (let ((test (pred input)))
+ (if (and result test)
+ test
+ (reduced #f))))))
+
+
+(define list-transduce
+ (case-lambda
+ ((xform f coll)
+ (list-transduce xform f (f) coll))
+ ((xform f init coll)
+ (let* ((xf (xform f))
+ (result (list-reduce xf init coll)))
+ (xf result)))))
+
+(define vector-transduce
+ (case-lambda
+ ((xform f coll)
+ (vector-transduce xform f (f) coll))
+ ((xform f init coll)
+ (let* ((xf (xform f))
+ (result (vector-reduce xf init coll)))
+ (xf result)))))
+
+(define string-transduce
+ (case-lambda
+ ((xform f coll)
+ (string-transduce xform f (f) coll))
+ ((xform f init coll)
+ (let* ((xf (xform f))
+ (result (string-reduce xf init coll)))
+ (xf result)))))
+
+(define bytevector-u8-transduce
+ (case-lambda
+ ((xform f coll)
+ (bytevector-u8-transduce xform f (f) coll))
+ ((xform f init coll)
+ (let* ((xf (xform f))
+ (result (bytevector-u8-reduce xf init coll)))
+ (xf result)))))
+
+(define port-transduce
+ (case-lambda
+ ((xform f by)
+ (generator-transduce xform f by))
+ ((xform f by port)
+ (port-transduce xform f (f) by port))
+ ((xform f init by port)
+ (let* ((xf (xform f))
+ (result (port-reduce xf init by port)))
+ (xf result)))))
+
+(define generator-transduce
+ (case-lambda
+ ((xform f gen)
+ (generator-transduce xform f (f) gen))
+ ((xform f init gen)
+ (let* ((xf (xform f))
+ (result (generator-reduce xf init gen)))
+ (xf result)))))
+
+;;; Transducers
+(define (tmap f)
+ (lambda (reducer)
+ (case-lambda
+ (() (reducer))
+ ((result) (reducer result))
+ ((result input)
+ (reducer result (f input))))))
+
+(define (tfilter pred)
+ (lambda (reducer)
+ (case-lambda
+ (() (reducer))
+ ((result) (reducer result))
+ ((result input)
+ (if (pred input)
+ (reducer result input)
+ result)))))
+
+(define (tremove pred)
+ (lambda (reducer)
+ (case-lambda
+ (() (reducer))
+ ((result) (reducer result))
+ ((result input)
+ (if (not (pred input))
+ (reducer result input)
+ result)))))
+
+(define (tfilter-map f)
+ (compose (tmap f) (tfilter values)))
+
+(define (make-replacer map)
+ (cond
+ ((list? map)
+ (lambda (x)
+ (match (assoc x map)
+ ((_ . replacer) replacer)
+ (#f x))))
+ ((srfi69:hash-table? map)
+ (lambda (x)
+ (srfi69:hash-table-ref/default map x x)))
+ ((rnrs:hashtable? map)
+ (lambda (x)
+ (rnrs:hashtable-ref map x x)))
+ ((hash-table? map)
+ (lambda (x)
+ (hash-ref map x x)))
+ ((procedure? map) map)
+ (else
+ (error "Unsupported mapping in treplace" map))))
+
+
+(define (treplace map)
+ "Return a transducer that searches for any input in @var{map}, which may
+be a guile native hashtable, an R6RS hashtable, a srfi-69 hashtable, an alist
+or a one-argument procedure taking one value and producing either the same
+value or a replacement one. Alists and guile-native hashtbles compare keys
+using @code{equal?} whereas the other mappings use whatever equality predicate
+they were created with."
+ (tmap (make-replacer map)))
+
+(define (tdrop n)
+ (lambda (reducer)
+ (let ((new-n (+ 1 n)))
+ (case-lambda
+ (() (reducer))
+ ((result) (reducer result))
+ ((result input)
+ (set! new-n (- new-n 1))
+ (if (positive? new-n)
+ result
+ (reducer result input)))))))
+
+(define (tdrop-while pred)
+ (lambda (reducer)
+ (let ((drop? #t))
+ (case-lambda
+ (() (reducer))
+ ((result) (reducer result))
+ ((result input)
+ (if (and (pred input) drop?)
+ result
+ (begin
+ (set! drop? #f)
+ (reducer result input))))))))
+
+(define (ttake n)
+ (lambda (reducer)
+ ;; we need to reset new-n for every new transduction
+ (let ((new-n n))
+ (case-lambda
+ (() (reducer))
+ ((result) (reducer result))
+ ((result input)
+ (let ((result (if (positive? new-n)
+ (reducer result input)
+ result)))
+ (set! new-n (- new-n 1))
+ (if (not (positive? new-n))
+ (ensure-reduced result)
+ result)))))))
+
+(define ttake-while
+ (case-lambda
+ ((pred) (ttake-while pred (lambda (result input) result)))
+ ((pred retf)
+ (lambda (reducer)
+ (let ((take? #t))
+ (case-lambda
+ (() (reducer))
+ ((result) (reducer result))
+ ((result input)
+ (if (and take? (pred input))
+ (reducer result input)
+ (begin
+ (set! take? #f)
+ (ensure-reduced (retf result input)))))))))))
+
+(define (tconcatenate reducer)
+ (let ((preserving-reducer (preserving-reduced reducer)))
+ (case-lambda
+ (() (reducer))
+ ((result) (reducer result))
+ ((result input)
+ (list-reduce preserving-reducer result input)))))
+
+(define (tappend-map f)
+ (compose (tmap f) tconcatenate))
+
+(define (tflatten reducer)
+ "tflatten is a transducer that flattens any list passed through it.
+@example
+(list-transduce tflatten conj (list 1 2 (list 3 4 '(5 6) 7 8)))
+@result{} (1 2 3 4 5 6 7 8)
+@end example"
+ (case-lambda
+ (() '())
+ ((result) (reducer result))
+ ((result input)
+ (if (list? input)
+ (list-reduce (preserving-reduced (tflatten reducer)) result input)
+ (reducer result input)))))
+
+
+(define tdelete-neighbor-duplicates
+ (case-lambda
+ (() (tdelete-neighbor-duplicates equal?))
+ ((equality-pred?)
+ (lambda (reducer)
+ (let ((prev nothing))
+ (case-lambda
+ (() (reducer))
+ ((result) (reducer result))
+ ((result input)
+ (if (equality-pred? prev input)
+ result
+ (begin
+ (set! prev input)
+ (reducer result input))))))))))
+
+
+(define* (tdelete-duplicates #:optional (equality-pred? equal?))
+ "tdelede-duplicates is a transducer that deletes any subsequent duplicate
+elements. Comparisons is done using @var{equality-pred?}, which defaults
+to @code{equal?}."
+ (lambda (reducer)
+ (let ((already-seen (srfi69:make-hash-table equality-pred?)))
+ (case-lambda
+ (() (reducer))
+ ((result) (reducer result))
+ ((result input)
+ (if (srfi69:hash-table-exists? already-seen input)
+ result
+ (begin
+ (srfi69:hash-table-set! already-seen input #t)
+ (reducer result input))))))))
+
+(define (tsegment n)
+ "Return a transducer that partitions the input into
+lists of @var{n} items. If the input stops it flushes any
+accumulated state, which may be shorter than @var{n}."
+ (if (not (and (integer? n) (positive? n)))
+ (error "argument to tsegment must be a positive integer")
+ (lambda (reducer)
+ (let ((i 0)
+ (collect (make-vector n)))
+ (case-lambda
+ (() (reducer))
+ ((result)
+ ;; if there is anything collected when we are asked to quit
+ ;; we flush it to the remaining transducers
+ (let ((result
+ (if (zero? i)
+ result
+ (reducer result (vector->list collect 0 i)))))
+ (set! i 0)
+ ;; now finally, pass it downstreams
+ (if (reduced? result)
+ (reducer (unreduce result))
+ (reducer result))))
+ ((result input)
+ (vector-set! collect i input)
+ (set! i (+ i 1))
+ ;; If we have collected enough input we can pass it on downstream
+ (if (< i n)
+ result
+ (let ((next-input (vector->list collect 0 i)))
+ (set! i 0)
+ (reducer result next-input)))))))))
+
+(define (tpartition f)
+ "Return a transducer that partitions any input by whenever
+@code{(f input)} changes value. "
+ (lambda (reducer)
+ (let* ((prev nothing)
+ (collect '()))
+ (case-lambda
+ (() (reducer))
+ ((result)
+ (let ((result
+ (if (null? collect)
+ result
+ (reducer result (reverse! collect)))))
+ (set! collect '())
+ (if (reduced? result)
+ (reducer (unreduce result))
+ (reducer result))))
+ ((result input)
+ (let ((fout (f input)))
+ (cond
+ ((or (equal? fout prev) (nothing? prev)) ; collect
+ (set! prev fout)
+ (set! collect (cons input collect))
+ result)
+ (else ; flush what we collected already to the reducer
+ (let ((next-input (reverse! collect)))
+ (set! prev fout)
+ (set! collect (list input))
+ (reducer result next-input))))))))))
+
+(define (tadd-between elem)
+ "Return a transducer that interposes @var{elem} between each value pushed
+through the transduction."
+ (lambda (reducer)
+ (let ((send-elem? #f))
+ (case-lambda
+ (() (reducer))
+ ((result)
+ (reducer result))
+ ((result input)
+ (if send-elem?
+ (let ((result (reducer result elem)))
+ (if (reduced? result)
+ result
+ (reducer result input)))
+ (begin
+ (set! send-elem? #t)
+ (reducer result input))))))))
+
+(define* (tenumerate #:optional (n 0))
+ "Return a transducer that indexes every value passed through into a cons
+pair as @code{(index . value)}. Starts at @var{n} which defaults to 0."
+ (lambda (reducer)
+ (let ((n n))
+ (case-lambda
+ (() (reducer))
+ ((result) (reducer result))
+ ((result input)
+ (let ((input (cons n input)))
+ (set! n (+ n 1))
+ (reducer result input)))))))
+
+(define* (tlog #:optional
+ (log-function (lambda (result input) (write input) (newline))))
+ (lambda (reducer)
+ (case-lambda
+ (() (reducer))
+ ((result) (reducer result))
+ ((result input)
+ (log-function result input)
+ (reducer result input)))))
+
+
+
+
diff --git a/module/srfi/srfi-171/gnu.scm b/module/srfi/srfi-171/gnu.scm
new file mode 100644
index 0000000..45a4e19
--- /dev/null
+++ b/module/srfi/srfi-171/gnu.scm
@@ -0,0 +1,65 @@
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (srfi srfi-171 gnu)
+ #:use-module (srfi srfi-171)
+ #:use-module (srfi srfi-171 meta)
+ #:export (tbatch tfold))
+
+
+(define tbatch
+ (case-lambda
+ ((reducer)
+ (tbatch identity reducer))
+ ((t r)
+ (lambda (reducer)
+ (let ((cur-reducer (t r))
+ (cur-state (r)))
+ (case-lambda
+ (() (reducer))
+ ((result)
+ (if (equal? cur-state (cur-reducer))
+ (reducer result)
+ (let ((new-res (reducer result (cur-reducer cur-state))))
+ (if (reduced? new-res)
+ (reducer (unreduce new-res))
+ (reducer new-res)))))
+ ((result value)
+ (let ((val (cur-reducer cur-state value)))
+ (cond
+ ;; cur-reducer is done. Push value downstream
+ ;; re-instantiate the state and the cur-reducer
+ ((reduced? val)
+ (let ((unreduced-val (unreduce val)))
+ (set! cur-reducer (t r))
+ (set! cur-state (cur-reducer))
+ (reducer result (cur-reducer unreduced-val))))
+ (else
+ (set! cur-state val)
+ result))))))))))
+
+
+(define* (tfold reducer #:optional (seed (reducer)))
+ (lambda (r)
+ (let ((state seed))
+ (case-lambda
+ (() (r))
+ ((result) (r result))
+ ((result value)
+ (set! state (reducer state value))
+ (if (reduced? state)
+ (reduced (reducer (unreduce state)))
+ (r result state)))))))
diff --git a/module/srfi/srfi-171/meta.scm b/module/srfi/srfi-171/meta.scm
new file mode 100644
index 0000000..771f707
--- /dev/null
+++ b/module/srfi/srfi-171/meta.scm
@@ -0,0 +1,113 @@
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+(define-module (srfi srfi-171 meta)
+ #:use-module (srfi srfi-9)
+ #:use-module ((rnrs bytevectors) #:select (bytevector-length
bytevector-u8-ref))
+ #:export (reduced reduced?
+ unreduce
+ ensure-reduced
+ preserving-reduced
+
+ list-reduce
+ vector-reduce
+ string-reduce
+ bytevector-u8-reduce
+ port-reduce
+ generator-reduce))
+
+
+;; A reduced value is stops the transduction.
+(define-record-type <reduced>
+ (reduced val)
+ reduced?
+ (val unreduce))
+
+(define (ensure-reduced x)
+ "Ensure that @var{x} is reduced"
+ (if (reduced? x)
+ x
+ (reduced x)))
+
+;; helper function that wraps a reduced value twice since reducing functions
(like list-reduce)
+;; unwraps them. tconcatenate is a good example: it re-uses it's reducer on
it's input using list-reduce.
+;; If that reduction finishes early and returns a reduced value, list-reduce
would "unreduce"
+;; that value and try to continue the transducing process.
+(define (preserving-reduced reducer)
+ (lambda (a b)
+ (let ((return (reducer a b)))
+ (if (reduced? return)
+ (reduced return)
+ return))))
+
+;; This is where the magic tofu is cooked
+(define (list-reduce f identity lst)
+ (if (null? lst)
+ identity
+ (let ((v (f identity (car lst))))
+ (if (reduced? v)
+ (unreduce v)
+ (list-reduce f v (cdr lst))))))
+
+(define (vector-reduce f identity vec)
+ (let ((len (vector-length vec)))
+ (let loop ((i 0) (acc identity))
+ (if (= i len)
+ acc
+ (let ((acc (f acc (vector-ref vec i))))
+ (if (reduced? acc)
+ (unreduce acc)
+ (loop (+ i 1) acc)))))))
+
+(define (string-reduce f identity str)
+ (let ((len (string-length str)))
+ (let loop ((i 0) (acc identity))
+ (if (= i len)
+ acc
+ (let ((acc (f acc (string-ref str i))))
+ (if (reduced? acc)
+ (unreduce acc)
+ (loop (+ i 1) acc)))))))
+
+(define (bytevector-u8-reduce f identity vec)
+ (let ((len (bytevector-length vec)))
+ (let loop ((i 0) (acc identity))
+ (if (= i len)
+ acc
+ (let ((acc (f acc (bytevector-u8-ref vec i))))
+ (if (reduced? acc)
+ (unreduce acc)
+ (loop (+ i 1) acc)))))))
+
+(define (port-reduce f identity reader port)
+ (let loop ((val (reader port)) (acc identity))
+ (if (eof-object? val)
+ acc
+ (let ((acc (f acc val)))
+ (if (reduced? acc)
+ (unreduce acc)
+ (loop (reader port) acc))))))
+
+(define (generator-reduce f identity gen)
+ (let loop ((val (gen)) (acc identity))
+ (if (eof-object? val)
+ acc
+ (let ((acc (f acc val)))
+ (if (reduced? acc)
+ (unreduce acc)
+ (loop (gen) acc))))))
+
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 0dc86b0..8158aaf 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -160,6 +160,7 @@ SCM_TESTS = tests/00-initial-env.test \
tests/srfi-98.test \
tests/srfi-105.test \
tests/srfi-111.test \
+ tests/srfi-171.test \
tests/srfi-4.test \
tests/srfi-9.test \
tests/statprof.test \
diff --git a/test-suite/tests/srfi-171.test b/test-suite/tests/srfi-171.test
new file mode 100644
index 0000000..1ef7bc5
--- /dev/null
+++ b/test-suite/tests/srfi-171.test
@@ -0,0 +1,267 @@
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-srfi-171)
+ #:use-module (test-suite lib)
+ #:use-module (ice-9 hash-table)
+ #:use-module (srfi srfi-171)
+ #:use-module (srfi srfi-171 gnu)
+ #:use-module (rnrs bytevectors)
+ #:use-module ((rnrs hashtables) #:prefix rnrs:)
+ #:use-module ((srfi srfi-69) #:prefix srfi:))
+
+(define (add1 x) (+ x 1))
+
+(define numeric-list (iota 5))
+(define numeric-vec (list->vector numeric-list))
+(define bv (list->u8vector numeric-list))
+(define test-string "0123456789abcdef")
+(define list-of-chars (string->list test-string))
+
+;; for testing all treplace variations
+(define replace-alist '((1 . s) (2 . c) (3 . h) (4 . e) (5 . m)))
+(define guile-hashtable (alist->hash-table replace-alist))
+(define srfi69-hashtable (srfi:alist->hash-table replace-alist))
+(define rnrs-hashtable (rnrs:make-eq-hashtable))
+(rnrs:hashtable-set! rnrs-hashtable 1 's)
+(rnrs:hashtable-set! rnrs-hashtable 2 'c)
+(rnrs:hashtable-set! rnrs-hashtable 3 'h)
+(rnrs:hashtable-set! rnrs-hashtable 4 'e)
+(rnrs:hashtable-set! rnrs-hashtable 5 'm)
+(define (replace-function val)
+ (case val
+ ((1) 's)
+ ((2) 'c)
+ ((3) 'h)
+ ((4) 'e)
+ ((5) 'm)
+ (else val)))
+
+;; Test procedures for port-transduce
+;; broken out to properly close port
+(define (port-transduce-test)
+ (let* ((port (open-input-string "0 1 2 3 4"))
+ (res (equal? 15 (port-transduce (tmap add1) + read
+ (open-input-string "0 1 2 3 4")))))
+ (close-port port)
+ res))
+(define (port-transduce-with-identity-test)
+ (let* ((port (open-input-string "0 1 2 3 4"))
+ (res (equal? 15 (port-transduce (tmap add1)
+ +
+ 0
+ read
+ (open-input-string "0 1 2 3 4")))))
+ (close-port port)
+ res))
+
+(with-test-prefix "transducers"
+ (pass-if "tmap" (equal? '(1 2 3 4 5) (list-transduce (tmap add1)
+ rcons
+ numeric-list)))
+
+ (pass-if "tfilter" (equal? '(0 2 4) (list-transduce (tfilter even?)
+ rcons
+ numeric-list)))
+
+ (pass-if "tfilter+tmap" (equal?
+ '(1 3 5)
+ (list-transduce (compose (tfilter even?) (tmap
add1))
+ rcons
+ numeric-list)))
+
+ (pass-if "tfilter-map"
+ (equal? '(1 3 5)
+ (list-transduce (tfilter-map
+ (lambda (x)
+ (if (even? x)
+ (+ x 1)
+ #f)))
+ rcons numeric-list)))
+
+ (pass-if "tremove"
+ (equal? (list-transduce (tremove char-alphabetic?)
+ rcount
+ list-of-chars)
+ (string-transduce (tremove char-alphabetic?)
+ rcount
+ test-string)))
+
+ (pass-if "treplace with alist"
+ (equal? '(s c h e m e r o c k s)
+ (list-transduce (treplace replace-alist)
+ rcons
+ '(1 2 3 4 5 4 r o c k s) )))
+
+ (pass-if "treplace with replace-function"
+ (equal? '(s c h e m e r o c k s)
+ (list-transduce (treplace replace-function)
+ rcons
+ '(1 2 3 4 5 4 r o c k s))))
+
+
+ (pass-if "treplace with guile hash-table"
+ (equal? '(s c h e m e r o c k s)
+ (list-transduce (treplace guile-hashtable)
+ rcons
+ '(1 2 3 4 5 4 r o c k s))))
+
+ (pass-if "treplace with srfi-69 hash-table"
+ (equal? '(s c h e m e r o c k s)
+ (list-transduce (treplace srfi69-hashtable)
+ rcons
+ '(1 2 3 4 5 4 r o c k s))))
+
+ (pass-if "treplace with rnrs hash-table"
+ (equal? '(s c h e m e r o c k s)
+ (list-transduce (treplace rnrs-hashtable)
+ rcons
+ '(1 2 3 4 5 4 r o c k s))))
+
+ (pass-if "ttake"
+ (equal? 6 (list-transduce (ttake 4) + numeric-list)))
+
+ (pass-if "tdrop"
+ (equal? 7 (list-transduce (tdrop 3) + numeric-list)))
+
+ (pass-if "tdrop-while"
+ (equal? '(3 4)
+ (list-transduce (tdrop-while (lambda (x) (< x 3)))
+ rcons
+ numeric-list)))
+
+ (pass-if "ttake-while"
+ (equal? '(0 1 2)
+ (list-transduce (ttake-while (lambda (x) (< x 3)))
+ rcons
+ numeric-list)))
+
+ (pass-if "tconcatenate"
+ (equal? '(0 1 2 3 4) (list-transduce tconcatenate
+ rcons
+ '((0 1) (2 3) (4)))))
+
+ (pass-if "tappend-map"
+ (equal? '(1 2 2 4 3 6)
+ (list-transduce (tappend-map (lambda (x) (list x (* x 2))))
+ rcons
+ '(1 2 3))))
+
+ (pass-if "tdelete-neighbor-duplicates"
+ (equal? '(1 2 1 2 3)
+ (list-transduce (tdelete-neighbor-duplicates)
+ rcons
+ '(1 1 1 2 2 1 2 3 3))))
+
+ (pass-if "tdelete-neighbor-duplicates with equality predicate"
+ (equal? '(a b c "hej" "hej")
+ (list-transduce (tdelete-neighbor-duplicates eq?)
+ rcons
+ (list 'a 'a 'b 'c 'c "hej" (string #\h #\e #\j)))))
+
+ (pass-if "tdelete-duplicates"
+ (equal? '(1 2 3 4)
+ (list-transduce (tdelete-duplicates)
+ rcons
+ '(1 1 2 1 2 3 3 1 2 3 4))))
+
+ (pass-if "tdelete-duplicates with predicate"
+ (equal? '("hej" "hopp")
+ (list-transduce (tdelete-duplicates string-ci=?)
+ rcons
+ (list "hej" "HEJ" "hopp" "HOPP" "heJ"))))
+
+ (pass-if "tflatten"
+ (equal? '(1 2 3 4 5 6 7 8 9)
+ (list-transduce tflatten rcons '((1 2) 3 (4 (5 6) 7) 8 (9)))))
+
+ (pass-if "tpartition"
+ (equal? '((1 1 1 1) (2 2 2 2) (3 3 3) (4 4 4 4))
+ (list-transduce (tpartition even?)
+ rcons
+ '(1 1 1 1 2 2 2 2 3 3 3 4 4 4 4))))
+
+ (pass-if "tsegment"
+ (equal? '((0 1) (2 3) (4))
+ (vector-transduce (tsegment 2) rcons numeric-vec)))
+
+ (pass-if "tadd-between"
+ (equal? '(0 and 1 and 2 and 3 and 4)
+ (list-transduce (tadd-between 'and) rcons numeric-list)))
+
+ (pass-if "tenumerate"
+ (equal? '((-1 . 0) (0 . 1) (1 . 2) (2 . 3) (3 . 4))
+ (list-transduce (tenumerate (- 1)) rcons numeric-list)))
+
+ (pass-if "tbatch"
+ (equal?
+ '((0 1) (2 3) (4))
+ (list-transduce (tbatch (ttake 2) rcons) rcons numeric-list)))
+
+ (pass-if "tfold"
+ (equal?
+ '(0 1 3 6 10)
+ (list-transduce (tfold +) rcons numeric-list))))
+
+
+(with-test-prefix "x-transduce"
+ (pass-if "list-transduce"
+ (equal? 15 (list-transduce (tmap add1) + numeric-list)))
+
+ (pass-if "list-transduce with identity"
+ (equal? 15 (list-transduce (tmap add1) + 0 numeric-list)))
+
+ (pass-if "vector-transduce"
+ (equal? 15 (vector-transduce (tmap add1) + numeric-vec)))
+
+ (pass-if "vector-transduce with identity"
+ (equal? 15
+ (vector-transduce (tmap add1) + 0 numeric-vec)))
+
+ (pass-if "port-transduce" (port-transduce-test))
+ (pass-if "port-transduce with identity" (port-transduce-with-identity-test))
+
+ ;; Converts each numeric char to it's corresponding integer and sums them.
+ (pass-if "string-transduce"
+ (equal?
+ 15
+ (string-transduce (tmap (lambda (x) (- (char->integer x) 47))) +
"01234")))
+
+ (pass-if "string-transduce with identity"
+ (equal?
+ 15
+ (string-transduce (tmap (lambda (x) (- (char->integer x) 47)))
+ +
+ 0
+ "01234")))
+
+ (pass-if "generator-transduce"
+ (equal?
+ '(1 2 3)
+ (parameterize ((current-input-port (open-input-string "1 2 3")))
+ (generator-transduce (tmap (lambda (x) x)) rcons read))))
+
+ (pass-if "generator-transduce with identity"
+ (equal?
+ '(1 2 3)
+ (parameterize ((current-input-port (open-input-string "1 2 3")))
+ (generator-transduce (tmap (lambda (x) x)) rcons '() read))))
+
+ (pass-if "bytevector-u8-transduce"
+ (equal? 15 (bytevector-u8-transduce (tmap add1) + bv)))
+
+ (pass-if "bytevector-u8-transduce with identity"
+ (equal? 15 (bytevector-u8-transduce (tmap add1) + 0 bv))))
