garbage-collection - 如何停止 OCaml 垃圾收集我的响应式(Reactive)事件处理程序？

Question

我正在尝试使用 OBus图书馆与 Lwt_react .这对属性和信号使用“函数式响应式(Reactive)编程”。

问题(如 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

这是从我的一些项目中摘取的片段，用于解决这个弱引用问题(谢谢!)。
第一部分是保持全局根指向您的对象。
第二部分是将信号/事件的活跃度限定在 Lwt 线程的范围内。

请注意， react 实体被克隆并明确停止，这可能不完全符合您的期望。

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)