Multithreading 取消Lwt。线

我一辈子都找不到处理lwt线程取消的方法

这里是我的，简化的

#require "lwt.unix, lwt.ppx"
open Lwt.Infix

let program =
  let counter = ref 1 in
  let can_cancel = fst (Lwt.task ()) in

  Lwt.async_exception_hook := (fun _ ->
    prerr_endline "some exception");

  Lwt.on_cancel can_cancel (fun () ->
            Lwt_io.printl "correct ending" |> Lwt.ignore_result);

  Lwt.async begin fun () ->
    let rec forever () =

      try%lwt
        Lwt_io.printl "Hello World" >>= fun () ->

        if !counter = 3 then Lwt.cancel can_cancel
        else counter := !counter + 1;
        Lwt_unix.sleep 0.5 >>= forever
      with
        Lwt.Canceled -> Lwt_io.printl "canceled inside function"
    in

    Lwt.catch forever begin function
      | Lwt.Canceled -> Lwt_io.printl "Cancled exception happened"
      | _ -> Lwt.return ()
    end
  end;
  can_cancel

let () =
  Lwt_main.run program

您可以看到我多次尝试捕获已取消的异常，但都没有成功。 我的输出是

utop cancelable.ml                                                     ⏎
Hello World
Hello World
Hello World
correct ending
Exception: Lwt.Canceled.

---

在更宏大的计划中，我有一个

unit Lwt.t list ref

，它是用

Lwt.task

创建的，然后我计划在列表中执行

list.iter Lwt.cancel

，然后用

unit Lwt.t

类型的新线程替换它，我把try/with放在了错误的级别

此代码显示了放置Lwt.Cancelled异常的try/with的正确位置

#require "lwt.unix, lwt.ppx"
open Lwt.Infix

let program =
  let counter = ref 1 in
  let can_cancel = fst (Lwt.task ()) in

  Lwt.async begin fun () ->
    let rec forever () =
        Lwt_io.printl "Hello World" >>= fun () ->
        if !counter = 3 then Lwt.cancel can_cancel
        else counter := !counter + 1;
        Lwt_unix.sleep 0.5 >>= forever
    in
    forever ()
  end;
  can_cancel

let () =
  try
    Lwt_main.run program
  with
    Lwt.Canceled -> Lwt_io.printl "ended" |> Lwt.ignore_result

---

我把try/with放错了位置

此代码显示了放置Lwt.Cancelled异常的try/with的正确位置

#require "lwt.unix, lwt.ppx"
open Lwt.Infix

let program =
  let counter = ref 1 in
  let can_cancel = fst (Lwt.task ()) in

  Lwt.async begin fun () ->
    let rec forever () =
        Lwt_io.printl "Hello World" >>= fun () ->
        if !counter = 3 then Lwt.cancel can_cancel
        else counter := !counter + 1;
        Lwt_unix.sleep 0.5 >>= forever
    in
    forever ()
  end;
  can_cancel

let () =
  try
    Lwt_main.run program
  with
    Lwt.Canceled -> Lwt_io.printl "ended" |> Lwt.ignore_result