限定継続でモナドを後付けする

sort :: (a -> a -> Bool) -> [a] -> [a] のような関数があるとき、ふと、適当な入力を与えたときにこの sort 関数は何回比較を行なうのだろうと気になることがある。

Scheme の場合なら何も考えずに比較手続きを wrap して、その中でカウンタを set! すればよい（Gauche の sort 手続きに合わせるために引数の順番が逆になっている。以下の Scheme コードはすべて処理系として Gauche を仮定する）。

count.scm

(define (count-compare sort compare xs)
  (let ((n 0))
    (sort xs
          (lambda (x y)
            (set! n (+ n 1))
            (compare x y)))
    n))

しかし、この手続きは入力によってのみ出力が決まる純粋な関数なのに代入を使うのは負けたような気がする。何か他の方法は……

状態モナド

Haskell で State モナドを使うとこんな感じだろうか。

countCompare.hs

import Control.Monad.Trans.State.Strict

countCompare :: Monad m => ((a -> a -> m Bool) -> [a] -> m [a]) -> (a -> a -> Bool) -> [a] -> Int
countCompare sort p xs = execState (sort p' xs) 0
    where
      p' x y = do
        modify (+1)
        return $ p x y

sort :: Monad m => (a -> a -> m Bool) -> [a] -> m [a]
sort _ [] = return []
sort pred (x:xs) = do
  xs' <- sort pred xs
  insert pred x xs'

insert :: Monad m => (a -> a -> m Bool) -> a -> [a] -> m [a]
insert _ x [] = return [x]
insert pred x (y:ys) = do
  b <- pred x y
  if b
    then return (x:y:ys)
    else do
      ys' <- insert pred x ys
      return (y:ys')

pred の型が変わったせいで sort まで書き換えないといけなくなった。純粋な sort が欲しいときは runIdentity する。あまりうれしくない。

限定継続

限定継続でモナドを表現してみるとどうだろうか。

定義はお馴染みの。

count.scm

(use gauche.partcont)

(define (return x)
  (lambda (s)
    (values x s)))

(define (bind m f)
  (lambda (s)
    (receive (x s~) (m s)
      ((f x) s~))))

(define-syntax reify
  (syntax-rules ()
    ((_ expr)
     (reset
       (return expr)))))

(define (reflect x)
  (shift k (bind x k)))

(define (get)
  (lambda (s)
    (values s s)))

(define (put v)
  (lambda (s)
    (values #f v)))

(define (modify f)
  (let ((s (reflect (get))))
    (put (f s))))

(define (run-state m s)
  (m s))

(define (eval-state m s)
  (values-ref (run-state m s) 0))

(define (exec-state m s)
  (values-ref (run-state m s) 1))

return, bind は Haskell 等と同じ。 reify, reflect はモナドによらず共通の定義。 Haskell で do を書くところに reify, <- を書くところに reflect を書く。 reflect は shift を呼ぶので評価順序に注意。

count.scm

(define (count-compare sort compare xs)
  (let ((n 0))
    (sort xs
          (lambda (x y)
            (set! n (+ n 1))
            (compare x y)))
    n))

(define (count-compare* sort compare xs)
  (let ((c (lambda (x y)
             (reflect (put (+ (reflect (get)) 1)))
             (compare x y))))
    (exec-state (reify (sort xs c)) 0)))

(define (test sort pred xs)
  (list (count-compare sort compare xs)
        (count-compare* sort compare xs)))

(test sort > '(2 1 4 3 5))
;; => (7 7)

うまく動いているようだ。

何が起きている？

Haskell 版では副作用の起こりそうなところを前以って monadic な型にしておく必要がある。それに対して、限定継続版では reflect を呼ぶたびに shift の副作用で reset までの残りの計算（継続）を状態引数を受け取るようにラップし、プログラム自体をモナド版と同じ形になるように書き換えている。

プログラムの字面だけ見ると、 sort に渡す比較手続きが外から状態引数を受け取れるというのは気持ち悪い気がするけれど、継続演算子はプログラムの字面を操作するのではなく、実行時の状態を操作するものなのでこんなことができる。

ちなみに、今回の話は静的型の有無は関係なく、例えば OchaCaml でも同じようなプログラムを書くことができる。

※最初の方に出てきた、純粋関数っぽく見えるのに、副作用を使わないと書けない、という話は When is a Functional Program Not a Functional Program? にもっと色々書いてあるみたいです