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