From 055f42f4934492fed6ccb984a59a0467bf339c43 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 6 Aug 2022 20:30:06 -0500 Subject: [PATCH] fix: run console in separate thread We no longer block on updating the terminal Signed-off-by: Rudi Grinberg ps-id: 230cf5db-0841-4d20-af31-5f2cf27a8432 --- src/dune_console/dune | 2 +- src/dune_console/dune_console.ml | 78 +++++++++++++++++++++++++++---- src/dune_console/dune_console.mli | 36 ++++++-------- src/dune_engine/scheduler.ml | 7 ++- 4 files changed, 90 insertions(+), 33 deletions(-) diff --git a/src/dune_console/dune b/src/dune_console/dune index 94dd19e3cc5..befeee5273a 100644 --- a/src/dune_console/dune +++ b/src/dune_console/dune @@ -1,3 +1,3 @@ (library (name dune_console) - (libraries stdune)) + (libraries stdune threads.posix)) diff --git a/src/dune_console/dune_console.ml b/src/dune_console/dune_console.ml index a320ba1b0d0..ea2e1b98b6e 100644 --- a/src/dune_console/dune_console.ml +++ b/src/dune_console/dune_console.ml @@ -54,7 +54,7 @@ module Backend = struct flush stderr end - module Progress : S = struct + module Progress_no_flush : S = struct let status_line = ref Pp.nop let status_line_len = ref 0 @@ -69,24 +69,21 @@ module Backend = struct | None -> hide_status_line (); status_line := Pp.nop; - status_line_len := 0; - flush stderr + status_line_len := 0 | Some line -> let line = Pp.map_tags line ~f:User_message.Print_config.default in let line_len = String.length (Format.asprintf "%a" Pp.to_fmt line) in hide_status_line (); status_line := line; status_line_len := line_len; - show_status_line (); - flush stderr + show_status_line () let print_if_no_status_line _msg = () let print_user_message msg = hide_status_line (); Dumb_no_flush.print_user_message msg; - show_status_line (); - flush stderr + show_status_line () let reset () = Dumb.reset () @@ -95,8 +92,6 @@ module Backend = struct let dumb = (module Dumb : S) - let progress = (module Progress : S) - let main = ref dumb let set t = main := t @@ -123,6 +118,71 @@ module Backend = struct A.reset_flush_history (); B.reset_flush_history () end : S) + + let spawn_thread = Fdecl.create Dyn.opaque + + let threaded (module Base : S) : (module S) = + let module T = struct + let mutex = Mutex.create () + + type state = + { messages : User_message.t Queue.t + ; mutable status_line : User_message.Style.t Pp.t option + } + + let state = { messages = Queue.create (); status_line = None } + + let print_user_message m = + Mutex.lock mutex; + Queue.push state.messages m; + Mutex.unlock mutex + + let set_status_line sl = + Mutex.lock mutex; + state.status_line <- sl; + Mutex.unlock mutex + + let print_if_no_status_line _msg = () + + let reset () = + Mutex.lock mutex; + Queue.clear state.messages; + state.status_line <- None; + Base.reset (); + Mutex.unlock mutex + + let reset_flush_history () = + Mutex.lock mutex; + Queue.clear state.messages; + state.status_line <- None; + Base.reset_flush_history (); + Mutex.unlock mutex + end in + ( Fdecl.get spawn_thread @@ fun () -> + let open T in + let last = ref (Unix.gettimeofday ()) in + let frame_rate = 1. /. 60. in + while true do + Mutex.lock mutex; + while not (Queue.is_empty state.messages) do + Base.print_user_message (Queue.pop_exn state.messages) + done; + Base.set_status_line state.status_line; + flush stderr; + Mutex.unlock mutex; + let now = Unix.gettimeofday () in + let elapsed = now -. !last in + if elapsed >= frame_rate then last := now + else + let delta = frame_rate -. elapsed in + Unix.sleepf delta; + last := delta +. now + done ); + (module T) + + let progress = + let t = lazy (threaded (module Progress_no_flush)) in + fun () -> Lazy.force t end let print_user_message msg = diff --git a/src/dune_console/dune_console.mli b/src/dune_console/dune_console.mli index faed3c9a158..48f5e738901 100644 --- a/src/dune_console/dune_console.mli +++ b/src/dune_console/dune_console.mli @@ -8,25 +8,7 @@ open Stdune application as well as composing backends. *) module Backend : sig - module type S = sig - (** Format and print a user message to the console *) - val print_user_message : User_message.t -> unit - - (** Change the status line *) - val set_status_line : User_message.Style.t Pp.t option -> unit - - (** Print a message if the backend does not display the status line. This is - needed so that the important status changes show up even when a [dumb] - terminal backend is used. *) - val print_if_no_status_line : User_message.Style.t Pp.t -> unit - - (** Reset the log output *) - val reset : unit -> unit - - val reset_flush_history : unit -> unit - end - - type t = (module S) + type t val set : t -> unit @@ -39,11 +21,21 @@ module Backend : sig val dumb : t (** A backend that just displays the status line in the terminal *) - val progress : t + val progress : unit -> t + + val spawn_thread : ((unit -> unit) -> unit) Fdecl.t + + val threaded : t -> t end -(** The main backend for the application *) -include Backend.S +(** Format and print a user message to the console *) +val print_user_message : User_message.t -> unit + +(** Reset the log output and (try) to remove the history *) +val reset_flush_history : unit -> unit + +(** Reset the log output *) +val reset : unit -> unit (** [print paragraphs] is a short-hand for: diff --git a/src/dune_engine/scheduler.ml b/src/dune_engine/scheduler.ml index 9af204cd7c9..114567e1939 100644 --- a/src/dune_engine/scheduler.ml +++ b/src/dune_engine/scheduler.ml @@ -39,7 +39,7 @@ module Config = struct let console_backend t = match t.status_line with | false -> Console.Backend.dumb - | true -> Console.Backend.progress + | true -> Console.Backend.progress () end type t = @@ -140,6 +140,11 @@ end = struct in Thread.create f x + let () = + Fdecl.set Console.Backend.spawn_thread (fun f -> + let (_ : Thread.t) = create ~signal_watcher:`Yes f () in + ()) + let spawn ~signal_watcher f = let (_ : Thread.t) = create ~signal_watcher f () in ()