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

这是一个摘自我的某个项目的片段，修复了解决这个弱引用问题（thx！）。第一部分是保持指向对象的全局根。第二部分是将信号/事件的活跃度划分为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只是压缩最后一个指针，所以它碰巧做你想要的。

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

如何阻止OCaml垃圾收集我的被动事件处理程序？

4 个答案: