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

Question

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

问题（如 React 文档中所述）是 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

这是从我的某个项目中获取的一个片段，已修复以解决此弱引用问题（谢谢！第一部分是保持指向对象的全局根。第二部分是将信号/事件的活跃度界定为 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

这是我

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

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 只会挤压最后一个指针，因此它恰好可以执行您想要的操作。

Lwt 只有前向指针（除了支持取消），而 React 只有向后指针（前向指针很弱）。因此，使其正常工作的方法是返回事件而不是线程。