call/ccの練習でgenerator作ってみる

call/ccを使って値とnextが多値で帰ってくるようなgeneratorを作ってみようとしたら予想以上に難しかった。

はじめはset!なしで書こうとしたんだけど出来なさそうだった。思いつかないだけでなにか方法があるかもしれないけど。

(define (generator func)
  (define *receive* #f)
  
  (define (start-iteration)
    (func (lambda (val)
      (call/cc (lambda (cont)
        (*receive* val cont)))))
    
    ; iteration reached at end
    (*receive* #f #f))
  
  (define (step cont return)
    (set! *receive* (lambda (val cont)
      (return val (make-next cont))))
    (cont))
  
  (define (make-next cont)
    (and cont
         (lambda ()
           (call/cc (lambda (return) (step cont return))))))
  
  (make-next start-iteration))

ついでにテスト

(use gauche.test)
(use srfi-1)
(use srfi-11)

(test-start "generator")

(define (infinite-loop fn)
  (let loop ((i 0))
    (fn i)
    (loop (+ i 1))))

(let*-values ([(g) (generator infinite-loop)]
              [(val0 next0) (g)]
              [(val1 next1) (next0)]
              [(val2 next2) (next1)]
              [(val3 next3) (next2)]
              [(val1b next1b) (next0)]
              [(val2b next2b) (next1b)]
              [(val2c next2c) (next1)]
              [(val3c next3c) (next2c)])

  (test* "#0" 0 val0)
  (test* "#1" 1 val1)
  (test* "#2" 2 val2)
  (test* "#3" 3 val3)

  (test* "#1b" 1 val1b)
  (test* "#2b" 2 val2b)

  (test* "#2c" 2 val2c)
  (test* "#3c" 3 val3c)
)

(let*-values ([(g) (generator (cut for-each <> (iota 2)))]
              [(val0 next0) (g)]
              [(val1 next1) (next0)]
              [(val2 next2) (next1)])
  (test* "reached at end" #f next2))

(test-end)

はじめは以下のように書いてたんだけどシンタックスエラーになった。定義は好きなところに書けないのかー
テストのアサーション一つ一つに名前つけるのが面倒くさい

(let ()
  (define g (generator infinite-loop))
  (define-values (val0 next0) (g))
  (define-values (val1 next1) (next0))
  (define-values (val2 next2) (next1))
  (define-values (val3 next3) (next2))

  (test* "#0" 0 val0)
  (test* "#1" 1 val1)
  (test* "#2" 2 val2)
  (test* "#3" 3 val3)

  (define-values (val1b next1b) (next0))
  (define-values (val2b next2b) (next1b))
  (test* "#1b" 1 val1b)
  (test* "#2b" 2 val2b)

  (define-values (val2c next2c) (next1))
  (define-values (val3c next3c) (next2c))
  (test* "#2c" 2 val2c)
  (test* "#3c" 3 val3c)
)