如何停止 OCaml 垃圾收集我的反应事件处理程序？

Question

我正在尝试将OBus 库与Lwt_react 一起使用。这对属性和信号使用“函数式反应式编程”。

问题（如React documentation 中所述）是OCaml 可能会在您仍在使用它时垃圾收集您的回调。有一个keep 函数，它可以永久保存处理程序，但我不希望这样。我确实想最终释放它，而不是在我仍然需要它的时候。

所以，我想我会将处理程序附加到开关：

let keep ~switch handler =
  Lwt_switch.add_hook (Some switch) (fun () ->
    ignore handler;
    Lwt.return ()
  )

但是我的事件处理程序无论如何都会被垃圾收集（这是有道理的，因为关闭开关的代码在信号到达时被调用，所以它只是首先保持开关处于活动状态的信号处理程序）。

这是我的代码的简化（独立）版本：

(* ocamlfind ocamlopt -package react,lwt,lwt.react,lwt.unix -linkpkg -o test test.ml *)

let finished_event, fire_finished = React.E.create ()

let setup () =
  let switch = Lwt_switch.create () in

  let finished, waker = Lwt.wait () in
  let handler () = Lwt.wakeup waker () in
  let dont_gc_me = Lwt_react.E.map handler finished_event in
  ignore dont_gc_me;  (* What goes here? *)

  print_endline "Waiting for signal...";
  Lwt.bind finished (fun () -> Lwt_switch.turn_off switch)

let () =
  let finished = Lwt.protected (setup ()) in

  Gc.full_major ();  (* Force GC, to demonstrate problem *)
  fire_finished ();  (* Simulate send *)

  Lwt_main.run finished;
  print_endline "Done";

没有Gc.full_major 行，这通常打印Done。有了它，它就挂在Waiting for signal...。

编辑：我已将 setup（真实代码）从测试驱动程序中分离出来，并添加了一个 Lwt.protected 包装器，以避免因 Lwt 取消而掩盖问题。

Answer 1

这是从我的某个项目中获取的 sn-p，已修复以解决此弱引用问题（谢谢！）。 第一部分是保持全局根指向您的对象。 第二部分是将信号/事件的活跃度限制在 Lwt 线程的范围内。

请注意，反应实体被克隆并显式停止，这可能与您的期望不完全相符。

module Keep : sig 
  type t
  val this : 'a -> t
  val release : t -> unit
end = struct
  type t = {mutable prev: t; mutable next: t; mutable keep: (unit -> unit)}
  let rec root = {next = root; prev = root; keep = ignore}

  let release item =
    item.next.prev <- item.prev;
    item.prev.next <- item.next;
    item.prev <- item;
    item.next <- item;
    (* In case user-code keep a reference to item *)
    item.keep <- ignore

  let attach keep =
    let item = {next = root.next; prev = root; keep} in
    root.next.prev <- item;
    root.next <- item;
    item

  let this a = attach (fun () -> ignore a)
end

module React_utils : sig
  val with_signal : 'a signal -> ('a signal -> 'b Lwt.t) -> 'b Lwt.t
  val with_event  : 'a event -> ('a event -> 'b Lwt.t) -> 'b Lwt.t
end = struct
  let with_signal s f =
    let clone = S.map (fun x -> x) s in
    let kept = Keep.this clone in
    Lwt.finalize (fun () -> f clone)
                 (fun () -> S.stop clone; Keep.release kept; Lwt.return_unit)
  let with_event e f =
    let clone = E.map (fun x -> x) e in
    let kept = Keep.this clone in
    Lwt.finalize (fun () -> f clone)
                 (fun () -> E.stop clone; Keep.release kept; Lwt.return_unit)
end

用这个解决你的例子：

let run () =
  let switch = Lwt_switch.create () in

  let finished, waker = Lwt.wait () in
  let handler () = Lwt.wakeup waker () in
  (* We use [Lwt.async] because are not interested in knowing when exactly the reference will be released *)
  Lwt.async (fun () ->
    (React_utils.with_event (Lwt_react.E.map handler finished_event)
      (fun _dont_gc_me -> finished)));
  print_endline "Waiting for signal...";

  Gc.full_major ();  (* Force GC, to demonstrate problem *)
  fire_finished ();  (* Simulate send *)

  Lwt.bind finished (fun () -> Lwt_switch.turn_off switch)

Answer 2

这是我当前的（hacky）解决方法。每个处理程序都被添加到全局哈希表中，然后在关闭开关时再次删除：

let keep =
  let kept = Hashtbl.create 10 in
  let next = ref 0 in
  fun ~switch value ->
    let ticket = !next in
    incr next;
    Hashtbl.add kept ticket value;
    Lwt_switch.add_hook (Some switch) (fun () ->
      Hashtbl.remove kept ticket;
      Lwt.return ()
    )

它是这样使用的：

Lwt_react.E.map handler event |> keep ~switch;

Answer 3

处理此问题的一种简单方法是保留对您的事件的引用，并在您不再需要它时致电 React.E.stop：

(* ocamlfind ocamlopt -package react,lwt,lwt.react,lwt.unix -linkpkg -o test test.ml *)

let finished_event, fire_finished = React.E.create ()

let run () =
  let switch = Lwt_switch.create () in

  let finished, waker = Lwt.wait () in
  let handler () = Lwt.wakeup waker () in
  let ev = Lwt_react.E.map handler finished_event in
  print_endline "Waiting for signal...";

  Gc.full_major ();  (* Force GC, to demonstrate problem *)
  fire_finished ();  (* Simulate send *)

  React.E.stop ev;

  Lwt.bind finished (fun () -> Lwt_switch.turn_off switch)

let () =
  Lwt_main.run (run ());
  print_endline "Done";

Answer 4

请注意，如果 lwt 不支持取消，那么您将通过将 Lwt.protected (setup ()) 替换为 Lwt.bind (setup ()) Lwt.return 来观察相同的行为。

基本上你拥有的是：

finished_event --weak--> SETUP --> finished

其中SETUP 是事件和Lwt 线程之间的循环。删除 Lwt.protected 只是 squashes 最后一个指针，所以它恰好可以做你想做的事情。

Lwt 只有前向指针（支持取消除外），而 React 只有后向指针（前向指针很弱）。所以要让它正常工作的方法是返回事件而不是线程。