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 <ludo@gnu.org>

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:

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					\
 						\

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)))))
+
+
+
+

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)))))))

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))))))
+

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			\

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))))