First try with a typer domain

src/frontend/ocamlmerlin/new/new_merlin.ml

@@ -112,9 +112,7 @@ let run =
           let store = Mpipeline.Cache.get config in
           Local_store.open_store store;
           let source = Msource.make (Misc.string_of_file stdin) in
-          let pipeline =
-            Mpipeline.get ~state:(Mpipeline.Cache.get config) config source
-          in
+          let pipeline = Mpipeline.get config source in
           let json =
             let class_, message =
               Printexc.record_backtrace true;

src/frontend/ocamlmerlin/ocamlmerlin_server.ml

@@ -56,16 +56,25 @@ module Server = struct
     | None -> Logger.log ~section:"server" ~title:"cannot setup listener" ""
     | Some server ->
       (* If the client closes its connection, don't let it kill us with a SIGPIPE. *)
+      let domain_typer = Domain.spawn Mpipeline.domain_typer in
       if Sys.unix then Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
       loop (File_id.get Sys.executable_name) server;
+
+      Atomic.set Mpipeline.close_typer `True;
+      Domain.join domain_typer;
       Os_ipc.server_close server
 end
 
 let main () =
   (* Setup env for extensions *)
   Unix.putenv "__MERLIN_MASTER_PID" (string_of_int (Unix.getpid ()));
   match List.tl (Array.to_list Sys.argv) with
-  | "single" :: args -> exit (New_merlin.run ~new_env:None None args)
+  | "single" :: args ->
+    let domain_typer = Domain.spawn Mpipeline.domain_typer in
+    let vexit = New_merlin.run ~new_env:None None args in
+    Atomic.set Mpipeline.close_typer `True;
+    Domain.join domain_typer;
+    exit vexit
   | "old-protocol" :: args -> Old_merlin.run args
   | [ "server"; socket_path; socket_fd ] -> Server.start socket_path socket_fd
   | ("-help" | "--help" | "-h" | "server") :: _ ->

src/kernel/mpipeline.ml

@@ -321,8 +321,6 @@ let process ?state ?(pp_time = ref 0.0) ?(reader_time = ref 0.0)
 
 let make config source = process (Mconfig.normalize config) source
 
-let get ?state config source = process ?state (Mconfig.normalize config) source
-
 let for_completion position
     { config;
       state;
@@ -367,3 +365,45 @@ let cache_information t =
       ("cmt", cmt);
       ("cmi", cmi)
     ]
+
+let shared_config = Atomic.make None
+let shared_pipeline = Atomic.make None
+
+let close_typer = Atomic.make `False
+
+let domain_typer () =
+  let rec loop () =
+    if Atomic.get close_typer = `True then ()
+    else
+      match Atomic.get shared_config with
+      | None ->
+        Domain.cpu_relax ();
+        loop ()
+      | Some (config, source) as curr -> (
+        try
+          let pipeline = make config source in
+          if Atomic.compare_and_set shared_config curr None then
+            Atomic.set shared_pipeline (Some pipeline);
+          loop ()
+        with exn -> Atomic.set close_typer (`Exn exn))
+  in
+  loop ()
+
+let get config source =
+  Atomic.set shared_config (Some (config, source));
+
+  let rec loop count =
+    match Atomic.get shared_pipeline with
+    | None -> begin
+      match Atomic.get close_typer with
+      | `Exn exn -> raise exn
+      | `True -> assert false
+      | _ ->
+        Domain.cpu_relax ();
+        loop (count + 1)
+    end
+    | Some pipeline ->
+      Atomic.set shared_pipeline None;
+      pipeline
+  in
+  loop 0

src/kernel/mpipeline.mli

@@ -1,6 +1,6 @@
 type t
 val make : Mconfig.t -> Msource.t -> t
-val get : ?state:Mocaml.typer_state -> Mconfig.t -> Msource.t -> t
+val get : Mconfig.t -> Msource.t -> t
 
 val with_pipeline : t -> (unit -> 'a) -> 'a
 val for_completion : Msource.position -> t -> t
@@ -33,3 +33,7 @@ val cache_information : t -> Std.json
 module Cache : sig
   val get : Mconfig.t -> Mocaml.typer_state
 end
+
+val close_typer : [ `True | `False | `Exn of exn ] Atomic.t
+
+val domain_typer : unit -> unit