From 9fd44118dd9e92c4a2851795f350578e348b807a Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Tue, 4 Feb 2025 17:37:44 +0100 Subject: [PATCH 1/4] We should not need to avoid ghost location on these samples --- tests/test-dirs/inlay-hint/samples.t | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/tests/test-dirs/inlay-hint/samples.t b/tests/test-dirs/inlay-hint/samples.t index de3be2b4ba..95bcc7ccb6 100644 --- a/tests/test-dirs/inlay-hint/samples.t +++ b/tests/test-dirs/inlay-hint/samples.t @@ -1,6 +1,6 @@ Optional argument - $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location true \ > -filename inlay.ml < let f ?x () = x () > EOF @@ -20,7 +20,7 @@ Optional argument Optional argument with value - $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location true \ > -filename inlay.ml < let f ?(x = 1) () = x > EOF @@ -40,7 +40,7 @@ Optional argument with value Labeled argument - $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location true \ > -filename inlay.ml < let f ~x = x + 1 > EOF @@ -60,7 +60,7 @@ Labeled argument Case argument - $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location true \ > -filename inlay.ml < let f (Some x) = x + 1 > EOF @@ -80,7 +80,7 @@ Case argument Pattern variables without pattern-binding hint - $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location false \ + $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location true \ > -filename inlay.ml < let f x = > match x with @@ -103,7 +103,7 @@ Pattern variables without pattern-binding hint Pattern variables with pattern-binding hint - $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location false \ + $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location true \ > -pattern-binding true \ > -filename inlay.ml < let f x = @@ -135,7 +135,7 @@ Pattern variables with pattern-binding hint Let bindings without let hinting - $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location false \ + $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location true \ > -let-binding false \ > -filename inlay.ml < let f () = let y = 0 in y @@ -149,7 +149,7 @@ Let bindings without let hinting Let bindings with let hinting - $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location false \ + $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location true \ > -let-binding true \ > -filename inlay.ml < let f () = let y = 0 in y From 02a04058c996c515eaaa4159f9400f70c05f0775 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Tue, 4 Feb 2025 17:46:50 +0100 Subject: [PATCH 2/4] Traverse ghost location; avoid ghost hints --- src/analysis/inlay_hints.ml | 23 +++++++---------------- 1 file changed, 7 insertions(+), 16 deletions(-) diff --git a/src/analysis/inlay_hints.ml b/src/analysis/inlay_hints.ml index 54de9cda65..c06697c808 100644 --- a/src/analysis/inlay_hints.ml +++ b/src/analysis/inlay_hints.ml @@ -4,8 +4,6 @@ let { Logger.log } = Logger.for_section "inlay-hints" module Iterator = Ocaml_typing.Tast_iterator -let is_ghost_location avoid_ghost loc = loc.Location.loc_ghost && avoid_ghost - let pattern_has_constraint (type a) (pattern : a Typedtree.general_pattern) = List.exists ~f:(fun (extra, _, _) -> @@ -16,8 +14,8 @@ let pattern_has_constraint (type a) (pattern : a Typedtree.general_pattern) = | Typedtree.Tpat_unpack -> false) pattern.pat_extra -let structure_iterator hint_let_binding hint_pattern_binding - avoid_ghost_location typedtree range callback = +let structure_iterator hint_let_binding hint_pattern_binding typedtree range + callback = let case_iterator hint_lhs (iterator : Iterator.iterator) case = let () = log ~title:"case" "on case" in let () = if hint_lhs then iterator.pat iterator case.Typedtree.c_lhs in @@ -77,10 +75,6 @@ let structure_iterator hint_let_binding hint_pattern_binding let () = log ~title:"expression" "on function" in let () = iterator.pat iterator vb_pat in iterator.expr iterator body - | _ when is_ghost_location avoid_ghost_location expr.exp_loc -> - (* Stop iterating when we see a ghost location to avoid - annotating generated code *) - log ~title:"ghost" "ghost-location found" | _ -> Iterator.default_iterator.expr iterator expr in @@ -92,10 +86,6 @@ let structure_iterator hint_let_binding hint_pattern_binding List.iter ~f:(fun binding -> expr_iterator iterator binding.Typedtree.vb_expr) bindings - | _ when is_ghost_location avoid_ghost_location item.str_loc -> - (* Stop iterating when we see a ghost location to avoid - annotating generated code *) - log ~title:"ghost" "ghost-location found" | _ -> Iterator.default_iterator.structure_item iterator item in @@ -151,15 +141,16 @@ let of_structure ~hint_let_binding ~hint_pattern_binding ~avoid_ghost_location let range = (start, stop) in let hints = ref [] in let () = - structure_iterator hint_let_binding hint_pattern_binding - avoid_ghost_location structure range (fun env typ loc -> + structure_iterator hint_let_binding hint_pattern_binding structure range + (fun env typ loc -> let () = log ~title:"hint" "Find hint %a" Logger.fmt (fun fmt -> Format.fprintf fmt "%s - %a" (Location_aux.print () loc) Printtyp.type_expr typ) in - let hint = create_hint env typ loc in - hints := hint :: !hints) + if not (loc.Location.loc_ghost && avoid_ghost_location) then + let hint = create_hint env typ loc in + hints := hint :: !hints) in !hints From 9a977d7dcce08827285a03e4d82555aec49a3aac Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Tue, 4 Feb 2025 19:53:54 +0100 Subject: [PATCH 3/4] Revert previous commit; ignore ghost structure items --- src/analysis/inlay_hints.ml | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/analysis/inlay_hints.ml b/src/analysis/inlay_hints.ml index c06697c808..daf95f8e05 100644 --- a/src/analysis/inlay_hints.ml +++ b/src/analysis/inlay_hints.ml @@ -4,6 +4,8 @@ let { Logger.log } = Logger.for_section "inlay-hints" module Iterator = Ocaml_typing.Tast_iterator +let is_ghost_location avoid_ghost loc = loc.Location.loc_ghost && avoid_ghost + let pattern_has_constraint (type a) (pattern : a Typedtree.general_pattern) = List.exists ~f:(fun (extra, _, _) -> @@ -14,8 +16,8 @@ let pattern_has_constraint (type a) (pattern : a Typedtree.general_pattern) = | Typedtree.Tpat_unpack -> false) pattern.pat_extra -let structure_iterator hint_let_binding hint_pattern_binding typedtree range - callback = +let structure_iterator hint_let_binding hint_pattern_binding + avoid_ghost_location typedtree range callback = let case_iterator hint_lhs (iterator : Iterator.iterator) case = let () = log ~title:"case" "on case" in let () = if hint_lhs then iterator.pat iterator case.Typedtree.c_lhs in @@ -82,6 +84,10 @@ let structure_iterator hint_let_binding hint_pattern_binding typedtree range if Location_aux.overlap_with_range range item.Typedtree.str_loc then let () = log ~title:"structure_item" "overlap" in match item.str_desc with + | _ when is_ghost_location avoid_ghost_location item.str_loc -> + (* Stop iterating when we see a ghost location to avoid + annotating generated code *) + log ~title:"ghost" "ghost-location found" | Tstr_value (_, bindings) -> List.iter ~f:(fun binding -> expr_iterator iterator binding.Typedtree.vb_expr) @@ -141,16 +147,15 @@ let of_structure ~hint_let_binding ~hint_pattern_binding ~avoid_ghost_location let range = (start, stop) in let hints = ref [] in let () = - structure_iterator hint_let_binding hint_pattern_binding structure range - (fun env typ loc -> + structure_iterator hint_let_binding hint_pattern_binding + avoid_ghost_location structure range (fun env typ loc -> let () = log ~title:"hint" "Find hint %a" Logger.fmt (fun fmt -> Format.fprintf fmt "%s - %a" (Location_aux.print () loc) Printtyp.type_expr typ) in - if not (loc.Location.loc_ghost && avoid_ghost_location) then - let hint = create_hint env typ loc in - hints := hint :: !hints) + let hint = create_hint env typ loc in + hints := hint :: !hints) in !hints From 598e8631638f6fb5602874f33b65f6aabd6f1057 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Tue, 4 Feb 2025 20:47:38 +0100 Subject: [PATCH 4/4] Let's use the merlin.hide attributes instead ! --- src/analysis/inlay_hints.ml | 28 +++++++++++----------------- 1 file changed, 11 insertions(+), 17 deletions(-) diff --git a/src/analysis/inlay_hints.ml b/src/analysis/inlay_hints.ml index daf95f8e05..404739fc23 100644 --- a/src/analysis/inlay_hints.ml +++ b/src/analysis/inlay_hints.ml @@ -4,8 +4,6 @@ let { Logger.log } = Logger.for_section "inlay-hints" module Iterator = Ocaml_typing.Tast_iterator -let is_ghost_location avoid_ghost loc = loc.Location.loc_ghost && avoid_ghost - let pattern_has_constraint (type a) (pattern : a Typedtree.general_pattern) = List.exists ~f:(fun (extra, _, _) -> @@ -16,8 +14,8 @@ let pattern_has_constraint (type a) (pattern : a Typedtree.general_pattern) = | Typedtree.Tpat_unpack -> false) pattern.pat_extra -let structure_iterator hint_let_binding hint_pattern_binding - avoid_ghost_location typedtree range callback = +let structure_iterator hint_let_binding hint_pattern_binding typedtree range + callback = let case_iterator hint_lhs (iterator : Iterator.iterator) case = let () = log ~title:"case" "on case" in let () = if hint_lhs then iterator.pat iterator case.Typedtree.c_lhs in @@ -84,10 +82,6 @@ let structure_iterator hint_let_binding hint_pattern_binding if Location_aux.overlap_with_range range item.Typedtree.str_loc then let () = log ~title:"structure_item" "overlap" in match item.str_desc with - | _ when is_ghost_location avoid_ghost_location item.str_loc -> - (* Stop iterating when we see a ghost location to avoid - annotating generated code *) - log ~title:"ghost" "ghost-location found" | Tstr_value (_, bindings) -> List.iter ~f:(fun binding -> expr_iterator iterator binding.Typedtree.vb_expr) @@ -113,14 +107,14 @@ let structure_iterator hint_let_binding hint_pattern_binding callback pattern.pat_env pattern.pat_type pattern.pat_loc | _ -> log ~title:"pattern" "not a var" in - let iterator = - { Ocaml_typing.Tast_iterator.default_iterator with - expr = expr_iterator; - structure_item = structure_item_iterator; - pat = pattern_iterator; - value_binding = value_binding_iterator true - } + Ast_iterators.iter_only_visible + { Ocaml_typing.Tast_iterator.default_iterator with + expr = expr_iterator; + structure_item = structure_item_iterator; + pat = pattern_iterator; + value_binding = value_binding_iterator true + } in iterator.structure iterator typedtree @@ -147,8 +141,8 @@ let of_structure ~hint_let_binding ~hint_pattern_binding ~avoid_ghost_location let range = (start, stop) in let hints = ref [] in let () = - structure_iterator hint_let_binding hint_pattern_binding - avoid_ghost_location structure range (fun env typ loc -> + structure_iterator hint_let_binding hint_pattern_binding structure range + (fun env typ loc -> let () = log ~title:"hint" "Find hint %a" Logger.fmt (fun fmt -> Format.fprintf fmt "%s - %a"