導入

今回は「継続渡しスタイル(CPS : Continuation Passing Style)」を扱います。CPS はプログラミングスタイルの１つであり、後に続く処理を手続きに渡すことで、プログラムの実行を制御するというスタイルです。言葉で説明しても「なんのこっちゃ？」だと思いますので早速サンプルコードを示しながら解説したいと思います。

例：四則演算

まずは四則演算を CPS で書いてみます。

(* 3 (+ 4 5))

これは Lisp での表記（前置記法）です。

3 * (4 + 5)

普段私たちが使っている記法（中間記法）ではこうなります。
どちらの式も結果は 27 です。

CPS 的に書くと

１．はじめに 4 + 5 を足す
２．１の結果に 3 を掛ける
３．２の結果を返す

のようになります。
Scheme で書くとこんなコードになります。

(define (return x)
  x)

(define (k+ a b k)
  (k (+ a b)))

(define (k* a b k)
  (k (* a b)))

手続きの引数 k には「継続」（すなわち後続の処理）を渡します。
冒頭の式を計算してみましょう。

gosh> (k+ 4 5 (lambda (x) (k* x 3 return)))
27

例：リストで与えられた数を掛け算する

まずは普通に書いたプログラムから。

(define (product numbers)
  (define (iter ls acc)
    (cond ((null? ls) acc)
          ((zero? (car ls)) 0)
          (else (iter (cdr ls) (* acc (car ls))))))
  (iter numbers 1))

gosh> (product '(3 4 5))
60

掛け算なのでリスト内にゼロ「0」が現れた場合はもう計算しても意味が無いので、0 を返して処理を打ち切ります。
CPS で同じ処理を書いてみます。

(define (k+ a b k)
  (k (+ a b)))

(define (k* a b k)
  (k (* a b)))

(define (return x)
  x)

(define (kproduct numbers k)
  (let ((break k))
    (define (iter ls k)
      (cond ((null? ls) (k 1))
            ((zero? (car ls)) (break 0))
            (else (iter (cdr ls) (lambda (x) (k (* (car ls) x)))))))
    (iter numbers k)))

gosh> (kproduct '(3 4 5) return)
60

これだけでは CPS のメリットはあまり感じられないかも知れません。そこで kproduct に例外処理（エラー処理）を組み込みます。

(define (k+ a b k)
  (k (+ a b)))

(define (k* a b k)
  (k (* a b)))

(define (return x)
  x)

(define (non-number-value-error x)
  (error x 'is 'not 'number))

(define (kproduct numbers k k-value-error)
  (let ((break k))
    (define (iter ls k)
      (cond ((null? ls) (k 1))
            ((not (number? (car ls))) (k-value-error (car ls)))
            ((zero? (car ls)) (break 0))
            (else (iter (cdr ls) (lambda (x) (k (* (car ls) x)))))))
    (iter numbers k)))

リストに数字以外の要素が含まれていた場合は処理を停止し、例外処理を実行するように kproduct を修正しました。

gosh> (kproduct '(1 2 3 4 5) return non-number-value-error)
120

gosh> (kproduct '(1 2 a 4 5) return non-number-value-error)
*** ERROR: a is not number
Stack Trace:
(以下略)

CPS を使うと try-catch のような例外処理を簡単に実装できます。

応用：コルーチン

コルーチンとは、プログラムの実行を一時停止し、後で再開できるような機能を持つ特殊なサブルーチンを言います。CPS を使うとコルーチンも簡単に実装できます。

(use util.queue)

(define nil '())

(define process-queue (make-queue))

(define (coroutine thunk)
  (enqueue! process-queue thunk))

(define (start)
  (if (queue-empty? process-queue)
      'done
      ((dequeue! process-queue))))

(define (pause)
  (call/cc
   (lambda (k)
     (coroutine (lambda () (k #f)))
     (start))))

; example
(coroutine (lambda ()
             (let loop ((i 0))
               (when (< i 10)
                     (display (+ i 1))
                     (display " ")
                     (pause)
                     (loop (+ i 1))))))

(coroutine (lambda ()
             (let loop ((i 0))
               (when (< i 10)
                     (display (integer->char (+ i (char->integer #\A))))
                     (display " ")
                     (pause)
                     (loop (+ i 1))))))

(coroutine (lambda ()
             (let loop ((i 0))
               (when (< i 10)
                     (display (integer->char (+ i (char->integer #\a))))
                     (display " ")
                     (pause)
                     (loop (+ i 1))))))

実行してみます。

gosh> (start)
1 A a 2 B b 3 C c 4 D d 5 E e 6 F f 7 G g 8 H h 9 I i 10 J j #<undef>

応用：コルーチン版 fizz buzz

コルーチンを使い fizz buzz を書いてみます。コルーチンの実装から。

(use util.queue)

(define *tasks* (make-queue))

(define-syntax define-coroutine
  (syntax-rules ()
    ((_ (routine yield) body ...)
     (define (routine)
       (call/cc (lambda (return)
                  (define (yield)
                    (call/cc (lambda (cont)
                               (enqueue! *tasks* cont)
                               (return))))
                  body ...))
       ((dequeue! *tasks*))))
    ((_ (routine yield exit) body ...)
     (define (routine)
       (call/cc (lambda (escape)
                  (call/cc (lambda (return)
                             (define (yield)
                               (call/cc (lambda (cont)
                                          (enqueue! *tasks* cont)
                                          (return))))
                             (define (exit)
                               (call/cc (lambda (cont)
                                          (enqueue! *tasks* cont)
                                          (escape))))
                             body ...))
                  ((dequeue! *tasks*))))))))

(define (coroutine-init! . rs)
  (set! *tasks* (make-queue))
  (for-each (lambda (r)
              (enqueue! *tasks* r))
            rs))

(define (coroutine-add! r) (enqueue! *tasks* r))
(define (coroutine-del!) (dequeue! *tasks*))
(define (coroutine-restart!) ((dequeue! *tasks*)))
(define (coroutine-skip!) (coroutine-add! (coroutine-del!)))

call/cc 手続きは手続きから継続を取り出すことができます。
次は、実装したコルーチンを使用して fizz buzz を表示する手続きです。

(define (print-fizz-buzz limit)
  (define (devidable? m n) (= (remainder m n) 0))
  (define (fizz? n) (devidable? n 3))
  (define (buzz? n) (devidable? n 5))
  (define (fizz-buzz? n) (and (fizz? n) (buzz? n)))
 
  (define *output* (cons 0 ""))
  (define (request-output! priority output)
    (and (> priority (car *output*))
         (set! *output* (cons priority output))))
  (define (init-request!) (set! *output* (cons 0 "")))
  (define (get-request-output) (cdr *output*))
  
  (define-coroutine (cr-number yield)
    (let lp ((c 0))
      (inc! c)
      (request-output! 10 c)
      (yield)
      (lp c)))

  (define-coroutine (cr-fizz yield)
    (let lp ((c 0))
      (inc! c)
      (and (fizz? c) (request-output! 30 'fizz))
      (yield)
      (lp c)))

  (define-coroutine (cr-buzz yield)
    (let lp ((c 0))
      (inc! c)
      (and (buzz? c) (request-output! 20 'buzz))
      (yield)
      (lp c)))

  (define-coroutine (cr-fizz-buzz yield)
    (let lp ((c 0))
      (inc! c)
      (and (fizz-buzz? c) (request-output! 40 'fizz-buzz))
      (yield)
      (lp c)))

  (define-coroutine (cr-limitter yield exit)
    (let lp ((c 0))
      (inc! c)
      (if (> c limit)
          (begin (newline) (exit))
          (yield))
      (lp c)))

  (define-coroutine (cr-printer yield)
    (let lp ()
      (display (get-request-output))
      (display " ")
      (init-request!)
      (yield)
      (lp)))

  (coroutine-init! cr-fizz cr-buzz cr-fizz-buzz cr-limitter cr-printer)
  (cr-number))

cr-number cr-fizz cr-buzz cr-fizz-buzz の各コルーチンはそれぞれ、数字、fizz、buzz, fizz-buzz の表示リスエストを行いますが、リクエストには重み付けがされており、数字が一番弱く、fizz-buzz が一番強くなっています。cr-limitter コルーチンはループ回数を監視しており、limit を超えると処理を強制終了します。cr-printer コルーチンは表示を司り、重み付けが一番強いリクエストの表示を許可します。これらのコルーチンはすべて並行に動作します。

実行してみます。

gosh> (print-fizz-buzz 100)
1 2 fizz 4 buzz fizz 7 8 fizz buzz 11 fizz 13 14 fizz-buzz 16 17 fizz 19 buzz fizz 22 23 fizz buzz 26 fizz 28 29 fizz-buzz 31 32 fizz 34 buzz fizz 37 38 fizz buzz 41 fizz 43 44 fizz-buzz 46 47 fizz 49 buzz fizz 52 53 fizz buzz 56 fizz 58 59 fizz-buzz 61 62 fizz 64 buzz fizz 67 68 fizz buzz 71 fizz 73 74 fizz-buzz 76 77 fizz 79 buzz fizz 82 83 fizz buzz 86 fizz 88 89 fizz-buzz 91 92 fizz 94 buzz fizz 97 98 fizz buzz

CPS のデメリット

最大のデメリットはバグった時にデバッグが死ぬほど大変です。ハマると頭髪が全部抜けるんじゃないかと心配になるぐらい辛いです。仕事では CPS なんて絶対やりたくないですｗ

まとめ

CPS について四則演算を使い基本的な考え方を説明し、応用では CPS による例外処理およびコルーチンの実装を見ました。さらに CPS について勉強したい方は参考文献の書籍をご覧になることをおすすめします。

参考文献

プログラミング Gauche （書籍)

CPS とコルーチンについての基本的な解説があります。

計算機プログラムの構造と解釈（書籍)

第五章では Scheme で実装したアセンブリ言語処理系(レジスタ計算機)を通じて、深く CPS について学ぶことができます。わかりやすく解説されてはいますが決して簡単ではありません。