OCaml Effects Tutorialの演習「Generators from iterators」をやってみる２

前回に続いてOCaml Effects TutorialのGenerators from Iteratorsをやっていく。

前回のコード

前回のコードを再掲する：

type ('elt, 'container) iterator = ('elt -> unit) -> 'container -> unit

type 'elt generator = unit -> 'elt option

let generate (type elt) (i : (elt, 'container) iterator) (c : 'container) : elt generator =
  let module D = Effect.Deep in
  let open struct
    type _ Effect.t += Yield : elt -> unit Effect.t
    type status =
    | Paused of elt * (unit, status) D.continuation
    | Done
  end in
  let yield x = Effect.perform (Yield x) in
  let handler = {
    D.retc = (fun () -> Done);
    D.exnc = (fun e -> raise e);
    D.effc = (fun (type b) (eff : b Effect.t) ->
      match eff with
      | Yield x -> Some (fun (k: (b,status) D.continuation) -> Paused (x, k))
      | _ -> None)
  } in
  let status = ref (D.match_with (i yield) c handler) in
  fun () -> match !status with
  | Paused (v, k) -> status := (D.continue k ()); Some v
  | Done -> None

前回書いた通り、このコードの問題は「n番目の要素をgeneratorから取り出した時点で既に内部状態でn+1番目の要素をiteratorから取り出している」というルックアヘッドに頼っている点。なるべくiteratorとgeneratorの進み具合を一致させたい。

修正したコード

というわけで修正したコードの全容：

type ('elt, 'container) iterator = ('elt -> unit) -> 'container -> unit

type 'elt generator = unit -> 'elt option

let generate (type elt) (i : (elt, 'container) iterator) (c : 'container) : elt generator =
  let module D = Effect.Deep in
  let open struct
    type _ Effect.t += Yield : elt -> unit Effect.t
    type status =
    | Starting
    | Paused of (unit, elt option) D.continuation
    | Done
  end in
  let yield x = Effect.perform (Yield x) in
  let status = ref Starting in
  let handler = {
    D.retc = (fun () -> status := Done; None);
    D.exnc = (fun e -> raise e);
    D.effc = (fun (type b) (eff : b Effect.t) ->
      match eff with
      | Yield x ->
        let handle_eff (k: (b,elt option) D.continuation) =
          status := Paused k;
          Some x
        in
        Some handle_eff
      | _ -> None)
  } in
  fun () -> match !status with
  | Starting -> D.match_with (i yield) c handler
  | Paused k -> D.continue k ()
  | Done -> None

変更箇所は以下の通り：

• status型にStartingバリアントを追加
• status型のPausedバリアントの保持する値をelt * (unit, status) D.continuationから(unit, elt option) D.continuationに変更
• let status = ...をlet handler = ...の前に定義
• let status = ref (D.match_with (i yield) c handler)からlet status = ref Startingに
• handlerがstatus型の値を返すのではなくstatus値に代入した上でelt option型の値を返す
• 最後のfun () -> ...に| Starting -> D.match_with (i yield) c handlerというケースを追加
• fun () -> ...のPausedケースを| Paused (v, k) -> status := (D.continue k ()); Some vから| Paused k -> D.continue k ()に変更

一つ一つを見ていく。

status型

generatorの状況を表現するためのstatus型に「まだgeneratorから値を取り出していない」状況を表すStartingバリアントを追加する：

    type status =
    | Starting
    | Paused of (unit, elt option) D.continuation
    | Done

また前回のコードではPaused of elt * (unit, status) D.continuationで「次にgeneratorとして返す値」を「次に実行する限定継続」と一緒に保持していたのだが、そのような「次に渡す値」を算出しないようにするのでPaused of (unit, elt option) D.continuationと保持する値が限定継続だけになる。また限定継続の型自体も（値も保持した）statusを返すのではなく値そのもののオプションelt option型を返すようにする。

let status = ...

ハンドラの定義が前回では：

  let handler = { ... } in
  let status = ref (D.match_with (i yield) c handler) in

だったのが今回は：

  let status = ref Starting in
  let handler = { ... } in

このようになっている。

以前はstatusの初期値を計算するのにhandlerを使って一回iteratorから値と限定継続を取り出していたのが、今回は単にStartingで初期化している。そのかわりhandlerの中でstatus値に対して破壊的代入を行なっている。なので定義順を入れ替える必要があった。

let handler = ...

ハンドラはretcとeffcの両方が変わっている。

前回：

  let handler = {
    D.retc = (fun () -> Done);
    D.exnc = (fun e -> raise e);
    D.effc = (fun (type b) (eff : b Effect.t) ->
      match eff with
      | Yield x -> Some (fun (k: (b,status) D.continuation) -> Paused (x, k))
      | _ -> None)
  }

今回：

  let handler = {
    D.retc = (fun () -> status := Done; None);
    D.exnc = (fun e -> raise e);
    D.effc = (fun (type b) (eff : b Effect.t) ->
      match eff with
      | Yield x ->
        let handle_eff (k: (b,elt option) D.continuation) =
          status := Paused k;
          Some x
        in
        Some handle_eff
      | _ -> None)
  }

retc

    D.retc = (fun () -> Done);

が

    D.retc = (fun () -> status := Done; None);

になっている。つまり以前はstatus型のDoneバリアントを返していたのに対して、今回のコードではstatus値にDoneを代入した上でNoneを返している。（Noneはelt option型だ）

effc

    D.effc = (fun (type b) (eff : b Effect.t) ->
      match eff with
      | Yield x -> Some (fun (k: (b,status) D.continuation) -> Paused (x, k))
      | _ -> None)

が

    D.effc = (fun (type b) (eff : b Effect.t) ->
      match eff with
      | Yield x ->
        let handle_eff (k: (b,elt option) D.continuation) =
          status := Paused k;
          Some x
        in
        Some handle_eff
      | _ -> None)

になっている。

限定継続の型注釈がk: (b,status) D.continuationがk: (b,elt option) D.continuationになり、限定継続が返す値の型がstatusからelt optionになったのを反映している。

そしてYield xエフェクトに対する処理自体が単にPaused(k, x)を返していたのが、status値にPaused kを破壊的に代入してからSome xを返すようになった。

以前はstatus値の更新をハンドラの外でやっていたのだが、今回はハンドラ内で実行している。ハンドラの外にPaused k（あるいはDone）も持ち出す場合、ハンドラからの返り値の型を新たに定義しなくてはいけなかったり、その結果に対して再度パターンマッチする必要が生じたりと記述がもたつくので、ほとんどの処理をハンドラ内で完結するようにしてある。

fun () -> match !status with ...

前回：

  fun () -> match !status with
  | Paused (v, k) -> status := (D.continue k ()); Some v
  | Done -> None

今回：

  fun () -> match !status with
  | Starting -> D.match_with (i yield) c handler
  | Paused k -> D.continue k ()
  | Done -> None

まず| Paused (v, k) -> status := (D.continue k ()); Some vが| Paused k -> D.continue k ()になっている。ポイントは：

• Pausedが限定継続のみを保持するようになった
• status値の更新はハンドラ内で行われるようになった
• D.continue k ()がそのままSome vのようなelt option型の値を返すようになった

という三点。今回の実装だと現在Pausedに保持されている限定継続をcontinueして返ってきた結果をそのまま返すようになっていて、前回の「一つ先の要素に対するルックアヘッドが行われてしまう」という問題が解決している。

さらにstatus型に追加された新バリアントであるStartingに対して| Starting -> D.match_with (i yield) c handlerとパターンマッチを行なっている。generate関数の引数であるiteratorのi、containerのc（この1文字変数名、演習問題だからそのままにしているけど嫌な気分になるな・・・）、Yieldエフェクトを発生させるyield関数、そして定義したhandlerがここで組み合わさる。

iterator関数のiがcontainerであるcに対してiterateし、cの各要素に対してyieldでYieldエフェクトを発生させ、そのエフェクトをhandlerで受け取って「iterationをそこで一旦停止させ限定継続を保存した上で要素を返す」という挙動を実現している。D.match_with (i yield) c handlerはやはり使われているハンドラ内部でstatus値を更新し、結果としてelt option型の値を返す。

次回

このコードで問題ないのだが、Effect.Shallowを使うと普通の関数を限定継続化できるのでStartingというバリアントに表される特殊ケースが必要なくなる。次回はその実装を見ていく。