From 5137ef4be4c28ed61b9a659111bf58c18c805e4a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 16 May 2024 10:53:34 +0200 Subject: [PATCH 1/3] Promote test result showing the issue --- tests/test-dirs/with-ppx/issue1671-string.t | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/test-dirs/with-ppx/issue1671-string.t b/tests/test-dirs/with-ppx/issue1671-string.t index 229409f619..cd67f71487 100644 --- a/tests/test-dirs/with-ppx/issue1671-string.t +++ b/tests/test-dirs/with-ppx/issue1671-string.t @@ -59,6 +59,16 @@ Merlin should ignore hidden nodes in occurrences results "line": 1, "col": 7 } + }, + { + "start": { + "line": 3, + "col": 93 + }, + "end": { + "line": 3, + "col": 94 + } } ], "notifications": [] From 4d5560e28919a403b2df693a2a22b4c133f07af6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 16 May 2024 10:59:44 +0200 Subject: [PATCH 2/3] Do not traverse `merlin.hide` nodes when iterating --- src/analysis/ast_iterators.ml | 92 ++++++++++++++++++++- src/ocaml/typing/tast_iterator.ml | 14 +++- src/ocaml/typing/tast_iterator.mli | 2 + tests/test-dirs/with-ppx/issue1671-string.t | 10 --- 4 files changed, 105 insertions(+), 13 deletions(-) diff --git a/src/analysis/ast_iterators.ml b/src/analysis/ast_iterators.ml index 5d95ff1ee4..21967960f3 100644 --- a/src/analysis/ast_iterators.ml +++ b/src/analysis/ast_iterators.ml @@ -3,6 +3,95 @@ open Typedtree let {Logger. log} = Logger.for_section "iterators" +(* Sometimes we do not want to iterate on nodes that do not correspond to actual + syntax such as the ones introduced by PPXes with the `merlin.hide` + attribute. *) +let iter_only_visible iter = + let has_attribute ~name attrs = + List.exists ~f:(fun a -> + let (str,_) = Ast_helper.Attr.as_tuple a in + str.Location.txt = name + ) attrs + in + let not_hidden attrs = + not (has_attribute ~name:"merlin.hide" attrs) + in + let not_hidden_node node = + not (Browse_raw.has_attr ~name:"merlin.hide" node) + in + Tast_iterator.{ iter with + class_declaration = (fun sub ({ ci_attributes; _ } as cl) -> + if not_hidden ci_attributes then iter.class_declaration sub cl); + class_description = (fun sub ({ ci_attributes; _ } as cl) -> + if not_hidden ci_attributes then iter.class_description sub cl); + class_expr = (fun sub ({ cl_attributes; _ } as cl) -> + if not_hidden cl_attributes then iter.class_expr sub cl); + class_field = (fun sub ({ cf_attributes; _ } as cl) -> + if not_hidden cf_attributes then iter.class_field sub cl); + class_type = (fun sub ({ cltyp_attributes; _ } as cl) -> + if not_hidden cltyp_attributes then iter.class_type sub cl); + class_type_declaration = (fun sub ({ ci_attributes; _ } as cl) -> + if not_hidden ci_attributes then iter.class_type_declaration sub cl); + class_type_field = (fun sub ({ ctf_attributes; _ } as cl) -> + if not_hidden ctf_attributes then iter.class_type_field sub cl); + + expr = (fun sub ({ exp_attributes; _ } as e) -> + if not_hidden exp_attributes then iter.expr sub e); + extension_constructor = (fun sub ({ ext_attributes; _ } as e) -> + if not_hidden ext_attributes then iter.extension_constructor sub e); + + include_description = (fun sub ({ incl_attributes; _ } as incl) -> + if not_hidden incl_attributes then iter.include_description sub incl); + include_declaration = (fun sub ({ incl_attributes; _ } as incl) -> + if not_hidden incl_attributes then iter.include_declaration sub incl); + + module_binding = (fun sub ({ mb_attributes; _ } as mb) -> + if not_hidden mb_attributes then iter.module_binding sub mb); + module_declaration = (fun sub ({ md_attributes; _ } as m) -> + if not_hidden md_attributes then iter.module_declaration sub m); + module_substitution = (fun sub ({ ms_attributes; _ } as m) -> + if not_hidden ms_attributes then iter.module_substitution sub m); + module_expr = (fun sub ({ mod_attributes; _ } as m) -> + if not_hidden mod_attributes then iter.module_expr sub m); + module_type = (fun sub ({ mty_attributes; _ } as m) -> + if not_hidden mty_attributes then iter.module_type sub m); + module_type_declaration = (fun sub ({ mtd_attributes; _ } as m) -> + if not_hidden mtd_attributes then iter.module_type_declaration sub m); + + pat = (fun sub ({ pat_attributes; _ } as p) -> + if not_hidden pat_attributes then iter.pat sub p); + row_field = (fun sub ({ rf_attributes; _ } as p) -> + if not_hidden rf_attributes then iter.row_field sub p); + object_field = (fun sub ({ of_attributes; _ } as p) -> + if not_hidden of_attributes then iter.object_field sub p); + + open_declaration = (fun sub ({ open_attributes; _ } as p) -> + if not_hidden open_attributes then iter.open_declaration sub p); + open_description = (fun sub ({ open_attributes; _ } as p) -> + if not_hidden open_attributes then iter.open_description sub p); + + signature_item = (fun sub si -> + if not_hidden_node (Signature_item (si, Env.empty)) then + iter.signature_item sub si); + structure_item = (fun sub si -> + if not_hidden_node (Structure_item (si, Env.empty)) then + iter.structure_item sub si); + + typ = (fun sub ({ ctyp_attributes; _ } as t) -> + if not_hidden ctyp_attributes then iter.typ sub t); + type_declaration = (fun sub ({ typ_attributes; _ } as t) -> + if not_hidden typ_attributes then iter.type_declaration sub t); + type_extension = (fun sub ({ tyext_attributes; _ } as t) -> + if not_hidden tyext_attributes then iter.type_extension sub t); + type_exception = (fun sub ({ tyexn_attributes; _ } as t) -> + if not_hidden tyexn_attributes then iter.type_exception sub t); + + value_binding = (fun sub ({ vb_attributes; _ } as vb) -> + if not_hidden vb_attributes then iter.value_binding sub vb); + value_description = (fun sub ({ val_attributes; _ } as vb) -> + if not_hidden val_attributes then iter.value_description sub vb); + } + (* The compiler contains an iterator that aims to gather definitions but ignores local values like let-in expressions and local type definition. To provide occurrences in the active buffer we extend the compiler's iterator with @@ -45,7 +134,8 @@ let build_uid_to_locs_tbl ~(local_defs : Mtyper.typedtree) () = uid_to_locs_tbl let iter_on_usages ~f (local_defs : Mtyper.typedtree) = - let iter = Cmt_format.iter_on_occurrences ~f in + let occ_iter = Cmt_format.iter_on_occurrences ~f in + let iter = iter_only_visible occ_iter in begin match local_defs with | `Interface signature -> iter.signature iter signature | `Implementation structure -> iter.structure iter structure end diff --git a/src/ocaml/typing/tast_iterator.ml b/src/ocaml/typing/tast_iterator.ml index 6831fc1783..408454ad37 100644 --- a/src/ocaml/typing/tast_iterator.ml +++ b/src/ocaml/typing/tast_iterator.ml @@ -34,6 +34,8 @@ type iterator = env: iterator -> Env.t -> unit; expr: iterator -> expression -> unit; extension_constructor: iterator -> extension_constructor -> unit; + include_declaration: iterator -> include_declaration -> unit; + include_description: iterator -> include_description -> unit; location: iterator -> Location.t -> unit; module_binding: iterator -> module_binding -> unit; module_coercion: iterator -> module_coercion -> unit; @@ -120,6 +122,12 @@ let include_infos sub f {incl_loc; incl_mod; incl_attributes; _} = sub.attributes sub incl_attributes; f incl_mod +let include_description sub incl = + include_infos sub (sub.module_type sub) incl + +let include_declaration sub incl = + include_infos sub (sub.module_expr sub) incl + let class_type_declaration sub x = sub.item_declaration sub (Class_type x); class_infos sub (sub.class_type sub) x @@ -146,7 +154,7 @@ let structure_item sub {str_loc; str_desc; str_env; _} = | Tstr_class_type list -> List.iter (fun (_, s, cltd) -> iter_loc sub s; sub.class_type_declaration sub cltd) list - | Tstr_include incl -> include_infos sub (sub.module_expr sub) incl + | Tstr_include incl -> sub.include_declaration sub incl | Tstr_open od -> sub.open_declaration sub od | Tstr_attribute attr -> sub.attribute sub attr @@ -407,7 +415,7 @@ let signature_item sub {sig_loc; sig_desc; sig_env; _} = | Tsig_recmodule list -> List.iter (sub.module_declaration sub) list | Tsig_modtype x -> sub.module_type_declaration sub x | Tsig_modtypesubst x -> sub.module_type_declaration sub x - | Tsig_include incl -> include_infos sub (sub.module_type sub) incl + | Tsig_include incl -> sub.include_description sub incl | Tsig_class list -> List.iter (sub.class_description sub) list | Tsig_class_type list -> List.iter (sub.class_type_declaration sub) list | Tsig_open od -> sub.open_description sub od @@ -663,6 +671,8 @@ let default_iterator = env; expr; extension_constructor; + include_description; + include_declaration; location; module_binding; module_coercion; diff --git a/src/ocaml/typing/tast_iterator.mli b/src/ocaml/typing/tast_iterator.mli index 38cd4eac94..70fbfad76a 100644 --- a/src/ocaml/typing/tast_iterator.mli +++ b/src/ocaml/typing/tast_iterator.mli @@ -38,6 +38,8 @@ type iterator = env: iterator -> Env.t -> unit; expr: iterator -> expression -> unit; extension_constructor: iterator -> extension_constructor -> unit; + include_declaration: iterator -> include_declaration -> unit; + include_description: iterator -> include_description -> unit; location: iterator -> Location.t -> unit; module_binding: iterator -> module_binding -> unit; module_coercion: iterator -> module_coercion -> unit; diff --git a/tests/test-dirs/with-ppx/issue1671-string.t b/tests/test-dirs/with-ppx/issue1671-string.t index cd67f71487..229409f619 100644 --- a/tests/test-dirs/with-ppx/issue1671-string.t +++ b/tests/test-dirs/with-ppx/issue1671-string.t @@ -59,16 +59,6 @@ Merlin should ignore hidden nodes in occurrences results "line": 1, "col": 7 } - }, - { - "start": { - "line": 3, - "col": 93 - }, - "end": { - "line": 3, - "col": 94 - } } ], "notifications": [] From e5bb7115c81bd3328e0211a8957f82c865c2e10c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 16 May 2024 15:40:55 +0200 Subject: [PATCH 3/3] Add changelog for #1768 --- CHANGES.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index da12d591fe..5ea4f9661f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -12,6 +12,8 @@ merlin NEXT_VERSION - Addition of a `merlin-lib.commands` library which disassociates the execution of commands from the `new_protocol`, from the binary, allowing it to be invoked from other projects (#1758) + - New occurrences backend: Don't index occurrences when `merlin.hide` + attribute is present. (#1768) merlin 4.14 ===========