From 7e8d3b22ba5f814c40dbb5ab616a318c0cdc2f3e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Linus=20Bj=C3=B6rnstam?= <linus.bjornstam@fastmail.se>
Date: Sun, 22 Dec 2019 15:38:34 +0100
Subject: [PATCH 1/2] Added srfi-171 to guile under the module name (srfi
 srfi-171).

For more info, read the SRFI document: https://srfi.schemers.org/srfi-171/srfi-171.html
---
 module/srfi/srfi-171.scm       | 498 +++++++++++++++++++++++++++++++++
 module/srfi/srfi-171/gnu.scm   |  49 ++++
 module/srfi/srfi-171/meta.scm  | 115 ++++++++
 test-suite/tests/srfi-171.test | 195 +++++++++++++
 4 files changed, 857 insertions(+)
 create mode 100644 module/srfi/srfi-171.scm
 create mode 100644 module/srfi/srfi-171/gnu.scm
 create mode 100644 module/srfi/srfi-171/meta.scm
 create mode 100644 test-suite/tests/srfi-171.test

diff --git a/module/srfi/srfi-171.scm b/module/srfi/srfi-171.scm
new file mode 100644
index 000000000..7e8dc603f
--- /dev/null
+++ b/module/srfi/srfi-171.scm
@@ -0,0 +1,498 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Copyright 2019 Linus Björnstam
+;;
+;; You may use this code under either the license in the SRFI document or the
+;; license below.
+;;
+;; Permission to use, copy, modify, and/or distribute this software for any
+;; purpose with or without fee is hereby granted, provided that the above
+;; copyright notice and this permission notice appear in all source copies.
+;; The software is provided "as is", without any express or implied warranties.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;; This module name is guile-specific. The correct module name is of course
+;; (srfi 171)
+(define-module (srfi srfi-171)
+  #:declarative? #t
+  #: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))
+
+
+
+;; A special value to be used as a placeholder where no value has been set and #f
+;; doesn't cut it. Not exported.
+
+(define-record-type <nothing>
+  (make-nothing)
+  nothing?)
+(define nothing (make-nothing))
+
+
+;; helper function which ensures x is reduced.
+(define (ensure-reduced x)
+  (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 f)
+  (lambda (a b)
+    (let ((return (f a b)))
+      (if (reduced? return)
+          (reduced return)
+          return))))
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Reducing functions meant to be used at the end at the transducing
+;; process.    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; a transducer-friendly cons with the empty list as identity
+(define rcons
+  (case-lambda
+    (() '())
+    ((lst) (reverse! lst))
+    ((lst x) (cons x lst))))
+
+
+(define reverse-rcons
+  (case-lambda
+    (() '())
+    ((lst) lst)
+    ((lst x) (cons x lst))))
+
+
+;; Use this as the f in transduce to count the amount of elements passed through.
+;; (transduce (tfilter odd?) tcount (list 1 2 3)) => 2
+(define rcount
+  (case-lambda
+    (() 0)
+    ((result) result)
+    ((result input)
+     (+ 1  result))))
+
+
+;; These two take a predicate and returns reducing functions that behave
+;; like any and every from srfi-1
+(define (rany pred)
+  (case-lambda
+    (() #f)
+    ((result) result)
+    ((result input)
+     (let ((test (pred input)))
+       (if test
+           (reduced test)
+           #f)))))
+
+
+(define (revery pred)
+  (case-lambda
+    (() #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)
+      (let ((replacer? (assoc x map)))
+        (if replacer?
+            (cdr replacer?)
+            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))))
+
+;; For alists and guile's native hash tables, compare using equal?.
+;; For r6rs and srfi69 hashtables, use whatever the hash table has configured.
+(define (treplace map)
+  (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))
+
+
+
+;; Flattens everything and passes each value through the reducer
+;; (list-transduce tflatten conj (list 1 2 (list 3 4 '(5 6) 7 8))) => (1 2 3 4 5 6 7 8)
+(define tflatten
+  (lambda (reducer)
+    (case-lambda
+      (() '())
+      ((result) (reducer result))
+      ((result input)
+       (if (list? input)
+           (list-reduce (preserving-reduced (tflatten reducer)) result input)
+           (reducer result input))))))
+
+
+
+;; removes duplicate consecutive elements
+(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))))))))))
+
+
+;; Deletes all duplicates that passes through.
+(define tdelete-duplicates
+  (case-lambda
+    (() (tdelete-duplicates equal?))
+    ((equality-pred?)
+     (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))))))))))
+
+;; Partitions the input into lists of N items. If the input stops it flushes whatever
+;; it has collected, which may be shorter than n.
+;; I am not sure about the correctness about this. It seems to work.
+(define (tsegment 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
+               (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)))))))))
+
+
+;; I am not sure about the correctness of this. It seems to work.
+;; we could maybe make it faster?
+(define (tpartition f)
+  (lambda (reducer)
+    (let* ((prev nothing)
+           (collect '()))
+      (case-lambda
+        (() (reducer))
+        ((result)
+         (let ((result
+                (if (null? collect)
+                    result
+                    (reducer result (reverse! collect)))))
+           (set! collect '())
+           (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))))))))))
+
+
+;; Interposes element between each value pushed through the transduction.
+(define (tadd-between elem)
+  (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))))))))
+
+
+;; indexes every value passed through in a cons pair as in (index . value). By default starts at 0
+(define tenumerate
+  (case-lambda
+    (() (tenumerate 0))
+    ((n)
+     (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
+  (case-lambda
+    (() (tlog (lambda (result input) (write input) (newline))))
+    ((log-function)
+     (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 000000000..9aa8ab28e
--- /dev/null
+++ b/module/srfi/srfi-171/gnu.scm
@@ -0,0 +1,49 @@
+(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 000000000..dd1fd06c4
--- /dev/null
+++ b/module/srfi/srfi-171/meta.scm
@@ -0,0 +1,115 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Copyright 2019 Linus Björnstam
+;;
+;; You may use this code under either the license in the SRFI document or the
+;; license below.
+;;
+;; Permission to use, copy, modify, and/or distribute this software for any
+;; purpose with or without fee is hereby granted, provided that the above
+;; copyright notice and this permission notice appear in all source copies.
+;; The software is provided "as is", without any express or implied warranties.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;; This module name is guile-specific. The correct name is of course
+;; (srfi 171 meta)
+(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))
+
+
+;; helper function which ensures x is reduced.
+(define (ensure-reduced x)
+  (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/tests/srfi-171.test b/test-suite/tests/srfi-171.test
new file mode 100644
index 000000000..c6d574af2
--- /dev/null
+++ b/test-suite/tests/srfi-171.test
@@ -0,0 +1,195 @@
+;; TODO: test all transducers that take an equality predicate
+;; TODO: test treplace with all kinds of hash tables
+
+(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))))
-- 
2.24.1