diff --git a/CHANGES.md b/CHANGES.md index 7602212bb8..17969ab129 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -5,6 +5,8 @@ unreleased - Support for OCaml 5.3 - Use new 5.3 features to improve locate behavior in some cases. Merlin no longer confuses uids from interfaces and implementations. (#1857) + - Add initial support for project-wide renaming: occurrences can now return + all usages of all related definitions. (#1877) + vim plugin - Added support for search-by-type (#1846) This is exposed through the existing `:MerlinSearch` command, that diff --git a/src/analysis/occurrences.ml b/src/analysis/occurrences.ml index cd9acd810a..c4a1d59662 100644 --- a/src/analysis/occurrences.ml +++ b/src/analysis/occurrences.ml @@ -155,26 +155,54 @@ let get_external_locs ~(config : Mconfig.t) ~current_buffer_path uid = locs, Stat_check.get_outdated_files stats ))) -let find_linked_uids ~config ~name uid = +let lookup_related_uids_in_indexes ~(config : Mconfig.t) uid = + let title = "lookup_related_uids_in_indexes" in + let open Index_format in + let related_uids = + List.fold_left ~init:Uid_map.empty config.merlin.index_files + ~f:(fun acc index_file -> + try + let index = Index_cache.read index_file in + Uid_map.union + (fun _ a b -> Some (Union_find.union ~f:Uid_set.union a b)) + index.related_uids acc + with Index_format.Not_an_index _ | Sys_error _ -> + log ~title "Could not load index %s" index_file; + acc) + in + Uid_map.find_opt uid related_uids + |> Option.value_map ~default:Uid_set.empty ~f:Union_find.get + |> Uid_set.to_list + +let find_linked_uids ~config ~scope ~name uid = let title = "find_linked_uids" in match uid with - | Shape.Uid.Item { from = _; comp_unit; _ } -> ( - let config = + | Shape.Uid.Item { from = _; comp_unit; _ } -> + let locate_config = { Locate.mconfig = config; ml_or_mli = `ML; traverse_aliases = false } in - match Locate.get_linked_uids ~config ~comp_unit uid with - | [ uid' ] -> - log ~title "Found linked uid: %a" Logger.fmt (fun fmt -> - Shape.Uid.print fmt uid'); - let name_check = - Locate.lookup_uid_decl ~config:config.mconfig uid' - |> Option.bind ~f:(Typedtree_utils.location_of_declaration ~uid:uid') - |> Option.value_map - ~f:(fun { Location.txt; _ } -> String.equal name txt) - ~default:false - in - if name_check then [ uid' ] else [] - | _ -> []) + let check_name uid = + Locate.lookup_uid_decl ~config uid + |> Option.bind ~f:(Typedtree_utils.location_of_declaration ~uid) + |> Option.value_map + ~f:(fun { Location.txt; _ } -> + let result = String.equal name txt in + if not result then + log ~title "Found clashing idents %S <> %S. Ignoring UID %a." + name txt Logger.fmt + (Fun.flip Shape.Uid.print uid); + result) + ~default:false + in + let related_uids = + match scope with + | `Buffer -> [] + | `Project -> Locate.get_linked_uids ~config:locate_config ~comp_unit uid + | `Renaming -> lookup_related_uids_in_indexes ~config uid + in + log ~title "Found related uids: [%a]" Logger.fmt (fun fmt -> + List.iter ~f:(fprintf fmt "%a;" Shape.Uid.print) related_uids); + List.filter ~f:check_name related_uids | _ -> [] let locs_of ~config ~env ~typer_result ~pos ~scope path = @@ -230,7 +258,7 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path = let name = String.split_on_char ~sep:'.' path |> List.last |> Option.get in - let additional_uids = find_linked_uids ~config ~name def_uid in + let additional_uids = find_linked_uids ~config ~scope ~name def_uid in List.concat_map (def_uid :: additional_uids) ~f:(get_external_locs ~config ~current_buffer_path) @@ -284,9 +312,9 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path = in let status = match (scope, String.Set.to_list out_of_sync_files) with - | `Project, [] -> `Included - | `Project, l -> `Out_of_sync l | `Buffer, _ -> `Not_requested + | _, [] -> `Included + | _, l -> `Out_of_sync l in if not def_uid_is_in_current_unit then { locs; status } else diff --git a/src/analysis/occurrences.mli b/src/analysis/occurrences.mli index d41d4d4070..ba6d8dcc94 100644 --- a/src/analysis/occurrences.mli +++ b/src/analysis/occurrences.mli @@ -6,6 +6,6 @@ val locs_of : env:Env.t -> typer_result:Mtyper.result -> pos:Lexing.position -> - scope:[ `Project | `Buffer ] -> + scope:[ `Project | `Buffer | `Renaming ] -> string -> t diff --git a/src/commands/new_commands.ml b/src/commands/new_commands.ml index 67a11911e1..ebf1aee4ae 100644 --- a/src/commands/new_commands.ml +++ b/src/commands/new_commands.ml @@ -509,6 +509,7 @@ let all_commands = match scope with | "buffer" -> (pos, `Buffer) | "project" -> (pos, `Project) + | "renaming" -> (pos, `Renaming) | _ -> failwith "-scope should be one of buffer or project")) ] ~doc: diff --git a/src/commands/query_json.ml b/src/commands/query_json.ml index b2b0fb5e3b..f9f2f75d8c 100644 --- a/src/commands/query_json.ml +++ b/src/commands/query_json.ml @@ -192,7 +192,8 @@ let dump (type a) : a t -> json = ( "scope", match scope with | `Buffer -> `String "local" - | `Project -> `String "project" ) + | `Project -> `String "project" + | `Renaming -> `String "renaming" ) ] | Refactor_open (action, pos) -> mk "refactor-open" @@ -488,7 +489,7 @@ let json_of_response (type a) (query : a t) (response : a) : json = | Extension_list _, strs -> `List (List.map ~f:Json.string strs) | Path_list _, strs -> `List (List.map ~f:Json.string strs) | Occurrences (_, scope), (locations, _project) -> - let with_file = scope = `Project in + let with_file = scope = `Project || scope = `Renaming in `List (List.map locations ~f:(fun loc -> with_location ~with_file loc [])) | Signature_help _, s -> json_of_signature_help s | Version, version -> `String version diff --git a/src/frontend/query_protocol.ml b/src/frontend/query_protocol.ml index 4ac5d92095..43b8c65779 100644 --- a/src/frontend/query_protocol.ml +++ b/src/frontend/query_protocol.ml @@ -212,7 +212,7 @@ type _ t = | Extension_list : [ `All | `Enabled | `Disabled ] -> string list t | Path_list : [ `Build | `Source ] -> string list t | Occurrences (* *) : - [ `Ident_at of Msource.position ] * [ `Project | `Buffer ] + [ `Ident_at of Msource.position ] * [ `Project | `Buffer | `Renaming ] -> (Location.t list * occurrences_status) t | Signature_help : signature_help -> signature_help_result option t (** In current version, Merlin only uses the parameter [position] to answer diff --git a/src/index-format/index_format.ml b/src/index-format/index_format.ml index 541455cc6f..848b0c08d0 100644 --- a/src/index-format/index_format.ml +++ b/src/index-format/index_format.ml @@ -18,6 +18,7 @@ end module Lid_set = Set.Make (Lid) module Uid_map = Shape.Uid.Map module Stats = Map.Make (String) +module Uid_set = Shape.Uid.Set let add map uid locs = Uid_map.update uid @@ -33,7 +34,8 @@ type index = approximated : Lid_set.t Uid_map.t; cu_shape : (string, Shape.t) Hashtbl.t; stats : stat Stats.t; - root_directory : string option + root_directory : string option; + related_uids : Uid_set.t Union_find.element Uid_map.t } let pp_partials (fmt : Format.formatter) (partials : Lid_set.t Uid_map.t) = @@ -52,6 +54,26 @@ let pp_partials (fmt : Format.formatter) (partials : Lid_set.t Uid_map.t) = partials; Format.fprintf fmt "@]}" +let pp_related_uids (fmt : Format.formatter) + (related_uids : Uid_set.t Union_find.element Uid_map.t) = + let rec gather acc map = + match Uid_map.choose_opt map with + | Some (_key, union) -> + let group = Union_find.get union |> Uid_set.to_list in + List.fold_left (fun acc key -> Uid_map.remove key acc) map group + |> gather (group :: acc) + | None -> acc + in + Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.fprintf fmt ";@;") + (fun fmt group -> + Format.fprintf fmt "(%a)" + (Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ") + Shape.Uid.print) + group) + fmt (gather [] related_uids) + let pp (fmt : Format.formatter) pl = Format.fprintf fmt "%i uids:@ {@[" (Uid_map.cardinal pl.defs); Uid_map.iter @@ -71,7 +93,8 @@ let pp (fmt : Format.formatter) pl = (Uid_map.cardinal pl.approximated) pp_partials pl.approximated; Format.fprintf fmt "and shapes for CUS %s.@ " - (String.concat ";@," (Hashtbl.to_seq_keys pl.cu_shape |> List.of_seq)) + (String.concat ";@," (Hashtbl.to_seq_keys pl.cu_shape |> List.of_seq)); + Format.fprintf fmt "and related uids:@[{%a}@]" pp_related_uids pl.related_uids let ext = "ocaml-index" diff --git a/src/index-format/index_format.mli b/src/index-format/index_format.mli index a69da5bc18..beded4158e 100644 --- a/src/index-format/index_format.mli +++ b/src/index-format/index_format.mli @@ -7,6 +7,7 @@ module Lid : Set.OrderedType with type t = Longident.t Location.loc module Lid_set : Set.S with type elt = Lid.t module Stats : Map.S with type key = String.t module Uid_map = Shape.Uid.Map +module Uid_set = Shape.Uid.Set type stat = { mtime : float; size : int; source_digest : string option } @@ -15,7 +16,8 @@ type index = approximated : Lid_set.t Uid_map.t; cu_shape : (string, Shape.t) Hashtbl.t; stats : stat Stats.t; - root_directory : string option + root_directory : string option; + related_uids : Uid_set.t Union_find.element Uid_map.t } val pp : Format.formatter -> index -> unit diff --git a/src/index-format/union_find.ml b/src/index-format/union_find.ml new file mode 100644 index 0000000000..246c147523 --- /dev/null +++ b/src/index-format/union_find.ml @@ -0,0 +1,38 @@ +type 'a content = + | Root of { mutable value : 'a; mutable rank : int } + | Link of { mutable parent : 'a element } +and 'a element = { mutable content : 'a content } + +let make value = { content = Root { value; rank = 0 } } + +let rec find x = + match x.content with + | Root _ -> x + | Link ({ parent; _ } as link) -> + let root = find parent in + if root != parent then link.parent <- root; + root + +let union ~f x y = + let x = find x in + let y = find y in + match (x, y) with + | x, y when x == y -> x + | ( { content = Root ({ rank = rank_x; value = value_x } as root_x); _ }, + { content = Root ({ rank = rank_y; value = value_y } as root_y); _ } ) -> + let new_value = f value_x value_y in + if rank_x < rank_y then ( + x.content <- Link { parent = y }; + root_y.value <- new_value; + y) + else ( + y.content <- Link { parent = x }; + root_x.value <- new_value; + if rank_x = rank_y then root_x.rank <- root_x.rank + 1; + x) + | _ -> assert false + +let get elt = + match (find elt).content with + | Root { value; _ } -> value + | Link _ -> assert false diff --git a/src/ocaml-index/lib/index.ml b/src/ocaml-index/lib/index.ml index 554880cc43..11a484dd36 100644 --- a/src/ocaml-index/lib/index.ml +++ b/src/ocaml-index/lib/index.ml @@ -82,6 +82,7 @@ let index_of_cmt ~root ~rewrite_root ~build_path ~do_not_use_cmt_loadpath cmt_initial_env; cmt_sourcefile; cmt_source_digest; + cmt_declaration_dependencies; _ } = cmt_infos @@ -128,15 +129,33 @@ let index_of_cmt ~root ~rewrite_root ~build_path ~do_not_use_cmt_loadpath } with Unix.Unix_error _ -> Stats.empty) in - { defs; approximated; cu_shape; stats; root_directory = None } + let related_uids = + List.fold_left + (fun acc (_, uid1, uid2) -> + let union = Union_find.make (Uid_set.of_list [ uid1; uid2 ]) in + let map_update uid = + Uid_map.update uid (function + | None -> Some union + | Some union' -> + Some (Union_find.union ~f:Uid_set.union union' union)) + in + acc |> map_update uid1 |> map_update uid2) + Uid_map.empty cmt_declaration_dependencies + in + { defs; approximated; cu_shape; stats; root_directory = None; related_uids } let merge_index ~store_shapes ~into index = let defs = merge index.defs into.defs in let approximated = merge index.approximated into.approximated in let stats = Stats.union (fun _ f1 _f2 -> Some f1) into.stats index.stats in + let related_uids = + Uid_map.union + (fun _ a b -> Some (Union_find.union ~f:Uid_set.union a b)) + index.related_uids into.related_uids + in if store_shapes then Hashtbl.add_seq index.cu_shape (Hashtbl.to_seq into.cu_shape); - { into with defs; approximated; stats } + { into with defs; approximated; stats; related_uids } let from_files ~store_shapes ~output_file ~root ~rewrite_root ~build_path ~do_not_use_cmt_loadpath files = @@ -146,7 +165,8 @@ let from_files ~store_shapes ~output_file ~root ~rewrite_root ~build_path approximated = Shape.Uid.Map.empty; cu_shape = Hashtbl.create 64; stats = Stats.empty; - root_directory = root + root_directory = root; + related_uids = Uid_map.empty } in let final_index = diff --git a/src/ocaml-index/tests/tests-dirs/index-project.t b/src/ocaml-index/tests/tests-dirs/index-project.t index d521d6918a..44fa2ff07f 100644 --- a/src/ocaml-index/tests/tests-dirs/index-project.t +++ b/src/ocaml-index/tests/tests-dirs/index-project.t @@ -58,6 +58,7 @@ "+": File "main.ml", line 2, characters 14-15; "+": File "main.ml", line 4, characters 26-27 }, 0 approx shapes: {}, and shapes for CUS . + and related uids:{} $ ocaml-index dump foo.uideps 5 uids: @@ -71,6 +72,7 @@ "+": File "foo.ml", line 3, characters 11-12; "+": File "foo.ml", line 3, characters 19-20 }, 0 approx shapes: {}, and shapes for CUS . + and related uids:{} @@ -116,6 +118,7 @@ "+": File "main.ml", line 2, characters 14-15; "+": File "main.ml", line 4, characters 26-27 }, 0 approx shapes: {}, and shapes for CUS . + and related uids:{} $ ocaml-index stats foo.uideps test.uideps Index "test.uideps" contains: diff --git a/src/ocaml-index/tests/tests-dirs/interfaces.t b/src/ocaml-index/tests/tests-dirs/interfaces.t index 7514c55cf2..ecbd20face 100644 --- a/src/ocaml-index/tests/tests-dirs/interfaces.t +++ b/src/ocaml-index/tests/tests-dirs/interfaces.t @@ -22,3 +22,4 @@ uid: Stdlib__Float.81; locs: "Float.t": File "main.mli", line 1, characters 9-16 }, 0 approx shapes: {}, and shapes for CUS . + and related uids:{} diff --git a/src/ocaml-index/tests/tests-dirs/local-shape-and-include.t b/src/ocaml-index/tests/tests-dirs/local-shape-and-include.t index 1111fef1db..548196af8b 100644 --- a/src/ocaml-index/tests/tests-dirs/local-shape-and-include.t +++ b/src/ocaml-index/tests/tests-dirs/local-shape-and-include.t @@ -36,6 +36,7 @@ uid: Stdlib__String.174; locs: "String.equal": File "main.ml", line 1, characters 8-20 }, 0 approx shapes: {}, and shapes for CUS . + and related uids:{(Main.3 Main.4)} $ ocaml-index dump test.uideps @@ -53,4 +54,5 @@ uid: Stdlib__String.174; locs: "String.equal": File "main.ml", line 1, characters 8-20 }, 0 approx shapes: {}, and shapes for CUS . + and related uids:{(Main.3 Main.4)} diff --git a/src/ocaml-index/tests/tests-dirs/transitive-deps.t b/src/ocaml-index/tests/tests-dirs/transitive-deps.t index df75b37c32..8e9fec07ba 100644 --- a/src/ocaml-index/tests/tests-dirs/transitive-deps.t +++ b/src/ocaml-index/tests/tests-dirs/transitive-deps.t @@ -33,11 +33,13 @@ uid: Stdlib__List.45; locs: "List.init": File "main.ml", line 1, characters 8-17 }, 0 approx shapes: {}, and shapes for CUS . + and related uids:{} $ ocaml-index dump lib1/foo.uideps 1 uids: {uid: Bar; locs: "Bar": File "lib1/foo.ml", line 1, characters 8-11 }, 0 approx shapes: {}, and shapes for CUS . + and related uids:{} $ ocaml-index dump test.uideps 5 uids: @@ -50,4 +52,5 @@ uid: Stdlib__List.45; locs: "List.init": File "main.ml", line 1, characters 8-17 }, 0 approx shapes: {}, and shapes for CUS . + and related uids:{} diff --git a/tests/test-dirs/occurrences/project-wide/for-renaming/r-modules-and-types.t b/tests/test-dirs/occurrences/project-wide/for-renaming/r-modules-and-types.t new file mode 100644 index 0000000000..376e4c5910 --- /dev/null +++ b/tests/test-dirs/occurrences/project-wide/for-renaming/r-modules-and-types.t @@ -0,0 +1,91 @@ + $ cat >lib.mli <<'EOF' + > module type S = sig + > val x : unit + > end + > EOF + + $ cat >lib.ml <<'EOF' + > module type S = sig + > val x : unit + > end + > EOF + + $ cat >main.ml <<'EOF' + > module M : Lib.S = struct + > let x = () + > end + > let () = M.x + > EOF + + $ ocamlc -bin-annot -bin-annot-occurrences -c lib.mli lib.ml main.ml + $ ocaml-index aggregate *.cmti *.cmt + + $ ocaml-index dump project.ocaml-index + 6 uids: + {uid: [intf]Lib.0; locs: "x": File "lib.mli", line 2, characters 6-7 + uid: Lib.0; locs: "x": File "lib.ml", line 2, characters 6-7 + uid: [intf]Lib.1; locs: "S": File "lib.mli", line 1, characters 12-13 + uid: Lib.1; locs: + "S": File "lib.ml", line 1, characters 12-13; + "Lib.S": File "main.ml", line 1, characters 11-16 + uid: Main.0; locs: + "x": File "main.ml", line 2, characters 6-7; + "M.x": File "main.ml", line 4, characters 9-12 + uid: Main.1; locs: "M": File "main.ml", line 1, characters 7-8 }, + 0 approx shapes: {}, and shapes for CUS . + and related uids:{([intf]Lib.1 Lib.1); ([intf]Lib.0 Lib.0 Main.0)} + + $ $MERLIN single occurrences -scope renaming -identifier-at 4:11 \ + > -index-file project.ocaml-index \ + > -filename main.ml -filename main.ml -index-file project.ocaml-index \ diff --git a/tests/test-dirs/occurrences/project-wide/pwo-ml-gen.t b/tests/test-dirs/occurrences/project-wide/pwo-ml-gen.t index b3c0a34e46..b1c7a824e4 100644 --- a/tests/test-dirs/occurrences/project-wide/pwo-ml-gen.t +++ b/tests/test-dirs/occurrences/project-wide/pwo-ml-gen.t @@ -43,6 +43,7 @@ We should not index generated modules (lib.ml-gen) "foo": File "lib/aux.ml", line 1, characters 4-7; "foo": File "lib/aux.ml", line 2, characters 8-11 }, 0 approx shapes: {}, and shapes for CUS . + and related uids:{} $ ocaml-index dump _build/default/.main.eobjs/cctx.ocaml-index 4 uids: @@ -52,6 +53,7 @@ We should not index generated modules (lib.ml-gen) uid: Stdlib.312; locs: "print_string": File "main.ml", line 3, characters 9-21 }, 0 approx shapes: {}, and shapes for CUS . + and related uids:{} $ $MERLIN single occurrences -scope project -identifier-at 3:23 \ > -filename main.ml main/.merlin << EOF diff --git a/tests/test-dirs/server-tests/pwo-uid-stability.t b/tests/test-dirs/server-tests/pwo-uid-stability.t index 6bbb1dd203..65fc8afa26 100644 --- a/tests/test-dirs/server-tests/pwo-uid-stability.t +++ b/tests/test-dirs/server-tests/pwo-uid-stability.t @@ -19,6 +19,7 @@ "z": File "lib.ml", line 3, characters 4-5; "Lib.z": File "main.ml", line 1, characters 9-14 }, 0 approx shapes: {}, and shapes for CUS . + and related uids:{} $ $MERLIN server occurrences -identifier-at 3:4 \ @@ -66,6 +67,7 @@ Now we insert a def before z: "z": File "lib.ml", line 3, characters 4-5; "Lib.z": File "main.ml", line 1, characters 9-14 }, 0 approx shapes: {}, and shapes for CUS . + and related uids:{} We are not missing the occurrence in main.ml $ $MERLIN server occurrences -identifier-at 3:4 \ @@ -111,6 +113,7 @@ We are not missing the occurrence in main.ml "z": File "lib.ml", line 3, characters 4-5; "Lib.z": File "main.ml", line 1, characters 9-14 }, 0 approx shapes: {}, and shapes for CUS . + and related uids:{} We are not missing the occurrence in main.ml $ $MERLIN server occurrences -identifier-at 3:4 \