Functional Programming

継続渡しスタイル

今回は「継続渡しスタイル (Continuation Passing Style : CPS)」という手法について説明します。Scheme には「継続」という他の言語 ^[*1] にはない強力な機能がありますが、使いこなすのはちょっと難しいといわれています。継続渡しスタイルはクロージャを使った汎用的な方法で、クロージャがあるプログラミング言語であれば、継続渡しスタイルでプログラムを作成することができます。

●継続とは？

最初に継続について簡単に説明します。継続は「次に行われる計算」のことです。たとえば、次のプログラムを例に考えてみましょう。

Prelude> foo () = putStrLn "foo"
Prelude> bar () = putStrLn "bar"
Prelude> baz () = putStrLn "baz"
Prelude> test () = do{ foo(); bar(); baz() }
Prelude> test()
foo
bar
baz

関数 test は関数 foo, bar, baz を順番に呼び出します。foo の次に実行される処理は bar, baz の関数呼び出しです。この処理が foo を呼び出したあとの「継続」になります。同様に、bar のあとに実行されるのは baz の呼び出しで、この処理がこの時点での「継続」になります。baz を呼び出したあと、test の中では次に実行する処理はありませんが、test は関数呼び出しされているので、関数呼び出しから元に戻る処理が baz を呼び出したあとの「継続」になります。

このように、あるプログラムを実行しているとき、そのプログラムを終了するまでには「次に実行する処理 (計算)」が必ず存在します。一般に、この処理 (計算) のことを「継続」といいます。Scheme の場合、次の計算を続行するための情報を取り出して、それを保存することができます。Scheme では、この保存した情報を「継続」といって、通常のデータ型と同様に取り扱うことができます。つまり、継続を変数に代入したり関数の引数に渡すことができるのです。継続を使うとプログラムの実行を途中で中断し、あとからそこに戻ってプログラムの実行を再開することができます。

Prelude> foo' = putStrLn "foo"
Prelude> bar' = putStrLn "bar"
Prelude> baz' = putStrLn "baz"
Prelude> test' = do { foo'; bar'; baz' }
Prelude> test'
foo
bar
baz

●継続渡しスタイルとは？

一般のプログラミング言語では、Scheme のように継続を取り出して保存することはできません。そこで、継続 (次に行う処理) を関数 (クロージャ) で表して、それを引数に渡して実行することにします。これを「継続渡しスタイル (CPS)」といいます。次の例を見てください。

Prelude> test_cps cont = do {foo(); bar(); cont()}
Prelude> :t test_cps
test_cps :: (() -> IO b) -> IO b

Prelude> test_cps baz
foo
bar
baz
Prelude> test_cps foo
foo
bar
foo
Prelude> test_cps bar
foo
bar
bar

関数 test_cps は foo, bar を呼び出したあと、引数 cont に渡された処理 (継続) を実行します。関数 baz を渡せば foo, bar, baz と表示されますし、他の処理を渡せばそれを実行することができます。

もう一つ簡単な例を示しましょう。継続に値を渡して処理を行うこともできます。

Prelude> add_cps a b cont = cont (a + b)
Prelude> :t add_cps
add_cps :: Num a => a -> a -> (a -> t) -> t

Prelude> add_cps 1 2 (\x -> x)
3
Prelude> add_cps 1 2 id
3
Prelude> add_cps 1 2 print
3

Prelude> mul_cps a b cont = cont (a * b)
Prelude> :t mul_cps
mul_cps :: Num a => a -> a -> (a -> t) -> t

Prelude> mul_cps 3 3 id
9

関数 add_cps は引数 a と b を加算して、その結果を継続 cont に渡します。同様に、関数 mul_cps は引数 a と b を乗算して、その結果を継続 cont に渡します。cont に \x -> x または id を渡せば、計算結果を返すことができます。また、cont に print を渡せば、計算結果を表示することができます。

●継続のデータ型

ここで test_cps, add_cps, mul_cps のデータ型に注目してください。

test_cps :: (() -> IO b) -> IO b
add_cps :: Num a => a -> a -> (a -> t) -> t
mul_cps :: Num a => a -> a -> (a -> t) -> t

引数 cont のデータ型は引数を一つ受け取る関数で、cont の返り値と test_cps, add_cps, mul_cps の返り値は同じデータ型になっています。そこで、継続を表すデータ型を次のように定義します。

リスト : 継続の定義

type Cont r a = (a -> r) -> r

型名は Cont r a としました。a は継続を表す関数が受け取るデータ型、r がその返り値を表すデータ型です。Cont を使うと、プログラムは次のようになります。

リスト : 継続を Cont r a で表す

test_cps :: Cont (IO b) ()
test_cps cont = do {foo(); bar(); cont()}

add_cps :: Integer -> Integer -> Cont r Integer
add_cps a b cont = cont (a + b)

mul_cps :: Integer -> Integer -> Cont r Integer
mul_cps a b cont = cont (a * b)

データ型に Cont を用いることで、test_cps, add_cps, mul_cps が継続渡しスタイルでプログラムされていることがよくわかると思います。

●継続の連鎖

次は、add_cps と mul_cps を使って、2 つの整数の和の 2 乗を求める関数 add_square を CPS で作ってみましょう。

リスト : 継続の連鎖

add_square :: Integer -> Integer -> Cont r Integer
add_square a b cont = 
  add_cps a b (\x -> mul_cps x x (\y -> cont y))

add_cps a b で a と b の和を求めます。その結果は継続 (ラムダ式) の引数に渡されます。次に、継続の中で mul_cps を呼び出して、引数 x の 2 乗を求めます。その結果はラムダ式の引数 y に渡されます。最後に、ラムダ式の中で add_square に渡された継続 cont を y に適用します。このように、継続をつなげていくことで CPS でプログラムされた関数を組み合わせることができます。

簡単な実行例を示します。

*Main> add_square 1 2 id
9
*Main> add_square 3 3 id
36
*Main> add_square 4 7 id
121

●再帰呼び出しと継続渡しスタイル

CPS を使うと再帰呼び出しを末尾再帰に変換することができます。たとえば、階乗の計算を CPS でプログラムすると次のようになります。

リスト : 階乗の計算 (CPS)

fact_cps :: Integer -> Cont r Integer
fact_cps 0 cont = cont 1
fact_cps n cont = fact_cps (n - 1) (\x -> cont (n * x))

引数 cont が継続を表します。n = 0 のときは、cont に階乗の値 1 を渡します。それ以外の場合は、階乗の計算を継続の処理にまかせて fact_cps を再帰呼び出します。ここで、fact_cps の呼び出しは末尾再帰になることに注意してください。

継続の処理 \x -> cont (n * x) では、継続の引数 x と fact_cps の引数 n を掛け算して、その結果を cont に渡します。たとえば、fact_cps 4 (\x -> x) の呼び出しを図に示すと、次のようになります。

   fact 4 (\x -> x)
=>      4 (\x1 -> (\x -> x) (4 * x1))
=>      3 (\x2 -> (\x1 -> (\x -> x) (4 * x1)) (3 * x2))
=>      2 (\x3 -> (\x2 -> (\x1 -> (\x -> x) (4 * x1)) (3 * x2)) (2 * x3))
=>      1 (\x4 -> (\x3 -> (\x2 -> (\x1 -> (\x -> x) (4 * x1)) (3 * x2)) (2 * x3)) (1 * x4))
=>      0 (\x4 -> (\x3 -> (\x2 -> (\x1 -> (\x -> x) (4 * x1)) (3 * x2)) (2 * x3)) (1 * x4)) 1

継続の評価

   (\x4 -> (\x3 -> (\x2 -> (\x1 -> (\x -> x) (4 * x1)) (3 * x2)) (2 * x3)) (1 * x4)) 1
=> (\x3 -> (\x2 -> (\x1 -> (\x -> x) (4 * x1)) (3 * x2)) (2 * x3)) 1
=> (\x2 -> (\x1 -> (\x -> x) (4 * x1)) (3 * x2)) 2
=> (\x1 -> (\x -> x) (4 * x1)) 6
=> (\x -> x) 24
=> 24

                    図 : fact_cps の実行

このように、継続の中で階乗の式が組み立てられていきます。そして、n = 0 のとき継続 cont に引数 1 を渡して評価すると、今までに組み立てられた式が評価されて階乗の値を求めることができます。つまり、n の階乗を求めるとき、継続 \x -> cont (n * x) の引数 x には n - 1 の階乗の値が渡されていくわけです。そして、最後に継続 \x -> x に n の階乗の値が渡されるので、階乗の値を返すことができます。

それでは実際に実行してみましょう。

*Main> fact_cps 5 id
120
*Main> fact_cps 9 id
362880
*Main> fact_cps 10 id
3628800
*Main> fact_cps 11 id
39916800

●二重再帰と継続渡しスタイル

次はフィボナッチ数列を求める関数を CPS で作りましょう。次のリストを見てください。

リスト : フィボナッチ関数

-- 二重再帰
fibo :: Integer -> Integer
fibo 0 = 1
fibo 1 = 1
fibo n = fibo (n - 1) + fibo (n - 2)

-- CPS
fibo_cps :: Integer -> Cont r Integer
fibo_cps 0 cont = cont 1
fibo_cps 1 cont = cont 1
fibo_cps n cont = 
  fibo_cps (n - 1) (\x -> fibo_cps (n - 2) (\y -> cont (x + y)))

関数 fibo_cps は、引数 n が 0 または 1 のとき cont 1 を評価します。それ以外の場合は fibo_cps を再帰呼び出しします。fibo_cps (n - 1) が求まると、その値は継続の引数 x に渡されます。継続の中で、今度は fibo_cps (n - 2) の値を求めます。すると、その値は fibo_cps (n - 2) の継続の引数 y に渡されます。したがって、fibo_cps n の値は x + y で求めることができます。この値を fibo_cps n の継続 cont に渡せばいいわけです。

fibo_cps の実行を図に示すと、次のようになります。

cont は継続を表します。fibo_cps は末尾再帰になっているので、n - 1 の値を求めるために左から右へ処理が進みます。このとき、n - 2 の値を求める継続 cont が生成されていくことに注意してください。そして、f(1) の実行が終了すると継続が評価され、n - 2 の値が求められます。すると、2 番目の継続が評価されて n - 1 の値 x と n - 2 の値 y を加算して、その値を継続 cont に渡します。こうして、次々と継続が評価されてフィボナッチ関数の値を求めることができます。

それでは実際に実行してみましょう。

*Main> fibo_cps 1 id
1
*Main> fibo_cps 2 id
2
*Main> fibo_cps 3 id
3
*Main> fibo_cps 4 id
5
*Main> fibo_cps 5 id
8
*Main> fibo_cps 10 id
89
*Main> fibo_cps 11 id
144
*Main> fibo_cps 12 id
233
*Main> fibo_cps 20 id
10946

正常に動作していますね。

ところで、fibo_cps は末尾再帰になっていますが、関数の呼び出し回数は二重再帰の場合と同じです。したがって、実行速度は二重再帰の場合とほとんどかわりません。また、二重再帰の場合は関数呼び出しによりスタックが消費されますが、CPS の場合はクロージャが生成されるのでメモリ (ヒープ領域) が消費されます。このように、再帰呼び出しを CPS に変換したからといって、効率の良いプログラムになるとは限りません。ご注意くださいませ。

●CPS の便利な使い方

階乗やフィボナッチ関数の場合、CPS に変換するメリットはほとんどありませんが、場合によっては CPS に変換した方が簡単にプログラムできることもあります。たとえば、リストを平坦化する関数 flatten で、リストの要素に空リストが含まれていたら空リストを返すようにプログラムを修正することを考えてみましょう。次のリストを見てください。

リスト : リストの平坦化 (間違い)

flatten :: [[a]] -> [a]
flatten [] = []
flatten ([]:_) = []
flatten (x:xs) = x ++ flatten xs

関数 flatten は空リストを見つけたら空リストを返していますが、これでは正常に動作しません。実際に試してみると次のようになります。

*Main> flatten [[1,2],[3,4],[5,6]]
[1,2,3,4,5,6]
*Main> flatten [[1,2],[3,4],[],[5,6]]
[1,2,3,4]
*Main> flatten [[1,2],[],[3,4],[5,6]]
[1,2]

2, 3 番目の例が空リストを含む場合です。この場合、空リストを返したいのですが、その前の要素を連結したリストを返しています。空リストを見つける前にリストの連結処理を行っているので、空リストを見つけたらその処理を廃棄しないといけないのです。

このような場合、CPS を使うと簡単です。次のリストを見てください。

リスト : リストの平坦化 (CPS)

flatten_cps :: [[a]] -> Cont [b] [a]
flatten_cps [] cont = cont []
flatten_cps ([]:_) cont = []
flatten_cps (x:xs) cont = flatten_cps xs (\y -> cont (x ++ y))

flatten を CPS に変換するのは簡単です。リストの先頭の要素 x と平坦化したリストの連結を継続で行うだけです。平坦化したリストは継続の引数 y に渡されるので、x ++ y でリストを連結して、それを継続 cont に渡せばいいわけです。

引数のリストが空リストになったら継続 cont に空リストを渡して評価します。これで、リストの連結処理が行われます。もしも、途中で空リストを見つけた場合は、空リストをそのまま返します。この場合、継続 cont は評価されないので、リストの連結処理は行われず、空リストをそのまま返すことができます。

それでは実行してみましょう。

*Main> flatten_cps [[1,2],[3,4],[5,6]] id
[1,2,3,4,5,6]
*Main> flatten_cps [[1,2],[3,4],[],[5,6]] id
[]
*Main> flatten_cps [[1,2],[],[3,4],[5,6]] id
[]

正常に動作していますね。

●ツリーマッチング

次は、2 つの二分木を比較する関数 sameFringe を作ってみましょう。同じ葉を同じ並びで持つ場合、sameFringe は True を返します。次の例を見てください。

リスト : 二分木の定義

data Tree a = Leaf a | Node (Tree a) (Tree a) deriving Show

*Main> a = Node (Leaf 1) (Node (Leaf 2) (Node (Leaf 3) (Leaf 4)))
*Main> b = Node (Node (Leaf 1) (Leaf 2)) (Node (Leaf 3) (Leaf 4))
*Main> sameFringe a b
True
*Main> c = Node (Leaf 1) (Node (Leaf 2) (Node (Leaf 4) (Leaf 3)))
*Main> sameFringe a c
False

最初の例の場合、木の構造は違いますが、要素はどちらの木も 1, 2, 3, 4 の順番で並んでいるので、sameFringe は True を返します。次の例では、木の構造は同じですが、 3 と 4 の順番が逆になっています。この場合、sameFringe は False を返します。

プログラムは次のようになります。

リスト : ツリーマッチング

-- リストに変換
toList :: Tree a -> [a]
toList (Leaf x) = [x]
toList (Node l r) = toList l ++ toList r

sameFringe :: Eq a => Tree a -> Tree a -> Bool
sameFringe a b = toList a == toList b

関数 toList で二分木 a, b をリストに変換し、それを演算子 == で比較するだけです。正格評価を行う処理系の場合、関数 toList で二分木の要素をすべてリストに格納してから二つのリストを比較することになります。Haskell のリストは遅延リスト (遅延ストリーム) として利用できるので、異なる要素が見つかった時点で処理を終了することができます。つまり、すべての要素をリストに格納しなくてもすむわけです。

●遅延リストを使わない方法

ところで、遅延リストを使わなくても、クロージャを使って同様のことを行うことができます。次のリストを見てください。

リスト : 遅延リストを使わない場合

data Cont' a = Null | Cont' a (() -> Cont' a)

traverse_tree :: Tree a -> Cont (Cont' a) ()
traverse_tree (Leaf x) cont = Cont' x cont
traverse_tree (Node l r) cont =
  traverse_tree l (\() -> traverse_tree r cont)

sameFringe' :: Eq a => Tree a -> Tree a -> Bool
sameFringe' a b =
  iter (traverse_tree a (\() -> Null))
       (traverse_tree b (\() -> Null))
  where iter Null Null = True
        iter (Cont' x na) (Cont' y nb) =
          if x /= y then False
          else iter (na()) (nb())
        iter _ _ = False

二分木の要素と木の巡回を再開するクロージャを格納するデータ型 Cont' a を定義します。Null は木の巡回が終了したことを表します。Cont' の第 2 要素にはクロージャを格納し、このクロージャを評価すると次の要素を求めることができます。

traverse_tree は二分木を巡回する関数です。Cont' を返すことが目的なので、継続 cont に値を渡す必要はありません。データ型は Cont (Cont' a) () と定義しました。引数が Leaf x ならば要素 x と継続 cont を Cont' に格納して返します。これで二分木の巡回を中断して、Cont' a を返すことができます。Node l r の場合、traverse_tree l で左部分木を巡回し、その継続の中で traverse_tree r で右部分木を巡回します。このとき、継続 cont を渡して継続の連鎖が途切れないように注意してください。

sameFring' は traverse_tree を呼び出して二分木を巡回します。このとき指定した継続が最後に呼び出されるので、Null を返すようにラムダ式 \() -> Null を渡します。実際の処理は局所関数 iter で行います。二つの引数が Null の場合は、どちらも二分木の巡回を終えたので True を返します。これは空の木と空の木は同形であることを表します。

どちらの引数も Cont' の場合は要素 x, y を比較します。値が異なる場合は False を返します。そうでなければ、クロージャ na, nb を呼び出して次の要素を求めます。このように、クロージャを呼び出すだけで二分木の巡回を再開することができます。それ以外の場合は False を返します。

それでは実行例を示します。

*Main> a = Node (Leaf 1) (Node (Leaf 2) (Node (Leaf 3) (Leaf 4)))
*Main> b = Node (Node (Leaf 1) (Leaf 2)) (Node (Leaf 3) (Leaf 4))
*Main> c = Node (Leaf 1) (Node (Leaf 2) (Node (Leaf 4) (Leaf 3)))
*Main> sameFringe' a b
True
*Main> sameFringe' a c
False
*Main> sameFringe' a a
True

正常に動作していますね。このように、クロージャを使ってプログラムの実行を中断したり、あとから再開することもできます。

●継続モナド

Haskell には継続渡しスタイルをモナドにした「継続モナド (Continuation Monad)」が用意されています。継続モナドはモジュール Control.Monad.Cont に定義されていて、継続渡しスタイルのデータ型 (a -> r) -> r を newtype で包んだものです。次のリストを見てください。

リスト : 継続モナド

newtype Cont r a = Cont {runCont :: (a -> r) -> r}

instance Monad (Cont r) where
  return a       = Cont $ \k -> k a
  (Cont c) >>= f = Cont $ \k -> c (\a -> runCont (f a) k)

データ型は Cont r a です。a -> r が継続を表す関数で、その引数のデータ型が a に、返り値のデータ型が r になります。次に、Cont r をモナドのインスタンスに設定します。return の定義は簡単です。Cont が格納するデータは関数で、引数は継続を表す関数です。ラムダ式の引数 k を継続 (関数) とすると、\k -> k a を Cont に格納すれば、引数 a に継続 k を適用して、データ型が r の結果を返すことができます。

バインド演算子の定義は CPS と同じで、継続 c の結果を関数 f に渡して評価するだけです。c を評価するときは継続を表す関数を渡します。その引数を a とすると、関数 f に a を渡して評価します。その結果は継続モナドになるので、runCont で取り出して、それに継続 k を渡して評価するだけです。

継続モナドを使うと、add_cps, mul_cps, add_square は次のようになります。

リスト : 継続モナドの使用例 (1)

add_cps :: Integer -> Integer -> Cont r Integer
add_cps x y = return (x + y)

mul_cps :: Integer -> Integer -> Cont r Integer
mul_cps x y = return (x * y)

add_square :: Integer -> Integer -> Cont r Integer
add_square a b = do
  x <- add_cps a b
  y <- mul_cps x x
  return y

*Main> runCont (add_cps 1 2) id
3
*Main> runCont (mul_cps 1 2) id
2
*Main> runCont (add_square 1 2) id
9
*Main> runCont (add_square 11 22) id
1089

fact_cps と fibo_cps は次のようになります。

リスト : 継続モナドの使用例 (2)

-- 階乗
fact_cps :: Integer -> Cont r Integer
fact_cps 0 = return 1
fact_cps x = fact_cps (x - 1) >>= \y -> return (y * x)

-- フィボナッチ関数
fibo_cps :: Integer -> Cont r Integer
fibo_cps 0 = return 1
fibo_cps 1 = return 1
fibo_cps x = do
  a <- fibo_cps (x - 1)
  b <- fibo_cps (x - 2)
  return (a + b)

*Main> runCont (fact_cps 9) id
362880
*Main> runCont (fact_cps 10) id
3628800
*Main> runCont (fact_cps 11) id
39916800
*Main> runCont (fibo_cps 8) id
34
*Main> runCont (fibo_cps 9) id
55
*Main> runCont (fibo_cps 10) id
89

リストを平坦化する flatten_cps は次のようになります。

リスト : リストの平坦化

flatten_cps :: [[a]] -> Cont [b] [a]
flatten_cps [] = return []
flatten_cps ([]:_) = cont $ \_ -> []
flatten_cps (x:xs) = flatten_cps xs >>= \y -> return (x ++ y)

リストの要素が空リストの場合は空リストを返します。2 番目の節 flatten_cps ([ ]:_) で、空リストを返すのに return [ ] としてはいけません。return a の定義は cont $ \k -> k a で、引数 k には継続が渡されます。ここで継続 k を呼び出すと、リストの連結処理を破棄することができないのです。この場合、渡された継続を呼び出さずに空リストを返すようにします。これで継続を破棄して空リストを返すことができます。

それでは実行してみましょう。

*Main> runCont (flatten_cps [[1,2],[3,4],[5,6]]) id
[1,2,3,4,5,6]
*Main> runCont (flatten_cps [[1,2],[],[3,4],[5,6]]) id
[]
*Main> runCont (flatten_cps [[1,2],[3,4],[],[5,6]]) id
[]

正常に動作していますね。

●callCC

継続モナドには callCC という関数が便利な用意されています。名前は Scheme の関数 call/cc (call-with-current-continuation) とよく似ていますが、Scheme のように「継続」を取り出すものではありません。継続渡しスタイルの中で利用する関数です。

WWW.SAMPOU.ORG の モナドのすべて Continuation モナド より引用します。

『callCC は現在の継続(Current Continuation)を引数として関数を 呼びます(それゆえ，CallCCという名があります)． callCC を使うときの標準的なイディオムは，λ式を与えて 継続に名前をつけるというものです．そうすると，その名前のついた継続を スコープ内のあらゆる場所から呼ぶことで，それが入れ子の計算のどんなに 深いところからでも，脱出できます．』

callCC は次のように定義されています。

リスト : callCC の定義

class Monad m => MonadCont m where
  callCC :: ((a -> m a) -> m a) -> m a

instance MonadCont (Cont r) where
  callCC f = Cont $ \k -> runCont (f (\a -> Cont $ \_ -> k a)) k

callCC の引数 f は継続 Cont を返す関数で、関数 f の引数も Cont を返す関数になります。ここで f に渡すラムダ式に注目してください。引数 a に継続 k を適用していますが、継続 k は callCC で指定されたもので、ラムダ式の引数に渡される継続は無視されています。つまり flatten_cps のように、ここで継続が破棄されて、k a の評価結果が callCC の返り値となります。

簡単な使用例を示しましょう。

Prelude Control.Monad.Cont> runCont (callCC (\k -> return 1)) id
1
Prelude Control.Monad.Cont> runCont (callCC (\k -> do{k 10;return 1})) id
10

最初の例では、評価する式が return 1 だけなので、結果は 1 になります。ラムダ式の中で引数の継続 k を実行すると、それ以降の継続 (return 1 と id 1) は破棄されて、id 10 が評価されて返り値は 10 になります。

●大域脱出

Scheme の場合、call/cc を使って評価中の関数からほかの関数へ制御を移すことができます。これを「大域脱出 (global exit)」といいます。また、再帰呼び出しの深いところからいっきに脱出するときにも使うことができます。Haskell の callCC でも、同じような動作を行わせることができます。

簡単な例を示しましょう。

リスト : 大域脱出

bar1, bar2, bar3, foo :: (Int -> Cont r Int) -> Cont r Int

bar1 cont = return 1
bar2 cont = cont 2
bar3 cont = return 3
foo  cont = do {bar1 cont; bar2 cont; bar3 cont}

test = callCC (\k -> foo k)

*Main> runCont test id
2

関数 foo は関数 bar1, bar2, bar3 を順番に呼び出します。ところが bar2 で cont 2 が評価されると、継続の連鎖が中断されて callCC の返り値は 2 になります。このように、callCC を使うと大域脱出と同じような動作を行わせることができます。

●再帰呼び出しからの脱出

再帰呼び出しから脱出することも callCC を使えば簡単です。flatten_cps を callCC を使って書き直してみましょう。次のリストを見てください。

リスト : 再帰呼び出しから脱出する

flatten_cps' :: [[a]] -> Cont [b] [a]
flatten_cps' xs = 
  callCC (\k -> let flatten' [] = return []
                    flatten' ([]:_) = k []
                    flatten' (x:xs) = flatten' xs >>= \y -> return (x ++ y)
                in flatten' xs)

関数 flatten_cps' は局所関数 flatten' を呼び出します。flatten' は callCC のラムダ式の中で定義されているので、その中で脱出継続 k を呼び出すことができます。flatten' は空リストを見つけたら継続 k を評価します。すると、再帰呼び出しの処理は破棄されて、k に渡した空リストが返り値となります。

それでは実行してみましょう。

*Main> runCont (flatten_cps' [[1,2],[3,4],[5,6]]) id
[1,2,3,4,5,6]
*Main> runCont (flatten_cps' [[1,2],[],[3,4],[5,6]]) id
[]
*Main> runCont (flatten_cps' [[1,2],[3,4],[],[5,6]]) id
[]

●モナド変換子 ContT

継続モナドにはモナド変換子 ContT が用意されています。ContT のデータ型を示します。

newtype ContT r m a = ContT {runContT :: (a -> m r) -> m r}

ContT r m a は継続の型 (a -> r) -> r の返り値 r をモナド m に包んだ型になります。モナドは次のように定義されています。

リスト : モナド変換子 ContT

instance (Monad m) => Monad (ContT r m) where
  return a        = ContT $ \k -> k a
  (ContT c) >>= f = ContT $ \k -> c (\a -> runContT (f a) k)

処理内容は継続モナド Cont とほぼ同じで、返り値の型が m r になるだけです。

簡単な例を示しましょう。

Prelude Control.Monad.Cont> runContT (return 1 :: ContT r Maybe Int) return
Just 1
Prelude Control.Monad.Cont> runContT (return 1 :: ContT r [] Int) return
[1]
Prelude Control.Monad.Cont> runContT (return 1 :: ContT r IO Int) return
1
Prelude Control.Monad.Cont> runContT (return 1 :: ContT r Maybe Int) (\_ -> Nothing)
Nothing
Prelude Control.Monad.Cont> runContT (return 1 :: ContT r [] Int) (\_ -> [])
[]
Prelude Control.Monad.Cont> runContT (return 1 :: ContT r IO Int) print
1

runContT に渡す継続 (関数) の型は r -> m r になることに注意してください。return を指定すると、Maybe ならば結果は Just 1 に、リストならば [1] に、IO ならば IO 1 になります。意味はありませんが、Maybe と合成する場合は Nothing を返してもかまいませんし、リストならば空リストを返すこともできます。IO と合成する場合、print を指定すると 1 を表示して返り値は IO () になります。

●callCC と lift

次は ContT の callCC と lift を説明します。

リスト : ContT の callCC 

instance (Monad m) => MonadCont (ContT r m) where
  callCC f = ContT $ \k -> runContT (f (\a -> ContT $ \_ -> k a)) k

ContT と同様に、callCC の定義も Cont の callCC とほぼ同じです。

lift と liftIO は次のように定義されています。

リスト : ContT の lift と liftIO

class MonadTrans t where
  lift :: (Monad m) => m a -> t m a

instance MonadTrans (ContT r) where
  lift m = ContT (m >>=)

class (Monad m) => MonadIO m where
  liftIO :: IO a -> m a

instance MonadIO IO where
  liftIO = id

instance (MonadIO m) => MonadIO (ContT r m) where
  liftIO = lift . liftIO

lift の引数 m はモナドです。ContT のデータ型は (a -> m r) -> m r で、バインド演算子のデータ型は m a -> (a -> m b) -> m b です。モナド m にバインド演算子を適用すれば、(a -> m b) -> m b という関数が得られるので、それを ContT に包んで返すだけです。

簡単な使用例を示します。

リスト : callCC と lift の使用例

bar1, bar2, bar3, foo :: (Int -> ContT r IO Int) -> ContT r IO Int
bar1 cont = do {liftIO(putStrLn "call bar1"); return 1}
bar2 cont = do {liftIO(putStrLn "call bar2"); cont 2}
bar3 cont = do {liftIO(putStrLn "call bar3"); return 3}
foo  cont = do {bar1 cont; bar2 cont; bar3 cont}

test = callCC (\k -> foo k)

大域脱出の例を ContT r IO Int に書き換えます。bar1, bar2, bar3 は liftIO を使って putStrLn を呼び出してメッセージを表示します。

実行結果は次のようになります。

*Main> runContT test return
call bar1
call bar2
2

関数 bar1, bar2 は呼び出されていますが、bar3 は呼び出されていないことがわかります。