In progress: new feature _local debug runtimes_

Still needed: what to do about non-functions, should it always be `_this_`.
lukstafi · Aug 1, 2024 · 58f035b · 58f035b
1 parent 30138de
commit 58f035b
Show file tree

Hide file tree

Showing 5 changed files with 138 additions and 10 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -3,6 +3,7 @@
 ### Added
 
 - Runtime `description`: where the logs are directed to.
+- A new family of entry points `_l_` resp. `_lb_` that retrieve debug runtimes via a call `_get_local_debug_runtime ()` resp. `_get_local_printbox_debug_runtime ()`: these functions are correspondingly expected in the scope. The entry points facilitate using thread-local (and domain-local) debug runtimes.
 
 ### Changed
 

diff --git a/README.md b/README.md
@@ -1,5 +1,26 @@
 # ppx_minidebug
 
+<!-- TOC -->
+
+- [ppx_minidebug](#ppx_minidebug)
+  - [ppx_minidebug: Debug logs for selected functions and let-bindings](#ppx_minidebug-debug-logs-for-selected-functions-and-let-bindings)
+    - [Traces in HTML or Markdown as collapsible trees](#traces-in-html-or-markdown-as-collapsible-trees)
+    - [Highlighting search terms](#highlighting-search-terms)
+    - [PrintBox creating helpers with defaults: debug and debug_file](#printbox-creating-helpers-with-defaults-debug-and-debug_file)
+    - [Hyperlinks to source locations](#hyperlinks-to-source-locations)
+    - [Recommended: values_first_mode](#recommended-values_first_mode)
+  - [Usage](#usage)
+    - [Breaking infinite recursion with max_nesting_depth and looping with max_num_children; Flushing-based traces](#breaking-infinite-recursion-with-max_nesting_depth-and-looping-with-max_num_children-flushing-based-traces)
+    - [Tracking: control flow branches, anonymous and insufficiently annotated functions](#tracking-control-flow-branches-anonymous-and-insufficiently-annotated-functions)
+    - [Using as a logging framework](#using-as-a-logging-framework)
+    - [Lexical scopes vs. dynamic scopes](#lexical-scopes-vs-dynamic-scopes)
+    - [Reducing the size of generated logs](#reducing-the-size-of-generated-logs)
+    - [Navigating large logs](#navigating-large-logs)
+    - [Providing the necessary type information](#providing-the-necessary-type-information)
+    - [Dealing with concurrent execution](#dealing-with-concurrent-execution)
+
+<!-- /TOC -->
+
 ## `ppx_minidebug`: Debug logs for selected functions and let-bindings
 
 `ppx_minidebug` traces let bindings and functions within a selected scope if they have type annotations. `ppx_minidebug` offers three ways of instrumenting the code: `%debug_pp` and `%debug_show` (also `%track_pp`, `%diagn_pp` and `%track_show`, `%diagn_show`), based on `deriving.show`, and `%debug_sexp` (also `%track_sexp`, `%diagn_sexp`) based on `sexplib0` and `ppx_sexp_conv`. Explicit logs can be added with `%log` within a debug scope (`%log` is not a registered extension point to avoid conflicts with other logging frameworks). The syntax extension expects a module `Debug_runtime` in the scope. The `ppx_minidebug.runtime` library (part of the `ppx_minidebug` package) offers multiple ways of logging the traces, as helper functions generating `Debug_runtime` modules. See [the generated documentation for `Minidebug_runtime`](https://lukstafi.github.io/ppx_minidebug/ppx_minidebug/Minidebug_runtime/index.html).
@@ -1256,9 +1277,17 @@ Explicit logging with `%log` (and `%log_result`) has different but related restr
 
 For programs with threads or domains running concurrently, you need to ensure that each thread uses its own instance of a debug runtime, writing to its own log file. Currently, `ppx_minidebug` doesn't do any checks to prevent abuse: using the same debug runtime instance from multiple threads or opening the same file by multiple debug runtime instances.
 
-We offer two helpers for dealing with multiple debug runtimes. There is an optional runtime instance-level setting `global_prefix`, which adds the given information to all log headers coming from the instance.
+We offer three helpers for dealing with multiple debug runtimes. There is an optional runtime instance-level setting `global_prefix`, which adds the given information to all log headers coming from the instance.
+
+There are extension points `%debug_lb_sexp`, `%debug_this_lb_sexp`, `%track_lb_sexp`, etc. They call a function `_get_local_printbox_debug_runtime ()`, or `_get_local_debug_runtime ()` for the `_l_` variants, and unpack the argument as `module Debug_runtime` (in a function body). The feature helps using a runtime instance dedicated to a thread or domain, since for example `_get_local_debug_runtime` can retrieve the runtime using `Domain.DLS`. To avoid surprises, this feature only takes effect for directly annotated functions, and unpacks a `Debug_runtime` inside the function body (regardless of whether there is a `_this_`), so that we get the appropriate runtime for the dynamic local scope.
+
+Example from the test suite:
+
+```ocaml
+
+```
 
-Another feature is the extension points `%debug_rtb_sexp`, `%debug_this_rtb_sexp`, `%track_rtb_sexp`, etc. They add a first-class module argument to a function, and unpack the argument as `module Debug_runtime`. The feature helps using a runtime instance dedicated to a thread. At present, passing of the runtime instance to functions needs to be done manually. Note that only the function attached to the `_rt_` or `_rtb_` extension point is modified, regardless of whether there is a `_this_`.
+Another similar feature is the extension points `%debug_rtb_sexp`, `%debug_this_rtb_sexp`, `%track_rtb_sexp`, etc. They add a first-class module argument to a function, and unpack the argument as `module Debug_runtime`. At present, passing of the runtime instance to functions needs to be done manually. Note that only the function attached to the `_rt_` or `_rtb_` extension point is modified, regardless of whether there is a `_this_`.
 
 Example from the test suite:
 

diff --git a/index.mld b/index.mld
@@ -1,4 +1,26 @@
 {0 ppx_minidebug}
+<!-- TOC -->
+{ul {- {{: #ppx_minidebug} ppx_minidebug}
+{ul {- {{: #ppx_minidebug-debug-logs-for-selected-functions-and-let-bindings} ppx_minidebug: Debug logs for selected functions and let-bindings}
+{ul {- {{: #traces-in-html-or-markdown-as-collapsible-trees} Traces in HTML or Markdown as collapsible trees}
+}{- {{: #highlighting-search-terms} Highlighting search terms}
+}{- {{: #printbox-creating-helpers-with-defaults-debug-and-debug_file} PrintBox creating helpers with defaults: debug and debug_file}
+}{- {{: #hyperlinks-to-source-locations} Hyperlinks to source locations}
+}{- {{: #recommended-values_first_mode} Recommended: values_first_mode}
+}}
+}{- {{: #usage} Usage}
+{ul {- {{: #breaking-infinite-recursion-with-max_nesting_depth-and-looping-with-max_num_children-flushing-based-traces} Breaking infinite recursion with max_nesting_depth and looping with max_num_children; Flushing-based traces}
+}{- {{: #tracking-control-flow-branches-anonymous-and-insufficiently-annotated-functions} Tracking: control flow branches, anonymous and insufficiently annotated functions}
+}{- {{: #using-as-a-logging-framework} Using as a logging framework}
+}{- {{: #lexical-scopes-vs-dynamic-scopes} Lexical scopes vs. dynamic scopes}
+}{- {{: #reducing-the-size-of-generated-logs} Reducing the size of generated logs}
+}{- {{: #navigating-large-logs} Navigating large logs}
+}{- {{: #providing-the-necessary-type-information} Providing the necessary type information}
+}{- {{: #dealing-with-concurrent-execution} Dealing with concurrent execution}
+}}
+}}
+}}
+<!-- /TOC -->
 
 {1 [ppx_minidebug]: Debug logs for selected functions and let-bindings}
 
@@ -1325,9 +1347,17 @@ Explicit logging with [%log] (and [%log_result]) has different but related restr
 
 For programs with threads or domains running concurrently, you need to ensure that each thread uses its own instance of a debug runtime, writing to its own log file. Currently, [ppx_minidebug] doesn't do any checks to prevent abuse: using the same debug runtime instance from multiple threads or opening the same file by multiple debug runtime instances.
 
-We offer two helpers for dealing with multiple debug runtimes. There is an optional runtime instance-level setting [global_prefix], which adds the given information to all log headers coming from the instance.
+We offer three helpers for dealing with multiple debug runtimes. There is an optional runtime instance-level setting [global_prefix], which adds the given information to all log headers coming from the instance.
+
+There are extension points [%debug_lb_sexp], [%debug_this_lb_sexp], [%track_lb_sexp], etc. They call a function [_get_local_printbox_debug_runtime ()], or [_get_local_debug_runtime ()] for the [_l_] variants, and unpack the argument as [module Debug_runtime] (in a function body). The feature helps using a runtime instance dedicated to a thread or domain, since for example [_get_local_debug_runtime] can retrieve the runtime using [Domain.DLS]. To avoid surprises, this feature only takes effect for directly annotated functions, and unpacks a [Debug_runtime] inside the function body (regardless of whether there is a [_this_]), so that we get the appropriate runtime for the dynamic local scope.
+
+Example from the test suite:
+
+{@ocaml[
+
+]}
 
-Another feature is the extension points [%debug_rtb_sexp], [%debug_this_rtb_sexp], [%track_rtb_sexp], etc. They add a first-class module argument to a function, and unpack the argument as [module Debug_runtime]. The feature helps using a runtime instance dedicated to a thread. At present, passing of the runtime instance to functions needs to be done manually. Note that only the function attached to the [_rt_] or [_rtb_] extension point is modified, regardless of whether there is a [_this_].
+Another similar feature is the extension points [%debug_rtb_sexp], [%debug_this_rtb_sexp], [%track_rtb_sexp], etc. They add a first-class module argument to a function, and unpack the argument as [module Debug_runtime]. At present, passing of the runtime instance to functions needs to be done manually. Note that only the function attached to the [_rt_] or [_rtb_] extension point is modified, regardless of whether there is a [_this_].
 
 Example from the test suite:
 

diff --git a/ppx_minidebug.ml b/ppx_minidebug.ml
@@ -14,7 +14,17 @@ type log_level =
 let no_results = function Nothing | Prefixed _ -> true | _ -> false
 let is_prefixed_or_result = function Prefixed_or_result _ -> true | _ -> false
 
-type toplevel_opt_arg = Nested | Toplevel_no_arg | Generic | PrintBox
+type toplevel_opt_arg =
+  | Nested
+  | Toplevel_no_arg
+  | Generic
+  | PrintBox
+  | Generic_local
+  | PrintBox_local
+
+let is_local_debug_runtime = function
+  | Generic_local | PrintBox_local -> true
+  | _ -> false
 
 let global_log_count = ref 0
 
@@ -622,6 +632,14 @@ let unpack_runtime toplevel_opt_arg exp =
   let loc = exp.pexp_loc in
   match toplevel_opt_arg with
   | Nested | Toplevel_no_arg -> exp
+  | Generic_local ->
+      [%expr
+        let module Debug_runtime = (val _get_local_debug_runtime ()) in
+        [%e exp]]
+  | PrintBox_local ->
+      [%expr
+        let module Debug_runtime = (val _get_local_printbox_debug_runtime ()) in
+        [%e exp]]
   | Generic | PrintBox ->
       [%expr
         let module Debug_runtime = (val _debug_runtime) in
@@ -743,6 +761,11 @@ let debug_case context callback ?ret_descr ?ret_typ ?arg_typ kind i
     debug_body context callback ~loc:pc_rhs.pexp_loc ~message ~descr_loc:ret_descr
       ~log_count_before ~arg_logs ret_typ pc_rhs
   in
+  let pc_rhs =
+    if is_local_debug_runtime context.toplevel_opt_arg then
+      unpack_runtime context.toplevel_opt_arg pc_rhs
+    else pc_rhs
+  in
   { pc_lhs; pc_guard; pc_rhs }
 
 let debug_function context callback ~loc ?ret_descr ?ret_typ ?arg_typ cases =
@@ -754,7 +777,7 @@ let debug_function context callback ~loc ?ret_descr ?ret_typ ?arg_typ cases =
          cases)
   in
   match context.toplevel_opt_arg with
-  | Nested | Toplevel_no_arg -> exp
+  | Nested | Toplevel_no_arg | Generic_local | PrintBox_local -> exp
   | Generic ->
       [%expr
         fun (_debug_runtime : (module Minidebug_runtime.Debug_runtime)) ->
@@ -847,8 +870,9 @@ let debug_binding context callback vb =
     in
     let pvb_expr =
       match (typ2, context.toplevel_opt_arg) with
-      | None, (Nested | Toplevel_no_arg) -> exp
-      | Some typ, (Nested | Toplevel_no_arg) -> [%expr ([%e exp] : [%t typ])]
+      | None, (Nested | Toplevel_no_arg | Generic_local | PrintBox_local) -> exp
+      | Some typ, (Nested | Toplevel_no_arg | Generic_local | PrintBox_local) ->
+          [%expr ([%e exp] : [%t typ])]
       | Some typ, Generic ->
           [%expr ([%e exp] : (module Minidebug_runtime.Debug_runtime) -> [%t typ])]
       | Some typ, PrintBox ->
@@ -1006,6 +1030,8 @@ let rules =
                              | Toplevel_no_arg -> ext_point
                              | Generic -> ext_point ^ "_rt"
                              | PrintBox -> ext_point ^ "_rtb"
+                             | Generic_local -> ext_point ^ "_l"
+                             | PrintBox_local -> ext_point ^ "_lb"
                            in
                            let ext_point =
                              ext_point ^ "_"
@@ -1025,7 +1051,7 @@ let rules =
                            })
                          [ Pp; Sexp; Show ])
                      [ `Debug; `Debug_this; `Str ])
-              [ Toplevel_no_arg; Generic; PrintBox ])
+              [ Toplevel_no_arg; Generic; PrintBox; Generic_local; PrintBox_local ])
        [ `Track; `Debug; `Diagn ]
 
 let is_ext_point =
@@ -1088,6 +1114,10 @@ let traverse_expression =
             let toplevel_opt_arg =
               if String.length txt > 9 && String.sub txt 5 4 = "_rt_" then Generic
               else if String.length txt > 10 && String.sub txt 5 5 = "_rtb_" then PrintBox
+              else if String.length txt > 8 && String.sub txt 5 3 = "_l_" then
+                Generic_local
+              else if String.length txt > 9 && String.sub txt 5 4 = "_lb_" then
+                PrintBox_local
               else Toplevel_no_arg
             in
             self#expression

diff --git a/test/test_expect_test.ml b/test/test_expect_test.ml
@@ -3757,7 +3757,9 @@ let%expect_test "%debug_show skip module bindings" =
       int =
     let y : int = x + 1 in
     let module Debug_runtime =
-      (val optional rt (fun () -> (module Debug_runtime : Minidebug_runtime.Debug_runtime))) in
+      (val optional rt (fun () ->
+               (module Debug_runtime : Minidebug_runtime.Debug_runtime)))
+    in
     let z = y * 2 in
     z - 1
   in
@@ -3772,3 +3774,39 @@ let%expect_test "%debug_show skip module bindings" =
       └─"test/test_expect_test.ml":3758:8
     15
     |}]
+
+let%expect_test "%track_l_show procedure runtime passing" =
+  let i = ref 0 in
+  let _get_local_debug_runtime () =
+    Minidebug_runtime.debug_flushing ~global_prefix:("foo-" ^ string_of_int !i) ()
+  in
+  let%track_this_l_show foo () =
+    let () = () in
+    ()
+  in
+  while !i < 5 do
+    incr i;
+    foo ()
+  done;
+  [%expect
+    {|
+    BEGIN DEBUG SESSION foo-1
+    foo-1 foo begin "test/test_expect_test.ml":3783:28:
+    foo-1 foo end
+
+    BEGIN DEBUG SESSION foo-2
+    foo-2 foo begin "test/test_expect_test.ml":3783:28:
+    foo-2 foo end
+
+    BEGIN DEBUG SESSION foo-3
+    foo-3 foo begin "test/test_expect_test.ml":3783:28:
+    foo-3 foo end
+
+    BEGIN DEBUG SESSION foo-4
+    foo-4 foo begin "test/test_expect_test.ml":3783:28:
+    foo-4 foo end
+
+    BEGIN DEBUG SESSION foo-5
+    foo-5 foo begin "test/test_expect_test.ml":3783:28:
+    foo-5 foo end
+    |}]