OCaml Effects Tutorialの第一演習「Exceptionの再実装」をやってみる２

前回の締めで書いたとおり、以下のException再実装は結果こそ期待通りに返ってくるものの、内容的には不満が残る：

open Effect
open Effect.Deep

type _ Effect.t += Raise_exception : exn -> _ Effect.t

let raise (e : exn) : 'a = perform (Raise_exception e)

let try_with (f : unit -> 'a) (h : exn -> 'a) : 'a =
  let handler = {
    effc = (fun (type c) (eff : c Effect.t) ->
      match eff with
      | Raise_exception e -> Some (fun (k : (c,_) continuation) -> h e)
      | _ -> None);
    exnc = (fun e -> raise e);
    retc = (fun e -> e)
  } in
  match_with f () handler

というわけで段階的に改善していく。

openの除去

冒頭のopenを何とかしたい。

とりあえずEffectモジュールはtype tとval performしか入っていない。そしてtype tに関してはOCaml effect tutorialでは一貫してEffect.tとして使っている。なのでopen Effectはperformの先頭のモジュールアクセスを省略するためにしか使っていない。

というわけで省く：

open Effect.Deep

type _ Effect.t += Raise_exception : exn -> _ Effect.t

let raise (e : exn) : 'a = Effect.perform (Raise_exception e)

let try_with (f : unit -> 'a) (h : exn -> 'a) : 'a =
  let handler = {
    effc = (fun (type c) (eff : c Effect.t) ->
      match eff with
      | Raise_exception e -> Some (fun (k : (c,_) continuation) -> h e)
      | _ -> None);
    exnc = (fun e -> raise e);
    retc = (fun e -> e)
  } in
  match_with f () handler

次にEffect.Deepモジュールだが、よくみるとこのモジュールの中身を使っているのはtry_with関数の定義の中だけだ。なのでこの関数内で1文字変数名のモジュールにしてしまう：

type _ Effect.t += Raise_exception : exn -> _ Effect.t

let raise (e : exn) : 'a = Effect.perform (Raise_exception e)

let try_with (f : unit -> 'a) (h : exn -> 'a) : 'a =
  let module D = Effect.Deep in
  let handler = {
    D.effc = (fun (type c) (eff : c Effect.t) ->
      match eff with
      | Raise_exception e -> Some (fun (k : (c,_) D.continuation) -> h e)
      | _ -> None);
    D.exnc = (fun e -> raise e);
    D.retc = (fun e -> e)
  } in
  D.match_with f () handler

変更としては

• Effect.Deepモジュールに一文字変数Dを束縛
• match_with関数はEffect.Deepから来ているのでD.match_withに
• handlerの型は('a, 'b) Effect.Deep.handlerなのでそのフィールド名すべてにDをつける
• continuation型もEffect.Deepから来ているのでD.continuationに

と、Effect.Deep由来の関数・型が明示的になって個人的にはかなり嬉しい。

match_withとtry_with

これまでEffect.Deepのmatch_with関数を使ってきた。それに渡すために('a, 'b') Effect.Deep.handler型のレコードを作成する。これはeffc、exnc、retcの３フィールドが存在し、それぞれ

• effectが生じた時のハンドラ
• 普通のOCaml例外が生じた時のハンドラ
• 関数が普通に結果を返した時のハンドラ

の三関数となる。

今回のケースを見ると、ロジックらしいロジックがあるのはeffcだけで、他の二つは「そのまま例外を投げる」「そのまま値を返す」という処理になっている。こういうケースは非常に多いだろうことは想像に難くない。

というわけでeffectだけのロジックを書ける専用関数とレコード型が存在する。

Effect.Deep.try_withと'a Effect.Deep.effect_handlerだ（このtry_withは「演習問題の一部として定義しないといけない関数」と同名でややこしいがまったく別物である）。これらについてはモジュールのドキュメント参照のこと。

これらを使うと以下のようになる：

type _ Effect.t += Raise_exception : exn -> _ Effect.t

let raise (e : exn) : 'a = Effect.perform (Raise_exception e)

let try_with (f : unit -> 'a) (h : exn -> 'a) : 'a =
  let module D = Effect.Deep in
  let handler = {
    D.effc = fun (type c) (eff : c Effect.t) ->
      match eff with
      | Raise_exception e -> Some (fun (k : (c,_) D.continuation) -> h e)
      | _ -> None
  } in
  D.try_with f () handler

ボイラープレートが減って少々スッキリする。

handlerの整理

handlerの部分を見直してみる：

  let handler = {
    D.effc = fun (type c) (eff : c Effect.t) ->
      match eff with
      | Raise_exception e -> Some (fun (k : (c,_) D.continuation) -> h e)
      | _ -> None
  }

まずSome (fun (k : (c,_) D.continuation) -> h e)の部分でkに言及する必要がないのがわかる。なぜなら使わないので。というわけでここはSome (fun _ -> h e)でいい。

次にfun (type c) (eff : c Effect.t) -> ...の部分。(k : (c,_) D.continuation)の部分が消えたのでlocally abstract typeのcを導入する必要がなくなった。なのでここはfun (eff : _ Effect.t) -> ...でいい。

そしてfun (eff : _ Effect.t) -> match eff with | Raise_exception e -> ...となっているということはeffが_ Effect.tであることは推論できるのでその部分の型注釈もいらない。つまりfun eff -> match eff with | Raise_exception e -> ...。そしてそれはさらに単純化してfunction | Raise_exception e -> ...にできる。

以下のようになる：

type _ Effect.t += Raise_exception : exn -> _ Effect.t

let raise (e : exn) : 'a = Effect.perform (Raise_exception e)

let try_with (f : unit -> 'a) (h : exn -> 'a) : 'a =
  let module D = Effect.Deep in
  let handler = {
    D.effc = function
    | Raise_exception e -> Some (fun _ -> h e)
    | _ -> None
  } in
  D.try_with f () handler

今回の構文の整理が可能なのはエフェクトの処理で限定継続をまったく使わないからだ。ハンドラ内で限定継続を使う場合、その「限定継続に渡す値の型」と「エフェクトが返す値の型」が合致しているという制約を明示的に書く必要が生じ、その結果locally abstract typesが必要になる。（正直「なぜこの制約を明示しないといけないのか・よしなに推論してくれないのか」については理解できていないが・・・）

何はともあれ例題のコードのどの部分がどのモジュールから来ていて、どういう意図を持ち、どういう状況で必要・不必要になるのか、色々考えることができたので大変ありがたい演習だった。このままtutorialをすすめていく。

余談

前回気になっていた以下のwarningが出る件：

33 |   (fun Invalid_argument -> Printf.printf "Invalid_argument to sqrt\n")
       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 8 [partial-match]: this pattern-matching is not exhaustive.

考えたけどあまりうまい手が思いつかなかったのでsolutionを見てみた：

github.com

ここのコードが：

(fun Invalid_argument -> Printf.printf "Invalid_argument to sqrt\n")

以下のように書きかわっていた：

(function
   | Invalid_argument -> Printf.printf "Invalid_argument to sqrt\n"
   | _ -> ())

他の例外全部握りつぶしているがいいのか・・・？