gistfile1.scm

;; https://gist.github.com/3176621 にインスパイアされて
;; 実際に CPS スタイルで非同期処理を行うコードを実装してみた
;;
;; $ gosh -V
;; Gauche scheme shell, version 0.9.3.2 [utf-8,pthreads], x86_64-apple-darwin11.4.2
;;

(use util.queue)

;; 非常に簡易なイベントキューの実装
(define *event-queue* (make-mtqueue))

(define (queue-event ev)
  (enqueue! *event-queue* ev)
  #t)

;; CPU が idle のときに処理系が呼び出すコード...のつもり
;; 今回は REPL の合間に手動で呼び出すことでエミュレーションしている
(define (idle)
  (let ((ev (dequeue! *event-queue* 'empty)))
    (if (eq? ev 'empty)
        (values)
        (ev))))

;; 非同期関数なので渡された継続をその場では呼ばずにキューに積むだけ
(define (add1/async x cont)
  (queue-event (lambda () (cont (+ x 1)))))

(define (mul2/async x cont)
  (queue-event (lambda () (cont (* x 2)))))

;; キューに積んだら即座に戻る
(add1/async 3 display) ; => #t
;; (idle) が呼ばれた時に続きの処理が実行される
(idle) ; -> 4#<undef>

;; 非同期処理の結果を使ってもっと複雑なことをしてみる
(add1/async 3
  (lambda (x)
    (display "Got ")
    (display x)
    (newline)
    'done))
; => #t

(idle)
; => Got 4
;    done

;; 関数合成の例
(define (compose/cont f g)
  (lambda (x cont)
    (f x (cut g <> cont))))

;; 合成された回数だけ (idle) を呼ぶ必要がある
((compose/cont add1/async mul2/async) 10 identity) ; => #t
(idle) ; => #t
(idle) ; => 22

;; 分岐を含む関数合成の例
(define (if/cont pred scont fcont)
  (lambda (x cont)
    (if (pred x)
        (queue-event (lambda () (cont (scont x))))
        (queue-event (lambda () (cont (fcont x)))))))

(define even-or-odd
  (if/cont even?
           (lambda _ 'even)
           (lambda _ 'odd)))

(even-or-odd 3 identity) ; => #t
(even-or-odd 0 identity) ; => #t
(idle) ; => odd
(idle) ; => even
(idle) ; no values returned

;; 再帰呼び出しを含む関数の例
(define (fib/cont n cont)
  (display n)
  (cond ((< n 1) (queue-event (lambda () (cont 0))))
        ((= n 1) (queue-event (lambda () (cont 1))))
        (#t (queue-event
             (lambda ()
               (fib/cont (- n 1)
                         (lambda (n1)
                           (queue-event
                            (lambda ()
                              (fib/cont (- n 2)
                                        (lambda (n2)
                                          (queue-event
                                           (lambda ()
                                             (cont (+ n1 n2)))))))))))))))

(fib/cont 7 identity) ; => 7#t
;; 結果が得られるまで (idle) を繰り返し呼び続ける
(while (receive vars (idle)
         (or (equal? vars (list #t)) (display vars))
         (not (null? vars))))
; => 6543210121032101432101210543210121032101(13)()#t