Как остановить сборку мусора 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 есть только обратные (слабые передние). Таким образом, способ заставить эту работу работать правильно - вернуть событие вместо потока.