unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* Re: [PATCH] add SRFI: srfi-121; generators
@ 2021-01-21 18:39 John Cowan
  2021-01-23  0:58 ` Mark H Weaver
  0 siblings, 1 reply; 24+ messages in thread
From: John Cowan @ 2021-01-21 18:39 UTC (permalink / raw)
  To: guile-devel; +Cc: srfi, Mark H Weaver

[-- Attachment #1: Type: text/plain, Size: 728 bytes --]

Back in July 2020, Mark Weaver wrote:

Also, the provided implementations of 'generator-find', 'generator-any'
> and 'generator-every' are incorrect:


Shiro Kawai has now fixed these bugs, and they have been merged into SRFI
121.  Note that even if it doesn't become part of Guile's
batteries-included, the code should still work on Guile as an R6RS
library.  However, the upward compatible SRFI 158 provides more generator
function as well as support for accumulators, the dual of generators.

Mark: I'm interested to know if you have a sketch of ideas for a more
efficient implementation of SRFI 121/158.  You say it requires specific
knowledge of Guile internals, but are you willing to sketch how you might
do it?  Thanks.

[-- Attachment #2: Type: text/html, Size: 1646 bytes --]

^ permalink raw reply	[flat|nested] 24+ messages in thread
[parent not found: <mailman.61.1596470427.10776.guile-devel@gnu.org>]
* Re: [PATCH] add SRFI: srfi-121; generators
@ 2020-08-01  3:42 John Cowan
  2020-08-02 22:39 ` Mark H Weaver
  0 siblings, 1 reply; 24+ messages in thread
From: John Cowan @ 2020-08-01  3:42 UTC (permalink / raw)
  To: guile-devel

[-- Attachment #1: Type: text/plain, Size: 263 bytes --]

Mark Weaver wrote in July 2019:

Also, the provided implementations of 'generator-find', 'generator-any'
> and 'generator-every' are incorrect:


I appreciate your finding these bugs.  I wish, however, that you had also
sent them to <srfi-121@srfi.schemers.org>.

[-- Attachment #2: Type: text/html, Size: 578 bytes --]

^ permalink raw reply	[flat|nested] 24+ messages in thread
* [PATCH] add SRFI: srfi-121; generators
@ 2019-07-01  0:09 nly
  2019-07-01  5:06 ` Mark H Weaver
  0 siblings, 1 reply; 24+ messages in thread
From: nly @ 2019-07-01  0:09 UTC (permalink / raw)
  To: guile-devel


[-- Attachment #1.1: Type: text/plain, Size: 131 bytes --]

SRFI-121 Generators.

All tests(49/49) are passing in my testing. I am not sure if the tests
file is put in the correct place.

[-- Attachment #1.2: Type: text/html, Size: 398 bytes --]

[-- Attachment #2: 0001-add-SRFI-srfi-121-generators.patch --]
[-- Type: application/octet-stream, Size: 23279 bytes --]

From 0352f9be13aba1e8acc9a8f700f3673334d48d28 Mon Sep 17 00:00:00 2001
From: Amar Singh <nly@disroot.org>
Date: Mon, 1 Jul 2019 05:14:53 +0530
Subject: [PATCH] add SRFI: srfi-121; generators

---
 module/srfi/srfi-121.scm       | 458 +++++++++++++++++++++++++++++++++
 test-suite/tests/srfi-121.test | 145 +++++++++++
 2 files changed, 603 insertions(+)
 create mode 100644 module/srfi/srfi-121.scm
 create mode 100644 test-suite/tests/srfi-121.test

diff --git a/module/srfi/srfi-121.scm b/module/srfi/srfi-121.scm
new file mode 100644
index 000000000..dfbd72d71
--- /dev/null
+++ b/module/srfi/srfi-121.scm
@@ -0,0 +1,458 @@
+;; Copyright (C) John Cowan (2016). All Rights Reserved.
+;; Copyright (C) 2019 by Amar Singh<nly@disroot.org>
+
+;; Permission is hereby granted, free of charge, to any person obtaining
+;; a copy of this software and associated documentation files (the
+;; "Software"), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+(define-module (srfi srfi-121)
+  #:use-module (guile)
+  #:use-module (ice-9 rdelim)
+  #:use-module ((srfi srfi-4) #:select (u8vector-ref u8vector-length))
+  #:export (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
+                      gcons* gappend gcombine gfilter gremove
+                      gtake gdrop gtake-while gdrop-while
+                      gdelete gdelete-neighbor-dups gindex gselect
+                      generator->list generator->reverse-list
+                      generator->vector generator->vector!  generator->string
+                      generator-fold generator-for-each generator-find
+                      generator-count generator-any generator-every generator-unfold))
+
+(define *eof-object* (read (open-input-string "")))
+(define (eof-object) *eof-object*)
+(define (bytevector-u8-ref bv i) (u8vector-ref bv i))
+(define (bytevector-length bv) (u8vector-length bv))
+(define (truncate/ n1 n2) (values (quotient n1 n2) (remainder n1 n2)))
+
+
+;; Chibi Scheme versions of any and every
+
+(define (any pred ls)
+  (if (null? (cdr ls))
+    (pred (car ls))
+    ((lambda (x) (if x x (any pred (cdr ls)))) (pred (car ls)))))
+
+(define (every pred ls)
+  (if (null? (cdr ls))
+    (pred (car ls))
+    (if (pred (car ls)) (every pred (cdr ls)) #f)))
+
+
+
+;; generator
+(define (generator . args)
+  (lambda () (if (null? args)
+               (eof-object)
+               (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)))))
+
+
+
+;; 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))))))
+
+
+
+;; 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))))))
+
+
+;; 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))
diff --git a/test-suite/tests/srfi-121.test b/test-suite/tests/srfi-121.test
new file mode 100644
index 000000000..144cfaed5
--- /dev/null
+++ b/test-suite/tests/srfi-121.test
@@ -0,0 +1,145 @@
+;; Copyright (C) John Cowan (2016). All Rights Reserved.
+;; Copyright (C) 2019 by Amar Singh<nly@disroot.org>
+
+;; Permission is hereby granted, free of charge, to any person obtaining
+;; a copy of this software and associated documentation files (the
+;; "Software"), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+(define-module (srfi srfi-121 tests)
+  #:use-module ((srfi srfi-1) #:select (unfold))
+  #:use-module (srfi srfi-4)
+  #:use-module (srfi srfi-11)
+  #:use-module ((srfi srfi-13) #:select (string-for-each))
+  #:use-module (srfi srfi-64)
+  #:use-module (srfi srfi-121))
+
+(define-syntax test
+  (syntax-rules ()
+    ((_ args ...)
+     (test-equal args ...))))
+
+(test-begin "generators")
+
+(test-group "generators"
+  (test-group "generators/constructors"
+    (test '() (generator->list (generator)))
+    (test '(1 2 3) (generator->list (generator 1 2 3)))
+    (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)))
+    (let ((g (make-coroutine-generator
+            (lambda (yield) (let loop ((i 0))
+                              (when (< i 3) (yield i) (loop (+ i 1))))))))
+      (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 '(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 (u8vector 10 20 30))))
+      (letrec ((for-each-digit (lambda (proc n)
+                              (when (> n 0)
+                                (let-values (((div rem) (truncate/ n 10)))
+                                  (proc rem)
+                                  (for-each-digit proc div))))))
+        (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)))
+    (let ((g1 (generator 1 2 3))
+          (g2 (generator 4 5 6 7))
+          (proc (lambda* (#:rest args) (values (apply + args) (apply + args)))))
+      (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))))
+      (let ((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)))
+        (let ((g (make-range-generator 1 5))
+              (small? (lambda (x) (< x 3))))
+          (test '(1 2) (generator->list (gtake-while small? g)))
+          (let ((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))))))))
+  ) ; 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))))
+
+    (let ((n 0))
+      (generator-for-each (lambda values (set! n (apply + values)))
+                          (generator 1) (generator 2) (generator 3))
+      (test 6 n)
+      (test 3 (generator-find (lambda (x) (> x 2)) (make-range-generator 1 5)))
+      (test 2 (generator-count odd? (make-range-generator 1 5)))
+      (let ((g (make-range-generator 2 5)))
+        (test #t (generator-any odd? g))
+        (test '(4) (generator->list g))
+        (let ((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-end "generators")
-- 
2.22.0


^ permalink raw reply related	[flat|nested] 24+ messages in thread

end of thread, other threads:[~2021-04-11 16:17 UTC | newest]

Thread overview: 24+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-01-21 18:39 [PATCH] add SRFI: srfi-121; generators John Cowan
2021-01-23  0:58 ` Mark H Weaver
2021-01-23  2:14   ` Shiro Kawai
2021-01-23  2:18     ` Arthur A. Gleckler
2021-01-23  6:37       ` Mark H Weaver
2021-01-26  3:29         ` John Cowan
2021-01-26  6:48           ` Linus Björnstam
2021-01-26  6:49             ` Linus Björnstam
2021-01-26  7:14             ` Marc Nieper-Wißkirchen
2021-01-26 11:54               ` Linus Björnstam
2021-04-08 15:53                 ` Arthur A. Gleckler
2021-04-11  6:52                   ` Linus Björnstam
2021-04-11 16:17                     ` Arthur A. Gleckler
     [not found] <mailman.61.1596470427.10776.guile-devel@gnu.org>
2020-08-03 19:41 ` Marc Nieper-Wißkirchen
2020-08-04 12:48   ` Marc Nieper-Wißkirchen
2020-08-04 15:24   ` John Cowan
2020-08-04 15:58     ` Marc Nieper-Wißkirchen
2020-08-04 17:24       ` Dr. Arne Babenhauserheide
  -- strict thread matches above, loose matches on Subject: below --
2020-08-01  3:42 John Cowan
2020-08-02 22:39 ` Mark H Weaver
2019-07-01  0:09 nly
2019-07-01  5:06 ` Mark H Weaver
2019-07-01  6:00   ` Mark H Weaver
2019-07-01  6:21     ` Amar Singh

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).