runtime-events as optional dep (to be compatible with 4.14)

raphael-proust · raphael-proust · commit 8985a4159289 · 2025-10-15T10:13:45.000+08:00
diff --git a/dune-project b/dune-project
@@ -62,6 +62,15 @@
   base-unix
   (lwt (>= 6))))
 
+(package
+ (name lwt_runtime_events)
+ (version 6.0.0~beta00)
+ (synopsis "Emit runtime events to trace the execution of Lwt programs")
+ (authors "Raphaël Proust")
+ (depends
+  (ocaml (>= 5.1))
+  ))
+
 (package
  (name lwt)
  (version 6.0.0~beta00)
@@ -76,10 +85,10 @@ a single thread by default. This reduces the need for locks or other
 synchronization primitives. Code can be run in parallel on an opt-in basis.
 ")
  (depends
-  (ocaml (>= 5.1))
+  (ocaml (>= 4.14))
   (cppo (and :build (>= 1.1)))
   (ocamlfind (and :dev (>= 1.7.3-1)))
   (odoc (and :with-doc (>= 2.3)))
   dune-configurator
   ocplib-endian)
- (depopts base-threads base-unix conf-libev))
+ (depopts base-threads base-unix conf-libev lwt_runtime_events))
diff --git a/lwt.opam b/lwt.opam
@@ -22,14 +22,14 @@ doc: "https://ocsigen.org/lwt"
 bug-reports: "https://github.com/ocsigen/lwt/issues"
 depends: [
   "dune" {>= "3.15"}
-  "ocaml" {>= "5.1"}
+  "ocaml" {>= "4.14"}
   "cppo" {build & >= "1.1"}
   "ocamlfind" {dev & >= "1.7.3-1"}
   "odoc" {with-doc & >= "2.3"}
   "dune-configurator"
   "ocplib-endian"
 ]
-depopts: ["base-threads" "base-unix" "conf-libev"]
+depopts: ["base-threads" "base-unix" "conf-libev" "lwt_runtime_events"]
 dev-repo: "git+https://github.com/ocsigen/lwt.git"
 build: [
   ["dune" "subst"] {dev}
diff --git a/lwt_runtime_events.opam b/lwt_runtime_events.opam
@@ -0,0 +1,32 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+version: "6.0.0~beta00"
+synopsis: "Emit runtime events to trace the execution of Lwt programs"
+maintainer: [
+  "Raphaël Proust <code@bnwr.net>" "Anton Bachin <antonbachin@yahoo.com>"
+]
+authors: ["Raphaël Proust"]
+license: "MIT"
+homepage: "https://github.com/ocsigen/lwt"
+doc: "https://ocsigen.org/lwt"
+bug-reports: "https://github.com/ocsigen/lwt/issues"
+depends: [
+  "dune" {>= "3.15"}
+  "ocaml" {>= "5.1"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/ocsigen/lwt.git"
diff --git a/src/core/dune b/src/core/dune
@@ -2,7 +2,10 @@
  (public_name lwt)
  (synopsis "Monadic promises and concurrent I/O")
  (wrapped false)
- (libraries runtime_events))
+ (libraries
+ (select lwt_rte.ml from
+  (lwt_runtime_events -> lwt_rte.with.ml)
+  (-> lwt_rte.without.ml))))
 
 (documentation
  (package lwt))
diff --git a/src/core/lwt.ml b/src/core/lwt.ml
@@ -3240,6 +3240,4 @@ end
 module Private = struct
   type nonrec storage = storage
   module Sequence_associated_storage = Sequence_associated_storage
-  type Runtime_events.User.tag += Paused_count
-  let paused_count = Runtime_events.User.register "lwt-paused-count" Paused_count Runtime_events.Type.int
 end
diff --git a/src/core/lwt.mli b/src/core/lwt.mli
@@ -2071,6 +2071,4 @@ module Private : sig
     val empty_storage : storage
     val current_storage : storage ref
   end
-
-  val paused_count : int Runtime_events.User.t
 end [@@alert trespassing "for internal use only, keep away"]
diff --git a/src/core/lwt_rte.mli b/src/core/lwt_rte.mli
@@ -0,0 +1,5 @@
+val emit_paused_count : int -> unit
+val emit_sch_call_begin : unit -> unit
+val emit_sch_call_end : unit -> unit
+val emit_sch_lap : unit -> unit
+val emit_job_count : int -> unit
diff --git a/src/core/lwt_rte.with.ml b/src/core/lwt_rte.with.ml
@@ -0,0 +1,5 @@
+let emit_paused_count v = Lwt_runtime_events.emit_paused_count v
+let emit_sch_call_begin () = Lwt_runtime_events.emit_sch_call_begin ()
+let emit_sch_call_end () = Lwt_runtime_events.emit_sch_call_end ()
+let emit_sch_lap v = Lwt_runtime_events.emit_sch_lap v
+let emit_job_count v = Lwt_runtime_events.emit_job_count v
diff --git a/src/core/lwt_rte.without.ml b/src/core/lwt_rte.without.ml
@@ -0,0 +1,5 @@
+let emit_paused_count _v = ()
+let emit_sch_call_begin () = ()
+let emit_sch_call_end () = ()
+let emit_sch_lap _v = ()
+let emit_job_count _v = ()
diff --git a/src/runtime_events/dune b/src/runtime_events/dune
@@ -0,0 +1,5 @@
+(library
+ (public_name lwt_runtime_events)
+ (synopsis "Emit runtime events to trace the execution of Lwt programs")
+ (wrapped false)
+ (libraries runtime_events))
diff --git a/src/runtime_events/lwt_runtime_events.ml b/src/runtime_events/lwt_runtime_events.ml
@@ -0,0 +1,16 @@
+type Runtime_events.User.tag += Paused_count
+let paused_count = Runtime_events.User.register "lwt-paused-count" Paused_count Runtime_events.Type.int
+let emit_paused_count v = Runtime_events.User.write paused_count v
+
+type Runtime_events.User.tag += Scheduler_call
+let sch_call = Runtime_events.User.register "lwt-sch-call" Scheduler_call Runtime_events.Type.span
+let emit_sch_call_begin () = Runtime_events.User.write sch_call Runtime_events.Type.Begin
+let emit_sch_call_end () = Runtime_events.User.write sch_call Runtime_events.Type.End
+
+type Runtime_events.User.tag += Scheduler_lap
+let sch_lap = Runtime_events.User.register "lwt-sch-lap" Scheduler_lap Runtime_events.Type.unit
+let emit_sch_lap v = Runtime_events.User.write sch_lap v
+
+type Runtime_events.User.tag += Unix_job_count
+let unix_job_count = Runtime_events.User.register "lwt-unix-job-count" Unix_job_count Runtime_events.Type.int
+let emit_job_count v = Runtime_events.User.write unix_job_count v
diff --git a/src/runtime_events/lwt_runtime_events.mli b/src/runtime_events/lwt_runtime_events.mli
@@ -0,0 +1,16 @@
+type Runtime_events.User.tag += Paused_count
+val paused_count : int Runtime_events.User.t
+val emit_paused_count : int -> unit
+
+type Runtime_events.User.tag += Scheduler_call
+val sch_call : Runtime_events.Type.span Runtime_events.User.t
+val emit_sch_call_begin : unit -> unit
+val emit_sch_call_end : unit -> unit
+
+type Runtime_events.User.tag += Scheduler_lap
+val sch_lap : unit Runtime_events.User.t
+val emit_sch_lap : unit -> unit
+
+type Runtime_events.User.tag += Unix_job_count
+val unix_job_count : int Runtime_events.User.t
+val emit_job_count : int -> unit
diff --git a/src/unix/dune b/src/unix/dune
@@ -54,7 +54,7 @@
  (public_name lwt.unix)
  (synopsis "Unix support for Lwt")
  (wrapped false)
- (libraries bigarray lwt ocplib-endian.bigstring threads unix runtime_events)
+ (libraries bigarray lwt ocplib-endian.bigstring threads unix)
  (install_c_headers lwt_features lwt_config lwt_unix)
  (foreign_stubs
   (language c)
diff --git a/src/unix/lwt_main.ml b/src/unix/lwt_main.ml
@@ -20,17 +20,11 @@ let yield = Lwt.pause
 let abandon_yielded_and_paused () =
   Lwt.abandon_paused ()
 
-type Runtime_events.User.tag += Scheduler_call
-let sch_call = Runtime_events.User.register "lwt-sch-call" Scheduler_call Runtime_events.Type.span
-
-type Runtime_events.User.tag += Scheduler_lap
-let sch_lap = Runtime_events.User.register "lwt-sch-lap" Scheduler_lap Runtime_events.Type.unit
-
 let run p =
   let rec run_loop () =
-    Runtime_events.User.write sch_lap ();
+    Lwt_rte.emit_sch_lap ();
     Lwt_unix.write_job_count_runtimte_event ();
-    Runtime_events.User.write (Lwt.Private.paused_count[@alert "-trespassing"]) (Lwt.paused_count ()) ;
+    Lwt_rte.emit_paused_count (Lwt.paused_count ()) ;
     match Lwt.poll p with
     | Some x ->
       x
@@ -52,9 +46,9 @@ let run p =
       run_loop ()
   in
 
-  Runtime_events.User.write sch_call Begin;
+  Lwt_rte.emit_sch_call_begin ();
   Fun.protect
-    ~finally:(fun () -> Runtime_events.User.write sch_call End)
+    ~finally:(fun () -> Lwt_rte.emit_sch_call_end ())
     (fun () -> run_loop ())
 
 let run_already_called = ref `No
diff --git a/src/unix/lwt_main.mli b/src/unix/lwt_main.mli
@@ -129,11 +129,3 @@ module Exit_hooks :
 val at_exit : (unit -> unit Lwt.t) -> unit
 (** [Lwt_main.at_exit hook] is the same as
     [ignore (Lwt_main.Exit_hooks.add_first hook)]. *)
-
-(** scheduler call span event: spanning the execution of [Lwt_main.run] *)
-type Runtime_events.User.tag += Scheduler_call
-val sch_call : Runtime_events.Type.span Runtime_events.User.t
-
-(** scheduler lap event: once per iteration of the scheduler *)
-type Runtime_events.User.tag += Scheduler_lap
-val sch_lap : unit Runtime_events.User.t
diff --git a/src/unix/lwt_unix.cppo.ml b/src/unix/lwt_unix.cppo.ml
@@ -2555,6 +2555,4 @@ struct
   let send_msg_2 = send_msg
 end
 
-type Runtime_events.User.tag += Unix_job_count
-let unix_job_count = Runtime_events.User.register "lwt-unix-job-count" Unix_job_count Runtime_events.Type.int
-let write_job_count_runtimte_event () = Runtime_events.User.write unix_job_count !job_count
+let write_job_count_runtimte_event () = Lwt_rte.emit_job_count !job_count
diff --git a/test/stall_detection/dune b/test/stall_detection/dune
@@ -6,9 +6,9 @@
 (executable
   (name detector)
   (enabled_if (>= %{ocaml_version} 5.4))
-  (libraries lwt lwt.unix runtime_events))
+  (libraries lwt lwt.unix runtime_events lwt_runtime_events))
 
 (executable
   (name selfdetector)
   (enabled_if (>= %{ocaml_version} 5.4))
-  (libraries unix lwt lwt.unix runtime_events))
+  (libraries unix lwt lwt.unix runtime_events lwt_runtime_events))
diff --git a/test/stall_detection/stallerlib.ml b/test/stall_detection/stallerlib.ml
@@ -48,7 +48,7 @@ let detect ?ringopt () =
         Runtime_events.Type.unit
         (fun _ t e () ->
           match Runtime_events.User.tag e with
-          | Lwt_main.Scheduler_lap ->
+          | Lwt_runtime_events.Scheduler_lap ->
               alarmed := false;
               last_lap := Runtime_events.Timestamp.to_int64 t
           | _ -> ())
