Skip to content

Commit

Permalink
Merge pull request #917 from madroach/master
Browse files Browse the repository at this point in the history
Remove obsolete second wakeup_paused
  • Loading branch information
raphael-proust authored Jul 31, 2023
2 parents 75e479e + 6419816 commit 792ab06
Show file tree
Hide file tree
Showing 4 changed files with 15 additions and 26 deletions.
4 changes: 4 additions & 0 deletions CHANGES
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,10 @@

* Fix marshall header size in Lwt_io.read_value. (Simmo Saan, #995)

====== Misc ======

* Resolve paused promises only once in main loop. This lets Lwt.pause behave identical to Lwt_unix.yield. (#917, Christopher Zimmermann, Favonia)


===== 5.6.1 =====

Expand Down
18 changes: 3 additions & 15 deletions src/unix/lwt_main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -16,18 +16,14 @@ open Lwt.Infix

let enter_iter_hooks = Lwt_sequence.create ()
let leave_iter_hooks = Lwt_sequence.create ()
let yielded = Lwt_sequence.create ()

let yield () = (Lwt.add_task_r [@ocaml.warning "-3"]) yielded
let yield = Lwt.pause

let abandon_yielded_and_paused () =
Lwt_sequence.clear yielded;
Lwt.abandon_paused ()

let run p =
let rec run_loop () =
(* Fulfill paused promises now. *)
Lwt.wakeup_paused ();
match Lwt.poll p with
| Some x ->
x
Expand All @@ -36,20 +32,12 @@ let run p =
Lwt_sequence.iter_l (fun f -> f ()) enter_iter_hooks;

(* Do the main loop call. *)
let should_block_waiting_for_io =
Lwt.paused_count () = 0 && Lwt_sequence.is_empty yielded in
let should_block_waiting_for_io = Lwt.paused_count () = 0 in
Lwt_engine.iter should_block_waiting_for_io;

(* Fulfill paused promises again. *)
(* Fulfill paused promises. *)
Lwt.wakeup_paused ();

(* Fulfill yield promises. *)
if not (Lwt_sequence.is_empty yielded) then begin
let tmp = Lwt_sequence.create () in
Lwt_sequence.transfer_r yielded tmp;
Lwt_sequence.iter_l (fun resolver -> Lwt.wakeup resolver ()) tmp
end;

(* Call leave hooks. *)
Lwt_sequence.iter_l (fun f -> f ()) leave_iter_hooks;

Expand Down
17 changes: 7 additions & 10 deletions src/unix/lwt_main.mli
Original file line number Diff line number Diff line change
Expand Up @@ -49,22 +49,19 @@ val yield : unit -> unit Lwt.t [@@deprecated "Use Lwt.pause instead"]
@deprecated Since 5.5.0 [yield] is deprecated in favor of the more general
{!Lwt.pause} in order to avoid discrepancies in resolution (see below) and
stay compatible with other execution environments such as js_of_ocaml.
stay compatible with other execution environments such as js_of_ocaml. *)

Currently, paused promises are resolved more frequently than yielded promises.
The difference is unintended but existing applications could depend on it.
Unifying the two pools of promises into one in the future would eliminate
possible discrepancies and simplify the code. *)

val abandon_yielded_and_paused : unit -> unit
val abandon_yielded_and_paused : unit -> unit [@@deprecated "Use Lwt.abandon_paused instead"]
(** Causes promises created with {!Lwt.pause} and {!Lwt_main.yield} to remain
forever pending.
[yield] is now deprecated in favor of the more general {!Lwt.pause}.
Once [yield] is phased out, this function will be deprecated as well.
(Note that [yield] is deprecated in favor of the more general {!Lwt.pause}.)
This is meant for use with {!Lwt_unix.fork}, as a way to “abandon” more
promise chains that are pending in your process. *)
promise chains that are pending in your process.
@deprecated Since 5.7 [abandon_yielded_and_paused] is deprecated in favour
of [Lwt.abandon_paused]. *)



Expand Down
2 changes: 1 addition & 1 deletion src/unix/lwt_unix.cppo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -123,7 +123,7 @@ let sleep delay =
Lwt.on_cancel waiter (fun () -> Lwt_engine.stop_event ev);
waiter

let yield = (Lwt_main.yield [@warning "-3"])
let yield = Lwt.pause

let auto_yield timeout =
let limit = ref (Unix.gettimeofday () +. timeout) in
Expand Down

0 comments on commit 792ab06

Please sign in to comment.