From 06a21d8800d247fce7d2b458376067c44f848e9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Fri, 22 Aug 2025 11:29:08 +0200 Subject: [PATCH 01/15] prepare for 5.9.2 - add versions - revert recent tcp breaking changes (breaking changes go in 5.10) --- dune-project | 2 ++ lwt.opam | 1 + lwt_ppx.opam | 1 + src/unix/lwt_io.ml | 40 +++++++++------------------------------- src/unix/lwt_io.mli | 29 +---------------------------- 5 files changed, 14 insertions(+), 59 deletions(-) diff --git a/dune-project b/dune-project index c1b5de487..8da642c4f 100644 --- a/dune-project +++ b/dune-project @@ -25,6 +25,7 @@ (package (name lwt_ppx) + (version 5.9.2) (synopsis "PPX syntax for Lwt, providing something similar to async/await from JavaScript") (depends (ocaml (>= 4.08)) @@ -51,6 +52,7 @@ (package (name lwt) + (version 5.9.2) (synopsis "Promises and event-driven I/O") (description "A promise is a value that may become determined in the future. diff --git a/lwt.opam b/lwt.opam index cc46cfca7..b259ec4fb 100644 --- a/lwt.opam +++ b/lwt.opam @@ -1,5 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" +version: "5.9.2" synopsis: "Promises and event-driven I/O" description: """ A promise is a value that may become determined in the future. diff --git a/lwt_ppx.opam b/lwt_ppx.opam index 022bf0d79..eb8b6df2c 100644 --- a/lwt_ppx.opam +++ b/lwt_ppx.opam @@ -1,5 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" +version: "5.9.2" synopsis: "PPX syntax for Lwt, providing something similar to async/await from JavaScript" maintainer: [ diff --git a/src/unix/lwt_io.ml b/src/unix/lwt_io.ml index 88cbbc60b..f7c5afb1c 100644 --- a/src/unix/lwt_io.ml +++ b/src/unix/lwt_io.ml @@ -1553,7 +1553,7 @@ let close_socket fd = (fun () -> Lwt_unix.close fd) -let open_connection ?fd ?(set_tcp_nodelay=true) ?(prepare_fd=ignore) ?in_buffer ?out_buffer sockaddr = +let open_connection ?fd ?in_buffer ?out_buffer sockaddr = let fd = match fd with | None -> @@ -1561,10 +1561,6 @@ let open_connection ?fd ?(set_tcp_nodelay=true) ?(prepare_fd=ignore) ?in_buffer | Some fd -> fd in - - if set_tcp_nodelay then Lwt_unix.setsockopt fd Unix.TCP_NODELAY true; - prepare_fd fd; - let close = lazy (close_socket fd) in Lwt.catch (fun () -> @@ -1590,8 +1586,8 @@ let with_close_connection f (ic, oc) = (fun () -> f (ic, oc)) (fun () -> close_if_not_closed ic <&> close_if_not_closed oc) -let with_connection ?fd ?set_tcp_nodelay ?prepare_fd ?in_buffer ?out_buffer sockaddr f = - open_connection ?fd ?set_tcp_nodelay ?prepare_fd ?in_buffer ?out_buffer sockaddr >>= fun channels -> +let with_connection ?fd ?in_buffer ?out_buffer sockaddr f = + open_connection ?fd ?in_buffer ?out_buffer sockaddr >>= fun channels -> with_close_connection f channels type server = { @@ -1609,9 +1605,6 @@ let shutdown_server_deprecated server = let establish_server_generic bind_function ?fd:preexisting_socket_for_listening - ?(set_tcp_nodelay=true) - ?(prepare_listening_fd=ignore) - ?(prepare_client_fd=ignore) ?(backlog = Lwt_unix.somaxconn () [@ocaml.warning "-3"]) listening_address connection_handler_callback = @@ -1625,7 +1618,6 @@ let establish_server_generic socket in Lwt_unix.setsockopt listening_socket Unix.SO_REUSEADDR true; - prepare_listening_fd listening_socket; (* This promise gets resolved with `Should_stop when the user calls Lwt_io.shutdown_server. This begins the shutdown procedure. *) @@ -1653,13 +1645,10 @@ let establish_server_generic Lwt.pick [try_to_accept; should_stop] >>= function | `Accepted (client_socket, client_address) -> begin - try - Lwt_unix.set_close_on_exec client_socket + try Lwt_unix.set_close_on_exec client_socket with Invalid_argument _ -> () end; - if set_tcp_nodelay then Lwt_unix.setsockopt client_socket Unix.TCP_NODELAY true; - prepare_client_fd client_socket; connection_handler_callback client_address client_socket; accept_loop () @@ -1701,9 +1690,7 @@ let establish_server_generic server, server_has_started let establish_server_with_client_socket - ?server_fd ?backlog ?(no_close = false) - ?set_tcp_nodelay ?prepare_listening_fd ?prepare_client_fd - sockaddr f = + ?server_fd ?backlog ?(no_close = false) sockaddr f = let handler client_address client_socket = Lwt.async begin fun () -> (* Not using Lwt.finalize here, to make sure that exceptions from [f] @@ -1731,9 +1718,7 @@ let establish_server_with_client_socket let server, server_started = establish_server_generic - Lwt_unix.bind ?fd:server_fd ?backlog - ?set_tcp_nodelay ?prepare_listening_fd ?prepare_client_fd - sockaddr handler + Lwt_unix.bind ?fd:server_fd ?backlog sockaddr handler in server_started >>= fun () -> Lwt.return server @@ -1744,7 +1729,6 @@ let establish_server_with_client_address_generic ?(buffer_size = !default_buffer_size) ?backlog ?(no_close = false) - ?set_tcp_nodelay ?prepare_listening_fd ?prepare_client_fd sockaddr handler = @@ -1800,19 +1784,13 @@ let establish_server_with_client_address_generic best_effort_close output_channel) in - establish_server_generic bind_function ?fd ?backlog - ?set_tcp_nodelay ?prepare_listening_fd ?prepare_client_fd - sockaddr handler + establish_server_generic bind_function ?fd ?backlog sockaddr handler let establish_server_with_client_address - ?fd ?buffer_size ?backlog ?no_close - ?set_tcp_nodelay ?prepare_listening_fd ?prepare_client_fd - sockaddr handler = + ?fd ?buffer_size ?backlog ?no_close sockaddr handler = let server, server_started = establish_server_with_client_address_generic - Lwt_unix.bind ?fd ?buffer_size ?backlog ?no_close - ?set_tcp_nodelay ?prepare_listening_fd ?prepare_client_fd - sockaddr handler + Lwt_unix.bind ?fd ?buffer_size ?backlog ?no_close sockaddr handler in server_started >>= fun () -> Lwt.return server diff --git a/src/unix/lwt_io.mli b/src/unix/lwt_io.mli index 587195d41..fd104af4e 100644 --- a/src/unix/lwt_io.mli +++ b/src/unix/lwt_io.mli @@ -559,8 +559,6 @@ val delete_recursively : string -> unit Lwt.t val open_connection : ?fd : Lwt_unix.file_descr -> - ?set_tcp_nodelay:bool -> - ?prepare_fd: (Lwt_unix.file_descr -> unit) -> ?in_buffer : Lwt_bytes.t -> ?out_buffer : Lwt_bytes.t -> Unix.sockaddr -> (input_channel * output_channel) Lwt.t (** [open_connection ?fd ?in_buffer ?out_buffer addr] opens a @@ -571,31 +569,15 @@ val open_connection : channels. @raise Unix.Unix_error on error. - - @param set_tcp_nodelay if true, [TCP_NODELAY] is set on the socket FD. This - avoids a surprising 40ms delay in some situations. - See for example https://brooker.co.za/blog/2024/05/09/nagle.html for why. - - @param prepare_fd is a custom callback that can be used to modify the socket FD - before it is turned into high level channels. - - For example passing - [~prepare_fd:(fun fd -> Lwt_unix.setsockopt_int fd SO_SNDBUF 65_536)] - will set the socket's send buffer's size to 64kiB. *) val with_connection : ?fd : Lwt_unix.file_descr -> - ?set_tcp_nodelay:bool -> - ?prepare_fd: (Lwt_unix.file_descr -> unit) -> ?in_buffer : Lwt_bytes.t -> ?out_buffer : Lwt_bytes.t -> Unix.sockaddr -> (input_channel * output_channel -> 'a Lwt.t) -> 'a Lwt.t (** [with_connection ?fd ?in_buffer ?out_buffer addr f] opens a connection to the given address and passes the channels to - [f] - - See {!open_connection} for more details about [set_tcp_nodelay] - and [prepare_fd]. *) + [f] *) (**/**) @@ -619,9 +601,6 @@ val establish_server_with_client_socket : ?server_fd:Lwt_unix.file_descr -> ?backlog:int -> ?no_close:bool -> - ?set_tcp_nodelay:bool -> - ?prepare_listening_fd:(Lwt_unix.file_descr -> unit) -> - ?prepare_client_fd:(Lwt_unix.file_descr -> unit) -> Unix.sockaddr -> (Lwt_unix.sockaddr -> Lwt_unix.file_descr -> unit Lwt.t) -> server Lwt.t @@ -669,9 +648,6 @@ f client_address client_socket started listening on [listen_address]: right after the internal call to [listen], and right before the first internal call to [accept]. - See {!open_connection} for more details about [set_tcp_nodelay] - and [prepare_fd]. - @since 4.1.0 *) val establish_server_with_client_address : @@ -679,9 +655,6 @@ val establish_server_with_client_address : ?buffer_size:int -> ?backlog:int -> ?no_close:bool -> - ?set_tcp_nodelay:bool -> - ?prepare_listening_fd:(Lwt_unix.file_descr -> unit) -> - ?prepare_client_fd:(Lwt_unix.file_descr -> unit) -> Unix.sockaddr -> (Lwt_unix.sockaddr -> input_channel * output_channel -> unit Lwt.t) -> server Lwt.t From ca1646c405ec150bd80ef2c4fdb48d9dde719d08 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Fri, 22 Aug 2025 14:09:20 +0200 Subject: [PATCH 02/15] update CHANGES --- CHANGES | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/CHANGES b/CHANGES index 76a6cdb80..efcea74b9 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,21 @@ +===== 5.9.1 ===== + +====== Packaging ====== + + * lwt_ppx is compatible with newer versions of ppxlib. (Patrick Ferris, Kate Deplaix, Sora Morimoto, #1033) + +====== Other ====== + + * Misc repository maintenance. (Sora Morimoto) + + * Misc typo. (Kaustubh Maske Patil, #1056) + +===== 5.9.1 ===== + +====== Fixes ====== + + * META files now carry version information. (Hugo Heuzard, #1042, #1053) + ===== 5.9.0 ===== ====== Additions ====== @@ -14,6 +32,12 @@ * Misc repository maintenance. (Sora Morimoto, Shon Feder, #1037, #1035) +===== 5.8.1 ===== + +====== Fixes ====== + + * META files now carry version information. (Hugo Heuzard, #1042, #1053) + ===== 5.8.0 ===== ====== Improvements ====== From a0edd1f4099e8d14f7106c2a4bc89f95a40441da Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Fri, 22 Aug 2025 14:12:51 +0200 Subject: [PATCH 03/15] restore original authroship of lwt_ppx this has been overwritten when switching to dune-project --- dune-project | 1 + lwt_ppx.opam | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/dune-project b/dune-project index 8da642c4f..d3bd18345 100644 --- a/dune-project +++ b/dune-project @@ -26,6 +26,7 @@ (package (name lwt_ppx) (version 5.9.2) + (authors "Gabriel Radanne") (synopsis "PPX syntax for Lwt, providing something similar to async/await from JavaScript") (depends (ocaml (>= 4.08)) diff --git a/lwt_ppx.opam b/lwt_ppx.opam index eb8b6df2c..b6e4bb311 100644 --- a/lwt_ppx.opam +++ b/lwt_ppx.opam @@ -6,7 +6,7 @@ synopsis: maintainer: [ "Raphaël Proust " "Anton Bachin " ] -authors: ["Jérôme Vouillon" "Jérémie Dimino"] +authors: ["Gabriel Radanne"] license: "MIT" homepage: "https://github.com/ocsigen/lwt" doc: "https://ocsigen.org/lwt" From dac315d0e91fa64862986ff31fb15b1683ccf013 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Tue, 30 Dec 2025 16:21:57 +0100 Subject: [PATCH 04/15] ppx: add test for #1085, add standalone ppx executable --- src/ppx/dune | 8 ++++++++ src/ppx/ppx_lwt_standalone.ml | 1 + test/ppx/main.ml | 7 +++++++ 3 files changed, 16 insertions(+) create mode 100644 src/ppx/ppx_lwt_standalone.ml diff --git a/src/ppx/dune b/src/ppx/dune index 1a48fc938..ddaebcda5 100644 --- a/src/ppx/dune +++ b/src/ppx/dune @@ -2,9 +2,17 @@ (public_name lwt_ppx) (synopsis "Lwt PPX syntax extension") (libraries ppxlib) + (modules ppx_lwt) (ppx_runtime_libraries lwt) (kind ppx_rewriter) (preprocess (pps ppxlib.metaquot)) (instrumentation (backend bisect_ppx))) + +(executable + (name ppx_lwt_standalone) + (modules ppx_lwt_standalone) + (libraries + lwt_ppx + ppxlib)) diff --git a/src/ppx/ppx_lwt_standalone.ml b/src/ppx/ppx_lwt_standalone.ml new file mode 100644 index 000000000..e3cba4049 --- /dev/null +++ b/src/ppx/ppx_lwt_standalone.ml @@ -0,0 +1 @@ +let () = Ppxlib.Driver.standalone () diff --git a/test/ppx/main.ml b/test/ppx/main.ml index 18db4bdad..a8c6fe95d 100644 --- a/test/ppx/main.ml +++ b/test/ppx/main.ml @@ -162,6 +162,13 @@ let suite = suite "ppx" [ (fun () -> Lwt.return structure_let_result ) ; + + (* as reported in https://github.com/ocsigen/lwt/issues/1085 *) + test "1085" + (fun () -> + let%lwt (_ : int) = Lwt.return 0 in + Lwt.return_true + ) ; ] let _ = Test.run "ppx" [ suite ] From 58b7566a5ece82bf54cbc9f44279beb6f9bb8f4e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Thu, 15 Jan 2026 15:56:15 +0100 Subject: [PATCH 05/15] =?UTF-8?q?fix=20ppx:=20correctly=20move=20constrain?= =?UTF-8?q?t=20in=20`let%lwt=20x=20:=20t=20=3D=20=E2=80=A6`=20expressions?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/ppx/ppx_lwt.ml | 13 +++++++++++-- test/ppx/main.ml | 2 +- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/src/ppx/ppx_lwt.ml b/src/ppx/ppx_lwt.ml index d9973b8b8..283885d96 100644 --- a/src/ppx/ppx_lwt.ml +++ b/src/ppx/ppx_lwt.ml @@ -56,7 +56,8 @@ let gen_name i = lwt_prefix ^ string_of_int i let gen_bindings l = let aux i binding = { binding with - pvb_pat = pvar ~loc:binding.pvb_expr.pexp_loc (gen_name i) + pvb_pat = pvar ~loc:binding.pvb_expr.pexp_loc (gen_name i); + pvb_constraint = None; } in List.mapi aux l @@ -72,7 +73,15 @@ let gen_binds e_loc l e = in let fun_ = let loc = e_loc in - [%expr (fun [%p binding.pvb_pat] -> [%e aux (i+1) t])] + match binding.pvb_constraint with + | None -> [%expr (fun [%p binding.pvb_pat] -> [%e aux (i+1) t])] + | Some (Pvc_constraint { locally_abstract_univars = []; typ }) -> [%expr (fun ([%p binding.pvb_pat] : [%t typ]) -> [%e aux (i+1) t])] +(* + | Some (Pvc_constraint { locally_abstract_univars = _::_; typ= _}) -> failwith "what to do here" + | Some (Pvc_coercion { ground = None; coercion }) -> [%expr (fun ([%p binding.pvb_pat] :> [%t coercion]) -> [%e aux (i+1) t])] + | Some (Pvc_coercion { ground = Some ground; coercion }) -> [%expr (fun ([%p binding.pvb_pat] : [%t ground] :> [%t coercion]) -> [%e aux (i+1) t])] +*) + | _ -> failwith "WIP: what to do here" in let new_exp = let loc = e_loc in diff --git a/test/ppx/main.ml b/test/ppx/main.ml index a8c6fe95d..a4b900334 100644 --- a/test/ppx/main.ml +++ b/test/ppx/main.ml @@ -164,7 +164,7 @@ let suite = suite "ppx" [ ) ; (* as reported in https://github.com/ocsigen/lwt/issues/1085 *) - test "1085" + test "1085-int" (fun () -> let%lwt (_ : int) = Lwt.return 0 in Lwt.return_true From 0c7c0b8dc48b9fe4c0df8abdc2a8385672abc912 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Fri, 16 Jan 2026 11:14:01 +0100 Subject: [PATCH 06/15] ppx: improve handling of value binding constraints --- src/ppx/ppx_lwt.ml | 31 +++++++++++++++++++++++++------ test/ppx/main.ml | 10 ++++++++++ 2 files changed, 35 insertions(+), 6 deletions(-) diff --git a/src/ppx/ppx_lwt.ml b/src/ppx/ppx_lwt.ml index 283885d96..b98ca9b4f 100644 --- a/src/ppx/ppx_lwt.ml +++ b/src/ppx/ppx_lwt.ml @@ -75,13 +75,32 @@ let gen_binds e_loc l e = let loc = e_loc in match binding.pvb_constraint with | None -> [%expr (fun [%p binding.pvb_pat] -> [%e aux (i+1) t])] - | Some (Pvc_constraint { locally_abstract_univars = []; typ }) -> [%expr (fun ([%p binding.pvb_pat] : [%t typ]) -> [%e aux (i+1) t])] -(* - | Some (Pvc_constraint { locally_abstract_univars = _::_; typ= _}) -> failwith "what to do here" - | Some (Pvc_coercion { ground = None; coercion }) -> [%expr (fun ([%p binding.pvb_pat] :> [%t coercion]) -> [%e aux (i+1) t])] - | Some (Pvc_coercion { ground = Some ground; coercion }) -> [%expr (fun ([%p binding.pvb_pat] : [%t ground] :> [%t coercion]) -> [%e aux (i+1) t])] + | Some (Pvc_constraint { locally_abstract_univars = []; typ }) -> + [%expr (fun ([%p binding.pvb_pat] : [%t typ]) -> [%e aux (i+1) t])] +(* TODO: I don't know how to trigger this + | Some constraint_ pv -> + begin match binding.pvb_pat.ppat_desc with + | Ppat_var pv -> + let e = + let open Ast_builder.Default in + pexp_let ~loc + Nonrecursive + [ + Latest.value_binding ~constraint_ + ~loc + ~pat:binding.pvb_pat + ~expr:(pexp_ident ~loc {loc=pv.loc; txt=Lident pv.txt}) + () + ] + (aux (i+1) t) + in + [%expr (fun [%p binding.pvb_pat] -> [%e e])] + | _ -> + Location.Error.(raise (make ~loc "unsupported value binding constraint" ~sub:[])) + end *) - | _ -> failwith "WIP: what to do here" + | _ -> + Location.Error.(raise (make ~loc "unsupported value binding constraint" ~sub:[])) in let new_exp = let loc = e_loc in diff --git a/test/ppx/main.ml b/test/ppx/main.ml index a4b900334..06a0ebe72 100644 --- a/test/ppx/main.ml +++ b/test/ppx/main.ml @@ -169,6 +169,16 @@ let suite = suite "ppx" [ let%lwt (_ : int) = Lwt.return 0 in Lwt.return_true ) ; + test "1085-int-again" + (fun () -> + let%lwt _ : int = Lwt.return 0 in + Lwt.return_true + ) ; + test "1085-any" + (fun () -> + let%lwt _ : _ = Lwt.return 0 in + Lwt.return_true + ) ; ] let _ = Test.run "ppx" [ suite ] From 252dca934fbc837908803eb0a1c0819817899300 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Fri, 16 Jan 2026 14:59:28 +0100 Subject: [PATCH 07/15] remove debugging-helper executable move it to examples/ causes dune errors in CI --- examples/ppx_lwt_standalone/dune | 10 ++++++++++ .../ppx_lwt_standalone}/ppx_lwt_standalone.ml | 0 src/ppx/dune | 7 ------- 3 files changed, 10 insertions(+), 7 deletions(-) create mode 100644 examples/ppx_lwt_standalone/dune rename {src/ppx => examples/ppx_lwt_standalone}/ppx_lwt_standalone.ml (100%) diff --git a/examples/ppx_lwt_standalone/dune b/examples/ppx_lwt_standalone/dune new file mode 100644 index 000000000..d29ce18f4 --- /dev/null +++ b/examples/ppx_lwt_standalone/dune @@ -0,0 +1,10 @@ +; causes build errors when in src/ppx (when building other packages but not this one) +; can't use (package lwt_ppx) because dune complains it'd be useless without a public_name +; so this lives in examples/ +(executable + (name ppx_lwt_standalone) + (modules ppx_lwt_standalone) + (libraries + lwt_ppx + ppxlib)) + diff --git a/src/ppx/ppx_lwt_standalone.ml b/examples/ppx_lwt_standalone/ppx_lwt_standalone.ml similarity index 100% rename from src/ppx/ppx_lwt_standalone.ml rename to examples/ppx_lwt_standalone/ppx_lwt_standalone.ml diff --git a/src/ppx/dune b/src/ppx/dune index ddaebcda5..0ed86ce05 100644 --- a/src/ppx/dune +++ b/src/ppx/dune @@ -9,10 +9,3 @@ (pps ppxlib.metaquot)) (instrumentation (backend bisect_ppx))) - -(executable - (name ppx_lwt_standalone) - (modules ppx_lwt_standalone) - (libraries - lwt_ppx - ppxlib)) From c6cdcf34e0f5c16a0c65c4d5a63992afe5bdbeef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Fri, 23 Jan 2026 11:40:29 +0100 Subject: [PATCH 08/15] also support type annotations at top-level --- src/ppx/ppx_lwt.ml | 35 +++++++++++++---------------------- test/ppx/main.ml | 2 +- 2 files changed, 14 insertions(+), 23 deletions(-) diff --git a/src/ppx/ppx_lwt.ml b/src/ppx/ppx_lwt.ml index b98ca9b4f..9d55f0c20 100644 --- a/src/ppx/ppx_lwt.ml +++ b/src/ppx/ppx_lwt.ml @@ -77,29 +77,8 @@ let gen_binds e_loc l e = | None -> [%expr (fun [%p binding.pvb_pat] -> [%e aux (i+1) t])] | Some (Pvc_constraint { locally_abstract_univars = []; typ }) -> [%expr (fun ([%p binding.pvb_pat] : [%t typ]) -> [%e aux (i+1) t])] -(* TODO: I don't know how to trigger this - | Some constraint_ pv -> - begin match binding.pvb_pat.ppat_desc with - | Ppat_var pv -> - let e = - let open Ast_builder.Default in - pexp_let ~loc - Nonrecursive - [ - Latest.value_binding ~constraint_ - ~loc - ~pat:binding.pvb_pat - ~expr:(pexp_ident ~loc {loc=pv.loc; txt=Lident pv.txt}) - () - ] - (aux (i+1) t) - in - [%expr (fun [%p binding.pvb_pat] -> [%e e])] - | _ -> - Location.Error.(raise (make ~loc "unsupported value binding constraint" ~sub:[])) - end -*) | _ -> + (* no support for more advanced type annotations *) Location.Error.(raise (make ~loc "unsupported value binding constraint" ~sub:[])) in let new_exp = @@ -367,6 +346,18 @@ class mapper = object (self) (Lwt_main.run [@ocaml.ppwarning [%e warning]]) [%e super#expression exp]] + | [%stri let%lwt [%p? var] : [%t? typ] = [%e? exp]] -> + let warning = + estring ~loc:!default_loc + ("let%lwt should not be used at the module item level.\n" ^ + "Replace let%lwt x = e by let x = Lwt_main.run (e)") + in + let loc = !default_loc in + [%stri + let [%p var] : [%t typ] = + (Lwt_main.run [@ocaml.ppwarning [%e warning]]) + [%e super#expression exp]] + | x -> super#structure_item x); end diff --git a/test/ppx/main.ml b/test/ppx/main.ml index 06a0ebe72..4f22b44c0 100644 --- a/test/ppx/main.ml +++ b/test/ppx/main.ml @@ -7,7 +7,7 @@ open Lwt an outer call to Lwt_main.run, and nested calls to Lwt_main.run are not allowed. *) [@@@ocaml.warning "-22"] -let%lwt structure_let_result = Lwt.return_true +let%lwt structure_let_result : bool = Lwt.return_true [@@@ocaml.warning "+22"] let suite = suite "ppx" [ From bfd18ca21965a348ff3fe0e09ffd822e07610cae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Tue, 27 Jan 2026 19:55:54 +0100 Subject: [PATCH 09/15] CHANGES and version bump --- CHANGES | 8 +++++++- dune-project | 2 +- lwt_ppx.opam | 2 +- 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/CHANGES b/CHANGES index efcea74b9..0f26858d5 100644 --- a/CHANGES +++ b/CHANGES @@ -1,4 +1,10 @@ -===== 5.9.1 ===== +===== 5.9.3 ===== + +====== Fixes ====== + + * lwt_ppx: correctly carry type annotations again (broken since in 5.9.2). (Pierre Villemot, #1091) + +===== 5.9.2 ===== ====== Packaging ====== diff --git a/dune-project b/dune-project index d3bd18345..afa7023bd 100644 --- a/dune-project +++ b/dune-project @@ -25,7 +25,7 @@ (package (name lwt_ppx) - (version 5.9.2) + (version 5.9.3) (authors "Gabriel Radanne") (synopsis "PPX syntax for Lwt, providing something similar to async/await from JavaScript") (depends diff --git a/lwt_ppx.opam b/lwt_ppx.opam index b6e4bb311..829206fb9 100644 --- a/lwt_ppx.opam +++ b/lwt_ppx.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "5.9.2" +version: "5.9.3" synopsis: "PPX syntax for Lwt, providing something similar to async/await from JavaScript" maintainer: [ From 1b05054c29e073deb8fe735519605b70e700803b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Fri, 13 Mar 2026 15:26:42 +0100 Subject: [PATCH 10/15] provide type Lwt_unix.notification = int --- src/unix/lwt_preemptive.ml | 2 +- src/unix/lwt_unix.cppo.ml | 4 +++- src/unix/lwt_unix.cppo.mli | 12 +++++++----- 3 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/unix/lwt_preemptive.ml b/src/unix/lwt_preemptive.ml index eacf32f28..39a37b45f 100644 --- a/src/unix/lwt_preemptive.ml +++ b/src/unix/lwt_preemptive.ml @@ -78,7 +78,7 @@ struct end type thread = { - task_cell: (int * (unit -> unit)) CELL.t; + task_cell: (Lwt_unix.notification * (unit -> unit)) CELL.t; (* Channel used to communicate notification id and tasks to the worker thread. *) diff --git a/src/unix/lwt_unix.cppo.ml b/src/unix/lwt_unix.cppo.ml index 6fb9f8044..6e43fd60e 100644 --- a/src/unix/lwt_unix.cppo.ml +++ b/src/unix/lwt_unix.cppo.ml @@ -80,9 +80,11 @@ module Notifiers = Hashtbl.Make(struct let notifiers = Notifiers.create 1024 +type notification = int + (* See https://github.com/ocsigen/lwt/issues/277 and https://github.com/ocsigen/lwt/pull/278. *) -let current_notification_id = ref (0x7FFFFFFF - 1000) +let current_notification_id : notification ref = ref (0x7FFFFFFF - 1000) let rec find_free_id id = if Notifiers.mem notifiers id then diff --git a/src/unix/lwt_unix.cppo.mli b/src/unix/lwt_unix.cppo.mli index c36d9a470..4e36b74db 100644 --- a/src/unix/lwt_unix.cppo.mli +++ b/src/unix/lwt_unix.cppo.mli @@ -1471,7 +1471,9 @@ val execute_job : (** Lwt internally use a pipe to send notification to the main thread. The following functions allow to use this pipe. *) -val make_notification : ?once : bool -> (unit -> unit) -> int +type notification = int + +val make_notification : ?once : bool -> (unit -> unit) -> notification (** [make_notification ?once f] registers a new notifier. It returns the id of the notifier. Each time a notification with this id is received, [f] is called. @@ -1479,21 +1481,21 @@ val make_notification : ?once : bool -> (unit -> unit) -> int if [once] is specified, then the notification is stopped after the first time it is received. It defaults to [false]. *) -val send_notification : int -> unit +val send_notification : notification -> unit (** [send_notification id] sends a notification. This function is thread-safe. *) -val stop_notification : int -> unit +val stop_notification : notification -> unit (** Stop the given notification. Note that you should not reuse the id after the notification has been stopped, the result is unspecified if you do so. *) -val call_notification : int -> unit +val call_notification : notification -> unit (** Call the handler associated to the given notification. Note that if the notification was defined with [once = true] it is removed. *) -val set_notification : int -> (unit -> unit) -> unit +val set_notification : notification -> (unit -> unit) -> unit (** [set_notification id f] replace the function associated to the notification by [f]. It raises [Not_found] if the given notification is not found. *) From 33a4e548ab24b91e3f4adf170a254844b3d198f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Fri, 13 Mar 2026 15:30:12 +0100 Subject: [PATCH 11/15] provide type Lwt_engine.id = .. --- src/unix/lwt_engine.ml | 2 ++ src/unix/lwt_engine.mli | 2 ++ 2 files changed, 4 insertions(+) diff --git a/src/unix/lwt_engine.ml b/src/unix/lwt_engine.ml index 20a8eafc7..b52b6689f 100644 --- a/src/unix/lwt_engine.ml +++ b/src/unix/lwt_engine.ml @@ -37,6 +37,8 @@ let _fake_event = { let fake_event = ref _fake_event +type engine_id = .. + (* +-----------------------------------------------------------------+ | Engines | +-----------------------------------------------------------------+ *) diff --git a/src/unix/lwt_engine.mli b/src/unix/lwt_engine.mli index fbdd7d199..ce8fc40ca 100644 --- a/src/unix/lwt_engine.mli +++ b/src/unix/lwt_engine.mli @@ -65,6 +65,8 @@ val forwards_signal : int -> bool (** An engine represents a set of functions used to register different kinds of callbacks for different kinds of events. *) +type engine_id = .. + (** Abstract class for engines. *) class virtual abstract : object method destroy : unit From 7eb1883479298757535d232fc9f30e54e97c0f68 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Fri, 13 Mar 2026 15:32:05 +0100 Subject: [PATCH 12/15] CHANGES --- CHANGES | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/CHANGES b/CHANGES index 0f26858d5..a97e9f52e 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,11 @@ +===== 5.9.4 ===== + +====== Additions ====== + + * Lwt_engine.id: an unused type definition for better 6+ compatibility + + * Lwt_unix.notification=int: a type alias for better 6+ compatibility + ===== 5.9.3 ===== ====== Fixes ====== From b88f0695d56ba2e2e0a6a10b64e0d00aac9464cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Sat, 14 Mar 2026 13:56:22 +0100 Subject: [PATCH 13/15] mark examples/ as data_only_dirs --- dune | 1 + 1 file changed, 1 insertion(+) create mode 100644 dune diff --git a/dune b/dune new file mode 100644 index 000000000..261d36616 --- /dev/null +++ b/dune @@ -0,0 +1 @@ +(data_only_dirs examples) From e39d447ef7bf218e66f184a7b9f9960802d80d5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Sat, 14 Mar 2026 14:23:49 +0100 Subject: [PATCH 14/15] more engine compat --- src/unix/lwt_engine.ml | 12 ++++++++++++ src/unix/lwt_engine.mli | 7 +++++++ 2 files changed, 19 insertions(+) diff --git a/src/unix/lwt_engine.ml b/src/unix/lwt_engine.ml index b52b6689f..cff210b23 100644 --- a/src/unix/lwt_engine.ml +++ b/src/unix/lwt_engine.ml @@ -38,12 +38,14 @@ let _fake_event = { let fake_event = ref _fake_event type engine_id = .. +type engine_id += Engine_id__other (* +-----------------------------------------------------------------+ | Engines | +-----------------------------------------------------------------+ *) class virtual abstract = object(self) + method id = Engine_id__other method virtual iter : bool -> unit method virtual private cleanup : unit method virtual private register_readable : Unix.file_descr -> (unit -> unit) -> unit Lazy.t @@ -174,9 +176,12 @@ external ev_io_stop : ev_loop -> ev_io -> unit = "lwt_libev_io_stop" external ev_timer_init : ev_loop -> float -> bool -> (unit -> unit) -> ev_timer = "lwt_libev_timer_init" external ev_timer_stop : ev_loop -> ev_timer -> unit = "lwt_libev_timer_stop" +type engine_id += Engine_id__libev of Ev_backend.t class libev ?(backend=Ev_backend.default) () = object inherit abstract + method! id = Engine_id__libev backend + val loop = ev_init backend method loop = loop @@ -332,9 +337,12 @@ class virtual select_or_poll_based = object if Lwt_sequence.is_empty actions then wait_writable <- Fd_map.remove fd wait_writable) end +type engine_id += Engine_id__select class virtual select_based = object(self) inherit select_or_poll_based + method! id = Engine_id__select + method private virtual select : Unix.file_descr list -> Unix.file_descr list -> float -> Unix.file_descr list * Unix.file_descr list method iter block = @@ -367,9 +375,12 @@ class virtual select_based = object(self) List.iter (fun fd -> invoke_actions fd wait_writable) fds_w end +type engine_id += Engine_id__poll class virtual poll_based = object(self) inherit select_or_poll_based + method! id = Engine_id__select + method private virtual poll : (Unix.file_descr * bool * bool) list -> float -> (Unix.file_descr * bool * bool) list method iter block = @@ -431,6 +442,7 @@ let set ?(transfer=true) ?(destroy=true) engine = if destroy then !current#destroy; current := (engine : #t :> t) +let id () = !current#id let iter block = !current#iter block let on_readable fd f = !current#on_readable fd f let on_writable fd f = !current#on_writable fd f diff --git a/src/unix/lwt_engine.mli b/src/unix/lwt_engine.mli index ce8fc40ca..c9d7a81ba 100644 --- a/src/unix/lwt_engine.mli +++ b/src/unix/lwt_engine.mli @@ -67,8 +67,11 @@ val forwards_signal : int -> bool type engine_id = .. +val id : unit -> engine_id + (** Abstract class for engines. *) class virtual abstract : object + method id : engine_id method destroy : unit (** Destroy the engine, remove all its events and free its associated resources. *) @@ -144,6 +147,8 @@ end (** Type of libev loops. *) +type engine_id += Engine_id__libev of Ev_backend.t + (** Engine based on libev. If not compiled with libev support, the creation of the class will raise {!Lwt_sys.Not_available}. *) class libev : ?backend:Ev_backend.t -> unit -> object @@ -160,6 +165,8 @@ class libev : ?backend:Ev_backend.t -> unit -> object end (** Engine based on {!Unix.select}. *) +type engine_id += Engine_id__select +type engine_id += Engine_id__poll class select : t (** Abstract class for engines based on a select-like function. *) From 187cf65c9dac506ae120bfeef9e9d1c30ce28ded Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Tue, 12 May 2026 11:20:00 +0200 Subject: [PATCH 15/15] 5.10.0 is a better version for these changes --- CHANGES | 2 +- dune-project | 2 +- lwt.opam | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/CHANGES b/CHANGES index a97e9f52e..3c7e0f82e 100644 --- a/CHANGES +++ b/CHANGES @@ -1,4 +1,4 @@ -===== 5.9.4 ===== +===== 5.10.0 ===== ====== Additions ====== diff --git a/dune-project b/dune-project index afa7023bd..122663c0f 100644 --- a/dune-project +++ b/dune-project @@ -53,7 +53,7 @@ (package (name lwt) - (version 5.9.2) + (version 5.10.0) (synopsis "Promises and event-driven I/O") (description "A promise is a value that may become determined in the future. diff --git a/lwt.opam b/lwt.opam index b259ec4fb..fa2f67d63 100644 --- a/lwt.opam +++ b/lwt.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "5.9.2" +version: "5.10.0" synopsis: "Promises and event-driven I/O" description: """ A promise is a value that may become determined in the future.