Lwt 6 (NOT FOR MERGE AS IS)

.github/workflows/workflow.yml

@@ -15,12 +15,6 @@ jobs:
         os:
           - ubuntu-latest
         ocaml-compiler:
-          - "4.08"
-          - "4.09"
-          - "4.10"
-          - "4.11"
-          - "4.12"
-          - "4.13"
           - "4.14"
           - "5.0"
           - "5.1"
@@ -43,24 +37,42 @@ jobs:
     runs-on: ${{ matrix.os }}
 
     steps:
-      - name: set ppx-related variables
-        id: configppx
+      - name: set version-dependent variables
+        id: configpkgs
         shell: bash
         run: |
+          opampkgs="./lwt.opam ./lwt_react.opam ./lwt_retry.opam ./lwt_ppx.opam"
+          dunepkgs="lwt,lwt_react,lwt_retry,lwt_ppx"
           case ${{ matrix.ocaml-compiler }} in
-            "4.08"|"4.09"|"4.10"|"4.11"|"4.12"|"4.13"|"4.14"|"5.0")
-              echo "letppx=false"
-              echo "letppx=false" >> "$GITHUB_OUTPUT"
+            "4.14"|"5.0")
+              :
               ;;
             "5.1"|"5.2"|"5.3")
-              echo "letppx=true"
-              echo "letppx=true" >> "$GITHUB_OUTPUT"
+              opampkgs="${opampkgs} ./lwt_ppx__ppx_let_tests.opam"
+              dunepkgs="${dunepkgs},lwt_ppx__ppx_let_tests"
               ;;
             *)
               printf "unrecognised version %s\n" "${{ matrix.ocaml-compiler }}";
               exit 1
               ;;
           esac
+          case ${{ matrix.ocaml-compiler }} in
+            "4.14")
+              :
+              ;;
+            "5.0"|"5.1"|"5.2"|"5.3")
+              opampkgs="${opampkgs} ./lwt_direct.opam"
+              dunepkgs="${dunepkgs},lwt_direct"
+              ;;
+            *)
+              printf "unrecognised version %s\n" "${{ matrix.ocaml-compiler }}";
+              exit 1
+              ;;
+          esac
+          echo "opampkgs=${opampkgs}"
+          echo "opampkgs=${opampkgs}" >> "$GITHUB_OUTPUT"
+          echo "dunepkgs=${dunepkgs}"
+          echo "dunepkgs=${dunepkgs}" >> "$GITHUB_OUTPUT"
 
       - name: Checkout tree
         uses: actions/checkout@v5
@@ -73,20 +85,11 @@ jobs:
       - run: opam install conf-libev
         if: ${{ matrix.libev == true }}
 
-      - 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) }}
-
-      - 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) }}
+      - run: opam install --deps-only --with-test ${{ steps.configpkgs.outputs.opampkgs }}
 
-      - run: opam exec -- dune runtest --only-packages lwt,lwt_react,lwt_retry,lwt_ppx
+      - run: opam exec -- dune build --only-packages ${{ steps.configpkgs.outputs.dunepkgs }}
 
-      - run: opam exec -- dune runtest --only-packages lwt,lwt_ppx__ppx_let_tests
-        if: ${{ fromJSON(steps.configppx.outputs.letppx) }}
+      - run: opam exec -- dune runtest --only-packages ${{ steps.configpkgs.outputs.dunepkgs }}
 
   lint-opam:
     runs-on: ubuntu-latest

.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-project

@@ -52,9 +52,19 @@
   (lwt (>= 3.0))
   (react (>= 1.0))))
 
+(package
+ (name lwt_direct)
+ (version 6.0.0~beta00)
+ (synopsis "Direct-style control-flow and `await` for Lwt")
+ (authors "Simon Cruanes")
+ (depends
+  (ocaml (>= 5.0))
+  base-unix
+  (lwt (>= 6))))
+
 (package
  (name lwt)
- (version 5.9.2+dev)
+ (version 6.0.0~beta00)
  (synopsis "Promises and event-driven I/O")
  (description "A promise is a value that may become determined in the future.
 
@@ -66,7 +76,8 @@ 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))
+  domain_shims
   (cppo (and :build (>= 1.1)))
   (ocamlfind (and :dev (>= 1.7.3-1)))
   (odoc (and :with-doc (>= 2.3)))

lwt.opam

@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "5.9.2+dev"
+version: "6.0.0~beta00"
 synopsis: "Promises and event-driven I/O"
 description: """
 A promise is a value that may become determined in the future.
@@ -22,7 +22,8 @@ doc: "https://ocsigen.org/lwt"
 bug-reports: "https://github.com/ocsigen/lwt/issues"
 depends: [
   "dune" {>= "3.15"}
-  "ocaml" {>= "4.08"}
+  "ocaml" {>= "4.14"}
+  "domain_shims"
   "cppo" {build & >= "1.1"}
   "ocamlfind" {dev & >= "1.7.3-1"}
   "odoc" {with-doc & >= "2.3"}

lwt_direct.opam

@@ -0,0 +1,34 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+version: "6.0.0~beta00"
+synopsis: "Direct-style control-flow and `await` for Lwt"
+maintainer: [
+  "Raphaël Proust <[email protected]>" "Anton Bachin <[email protected]>"
+]
+authors: ["Simon Cruanes"]
+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.0"}
+  "base-unix"
+  "lwt" {>= "6"}
+  "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"

src/core/domain_map.ml

@@ -0,0 +1,57 @@
+module Domain_map : Map.S with type key = Domain.id = Map.Make(struct
+  type t = Domain.id
+  let compare d1 d2 = Int.compare (d1 : Domain.id :> int) (d2 : Domain.id :> int)
+end)
+
+(* Protected domain map reference with per-reference mutex *)
+type 'a protected_map = {
+  mutex : Mutex.t;
+  mutable map : 'a Domain_map.t;
+}
+
+let create_protected_map () = {
+  mutex = Mutex.create ();
+  map = Domain_map.empty;
+}
+
+let with_lock protected_map f =
+  Mutex.lock protected_map.mutex;
+  Fun.protect f ~finally:(fun () -> Mutex.unlock protected_map.mutex)
+
+let update_map protected_map f =
+  with_lock protected_map (fun () ->
+    let old_map = protected_map.map in
+    let new_map = f old_map in
+    protected_map.map <- new_map)
+
+let add protected_map key value =
+  update_map protected_map (Domain_map.add key value)
+
+let remove protected_map key =
+  update_map protected_map (Domain_map.remove key)
+
+let update protected_map key f =
+  update_map protected_map (Domain_map.update key f)
+
+let find protected_map key =
+  with_lock protected_map (fun () -> Domain_map.find_opt key protected_map.map)
+
+let extract protected_map key =
+  with_lock protected_map (fun () ->
+    match Domain_map.find_opt key protected_map.map with
+    | None -> None
+    | Some v ->
+        protected_map.map <- Domain_map.remove key protected_map.map;
+        Some v)
+
+let size protected_map =
+  with_lock protected_map (fun () -> Domain_map.cardinal protected_map.map)
+
+let init protected_map key init_value =
+  with_lock protected_map (fun () ->
+    match Domain_map.find_opt key protected_map.map with
+    | Some existing -> existing
+    | None ->
+        let new_value = init_value () in
+        protected_map.map <- Domain_map.add key new_value protected_map.map;
+        new_value)

src/core/domain_map.mli

@@ -0,0 +1,38 @@
+(** Domain-indexed maps with thread-safe operations
+
+    Only intended to use internally, not for general release.
+
+    Note that these function use a lock. A single lock.
+    - Probably not optimal
+    - Deadlock if you call one of those functions inside another (e.g., use
+    `init` rather than `find`+`update`
+ *)
+
+(** Thread-safe wrapper for domain maps *)
+type 'a protected_map
+
+(** Create a new protected map with an empty map inside and a dedicated mutex,
+    the map is keyed on domain ids, and operations are synchronised via a mutex.
+    *)
+val create_protected_map : unit -> 'a protected_map
+
+(** Add a key-value binding to the map *)
+val add : 'a protected_map -> Domain.id -> 'a -> unit
+
+(** Remove a key from the map *)
+val remove : 'a protected_map -> Domain.id -> unit
+
+(** Update a binding using the underlying map's update function *)
+val update : 'a protected_map -> Domain.id -> ('a option -> 'a option) -> unit
+
+(** Find a value by key, returning None if not found *)
+val find : 'a protected_map -> Domain.id -> 'a option
+
+(** Find + remove but hit the mutex only once *)
+val extract : 'a protected_map -> Domain.id -> 'a option
+
+(** Get the number of bindings in the map *)
+val size : 'a protected_map -> int
+
+(** Initialize a key with a value if it doesn't exist, return existing or new value *)
+val init : 'a protected_map -> Domain.id -> (unit -> 'a) -> 'a

src/core/dune

@@ -2,8 +2,7 @@
  (public_name lwt)
  (synopsis "Monadic promises and concurrent I/O")
  (wrapped false)
- (instrumentation
-  (backend bisect_ppx)))
+ (libraries domain_shims))
 
 (documentation
  (package lwt))