From 15b3449b854e6c3caaa35ae1e87751b7f61a0c68 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Marc=20Nieper-Wi=C3=9Fkirchen?= <marc@nieper-wisskirchen.de>
Date: Tue, 5 May 2020 22:28:10 +0200
Subject: [PATCH] Implement SRFI 158.

---
 lib/srfi/158.scm      | 583 ++++++++++++++++++++++++++++++++++++++++++
 lib/srfi/158.sld      |  23 ++
 lib/srfi/158/test.sld | 267 +++++++++++++++++++
 tests/lib-tests.scm   |   2 +
 4 files changed, 875 insertions(+)
 create mode 100644 lib/srfi/158.scm
 create mode 100644 lib/srfi/158.sld
 create mode 100644 lib/srfi/158/test.sld

diff --git a/lib/srfi/158.scm b/lib/srfi/158.scm
new file mode 100644
index 00000000..696eb9c8
--- /dev/null
+++ b/lib/srfi/158.scm
@@ -0,0 +1,583 @@
+;; Chibi Scheme version of any
+
+(define (any pred ls)
+  (if (null? (cdr ls))
+    (pred (car ls))
+    ((lambda (x) (if x x (any pred (cdr ls)))) (pred (car ls)))))
+
+;; list->bytevector
+(define (list->bytevector list)
+  (let ((vec (make-bytevector (length list) 0)))
+    (let loop ((i 0) (list list))
+      (if (null? list)
+        vec
+        (begin
+          (bytevector-u8-set! vec i (car list))
+          (loop (+ i 1) (cdr list)))))))
+
+
+;; generator
+(define (generator . args)
+  (lambda () (if (null? args)
+               (eof-object)
+               (let ((next (car args)))
+                (set! args (cdr args))
+                next))))
+
+;; circular-generator
+(define (circular-generator . args)
+  (let ((base-args args))
+    (lambda ()
+      (when (null? args)
+        (set! args base-args))
+          (let ((next (car args)))
+                (set! args (cdr args))
+                next))))
+
+
+;; make-iota-generator
+(define make-iota-generator
+  (case-lambda ((count) (make-iota-generator count 0 1))
+               ((count start) (make-iota-generator count start 1))
+               ((count start step) (make-iota count start step))))
+
+;; make-iota
+(define (make-iota count start step)
+  (lambda ()
+    (cond
+      ((<= count 0)
+       (eof-object))
+      (else
+        (let ((result start))
+         (set! count (- count 1))
+         (set! start (+ start step))
+         result)))))
+
+
+;; make-range-generator
+(define make-range-generator
+  (case-lambda ((start end) (make-range-generator start end 1))
+               ((start) (make-infinite-range-generator start))
+               ((start end step)
+                (set! start (- (+ start step) step))
+                (lambda () (if (< start end)
+                             (let ((v start))
+                              (set! start (+ start step))
+                              v)
+                             (eof-object))))))
+
+(define (make-infinite-range-generator start)
+  (lambda ()
+    (let ((result start))
+     (set! start (+ start 1))
+     result)))
+
+
+
+;; make-coroutine-generator
+(define (make-coroutine-generator proc)
+  (define return #f)
+  (define resume #f)
+  (define yield (lambda (v) (call/cc (lambda (r) (set! resume r) (return v)))))
+  (lambda () (call/cc (lambda (cc) (set! return cc)
+                        (if resume
+                          (resume (if #f #f))  ; void? or yield again?
+                          (begin (proc yield)
+                                 (set! resume (lambda (v) (return (eof-object))))
+                                 (return (eof-object))))))))
+
+
+;; list->generator
+(define (list->generator lst)
+  (lambda () (if (null? lst)
+               (eof-object)
+               (let ((next (car lst)))
+                (set! lst (cdr lst))
+                next))))
+
+
+;; vector->generator
+(define vector->generator
+  (case-lambda ((vec) (vector->generator vec 0 (vector-length vec)))
+               ((vec start) (vector->generator vec start (vector-length vec)))
+               ((vec start end)
+                (lambda () (if (>= start end)
+                             (eof-object)
+                             (let ((next (vector-ref vec start)))
+                              (set! start (+ start 1))
+                              next))))))
+
+
+;; reverse-vector->generator
+(define reverse-vector->generator
+  (case-lambda ((vec) (reverse-vector->generator vec 0 (vector-length vec)))
+               ((vec start) (reverse-vector->generator vec start (vector-length vec)))
+               ((vec start end)
+                (lambda () (if (>= start end)
+                             (eof-object)
+                             (let ((next (vector-ref vec (- end 1))))
+                              (set! end (- end 1))
+                              next))))))
+
+
+;; string->generator
+(define string->generator
+  (case-lambda ((str) (string->generator str 0 (string-length str)))
+               ((str start) (string->generator str start (string-length str)))
+               ((str start end)
+                (lambda () (if (>= start end)
+                             (eof-object)
+                             (let ((next (string-ref str start)))
+                              (set! start (+ start 1))
+                              next))))))
+
+
+;; bytevector->generator
+(define bytevector->generator
+  (case-lambda ((str) (bytevector->generator str 0 (bytevector-length str)))
+               ((str start) (bytevector->generator str start (bytevector-length str)))
+               ((str start end)
+                (lambda () (if (>= start end)
+                             (eof-object)
+                             (let ((next (bytevector-u8-ref str start)))
+                              (set! start (+ start 1))
+                              next))))))
+
+
+;; make-for-each-generator
+;FIXME: seems to fail test
+(define (make-for-each-generator for-each obj)
+  (make-coroutine-generator (lambda (yield) (for-each yield obj))))
+
+
+;; make-unfold-generator
+(define (make-unfold-generator stop? mapper successor seed)
+  (make-coroutine-generator (lambda (yield)
+                              (let loop ((s seed))
+                               (if (stop? s)
+                                 (if #f #f)
+                                 (begin (yield (mapper s))
+                                        (loop (successor s))))))))
+
+
+;; gcons*
+(define (gcons* . args)
+  (lambda () (if (null? args)
+               (eof-object)
+               (if (= (length args) 1)
+                 ((car args))
+                 (let ((v (car args)))
+                  (set! args (cdr args))
+                  v)))))
+
+
+;; gappend
+(define (gappend . args)
+  (lambda () (if (null? args)
+               (eof-object)
+               (let loop ((v ((car args))))
+                (if (eof-object? v)
+                  (begin (set! args (cdr args))
+                         (if (null? args)
+                           (eof-object)
+                           (loop ((car args)))))
+                  v)))))
+
+;; gflatten
+(define (gflatten gen)
+  (let ((state '()))
+    (lambda ()
+      (if (null? state) (set! state (gen)))
+      (if (eof-object? state)
+        state
+        (let ((obj (car state)))
+          (set! state (cdr state))
+          obj)))))
+
+;; ggroup
+(define ggroup
+  (case-lambda
+    ((gen k)
+     (simple-ggroup gen k))
+    ((gen k padding)
+     (padded-ggroup (simple-ggroup gen k) k padding))))
+
+(define (simple-ggroup gen k)
+  (lambda ()
+    (let loop ((item (gen)) (result '()) (count (- k 1)))
+      (if (eof-object? item)
+        (if (null? result) item (reverse result))
+        (if (= count 0)
+          (reverse (cons item result))
+          (loop (gen) (cons item result) (- count 1)))))))
+
+(define (padded-ggroup gen k padding)
+  (lambda ()
+    (let ((item (gen)))
+      (if (eof-object? item)
+        item
+        (let ((len (length item)))
+          (if (= len k)
+              item
+              (append item (make-list (- k len) padding))))))))
+
+;; gmerge
+(define gmerge
+  (case-lambda
+    ((<) (error "wrong number of arguments for gmerge"))
+    ((< gen) gen)
+    ((< genleft genright)
+     (let ((left (genleft))
+           (right (genright)))
+       (lambda ()
+         (cond
+          ((and (eof-object? left) (eof-object? right))
+           left)
+          ((eof-object? left)
+           (let ((obj right)) (set! right (genright)) obj))
+          ((eof-object? right)
+           (let ((obj left))  (set! left (genleft)) obj))
+          ((< right left)
+           (let ((obj right)) (set! right (genright)) obj))
+          (else
+           (let ((obj left)) (set! left (genleft)) obj))))))
+    ((< . gens)
+     (apply gmerge <
+            (let loop ((gens gens) (gs '()))
+              (cond ((null? gens) (reverse gs))
+                    ((null? (cdr gens)) (reverse (cons (car gens) gs)))
+                    (else (loop (cddr gens)
+                                (cons (gmerge < (car gens) (cadr gens)) gs)))))))))
+
+;; gmap
+(define gmap
+  (case-lambda
+    ((proc) (error "wrong number of arguments for gmap"))
+    ((proc gen)
+     (lambda ()
+       (let ((item (gen)))
+         (if (eof-object? item) item (proc item)))))
+    ((proc . gens)
+     (lambda ()
+       (let ((items (map (lambda (x) (x)) gens)))
+         (if (any eof-object? items) (eof-object) (apply proc items)))))))
+
+;; gcombine
+(define (gcombine proc seed . gens)
+  (lambda ()
+    (define items (map (lambda (x) (x)) gens))
+    (if (any eof-object? items)
+      (eof-object)
+      (let ()
+       (define-values (value newseed) (apply proc (append items (list seed))))
+       (set! seed newseed)
+       value))))
+
+;; gfilter
+(define (gfilter pred gen)
+  (lambda () (let loop ()
+              (let ((next (gen)))
+               (if (or (eof-object? next)
+                       (pred next))
+                 next
+                 (loop))))))
+
+;; gstate-filter
+(define (gstate-filter proc seed gen)
+  (let ((state seed))
+    (lambda ()
+      (let loop ((item (gen)))
+        (if (eof-object? item)
+          item
+          (let-values (((yes newstate) (proc item state)))
+            (set! state newstate)
+            (if yes
+               item
+               (loop (gen)))))))))
+
+
+
+;; gremove
+(define (gremove pred gen)
+  (gfilter (lambda (v) (not (pred v))) gen))
+
+
+
+;; gtake
+(define gtake
+  (case-lambda ((gen k) (gtake gen k (eof-object)))
+               ((gen k padding)
+                (make-coroutine-generator (lambda (yield)
+                                            (if (> k 0)
+                                              (let loop ((i 0) (v (gen)))
+                                               (begin (if (eof-object? v) (yield padding) (yield v))
+                                                      (if (< (+ 1 i) k)
+                                                        (loop (+ 1 i) (gen))
+                                                        (eof-object))))
+                                              (eof-object)))))))
+
+
+
+;; gdrop
+(define (gdrop gen k)
+  (lambda () (do () ((<= k 0)) (set! k (- k 1)) (gen))
+    (gen)))
+
+
+
+;; gdrop-while
+(define (gdrop-while pred gen)
+  (define found #f)
+  (lambda ()
+    (let loop ()
+     (let ((val (gen)))
+      (cond (found val)
+            ((and (not (eof-object? val)) (pred val)) (loop))
+            (else (set! found #t) val))))))
+
+
+;; gtake-while
+(define (gtake-while pred gen)
+  (lambda () (let ((next (gen)))
+              (if (eof-object? next)
+                next
+                (if (pred next)
+                  next
+                  (begin (set! gen (generator))
+                         (gen)))))))
+
+
+
+;; gdelete
+(define gdelete
+  (case-lambda ((item gen) (gdelete item gen equal?))
+               ((item gen ==)
+                (lambda () (let loop ((v (gen)))
+                            (cond
+                              ((eof-object? v) (eof-object))
+                              ((== item v) (loop (gen)))
+                              (else v)))))))
+
+
+
+;; gdelete-neighbor-dups
+(define gdelete-neighbor-dups
+  (case-lambda ((gen)
+                (gdelete-neighbor-dups gen equal?))
+               ((gen ==)
+                (define firsttime #t)
+                (define prev #f)
+                (lambda () (if firsttime
+                             (begin (set! firsttime #f)
+                                    (set! prev (gen))
+                                    prev)
+                             (let loop ((v (gen)))
+                              (cond
+                                ((eof-object? v)
+                                 v)
+                                ((== prev v)
+                                 (loop (gen)))
+                                (else
+                                  (set! prev v)
+                                  v))))))))
+
+
+;; gindex
+(define (gindex value-gen index-gen)
+  (let ((done? #f) (count 0))
+   (lambda ()
+     (if done?
+       (eof-object)
+       (let loop ((value (value-gen)) (index (index-gen)))
+        (cond
+          ((or (eof-object? value) (eof-object? index))
+           (set! done? #t)
+           (eof-object))
+          ((= index count)
+           (set! count (+ count 1))
+           value)
+          (else
+            (set! count (+ count 1))
+            (loop (value-gen) index))))))))
+
+
+;; gselect
+(define (gselect value-gen truth-gen)
+  (let ((done? #f))
+   (lambda ()
+     (if done?
+       (eof-object)
+       (let loop ((value (value-gen)) (truth (truth-gen)))
+        (cond
+          ((or (eof-object? value) (eof-object? truth))
+           (set! done? #t)
+           (eof-object))
+          (truth value)
+          (else (loop (value-gen) (truth-gen)))))))))
+
+;; generator->list
+(define generator->list
+  (case-lambda ((gen n)
+		(generator->list (gtake gen n)))
+               ((gen)
+		(reverse (generator->reverse-list gen)))))
+
+;; generator->reverse-list
+(define generator->reverse-list
+  (case-lambda ((gen n)
+		(generator->reverse-list (gtake gen n)))
+               ((gen)
+		(generator-fold cons '() gen))))
+
+;; generator->vector
+(define generator->vector
+  (case-lambda ((gen) (list->vector (generator->list gen)))
+               ((gen n) (list->vector (generator->list gen n)))))
+
+
+;; generator->vector!
+(define (generator->vector! vector at gen)
+  (let loop ((value (gen)) (count 0) (at at))
+   (cond
+     ((eof-object? value) count)
+     ((>= at (vector-length vector)) count)
+     (else (begin
+             (vector-set! vector at value)
+             (loop (gen) (+ count 1) (+ at 1)))))))
+
+
+;; generator->string
+(define generator->string
+  (case-lambda ((gen) (list->string (generator->list gen)))
+               ((gen n) (list->string (generator->list gen n)))))
+
+
+
+
+;; generator-fold
+(define (generator-fold f seed . gs)
+  (define (inner-fold seed)
+    (let ((vs (map (lambda (g) (g)) gs)))
+     (if (any eof-object? vs)
+       seed
+       (inner-fold (apply f (append vs (list seed)))))))
+  (inner-fold seed))
+
+
+
+;; generator-for-each
+(define (generator-for-each f . gs)
+  (let loop ()
+   (let ((vs (map (lambda (g) (g)) gs)))
+    (if (any eof-object? vs)
+      (if #f #f)
+      (begin (apply f vs)
+             (loop))))))
+
+
+(define (generator-map->list f . gs)
+  (let loop ((result '()))
+   (let ((vs (map (lambda (g) (g)) gs)))
+    (if (any eof-object? vs)
+      (reverse result)
+      (loop (cons (apply f vs) result))))))
+
+
+;; generator-find
+(define (generator-find pred g)
+  (let loop ((v (g)))
+   ; A literal interpretation might say it only terminates on #eof if (pred #eof) but I think this makes more sense...
+   (if (or (pred v) (eof-object? v))
+     v
+     (loop (g)))))
+
+
+;; generator-count
+(define (generator-count pred g)
+  (generator-fold (lambda (v n) (if (pred v) (+ 1 n) n)) 0 g))
+
+
+;; generator-any
+(define (generator-any pred g)
+  (let loop ((v (g)))
+   (if (eof-object? v)
+     #f
+     (if (pred v)
+       #t
+       (loop (g))))))
+
+
+;; generator-every
+(define (generator-every pred g)
+  (let loop ((v (g)))
+   (if (eof-object? v)
+     #t
+     (if (pred v)
+       (loop (g))
+       #f ; the spec would have me return #f, but I think it must simply be wrong...
+       ))))
+
+
+;; generator-unfold
+(define (generator-unfold g unfold . args)
+  (apply unfold eof-object? (lambda (x) x) (lambda (x) (g)) (g) args))
+
+
+;; make-accumulator
+(define (make-accumulator kons knil finalize)
+  (let ((state knil))
+    (lambda (obj)
+      (if (eof-object? obj)
+        (finalize state)
+        (set! state (kons obj state))))))
+
+
+;; count-accumulator
+(define (count-accumulator) (make-accumulator
+                            (lambda (obj state) (+ 1 state)) 0 (lambda (x) x)))
+
+;; list-accumulator
+(define (list-accumulator) (make-accumulator cons '() reverse))
+
+;; reverse-list-accumulator
+(define (reverse-list-accumulator) (make-accumulator cons '() (lambda (x) x)))
+
+;; vector-accumulator
+(define (vector-accumulator)
+  (make-accumulator cons '() (lambda (x) (list->vector (reverse x)))))
+
+;; reverse-vector-accumulator
+(define (reverse-vector-accumulator)
+  (make-accumulator cons '() list->vector))
+
+;; vector-accumulator!
+(define (vector-accumulator! vec at)
+  (lambda (obj)
+    (if (eof-object? obj)
+      vec
+      (begin
+        (vector-set! vec at obj)
+        (set! at (+ at 1))))))
+
+;; bytevector-accumulator
+(define (bytevector-accumulator)
+  (make-accumulator cons '() (lambda (x) (list->bytevector (reverse x)))))
+
+(define (bytevector-accumulator! bytevec at)
+  (lambda (obj)
+    (if (eof-object? obj)
+      bytevec
+      (begin
+        (bytevector-u8-set! bytevec at obj)
+        (set! at (+ at 1))))))
+
+;; string-accumulator
+(define (string-accumulator)
+  (make-accumulator cons '()
+        (lambda (lst) (list->string (reverse lst)))))
+
+;; sum-accumulator
+(define (sum-accumulator) (make-accumulator + 0 (lambda (x) x)))
+
+;; product-accumulator
+(define (product-accumulator) (make-accumulator * 1 (lambda (x) x)))
diff --git a/lib/srfi/158.sld b/lib/srfi/158.sld
new file mode 100644
index 00000000..897a43d9
--- /dev/null
+++ b/lib/srfi/158.sld
@@ -0,0 +1,23 @@
+(define-library (srfi 158)
+  (import (scheme base))
+  (import (scheme case-lambda))
+  (export generator circular-generator make-iota-generator make-range-generator
+          make-coroutine-generator list->generator vector->generator
+          reverse-vector->generator string->generator
+          bytevector->generator
+          make-for-each-generator make-unfold-generator)
+  (export gcons* gappend gcombine gfilter gremove
+          gtake gdrop gtake-while gdrop-while
+          gflatten ggroup gmerge gmap gstate-filter
+          gdelete gdelete-neighbor-dups gindex gselect)
+  (export generator->list generator->reverse-list
+          generator->vector generator->vector!  generator->string
+          generator-fold generator-map->list generator-for-each generator-find
+          generator-count generator-any generator-every generator-unfold)
+  (export make-accumulator count-accumulator list-accumulator
+          reverse-list-accumulator vector-accumulator
+          reverse-vector-accumulator vector-accumulator!
+          string-accumulator bytevector-accumulator bytevector-accumulator!
+          sum-accumulator product-accumulator)
+  (include "158.scm")
+)
diff --git a/lib/srfi/158/test.sld b/lib/srfi/158/test.sld
new file mode 100644
index 00000000..58ba68c6
--- /dev/null
+++ b/lib/srfi/158/test.sld
@@ -0,0 +1,267 @@
+(define-library (srfi 158 test)
+  (import (scheme base)
+	  (scheme read)
+	  (srfi 1)
+	  (srfi 158)
+	  (chibi test))
+  (export run-tests)
+  (begin
+    (define (with-input-from-string str thunk)
+      (parameterize ((current-input-port (open-input-string str)))
+	(thunk)))
+    (define g
+      (make-coroutine-generator
+       (lambda (yield) (let loop ((i 0))
+			 (when (< i 3) (yield i) (loop (+ i 1)))))))
+    (define (for-each-digit proc n)
+      (when (> n 0)
+	(let-values (((div rem) (truncate/ n 10)))
+	  (proc rem)
+	  (for-each-digit proc div))))
+    (define g1 (generator 1 2 3))
+    (define g2 (generator 4 5 6 7))
+    (define (proc . args) (values (apply + args) (apply + args)))
+    (define (small? x) (< x 3))
+    (define n 0)
+    (define (run-tests)
+      (test-group "generators"
+		  (test-group "generators/constructors"
+			      (test '() (generator->list (generator)))
+			      (test '(1 2 3) (generator->list (generator 1 2 3)))
+			      (test '(1 2 3 1 2) (generator->list (circular-generator 1 2 3) 5))
+			      (test '(8 9 10) (generator->list (make-iota-generator 3 8)))
+			      (test '(8 10 12) (generator->list (make-iota-generator 3 8 2)))
+			      (test '(3 4 5 6) (generator->list (make-range-generator 3) 4))
+			      (test '(3 4 5 6 7) (generator->list (make-range-generator 3 8)))
+			      (test '(3 5 7) (generator->list (make-range-generator 3 8 2)))
+
+			      (test '(0 1 2) (generator->list g))
+			      (test '(1 2 3 4 5) (generator->list (list->generator '(1 2 3 4 5))))
+			      (test '(1 2 3 4 5) (generator->list (vector->generator '#(1 2 3 4 5))))
+			      (test '#(0 0 1 2 4)
+				    (let ((v (make-vector 5 0)))
+				      (generator->vector! v 2 (generator 1 2 4))
+				      v))
+			      (test '(5 4 3 2 1) (generator->list (reverse-vector->generator '#(1 2 3 4 5))))
+			      (test '(#\a #\b #\c #\d #\e) (generator->list (string->generator "abcde")))
+			      (test '(10 20 30) (generator->list (bytevector->generator (bytevector 10 20 30))))
+			      (test '(5 4 3 2 1) (generator->list
+						  (make-for-each-generator for-each-digit
+									   12345)))
+			      (test '(0 2 4 6 8 10) (generator->list
+						     (make-unfold-generator
+						      (lambda (s) (> s 5))
+						      (lambda (s) (* s 2))
+						      (lambda (s) (+ s 1))
+						      0)))
+			      ) ; end "generators/constructors"
+
+		  (test-group "generators/operators"
+			      (test '(a b 0 1) (generator->list (gcons* 'a 'b (make-range-generator 0 2))))
+			      (test '(0 1 2 0 1) (generator->list (gappend (make-range-generator 0 3)
+									   (make-range-generator 0 2))))
+			      (test '() (generator->list (gappend)))
+			      (test '(15 22 31) (generator->list (gcombine proc 10 g1 g2)))
+			      (test '(1 3 5 7 9) (generator->list (gfilter
+								   odd?
+								   (make-range-generator 1 11))))
+			      (test '(2 4 6 8 10) (generator->list (gremove
+								    odd?
+								    (make-range-generator 1 11))))
+			      (set! g (make-range-generator 1 5))
+			      (test '(1 2 3) (generator->list (gtake g 3)))
+			      (test '(4) (generator->list g))
+			      (test '(1 2) (generator->list (gtake (make-range-generator 1 3) 3)))
+			      (test '(1 2 0) (generator->list (gtake (make-range-generator 1 3) 3 0)))
+			      (test '(3 4) (generator->list (gdrop (make-range-generator 1 5) 2)))
+			      (set! g (make-range-generator 1 5))
+			      (test '(1 2) (generator->list (gtake-while small? g)))
+			      (set! g (make-range-generator 1 5))
+			      (test '(3 4) (generator->list (gdrop-while small? g)))
+			      (test '() (generator->list (gdrop-while (lambda args #t) (generator 1 2 3))))
+			      (test '(0.0 1.0 0 2) (generator->list (gdelete 1
+									     (generator 0.0 1.0 0 1 2))))
+			      (test '(0.0 0 2) (generator->list (gdelete 1
+									 (generator 0.0 1.0 0 1 2)
+									 =)))
+			      (test '(a c e) (generator->list (gindex (list->generator '(a b c d e f))
+								      (list->generator '(0 2 4)))))
+			      (test '(a d e) (generator->list (gselect (list->generator '(a b c d e f))
+								       (list->generator '(#t #f #f #t #t #f)))))
+			      (test '(1 2 3) (generator->list (gdelete-neighbor-dups
+							       (generator 1 1 2 3 3 3)
+							       =)))
+			      (test '(1) (generator->list (gdelete-neighbor-dups
+							   (generator 1 2 3)
+							   (lambda args #t))))
+			      (test '(1 2 3 a b c)
+				    (generator->list
+				     (gflatten (generator '(1 2 3) '(a b c)))))
+			      (test '((1 2 3) (4 5 6) (7 8))
+				    (generator->list (ggroup (generator 1 2 3 4 5 6 7 8) 3)))
+			      (test '((1 2 3) (4 5 6) (7 8 0))
+				    (generator->list (ggroup (generator 1 2 3 4 5 6 7 8) 3 0)))
+			      (test '(1 2 3)
+				    (generator->list (gmerge < (generator 1 2 3))))
+			      (test '(1 2 3 4 5 6)
+				    (generator->list (gmerge < (generator 1 2 3) (generator 4 5 6))))
+			      (test '(1 2 3 4 4 5 6)
+				    (generator->list (gmerge <
+							     (generator 1 2 4 6)
+							     (generator)
+							     (generator 3 4 5))))
+			      (test '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)
+				    (generator->list (gmerge <
+							     (generator 1 10 11)
+							     (generator 2 9 12)
+							     (generator 3 8 13)
+							     (generator 4 7 14)
+							     (generator 5 6 15))))
+			      ;; check the tie-break rule
+			      (test '((1 a) (1 e) (1 b) (1 c) (1 d))
+				    (generator->list (gmerge (lambda (x y) (< (car x) (car y)))
+							     (generator '(1 a) '(1 e))
+							     (generator '(1 b))
+							     (generator '(1 c) '(1 d)))))
+
+			      (test '(-1 -2 -3 -4 -5)
+				    (generator->list (gmap - (generator 1 2 3 4 5))))
+			      (test '(7 9 11 13)
+				    (generator->list (gmap +
+							   (generator 1 2 3 4 5)
+							   (generator 6 7 8 9))))
+			      (test '(54 140 264)
+				    (generator->list (gmap *
+							   (generator 1 2 3 4 5)
+							   (generator 6 7 8)
+							   (generator 9 10 11 12 13))))
+			      (test '(a c e g i)
+				    (generator->list
+				     (gstate-filter
+				      (lambda (item state) (values (even? state) (+ 1 state)))
+				      0
+				      (generator 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j))))
+			      ) ; end "generators/operators"
+
+
+		  (test-group "generators/consumers"
+			      ;; no test for plain generator->list (used throughout)
+			      (test '(1 2 3) (generator->list (generator 1 2 3 4 5) 3))
+			      (test '(5 4 3 2 1) (generator->reverse-list (generator 1 2 3 4 5)))
+			      (test '#(1 2 3 4 5) (generator->vector (generator 1 2 3 4 5)))
+			      (test '#(1 2 3) (generator->vector (generator 1 2 3 4 5) 3))
+			      (test "abc" (generator->string (generator #\a #\b #\c)))
+			      (test '(e d c b a . z) (with-input-from-string "a b c d e"
+						       (lambda () (generator-fold cons 'z read))))
+
+			      (generator-for-each (lambda values (set! n (apply + values)))
+						  (generator 1) (generator 2) (generator 3))
+			      (test 6 n)
+			      (test '(6 15)
+				    (generator-map->list (lambda values (apply + values))
+							 (generator 1 4) (generator 2 5) (generator 3 6)))
+			      (test 3 (generator-find (lambda (x) (> x 2)) (make-range-generator 1 5)))
+			      (test 2 (generator-count odd? (make-range-generator 1 5)))
+			      (set! g (make-range-generator 2 5))
+			      (test #t (generator-any odd? g))
+			      (test '(4) (generator->list g))
+			      (set! g (make-range-generator 2 5))
+			      (test #f (generator-every odd? g))
+			      (test '(3 4) (generator->list g))
+			      (test '(#\a #\b #\c) (generator-unfold (make-for-each-generator string-for-each "abc") unfold))
+
+			      ) ; end "generators/consumers"
+
+		  ) ; end "generators"
+
+
+      (test-group "accumulators"
+		  (test -8
+			(let ((a (make-accumulator * 1 -)))
+			  (a 1)
+			  (a 2)
+			  (a 4)
+			  (a (eof-object))))
+
+		  (test 3
+			(let ((a (count-accumulator)))
+			  (a 1)
+			  (a 2)
+			  (a 4)
+			  (a (eof-object))))
+
+		  (test '(1 2 4)
+			(let ((a (list-accumulator)))
+			  (a 1)
+			  (a 2)
+			  (a 4)
+			  (a (eof-object))))
+
+		  (test '(4 2 1)
+			(let ((a (reverse-list-accumulator)))
+			  (a 1)
+			  (a 2)
+			  (a 4)
+			  (a (eof-object))))
+
+		  (test '#(1 2 4)
+			(let ((a (vector-accumulator)))
+			  (a 1)
+			  (a 2)
+			  (a 4)
+			  (a (eof-object))))
+
+		  (test '#(0 0 1 2 4)
+			(let* ((v (vector 0 0 0 0 0))
+			       (a (vector-accumulator! v 2)))
+			  (a 1)
+			  (a 2)
+			  (a 4)
+			  (a (eof-object))))
+
+		  (test '#u8(0 0 1 2 4)
+			(let* ((v (bytevector 0 0 0 0 0))
+			       (a (bytevector-accumulator! v 2)))
+			  (a 1)
+			  (a 2)
+			  (a 4)
+			  (a (eof-object))))
+
+		  (test '#(4 2 1)
+			(let ((a (reverse-vector-accumulator)))
+			  (a 1)
+			  (a 2)
+			  (a 4)
+			  (a (eof-object))))
+
+		  (test "abc"
+			(let ((a (string-accumulator)))
+			  (a #\a)
+			  (a #\b)
+			  (a #\c)
+			  (a (eof-object))))
+
+		  (test #u8(1 2 4)
+			(let ((a (bytevector-accumulator)))
+			  (a 1)
+			  (a 2)
+			  (a 4)
+			  (a (eof-object))))
+
+		  (test 7
+			(let ((a (sum-accumulator)))
+			  (a 1)
+			  (a 2)
+			  (a 4)
+			  (a (eof-object))))
+
+		  (test 8
+			(let ((a (product-accumulator)))
+			  (a 1)
+			  (a 2)
+			  (a 4)
+			  (a (eof-object))))
+
+		  ) ; end "accumulators"
+
+      )))
diff --git a/tests/lib-tests.scm b/tests/lib-tests.scm
index aa0eb7ce..0b8edd91 100644
--- a/tests/lib-tests.scm
+++ b/tests/lib-tests.scm
@@ -28,6 +28,7 @@
         (rename (srfi 134 test) (run-tests run-srfi-134-tests))
         (rename (srfi 139 test) (run-tests run-srfi-139-tests))
         (rename (srfi 151 test) (run-tests run-srfi-151-tests))
+	(rename (srfi 158 test) (run-tests run-srfi-158-tests))
         (rename (srfi 160 test) (run-tests run-srfi-160-tests))
         (rename (chibi base64-test) (run-tests run-base64-tests))
         (rename (chibi bytevector-test) (run-tests run-bytevector-tests))
@@ -91,6 +92,7 @@
 (run-srfi-134-tests)
 (run-srfi-139-tests)
 (run-srfi-151-tests)
+(run-srfi-158-tests)
 (run-srfi-160-tests)
 (run-base64-tests)
 (run-bytevector-tests)