diff --git a/.ocamlformat b/.ocamlformat
index 409672b79c..6986d1a28e 100644
--- a/.ocamlformat
+++ b/.ocamlformat
@@ -1,5 +1,6 @@
 version=0.27.0
 disable=false
+ocaml-version = 5.3
 
 break-cases=fit-or-vertical
 doc-comments=before
diff --git a/src/analysis/typed_hole.ml b/src/analysis/typed_hole.ml
index d71bd893c0..52d73e9b0f 100644
--- a/src/analysis/typed_hole.ml
+++ b/src/analysis/typed_hole.ml
@@ -14,4 +14,3 @@ let is_a_hole = function
   | (_, Browse_raw.Module_expr { mod_desc = Tmod_typed_hole; _ }) :: (_, _) :: _
   | (_, Browse_raw.Expression { exp_desc = Texp_typed_hole; _ }) :: _ -> true
   | [] | (_, _) :: _ -> false
-;;
diff --git a/src/commands/new_commands.ml b/src/commands/new_commands.ml
index ebf1aee4ae..9159d1b31e 100644
--- a/src/commands/new_commands.ml
+++ b/src/commands/new_commands.ml
@@ -35,7 +35,11 @@ type command =
       * Marg.docstring
       * ([ `Mandatory | `Optional | `Many ] * 'args Marg.spec) list
       * 'args
-      * (Mpipeline.t -> 'args -> json)
+      * (Mpipeline.shared ->
+        Mconfig.t ->
+        Msource.t ->
+        'args ->
+        json * Mpipeline.t option)
       -> command
 
 let command name ?(doc = "") ~spec ~default f =
@@ -92,12 +96,27 @@ let find_command name = List.find ~f:(command_is ~name)
 
 let find_command_opt name = List.find_opt ~f:(command_is ~name)
 
-let run pipeline query =
+let run ?position shared config source query =
+  let pipeline = Mpipeline.get ?position shared config source in
   Logger.log ~section:"New_commands" ~title:"run(query)" "%a" Logger.json
     (fun () -> Query_json.dump query);
-  let result = Query_commands.dispatch pipeline query in
-  let json = Query_json.json_of_response query result in
-  json
+
+  (* Analyse : need to ask for lock here *)
+  (* Main domain signals it wants the lock  *)
+  if Atomic.compare_and_set shared.msg.from_main `Empty `Waiting then
+    let result =
+      Shared.protect shared.result (fun () ->
+          (* The write on mess_main needed 
+              to happen in the lock to ensure the main domain got it, before 
+              releasing the typer domain of its active wait *)
+          Atomic.set shared.msg.from_main `Empty;
+          Query_commands.dispatch pipeline query)
+    in
+    let json = Query_json.json_of_response query result in
+    (json, Some pipeline)
+  else
+    (* This can happen when the typer domain found an exception *)
+    failwith "To debug."
 
 let all_commands =
   [ command "case-analysis"
@@ -119,17 +138,20 @@ let all_commands =
          position}, content]`, where content is string.\n"
       ~default:(`Offset (-1), `Offset (-1))
       begin
-        fun buffer -> function
+        fun shared config source -> function
           | `Offset -1, _ -> failwith "-start <pos> is mandatory"
           | _, `Offset -1 -> failwith "-end <pos> is mandatory"
           | startp, endp ->
-            run buffer (Query_protocol.Case_analysis (startp, endp))
+            let position = Msource.get_position source endp in
+            run ~position shared config source
+              (Query_protocol.Case_analysis (startp, endp))
       end;
     command "holes" ~spec:[]
       ~doc:"Returns the list of the positions of all the holes in the file."
       ~default:()
       begin
-        fun buffer () -> run buffer Query_protocol.Holes
+        fun shared config source () ->
+          run shared config source Query_protocol.Holes
       end;
     command "construct"
       ~spec:
@@ -160,11 +182,14 @@ let all_commands =
          inferior depth will not be returned."
       ~default:(`Offset (-1), None, None)
       begin
-        fun buffer (pos, with_values, max_depth) ->
+        fun shared config source (pos, with_values, max_depth) ->
           match pos with
           | `Offset -1 -> failwith "-position <pos> is mandatory"
           | pos ->
-            run buffer (Query_protocol.Construct (pos, with_values, max_depth))
+            (* FIXME: Invalid some tests related to holes. *)
+            (* let position = Msource.get_position source pos in *)
+            run (* ~position *) shared config source
+              (Query_protocol.Construct (pos, with_values, max_depth))
       end;
     command "complete-prefix"
       ~spec:
@@ -217,11 +242,12 @@ let all_commands =
          like signatures for modules or documentation string."
       ~default:("", `None, [], false, true)
       begin
-        fun buffer (txt, pos, kinds, doc, typ) ->
+        fun shared config source (txt, pos, kinds, doc, typ) ->
           match pos with
           | `None -> failwith "-position <pos> is mandatory"
           | #Msource.position as pos ->
-            run buffer
+            let position = Msource.get_position source pos in
+            run ~position shared config source
               (Query_protocol.Complete_prefix
                  (txt, pos, List.rev kinds, doc, typ))
       end;
@@ -240,11 +266,13 @@ let all_commands =
         ]
       ~default:(None, `None)
       begin
-        fun buffer (ident, pos) ->
+        fun shared config source (ident, pos) ->
           match pos with
           | `None -> failwith "-position <pos> is mandatory"
           | #Msource.position as pos ->
-            run buffer (Query_protocol.Document (ident, pos))
+            let position = Msource.get_position source pos in
+            run ~position shared config source
+              (Query_protocol.Document (ident, pos))
       end;
     command "syntax-document"
       ~doc:
@@ -255,11 +283,13 @@ let all_commands =
         ]
       ~default:`None
       begin
-        fun buffer pos ->
+        fun shared config source pos ->
           match pos with
           | `None -> failwith "-position <pos> is mandatory"
           | #Msource.position as pos ->
-            run buffer (Query_protocol.Syntax_document pos)
+            let position = Msource.get_position source pos in
+            run ~position shared config source
+              (Query_protocol.Syntax_document pos)
       end;
     command "expand-ppx" ~doc:"Returns the generated code of a PPX."
       ~spec:
@@ -268,11 +298,14 @@ let all_commands =
         ]
       ~default:`None
       begin
-        fun buffer pos ->
+        fun shared config source pos ->
           match pos with
           | `None -> failwith "-position <pos> is mandatory"
           | #Msource.position as pos ->
-            run buffer (Query_protocol.Expand_ppx pos)
+            (* FIXME: Test loop infinitely. *)
+            (* let position = Msource.get_position source pos in *)
+            run (* ~position *) shared config source
+              (Query_protocol.Expand_ppx pos)
       end;
     command "enclosing"
       ~spec:
@@ -286,11 +319,12 @@ let all_commands =
          the cursor.)"
       ~default:`None
       begin
-        fun buffer pos ->
+        fun shared config source pos ->
           match pos with
           | `None -> failwith "-position <pos> is mandatory"
           | #Msource.position as pos ->
-            run buffer (Query_protocol.Enclosing pos)
+            let position = Msource.get_position source pos in
+            run ~position shared config source (Query_protocol.Enclosing pos)
       end;
     command "errors"
       ~spec:
@@ -323,8 +357,9 @@ let all_commands =
          `message` is the error description to be shown to the user."
       ~default:(true, true, true)
       begin
-        fun buffer (lexing, parsing, typing) ->
-          run buffer (Query_protocol.Errors { lexing; parsing; typing })
+        fun shared config source (lexing, parsing, typing) ->
+          run shared config source
+            (Query_protocol.Errors { lexing; parsing; typing })
       end;
     command "expand-prefix"
       ~doc:
@@ -356,11 +391,12 @@ let all_commands =
         ]
       ~default:("", `None, [], false)
       begin
-        fun buffer (txt, pos, kinds, typ) ->
+        fun shared config source (txt, pos, kinds, typ) ->
           match pos with
           | `None -> failwith "-position <pos> is mandatory"
           | #Msource.position as pos ->
-            run buffer
+            let position = Msource.get_position source pos in
+            run ~position shared config source
               (Query_protocol.Expand_prefix (txt, pos, List.rev kinds, typ))
       end;
     command "extension-list"
@@ -379,13 +415,15 @@ let all_commands =
          a list of strings."
       ~default:`All
       begin
-        fun buffer status -> run buffer (Query_protocol.Extension_list status)
+        fun shared config source status ->
+          run shared config source (Query_protocol.Extension_list status)
       end;
     command "findlib-list"
       ~doc:"Returns all known findlib packages as a list of string." ~spec:[]
       ~default:()
       begin
-        fun buffer () -> run buffer Query_protocol.Findlib_list
+        fun shared config source () ->
+          run shared config source Query_protocol.Findlib_list
       end;
     command "flags-list" ~spec:[]
       ~doc:
@@ -393,8 +431,9 @@ let all_commands =
          implement interactive completion of compiler settings in an IDE."
       ~default:()
       begin
-        fun _ () ->
-          `List (List.map ~f:Json.string (Mconfig.flags_for_completion ()))
+        fun _ _ _ () ->
+          ( `List (List.map ~f:Json.string (Mconfig.flags_for_completion ())),
+            None )
       end;
     command "jump"
       ~spec:
@@ -411,11 +450,17 @@ let all_commands =
          module or match expression that contains the cursor\n"
       ~default:("", `None)
       begin
-        fun buffer (target, pos) ->
+        fun shared config source (target, pos) ->
           match pos with
           | `None -> failwith "-position <pos> is mandatory"
           | #Msource.position as pos ->
-            run buffer (Query_protocol.Jump (target, pos))
+            (* FIXME: Test loops infinitely
+                      We need a more precise heuristic
+                      based on the target.
+            *)
+            (* let position = Msource.get_position source pos in *)
+            run (* ~position *) shared config source
+              (Query_protocol.Jump (target, pos))
       end;
     command "phrase"
       ~spec:
@@ -433,11 +478,17 @@ let all_commands =
          definition or module definition)."
       ~default:(`Next, `None)
       begin
-        fun buffer (target, pos) ->
+        fun shared config source (target, pos) ->
           match pos with
           | `None -> failwith "-position <pos> is mandatory"
           | #Msource.position as pos ->
-            run buffer (Query_protocol.Phrase (target, pos))
+            (* FIXME: Test loops infinitely
+                      We need a more precise heuristic
+                      based on the next phrase.
+            *)
+            (* let position = Msource.get_position source pos in *)
+            run (* ~position *) shared config source
+              (Query_protocol.Phrase (target, pos))
       end;
     command "list-modules"
       ~spec:
@@ -449,8 +500,9 @@ let all_commands =
          and prints the corresponding module name."
       ~default:[]
       begin
-        fun buffer extensions ->
-          run buffer (Query_protocol.List_modules (List.rev extensions))
+        fun shared config source extensions ->
+          run shared config source
+            (Query_protocol.List_modules (List.rev extensions))
       end;
     command "locate"
       ~spec:
@@ -481,11 +533,13 @@ let all_commands =
          different file."
       ~default:(None, `None, `MLI)
       begin
-        fun buffer (prefix, pos, lookfor) ->
+        fun shared config source (prefix, pos, lookfor) ->
           match pos with
           | `None -> failwith "-position <pos> is mandatory"
           | #Msource.position as pos ->
-            run buffer (Query_protocol.Locate (prefix, lookfor, pos))
+            let position = Msource.get_position source pos in
+            run ~position shared config source
+              (Query_protocol.Locate (prefix, lookfor, pos))
       end;
     command "locate-type"
       ~spec:
@@ -494,11 +548,12 @@ let all_commands =
         ]
       ~doc:"Locate the declaration of the type of the expression" ~default:`None
       begin
-        fun buffer pos ->
+        fun shared config source pos ->
           match pos with
           | `None -> failwith "-position <pos> is mandatory"
           | #Msource.position as pos ->
-            run buffer (Query_protocol.Locate_type pos)
+            let position = Msource.get_position source pos in
+            run ~position shared config source (Query_protocol.Locate_type pos)
       end;
     command "occurrences"
       ~spec:
@@ -518,10 +573,13 @@ let all_commands =
          position."
       ~default:(`None, `Buffer)
       begin
-        fun buffer -> function
+        fun shared config source -> function
           | `None, _ -> failwith "-identifier-at <pos> is mandatory"
           | `Ident_at pos, scope ->
-            run buffer (Query_protocol.Occurrences (`Ident_at pos, scope))
+            (* TODO: Guess we have to typecheck everything
+                     to get every occurence? *)
+            run shared config source
+              (Query_protocol.Occurrences (`Ident_at pos, scope))
       end;
     command "outline" ~spec:[]
       ~doc:
@@ -530,7 +588,8 @@ let all_commands =
          content of the buffer."
       ~default:()
       begin
-        fun buffer () -> run buffer Query_protocol.Outline
+        fun shared config source () ->
+          run shared config source Query_protocol.Outline
       end;
     command "path-of-source"
       ~doc:
@@ -542,8 +601,9 @@ let all_commands =
         ]
       ~default:[]
       begin
-        fun buffer filenames ->
-          run buffer (Query_protocol.Path_of_source (List.rev filenames))
+        fun shared config source filenames ->
+          run shared config source
+            (Query_protocol.Path_of_source (List.rev filenames))
       end;
     command "refactor-open"
       ~doc:"refactor-open -position pos -action <qualify|unqualify>\n\tTODO"
@@ -559,11 +619,15 @@ let all_commands =
         ]
       ~default:(None, `None)
       begin
-        fun buffer -> function
+        fun shared config source -> function
           | None, _ -> failwith "-action is mandatory"
           | _, `None -> failwith "-position is mandatory"
           | Some action, (#Msource.position as pos) ->
-            run buffer (Query_protocol.Refactor_open (action, pos))
+            (* FIXME: break the test-suite, should we try to keep it?
+                      Need to investigate the command. *)
+            (* let position = Msource.get_position source pos in *)
+            run (* ~position *) shared config source
+              (Query_protocol.Refactor_open (action, pos))
       end;
     command "search-by-polarity"
       ~doc:"search-by-polarity -position pos -query ident\n\tTODO"
@@ -579,11 +643,13 @@ let all_commands =
         ]
       ~default:("", `None)
       begin
-        fun buffer (query, pos) ->
+        fun shared config source (query, pos) ->
           match pos with
           | `None -> failwith "-position <pos> is mandatory"
           | #Msource.position as pos ->
-            run buffer (Query_protocol.Polarity_search (query, pos))
+            let position = Msource.get_position source pos in
+            run ~position shared config source
+              (Query_protocol.Polarity_search (query, pos))
       end;
     command "search-by-type" ~doc:"return a list of values that match a query"
       ~spec:
@@ -603,14 +669,15 @@ let all_commands =
         ]
       ~default:(None, `None, 100, false)
       begin
-        fun buffer (query, pos, limit, with_doc) ->
+        fun shared config source (query, pos, limit, with_doc) ->
           match (query, pos) with
           | None, `None ->
             failwith "-position <pos> and -query <string> are mandatory"
           | None, _ -> failwith "-query <string> is mandatory"
           | _, `None -> failwith "-position <pos> is mandatory"
           | Some query, (#Msource.position as pos) ->
-            run buffer
+            let position = Msource.get_position source pos in
+            run ~position shared config source
               (Query_protocol.Type_search (query, pos, limit, with_doc))
       end;
     command "inlay-hints"
@@ -645,14 +712,19 @@ let all_commands =
         ]
       ~default:(`None, `None, false, false, true)
       begin
-        fun buffer (start, stop, let_binding, pattern_binding, avoid_ghost) ->
+        fun shared
+          config
+          source
+          (start, stop, let_binding, pattern_binding, avoid_ghost)
+        ->
           match (start, stop) with
           | `None, `None -> failwith "-start <pos> and -end are mandatory"
           | `None, _ -> failwith "-start <pos> is mandatory"
           | _, `None -> failwith "-end <pos> is mandatory"
           | (#Msource.position, #Msource.position) as position ->
             let start, stop = position in
-            run buffer
+            let position = Msource.get_position source stop in
+            run ~position shared config source
               (Query_protocol.Inlay_hints
                  (start, stop, let_binding, pattern_binding, avoid_ghost))
       end;
@@ -676,9 +748,11 @@ let all_commands =
         ]
       ~default:`None
       begin
-        fun buffer -> function
+        fun shared config source -> function
           | `None -> failwith "-position <pos> is mandatory"
-          | #Msource.position as pos -> run buffer (Query_protocol.Shape pos)
+          | #Msource.position as pos ->
+            let position = Msource.get_position source pos in
+            run ~position shared config source (Query_protocol.Shape pos)
       end;
     command "type-enclosing"
       ~doc:
@@ -725,7 +799,7 @@ let all_commands =
         ]
       ~default:("", -1, `None, None)
       begin
-        fun buffer (expr, cursor, pos, index) ->
+        fun shared config source (expr, cursor, pos, index) ->
           match pos with
           | `None -> failwith "-position <pos> is mandatory"
           | #Msource.position as pos ->
@@ -737,7 +811,9 @@ let all_commands =
                 in
                 Some (expr, cursor)
             in
-            run buffer (Query_protocol.Type_enclosing (expr, pos, index))
+            let position = Msource.get_position source pos in
+            run ~position shared config source
+              (Query_protocol.Type_enclosing (expr, pos, index))
       end;
     command "type-expression"
       ~doc:
@@ -751,11 +827,13 @@ let all_commands =
         ]
       ~default:("", `None)
       begin
-        fun buffer (expr, pos) ->
+        fun shared config source (expr, pos) ->
           match pos with
           | `None -> failwith "-position <pos> is mandatory"
           | #Msource.position as pos ->
-            run buffer (Query_protocol.Type_expr (expr, pos))
+            let position = Msource.get_position source pos in
+            run ~position shared config source
+              (Query_protocol.Type_expr (expr, pos))
       end;
     (* Implemented without support from Query_protocol.  This command might be
        refactored if it proves useful for old protocol too. *)
@@ -771,25 +849,29 @@ let all_commands =
          ```"
       ~default:()
       begin
-        fun pipeline () ->
+        fun shared config source () ->
+          (* TODO this is probabably not what we want *)
+          let pipeline = Mpipeline.get shared config source in
           let config = Mpipeline.final_config pipeline in
-          `Assoc
-            [ (* TODO Remove support for multiple configuration files
+          ( `Assoc
+              [ (* TODO Remove support for multiple configuration files
                  The protocol could be changed to:
                  'config_file': path_to_dot_merlin_or_dune
 
                  For now, if the configurator is dune, the field 'dot_merlins'
                  will contain the path to the dune file (or jbuild, or dune-project)
               *)
-              ( "dot_merlins",
-                `List
-                  (match Mconfig.(config.merlin.config_path) with
-                  | Some path -> [ Json.string path ]
-                  | None -> []) );
-              ( "failures",
-                `List (List.map ~f:Json.string Mconfig.(config.merlin.failures))
-              )
-            ]
+                ( "dot_merlins",
+                  `List
+                    (match Mconfig.(config.merlin.config_path) with
+                    | Some path -> [ Json.string path ]
+                    | None -> []) );
+                ( "failures",
+                  `List
+                    (List.map ~f:Json.string Mconfig.(config.merlin.failures))
+                )
+              ],
+            Some pipeline )
       end;
     command "signature-help" ~doc:"Returns LSP Signature Help response"
       ~spec:
@@ -798,7 +880,7 @@ let all_commands =
         ]
       ~default:("", `None)
       begin
-        fun buffer (_, pos) ->
+        fun shared config source (_, pos) ->
           match pos with
           | `None -> failwith "-position <pos> is mandatory"
           | #Msource.position as position ->
@@ -809,7 +891,9 @@ let all_commands =
                 active_signature_help = None
               }
             in
-            run buffer (Query_protocol.Signature_help sh)
+            let position = Msource.get_position source position in
+            run ~position shared config source
+              (Query_protocol.Signature_help sh)
       end;
     (* Used only for testing *)
     command "dump"
@@ -821,12 +905,17 @@ let all_commands =
         ]
       ~default:"" ~doc:"Not for the casual user, used for debugging merlin"
       begin
-        fun pipeline what -> run pipeline (Query_protocol.Dump [ `String what ])
+        fun shared config source what ->
+          run shared config source (Query_protocol.Dump [ `String what ])
       end;
     (* Used only for testing *)
     command "dump-configuration" ~spec:[] ~default:()
       ~doc:"Not for the casual user, used for merlin tests"
       begin
-        fun pipeline () -> Mconfig.dump (Mpipeline.final_config pipeline)
+        fun shared config source () ->
+          (* TODO this is probabably not what we want *)
+          let pipeline = Mpipeline.get shared config source in
+
+          (Mconfig.dump (Mpipeline.final_config pipeline), Some pipeline)
       end
   ]
diff --git a/src/commands/new_commands.mli b/src/commands/new_commands.mli
index 0cb3ad5b24..7890a16f95 100644
--- a/src/commands/new_commands.mli
+++ b/src/commands/new_commands.mli
@@ -35,7 +35,11 @@ type command =
       * Marg.docstring
       * ([ `Mandatory | `Optional | `Many ] * 'args Marg.spec) list
       * 'args
-      * (Mpipeline.t -> 'args -> json)
+      * (Mpipeline.shared ->
+        Mconfig.t ->
+        Msource.t ->
+        'args ->
+        json * Mpipeline.t option)
       -> command
 
 val all_commands : command list
diff --git a/src/frontend/ocamlmerlin/new/new_merlin.ml b/src/frontend/ocamlmerlin/new/new_merlin.ml
index 78e13d9c34..2650cfcd84 100644
--- a/src/frontend/ocamlmerlin/new/new_merlin.ml
+++ b/src/frontend/ocamlmerlin/new/new_merlin.ml
@@ -47,7 +47,7 @@ let commands_help () =
       print_endline doc)
     New_commands.all_commands
 
-let run =
+let run shared =
   let query_num = ref (-1) in
   function
   | [] ->
@@ -109,37 +109,43 @@ let run =
               (float_of_int (60 * Mconfig.(config.merlin.cache_lifespan)))
             ();
           File_id.with_cache @@ fun () ->
+          (* TODO : Would it be possible to not expose this function in mpipeline.mli and its type in mocaml.mli ? *)
+          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.make config source in
           let json =
-            let class_, message =
+            let class_, message, pipeline_opt =
               Printexc.record_backtrace true;
-              match
-                Mpipeline.with_pipeline pipeline @@ fun () ->
-                command_action pipeline command_args
-              with
-              | result -> ("return", result)
+              match command_action shared config source command_args with
+              | result, pipeline_opt -> ("return", result, pipeline_opt)
               | exception Failure str ->
                 let trace = Printexc.get_backtrace () in
                 log ~title:"run" "Command error backtrace: %s" trace;
-                ("failure", `String str)
+                ("failure", `String str, None)
               | exception exn -> (
                 let trace = Printexc.get_backtrace () in
                 log ~title:"run" "Command error backtrace: %s" trace;
                 match Location.error_of_exn exn with
                 | None | Some `Already_displayed ->
-                  ("exception", `String (Printexc.to_string exn ^ "\n" ^ trace))
+                  ( "exception",
+                    `String (Printexc.to_string exn ^ "\n" ^ trace),
+                    None )
                 | Some (`Ok err) ->
                   Location.print_main Format.str_formatter err;
-                  ("error", `String (Format.flush_str_formatter ())))
+                  ("error", `String (Format.flush_str_formatter ()), None))
             in
+            Local_store.close_store store;
             let cpu_time = Misc.time_spent () -. start_cpu in
             let gc_stats = Gc.quick_stat () in
             let heap_mbytes =
               gc_stats.heap_words * (Sys.word_size / 8) / 1_000_000
             in
             let clock_time = (Unix.gettimeofday () *. 1000.) -. start_clock in
-            let timing = Mpipeline.timing_information pipeline in
+            let timing =
+              match pipeline_opt with
+              | None -> [] (* TODO *)
+              | Some p -> Mpipeline.timing_information p
+            in
             let pipeline_time =
               List.fold_left (fun acc (_, k) -> k +. acc) 0.0 timing
             in
@@ -158,7 +164,10 @@ let run =
                 ("notifications", `List (List.rev_map notify !notifications));
                 ("timing", `Assoc (List.map format_timing timing));
                 ("heap_mbytes", `Int heap_mbytes);
-                ("cache", Mpipeline.cache_information pipeline);
+                ( "cache",
+                  match pipeline_opt with
+                  | None -> `Assoc [] (* TODO *)
+                  | Some pipeline -> Mpipeline.cache_information pipeline );
                 ("query_num", `Int !query_num)
               ]
           in
@@ -186,7 +195,7 @@ let with_wd ~wd ~old_wd f args =
       old_wd;
     f args
 
-let run ~new_env wd args =
+let run ~new_env wd args shared =
   begin
     match new_env with
     | Some env ->
@@ -197,10 +206,10 @@ let run ~new_env wd args =
   let old_wd = Sys.getcwd () in
   let run args () =
     match wd with
-    | Some wd -> with_wd ~wd ~old_wd run args
+    | Some wd -> with_wd ~wd ~old_wd (run shared) args
     | None ->
       log ~title:"run" "No working directory specified (old wd: %S)" old_wd;
-      run args
+      run shared args
   in
   let `Log_file_path log_file, `Log_sections sections = Log_info.get () in
   Logger.with_log_file log_file ~sections @@ run args
diff --git a/src/frontend/ocamlmerlin/ocamlmerlin_server.ml b/src/frontend/ocamlmerlin/ocamlmerlin_server.ml
index 35ca8a3a64..1ccee1d1f4 100644
--- a/src/frontend/ocamlmerlin/ocamlmerlin_server.ml
+++ b/src/frontend/ocamlmerlin/ocamlmerlin_server.ml
@@ -2,19 +2,19 @@ let merlin_timeout =
   try float_of_string (Sys.getenv "MERLIN_TIMEOUT") with _ -> 600.0
 
 module Server = struct
-  let process_request { Os_ipc.wd; environ; argv; context = _ } =
+  let process_request { Os_ipc.wd; environ; argv; context = _ } shared =
     match Array.to_list argv with
     | "stop-server" :: _ -> raise Exit
-    | args -> New_merlin.run ~new_env:(Some environ) (Some wd) args
+    | args -> New_merlin.run ~new_env:(Some environ) (Some wd) args shared
 
-  let process_client client =
+  let process_client client shared =
     let context = client.Os_ipc.context in
     Os_ipc.context_setup context;
     let close_with return_code =
       flush_all ();
       Os_ipc.context_close context ~return_code
     in
-    match process_request client with
+    match process_request client shared with
     | code -> close_with code
     | exception Exit ->
       close_with (-1);
@@ -38,18 +38,18 @@ module Server = struct
     | Some _ as result -> result
     | None -> loop 1.0
 
-  let rec loop merlinid server =
+  let rec loop merlinid server shared =
     match server_accept merlinid server with
     | None ->
       (* Timeout *)
       ()
     | Some client ->
       let continue =
-        match process_client client with
+        match process_client client shared with
         | exception Exit -> false
         | () -> true
       in
-      if continue then loop merlinid server
+      if continue then loop merlinid server shared
 
   let start socket_path socket_fd =
     match Os_ipc.server_setup socket_path socket_fd with
@@ -57,7 +57,12 @@ module Server = struct
     | Some server ->
       (* If the client closes its connection, don't let it kill us with a SIGPIPE. *)
       if Sys.unix then Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
-      loop (File_id.get Sys.executable_name) server;
+
+      let shared = Mpipeline.create_shared () in
+      let domain_typer = Domain.spawn @@ Mpipeline.domain_typer shared in
+      loop (File_id.get Sys.executable_name) server shared;
+      Mpipeline.close_typer shared;
+      Domain.join domain_typer;
       Os_ipc.server_close server
 end
 
@@ -65,7 +70,13 @@ 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 shared = Mpipeline.create_shared () in
+    let domain_typer = Domain.spawn @@ Mpipeline.domain_typer shared in
+    let vexit = New_merlin.run ~new_env:None None args shared in
+    Mpipeline.close_typer shared;
+    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") :: _ ->
diff --git a/src/frontend/ocamlmerlin/old/old_command.ml b/src/frontend/ocamlmerlin/old/old_command.ml
index 829729315b..10bdb7cbd8 100644
--- a/src/frontend/ocamlmerlin/old/old_command.ml
+++ b/src/frontend/ocamlmerlin/old/old_command.ml
@@ -126,7 +126,9 @@ let checkout_buffer =
       end;
       buffer
 
-let make_pipeline config buffer = Mpipeline.make config buffer.source
+let make_pipeline config buffer =
+  let shared = Mpipeline.create_shared () in
+  Mpipeline.make config buffer.source shared |> Option.get
 
 let dispatch_sync config state (type a) : a sync_command -> a = function
   | Idle_job -> false
diff --git a/src/frontend/query_commands.ml b/src/frontend/query_commands.ml
index 057a8bacee..27deeae8e3 100644
--- a/src/frontend/query_commands.ml
+++ b/src/frontend/query_commands.ml
@@ -62,8 +62,15 @@ let print_completion_entries ~with_types config source entries =
     List.rev_map ~f:(Completion.map_entry postprocess) entries)
   else List.rev_map ~f:(Completion.map_entry (fun _ -> "")) entries
 
-let for_completion pipeline position =
-  let pipeline = Mpipeline.for_completion position pipeline in
+let for_completion pipeline _position =
+  (* TODO
+
+  This functions is an issue because of the removal of laziness (and the fact that the pipeline computation is now done by another domain than the one calling this function !).
+
+  This quick patch needs to be corrected or at least properly validated. It breaks a single tests that is about completion with labels.  
+*)
+  (*
+  let pipeline = Mpipeline.for_completion position pipeline in *)
   let typer = Mpipeline.typer_result pipeline in
   (pipeline, typer)
 
diff --git a/src/kernel/domain_msg.ml b/src/kernel/domain_msg.ml
new file mode 100644
index 0000000000..8041112491
--- /dev/null
+++ b/src/kernel/domain_msg.ml
@@ -0,0 +1,22 @@
+type from_main = [ `Empty | `Closing | `Waiting | `Cancel ]
+type from_typer = [ `Empty | `Exn of exn ]
+
+type msg = { from_main : from_main Atomic.t; from_typer : from_typer Atomic.t }
+
+let create () =
+  { from_main = Atomic.make `Empty; from_typer = Atomic.make `Empty }
+
+let send_msg msg new_msg signal_on =
+  (* CAS could be replaced by `set` here *)
+  if Atomic.compare_and_set msg `Empty new_msg then
+    while Atomic.get msg == new_msg do
+      Shared.signal signal_on
+    done
+  else failwith "send_msg: should not happen."
+
+exception Cancel_or_Closing
+
+(*  TODO @xvw 
+    Type completion needs to be changed for whatever type you defined to describe how far the typer must go. 
+*)
+type completion = All | Partial of { line : int; column : int }
diff --git a/src/kernel/mocaml.mli b/src/kernel/mocaml.mli
index 62b45e5525..2e9c9fee87 100644
--- a/src/kernel/mocaml.mli
+++ b/src/kernel/mocaml.mli
@@ -1,5 +1,5 @@
 (* An instance of load path, environment cache & btype unification log  *)
-type typer_state
+type typer_state = Local_store.store
 
 val new_state : unit -> typer_state
 val with_state : typer_state -> (unit -> 'a) -> 'a
diff --git a/src/kernel/mpipeline.ml b/src/kernel/mpipeline.ml
index 2180675a74..a7429cf4d3 100644
--- a/src/kernel/mpipeline.ml
+++ b/src/kernel/mpipeline.ml
@@ -4,23 +4,22 @@ let { Logger.log } = Logger.for_section "Pipeline"
 
 let time_shift = ref 0.0
 
-let timed_lazy r x =
-  lazy
-    (let start = Misc.time_spent () in
-     let time_shift0 = !time_shift in
-     let update () =
-       let delta = Misc.time_spent () -. start in
-       let shift = !time_shift -. time_shift0 in
-       time_shift := time_shift0 +. delta;
-       r := !r +. delta -. shift
-     in
-     match Lazy.force x with
-     | x ->
-       update ();
-       x
-     | exception exn ->
-       update ();
-       Std.reraise exn)
+let timed r x =
+  let start = Misc.time_spent () in
+  let time_shift0 = !time_shift in
+  let update () =
+    let delta = Misc.time_spent () -. start in
+    let shift = !time_shift -. time_shift0 in
+    time_shift := time_shift0 +. delta;
+    r := !r +. delta -. shift
+  in
+  match x () with
+  | x ->
+    update ();
+    x
+  | exception exn ->
+    update ();
+    Std.reraise exn
 
 module Cache = struct
   let cache = ref []
@@ -65,7 +64,7 @@ module Cache = struct
 end
 
 module Typer = struct
-  type t = { errors : exn list lazy_t; result : Mtyper.result }
+  type t = { errors : exn list; result : Mtyper.result }
 end
 
 module Ppx = struct
@@ -82,10 +81,10 @@ type t =
   { config : Mconfig.t;
     state : Mocaml.typer_state;
     raw_source : Msource.t;
-    source : (Msource.t * Mreader.parsetree option) lazy_t;
-    reader : Reader.t lazy_t;
-    ppx : Ppx.t lazy_t;
-    typer : Typer.t lazy_t;
+    source : Msource.t * Mreader.parsetree option;
+    reader : Reader.t;
+    ppx : Ppx.t;
+    typer : Typer.t;
     pp_time : float ref;
     reader_time : float ref;
     ppx_time : float ref;
@@ -99,7 +98,7 @@ type t =
 let raw_source t = t.raw_source
 
 let input_config t = t.config
-let input_source t = fst (Lazy.force t.source)
+let input_source t = fst t.source
 
 let with_pipeline t f =
   Mocaml.with_state t.state @@ fun () ->
@@ -110,10 +109,10 @@ let get_lexing_pos t pos =
     ~filename:(Mconfig.filename t.config)
     pos
 
-let reader t = Lazy.force t.reader
+let reader t = t.reader
 
-let ppx t = Lazy.force t.ppx
-let typer t = Lazy.force t.typer
+let ppx t = t.ppx
+let typer t = t.typer
 
 let reader_config t = (reader t).config
 let reader_parsetree t = (reader t).result.Mreader.parsetree
@@ -131,7 +130,7 @@ let ppx_errors t = (ppx t).Ppx.errors
 let final_config t = (ppx t).Ppx.config
 
 let typer_result t = (typer t).Typer.result
-let typer_errors t = Lazy.force (typer t).Typer.errors
+let typer_errors t = (typer t).Typer.errors
 
 module Reader_phase = struct
   type t =
@@ -220,19 +219,28 @@ end
 
 module Ppx_with_cache = Phase_cache.With_cache (Ppx_phase)
 
-let process ?state ?(pp_time = ref 0.0) ?(reader_time = ref 0.0)
+type shared =
+  { msg : Domain_msg.msg;
+    config : (Mconfig.t * Msource.t * (int * int) option) option Shared.t;
+    (* Partial result *)
+    partial : t option Shared.t;
+    (* Use to protect typer computation *)
+    result : unit Shared.t
+  }
+
+let process ?position ?state ?(pp_time = ref 0.0) ?(reader_time = ref 0.0)
     ?(ppx_time = ref 0.0) ?(typer_time = ref 0.0) ?(error_time = ref 0.0)
     ?(ppx_cache_hit = ref false) ?(reader_cache_hit = ref false)
-    ?(typer_cache_stats = ref Mtyper.Miss) ?for_completion config raw_source =
+    ?(typer_cache_stats = ref Mtyper.Miss) ?for_completion config raw_source
+    shared =
   let state =
     match state with
     | None -> Cache.get config
     | Some state -> state
   in
   let source =
-    timed_lazy pp_time
-      (lazy
-        (match Mconfig.(config.ocaml.pp) with
+    timed pp_time (fun () ->
+        match Mconfig.(config.ocaml.pp) with
         | None -> (raw_source, None)
         | Some { workdir; workval } -> (
           let source = Msource.text raw_source in
@@ -242,94 +250,132 @@ let process ?state ?(pp_time = ref 0.0) ?(reader_time = ref 0.0)
               ~source ~pp:workval
           with
           | `Source source -> (Msource.make source, None)
-          | (`Interface _ | `Implementation _) as ast -> (raw_source, Some ast))))
+          | (`Interface _ | `Implementation _) as ast -> (raw_source, Some ast)))
   in
   let reader =
-    timed_lazy reader_time
-      (lazy
-        (let (lazy ((_, pp_result) as source)) = source in
-         let config = Mconfig.normalize config in
-         Mocaml.setup_reader_config config;
-         let cache_disabling =
-           match (config.merlin.use_ppx_cache, pp_result) with
-           | false, _ -> Some "configuration"
-           | true, Some _ ->
-             (* The cache could be refined in the future to also act on the
+    timed reader_time (fun () ->
+        let ((_, pp_result) as source) = source in
+        let config = Mconfig.normalize config in
+        Mocaml.setup_reader_config config;
+        let cache_disabling =
+          match (config.merlin.use_ppx_cache, pp_result) with
+          | false, _ -> Some "configuration"
+          | true, Some _ ->
+            (* The cache could be refined in the future to also act on the
                 PP phase. For now, let's disable the whole cache when there's
                 a PP. *)
-             Some "source preprocessor usage"
-           | true, None -> None
-         in
-         let { Reader_with_cache.output = { result; cache_version };
-               cache_was_hit
-             } =
-           Reader_with_cache.apply ~cache_disabling
-             { source; for_completion; config }
-         in
-         reader_cache_hit := cache_was_hit;
-         let cache_version =
-           if Option.is_some cache_disabling then None else Some cache_version
-         in
-         { Reader.result; config; cache_version }))
+            Some "source preprocessor usage"
+          | true, None -> None
+        in
+        let { Reader_with_cache.output = { result; cache_version };
+              cache_was_hit
+            } =
+          Reader_with_cache.apply ~cache_disabling
+            { source; for_completion; config }
+        in
+        reader_cache_hit := cache_was_hit;
+        let cache_version =
+          if Option.is_some cache_disabling then None else Some cache_version
+        in
+        { Reader.result; config; cache_version })
   in
   let ppx =
-    timed_lazy ppx_time
-      (lazy
-        (let (lazy
-               { Reader.result = { Mreader.parsetree; _ };
-                 config;
-                 cache_version
-               }) =
-           reader
-         in
-         let caught = ref [] in
-         Msupport.catch_errors Mconfig.(config.ocaml.warnings) caught
-         @@ fun () ->
-         (* Currently the cache is invalidated even for source changes that don't
+    timed ppx_time (fun () ->
+        let { Reader.result = { Mreader.parsetree; _ }; config; cache_version }
+            =
+          reader
+        in
+        let caught = ref [] in
+        Msupport.catch_errors Mconfig.(config.ocaml.warnings) caught
+        @@ fun () ->
+        (* Currently the cache is invalidated even for source changes that don't
              change the parsetree. To avoid that, we'd have to digest the
              parsetree in the cache. *)
-         let cache_disabling, reader_cache =
-           match cache_version with
-           | Some v -> (None, Ppx_phase.Version v)
-           | None -> (Some "reader cache is disabled", Off)
-         in
-         let { Ppx_with_cache.output = parsetree; cache_was_hit } =
-           Ppx_with_cache.apply ~cache_disabling
-             { parsetree; config; reader_cache }
-         in
-         ppx_cache_hit := cache_was_hit;
-         { Ppx.config; parsetree; errors = !caught }))
+        let cache_disabling, reader_cache =
+          match cache_version with
+          | Some v -> (None, Ppx_phase.Version v)
+          | None -> (Some "reader cache is disabled", Off)
+        in
+        let { Ppx_with_cache.output = parsetree; cache_was_hit } =
+          Ppx_with_cache.apply ~cache_disabling
+            { parsetree; config; reader_cache }
+        in
+        ppx_cache_hit := cache_was_hit;
+        { Ppx.config; parsetree; errors = !caught })
   in
-  let typer =
-    timed_lazy typer_time
-      (lazy
-        (let (lazy { Ppx.config; parsetree; _ }) = ppx in
-         Mocaml.setup_typer_config config;
-         let result = Mtyper.run config parsetree in
-         let errors = timed_lazy error_time (lazy (Mtyper.get_errors result)) in
-         typer_cache_stats := Mtyper.get_cache_stat result;
-         { Typer.errors; result }))
+  let cache_and_return_typer result =
+    let errors = timed error_time (fun () -> Mtyper.get_errors result) in
+    typer_cache_stats := Mtyper.get_cache_stat result;
+    { Typer.errors; result }
   in
-  { config;
-    state;
-    raw_source;
-    source;
-    reader;
-    ppx;
-    typer;
-    pp_time;
-    reader_time;
-    ppx_time;
-    typer_time;
-    error_time;
-    ppx_cache_hit;
-    reader_cache_hit;
-    typer_cache_stats
-  }
-
-let make config source = process (Mconfig.normalize config) source
 
-let for_completion position
+  let typer_has_been_shared = ref false in
+  let typer =
+    match
+      timed typer_time (fun () ->
+          let { Ppx.config; parsetree; _ } = ppx in
+          Mocaml.setup_typer_config config;
+          let result =
+            Mtyper.(
+              run config
+                (make_partial ?position shared.msg shared.result)
+                parsetree)
+          in
+          cache_and_return_typer result)
+    with
+    | res -> res
+    | effect Mtyper.(Partial result), k ->
+      let typer = cache_and_return_typer result in
+      let mpipeline =
+        { config;
+          state;
+          raw_source;
+          source;
+          reader;
+          ppx;
+          typer;
+          pp_time;
+          reader_time;
+          ppx_time;
+          typer_time;
+          error_time;
+          ppx_cache_hit;
+          reader_cache_hit;
+          typer_cache_stats
+        }
+      in
+      Shared.locking_set shared.partial (Some mpipeline);
+      typer_has_been_shared := true;
+      (* Back to [Mtyper.run] *)
+      Effect.Deep.continue k ()
+  in
+  if !typer_has_been_shared then
+    (* assert (Option.is_some position); *)
+    None
+  else
+    (* assert (position = None); *)
+    Some
+      { config;
+        state;
+        raw_source;
+        source;
+        reader;
+        ppx;
+        typer;
+        pp_time;
+        reader_time;
+        ppx_time;
+        typer_time;
+        error_time;
+        ppx_cache_hit;
+        reader_cache_hit;
+        typer_cache_stats
+      }
+
+let make ?position config source shared =
+  process ?position (Mconfig.normalize config) source shared
+
+(* let for_completion position
     { config;
       state;
       raw_source;
@@ -341,7 +387,7 @@ let for_completion position
       _
     } =
   process config raw_source ~for_completion:position ~state ~pp_time
-    ~reader_time ~ppx_time ~typer_time ~error_time
+    ~reader_time ~ppx_time ~typer_time ~error_time *)
 
 let timing_information t =
   [ ("pp", !(t.pp_time));
@@ -351,9 +397,9 @@ let timing_information t =
     ("error", !(t.error_time))
   ]
 
-let cache_information t =
+let cache_information pipeline =
   let typer =
-    match !(t.typer_cache_stats) with
+    match !(pipeline.typer_cache_stats) with
     | Miss -> `String "miss"
     | Hit { reused; typed } ->
       `Assoc [ ("reused", `Int reused); ("typed", `Int typed) ]
@@ -367,9 +413,98 @@ let cache_information t =
   Cmi_cache.clear_cache_stats ();
   let fmt_bool hit = `String (if hit then "hit" else "miss") in
   `Assoc
-    [ ("reader_phase", fmt_bool !(t.reader_cache_hit));
-      ("ppx_phase", fmt_bool !(t.ppx_cache_hit));
+    [ ("reader_phase", fmt_bool !(pipeline.reader_cache_hit));
+      ("ppx_phase", fmt_bool !(pipeline.ppx_cache_hit));
       ("typer", typer);
       ("cmt", cmt);
       ("cmi", cmi)
     ]
+
+(* Represents the different possible communications between the two domains: 
+  + From Main to Typer :
+    - request is canceled
+    - merlin is closing
+    - main domain is waiting for the lock
+
+  + From Typer to Main :
+    - caught an exception 
+*)
+(* TODO : For message passing, it seems okay to have active waiting but it could be interesting to test both.
+*)
+
+(** [closing]: called by the main domain *)
+let close_typer shared =
+  Domain_msg.send_msg shared.msg.from_main `Closing shared.config
+
+(** [share_exn]: called by the typer domain *)
+let share_exn shared exn =
+  Domain_msg.send_msg shared.msg.from_typer (`Exn exn) shared.partial
+
+(** [cancel]: called by the main domain *)
+let _cancel shared =
+  Domain_msg.send_msg shared.msg.from_main `Cancel shared.config
+
+let domain_typer shared () =
+  let rec loop () =
+    match Atomic.get shared.msg.from_main with
+    | `Closing -> Atomic.set shared.msg.from_main `Empty
+    | `Waiting ->
+      while Atomic.get shared.msg.Domain_msg.from_main == `Waiting do
+        Domain.cpu_relax ()
+      done;
+      loop ()
+    | `Cancel ->
+      Atomic.set shared.msg.from_main `Empty;
+      loop ()
+    | `Empty -> (
+      match Shared.get shared.config with
+      | None ->
+        Shared.wait shared.config;
+        loop ()
+      | Some (config, source, potential_pos) ->
+        Shared.set shared.config None;
+        (try
+           match make ?position:potential_pos config source shared with
+           | Some _ as pipeline -> Shared.locking_set shared.partial pipeline
+           | None -> (* result already shared *) ()
+         with
+        | Domain_msg.Cancel_or_Closing -> ()
+        | Mtyper.Exn_after_partial ->
+          (* An exception has happened after sharing partial result: we can dump it *)
+          ()
+        | exn -> share_exn shared exn);
+        loop ())
+  in
+  Shared.protect shared.config (fun () -> loop ())
+
+let get ?position shared config source =
+  Shared.locking_set shared.config (Some (config, source, position));
+
+  let rec loop () =
+    let critical_section () =
+      match Shared.get shared.partial with
+      | None -> begin
+        match Atomic.get shared.msg.from_typer with
+        | `Empty ->
+          Shared.wait shared.partial;
+          `Retry
+        | `Exn exn ->
+          Atomic.set shared.msg.from_typer `Empty;
+          raise exn
+      end
+      | Some pipeline ->
+        Shared.set shared.partial None;
+        `Result pipeline
+    in
+    match Shared.protect shared.partial critical_section with
+    | `Retry -> loop ()
+    | `Result pipeline -> pipeline
+  in
+  loop ()
+
+let create_shared () =
+  { msg = Domain_msg.create ();
+    result = Shared.create ();
+    config = Shared.create None;
+    partial = Shared.create None
+  }
diff --git a/src/kernel/mpipeline.mli b/src/kernel/mpipeline.mli
index f6f1d21df6..8a5402ecbc 100644
--- a/src/kernel/mpipeline.mli
+++ b/src/kernel/mpipeline.mli
@@ -1,7 +1,21 @@
 type t
-val make : Mconfig.t -> Msource.t -> t
+
+type shared =
+  { msg : Domain_msg.msg;
+    config : (Mconfig.t * Msource.t * (int * int) option) option Shared.t;
+    (* Partial result *)
+    partial : t option Shared.t;
+    (* Use to protect typer computation *)
+    result : unit Shared.t
+  }
+
+(* Except inside Mpipeline, this function should only use in old_merlin *)
+val make : ?position:int * int -> Mconfig.t -> Msource.t -> shared -> t option
+
+(* Except inside Mpipeline, this function should only use in old_merlin *)
 val with_pipeline : t -> (unit -> 'a) -> 'a
-val for_completion : Msource.position -> t -> t
+
+(* val for_completion : Msource.position -> t -> t *)
 
 val raw_source : t -> Msource.t
 
@@ -27,3 +41,14 @@ val typer_errors : t -> exn list
 
 val timing_information : t -> (string * float) list
 val cache_information : t -> Std.json
+
+module Cache : sig
+  val get : Mconfig.t -> Mocaml.typer_state
+end
+
+val create_shared : unit -> shared
+val close_typer : shared -> unit
+val share_exn : shared -> exn -> unit
+
+val domain_typer : shared -> unit -> unit
+val get : ?position:int * int -> shared -> Mconfig.t -> Msource.t -> t
diff --git a/src/kernel/msource.ml b/src/kernel/msource.ml
index b975cc556f..59a367c7a1 100644
--- a/src/kernel/msource.ml
+++ b/src/kernel/msource.ml
@@ -114,6 +114,10 @@ let get_lexing_pos t ~filename pos =
     pos_cnum = o
   }
 
+let get_position t pos =
+  let (`Logical (line, col)) = get_logical t pos in
+  (line, col)
+
 let substitute t starting ending text =
   let len = String.length t.text in
   let (`Offset starting) = get_offset t starting in
diff --git a/src/kernel/msource.mli b/src/kernel/msource.mli
index ff0b72b9e0..1472fcc0ce 100644
--- a/src/kernel/msource.mli
+++ b/src/kernel/msource.mli
@@ -29,6 +29,8 @@ val get_logical : t -> [< position ] -> [> `Logical of int * int ]
 
 val get_lexing_pos : t -> filename:string -> [< position ] -> Lexing.position
 
+val get_position : t -> [< position ] -> int * int
+
 (** {1 Managing content} *)
 
 (** Updating content *)
diff --git a/src/kernel/mtyper.ml b/src/kernel/mtyper.ml
index 942a1808d5..cf63f20aa7 100644
--- a/src/kernel/mtyper.ml
+++ b/src/kernel/mtyper.ml
@@ -105,50 +105,140 @@ let compatible_prefix result_items tree_items =
   in
   aux [] (result_items, tree_items)
 
-let rec type_structure caught env = function
-  | parsetree_item :: rest ->
-    let items, _, part_env =
-      Typemod.merlin_type_structure env [ parsetree_item ]
-    in
-    let typedtree_items =
-      (items.Typedtree.str_items, items.Typedtree.str_type)
-    in
-    let item =
-      { parsetree_item;
-        typedtree_items;
-        part_env;
-        part_snapshot = Btype.snapshot ();
-        part_stamp = Ident.get_currentstamp ();
-        part_uid = Shape.Uid.get_current_stamp ();
-        part_errors = !caught;
-        part_checks = !Typecore.delayed_checks;
-        part_warnings = Warnings.backup ()
-      }
-    in
-    item :: type_structure caught part_env rest
-  | [] -> []
+type partial =
+  { msg : Domain_msg.msg; shared : unit Shared.t; comp : Domain_msg.completion }
 
-let rec type_signature caught env = function
-  | parsetree_item :: rest ->
-    let { Typedtree.sig_final_env = part_env; sig_items; sig_type } =
-      Typemod.merlin_transl_signature env [ parsetree_item ]
-    in
-    let item =
-      { parsetree_item;
-        typedtree_items = (sig_items, sig_type);
-        part_env;
-        part_snapshot = Btype.snapshot ();
-        part_stamp = Ident.get_currentstamp ();
-        part_uid = Shape.Uid.get_current_stamp ();
-        part_errors = !caught;
-        part_checks = !Typecore.delayed_checks;
-        part_warnings = Warnings.backup ()
-      }
-    in
-    item :: type_signature caught part_env rest
-  | [] -> []
+let make_partial ?position msg shared =
+  let comp =
+    match position with
+    | None -> Domain_msg.All
+    | Some (line, column) -> Domain_msg.Partial { line; column }
+  in
+  { msg; shared; comp }
+
+exception Exn_after_partial
+exception
+  Cancel_struc of (Parsetree.structure_item, Typedtree.structure_item) item list
+exception
+  Cancel_sig of (Parsetree.signature_item, Typedtree.signature_item) item list
+
+let continue_typing comp get_location item =
+  match comp with
+  | Domain_msg.All -> true
+  | Partial { line; column } -> (
+    let loc = get_location item in
+    let start = loc.Location.loc_start in
+    match Int.compare line start.pos_lnum with
+    | 0 -> Int.compare column (Lexing.column start) >= 0
+    | i -> i >= 0)
+
+(* TODO It should be possible to cache the result in case an exception is raised 
+during typing by encapsulating the partial result (before the exception) and the 
+exception in an other exception, catched by type_implementation.  *)
+let type_structure caught { msg; shared; comp } env parsetree =
+  (*  TODO @xvw *)
+  let continue_typing = continue_typing comp (fun i -> i.Parsetree.pstr_loc) in
+
+  let rec loop env parsetree acc =
+    (match Atomic.get msg.Domain_msg.from_main with
+    | `Empty -> ()
+    | `Waiting ->
+      while Atomic.get msg.Domain_msg.from_main == `Waiting do
+        Domain.cpu_relax ()
+      done
+    | `Closing -> raise Domain_msg.Cancel_or_Closing
+    | `Cancel ->
+      (* Cancel_struct is catched by type_implementation where the partial 
+      result is going to get cached *)
+      raise (Cancel_struc acc));
+
+    Shared.lock shared;
+    match parsetree with
+    | parsetree_item :: rest ->
+      let items, _, part_env =
+        Typemod.merlin_type_structure env [ parsetree_item ]
+      in
+      let typedtree_items =
+        (items.Typedtree.str_items, items.Typedtree.str_type)
+      in
+      let item =
+        { parsetree_item;
+          typedtree_items;
+          part_env;
+          part_snapshot = Btype.snapshot ();
+          part_stamp = Ident.get_currentstamp ();
+          part_uid = Shape.Uid.get_current_stamp ();
+          part_errors = !caught;
+          part_checks = !Typecore.delayed_checks;
+          part_warnings = Warnings.backup ()
+        }
+      in
+      Shared.unlock shared;
+      (*  TODO @xvw *)
+      if not (continue_typing parsetree_item) then (env, rest, item :: acc)
+      else loop part_env rest (item :: acc)
+    | [] ->
+      Shared.unlock shared;
+      (env, [], List.rev acc)
+  in
+  loop env parsetree []
+
+let type_signature caught { msg; shared; comp } env parsetree =
+  (*  TODO @xvw *)
+  let continue_typing = continue_typing comp (fun i -> i.Parsetree.psig_loc) in
+
+  let rec loop env parsetree acc =
+    (match Atomic.get msg.Domain_msg.from_main with
+    | `Empty -> ()
+    | `Waiting ->
+      while Atomic.get msg.Domain_msg.from_main == `Waiting do
+        Domain.cpu_relax ()
+      done
+    | `Closing -> raise Domain_msg.Cancel_or_Closing
+    | `Cancel ->
+      (* Cancel_sig is catched by type_interface where the partial 
+      result is going to get cached *)
+      raise (Cancel_sig acc));
+
+    Shared.lock shared;
 
-let type_implementation config caught parsetree =
+    match parsetree with
+    | parsetree_item :: rest ->
+      let { Typedtree.sig_final_env = part_env; sig_items; sig_type } =
+        Typemod.merlin_transl_signature env [ parsetree_item ]
+      in
+      let item =
+        { parsetree_item;
+          typedtree_items = (sig_items, sig_type);
+          part_env;
+          part_snapshot = Btype.snapshot ();
+          part_stamp = Ident.get_currentstamp ();
+          part_uid = Shape.Uid.get_current_stamp ();
+          part_errors = !caught;
+          part_checks = !Typecore.delayed_checks;
+          part_warnings = Warnings.backup ()
+        }
+      in
+      Shared.unlock shared;
+      (*  TODO @xvw *)
+      if not (continue_typing parsetree_item) then (env, rest, item :: acc)
+      else loop part_env rest (item :: acc)
+    | [] ->
+      Shared.unlock shared;
+      (env, [], List.rev acc)
+  in
+  loop env parsetree []
+
+open Effect
+open Effect.Deep
+
+type _ Effect.t +=
+  | Internal_partial :
+      typedtree_items cache_result * typer_cache_stats
+      -> unit t
+  | Partial : result -> unit t
+
+let type_implementation config caught partial parsetree =
   let { env; snapshot; ident_stamp; uid_stamp; value = prefix; index; _ } =
     get_cache config
   in
@@ -172,19 +262,40 @@ let type_implementation config caught parsetree =
   Stamped_hashtable.backtrack !index_changelog ~stamp;
   Env.cleanup_usage_tables ~stamp:uid_stamp';
   Shape.Uid.restore_stamp uid_stamp';
-  let suffix = type_structure caught env' parsetree in
-  let () =
-    List.iteri
-      ~f:(fun i { typedtree_items = items, _; _ } ->
-        let stamp = stamp + i + 1 in
-        !index_items ~index ~stamp config (`Impl items))
-      suffix
+  let aux preprocessed_suffix suffix =
+    let () =
+      List.iteri
+        ~f:(fun i { typedtree_items = items, _; _ } ->
+          let stamp = stamp + i + 1 in
+          !index_items ~index ~stamp config (`Impl items))
+        suffix
+    in
+    let value =
+      `Implementation (List.rev_append prefix (preprocessed_suffix @ suffix))
+    in
+    return_and_cache { env; snapshot; ident_stamp; uid_stamp; value; index }
   in
-  let value = `Implementation (List.rev_append prefix suffix) in
-  ( return_and_cache { env; snapshot; ident_stamp; uid_stamp; value; index },
-    cache_stats )
+  try
+    match partial.comp with
+    | All ->
+      let _, _, suffix = type_structure caught partial env' parsetree in
+      (aux [] suffix, cache_stats)
+    | Partial _ ->
+      let nenv, nparsetree, first_suffix =
+        type_structure caught partial env' parsetree
+      in
+      let partial_result = aux [] first_suffix in
+      perform (Internal_partial (partial_result, cache_stats));
+      let _, _, second_suffix =
+        type_structure caught { partial with comp = All } nenv nparsetree
+      in
+      (aux first_suffix second_suffix, cache_stats)
+  with Cancel_struc suffix ->
+    (* Caching before cancellation *)
+    aux [] suffix |> ignore;
+    raise Domain_msg.Cancel_or_Closing
 
-let type_interface config caught parsetree =
+let type_interface config caught partial parsetree =
   let { env; snapshot; ident_stamp; uid_stamp; value = prefix; index; _ } =
     get_cache config
   in
@@ -208,19 +319,44 @@ let type_interface config caught parsetree =
   Stamped_hashtable.backtrack !index_changelog ~stamp;
   Env.cleanup_usage_tables ~stamp:uid_stamp';
   Shape.Uid.restore_stamp uid_stamp';
-  let suffix = type_signature caught env' parsetree in
-  let () =
-    List.iteri
-      ~f:(fun i { typedtree_items = items, _; _ } ->
-        let stamp = stamp + i + 1 in
-        !index_items ~index ~stamp config (`Intf items))
-      suffix
+  let aux preprocessed_suffix suffix =
+    let () =
+      List.iteri
+        ~f:(fun i { typedtree_items = items, _; _ } ->
+          let stamp = stamp + i + 1 in
+          !index_items ~index ~stamp config (`Intf items))
+        suffix
+    in
+    let value =
+      `Interface (List.rev_append prefix (preprocessed_suffix @ suffix))
+    in
+    return_and_cache { env; snapshot; ident_stamp; uid_stamp; value; index }
   in
-  let value = `Interface (List.rev_append prefix suffix) in
-  ( return_and_cache { env; snapshot; ident_stamp; uid_stamp; value; index },
-    cache_stats )
+  try
+    match partial.comp with
+    | All ->
+      let _, _, suffix = type_signature caught partial env' parsetree in
+      (aux [] suffix, cache_stats)
+    | Partial _ -> (
+      let nenv, nparsetree, first_suffix =
+        type_signature caught partial env' parsetree
+      in
+      let partial_result = aux [] first_suffix in
+      try
+        begin
+          perform (Internal_partial (partial_result, cache_stats));
+          let _, _, second_suffix =
+            type_signature caught { partial with comp = All } nenv nparsetree
+          in
+          (aux first_suffix second_suffix, cache_stats)
+        end
+      with _ -> raise Exn_after_partial)
+  with Cancel_sig suffix ->
+    (* Caching before cancellation *)
+    aux [] suffix |> ignore;
+    raise Domain_msg.Cancel_or_Closing
 
-let run config parsetree =
+let run config partial parsetree =
   if not (Env.check_state_consistency ()) then (
     (* Resetting the local store will clear the load_path cache.
        Save it now, reset the store and then restore the path. *)
@@ -232,23 +368,33 @@ let run config parsetree =
   let caught = ref [] in
   Msupport.catch_errors Mconfig.(config.ocaml.warnings) caught @@ fun () ->
   Typecore.reset_delayed_checks ();
-  let cached_result, cache_stat =
-    match parsetree with
-    | `Implementation parsetree -> type_implementation config caught parsetree
-    | `Interface parsetree -> type_interface config caught parsetree
+
+  let aux cached_result cache_stat =
+    let stamp = Ident.get_currentstamp () in
+    Typecore.reset_delayed_checks ();
+    { config;
+      initial_env = cached_result.env;
+      initial_snapshot = cached_result.snapshot;
+      initial_stamp = cached_result.ident_stamp;
+      stamp;
+      initial_uid_stamp = cached_result.uid_stamp;
+      typedtree = cached_result.value;
+      index = cached_result.index;
+      cache_stat
+    }
   in
-  let stamp = Ident.get_currentstamp () in
-  Typecore.reset_delayed_checks ();
-  { config;
-    initial_env = cached_result.env;
-    initial_snapshot = cached_result.snapshot;
-    initial_stamp = cached_result.ident_stamp;
-    stamp;
-    initial_uid_stamp = cached_result.uid_stamp;
-    typedtree = cached_result.value;
-    index = cached_result.index;
-    cache_stat
-  }
+
+  match
+    match parsetree with
+    | `Implementation parsetree ->
+      type_implementation config caught partial parsetree
+    | `Interface parsetree -> type_interface config caught partial parsetree
+  with
+  | cached_result, cache_stat -> aux cached_result cache_stat
+  | effect Internal_partial (cached_result, cache_stat), k ->
+    let r = aux cached_result cache_stat in
+    perform (Partial r);
+    continue k ()
 
 let get_env ?pos:_ t =
   Option.value ~default:t.initial_env
diff --git a/src/kernel/mtyper.mli b/src/kernel/mtyper.mli
index 5723b721ce..c040f1a384 100644
--- a/src/kernel/mtyper.mli
+++ b/src/kernel/mtyper.mli
@@ -9,6 +9,11 @@
 
 type result
 
+type partial
+
+val make_partial :
+  ?position:int * int -> Domain_msg.msg -> unit Shared.t -> partial
+
 type typedtree =
   [ `Interface of Typedtree.signature | `Implementation of Typedtree.structure ]
 
@@ -26,7 +31,16 @@ val set_index_items :
   unit) ->
   unit
 
-val run : Mconfig.t -> Mreader.parsetree -> result
+type _ Effect.t += Partial : result -> unit Effect.t
+exception Exn_after_partial
+
+(** [run config partial parsetree]
+@perform the effect Partial. It is caught in [Mpipeline.process]).
+
+@raise [Domain_msg.Cancel] and [Domain_msg.Closing]. Botch are caught in
+[Mpipeline.domain_typer]).
+*)
+val run : Mconfig.t -> partial -> Mreader.parsetree -> result
 
 val get_env : ?pos:Msource.position -> result -> Env.t
 
diff --git a/src/ocaml/utils/local_store.ml b/src/ocaml/utils/local_store.ml
index b6d117ea3b..37061da88e 100644
--- a/src/ocaml/utils/local_store.ml
+++ b/src/ocaml/utils/local_store.ml
@@ -57,3 +57,12 @@ let with_store slots f =
     List.iter (fun (Slot s) -> s.value <- !(s.ref)) slots;
     global_bindings.is_bound <- false;
   )
+
+let open_store slots =
+  assert (not global_bindings.is_bound);
+  global_bindings.is_bound <- true;
+  List.iter (fun (Slot { ref; value }) -> ref := value) slots
+  
+let close_store slots =
+  List.iter (fun (Slot s) -> s.value <- !(s.ref)) slots;
+  global_bindings.is_bound <- false
\ No newline at end of file
diff --git a/src/ocaml/utils/local_store.mli b/src/ocaml/utils/local_store.mli
index 545cf71e02..22c51dbe06 100644
--- a/src/ocaml/utils/local_store.mli
+++ b/src/ocaml/utils/local_store.mli
@@ -65,3 +65,7 @@ val reset : unit -> unit
 val is_bound : unit -> bool
 (** Returns [true] when a store is active (i.e. when called from the callback
     passed to {!with_store}), [false] otherwise. *)
+
+
+val open_store : store -> unit
+val close_store : store -> unit 
\ No newline at end of file
diff --git a/src/utils/shared.ml b/src/utils/shared.ml
new file mode 100644
index 0000000000..37a81e7f51
--- /dev/null
+++ b/src/utils/shared.ml
@@ -0,0 +1,26 @@
+type 'a t = { mutex : Mutex.t; cond : Condition.t; mutable value : 'a }
+
+let locking_set t a =
+  Mutex.protect t.mutex @@ fun () ->
+  t.value <- a;
+  Condition.signal t.cond
+
+let set t a =
+  t.value <- a;
+  Condition.signal t.cond
+let locking_get t = Mutex.protect t.mutex @@ fun () -> t.value
+
+let get t = t.value
+
+let protect a f = Mutex.protect a.mutex f
+
+let signal a = Condition.signal a.cond
+
+let create a =
+  { mutex = Mutex.create (); cond = Condition.create (); value = a }
+
+let wait a = Condition.wait a.cond a.mutex
+
+let lock a = Mutex.lock a.mutex
+
+let unlock a = Mutex.unlock a.mutex
diff --git a/src/utils/shared.mli b/src/utils/shared.mli
new file mode 100644
index 0000000000..5945a208f9
--- /dev/null
+++ b/src/utils/shared.mli
@@ -0,0 +1,11 @@
+type 'a t = { mutex : Mutex.t; cond : Condition.t; mutable value : 'a }
+val locking_set : 'a t -> 'a -> unit
+val set : 'a t -> 'a -> unit
+val locking_get : 'a t -> 'a
+val get : 'a t -> 'a
+val create : 'a -> 'a t
+val protect : 'a t -> (unit -> 'b) -> 'b
+val signal : 'a t -> unit
+val wait : 'a t -> unit
+val lock : 'a t -> unit
+val unlock : 'a t -> unit
diff --git a/tests/test-dirs/completion/application_context.t/run.t b/tests/test-dirs/completion/application_context.t/run.t
index ec9fd7f409..09aedf73c5 100644
--- a/tests/test-dirs/completion/application_context.t/run.t
+++ b/tests/test-dirs/completion/application_context.t/run.t
@@ -4,7 +4,7 @@
   [
     "application",
     {
-      "argument_type": "'a",
+      "argument_type": "int",
       "labels": [
         {
           "name": "~j",