Add Lwt_main.abandon_yielded_and_paused

Resolves #789.

src/core/lwt.ml

@@ -2992,6 +2992,7 @@ sig
   val wakeup_paused : unit -> unit
   val paused_count : unit -> int
   val register_pause_notifier : (int -> unit) -> unit
+  val abandon_paused : unit -> unit
 
   (* Internal interface for other modules in Lwt *)
   val poll : 'a t -> 'a option
@@ -3087,6 +3088,10 @@ struct
 
   let register_pause_notifier f = pause_hook := f
 
+  let abandon_paused () =
+    Lwt_sequence.clear paused;
+    paused_count := 0
+
   let paused_count () = !paused_count
 end
 include Miscellaneous

src/core/lwt.mli

@@ -1819,6 +1819,12 @@ val register_pause_notifier : (int -> unit) -> unit
 
     This function is intended for internal use by Lwt. *)
 
+val abandon_paused : unit -> unit
+(** Causes promises created with {!Lwt.pause} to remain forever pending. See
+    {!Lwt_main.abandon_yielded_and_paused}.
+
+    This function is intended for internal use by Lwt. *)
+
 (**/**)
 
 

src/core/lwt_sequence.ml

@@ -46,6 +46,10 @@ let create () =
   let rec seq = { prev = seq; next = seq } in
   seq
 
+let clear seq =
+  seq.prev <- seq;
+  seq.next <- seq
+
 let is_empty seq = seq.next == seq
 
 let length seq =

src/core/lwt_sequence.mli

@@ -45,6 +45,10 @@ val remove : 'a node -> unit
 val create : unit -> 'a t
   (** [create ()] creates a new empty sequence *)
 
+val clear : 'a t -> unit
+(** Removes all nodes from the given sequence. The nodes are not actually
+    mutated to note their removal. Only the sequence's pointers are updated. *)
+
 val is_empty : 'a t -> bool
   (** Returns [true] iff the given sequence is empty *)
 

src/unix/lwt_main.ml

@@ -20,6 +20,10 @@ let yielded = Lwt_sequence.create ()
 
 let yield () = (Lwt.add_task_r [@ocaml.warning "-3"]) yielded
 
+let abandon_yielded_and_paused () =
+  Lwt_sequence.clear yielded;
+  Lwt.abandon_paused ()
+
 let run p =
   let rec run_loop () =
     (* Fulfill paused promises now. *)

src/unix/lwt_main.mli

@@ -51,6 +51,13 @@ val yield : unit -> unit Lwt.t
       Prefer [pause] in order to stay compatible with other execution
       environments such as js_of_ocaml. *)
 
+val abandon_yielded_and_paused : unit -> unit
+(** Causes promises created with {!Lwt.pause} and {!Lwt_main.yield} to remain
+    forever pending.
+
+    This is meant for use with {!Lwt.fork}, as a way to "abandon" more promise
+    chains that are pending in your process. *)
+
 
 
 (** Hook sequences. Each module of this type is a set of hooks, to be run by Lwt

src/unix/lwt_unix.cppo.mli

@@ -185,6 +185,7 @@ val fork : unit -> int
       child process.
 
       Notes:
+
       - In the child process all pending [Lwt_unix] I/O jobs are abandoned.
         This may cause the child's copy of their associated promises to remain
         forever pending.
@@ -196,7 +197,9 @@ val fork : unit -> int
         during process exit.
       - None of the above is necessary if you intend to call [exec]. Indeed, in
         that case, it is not even necessary to use [Lwt_unix.fork]. You can use
-        [Unix.fork]. *)
+        [Unix.fork].
+      - To abandon some more promises, see
+        {!Lwt_main.abandon_yielded_and_paused}. *)
 
 type process_status =
     Unix.process_status =