format

bench/dune

@@ -1,22 +1,23 @@
+(executable
+ (name trace1)
+ (modules trace1)
+ (libraries trace.core trace-tef))
 
 (executable
-  (name trace1)
+ (name trace_fx)
-  (modules trace1)
+ (modules trace_fx)
-  (libraries trace.core trace-tef))
+ (preprocess
+  (pps ppx_trace))
+ (libraries trace.core trace-fuchsia))
 
 (executable
-  (name trace_fx)
+ (name trace_tldrs)
-  (modules trace_fx)
+ (modules trace_tldrs)
-  (preprocess (pps ppx_trace))
+ (preprocess
-  (libraries trace.core trace-fuchsia))
+  (pps ppx_trace))
+ (libraries trace.core trace-tef.tldrs))
 
 (executable
-  (name trace_tldrs)
+ (name bench_fuchsia_write)
-  (modules trace_tldrs)
+ (modules bench_fuchsia_write)
-  (preprocess (pps ppx_trace))
+ (libraries benchmark trace-fuchsia.write))
-  (libraries trace.core trace-tef.tldrs))
-
-(executable
-  (name bench_fuchsia_write)
-  (modules bench_fuchsia_write)
-  (libraries benchmark trace-fuchsia.write))

dune

@@ -1,4 +1,9 @@
-
 (env
-  (_ (flags :standard -strict-sequence -warn-error -a+8+26+27 -w +a-4-40-42-44-70)))
+ (_
-
+  (flags
+   :standard
+   -strict-sequence
+   -warn-error
+   -a+8+26+27
+   -w
+   +a-4-40-42-44-70)))

src/core/collector.ml

@@ -1,9 +1,8 @@
 (** A global collector.
 
-    The collector, if present, is responsible for collecting messages
+    The collector, if present, is responsible for collecting messages and spans,
-    and spans, and storing them, recording them, forward them, or
+    and storing them, recording them, forward them, or offering them to other
-    offering them to other services and processes.
+    services and processes. *)
-*)
 
 open Types
 
@@ -30,7 +29,7 @@ module type S = sig
     (span -> 'a) ->
     'a
   (** Run the function in a new span.
-     @since 0.3 *)
+      @since 0.3 *)
 
   val enter_span :
     __FUNCTION__:string option ->
@@ -39,14 +38,14 @@ module type S = sig
     data:(string * user_data) list ->
     string ->
     span
-  (** Enter a new implicit span. For many uses cases, {!with_span} will
+  (** Enter a new implicit span. For many uses cases, {!with_span} will be
-      be easier to use.
+      easier to use.
       @since 0.6 *)
 
   val exit_span : span -> unit
-  (** Exit span. This should be called on the same thread
+  (** Exit span. This should be called on the same thread as the corresponding
-      as the corresponding {!enter_span}, and nest properly with
+      {!enter_span}, and nest properly with other calls to enter/exit_span and
-      other calls to enter/exit_span and {!with_span}.
+      {!with_span}.
       @since 0.6 *)
 
   val enter_manual_span :
@@ -58,16 +57,16 @@ module type S = sig
     data:(string * user_data) list ->
     string ->
     explicit_span
-  (** Enter an explicit span. Surrounding scope, if any, is provided by [parent],
+  (** Enter an explicit span. Surrounding scope, if any, is provided by
-      and this function can store as much metadata as it wants in the hmap
+      [parent], and this function can store as much metadata as it wants in the
-      in the {!explicit_span}'s [meta] field.
+      hmap in the {!explicit_span}'s [meta] field.
 
-      {b NOTE} the [parent] argument is now an {!explicit_span_ctx} and not
+      {b NOTE} the [parent] argument is now an {!explicit_span_ctx} and not an
-      an {!explicit_span} since NEXT_RELEASE.
+      {!explicit_span} since NEXT_RELEASE.
 
-      This means that the collector doesn't need to implement contextual
+      This means that the collector doesn't need to implement contextual storage
-      storage mapping {!span} to scopes, metadata, etc. on its side;
+      mapping {!span} to scopes, metadata, etc. on its side; everything can be
-      everything can be transmitted in the {!explicit_span}.
+      transmitted in the {!explicit_span}.
       @since 0.3 *)
 
   val exit_manual_span : explicit_span -> unit
@@ -76,6 +75,7 @@ module type S = sig
 
   val add_data_to_span : span -> (string * user_data) list -> unit
   (** @since Adds data to the current span.
+
       0.4 *)
 
   val add_data_to_manual_span :
@@ -99,9 +99,8 @@ module type S = sig
   (** Float counter. *)
 
   val extension_event : extension_event -> unit
-  (** Handle an extension event.
+  (** Handle an extension event. A collector {b MUST} simple ignore events it
-      A collector {b MUST} simple ignore events it doesn't know,
+      doesn't know, and return [()] silently.
-      and return [()] silently.
       @since 0.8 *)
 
   val shutdown : unit -> unit

src/core/dune

@@ -1,15 +1,17 @@
-
 (library
  (name trace_core)
  (public_name trace.core)
- (libraries (select meta_map.ml from
+ (libraries
-                    (hmap -> meta_map.hmap.ml)
+  (select
-                    (-> meta_map.ourown.ml)))
+   meta_map.ml
- (synopsis "Lightweight stub for tracing")
+   from
-)
+   (hmap -> meta_map.hmap.ml)
+   (-> meta_map.ourown.ml)))
+ (synopsis "Lightweight stub for tracing"))
 
 (rule
-  (targets atomic_.ml)
+ (targets atomic_.ml)
-  (action
+ (action
-    (with-stdout-to %{targets}
+  (with-stdout-to
-     (run ./gen/gen.exe --ocaml %{ocaml_version} --atomic))))
+   %{targets}
+   (run ./gen/gen.exe --ocaml %{ocaml_version} --atomic))))

src/core/gen/dune

@@ -1,3 +1,2 @@
-
 (executable
-  (name gen))
+ (name gen))

src/core/level.ml

@@ -1,16 +1,15 @@
 (** Tracing levels.
 
-    This is similar to log levels in, say, [Logs].
+    This is similar to log levels in, say, [Logs]. In a thoroughly instrumented
-    In a thoroughly instrumented program, there will be a {b lot}
+    program, there will be a {b lot} of spans, and enabling them all in
-    of spans, and enabling them all in production might slow
+    production might slow down the application or overwhelm the tracing system;
-    down the application or overwhelm the tracing system; yet
+    yet they might be useful in debug situations.
-    they might be useful in debug situations.
 
     @since 0.7 *)
 
-(** Level of tracing. These levels are in increasing order, i.e if
+(** Level of tracing. These levels are in increasing order, i.e if level
-    level [Debug1] is enabled, everything below it (Error, Warning, Info, etc.)
+    [Debug1] is enabled, everything below it (Error, Warning, Info, etc.) are
-    are also enabled.
+    also enabled.
     @since 0.7 *)
 type t =
   | Error  (** Only errors *)

src/core/trace_core.mli

@@ -19,16 +19,16 @@ end
 val enabled : unit -> bool
 (** Is there a collector?
 
-    This is fast, so that the traced program can check it before creating
+    This is fast, so that the traced program can check it before creating any
-    any span or message. *)
+    span or message. *)
 
 val get_default_level : unit -> Level.t
 (** Current default level for spans.
     @since 0.7 *)
 
 val set_default_level : Level.t -> unit
-(** Set level used for spans that do not specify it. The default
+(** Set level used for spans that do not specify it. The default default value
-    default value is [Level.Trace].
+    is [Level.Trace].
     @since 0.7 *)
 
 val ctx_of_span : explicit_span -> explicit_span_ctx
@@ -44,22 +44,20 @@ val with_span :
   string ->
   (span -> 'a) ->
   'a
-(** [with_span ~__FILE__ ~__LINE__ name f] enters a new span [sp],
+(** [with_span ~__FILE__ ~__LINE__ name f] enters a new span [sp], and calls
-    and calls [f sp].
+    [f sp]. [sp] might be a dummy span if no collector is installed. When [f sp]
-    [sp] might be a dummy span if no collector is installed.
+    returns or raises, the span [sp] is exited.
-    When [f sp] returns or raises, the span [sp] is exited.
 
     This is the recommended way to instrument most code.
 
-    @param level optional level for this span. since 0.7.
+    @param level
-      Default is set via {!set_default_level}.
+      optional level for this span. since 0.7. Default is set via
+      {!set_default_level}.
 
-    {b NOTE} an important restriction is that this is only supposed to
+    {b NOTE} an important restriction is that this is only supposed to work for
-    work for synchronous, direct style code. Monadic concurrency, Effect-based
+    synchronous, direct style code. Monadic concurrency, Effect-based fibers,
-    fibers, etc. might not play well with this style of spans on some
+    etc. might not play well with this style of spans on some or all backends.
-    or all backends. If you use cooperative concurrency,
+    If you use cooperative concurrency, see {!enter_manual_span}. *)
-    see {!enter_manual_span}.
-*)
 
 val enter_span :
   ?level:Level.t ->
@@ -71,17 +69,17 @@ val enter_span :
   span
 (** Enter a span manually.
 
-    @param level optional level for this span. since 0.7.
+    @param level
-      Default is set via {!set_default_level}. *)
+      optional level for this span. since 0.7. Default is set via
+      {!set_default_level}. *)
 
 val exit_span : span -> unit
-(** Exit a span manually. This must run on the same thread
+(** Exit a span manually. This must run on the same thread as the corresponding
-    as the corresponding {!enter_span}, and spans must nest
+    {!enter_span}, and spans must nest correctly. *)
-    correctly. *)
 
 val add_data_to_span : span -> (string * user_data) list -> unit
-(** Add structured data to the given active span (see {!with_span}).
+(** Add structured data to the given active span (see {!with_span}). Behavior is
-    Behavior is not specified if the span has been exited.
+    not specified if the span has been exited.
     @since 0.4 *)
 
 val enter_manual_span :
@@ -94,35 +92,37 @@ val enter_manual_span :
   ?data:(unit -> (string * user_data) list) ->
   string ->
   explicit_span
-(** Like {!with_span} but the caller is responsible for
+(** Like {!with_span} but the caller is responsible for obtaining the [parent]
-    obtaining the [parent] span from their {e own} caller, and carry the resulting
+    span from their {e own} caller, and carry the resulting {!explicit_span} to
-    {!explicit_span} to  the matching {!exit_manual_span}. 
+    the matching {!exit_manual_span}.
 
-    {b NOTE} this replaces [enter_manual_sub_span] and [enter_manual_toplevel_span]
+    {b NOTE} this replaces [enter_manual_sub_span] and
-    by just making [parent] an explicit option. It is breaking anyway because we now pass
+    [enter_manual_toplevel_span] by just making [parent] an explicit option. It
-    an {!explicit_span_ctx} instead of a full {!explicit_span} (the reason being that we
+    is breaking anyway because we now pass an {!explicit_span_ctx} instead of a
-    might receive this explicit_span_ctx from another process or machine).
+    full {!explicit_span} (the reason being that we might receive this
+    explicit_span_ctx from another process or machine).
 
-    @param flavor a description of the span that can be used by the {!Collector.S}
+    @param flavor
-      to decide how to represent the span. Typically, [`Sync] spans
+      a description of the span that can be used by the {!Collector.S} to decide
-      start and stop on one thread, and are nested purely by their timestamp;
+      how to represent the span. Typically, [`Sync] spans start and stop on one
-      and [`Async] spans can overlap, migrate between threads, etc. (as happens in
+      thread, and are nested purely by their timestamp; and [`Async] spans can
-      Lwt, Eio, Async, etc.) which impacts how the collector might represent them.
+      overlap, migrate between threads, etc. (as happens in Lwt, Eio, Async,
-    @param level optional level for this span. since 0.7.
+      etc.) which impacts how the collector might represent them.
-      Default is set via {!set_default_level}.
+    @param level
+      optional level for this span. since 0.7. Default is set via
+      {!set_default_level}.
     @since NEXT_RELEASE *)
 
 val exit_manual_span : explicit_span -> unit
-(** Exit an explicit span. This can be on another thread, in a
+(** Exit an explicit span. This can be on another thread, in a fiber or
-    fiber or lightweight thread, etc. and will be supported by backends
+    lightweight thread, etc. and will be supported by backends nonetheless. The
-    nonetheless.
+    span can be obtained via {!enter_manual_sub_span} or
-    The span can be obtained via {!enter_manual_sub_span} or
     {!enter_manual_toplevel_span}.
     @since 0.3 *)
 
 val add_data_to_manual_span : explicit_span -> (string * user_data) list -> unit
-(** [add_data_explicit esp data] adds [data] to the span [esp].
+(** [add_data_explicit esp data] adds [data] to the span [esp]. The behavior is
-      The behavior is not specified is the span has been exited already.
+    not specified is the span has been exited already.
     @since 0.4 *)
 
 val message :
@@ -131,11 +131,13 @@ val message :
   ?data:(unit -> (string * user_data) list) ->
   string ->
   unit
-(** [message msg] logs a message [msg] (if a collector is installed).
+(** [message msg] logs a message [msg] (if a collector is installed). Additional
-    Additional metadata can be provided.
+    metadata can be provided.
-    @param level optional level for this span. since 0.7.
+    @param level
-      Default is set via {!set_default_level}.
+      optional level for this span. since 0.7. Default is set via
-    @param span the surrounding span, if any. This might be ignored by the collector. *)
+      {!set_default_level}.
+    @param span
+      the surrounding span, if any. This might be ignored by the collector. *)
 
 val messagef :
   ?level:Level.t ->
@@ -144,20 +146,19 @@ val messagef :
   ((('a, Format.formatter, unit, unit) format4 -> 'a) -> unit) ->
   unit
 (** [messagef (fun k->k"hello %s %d!" "world" 42)] is like
-    [message "hello world 42!"] but only computes the string formatting
+    [message "hello world 42!"] but only computes the string formatting if a
-    if a collector is installed.
+    collector is installed.
-    @param level optional level for this span. since 0.7.
+    @param level
-      Default is set via {!set_default_level}. *)
+      optional level for this span. since 0.7. Default is set via
+      {!set_default_level}. *)
 
 val set_thread_name : string -> unit
-(** Give a name to the current thread.
+(** Give a name to the current thread. This might be used by the collector to
-    This might be used by the collector
+    display traces in a more informative way. *)
-    to display traces in a more informative way. *)
 
 val set_process_name : string -> unit
-(** Give a name to the current process.
+(** Give a name to the current process. This might be used by the collector to
-    This might be used by the collector
+    display traces in a more informative way. *)
-    to display traces in a more informative way. *)
 
 val counter_int :
   ?level:Level.t ->
@@ -165,10 +166,11 @@ val counter_int :
   string ->
   int ->
   unit
-(** Emit a counter of type [int]. Counters represent the evolution of some quantity
+(** Emit a counter of type [int]. Counters represent the evolution of some
-    over time.
+    quantity over time.
-    @param level optional level for this span. since 0.7.
+    @param level
-      Default is set via {!set_default_level}.
+      optional level for this span. since 0.7. Default is set via
+      {!set_default_level}.
     @param data metadata for this metric (since 0.4) *)
 
 val counter_float :
@@ -178,8 +180,9 @@ val counter_float :
   float ->
   unit
 (** Emit a counter of type [float]. See {!counter_int} for more details.
-    @param level optional level for this span. since 0.7.
+    @param level
-      Default is set via {!set_default_level}.
+      optional level for this span. since 0.7. Default is set via
+      {!set_default_level}.
     @param data metadata for this metric (since 0.4) *)
 
 (** {2 Collector} *)
@@ -191,32 +194,30 @@ type collector = (module Collector.S)
 
 val setup_collector : collector -> unit
 (** [setup_collector c] installs [c] as the current collector.
-    @raise Invalid_argument if there already is an established
+    @raise Invalid_argument if there already is an established collector. *)
-    collector. *)
 
 val get_current_level : unit -> Level.t
-(** Get current level. This is only meaningful if
+(** Get current level. This is only meaningful if a collector was set up with
-    a collector was set up with {!setup_collector}.
+    {!setup_collector}.
     @since 0.7 *)
 
 val set_current_level : Level.t -> unit
-(** Set the current level of tracing. This only has a visible
+(** Set the current level of tracing. This only has a visible effect if a
-    effect if a collector was installed with {!setup_collector}.
+    collector was installed with {!setup_collector}.
     @since 0.7 *)
 
 val shutdown : unit -> unit
-(** [shutdown ()] shutdowns the current collector, if one was installed,
+(** [shutdown ()] shutdowns the current collector, if one was installed, and
-    and waits for it to terminate before returning. *)
+    waits for it to terminate before returning. *)
 
 (** {2 Extensions} *)
 
 type extension_event = Types.extension_event = ..
 (** Extension event
-  @since 0.8 *)
+    @since 0.8 *)
 
 val extension_event : extension_event -> unit
-(** Trigger an extension event, whose meaning depends on
+(** Trigger an extension event, whose meaning depends on the library that
-    the library that defines it. Some collectors will
+    defines it. Some collectors will simply ignore it. This does nothing if no
-    simply ignore it. This does nothing if no collector
+    collector is setup.
-    is setup.
     @since 0.8 *)

src/core/types.ml

@@ -4,8 +4,8 @@ type span = int64
     The meaning of the identifier depends on the collector. *)
 
 type trace_id = string
-(** A bytestring representing a (possibly distributed) trace made of async spans.
+(** A bytestring representing a (possibly distributed) trace made of async
-    With opentelemetry this is 16 bytes.
+    spans. With opentelemetry this is 16 bytes.
     @since NEXT_RELEASE *)
 
 type user_data =
@@ -15,8 +15,8 @@ type user_data =
   | `Float of float
   | `None
   ]
-(** User defined data, generally passed as key/value pairs to
+(** User defined data, generally passed as key/value pairs to whatever collector
-    whatever collector is installed (if any). *)
+    is installed (if any). *)
 
 type explicit_span_ctx = {
   span: span;  (** The current span *)
@@ -28,18 +28,18 @@ type explicit_span_ctx = {
 type explicit_span = {
   span: span;
       (** Identifier for this span. Several explicit spans might share the same
-      identifier since we can differentiate between them via [meta]. *)
+          identifier since we can differentiate between them via [meta]. *)
   trace_id: trace_id;  (** The trace this belongs to *)
   mutable meta: Meta_map.t;
-      (** Metadata for this span (and its context). This can be used by collectors to
+      (** Metadata for this span (and its context). This can be used by
-        carry collector-specific information from the beginning
+          collectors to carry collector-specific information from the beginning
-        of the span, to the end of the span. *)
+          of the span, to the end of the span. *)
 }
-(** Explicit span, with collector-specific metadata.
+(** Explicit span, with collector-specific metadata. This is richer than
-    This is richer than {!explicit_span_ctx} but not intended to be passed around
+    {!explicit_span_ctx} but not intended to be passed around (or sent across
-    (or sent across the wire), unlike {!explicit_span_ctx}. *)
+    the wire), unlike {!explicit_span_ctx}. *)
 
 type extension_event = ..
-(** An extension event, used to add features that are backend specific
+(** An extension event, used to add features that are backend specific or simply
-    or simply not envisioned by [trace].
+    not envisioned by [trace].
-  @since 0.8 *)
+    @since 0.8 *)

src/dune

@@ -2,5 +2,5 @@
  (name trace)
  (public_name trace)
  (synopsis "Lightweight stub for tracing")
- (libraries (re_export trace.core))
+ (libraries
-)
+  (re_export trace.core)))

src/fuchsia/bg_thread.ml

@@ -51,9 +51,8 @@ let bg_thread ~buf_pool ~out ~(events : event B_queue.t) () : unit =
   let st = { oc; buf_pool; events } in
   bg_loop st
 
-(** Thread that simply regularly "ticks", sending events to
+(** Thread that simply regularly "ticks", sending events to the background
-     the background thread so it has a chance to write to the file,
+    thread so it has a chance to write to the file, and call [f()] *)
-     and call [f()] *)
 let tick_thread events : unit =
   try
     while true do

src/fuchsia/dune

@@ -1,9 +1,15 @@
-
-
 (library
-  (name trace_fuchsia)
+ (name trace_fuchsia)
-  (public_name trace-fuchsia)
+ (public_name trace-fuchsia)
-  (synopsis "A high-performance backend for trace, emitting a Fuchsia trace into a file")
+ (synopsis
-  (libraries trace.core trace.private.util thread-local-storage
+  "A high-performance backend for trace, emitting a Fuchsia trace into a file")
-             (re_export trace-fuchsia.write) bigarray
+ (libraries
-             mtime mtime.clock.os unix threads))
+  trace.core
+  trace.private.util
+  thread-local-storage
+  (re_export trace-fuchsia.write)
+  bigarray
+  mtime
+  mtime.clock.os
+  unix
+  threads))

src/fuchsia/fcollector.ml

@@ -135,8 +135,8 @@ type state = {
   buf_pool: Buf_pool.t;
   next_thread_ref: int A.t;  (** in [0x01 .. 0xff], to allocate thread refs *)
   per_thread: per_thread_state Int_map.t A.t array;
-      (** the state keeps tabs on thread-local state, so it can flush writers
+      (** the state keeps tabs on thread-local state, so it can flush writers at
-        at the end. This is a tid-sharded array of maps. *)
+          the end. This is a tid-sharded array of maps. *)
 }
 
 let[@inline] mk_trace_id (self : state) : trace_id =

src/fuchsia/trace_fuchsia.mli

@@ -1,15 +1,15 @@
 (** Fuchsia trace collector.
 
-  This provides a collector for traces that emits data into a file
+    This provides a collector for traces that emits data into a file using the
-  using the compact binary
+    compact binary
-  {{:https://fuchsia.dev/fuchsia-src/reference/tracing/trace-format} Fuchsia trace format}.
+    {{:https://fuchsia.dev/fuchsia-src/reference/tracing/trace-format} Fuchsia
-  This reduces the tracing overhead compared to [trace-tef], at the expense of simplicity.
+     trace format}. This reduces the tracing overhead compared to [trace-tef],
-*)
+    at the expense of simplicity. *)
 
 val collector :
   out:[ `File of string | `Stderr | `Stdout ] -> unit -> Trace_core.collector
-(** Make a collector that writes into the given output.
+(** Make a collector that writes into the given output. See {!setup} for more
-    See {!setup} for more details. *)
+    details. *)
 
 type output =
   [ `Stdout
@@ -20,29 +20,26 @@ type output =
 
     - [`Stdout] will enable tracing and print events on stdout
     - [`Stderr] will enable tracing and print events on stderr
-    - [`File "foo"] will enable tracing and print events into file
+    - [`File "foo"] will enable tracing and print events into file named "foo"
-        named "foo"
 *)
 
 val setup : ?out:[ output | `Env ] -> unit -> unit
 (** [setup ()] installs the collector depending on [out].
 
-    @param out can take different values:
+    @param out
-    - regular {!output} value to specify where events go
+      can take different values:
-    - [`Env] will enable tracing if the environment
+      - regular {!output} value to specify where events go
-      variable "TRACE" is set.
+      - [`Env] will enable tracing if the environment variable "TRACE" is set.
 
-      - If it's set to "1", then the file is "trace.fxt".
+    - If it's set to "1", then the file is "trace.fxt".
-      - If it's set to "stdout", then logging happens on stdout (since 0.2)
+    - If it's set to "stdout", then logging happens on stdout (since 0.2)
-      - If it's set to "stderr", then logging happens on stdout (since 0.2)
+    - If it's set to "stderr", then logging happens on stdout (since 0.2)
-      - Otherwise, if it's set to a non empty string, the value is taken
+    - Otherwise, if it's set to a non empty string, the value is taken to be the
-        to be the file path into which to write.
+      file path into which to write. *)
-*)
 
 val with_setup : ?out:[ output | `Env ] -> unit -> (unit -> 'a) -> 'a
-(** [with_setup () f] (optionally) sets a collector up, calls [f()],
+(** [with_setup () f] (optionally) sets a collector up, calls [f()], and makes
-    and makes sure to shutdown before exiting.
+    sure to shutdown before exiting. *)
-*)
 
 (**/**)
 

src/fuchsia/write/dune

@@ -1,9 +1,9 @@
-
 (library
-  (name trace_fuchsia_write)
+ (name trace_fuchsia_write)
-  (public_name trace-fuchsia.write)
+ (public_name trace-fuchsia.write)
-  (synopsis "Serialization part of trace-fuchsia")
+ (synopsis "Serialization part of trace-fuchsia")
-  (ocamlopt_flags :standard
+ (ocamlopt_flags
-                  ;-dlambda
+  :standard
-                  )
+  ;-dlambda
-  (libraries trace.core threads))
+  )
+ (libraries trace.core threads))

src/ppx/dune

@@ -1,8 +1,8 @@
-
 (library
  (name ppx_trace)
  (public_name ppx_trace)
  (kind ppx_rewriter)
- (preprocess (pps ppxlib.metaquot))
+ (preprocess
+  (pps ppxlib.metaquot))
  (ppx_runtime_libraries trace.core)
  (libraries ppxlib))

src/ppx/ppx_trace.ml

@@ -37,19 +37,19 @@ let expand_let ~ctxt (var : [ `Var of label loc | `Unit ]) (name : string) body
 let extension_let =
   Extension.V3.declare "trace" Extension.Context.expression
     (let open! Ast_pattern in
-    single_expr_payload
+     single_expr_payload
-      (pexp_let nonrecursive
+       (pexp_let nonrecursive
-         (value_binding
+          (value_binding
-            ~pat:
+             ~pat:
-              (let pat_var = ppat_var __' |> map ~f:(fun f v -> f (`Var v)) in
+               (let pat_var = ppat_var __' |> map ~f:(fun f v -> f (`Var v)) in
-               let pat_unit =
+                let pat_unit =
-                 as__ @@ ppat_construct (lident (string "()")) none
+                  as__ @@ ppat_construct (lident (string "()")) none
-                 |> map ~f:(fun f _ -> f `Unit)
+                  |> map ~f:(fun f _ -> f `Unit)
-               in
+                in
-               alt pat_var pat_unit)
+                alt pat_var pat_unit)
-            ~expr:(estring __)
+             ~expr:(estring __)
-         ^:: nil)
+          ^:: nil)
-         __))
+          __))
     expand_let
 
 let rule_let = Ppxlib.Context_free.Rule.extension extension_let
@@ -90,7 +90,7 @@ let expand_top_let ~ctxt rec_flag (vbs : _ list) =
 let extension_top_let =
   Extension.V3.declare "trace" Extension.Context.structure_item
     (let open! Ast_pattern in
-    pstr (pstr_value __ __ ^:: nil))
+     pstr (pstr_value __ __ ^:: nil))
     expand_top_let
 
 let rule_top_let = Ppxlib.Context_free.Rule.extension extension_top_let

src/subscriber/callbacks.ml

@@ -1,25 +1,25 @@
 (** Callbacks used for subscribers.
 
-  Each subscriber defines a set of callbacks, for each possible
+    Each subscriber defines a set of callbacks, for each possible tracing event.
-  tracing event. These callbacks take a custom state that is paired
+    These callbacks take a custom state that is paired with the callbacks in
-  with the callbacks in {!Subscriber.t}.
+    {!Subscriber.t}.
 
-  To use a default implementation for some callbacks, use:
+    To use a default implementation for some callbacks, use:
 
-  {[
+    {[
-  module My_callbacks = struct
+      module My_callbacks = struct
-    type st = …
+        type st = …
 
-    include Trace_subscriber.Callbacks.Dummy
+        include Trace_subscriber.Callbacks.Dummy
 
-    let on_init (state:st) ~time_ns : unit = …
+        let on_init (state:st) ~time_ns : unit = …
 
-    (* … other custom callbacks … *)
+        (* … other custom callbacks … *)
-  end ]}
+      end
+    ]}
 
-  {b NOTE}: the [trace_id] passed alongside manual spans is guaranteed to be at
+    {b NOTE}: the [trace_id] passed alongside manual spans is guaranteed to be
-  least 64 bits.
+    at least 64 bits. *)
-*)
 
 open Trace_core
 open Types
@@ -55,7 +55,8 @@ module type S = sig
   (** Enter a regular (sync) span *)
 
   val on_exit_span : st -> time_ns:float -> tid:int -> span -> unit
-  (** Exit a span. This and [on_enter_span] must follow strict stack discipline *)
+  (** Exit a span. This and [on_enter_span] must follow strict stack discipline
+  *)
 
   val on_add_data : st -> data:(string * user_data) list -> span -> unit
   (** Add data to a regular span (which must be active) *)
@@ -115,14 +116,12 @@ module type S = sig
 end
 
 type 'st t = (module S with type st = 'st)
-(** Callbacks for a subscriber. There is one callback per event
+(** Callbacks for a subscriber. There is one callback per event in {!Trace}. The
-    in {!Trace}. The type ['st] is the state that is passed to
+    type ['st] is the state that is passed to every single callback. *)
-    every single callback. *)
 
-(** Dummy callbacks.
+(** Dummy callbacks. It can be useful to reuse some of these functions in a real
-    It can be useful to reuse some of these functions in a
+    subscriber that doesn't want to handle {b all} events, but only some of
-    real subscriber that doesn't want to handle {b all}
+    them. *)
-    events, but only some of them. *)
 module Dummy = struct
   let on_init _ ~time_ns:_ = ()
   let on_shutdown _ ~time_ns:_ = ()

src/subscriber/dune

@@ -1,14 +1,17 @@
-
 (library
-  (name trace_subscriber)
+ (name trace_subscriber)
-  (public_name trace.subscriber)
+ (public_name trace.subscriber)
-  (libraries (re_export trace.core)
+ (libraries
-             (select thread_.ml from
+  (re_export trace.core)
-                     (threads -> thread_.real.ml)
+  (select
-                     ( -> thread_.dummy.ml))
+   thread_.ml
-             (select time_.ml from
+   from
-                     (mtime mtime.clock.os -> time_.mtime.ml)
+   (threads -> thread_.real.ml)
-                     (mtime mtime.clock.jsoo -> time_.mtime.ml)
+   (-> thread_.dummy.ml))
-                     (unix -> time_.unix.ml)
+  (select
-                     ( -> time_.dummy.ml))))
+   time_.ml
-
+   from
+   (mtime mtime.clock.os -> time_.mtime.ml)
+   (mtime mtime.clock.jsoo -> time_.mtime.ml)
+   (unix -> time_.unix.ml)
+   (-> time_.dummy.ml))))

src/subscriber/subscriber.ml

@@ -1,8 +1,8 @@
 (** Trace subscribers *)
 
-(** A trace subscriber. It pairs a set of callbacks
+(** A trace subscriber. It pairs a set of callbacks with the state they need
-    with the state they need (which can contain a file handle,
+    (which can contain a file handle, a socket to write events to, config,
-    a socket to write events to, config, etc.).
+    etc.).
 
     The design goal for this is that it should be possible to avoid allocations
     whenever the trace collector invokes the callbacks. *)
@@ -105,14 +105,14 @@ open struct
   end
 end
 
-(** [tee s1 s2] is a subscriber that forwards every
+(** [tee s1 s2] is a subscriber that forwards every call to [s1] and [s2] both.
-    call to [s1] and [s2] both. *)
+*)
 let tee (s1 : t) (s2 : t) : t =
   let st = s1, s2 in
   Sub { st; callbacks = (module Tee_cb) }
 
-(** Tee multiple subscribers, ie return a subscriber that forwards
+(** Tee multiple subscribers, ie return a subscriber that forwards to all the
-    to all the subscribers in [subs]. *)
+    subscribers in [subs]. *)
 let rec tee_l (subs : t list) : t =
   match subs with
   | [] -> dummy

src/subscriber/trace_subscriber.ml

@@ -30,8 +30,8 @@ open struct
     mutable data: (string * user_data) list;
   }
 
-  (** Key used to carry some information between begin and end of
+  (** Key used to carry some information between begin and end of manual spans,
-    manual spans, by way of the meta map *)
+      by way of the meta map *)
   let key_manual_info : manual_span_info Meta_map.key = Meta_map.Key.create ()
 end
 

src/subscriber/trace_subscriber.mli

@@ -1,12 +1,10 @@
 (** Generic subscribers.
 
-    This defines the notion of a {b subscriber},
+    This defines the notion of a {b subscriber}, a set of callbacks for every
-    a set of callbacks for every trace event.
+    trace event. It also defines a collector that needs to be installed for the
-    It also defines a collector that needs to be installed
+    subscriber(s) to be called.
-    for the subscriber(s) to be called.
 
-    @since 0.8
+    @since 0.8 *)
-*)
 
 module Callbacks = Callbacks
 module Subscriber = Subscriber
@@ -22,7 +20,7 @@ type t = Subscriber.t
 val collector : t -> Trace_core.collector
 (** A collector that calls the subscriber's callbacks.
 
-  It uses [mtime] (if available) to obtain timestamps. *)
+    It uses [mtime] (if available) to obtain timestamps. *)
 
 (**/**)
 

src/tef-tldrs/trace_tef_tldrs.mli

@@ -1,8 +1,9 @@
-(** Emit traces by talking to the {{: https://github.com/imandra-ai/tldrs} tldrs} daemon *)
+(** Emit traces by talking to the {{:https://github.com/imandra-ai/tldrs} tldrs}
+    daemon *)
 
 val collector : out:[ `File of string ] -> unit -> Trace_core.collector
-(** Make a collector that writes into the given output.
+(** Make a collector that writes into the given output. See {!setup} for more
-    See {!setup} for more details. *)
+    details. *)
 
 val subscriber : out:[ `File of string ] -> unit -> Trace_subscriber.t
 (** Make a subscriber that writes into the given output.
@@ -10,29 +11,26 @@ val subscriber : out:[ `File of string ] -> unit -> Trace_subscriber.t
 
 type output = [ `File of string ]
 (** Output for tracing.
-    - [`File "foo"] will enable tracing and print events into file
+    - [`File "foo"] will enable tracing and print events into file named "foo".
-        named "foo". The file is only written at exit.
+      The file is only written at exit. *)
-*)
 
 val setup : ?out:[ output | `Env ] -> unit -> unit
 (** [setup ()] installs the collector depending on [out].
 
-    @param out can take different values:
+    @param out
-    - regular {!output} value to specify where events go
+      can take different values:
-    - [`Env] will enable tracing if the environment
+      - regular {!output} value to specify where events go
-      variable "TRACE" is set.
+      - [`Env] will enable tracing if the environment variable "TRACE" is set.
 
-      - If it's set to "1", then the file is "trace.json".
+    - If it's set to "1", then the file is "trace.json".
-      - If it's set to "stdout", then logging happens on stdout (since 0.2)
+    - If it's set to "stdout", then logging happens on stdout (since 0.2)
-      - If it's set to "stderr", then logging happens on stdout (since 0.2)
+    - If it's set to "stderr", then logging happens on stdout (since 0.2)
-      - Otherwise, if it's set to a non empty string, the value is taken
+    - Otherwise, if it's set to a non empty string, the value is taken to be the
-        to be the file path into which to write.
+      file path into which to write. *)
-*)
 
 val with_setup : ?out:[ output | `Env ] -> unit -> (unit -> 'a) -> 'a
-(** [with_setup () f] (optionally) sets a collector up, calls [f()],
+(** [with_setup () f] (optionally) sets a collector up, calls [f()], and makes
-    and makes sure to shutdown before exiting.
+    sure to shutdown before exiting. *)
-*)
 
 (**/**)
 

src/tef/trace_tef.mli

@@ -7,8 +7,7 @@ type output =
 
     - [`Stdout] will enable tracing and print events on stdout
     - [`Stderr] will enable tracing and print events on stderr
-    - [`File "foo"] will enable tracing and print events into file
+    - [`File "foo"] will enable tracing and print events into file named "foo"
-        named "foo"
 *)
 
 val subscriber : out:[< output ] -> unit -> Trace_subscriber.t
@@ -16,29 +15,26 @@ val subscriber : out:[< output ] -> unit -> Trace_subscriber.t
     @since 0.8 *)
 
 val collector : out:[< output ] -> unit -> Trace_core.collector
-(** Make a collector that writes into the given output.
+(** Make a collector that writes into the given output. See {!setup} for more
-    See {!setup} for more details. *)
+    details. *)
 
 val setup : ?out:[ output | `Env ] -> unit -> unit
 (** [setup ()] installs the collector depending on [out].
 
-    @param out can take different values:
+    @param out
-    - regular {!output} value to specify where events go
+      can take different values:
-    - [`Env] will enable tracing if the environment
+      - regular {!output} value to specify where events go
-      variable "TRACE" is set.
+      - [`Env] will enable tracing if the environment variable "TRACE" is set.
 
-      - If it's set to "1", then the file is "trace.json".
+    - If it's set to "1", then the file is "trace.json".
-      - If it's set to "stdout", then logging happens on stdout (since 0.2)
+    - If it's set to "stdout", then logging happens on stdout (since 0.2)
-      - If it's set to "stderr", then logging happens on stdout (since 0.2)
+    - If it's set to "stderr", then logging happens on stdout (since 0.2)
-      - Otherwise, if it's set to a non empty string, the value is taken
+    - Otherwise, if it's set to a non empty string, the value is taken to be the
-        to be the file path into which to write.
+      file path into which to write. *)
-*)
 
 val with_setup : ?out:[ output | `Env ] -> unit -> (unit -> 'a) -> 'a
-(** [with_setup () f] (optionally) sets a collector up, calls [f()],
+(** [with_setup () f] (optionally) sets a collector up, calls [f()], and makes
-    and makes sure to shutdown before exiting.
+    sure to shutdown before exiting. since 0.2 a () argument was added. *)
-    since 0.2 a () argument was added.
-*)
 
 (**/**)
 

src/util/b_queue.mli

@@ -11,9 +11,8 @@ val push : 'a t -> 'a -> unit
     @raise Closed if [close q] was previously called.*)
 
 val pop_all : 'a t -> 'a list
-(** [pop_all bq] returns all items presently
+(** [pop_all bq] returns all items presently in [bq], in the same order, and
-    in [bq], in the same order, and clears [bq].
+    clears [bq]. It blocks if no element is in [bq]. *)
-    It blocks if no element is in [bq]. *)
 
 val close : _ t -> unit
 (** Close the queue, meaning there won't be any more [push] allowed. *)

src/util/dune

@@ -1,10 +1,16 @@
-
 (library
-  (public_name trace.private.util)
+ (public_name trace.private.util)
-  (synopsis "internal utilities for trace. No guarantees of stability.")
+ (synopsis "internal utilities for trace. No guarantees of stability.")
-  (name trace_private_util)
+ (name trace_private_util)
-  (optional) ; depends on mtime
+ (optional) ; depends on mtime
-  (libraries trace.core mtime mtime.clock.os unix threads
+ (libraries
-             (select domain_util.ml from
+  trace.core
-                     (base-domain -> domain_util.real.ml)
+  mtime
-                     ( -> domain_util.dummy.ml))))
+  mtime.clock.os
+  unix
+  threads
+  (select
+   domain_util.ml
+   from
+   (base-domain -> domain_util.real.ml)
+   (-> domain_util.dummy.ml))))

test/dune

@@ -1,13 +1,13 @@
+(test
+ (name t1)
+ (package trace-tef)
+ (modules t1)
+ (libraries trace trace-tef))
 
 (test
-  (name t1)
+ (name t2)
-  (package trace-tef)
+ (package ppx_trace)
-  (modules t1)
+ (modules t2)
-  (libraries trace trace-tef))
+ (preprocess
-
+  (pps ppx_trace))
-(test
+ (libraries trace-tef))
-  (name t2)
-  (package ppx_trace)
-  (modules t2)
-  (preprocess (pps ppx_trace))
-  (libraries trace-tef))

test/fuchsia/write/dune

@@ -1,5 +1,4 @@
-
 (tests
-  (names t1 t2)
+ (names t1 t2)
-  (package trace-fuchsia)
+ (package trace-fuchsia)
-  (libraries trace-fuchsia.write))
+ (libraries trace-fuchsia.write))