diff --git a/src/Mutex.ml b/src/Mutex.ml index 58866c2..689f365 100644 --- a/src/Mutex.ml +++ b/src/Mutex.ml @@ -4,6 +4,8 @@ sig val exclusively : (unit -> 'a) -> 'a val run : (unit -> 'a) -> 'a + + val register_printer : ([`Exclusively] -> string option) -> unit end module Make () = @@ -22,10 +24,16 @@ struct raise Locked else begin S.set true; + (* Favonia: I learn from the developers of eio that Fun.protect is not good at + preserving the backtraces. See https://github.com/ocaml-multicore/eio/pull/209. *) match f () with | ans -> S.set false; ans | exception e -> S.set false; raise e end let run f = S.run ~init:false f + + let register_printer f = S.register_printer @@ fun _ -> f `Exclusively + + let () = register_printer @@ fun _ -> Some "Unhandled algaeff effect; use Algaeff.Mutex.run" end diff --git a/src/Mutex.mli b/src/Mutex.mli index 7b011ad..d0673ae 100644 --- a/src/Mutex.mli +++ b/src/Mutex.mli @@ -49,6 +49,14 @@ sig (** [run f] executes the thunk [f] which may perform mutex effects. Each call of [run] creates a fresh mutex; in particular, calling [run] inside the thunk [f] will start a new scope that does not interfere with the outer scope. *) + + val register_printer : ([`Exclusively] -> string option) -> unit + (** [register_printer p] registers a printer [p] via {!val:Printexc.register_printer} to convert unhandled internal effects into strings for the OCaml runtime system to display. Ideally, all internal effects should have been handled by {!val:run} and there is no need to use this function, but when it is not the case, this function can be helpful for debugging. The functor {!module:Modifier.Make} always registers a simple printer to suggest using {!val:run}, but you can register new ones to override it. The return type of the printer [p] should return [Some s] where [s] is the resulting string, or [None] if it chooses not to convert a particular effect. The registered printers are tried in reverse order until one of them returns [Some s] for some [s]; that is, the last registered printer is tried first. Note that this function is a wrapper of {!val:Printexc.register_printer} and all the registered printers (via this function or {!val:Printexc.register_printer}) are put into the same list. + + The input type of the printer [p] is a variant representing internal effects used in this module. It corresponds to all the effects trigger by {!val:exclusively}. + + @since 1.1.0 + *) end module Make () : S diff --git a/src/Reader.ml b/src/Reader.ml index 7d713fc..1bf92bc 100644 --- a/src/Reader.ml +++ b/src/Reader.ml @@ -35,4 +35,6 @@ struct let register_printer f = Printexc.register_printer @@ function | Effect.Unhandled Read -> f `Read | _ -> None + + let () = register_printer @@ fun _ -> Some "Unhandled algaeff effect; use Algaeff.Reader.run" end diff --git a/src/Reader.mli b/src/Reader.mli index 2e47ec4..72e5004 100644 --- a/src/Reader.mli +++ b/src/Reader.mli @@ -47,7 +47,7 @@ sig The input type of the printer [p] is a variant representation of the only internal effect used in this module. It corresponds to the effect trigger by {!val:read}. - @since 1.0.0 + @since 1.1.0 *) end diff --git a/src/Sequencer.ml b/src/Sequencer.ml index 3140f04..f5abd07 100644 --- a/src/Sequencer.ml +++ b/src/Sequencer.ml @@ -32,4 +32,6 @@ struct let register_printer f = Printexc.register_printer @@ function | Effect.Unhandled (Yield elt) -> f (`Yield elt) | _ -> None + + let () = register_printer @@ fun _ -> Some "Unhandled algaeff effect; use Algaeff.Sequencer.run" end diff --git a/src/Sequencer.mli b/src/Sequencer.mli index b868961..1030e5c 100644 --- a/src/Sequencer.mli +++ b/src/Sequencer.mli @@ -41,7 +41,7 @@ sig The input type of the printer [p] is a variant representation of the internal effects used in this module. They correspond to the effects trigger by {!val:yield}. More precisely, [`Yield elt] corresponds to the effect triggered by [yield elt]. - @since 1.0.0 + @since 1.1.0 *) end diff --git a/src/State.ml b/src/State.ml index 0b9eb50..54e8f3d 100644 --- a/src/State.ml +++ b/src/State.ml @@ -43,4 +43,6 @@ struct | Effect.Unhandled Get -> f `Get | Effect.Unhandled (Set state) -> f (`Set state) | _ -> None + + let () = register_printer @@ fun _ -> Some "Unhandled algaeff effect; use Algaeff.State.run" end diff --git a/src/State.mli b/src/State.mli index fe38ef6..9c6ff23 100644 --- a/src/State.mli +++ b/src/State.mli @@ -48,7 +48,7 @@ sig - [`Get] corresponds to the effect triggered by [get ()]. - [`Set state] corresponds to the effect triggered by [set state]. - @since 1.0.0 + @since 1.1.0 *) end diff --git a/src/UniqueID.ml b/src/UniqueID.ml index 7194cfc..04fcc69 100644 --- a/src/UniqueID.ml +++ b/src/UniqueID.ml @@ -73,4 +73,6 @@ struct | Effect.Unhandled (Retrieve id) -> f (`Retrieve id) | Effect.Unhandled Export -> f `Export | _ -> None + + let () = register_printer @@ fun _ -> Some "Unhandled algaeff effect; use Algaeff.UniqueID.run" end diff --git a/src/UniqueID.mli b/src/UniqueID.mli index 8da1cf3..a2bb788 100644 --- a/src/UniqueID.mli +++ b/src/UniqueID.mli @@ -63,7 +63,7 @@ sig - [`Retrieve id] corresponds to the effect triggered by [retrieve id]. - [`Export] corresponds to the effect triggered by [export ()]. - @since 1.0.0 + @since 1.1.0 *) end diff --git a/src/Unmonad.ml b/src/Unmonad.ml index 153db9b..5b61877 100644 --- a/src/Unmonad.ml +++ b/src/Unmonad.ml @@ -27,4 +27,8 @@ struct ; exnc = raise ; effc = function Monadic m -> Option.some @@ fun k -> M.bind m (Effect.Deep.continue k) | _ -> None } + + let () = Printexc.register_printer @@ function + | Effect.Unhandled (Monadic _) -> Some "Unhandled algaeff effect; use Algaeff.Unmonad.run" + | _ -> None end diff --git a/src/Unmonad.mli b/src/Unmonad.mli index 2340ed6..2e7885b 100644 --- a/src/Unmonad.mli +++ b/src/Unmonad.mli @@ -1,8 +1,7 @@ (** Effects for any monad (subject to OCaml continuations being one-shot). *) (** This is a general construction that uses effects to construct monadic expressions. - Here is an alternative implementation of {!module:State} using - the standard state monad: + Here is an alternative implementation of {!module:State} using the standard state monad: {[ module StateMonad = @@ -33,6 +32,8 @@ raise an exception unless it encounters a truly unrecoverable fatal error. Raising an exception within [bind] will skip the continuation, and thus potentially skipping exception handlers within the continuation. Those handlers might be crucial for properly releasing acquired resources. + + PS: We are not aware of any actual use of this module, but we decided to keep it anyway. *) module type Monad =