Skip to content

Commit

Permalink
refactor: simplify merlin diagnostics
Browse files Browse the repository at this point in the history
Updating the document with no changes is no longer needed because we
don't reuse the pipeline.

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

<!-- ps-id: a79143e1-01bc-4565-b900-ee5d97474ced -->
  • Loading branch information
rgrinberg committed Jan 11, 2023
1 parent 2d216d5 commit e0cbc79
Show file tree
Hide file tree
Showing 5 changed files with 17 additions and 42 deletions.
20 changes: 6 additions & 14 deletions ocaml-lsp-server/src/document.ml
Original file line number Diff line number Diff line change
Expand Up @@ -128,22 +128,15 @@ module Single_pipeline : sig
-> f:(Mpipeline.t -> 'a)
-> ('a, Exn_with_backtrace.t) result Fiber.t
end = struct
type t =
{ thread : Lev_fiber.Thread.t
; mutable last : (Text_document.t * Mconfig.t * Mpipeline.t) option
}
type t = { thread : Lev_fiber.Thread.t }

let create thread = { thread; last = None }
let create thread = { thread }

let use t ~doc ~config ~f =
let* config = Merlin_config.config config in
let make_pipeline =
match t.last with
| Some (doc', config', pipeline) when doc' == doc && config == config' ->
fun () -> pipeline
| _ ->
let source = Msource.make (Text_document.text doc) in
fun () -> Mpipeline.make config source
let source = Msource.make (Text_document.text doc) in
fun () -> Mpipeline.make config source
in
let task =
match
Expand All @@ -152,15 +145,15 @@ end = struct
let pipeline = make_pipeline () in
let res = Mpipeline.with_pipeline pipeline (fun () -> f pipeline) in
let stop = Unix.time () in
(res, pipeline, start, stop))
(res, start, stop))
with
| Error `Stopped -> assert false
| Ok task -> task
in
let* res = await task in
match res with
| Error exn -> Fiber.return (Error exn)
| Ok (res, pipeline, start, stop) ->
| Ok (res, start, stop) ->
let event =
let module Event = Chrome_trace.Event in
let dur = Event.Timestamp.of_float_seconds (stop -. start) in
Expand All @@ -172,7 +165,6 @@ end = struct
in
Event.complete ~dur fields
in
t.last <- Some (doc, config, pipeline);
let+ () = Metrics.report event in
Ok res
end
Expand Down
19 changes: 6 additions & 13 deletions ocaml-lsp-server/src/document_store.ml
Original file line number Diff line number Diff line change
Expand Up @@ -190,19 +190,12 @@ let get_semantic_tokens_cache : t -> Uri.t -> semantic_tokens_cache option =
let doc = get' t uri in
doc.semantic_tokens_cache

let change_all t ~f =
let all =
Table.foldi ~init:[] t.db ~f:(fun uri doc acc -> (uri, doc) :: acc)
in
Fiber.parallel_iter all ~f:(fun (uri, doc) ->
let+ doc =
match doc.document with
| None -> Fiber.return doc
| Some document ->
let+ document = f document in
{ doc with document = Some document }
in
Table.set t.db uri doc)
let parallel_iter t ~f =
let all = Table.fold ~init:[] t.db ~f:(fun doc acc -> doc :: acc) in
Fiber.parallel_iter all ~f:(fun doc ->
match doc.document with
| None -> Fiber.return ()
| Some document -> f document)

let fold t ~init ~f =
Table.fold t.db ~init ~f:(fun doc acc ->
Expand Down
2 changes: 1 addition & 1 deletion ocaml-lsp-server/src/document_store.mli
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,6 @@ val close_document : t -> Uri.t -> unit Fiber.t

val fold : t -> init:'acc -> f:(Document.t -> 'acc -> 'acc) -> 'acc

val change_all : t -> f:(Document.t -> Document.t Fiber.t) -> unit Fiber.t
val parallel_iter : t -> f:(Document.t -> unit Fiber.t) -> unit Fiber.t

val close_all : t -> unit Fiber.t
10 changes: 3 additions & 7 deletions ocaml-lsp-server/src/dune.ml
Original file line number Diff line number Diff line change
Expand Up @@ -263,15 +263,11 @@ end = struct
match p with
| Failed | Interrupted | Success ->
let* () =
Document_store.change_all document_store ~f:(fun doc ->
Document_store.parallel_iter document_store ~f:(fun doc ->
match Document.kind doc with
| `Other -> Fiber.return doc
| `Other -> Fiber.return ()
| `Merlin merlin ->
let doc = Document.update_text doc [] in
let+ () =
Diagnostics.merlin_diagnostics diagnostics merlin
in
doc)
Diagnostics.merlin_diagnostics diagnostics merlin)
in
Diagnostics.send diagnostics `All
| _ -> Fiber.return ())
Expand Down
8 changes: 1 addition & 7 deletions ocaml-lsp-server/src/ocaml_lsp_server.ml
Original file line number Diff line number Diff line change
Expand Up @@ -758,13 +758,7 @@ let on_notification server (notification : Client_notification.t) :
( Log.log ~section:"on receive DidSaveTextDocument" @@ fun () ->
Log.msg "saved document is not in the store" [] );
Fiber.return state
| Some _ ->
let doc =
Document_store.change_document store uri ~f:(fun doc ->
(* we need [update_text] with no changes to get a new merlin
pipeline; otherwise the diagnostics don't get updated *)
Document.update_text doc [])
in
| Some doc ->
let+ () = set_diagnostics state.detached (State.diagnostics state) doc in
state)
| ChangeWorkspaceFolders change ->
Expand Down

0 comments on commit e0cbc79

Please sign in to comment.