api break: put spawn in the server itself, not IO

example/template/main.ml

@@ -43,6 +43,8 @@ class lsp_server =
     val buffers : (Lsp.Types.DocumentUri.t, state_after_processing) Hashtbl.t =
       Hashtbl.create 32
 
+    method spawn_query_handler f = Linol_lwt.spawn f
+
     (* We define here a helper method that will:
        - process a document
        - store the state resulting from the processing

src/blocking_IO.ml

@@ -11,7 +11,7 @@ let fail = raise
 let stdin = stdin
 let stdout = stdout
 
-let default_spawn_ f =
+let default_spawn f =
   let run () =
     try f ()
     with e ->
@@ -21,9 +21,6 @@ let default_spawn_ f =
   in
   ignore (Thread.create run ())
 
-let spawn_ref_ = ref default_spawn_
-let set_spawn_function f = spawn_ref_ := f
-let spawn f = !spawn_ref_ f
 let catch f g = try f () with e -> g e
 
 let rec read ic buf i len =

src/blocking_IO.mli

@@ -6,6 +6,6 @@ include
      and type in_channel = in_channel
      and type out_channel = out_channel
 
-val set_spawn_function : ((unit -> unit) -> unit) -> unit
+val default_spawn : (unit -> unit) -> unit
-(** Change the way the LSP server spawns new threads to handle
+(** Start a new thread.
-    client queries. For example, one might use a thread pool. *)
+    @since NEXT_RELEASE *)

src/jsonrpc2.ml

@@ -319,7 +319,7 @@ module Make (IO : IO) : S with module IO = IO = struct
         let* r = read_msg self in
         match r with
         | Ok r ->
-          IO.spawn (fun () -> process_msg r);
+          self.s#spawn_query_handler (fun () -> process_msg r);
           loop ()
         | Error e -> IO.fail e
     in

src/lwt/linol_lwt.ml

@@ -29,14 +29,16 @@ module IO_lwt :
   let read_line = Lwt_io.read_line
   let catch = Lwt.catch
   let fail = Lwt.fail
+end
 
+(** Spawn function.
+    @since NEXT_RELEASE *)
 let spawn f =
   Lwt.async (fun () ->
       Lwt.catch f (fun exn ->
           Printf.eprintf "uncaught exception in `spawn`:\n%s\n%!"
             (Printexc.to_string exn);
           Lwt.return ()))
-end
 
 include Lsp.Types
 include IO_lwt

src/server.ml

@@ -67,6 +67,11 @@ module Make (IO : IO) = struct
 
       method must_quit = false
       (** Set to true if the client requested to exit *)
+
+      method virtual spawn_query_handler : (unit -> unit IO.t) -> unit
+      (** How to start a new future/task/thread concurrently. This is used
+          to process incoming user queries.
+          @since NEXT_RELEASE *)
     end
 
   (** A wrapper to more easily reply to notifications *)

src/sigs.ml

@@ -17,10 +17,6 @@ module type IO = sig
   val read_line : in_channel -> string t
   val write : out_channel -> bytes -> int -> int -> unit t
   val write_string : out_channel -> string -> unit t
-
-  val spawn : (unit -> unit t) -> unit
-  (** Spawn a new task that executes concurrently. *)
-
   val fail : exn -> unit t
   val catch : (unit -> 'a t) -> (exn -> 'a t) -> 'a t
 end