Lwt 6 (NOT FOR MERGE AS IS)

.github/workflows/workflow.yml

@@ -17,33 +17,28 @@ jobs:
         os:
           - ubuntu-latest
         ocaml-compiler:
-          - "4.08"
-          - "4.09"
-          - "4.10"
-          - "4.11"
-          - "4.12"
-          - "4.13"
           - "4.14"
           - "5.0"
           - "5.1"
           - "5.2"
           - "5.3"
+          - "5.4"
         libev:
           - true
           - false
         include:
           - os: ubuntu-24.04-arm
-            ocaml-compiler: "5.3"
+            ocaml-compiler: "5.4"
             libev: false
           - os: macos-latest
-            ocaml-compiler: "5.3"
+            ocaml-compiler: "5.4"
             libev: false
           - os: windows-latest
-            ocaml-compiler: "5.3"
+            ocaml-compiler: "5.4"
             libev: false
           - os: ubuntu-latest
-            ocaml-name: "5.3.0+32bit"
-            ocaml-compiler: "ocaml-variants.5.3.0+options,ocaml-option-32bit"
+            ocaml-name: "5.4.0+32bit"
+            ocaml-compiler: "ocaml-variants.5.4.0+options,ocaml-option-32bit"
             libev: false
 
 
@@ -63,7 +58,7 @@ jobs:
           ocaml-compiler: ${{ matrix.ocaml-compiler }}
 
       - name: set ppx-related variables
-        id: configppx
+        id: configpackages
         shell: bash
         run: |
           opam exec -- ocaml src/util/letppx.ml
@@ -75,14 +70,32 @@ jobs:
       - run: opam install ./lwt.opam ./lwt_react.opam ./lwt_retry.opam ./lwt_ppx.opam --deps-only --with-test
 
       - run: opam install ./lwt_ppx__ppx_let_tests.opam --deps-only --with-test
-        if: ${{ fromJSON(steps.configppx.outputs.letppx) }}
+        if: ${{ fromJSON(steps.configpackages.outputs.letppx) }}
+
+      - run: opam install ./lwt_direct.opam --deps-only --with-test
+        if: ${{ fromJSON(steps.configpackages.outputs.direct) }}
+
+      - run: opam install ./lwt_runtime_events.opam --deps-only --with-test
+        if: ${{ fromJSON(steps.configpackages.outputs.runtime_events) }}
 
       - run: opam exec -- dune build --only-packages lwt,lwt_react,lwt_retry
 
       - run: opam exec -- dune build --only-packages lwt,lwt_ppx__ppx_let_tests
-        if: ${{ fromJSON(steps.configppx.outputs.letppx) }}
+        if: ${{ fromJSON(steps.configpackages.outputs.letppx) }}
+
+      - run: opam exec -- dune build --only-packages lwt,lwt_direct
+        if: ${{ fromJSON(steps.configpackages.outputs.direct) }}
+
+      - run: opam exec -- dune build --only-packages lwt,lwt_runtime_events
+        if: ${{ fromJSON(steps.configpackages.outputs.runtime_events) }}
 
       - run: opam exec -- dune runtest --only-packages lwt,lwt_react,lwt_retry,lwt_ppx
 
       - run: opam exec -- dune runtest --only-packages lwt,lwt_ppx__ppx_let_tests
-        if: ${{ fromJSON(steps.configppx.outputs.letppx) }}
+        if: ${{ fromJSON(steps.configpackages.outputs.letppx) }}
+
+      - run: opam exec -- dune runtest --only-packages lwt,lwt_direct
+        if: ${{ fromJSON(steps.configpackages.outputs.direct) }}
+
+      - run: opam exec -- dune runtest --only-packages lwt,lwt_runtime_events
+        if: ${{ fromJSON(steps.configpackages.outputs.runtime_events) }}

.gitignore

@@ -5,10 +5,6 @@ src/unix/discover_arguments
 # OPAM 2.0 local switches.
 _opam
 
-# Coverage analysis.
-bisect*.out
-_coverage/
-
 # For local work, tests, etc.
 scratch/
 

CHANGES

@@ -1,4 +1,14 @@
-===== 5.10.0 =====
+===== 6.0.0+dev =====
+
+====== Additions ======
+
+  * Lwt_direct using Lwt in direct-style. (Simon Cruanes, #1060)
+
+  * Support multiple scheduler running in parallel in separate domains.
+
+  * Exception filter defaults to letting systems exceptions through.
+
+===== 5.10.0+dev =====
 
 ====== Misc
 

Makefile

@@ -55,7 +55,6 @@ clean :
 	dune clean
 	rm -fr docs/api
 	rm -f src/unix/discover_arguments
-	rm -rf _coverage/
 
 EXPECTED_FILES := \
     --expect src/core/ \
@@ -65,10 +64,3 @@ EXPECTED_FILES := \
     --do-not-expect src/unix/lwt_gc.ml \
     --do-not-expect src/unix/lwt_throttle.ml \
     --do-not-expect src/unix/unix_c/
-
-.PHONY: coverage
-coverage :
-	dune runtest --instrument-with bisect_ppx --force
-	bisect-ppx-report html $(EXPECTED_FILES)
-	bisect-ppx-report summary
-	@echo See _coverage/index.html

dune

@@ -0,0 +1,3 @@
+;; marking those as data-only so that CIs and other automated systems don't try
+;; to build
+(data_only_dirs examples)

dune-project

@@ -26,12 +26,12 @@
 
 (package
  (name lwt_ppx)
- (version 5.9.2+dev)
+ (version 6.0.0-beta01)
  (synopsis "PPX syntax for Lwt, providing something similar to async/await from JavaScript")
  (depends
   (ocaml (>= 4.08))
   (ppxlib (>= 0.36))
-  (lwt (>= 5.7))))
+  (lwt (>= 6))))
 
 (package
  (name lwt_ppx__ppx_let_tests)
@@ -52,9 +52,28 @@
   (lwt (>= 3.0))
   (react (>= 1.0))))
 
+(package
+ (name lwt_direct)
+ (version 6.0.0-beta01)
+ (synopsis "Direct-style control-flow and `await` for Lwt")
+ (authors "Simon Cruanes")
+ (depends
+  (ocaml (>= 5.0))
+  base-unix
+  (lwt (>= 6))))
+
+(package
+ (name lwt_runtime_events)
+ (version 6.0.0-beta01)
+ (synopsis "Emit runtime events to trace the execution of Lwt programs")
+ (authors "Raphaël Proust")
+ (depends
+  (ocaml (>= 5.1))
+  ))
+
 (package
  (name lwt)
- (version 5.9.2+dev)
+ (version 6.0.0-beta01)
  (synopsis "Promises and event-driven I/O")
  (description "A promise is a value that may become determined in the future.
 
@@ -66,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 (>= 4.08))
+  (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))

examples/stall_detection/README.md

@@ -0,0 +1,26 @@
+# Stall detector
+
+In this directory is a demo for live-monitoring runtime-events and detecting
+stalls (extended periods of time when the Lwt main loop is not entered).
+
+Stalls happen when too many of the promises make too many blocking calls. In the
+example here (`Stallerlib.stall`) it's one promise which does increasingly long
+blocking calls to `Unix.sleepf`. Stalls can also happen with many short blocking
+calls (e.g., many promises logging to a file in a blocking way). Stalls
+can also happen if promises execute long computations.
+
+## Detection
+
+The detection relies on two mechanism. The first mechanism polls the runtime
+event ring to record the latest occurrence of Lwt scheduler's events. The second
+mechanism checks that this latest occurrence is recent enough.
+
+## selfdetector
+
+The `selfdetector.ml` file shows how to run the detector in the same process as
+the Lwt code. It runs in a separate domain so it executes in parallel.
+
+## staller + detector
+
+The `stall-detect.sh` runs separate processes for the Lwt-based program which
+stalls and a program which monitors the events of the first process.

examples/stall_detection/detector.ml

@@ -0,0 +1,2 @@
+let ringopt = (Sys.argv.(1), int_of_string Sys.argv.(2))
+let () = Stallerlib.detect ~ringopt ()

examples/stall_detection/dune

@@ -0,0 +1,14 @@
+(executable
+  (name staller)
+  (enabled_if (>= %{ocaml_version} 5.4))
+  (libraries lwt lwt.unix))
+
+(executable
+  (name detector)
+  (enabled_if (>= %{ocaml_version} 5.4))
+  (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 lwt_runtime_events))

examples/stall_detection/selfdetector.ml

@@ -0,0 +1,7 @@
+let () = Runtime_events.start ()
+
+let _ : _ Domain.t = Domain.spawn (fun () -> Stallerlib.detect ())
+
+let () =
+  Printf.printf "start\n"; flush stdout;
+  Lwt_main.run (Stallerlib.stall 0.)

examples/stall_detection/stall-detect.sh

@@ -0,0 +1,24 @@
+#!/bin/bash
+set -euo pipefail
+
+PROJECT_ROOT=./"$(git rev-parse --show-cdup)"
+dune build "$PROJECT_ROOT/_build/default/test/stall_detection/staller.exe"
+dune build "$PROJECT_ROOT/_build/default/test/stall_detection/detector.exe"
+
+RING_DIR=$(mktemp -d -t staller-detector.XXXXXX)
+
+OCAML_RUNTIME_EVENTS_DIR="$RING_DIR" "$PROJECT_ROOT"/_build/default/test/stall_detection/staller.exe &
+STALLER_PID=$!
+
+echo "staller started"
+
+sleep 0.1
+
+"$PROJECT_ROOT/_build/default/test/stall_detection/detector.exe" "$RING_DIR" "$STALLER_PID"
+
+echo "detector started"
+
+# Optional: wait for both processes to finish
+wait
+
+rm -f "$STALLER_PID.events"

examples/stall_detection/staller.ml

@@ -0,0 +1,4 @@
+let () = Runtime_events.start ()
+
+let () = Unix.sleep 2
+let () = Lwt_main.run (Stallerlib.stall 0.)

examples/stall_detection/stallerlib.ml

@@ -0,0 +1,62 @@
+(* STALLING *)
+
+let () = Random.self_init ()
+
+let to_s_ns f =
+  let ns = int_of_float (f *. 1_000_000_000.) in
+  (ns / 1_000_000_000 , ns mod 1_000_000_000)
+
+let rec stall d =
+  let open Lwt.Syntax in
+  let s, ns = to_s_ns d in
+  Printf.printf "stalling for %d.%09d\n" s ns;
+  flush stdout;
+  Unix.sleepf d;
+  let* () = Lwt.pause () in
+  if d > 3. then exit 2 else stall (1.2*.(d+. Random.float 0.05))
+
+
+(* DETECTING *)
+
+(* set to maxint to avoid the first hit being a false positive *)
+let last_lap = ref Int64.max_int
+let alarmed = ref false
+
+let detect ?ringopt () =
+  begin match ringopt with
+  | None -> Printf.printf "starting detection on self (%d)\n" (Unix.getpid ())
+  | Some (path, pid) -> Printf.printf "starting detection on %s/%d.events\n" path pid
+  end;
+  flush stdout;
+  let cursor = Runtime_events.create_cursor ringopt in
+  let is_stall t =
+    let delta = Int64.sub (Runtime_events.Timestamp.to_int64 t) !last_lap in
+    if delta > 1_000_000_000L (* 1 second *) then begin
+      Printf.printf "ALARM: stall 1s+ CRASHING\n"; flush stdout;
+      (match ringopt with
+      | None -> exit 1
+      | Some (_, pid) -> Unix.kill pid Sys.sigkill)
+    end;
+    if not !alarmed && delta > 500_000_000L (* 0.5 second *) then begin
+      alarmed := true;
+      Printf.printf "ALARM: stall .5s+\n"; flush stdout
+    end
+  in
+  let cb =
+    Runtime_events.Callbacks.create ()
+    |> Runtime_events.Callbacks.add_user_event
+        Runtime_events.Type.unit
+        (fun _ t e () ->
+          match Runtime_events.User.tag e with
+          | Lwt_runtime_events.Scheduler_lap ->
+              alarmed := false;
+              last_lap := Runtime_events.Timestamp.to_int64 t
+          | _ -> ())
+  in
+  let rec detect () =
+    Unix.sleepf 0.01;
+    let _ : int = Runtime_events.read_poll cursor cb None in
+    is_stall (Runtime_events.Timestamp.get_current ());
+    detect ()
+  in
+  detect ()

examples/tracing/README.md

@@ -0,0 +1,9 @@
+# Tail tracing
+
+This is a demo for producing a tail-trace for an Lwt program. The Lwt program
+emits tracing events as introduced by the ppx. A separate program monitors the
+execution of the Lwt program process and, upon a crash, it gets the content of
+the events ring-buffer and dumps it into a perfetto-compatible format.
+
+The produced trace shows the trace of execution for the end of the program, the
+part leading to its crash. This is called "tail tracing."

examples/tracing/dune

@@ -0,0 +1,11 @@
+(executable
+  (name work_and_crash)
+  (enabled_if (>= %{ocaml_version} 5.4))
+  (libraries lwt lwt.unix)
+  (preprocess
+   (pps lwt_ppx)))
+
+(executable
+  (name tailgate)
+  (enabled_if (>= %{ocaml_version} 5.4))
+  (libraries unix runtime_events lwt_runtime_events))