2011年5月5日木曜日

Haskell で継続渡しスタイル (CPS)

0. 目次

  1. 継続を理解するには「継続渡しスタイル(CPS)」から
  2. 足し算、かけ算、引き算
  3. 階乗
  4. 木の葉の数を数える
  5. フィボナッチ数
  6. リストの平坦
  7. foldr (畳み込み関数)

 

1. 継続を理解するには「継続渡しスタイル(CPS)」から

All About Monads」の Continuation モナド が理解できない。特に callCC 関数の定義。

callCC f = Cont $ \k -> runCont (f (\a -> Cont $ \_ -> k a)) k

うーん、わずか一行なんだけれど… (+_+)

callCC を含め、継続モナドを理解するための前提が次のように書かれている。

Continuation モナドを使う前に継続渡しスタイル(CPS)について確実に理解しているか,自身の設計課題について継続が最良のソリューションなのかを確認してください.他の言語では継続が要求されるような多くのアルゴリズムにおいて,Haskell では遅延評価意味論のおかげで,継続を必要としません.

(同上より、太字は引用者による)

どうやら「継続渡しスタイル(CPS)」から学ぶことがいいらしい。今回はこれについて調べる。

ところで、「継続」と言って連想するのは Scheme 。「Scheme 入門 16. 継続」によると、

… 多くの解説書ではまず Scheme の継続について説明してから、継続渡しスタイルについて説明していますが、 先に継続渡しスタイルについて説明したほうが、なぜ Scheme に継続というデータ型があるのかがわかりやすいと思います。

今後は、以下の順で理解していきたい。 (希望的観測)

  1. 継続渡しスタイル (CPS)
  2. 継続モナド
  3. callCC 関数

 

2. 足し算、かけ算、引き算

最初は、上記「3. 継続渡しスタイル」で説明されている CPS の例を真似たコードを Haskell で書く。

普通に足し算・かけ算・引き算を定義するなら、

add x y = x + y
mul x y = x * y
sub x y = x - y

これ自体は演算子 +, *, - を置き換えたに過ぎない。

組み合わせて使ってみる。

print (sub (mul (add 1 2) 3) 4)   -- 5

これを「継続渡しスタイル」にしたい。

 

a. CPS の書き方

「継続渡しスタイル」について述べらている解説をいくつか引用する。(装飾は引用者による)

Scheme 入門 16. 継続

継続渡しスタイルとは、関数が、値を返す代わりに、計算した値どの関数に渡すのかを明示的に指定する方法です。

Scheme:CPS

継続と聞くとSchemeのcall/ccを連想するかもしれませんが、むしろここで重要なのは、「継続渡しスタイル(Continuation Passing Style, CPS)」です。CPSそのものは、 PerlでもRubyでもJavaでも書けます。どっちかというと、普通の手続き指向から考え方を変えるのがポイントなんで。

CPSのポイント。手続きは呼び出したら戻ってきません。行ったっきりです。ですから、その手続きの後で何か別のことをやりたいなら、「その後にして欲しいこと=継続」を手続きに渡してやります。

M.Hiroi's Home Page / お気楽 OCaml プログラミング入門

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

Haskell/Continuation passing style - Wikibooks

Continuation Passing Style is a format for expressions such that no function ever returns, instead they pass control onto a continuation. Conceptually a continuation is what happens next, …

Continuation – HaskellWiki

1.1.2 Functional metaphors
  • Rather than return the result of a function, pass one or more Higher Order Functions to determine what to do with the result. ...

ポイントは、関数を定義するとき、

  1. 最後に値を返すのではなく、
  2. 関数を呼び出したときに与えた関数に引き渡す

ということ。

先ほど定義した関数 add, mul, sub で考えるなら、

  1. 計算結果を返す代わりに、
  2. 引数 x, y を元に行う計算の結果に対して、関数 k を適用する。

という定義に変更。

add_cps x y k = k $ x + y
mul_cps x y k = k $ x * y
sub_cps x y k = k $ x - y

例えば、 add を変更した add’cps は次のように読む。

add_cps は引数 x, y を足した結果に、関数 k を適用する。

 

b. CPS スタイルの使い方

add_cps を使い、1 と 2 を足した結果を、値を変化させず、そのまま返す関数に渡すなら、

print $ add_cps 1 2 (\x -> x)   -- 3

結果を 2 倍したいなら、

print $ add_cps 1 2 (\x -> x * 2)   -- 6

ところで、add_cps の型を調べると、

add_cps :: (Num a) => a -> a -> (a -> b) -> b

add_cps の第 3 引数である関数 k の型は

a –> b

であり、「返す値」が「関数 k を適用する値」の型と異なっていてもよいことがわかる。

例えば、結果を String 型に変換したいなら、

print $ add_cps 1 2 (\x -> "###" ++ show x ++"###")   -- "###3###"

IO () 型に変換したい場合は、

add_cps 1 2 (\x -> print x)

足し算、かけ算、引き算を組み合わせた、先ほどと同じ計算を行うには、第 3 引数に無名関数をネストさせていく。

print (add_cps 1 2 (\x ->      
       mul_cps x 3 (\y ->      
       sub_cps y 4 (\z -> z))))   -- 5

書くときに意識することは、

  1. add_cps 1 2 の結果を x に渡し、
  2. 次に mul_cps x 3 の結果を y に渡し、
  3. 続いて sub_cps y 4 の結果を z に渡し、
  4. 最後に結果 z をそのまま返す。

… とは言ったもののの、この方法で計算がちゃんとされるのは、何かだまされたような気分。 (@_@;

 

c. どういう風に計算されるのか?

計算の順序を気にせず、計算の様子をイメージしてみる。

予め無名関数を以下のように対応付けておく。

h : \z -> z
g : \y -> sub_cps y 4 h 
f : \x -> mul_cps x 3 g

先ほどの計算を順に考える。

add_cps 1 2 f
=> f $ 1 + 2
=> (\x -> mul_cps x 3 g) 3
=> mul_cps 3 3 g
=> g $ 3 * 3
=> (\y -> sub_cps y 4 h) 9
=> sub_scps 9 4 h
=> h $ 9 - 4
=> (\z -> z) 5
=> 5

定義したときには想像しにくかった具体的なイメージが少しわかったような気がする。

 

d. 関数を適用する流れ

ところで、Haskell では関数の引数が複数の場合、一部引数を適用すると、残りの引数を受け取る関数が返される。

add’cps の一部に引数を適用したときの型を調べる。

add_cps 1 2 :: (Num t) => (t -> b) -> b

定義で置き換えると、具体的には、

add_cps 1 2
=> k $ 1 + 2
=> k 3

ここですぐに値 3 を取り出したい場合、

(add_cps 1 2) (\x -> x) -- 3

値を取り出す前に、ドミノ倒しの要領で、無名関数をつなげていった場合の型を調べてみる。

(add_cps 1 2) (\x -> mul_cps x 3) :: (Num t) => (t -> b) -> b

ついでに、もう一つつなげたら、

(add_cps 1 2) (\x -> mul_cps x 3) (\y -> sub_cps y 4)
  :: (Num t) => (t -> b) -> b

最後に取り出して終わり。

(add_cps 1 2) (\x -> mul_cps x 3) (\y -> sub_cps y 4) (\z -> z)
  :: (Num b) => b

値を取り出す前の型はすべて、

(t -> b) –> b

であることが確認できる。この型がポイントになるので、頭の隅に入れておくこと。

ただし、上記の方法は無名関数をネストさせてないので、引き継いでいく各々の結果を、最後の無名関数内で参照することはできない。

例えば以下のように。

print (add_cps 1 2 (\x ->      
       mul_cps x 3 (\y ->      
       sub_cps y 4 (\z -> 
       [x,y,z]))))         -- [3,9,5]

ところで、これを見て Python による次のようなコードを連想した。

x = 1 + 2
y = x * 3
z = y - 4
print [x,y,z]

Haskell のコードをたとえるなら、ネストした内側の世界は、ネストしている外側の世界を覗くことができる。純粋関数型において「前提として成り立つ世界が存在すること」が、手続き型の「順次流れていく時間」と対応している。

 

e. 「計算の結果を渡す関数」が複数ある場合

add_cps 関数では、第 3 引数が「結果を渡す先」の関数だった。これに対して、「結果を渡す先」の関数をもう一つ増やし、「条件によって渡す先を決める」ように変更してみる。

例えば、x, y が 10 よりも小さい値のときに適用する関数を k とし、それ以外を k’ とする。

add1_cps x y k k' 
    | x < 10 && y < 10 = k  add'
    | otherwise        = k' add'
    where
      add' = x + y

使ってみる。

print $ add1_cps 1 2 (\x -> x * 10) (\x -> x)    -- 30
print $ add1_cps 11 22 (\x -> x * 10) (\x -> x)  -- 33

「条件」も関数として渡すなら、述語関数 p を想定し、

add2_cps x y p k k' 
    | p x y     = k  add'
    | otherwise = k' add'
    where
      add' = x + y

この場合は、

print $ add2_cps 1 2 (\x y -> x < y) 
          (\x -> x * 10) (\x -> x)    -- 30
print $ add2_cps 1 2 (\x y -> x > y) 
          (\x -> x * 10) (\x -> x)    -- 3

次に、「x が y よりも小さいときは計算結果を返し、そうでない場合はエラーを表示したい」とする。

Haskell では返す型が同じ必要があるので、予め以下の型を定義。

data Value a = Return a | Raise Exception deriving Show
type Exception = String

データコンストラクタ Return は値を返す場合に使い、Raise はエラーのときの値を生成するために使う。

print $ add2_cps 1 2 (<) 
      Return (\_ -> Raise "Error")   -- Return 3
print $ add2_cps 2 1 (<) 
      Return (\_ -> Raise "Error")   -- Raise "Error"

 

f. 「結果を渡す先の関数」の引数が複数ある場合

これまでは、「結果を渡す先の関数」が結果を一つ受けとるだけだった。複数の引数が渡された場合、どうなるだろう?

例えば、add3_cps 関数では、関数 k に最初に渡した引数も与えてみる。

add3_cps x y k = k x y $ x + y

これを使い、計算過程と結果を文字列として表示させてみる。

print $ add3_cps 1 2 $ \x y z -> 
    show x ++ " + " ++ show y ++ " = " ++ show z  -- "1 + 2 = 3"

( 全体は gist: 956701 — Gist )

 

3. 階乗

次は階乗の計算で継続渡しスタイルを考える。

普通に階乗を定義するなら、

fact n | n == 0    = 1
       | otherwise = n * fact (n-1)

これを継続渡しスタイルに変更したい。

まずは、n が 0 のとき、値 1 を関数 k に適用する。

fact_cps n k | n == 0    = k 1

次に上記以外の場合をどう定義すればいいのか?

fact’cps n k の意味は、

n の階乗の結果に関数 k を適用する

ということ。よって、意識することは fact_cps の結果を x に渡し、

             | otherwise = fact_cps (n-1) (\x –> …

n の値と上記 x の値をかけて、最後に関数 k に渡す。

             | otherwise = fact_cps (n-1) (\x -> k (n * x)) 

この最後に関数 k を値に適用しているのところがポイント。

( gist: 962816 — Gist )

n が 3 における計算の過程を考えると、

fact_cps 3 (\x -> x)
=> fact_cps 2 (\x -> (\x -> x) (3 * x))
=> fact_cps 1 (\x -> (\x -> (\x -> x) (3 * x)) (2 * x))
=> fact_cps 0 (\x -> (\x -> (\x -> (\x -> x) (3 * x)) (2 * x)) (1 * x))
=> (\x -> (\x -> (\x -> (\x -> x) (3 * x)) (2 * x)) (1 * x)) 1
=> (\x -> (\x -> (\x -> x) (3 * x)) (2 * x)) 1
=> (\x -> (\x -> x) (3 * x)) 2
=> (\x -> x) 6
=> 6

第 1 引数 n の値が小さくなるにつれて、ニョキニョキと無名関数が伸びていく。

正直イメージがしにくい。 てゆうか、具体的に創造できない。。(@_@;

 

a. 累積

ついでに、数値のリストの累積を継続渡しスタイルで書いてみる。

prod_cps []     k = k 1
prod_cps (x:xs) k = prod_cps xs (\y -> k (x * y))

ちょっと書き方に慣れてきた。

 

4. 木の葉の数を数える

なんでも継続」の「末尾再帰と継続」で挙げらている例、

与えられた木の全ての葉の数を数える関数

を考えてみる。

まずは木を次のように定義。

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

普通に木の葉の要素を数えるには、

leafCount (Leaf _)     = 1
leafCount (Branch l r) = leafCount l + leafCount r

これを継続渡しスタイルにしたい。

a. 継続渡しスタイルで数える

葉のときは要素数 1 は明らかなので、1 に対して関数 k を適用する。

leafCount_cps (Leaf _)     k = k 1

このとき意識することは、

leafCount_cps (Leaf _) の要素数を得たら、その値を関数 k に渡す

ということ。

数える対象が葉でないときも、定義する前に、関数の意味をしっかりと意識しておく。

leafCount_cps (Branch l r) k 

を以下のように解釈する。

  1. leafCount_cps (Branch l r) により、対象の木の葉の数を得ることができる。
  2. そして、その値を関数 k に与える。

これに基づき、左の木の葉の数を数え、その結果を受けとる無名関数を定義する準備をする。

leafCount_cps (Branch l r) k = leafCount_cps l $ \x –>

次に、上記無名関数の中で、右の葉の数を数え、その結果を更に続く無名関数に与える準備をする。

                               leafCount_cps r $ \y ->

最後に上記 2 つの結果を足し合わせ、その結果に対して関数 k を適用する。

                               k $ x + y

ここでも最終的な結果に関数 k を適用しているところがポイント。

でも、何かわかったような、わからないような… (+_+)

 

b. 計算のされ方の確認

具体的な木を作り leafCount_cps 関数を試してみる。

t = Branch 
    (Branch 
     (Leaf 1) 
     (Leaf 2))
    (Branch
     (Leaf 3)
     (Branch 
      (Leaf 4)
      (Leaf 5)))

これに対し、関数を適用。

main = do print $ leafCount t                -- 5
          print $ leafCount_cps t (\x -> x)  -- 5
          leafCount_cps t print              -- 5

( gist: 952890 — Gist )

より単純な場合を想定し、順に定義を置き換えてみる。( Haskell の内部において、遅延評価により実際にどのように計算が行なわれるのかわからないけれど。 )

まずは、葉を 2 つだけ持つ木。

leafCount_cps (Branch (Leaf 1) (Leaf 2)) (\x -> x)
=> leafCount_cps (Leaf 1) $ \x -> leafCount_cps (Leaf 2) $ \y -> (\x -> x) $ x + y
=> (\x -> leafCount_cps (Leaf 2) $ \y -> (\x -> x) $ x + y) 1
=> leafCount_cps (Leaf 2) $ \y -> (\x -> x) $ 1 + y
=> (y -> (\x -> x) $ 1 + y) 1
=> (\x -> x) $ 1 + 1
=> 2

一つ葉を増やした場合で考える。

leafCount_cps (Branch (Branch (Leaf 1) (Leaf 2)) (Leaf 3)) (\x -> x)
=> leafCount_cps (Branch (Leaf 1) (Leaf 2)) $ \x -> leafCount_cps (Leaf 3) $ \y -> (\x -> x) $ x + y
=> leafCount_cps (Leaf 1) $ \x -> leafCount_cps (Leaf 2) $ \y -> (x -> leafCount_cps (Leaf 3) $ \y -> (\x -> x) $ x + y) $ x + y
=> (\x -> leafCount_cps (Leaf 2) $ \y -> (x -> leafCount_cps (Leaf 3) $ \y -> (\x -> x) $ x + y) $ x + y) 1
=> leafCount_cps (Leaf 2) $ \y -> (x -> leafCount_cps (Leaf 3) $ \y -> (\x -> x) $ x + y) $ 1 + y
=> (\y -> (x -> leafCount_cps (Leaf 3) $ \y -> (\x -> x) $ x + y) $ 1 + y) 1
=> (x -> leafCount_cps (Leaf 3) $ \y -> (\x -> x) $ x + y) $ 1 + 1
=> leafCount_cps (Leaf 3) $ \y -> (\x -> x) $ 2 + y
=> (\y -> (\x -> x) $ 2 + y) 1
=> (\x -> x) $ 2 + 1
=> 3

上記 2 行目の内側の関数を先に置き換えたら、どうなるのかな?

leafCount_cps (Branch (Branch (Leaf 1) (Leaf 2)) (Leaf 3)) (\x -> x)
=> leafCount_cps (Branch (Leaf 1) (Leaf 2)) $ \x -> leafCount_cps (Leaf 3) $ \y -> (\x -> x) $ x + y
=> leafCount_cps (Branch (Leaf 1) (Leaf 2)) $ \x -> (\y -> (\x -> x) $ x + y) 1
=> leafCount_cps (Branch (Leaf 1) (Leaf 2)) $ \x -> (\x -> x) $ x + 1
=> leafCount_cps (Leaf 1) $ \x -> leafCount_cps (Leaf 2) $ \y -> (x -> (\x -> x) $ x + 1) x + y
=> (\x -> leafCount_cps (Leaf 2) $ \y -> (x -> (\x -> x) $ x + 1) x + y) 1
=> leafCount_cps (Leaf 2) $ \y -> (x -> (\x -> x) $ x + 1) 1 + y
=> (\y -> (x -> (\x -> x) $ x + 1) 1 + y) 1
=> (x -> (\x -> x) $ x + 1) 1 + 1
=> (\x -> x) $ 2 + 1
=> 3

うーん、頭の中が爆発しそう。。 (+_+)  ともかく、クロージャがすごく伸びたり縮んだりしている様子はわかった。

 

5. フィボナッチ数

フィボナッチ数列とは、1,1,2,3,5,8・・・と続く数列で、隣り合う2つの数を足し算すると、その上位の数になる数列を言います。

1+2=3 2+3=5 3+5=8 5+8=13 8+13=21・・・と、永遠に続いて行きます。

(株・個人投資家の喫茶店 より)

定義は、フィボナッチ数 - Wikipedia よると、

F_0 = 0\,

F_1 = 1 \,

F_{n+2} = F_n + F_{n+1} \quad (n \ge 0)

これをそのまま書くと、

fib n | n == 0    = 0
      | n == 1    = 1
      | otherwise =  fib (n-1) + fib (n-2)

n が 0 と 1 の場合をまとめ、継続渡しスタイルに変更。

fib_cps n k | n <= 1    = k n
            | otherwise = fib_cps (n-1) $ \x ->
                          fib_cps (n-2) $ \y ->
                          k $ x + y

( cf. c - What is a trampoline function? - Stack Overflow )

( gist: 956745 — Gist )

 

6. リストの平坦化

M.Hiroi's Home Page / お気楽 OCaml プログラミング入門」 の「CPS の便利な使い方」によると、

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

まずは、リストを平坦化する関数を継続渡しスタイルで書く。

concat_cps []       k = k []
concat_cps (xs:xss) k = concat_cps xss $ \xss' -> k $ xs ++ xss' 

「空リストが含まれていたら空リストを返す」ように変更したい場合、次の一行を追加するだけで良い。

concat_cps ([]:_)   k = []

( gist: 954835 — Gist)

print $ concat_cps [[1,2],[3,4],[5,6]] id   -- [1,2,3,4,5,6]
print $ concat_cps [[1,2],[3,4],[],[5,6]] id -- []

ところで、ライブラリに用意されている関数を利用し、同じ機能の関数を定義するなら、

flatten xss = if elem [] xss then [] else concat xss

しかし、型を比較すると、

flatten :: (Eq a) => [[a]] -> [a]
(`concat_cps` id) :: [[a]] -> [a]

flatten 関数はリストの要素間で比較できないと利用できない。例えば、リストの要素が関数である場合はだめ。

print $ length $ flatten [[odd, even], [flip elem [0..10]]]

これに対して、concat_cps では計算が行われる。

print $ length $ concat_cps [[odd, even], [flip elem [0..10]]] id  -- 3

ただし、末尾再帰で書くなら問題ない。

flatten1 xss = flatten' [] xss
    where
      flatten' acc []       = acc
      flatten' acc ([]:_)   = []
      flatten' acc (xs:xss) = flatten' (acc++xs) xss

こちらも要素に空リストがあった場合、すぐに脱出している。

上記のような形の関数になった場合、大抵 fold 系の関数で置き換えることがきるので、試しに書いてみる。

要素が [] の存否を表わす Bool 型をフラグとして用いるなら、

flatten2 = fst. foldr f ([], False)
    where
      f _  (_,  True)  = ([], True)
      f [] (_,  False) = ([], True)
      f xs (xy, False) = (xs ++ xy, False)

しかし、この場合、foldr を使い末尾から先頭へと一巡しているので、先ほどのように途中で計算を抜けているわけではない。

 

7. foldr (畳み込み関数)

では、foldr を継続渡しスタイルしたら、リストの要素を判定することにより、途中で計算を抜けることができるだろうか?

まずは、foldr の定義から確認。

foldr' _ z []     = z
foldr' f z (x:xs) = x `f` foldr' f z xs

 

a. 継続渡しスタイル

foldr を継続渡しスタイルにしてみる。名前を foldr2 とする。

まずは、リストの要素が空の場合は、第 2 引数に与えたに対して関数 k を適用する。

foldr2 _ z []     k = k z

リストの要素がある場合、リストの先頭要素以外のリストに対して、foldr2 を適用し、その結果を無名関数の引数に渡す準備。

foldr2 f z (x:xs) k = foldr2 f z xs $ \y –> … 

上記結果とリストの先頭要素に関数 f を適用し、最後に関数 k を適用する。

foldr2 f z (x:xs) k = foldr2 f z xs $ \y -> k $ f x y 

これを使って、1 から 10 までのリストの要素を足し合わせる。

print $ foldr2 (+) 0 [1..10] id   -- 55

上記結果を 2 倍したいなら、

print $ foldr2 (+) 0 [1..10] (* 2)  -- 110

( gist: 955325 — Gist )

 

b. 要素の値により、値を渡す先を変更

ここで先ほどの flatten 関数の仕様、

リストの要素に空リストが含まれていたら空リストを返す

というように変更。

要素を見て、空リストを返せばいいので、

foldr2' _ z [] k = k z
foldr2' f z (x:xs) k = foldr2' f z xs $ \y ->
                       if x == [] then [] else k $ f x y 

これを使うと、

print $ foldr2' (++) [] [[1,2],[3,4],[5,6]] id    -- [1,2,3,4,5,6]
print $ foldr2' (++) [] [[1,2],[3,4],[],[5,6]] id -- []

ただし、この定義では関数の型を確認すると、第 3 引数が「リストのリスト」に固定されてしまっている。

foldr2'
  :: (Eq a) =>
     ([a] -> a2 -> a2) -> a2 -> [[a]] -> (a2 -> [a1]) -> [a1]

( gist: 955345 — Gist )

上記を元により一般的な形にする。

  1. 条件は述語 p を与えるようにし、
  2. 述語が真であるとき、その要素の値に対して適用する関数を k’ とする。
foldr2_cps _ z []     p k _ = k z
foldr2_cps f z (x:xs) p k k' 
    | p x       = k' x
    | otherwise = foldr2_cps f z xs p (\y -> k $ f x y) k'

今度は型が以下のようになった。

foldr2_cps
  :: (t -> a -> a)
     -> a
     -> [t]
     -> (t -> Bool)
     -> (a -> b)
     -> (t -> b)
     -> b
使ってみると、適用対象が「リストのリスト」に限定されてないのが確認できる。
print $ foldr2_cps (++) [] [[1,2],[3,4],[5,6]] 
          (== []) id id                           -- [1,2,3,4,5,6]
print $ foldr2_cps (++) [] [[1,2],[3,4],[],[5,6]] 
          (== []) id id                           -- []
print $ foldr2_cps (+) 0 [1..10] (== 0) id id     -- 55
print $ foldr2_cps (+) 0 [1..10] (== 5) id id     -- 5

( gist: 955465 — Gist )

 

c. 「引数の関数」を継続渡しスタイルにする場合

ついでなので、「Haskell/Continuation passing style - Wikibooks」 の thrice 関数の例に書かれていたように、引数の関数を継続渡しスタイルにしてみる。

foldr で関数を引数に与えているのは第 1 引数。引数を 2 つ受け取り、何らかの計算をした結果を返す。

foldr' _ z []     = z
foldr' f z (x:xs) = x `f` foldr' f z xs

第1引数の名前を f_cps に変更し、「引数 2 つ受け取り、何らかの計算をした結果」に対して関数を適用するように変更してみる。

CropperCapture[170]

foldr3 _     z []     k = k z
foldr3 f_cps z (x:xs) k = f_cps x (foldr3 f_cps z xs k) $ \y -> k y

使ってみる。

print $ foldr3 (\x y k -> k $ x + y) 0 [1..3] id    -- 6
print $ foldr3 (\x y k -> k $ x + y) 0 [1..3] (* 2) -– 34

( gist: 956504 — Gist )

計算の過程は、下図の通り。

CropperCapture[171]

ところで、先ほど定義した foldr2 と foldr3 を並べて比較。

foldr2 _ z []     k = k z
foldr2 f z (x:xs) k = foldr2 f z xs $ \y -> k $ f x y 
foldr3 _     z []      k = k z
foldr3 f_cps z (x:xs ) k = f_cps x (foldr3 f_cps z xs k) $ \y -> k y

共に空リストに対する定義が

k z

となっている。

しかし、foldr2 が末尾再帰になっているのに対して、 foldr3 はそうではない。この定義の違いにより、動作が異なる。つまり、foldr2 が計算の過程で再帰呼び出しにより、そっくり定義が置き換えられていくのに対し、foldr3 では関数の呼び出しが積み重なっていく。

foldr2_cps の定義に類似した foldr3_csp を考える。

foldr3' _     z [] p      k _ = k z
foldr3' f_cps z (x:xs)  p k k'
    | p x = k' x
    | otherwise = f_cps x (foldr3' f_cps z xs p k k') $ \y -> k y

一見同じように見えるけれど、

print $ foldr3' (\x y k -> k $ x ++ y) []
          [[1,2],[3,4],[5,6]] (== []) id id     -- [1,2,3,4,5,6]
print $ foldr3' (\x y k -> k $ x ++ y) []
          [[1,2],[3,4],[],[5,6]] (== []) id id  -- [1,2,3,4]

foldr3_cps の方は、述語 p で指定した条件に合った場合、脱出時に一気に抜けるのではなく、それまでに生成したクロージャの計算がなされ、その値が返される。

( gist: 956626 — Gist )

これで、CPS の感覚が大分つかめるようになったかな。

Haskell で継続渡しスタイル (CPS) につづく