1;;;
2;;; SRFI-158 Generators and Accumulators
3;;;
4
5(define-module srfi-158
6  (use gauche.unicode)
7  (use gauche.generator)
8  (export generator circular-generator make-iota-generator make-range-generator
9          make-coroutine-generator list->generator vector->generator
10          reverse-vector->generator string->generator
11          bytevector->generator
12          make-for-each-generator make-unfold-generator
13          gcons* gappend gflatten ggroup gmerge gmap gcombine gfilter gremove
14          gstate-filter ggroup generator-map->list
15          gtake gdrop gtake-while gdrop-while
16          gdelete gdelete-neighbor-dups gindex gselect
17          generator->list generator->reverse-list generator-map->list
18          generator->vector generator->vector!  generator->string
19          generator-fold generator-for-each generator-find
20          generator-count generator-any generator-every generator-unfold
21
22          ;; accumulators
23          make-accumulator count-accumulator list-accumulator
24          reverse-list-accumulator vector-accumulator
25          reverse-vector-accumulator vector-accumulator!
26          string-accumulator bytevector-accumulator bytevector-accumulator!
27          sum-accumulator product-accumulator))
28(select-module srfi-158)
29
30(define (make-accumulator kons knil finalizer)
31  (^v
32   (if (eof-object? v)
33     (finalizer knil)
34     (begin (set! knil (kons v knil)) (undefined)))))
35
36(define (list-accumulator)
37  (make-accumulator cons '() reverse))
38
39(define (reverse-list-accumulator)
40  (make-accumulator cons '() identity))
41
42(define (vector-accumulator)
43  (make-accumulator cons '() reverse-list->vector))
44
45(define (reverse-vector-accumulator)
46  (make-accumulator cons '() list->vector))
47
48(define (vector-accumulator! vec at)
49  (make-accumulator (^[v i]
50                      (when (>= i (vector-length vec))
51                        (error "vector is full"))
52                      (vector-set! vec i v)
53                      (+ i 1))
54                    at
55                    (^_ vec)))
56
57(define (string-accumulator)
58  (make-accumulator (^[c p] (write-char c p) p)
59                    (open-output-string)
60                    get-output-string))
61
62(define (bytevector-accumulator)
63  (make-accumulator (^[b p] (write-byte b p) p)
64                    (open-output-string)
65                    (^p (string->utf8 (get-output-string p)))))
66
67(define (bytevector-accumulator! vec at)
68  (assume-type vec <u8vector>)
69  (make-accumulator (^[v i]
70                      (when (>= i (uvector-length vec))
71                        (error "bytevector is full"))
72                      (u8vector-set! vec i v)
73                      (+ i 1))
74                    at
75                    (^_ vec)))
76
77(define (sum-accumulator)
78  (make-accumulator + 0 identity))
79(define (product-accumulator)
80  (make-accumulator * 1 identity))
81(define (count-accumulator)
82  (make-accumulator (^[_ c] (+ c 1)) 0 identity))
83