Make traceln an effect

This allows different backends to provide different implementations,
and allows suppressing or changing trace output where needed.

lib_eio/eio.ml

@@ -3,18 +3,9 @@ module Std = struct
   module Fibre = Fibre
   module Switch = Switch
 
-  let stderr_mutex = Mutex.create ()
+  effect Trace : (?__POS__:(string * int * int * int) -> ('a, Format.formatter, unit, unit) format4 -> 'a)
   let traceln ?__POS__ fmt =
-    fmt |> Format.kasprintf (fun msg ->
-        Ctf.label msg;
-        Mutex.lock stderr_mutex;
-        Fun.protect ~finally:(fun () -> Mutex.unlock stderr_mutex)
-          (fun () ->
-             match __POS__ with
-             | Some (file, lnum, _, _) -> Format.printf "%s:%d %s@." file lnum msg
-             | None -> Format.printf "%s@." msg
-          )
-      )
+    perform Trace ?__POS__ fmt
 end
 
 module Semaphore = Semaphore
@@ -246,6 +237,7 @@ module Private = struct
     effect Suspend = Suspend.Suspend
     effect Fork = Fibre.Fork
     effect Fork_ignore = Fibre.Fork_ignore
+    effect Trace = Std.Trace
   end
   module Switch = Switch
 end

lib_eio/eio.mli

@@ -497,7 +497,13 @@ module Private : sig
     effect Fork : (unit -> 'a) -> 'a Promise.t
     (** See {!Fibre.fork} *)
 
-    effect Fork_ignore  : (unit -> unit) -> unit
+    effect Fork_ignore : (unit -> unit) -> unit
     (** See {!Fibre.fork_ignore} *)
+
+    effect Trace : (?__POS__:(string * int * int * int) -> ('a, Format.formatter, unit, unit) format4 -> 'a)
+    (** [perform Trace fmt] writes trace logging to the configured trace output.
+        It must not switch fibres, as tracing must not affect scheduling.
+        If the system is not ready to receive the trace output,
+        the whole domain must block until it is. *)
   end
 end

lib_eio_linux/eio_linux.ml

@@ -44,6 +44,20 @@ let rec shiftv cs = function
 
 effect Close : Unix.file_descr -> int
 
+let stderr_mutex = Mutex.create ()
+
+let default_traceln ?__POS__ fmt =
+  fmt |> Format.kasprintf (fun msg ->
+      Ctf.label msg;
+      Mutex.lock stderr_mutex;
+      Fun.protect ~finally:(fun () -> Mutex.unlock stderr_mutex)
+        (fun () ->
+           match __POS__ with
+           | Some (file, lnum, _, _) -> Format.printf "%s:%d %s@." file lnum msg
+           | None -> Format.printf "%s@." msg
+        )
+    )
+
 module FD = struct
   type t = {
     seekable : bool;
@@ -618,6 +632,11 @@ let accept ~sw fd =
   Switch.on_release sw (fun () -> FD.ensure_closed client);
   client, client_addr
 
+let run_compute fn () =
+  match fn () with
+  | x -> x
+  | effect Eio.Private.Effects.Trace k -> continue k default_traceln
+
 module Objects = struct
   type _ Eio.Generic.ty += FD : FD.t Eio.Generic.ty
 
@@ -772,7 +791,7 @@ module Objects = struct
       (* todo: use eventfd instead of a pipe *)
       let r, w = Unix.pipe () in
       let r = FD.of_unix_no_hook ~seekable:false r in
-      match Domain.spawn (fun () -> Fun.protect fn ~finally:(fun () -> Unix.close w)) with
+      match Domain.spawn (fun () -> Fun.protect (run_compute fn) ~finally:(fun () -> Unix.close w)) with
       | domain ->
         await_readable r;
         FD.close r;
@@ -957,6 +976,7 @@ let run ?(queue_depth=64) ?(block_size=4096) main =
           | exception ex ->
             Ctf.note_resolved child ~ex:(Some ex)
         )
+    | effect Eio.Private.Effects.Trace k -> continue k default_traceln
     | effect Alloc k ->
       let k = { Suspended.k; tid } in
       alloc_buf st k

tests/test_fs.md

@@ -55,7 +55,7 @@ Got "my-data"
 
 Check the file got the correct permissions (subject to the umask set above):
 ```ocaml
-# traceln "Perm = %o" ((Unix.stat "test-file").st_perm);;
+# Printf.printf "Perm = %o\n" ((Unix.stat "test-file").st_perm);;
 Perm = 644
 - : unit = ()
 ```