Skip to content

Instantly share code, notes, and snippets.

@halcat0x15a

halcat0x15a/ocaml_effects.md

Last active January 29, 2023 13:59
Show Gist options
  • Star 3 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save halcat0x15a/a537159180c21164a134833b7b35498e to your computer and use it in GitHub Desktop.
Save halcat0x15a/a537159180c21164a134833b7b35498e to your computer and use it in GitHub Desktop.
Download ZIP
Raw
ocaml_effects.md

OCaml 5.0のEffect handlersをさわってみた

Effect handlersについて調べた時のメモ書きです。 OCamlについては初心者です。

参考文献

DeepとShallowについて

まず疑問に思った点はDeepとShallowの違いについて。

以下公式Manual

A deep handler monitors a computation until the computation terminates (either normally or via an exception), and handles all of the effects performed (in sequence) by the computation. In contrast, a shallow handler monitors a computation until either the computation terminates or the computation performs one effect, and it handles this single effect only.

全てのEffectが処理されるか単一のEffectが処理されるかの違いらしい。 DeepとShallowではhandlerのシグネチャが異なる。

  (* Deep *)
  type ('a,'b) handler =
    { retc: 'a -> 'b;
      exnc: exn -> 'b;
      effc: 'c.'c t -> (('c,'b) continuation -> 'b) option }

  (* Shallow *)
  type ('a,'b) handler =
    { retc: 'a -> 'b;
      exnc: exn -> 'b;
      effc: 'c.'c t -> (('c,'a) continuation -> 'b) option }

'a は単一のEffectの計算結果で 'b が継続全体の計算結果だろう。

Deepの場合はmatch_with、Shallowの場合はcontinue_withを使ってhandlerを計算に組み込む。より簡易的なものとしてeffcだけ記述するtry_withもある。

retcは純粋な計算値を、exncは計算の中で投げられた例外を、effcはエフェクトを処理する。impureな（エフェクトのある）計算を処理した後にpureな計算値が出てくるので、基本的にretcが一番最後に呼ばれる処理という認識で良いだろう。

let match_with comp arg handler : ('a -> 'b) -> 'a -> ('b, 'c) handler -> 'c

compにhandlerを組み込んでargにより計算が実行される感じだろう。handlerが組み込まれることによって、compの中で呼び出されるperformを処理することができる。

このhandlerの組み込みを再帰的にやるかどうかがDeepとShallowの違いになるだろう。Deepは全てのperformを処理するが、Shallowでは1回performを処理したらそれ以降のperformは処理されない。

基本的にはDeepを使って書いて、計算に状態を持たせるなど、自身で再帰を記述したい場合はShallowを使うことになるだろう。

State Effect

MonadやEffectなどのcontextualな計算機構を理解するなら状態計算を書いてみるのが良いと思っているので、StateのEffectを記述してみる。

Stateを作るならば、まずはReaderから作ってみるのがよい。

open Effect
open Effect.Deep

type _ Effect.t += Get: int t

let get () = perform Get

let run_reader (i: int) e =
  try_with e ()
  { effc = fun (type a) (eff: a t) ->
      match eff with
      | Get -> Some (fun (k: (a, _) Deep.continuation) -> continue k i)
      | _ -> None }

let p1 () = get () + 1

let () = Printf.printf "run_reader: %d\n" (run_reader 0 p1)

今回扱う状態はintに限定する。多相的に扱えるようにするにはファンクタを使うことになるだろうか。

type _ Effect.t += Get: int t

Effect.tに対してコンストラクタGetを追加している。これはExtensible variant typesというものらしい。 tはパラメータをとるのだが、GADTsでGetの型をint tとして定義している。

let get () = perform Get

performすることでintの値を取得できる。これをgetとして定義した。

let run_reader (i: int) e =
  try_with e ()
  { effc = fun (type a) (eff: a t) ->
      match eff with
      | Get -> Some (fun (k: (a, _) Deep.continuation) -> continue k i)
      | _ -> None }

run_readerは環境i : intと計算e : unit -> 'aをとって計算結果'aを返す。 handlerはエフェクトがGetの場合にcontinueを使って継続の呼び出しを行う。継続kに環境iを渡すことで、計算eの中で呼び出されるperform Getは環境iを返すようになる。

let p1 () = get () + 1

let () = Printf.printf "run_reader: %d\n" (run_reader 0 p1)

p1はgetした結果に対して1を足すプログラムになる。run_readerで環境に0を渡して実行することで0 + 1となり1が計算結果として返る。

Readerのエフェクトは実行しても計算結果の型は変わらないし、状態を持つわけでもないので最もシンプルなtry_withにより記述できた。これに対して、Stateのエフェクトはより複雑なものになる。

open Effect
open Effect.Shallow

type _ Effect.t += Get: int t
                 | Put: int -> unit t

let get () = perform Get

let put s = perform (Put s)

let modify f = put (f (get ()))

let run_state (s: int) e =
  let rec loop : type a. int -> (a, _) Shallow.continuation -> a -> (int * _) = fun s k v ->
    continue_with k v
    { retc = (fun v -> (s, v));
      exnc = raise;
      effc = fun (type a) (eff: a t) ->
        match eff with
        | Get -> Some (fun (k: (a, _) Shallow.continuation) -> loop s k s)
        | Put s' -> Some (fun (k: (a, _) Shallow.continuation) -> loop s' k ())
        | _ -> None }
  in
  loop s (fiber e) ()

let eval_state s e = let _, v = run_state s e in v

let exec_state s e = let s, _ = run_state s e in s

let p1 () = get () + 1

let p2 () =
  modify (fun v -> v * 2);
  p1 ()

let () =
  Printf.printf "eval_state: %d\n" (eval_state 1 p2);
  Printf.printf "exec_state: %d\n" (exec_state 1 p2)

Readerのエフェクトを部分的に流用している。差分を見ていこう。

type _ Effect.t += Get: int t
                 | Put: int -> unit t

新たにPutというコンストラクタを追加した。Putはintの値を持つ。これを使って状態を更新する。

let get () = perform Get

let put s = perform (Put s)

let modify f = put (f (get ()))

getとputを定義したことにより、現在の状態を書き換えるmodifyを定義できるようになった。書き換えるのはStateのエフェクトが持つ状態だけであり、計算結果としてはunitが返る。

let run_state (s: int) e =
  let rec loop : type a. int -> (a, _) Shallow.continuation -> a -> int * _ = fun s k v ->
    continue_with k v
    { retc = (fun v -> (s, v));
      exnc = raise;
      effc = fun (type a) (eff: a t) ->
        match eff with
        | Get -> Some (fun (k: (a, _) Shallow.continuation) -> loop s k s)
        | Put s' -> Some (fun (k: (a, _) Shallow.continuation) -> loop s' k ())
        | _ -> None }
  in
  loop s (fiber e) ()

Stateのエフェクトハンドラの実装を見ていこう。run_stateは初期状態s : intと計算e : unit -> 'aをとって状態と計算結果のペアint * 'aを返す。

  let rec loop : type a. int -> (a, _) Shallow.continuation -> a -> int * _ = fun s k v ->

再帰によって状態を引き回すため、内部でloopを定義した。loopは状態s : intと継続k : (a, 'a) continuationと継続を実行するための計算値v : aをとって状態と計算結果のペアint * 'aを返す。このcontinuationはShallowモジュールのものであり、continue_withにより継続を実行することができる。

    continue_with k v
    { retc = (fun v -> (s, v));
      exnc = raise;
      effc = fun (type a) (eff: a t) ->
        match eff with
        | Get -> Some (fun (k: (a, _) Shallow.continuation) -> loop s k s)
        | Put s' -> Some (fun (k: (a, _) Shallow.continuation) -> loop s' k ())
        | _ -> None }

continue_withに渡すhandlerについて見ていく。retcはStateのエフェクトハンドラの計算結果として状態と計算値のペアで返している。exncは計算の中で例外が投げられた時に呼び出されるが、ここではそのままraiseをして例外を投げている。effcではエフェクトがGetの場合にloopで継続を状態sで呼び出している。エフェクトがPutの場合は継続を()で呼び出しているが、引き回す状態をs'に更新している。

  loop s (fiber e) ()

loopを呼び出す際には継続が必要になるが、fiberによって計算unit -> 'aを継続(unit, 'a) continuationに変換することができる。

let eval_state s e = let _, v = run_state s e in v

let exec_state s e = let s, _ = run_state s e in s

run_stateは状態と計算結果のペアを返すが、eval_stateは計算結果だけを、exec_stateは状態だけを返すために定義される。

let p1 () = get () + 1

let p2 () =
  modify (fun s -> s * 2);
  p1 ()

let () =
  Printf.printf "eval_state: %d\n" (eval_state 1 p2);
  Printf.printf "exec_state: %d\n" (exec_state 1 p2)

p1はReaderのエフェクトの例で定義したものと同じになる。p2はmodifyで現在の状態に2を掛けた後にp1を呼び出している。eval_stateで初期状態を1とした時に、p2の計算結果は1 * 2 + 1で3になる。一方exec_stateで初期状態を1とした時に、p2の状態を計算すると初期状態1から1 * 2で状態が更新され、最終的な状態として2が返る。

このように、再帰を記述することで状態を引き回すことができ、そのためにShallowのEffect handlersを利用することが可能であることがわかった。

最後に複数のエフェクトを処理する例を見ておこう。

type _ Effect.t += Exc: string -> _ t

let throw e = perform (Exc e)

let run_error e =
  match_with e ()
  { retc = (fun v -> Either.Right v);
    exnc = raise;
    effc = fun (type a) (eff: a t) ->
      match eff with
      | Exc s -> Some (fun _ -> Either.Left s)
      | _ -> None }

Errorのエフェクトを定義した。

Excはエラー値として文字列の値を持つ。performすることで任意の型を返すことができる。throwとして定義した。

run_errorは計算を実行して、Excを処理した場合はEither.Leftで、Excが現れなかったらEither.Rightで計算結果を返す。

let p3 () =
  modify (fun s -> s + 1);
  throw "interrupted!"

let () =
  Printf.printf "without transaction: %d\n" (exec_state 0 (fun () -> (run_error p3)))

p3は状態に対して1を足して例外を投げるようなプログラムになる。

p3に対してrun_errorを適用した後、初期状態を0としてexec_stateをすると計算結果としては1が返る。これは最初にrun_errorをすることでエラーが全て処理された後、状態計算を行っているので、throwの前にあるmodifyは正常に処理される。run_errorとrun_stateの順番を変えれば、全体の計算結果はEither.Left "interrupted!"になるだろう。

ここで、Stateのエフェクトにおいて、Errorのような他のエフェクトを考慮するような処理を加えてみよう。

let transaction e =
  let s, v = run_state (get ()) e in
  put s;
  v

transactionは現在の状態を初期値としてrun_state実行し、それで得られた新たな状態をputしている。この関数を利用することで先ほどとは違った結果が得られる。

let () =
  Printf.printf "with transaction: %d\n" (exec_state 0 (fun () -> (run_error (fun () -> transaction p3))));

これで得られる計算結果は0となる。transactionが適用されることによって、p3のStateのエフェクトが全て正常に処理されることで状態の更新と計算結果が得られるが、プログラムの途中でthrowされているため、transactionの処理は完了することができない。結果、run_errorで計算結果がEither.Left "interrupted!"となり、exec_stateを適用してもmodifyは既に処理されているため、初期状態の0が返る。

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment