From 1d074722de48a53c22db5f64c408f965aad2f238 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 4 Jun 2024 16:40:17 +0200 Subject: [PATCH] occ: return list of out of sync files --- src/analysis/occurrences.ml | 53 +++++++++++++++++++--------------- src/analysis/occurrences.mli | 4 +-- src/frontend/query_commands.ml | 9 +++--- src/frontend/query_protocol.ml | 10 +++++-- 4 files changed, 44 insertions(+), 32 deletions(-) diff --git a/src/analysis/occurrences.ml b/src/analysis/occurrences.ml index b2672f198..eb1662379 100644 --- a/src/analysis/occurrences.ml +++ b/src/analysis/occurrences.ml @@ -3,7 +3,7 @@ module Lid_set = Index_format.Lid_set let {Logger. log} = Logger.for_section "occurrences" -type res = { locs: Warnings.loc list; synced: bool } +type t = { locs: Warnings.loc list; status: Query_protocol.occurrences_status } let set_fname ~file (loc : Location.t) = let pos_fname = file in @@ -170,11 +170,17 @@ module Stat_check : sig type t val create: cache_size:int -> Index_format.index -> t val check: t -> file:string -> bool + val get_outdated_files: t -> String.Set.t end = struct type t = { index : Index_format.index; cache : (string, bool) Hashtbl.t } let create ~cache_size index = { index; cache = Hashtbl.create cache_size } + let get_outdated_files t = + Hashtbl.fold + (fun file check acc -> if check then acc else String.Set.add file acc) + t.cache String.Set.empty + let stat t file = let open Index_format in match Stats.find_opt file t.index.stats with @@ -252,10 +258,9 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path = index_buffer ~scope ~current_buffer_path ~stamp ~local_defs () in let buffer_locs = Hashtbl.find_opt buffer_index def_uid in - let external_locs, desync = - if scope = `Buffer then [], false else begin - let file_changed = ref false in - let locs = List.filter_map config.merlin.index_files ~f:(fun file -> + let external_locs = + if scope = `Buffer then [] + else List.filter_map config.merlin.index_files ~f:(fun file -> let external_locs = try let external_index = Index_cache.read file in Index_format.Uid_map.find_opt def_uid external_index.defs @@ -274,24 +279,22 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path = else begin (* We ignore external results if their source was modified *) let check = Stat_check.check stats ~file in - if not check then begin + if not check then log ~title:"locs_of" "File %s might be out-of-sync." file; - file_changed := true - end; check - end) locs)) - in - locs, !file_changed - end + end) locs, + Stat_check.get_outdated_files stats)) + in + let external_locs, out_of_sync_files = + List.fold_left ~init:(Lid_set.empty, String.Set.empty) + ~f:(fun (acc_locs, acc_files) (locs, files) -> + (Lid_set.union acc_locs locs, String.Set.union acc_files files)) + (external_locs) in - if desync then log ~title:"locs_of" "External index might be out-of-sync."; let locs = - let all_locs = - match buffer_locs with - | Some buffer_locs -> buffer_locs :: external_locs - | None -> external_locs - in - List.fold_left ~init:Lid_set.empty ~f:Lid_set.union all_locs + match buffer_locs with + | Some buffer_locs -> Lid_set.union buffer_locs external_locs + | None -> external_locs in let locs = log ~title:"occurrences" "Found %i locs" (Lid_set.cardinal locs); @@ -320,9 +323,13 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path = Option.value_map ~default:false uid_comp_unit ~f:(String.equal @@ Env.get_unit_name ()) in - let synced = not desync in - if not def_uid_is_in_current_unit then Ok { locs; synced } + let status = match scope, String.Set.to_list out_of_sync_files with + | `Project, [] -> `Included + | `Project, l -> `Out_of_sync l + | `Buffer, _ -> `Not_requested + in + if not def_uid_is_in_current_unit then { locs; status } else let locs = set_fname ~file:current_buffer_path def_loc :: locs in - Ok { locs; synced } - | None -> Error "Could not find the definition [uid]" + { locs; status } + | None -> { locs = []; status = `No_def} diff --git a/src/analysis/occurrences.mli b/src/analysis/occurrences.mli index 4a60ac390..8a04da910 100644 --- a/src/analysis/occurrences.mli +++ b/src/analysis/occurrences.mli @@ -1,4 +1,4 @@ -type res = { locs: Warnings.loc list; synced: bool } +type t = { locs: Warnings.loc list; status: Query_protocol.occurrences_status } val locs_of : config:Mconfig.t @@ -7,4 +7,4 @@ val locs_of -> pos:Lexing.position -> scope:[`Project | `Buffer] -> string - -> (res, string) result + -> t diff --git a/src/frontend/query_commands.ml b/src/frontend/query_commands.ml index a8a8b5a43..97e12275a 100644 --- a/src/frontend/query_commands.ml +++ b/src/frontend/query_commands.ml @@ -808,11 +808,10 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = Locate.log ~title:"reconstructed identifier" "%s" path; path in - (match scope, Occurrences.locs_of ~config ~env ~typer_result ~pos ~scope path with - | `Buffer, Ok { locs; _ } -> locs, `Not_requested - | `Project, Ok { locs; synced = true } -> locs, `Included - | `Project, Ok { locs; synced = false } -> locs, `Out_of_sync - | _, Error _ -> [], `Included) + let { Occurrences.locs; status } = + Occurrences.locs_of ~config ~env ~typer_result ~pos ~scope path + in + locs, status | Version -> Printf.sprintf "The Merlin toolkit version %s, for Ocaml %s\n" diff --git a/src/frontend/query_protocol.ml b/src/frontend/query_protocol.ml index b6a243f10..341b8f758 100644 --- a/src/frontend/query_protocol.ml +++ b/src/frontend/query_protocol.ml @@ -107,6 +107,13 @@ type is_tail_position = [`No | `Tail_position | `Tail_call] type _ _bool = bool +type occurrences_status = [ + | `Not_requested + | `Out_of_sync of string list + | `No_def + | `Included +] + type _ t = | Type_expr(* *) : string * Msource.position @@ -207,7 +214,6 @@ type _ t = -> string list t | Occurrences(* *) : [`Ident_at of Msource.position] * [`Project | `Buffer] - -> (Location.t list - * [`Not_requested|`Out_of_sync|`No_def|`Included]) t + -> (Location.t list * occurrences_status) t | Version : string t