継続渡しスタイルを使ってListコンピュテーション式を実装する

引き続き、コンピュテーション式を継続渡しスタイルで実装する編です。 今回は、

コンピュテーション式におけるreturnとyield - ぐるぐる~

で定義されているListコンピュテーション式を、継続渡しスタイルで実装してみましょう。 なお、Using や Whileなど省略しているメソッドは、型以外同じ(型推論に任せればまったく同じ)実装になるため省略します。

実装

type ListBuilder internal () =
  member this.Zero() = fun k -> k []
  member this.Return(x) = fun _ -> [x]
  member this.ReturnFrom(xs: _ list) = fun _ -> xs
  member this.Yield(x) = fun k -> k [x]
  member this.YieldFrom(xs: _ list) = fun k -> k xs
  member this.Bind(xs, f) =
    let rec fold acc = function
    | [] -> this.Zero()
    | [x] -> acc x
    | x::xs -> fold (fun y k -> acc x (fun l -> List.append l (f y k))) xs
    fold f xs
  member this.Combine(f, rest) =
    fun k -> f (fun xs -> rest () k |> List.append xs)
  member this.Delay(f) = f
  member this.Run(f) = f () id

Bind が今までとは少し毛色が異なるので、解説しておきます。

Bind

第一引数は 'a list、第二引数は 'a -> ('a list -> 'b list) -> 'b list) であればよいことは、変換規則を考慮するとすぐに思い至ります。

空リストに関しては、 Zero の結果を使えば事足ります。要素が一つの場合は、第二引数の関数を適用すればよいことも難しくはないでしょう。

複数要素が存在する場合は fold に似た動きをさせることで解決しました。アキュムレータとして渡されるものが関数という点を除けば、そんなに難しいものでもないです。単純に List.fold にできないのは、戻り値の型が 'a -> ('a list -> 'b list) -> 'b list) になってしまうからですね。

List.append を使った影響でパフォーマンス悪化が懸念として残っていますが、それはおいおい性能調査していくつもりです。

2014/02/10 追記:Seq ベースにする

id:bleis-tift さんと相談して、 Seq ベースにしてみました。

2014/02/12追記: CPS版 Seq.fold を定義すればより簡潔になるので変更。ついでに一部メソッドで Seq モジュールの関数を使うように修正。

type ListBuilder internal () =
  member this.Zero() = fun k -> k Seq.empty
  member this.Return(x) = fun _ -> Seq.singleton x
  member this.ReturnFrom(xs: _ list) = fun _ -> Seq.ofList xs
  member this.Yield(x) = fun k -> Seq.singleton x |> k
  member this.YieldFrom(xs: _ list) = fun (k: _ seq -> _) -> k xs
  member this.Bind(xs, f) =
    // Seq.fold の CPSlet rec fold f acc xs k =
      if Seq.length xs = 0 then k acc
      else f (fun v -> fold f v (Seq.skip 1 xs) k) acc (Seq.head xs)
    fold (fun k acc x -> seq { yield! acc; yield! f x k; }) Seq.empty xs
  member this.Combine(f, rest) =
    fun k -> f (fun xs -> rest () k |> Seq.append xs)
  member this.Delay(f) = f
  member this.Run(f) = f () id |> Seq.toList

いくつかの部分に、 'a list'a seq と認識させるための仕込みを入れている以外は、List ベースのものとほとんど変わりません。

おわりに

継続渡しスタイルを使えば、コンピュテーション式の制御をわりと楽に行えて便利ですね。そのかわり、ラップして使用するには継続渡しスタイルを知っていなければなりませんが…。