OCaml Effects Tutorialの演習「StateのHistory実装」をやってみる

前回に続いてState関連の演習問題を解いていく。

github.com

問題

今回は今までのStateの履歴をリストとして返すHistoryエフェクトの実装。

まずはSTATEシグニチャに追加：

module type STATE = sig
  type t
  val get : unit -> t
  val put : t -> unit
  val history : unit -> t list
  val run : (unit -> unit) -> init:t -> unit
end

実装

実装の全容：

module State (S : sig type t end) : STATE with type t = S.t = struct
  type t = S.t

  type _ Effect.t += Get : t Effect.t
  type _ Effect.t += Put : t -> unit Effect.t
  type _ Effect.t += History : t list Effect.t

  let get () = Effect.perform Get
  let put x = Effect.perform (Put x)
  let history () = Effect.perform History

  let run f ~init =
    let module Es = Effect.Shallow in
    let rec loop : type a r. t list -> (a, r) Es.continuation -> a -> r =
      fun states k x ->
        let handler = {
          Es.retc = (fun result -> result);
          Es.exnc = (fun e -> raise e);
          Es.effc = (fun (type b) (eff : b Effect.t) ->
            match eff with
            | Get -> Some (fun (k: (b, r) Es.continuation) ->
                       loop states k (List.hd states))
            | Put x -> Some (fun (k: (b, r) Es.continuation) ->
                       loop (x::states) k ())
            | History -> Some (fun (k: (b, r) Es.continuation) ->
                       loop states k (List.rev states))
            | _ -> None)
        } in
        Es.continue_with k x handler
    in
    loop [init] (Es.fiber f) ()
end

状態の内部表現がstate : tだったのがstates : t listに置き換わっている。

Getではそのリストの先頭をとって限定継続に渡す（状態はstatesのまま）：

| Get -> Some (fun k ... -> loop states k (List.hd states))

Putはそのリストにappendして新しい状態とする（限定継続には()を渡す）：

| Put x -> Some (fun k ... -> loop (x::states) k ())

そして今回追加したHistoryはそのリストを逆順にして限定継続に渡す（状態はstatesのまま）：

| History -> Some (fun k ... -> loop states k (List.rev states))

今回の変更の主要なポイントとしては大体これくらいなので、非常に簡単に拡張できた印象。

使ってみる

module IS = State (struct type t = int end)
module SS = State (struct type t = string end)

let foo () : unit =
  let open Printf in
  printf "%d\n" (IS.get ());
  printf "%d\n" (IS.get ());
  IS.put 4;
  printf "%d\n" (IS.get ());
  IS.put 2;
  printf "%s\n" (SS.get ());
  SS.put "hello";
  printf "%s\n" (SS.get ());
  assert ([42; 4; 2] = IS.history ());
  assert (["forty two"; "hello"] = SS.history ())

let _ = IS.run (fun () -> SS.run foo ~init:"forty two") ~init:42

ocaml state.mlと実行すると新しく追加したassert部分も失敗することなくコードが走る。

次回

OCaml 5.0のEffectsにはLocally abstract typesが多用されるので、そこら辺をもう少し理解したいということで調べる。