From d186f7fe7b2c53c054e74cb46d3c62c500670b20 Mon Sep 17 00:00:00 2001 From: icristescu Date: Wed, 31 Aug 2022 12:02:44 +0200 Subject: [PATCH 1/2] Remove lwt from low level finalise --- src/irmin-pack/unix/async.ml | 12 ++++++------ src/irmin-pack/unix/async_intf.ml | 2 +- src/irmin-pack/unix/ext.ml | 2 +- src/irmin-pack/unix/gc.ml | 8 ++++---- src/irmin-pack/unix/gc_intf.ml | 4 +--- 5 files changed, 13 insertions(+), 15 deletions(-) diff --git a/src/irmin-pack/unix/async.ml b/src/irmin-pack/unix/async.ml index c1cf7c343f..2b762845b8 100644 --- a/src/irmin-pack/unix/async.ml +++ b/src/irmin-pack/unix/async.ml @@ -71,14 +71,14 @@ module Unix = struct { pid; status = `Running } let status_of_process_outcome = function - | Lwt_unix.WSIGNALED x when x = Sys.sigkill -> + | Unix.WSIGNALED x when x = Sys.sigkill -> (* x is actually -7; -7 is the Sys.sigkill definition (not the OS' 9 as might be expected) *) `Success (* the child is killing itself when it's done *) - | Lwt_unix.WSIGNALED n -> `Failure (Fmt.str "Signaled %d" n) - | Lwt_unix.WEXITED n -> `Failure (Fmt.str "Exited %d" n) - | Lwt_unix.WSTOPPED n -> `Failure (Fmt.str "Stopped %d" n) + | Unix.WSIGNALED n -> `Failure (Fmt.str "Signaled %d" n) + | Unix.WEXITED n -> `Failure (Fmt.str "Exited %d" n) + | Unix.WSTOPPED n -> `Failure (Fmt.str "Stopped %d" n) let cancel t = let () = @@ -108,10 +108,10 @@ module Unix = struct let await t = match t.status with | `Running -> - let+ pid, status = Lwt_unix.waitpid [] t.pid in + let pid, status = Unix.waitpid [] t.pid in let s = status_of_process_outcome status in Exit.remove pid; t.status <- s; s - | #outcome as s -> Lwt.return s + | #outcome as s -> s end diff --git a/src/irmin-pack/unix/async_intf.ml b/src/irmin-pack/unix/async_intf.ml index 8ebad68972..5403956bc8 100644 --- a/src/irmin-pack/unix/async_intf.ml +++ b/src/irmin-pack/unix/async_intf.ml @@ -28,7 +28,7 @@ module type S = sig val async : (unit -> unit) -> t (** Start a task. *) - val await : t -> [> outcome ] Lwt.t + val await : t -> [> outcome ] (** If running, wait for a task to finish and return its outcome. If not running, return the oucome of the task. *) diff --git a/src/irmin-pack/unix/ext.ml b/src/irmin-pack/unix/ext.ml index 5284e962eb..6ce9166432 100644 --- a/src/irmin-pack/unix/ext.ml +++ b/src/irmin-pack/unix/ext.ml @@ -291,7 +291,7 @@ module Maker (Config : Conf.S) = struct | Some { gc; _ } -> if t.during_batch then Lwt.return_error `Gc_forbidden_during_batch - else Gc.finalise ~wait gc + else Gc.finalise ~wait gc |> Lwt.return in match result with | Ok (`Finalised _ as x) -> diff --git a/src/irmin-pack/unix/gc.ml b/src/irmin-pack/unix/gc.ml index 145aa78d91..f9a5cd80c6 100644 --- a/src/irmin-pack/unix/gc.ml +++ b/src/irmin-pack/unix/gc.ml @@ -547,7 +547,7 @@ module Make (Args : Args) = struct let finalise ~wait t = match t.stats with - | Some stats -> Lwt.return_ok (`Finalised stats) + | Some stats -> Ok (`Finalised stats) | None -> ( let go status = let start = t.elapsed () in @@ -614,14 +614,14 @@ module Make (Args : Args) = struct let () = Lwt.wakeup_later t.resolver err in err in - Lwt.return result + result in if wait then - let* status = Async.await t.task in + let status = Async.await t.task in go status else match Async.status t.task with - | `Running -> Lwt.return_ok `Running + | `Running -> Ok `Running | status -> go status) let on_finalise t f = diff --git a/src/irmin-pack/unix/gc_intf.ml b/src/irmin-pack/unix/gc_intf.ml index fd45ef1e67..2b9eb5cce3 100644 --- a/src/irmin-pack/unix/gc_intf.ml +++ b/src/irmin-pack/unix/gc_intf.ml @@ -109,9 +109,7 @@ module type S = sig (** Creates and starts a new GC process. *) val finalise : - wait:bool -> - t -> - ([> `Running | `Finalised of stats ], Args.Errs.t) result Lwt.t + wait:bool -> t -> ([> `Running | `Finalised of stats ], Args.Errs.t) result (** [finalise ~wait t] returns the state of the GC process. If [wait = true], the call will block until GC finishes. *) From ae959a3f8ff6064f8d692d0ed3747f05b47ae99a Mon Sep 17 00:00:00 2001 From: icristescu Date: Wed, 31 Aug 2022 16:36:09 +0200 Subject: [PATCH 2/2] Update doc --- src/irmin-pack/unix/s.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/irmin-pack/unix/s.ml b/src/irmin-pack/unix/s.ml index f5b53c2354..bf91b86fe1 100644 --- a/src/irmin-pack/unix/s.ml +++ b/src/irmin-pack/unix/s.ml @@ -81,9 +81,9 @@ module type S = sig Finalising consists of mutating [repo] so that it points to the new file and to flush the internal caches that could be referencing GCed objects. - If [wait = true] (the default), the call blocks until the GC process - finishes. If [wait = false], finalisation will occur if the process has - ended. + If [wait = true] (the default), the calling process blocks until the GC + process finishes. If [wait = false], finalisation will occur if the + process has ended. If there are no running GCs, the call is a no-op and it returns [`Idle]. @@ -119,7 +119,7 @@ module type S = sig messages should be used only for informational purposes, like logging. *) val wait : repo -> (stats option, msg) result Lwt.t - (** [wait repo] blocks until GC is finished or is idle. + (** [wait repo] blocks the process until GC is finished or is idle. If a GC finalises, its stats are returned.