diff --git a/src/Debugger.ml b/src/Debugger.ml new file mode 100644 index 0000000..2272b0d --- /dev/null +++ b/src/Debugger.ml @@ -0,0 +1,24 @@ +include DebuggerSigs + +module Make () = struct + type 'a Effect.t += + | Debug : Loctext.t -> unit Effect.t + | CallBegin : Loctext.t -> unit Effect.t + | CallEnd : Loctext.t -> unit Effect.t + + let emit_loctext t = Effect.perform @@ Debug t + let emit ?loc s = emit_loctext @@ Loctext.make ?loc s + let emitf ?loc = Loctext.kmakef ?loc emit_loctext + + let trace_open_loctext t = Effect.perform @@ CallBegin t + let trace_close_loctext t = Effect.perform @@ CallEnd t + + let trace ?loc s f = + trace_open_loctext (Loctext.make ?loc s); + Fun.protect f + ~finally:(fun () -> trace_close_loctext (Loctext.make ?loc s)) + let tracef ?loc = + Text.kmakef @@ fun t f -> + trace_open_loctext (Range.locate_opt loc t); + Fun.protect f ~finally:(fun () -> trace_close_loctext (Range.locate_opt loc t)) +end diff --git a/src/Debugger.mli b/src/Debugger.mli new file mode 100644 index 0000000..b67cf24 --- /dev/null +++ b/src/Debugger.mli @@ -0,0 +1,3 @@ +include module type of DebuggerSigs + +module Make () : S diff --git a/src/DebuggerSigs.ml b/src/DebuggerSigs.ml new file mode 100644 index 0000000..5bf4578 --- /dev/null +++ b/src/DebuggerSigs.ml @@ -0,0 +1,8 @@ +module type S = +sig + val emit : ?loc:Range.t -> string -> unit + val emitf : ?loc:Range.t -> ('a, Format.formatter, unit, unit) format4 -> 'a + val trace : ?loc:Range.t -> string -> (unit -> 'a) -> 'a + val tracef : ?loc:Range.t -> ('b, Format.formatter, unit, (unit -> 'a) -> 'a) format4 -> 'b + val run : emit:(Loctext.t -> unit) -> trace:([`Open | `Close] -> Loctext.t -> unit) -> (unit -> 'a) -> 'a +end