From f3faba39e5e8a5ee4089475d9ee57a89bfb824c2 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Wed, 5 Feb 2025 16:04:48 +0100 Subject: [PATCH 1/8] Add non-regression tests --- tests/test-dirs/inlay-hint/samples.t | 160 ++++++++++++++++++++++++++- 1 file changed, 154 insertions(+), 6 deletions(-) diff --git a/tests/test-dirs/inlay-hint/samples.t b/tests/test-dirs/inlay-hint/samples.t index de3be2b4ba..3415257897 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:0 -avoid-ghost-location false \ > -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:0 -avoid-ghost-location false \ > -filename inlay.ml < let f ?(x = 1) () = x > EOF @@ -40,13 +40,20 @@ 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:0 -avoid-ghost-location false \ > -filename inlay.ml < let f ~x = x + 1 + > let f ~x ~y:z = x + z > EOF { "class": "return", "value": [ + { + "pos": { + "line": 1, + "col": 13 + }, + "label": "int" + }, { "pos": { "line": 1, @@ -60,7 +67,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:0 -avoid-ghost-location false \ > -filename inlay.ml < let f (Some x) = x + 1 > EOF @@ -78,6 +85,31 @@ Case argument "notifications": [] } +Pair arguments + + $ $MERLIN single inlay-hints -start 1:0 -end 2:0 \ + > -filename inlay.ml < let f (a,b) = a+b + > EOF + { + "class": "return", + "value": [], + "notifications": [] + } + +Record arguments + + $ $MERLIN single inlay-hints -start 1:0 -end 3:0 \ + > -filename inlay.ml < type ('a, 'b) pair = {x:'a; y:'b} + > let f {x;y=b} = x+b + > EOF + { + "class": "return", + "value": [], + "notifications": [] + } + Pattern variables without pattern-binding hint $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location false \ @@ -146,7 +178,6 @@ Let bindings without let hinting "notifications": [] } - Let bindings with let hinting $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location false \ @@ -167,3 +198,120 @@ Let bindings with let hinting ], "notifications": [] } + +Class-level let bindings without let hinting + + $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location false \ + > -let-binding false \ + > -filename inlay.ml < class c x = let y = 1 in object method s = x + y end + > EOF + { + "class": "return", + "value": [ + { + "pos": { + "line": 1, + "col": 17 + }, + "label": "int" + }, + { + "pos": { + "line": 1, + "col": 9 + }, + "label": "int" + } + ], + "notifications": [] + } + +Class-level let bindings with let hinting + + $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location false \ + > -let-binding true \ + > -filename inlay.ml < class c x = let y = 1 in object method s = x + y end + > EOF + { + "class": "return", + "value": [ + { + "pos": { + "line": 1, + "col": 17 + }, + "label": "int" + }, + { + "pos": { + "line": 1, + "col": 9 + }, + "label": "int" + } + ], + "notifications": [] + } + +Top-level let bindings without let hinting + + $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location false \ + > -let-binding false \ + > -filename inlay.ml < let y = 0 + > EOF + { + "class": "return", + "value": [], + "notifications": [] + } + +Top-level let bindings with let hinting + + $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location false \ + > -let-binding true \ + > -filename inlay.ml < let y = 0 + > EOF + { + "class": "return", + "value": [], + "notifications": [] + } + +Support for @merlin.hide + + $ $MERLIN single inlay-hints -start 1:0 -end 3:0 -avoid-ghost-location false \ + > -filename inlay.ml < let[@merlin.hide] f x = 2 + > let f x = (fun y -> x+y+1) [@merlin.hide] + > EOF + { + "class": "return", + "value": [ + { + "pos": { + "line": 2, + "col": 16 + }, + "label": "int" + }, + { + "pos": { + "line": 2, + "col": 7 + }, + "label": "int" + }, + { + "pos": { + "line": 1, + "col": 21 + }, + "label": "'a" + } + ], + "notifications": [] + } From aa08f858501b28de7b363802187b6ccb907a62e0 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Wed, 5 Feb 2025 16:29:16 +0100 Subject: [PATCH 2/8] Improve inlay hints --- src/analysis/inlay_hints.ml | 71 +++++++++++-------------------------- 1 file changed, 20 insertions(+), 51 deletions(-) diff --git a/src/analysis/inlay_hints.ml b/src/analysis/inlay_hints.ml index 54de9cda65..55c2f59fc4 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,10 @@ 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 super = Iterator.default_iterator in + 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 @@ -25,18 +25,18 @@ let structure_iterator hint_let_binding hint_pattern_binding iterator.expr iterator case.c_rhs in - let value_binding_iterator hint_lhs (iterator : Iterator.iterator) vb = + let value_binding_iterator (iterator : Iterator.iterator) vb = let () = log ~title:"value_binding" "%a" Logger.fmt (fun fmt -> Format.fprintf fmt "On value binding %a" (Printtyped.pattern 0) vb.Typedtree.vb_pat) in if Location_aux.overlap_with_range range vb.Typedtree.vb_loc then - if hint_lhs then + if hint_let_binding then let () = log ~title:"value_binding" "overlap" in match vb.vb_expr.exp_desc with | Texp_function _ -> iterator.expr iterator vb.vb_expr - | _ -> Iterator.default_iterator.value_binding iterator vb + | _ -> super.value_binding iterator vb else iterator.expr iterator vb.vb_expr in @@ -50,11 +50,7 @@ let structure_iterator hint_let_binding hint_pattern_binding match expr.exp_desc with | Texp_let (_, bindings, body) -> let () = log ~title:"expression" "on let" in - let () = - List.iter - ~f:(value_binding_iterator hint_let_binding iterator) - bindings - in + let () = List.iter ~f:(iterator.value_binding iterator) bindings in iterator.expr iterator body | Texp_letop { body; _ } -> let () = log ~title:"expression" "on let-op" in @@ -63,40 +59,13 @@ let structure_iterator hint_let_binding hint_pattern_binding let () = log ~title:"expression" "on match" in let () = iterator.expr iterator expr in List.iter ~f:(case_iterator hint_pattern_binding iterator) cases - | Texp_function - ( _, - Tfunction_cases - { cases = - [ { c_rhs = - { exp_desc = Texp_let (_, [ { vb_pat; _ } ], body); _ }; - _ - } - ]; - _ - } ) -> - 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 + | _ -> super.expr iterator expr in let structure_item_iterator (iterator : Iterator.iterator) item = if Location_aux.overlap_with_range range item.Typedtree.str_loc then let () = log ~title:"structure_item" "overlap" in - match item.str_desc with - | Tstr_value (_, bindings) -> - 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 + super.structure_item iterator item in let pattern_iterator (type a) iterator (pattern : a Typedtree.general_pattern) @@ -110,21 +79,21 @@ let structure_iterator hint_let_binding hint_pattern_binding && not (pattern_has_constraint pattern) then let () = log ~title:"pattern" "overlap" in - let () = Iterator.default_iterator.pat iterator pattern in + let () = super.pat iterator pattern in match pattern.pat_desc with | Tpat_var _ when not pattern.pat_loc.loc_ghost -> let () = log ~title:"pattern" "found" in 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 + } in iterator.structure iterator typedtree @@ -151,8 +120,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" From 2cbac8a7536feffc7c159e384d971b204b23a6c4 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Wed, 5 Feb 2025 16:43:33 +0100 Subject: [PATCH 3/8] Remove support for avoid-ghost-location --- doc/dev/PROTOCOL.md | 3 +-- src/analysis/inlay_hints.ml | 9 ++++----- src/analysis/inlay_hints.mli | 1 - src/commands/new_commands.ml | 30 ++++++++++------------------ src/commands/query_json.ml | 5 ++--- src/frontend/query_commands.ml | 8 +++----- src/frontend/query_protocol.ml | 2 +- tests/test-dirs/inlay-hint/samples.t | 26 ++++++++++++------------ 8 files changed, 35 insertions(+), 49 deletions(-) diff --git a/doc/dev/PROTOCOL.md b/doc/dev/PROTOCOL.md index a6b86a0efb..5eb20e44b7 100644 --- a/doc/dev/PROTOCOL.md +++ b/doc/dev/PROTOCOL.md @@ -552,14 +552,13 @@ This command is essentially useful for an LSP server, as it can be used to retur If no help is found, the command returns an empty object, otherwise it returns a structured object with signatures and active parameters. You can find more information here -### `inlay-hints -start -end -let-binding -pattern-binding -avoid-ghost ` +### `inlay-hints -start -end -let-binding -pattern-binding ` ``` -start the start of the region where to activate the inlay-hints -end the end of the region where to activate the inlay-hints -let-binding activate for `let-bindings -pattern-binding activate for `pattern-bindings - -avoid-ghost deactivate for node attached with a ghost location (mainly for tests) ``` This command is essentially useful for an LSP server, and returns the list of inlay hints for a given region in a list of the following object: diff --git a/src/analysis/inlay_hints.ml b/src/analysis/inlay_hints.ml index 55c2f59fc4..4473a0b397 100644 --- a/src/analysis/inlay_hints.ml +++ b/src/analysis/inlay_hints.ml @@ -107,15 +107,14 @@ let create_hint env typ loc = let position = loc.Location.loc_end in (position, label) -let of_structure ~hint_let_binding ~hint_pattern_binding ~avoid_ghost_location - ~start ~stop structure = +let of_structure ~hint_let_binding ~hint_pattern_binding ~start ~stop structure + = let () = log ~title:"start" "%a" Logger.fmt (fun fmt -> - Format.fprintf fmt - "Start on %s to %s with : let: %b, pat: %b, ghost: %b" + Format.fprintf fmt "Start on %s to %s with : let: %b, pat: %b" (Lexing.print_position () start) (Lexing.print_position () stop) - hint_let_binding hint_pattern_binding avoid_ghost_location) + hint_let_binding hint_pattern_binding) in let range = (start, stop) in let hints = ref [] in diff --git a/src/analysis/inlay_hints.mli b/src/analysis/inlay_hints.mli index 575f8b7778..a968aa17a6 100644 --- a/src/analysis/inlay_hints.mli +++ b/src/analysis/inlay_hints.mli @@ -5,7 +5,6 @@ type hint = Lexing.position * string val of_structure : hint_let_binding:bool -> hint_pattern_binding:bool -> - avoid_ghost_location:bool -> start:Lexing.position -> stop:Lexing.position -> Typedtree.structure -> diff --git a/src/commands/new_commands.ml b/src/commands/new_commands.ml index ebf1aee4ae..dbe18d539d 100644 --- a/src/commands/new_commands.ml +++ b/src/commands/new_commands.ml @@ -618,34 +618,26 @@ let all_commands = ~spec: [ arg "-start" " Where inlay-hints generation start" (marg_position - (fun start (_start, stop, let_binding, pattern_binding, ghost) -> - (start, stop, let_binding, pattern_binding, ghost))); + (fun start (_start, stop, let_binding, pattern_binding) -> + (start, stop, let_binding, pattern_binding))); arg "-end" " Where inlay-hints generation stop" (marg_position - (fun stop (start, _stop, let_binding, pattern_binding, ghost) -> - (start, stop, let_binding, pattern_binding, ghost))); + (fun stop (start, _stop, let_binding, pattern_binding) -> + (start, stop, let_binding, pattern_binding))); optional "-let-binding" " Hint let-binding (default is false)" (Marg.bool - (fun - let_binding - (start, stop, _let_binding, pattern_binding, ghost) - -> (start, stop, let_binding, pattern_binding, ghost))); + (fun let_binding (start, stop, _let_binding, pattern_binding) -> + (start, stop, let_binding, pattern_binding))); optional "-pattern-binding" " Hint pattern-binding (default is false)" (Marg.bool (fun - pattern_binding - (start, stop, let_binding, _pattern_binding, ghost) - -> (start, stop, let_binding, pattern_binding, ghost))); - optional "-avoid-ghost-location" - " Avoid hinting ghost location (default is true)" - (Marg.bool - (fun ghost (start, stop, let_binding, pattern_binding, _ghost) -> - (start, stop, let_binding, pattern_binding, ghost))) + pattern_binding (start, stop, let_binding, _pattern_binding) -> + (start, stop, let_binding, pattern_binding))) ] - ~default:(`None, `None, false, false, true) + ~default:(`None, `None, false, false) begin - fun buffer (start, stop, let_binding, pattern_binding, avoid_ghost) -> + fun buffer (start, stop, let_binding, pattern_binding) -> match (start, stop) with | `None, `None -> failwith "-start and -end are mandatory" | `None, _ -> failwith "-start is mandatory" @@ -654,7 +646,7 @@ let all_commands = let start, stop = position in run buffer (Query_protocol.Inlay_hints - (start, stop, let_binding, pattern_binding, avoid_ghost)) + (start, stop, let_binding, pattern_binding)) end; command "shape" ~doc: diff --git a/src/commands/query_json.ml b/src/commands/query_json.ml index f9f2f75d8c..5058291329 100644 --- a/src/commands/query_json.ml +++ b/src/commands/query_json.ml @@ -134,13 +134,12 @@ let dump (type a) : a t -> json = | Some `Local -> `String "local" ); ("depth", `Int depth) ] - | Inlay_hints (start, stop, hint_let_binding, hint_pattern_var, ghost) -> + | Inlay_hints (start, stop, hint_let_binding, hint_pattern_var) -> mk "inlay-hints" [ ("start", mk_position start); ("stop", mk_position stop); ("hint-let-binding", `Bool hint_let_binding); - ("hint-pattern-variable", `Bool hint_pattern_var); - ("avoid-ghost-location", `Bool ghost) + ("hint-pattern-variable", `Bool hint_pattern_var) ] | Outline -> mk "outline" [] | Errors { lexing; parsing; typing } -> diff --git a/src/frontend/query_commands.ml b/src/frontend/query_commands.ml index be1ca4d2f9..8eed92fe54 100644 --- a/src/frontend/query_commands.ml +++ b/src/frontend/query_commands.ml @@ -795,9 +795,7 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function Occurrences.locs_of ~config ~env ~typer_result ~pos ~scope path in (locs, status) - | Inlay_hints - (start, stop, hint_let_binding, hint_pattern_binding, avoid_ghost_location) - -> + | Inlay_hints (start, stop, hint_let_binding, hint_pattern_binding) -> let start = Mpipeline.get_lexing_pos pipeline start and stop = Mpipeline.get_lexing_pos pipeline stop in let typer_result = Mpipeline.typer_result pipeline in @@ -805,8 +803,8 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function match Mtyper.get_typedtree typer_result with | `Interface _ -> [] | `Implementation structure -> - Inlay_hints.of_structure ~hint_let_binding ~hint_pattern_binding - ~avoid_ghost_location ~start ~stop structure + Inlay_hints.of_structure ~hint_let_binding ~hint_pattern_binding ~start + ~stop structure end | Signature_help { position; _ } -> ( (* Todo: additionnal contextual information could help us provide better diff --git a/src/frontend/query_protocol.ml b/src/frontend/query_protocol.ml index 43b8c65779..0e63d80798 100644 --- a/src/frontend/query_protocol.ml +++ b/src/frontend/query_protocol.ml @@ -200,7 +200,7 @@ type _ t = Msource.position * [ `None | `Local ] option * int option -> (Location.t * string list) t | Inlay_hints : - Msource.position * Msource.position * bool * bool * bool + Msource.position * Msource.position * bool * bool -> (Lexing.position * string) list t | Outline (* *) : outline t | Shape (* *) : Msource.position -> shape list t diff --git a/tests/test-dirs/inlay-hint/samples.t b/tests/test-dirs/inlay-hint/samples.t index 3415257897..de8127eb18 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:0 -avoid-ghost-location false \ + $ $MERLIN single inlay-hints -start 1:0 -end 2:0 \ > -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:0 -avoid-ghost-location false \ + $ $MERLIN single inlay-hints -start 1:0 -end 2:0 \ > -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:0 -avoid-ghost-location false \ + $ $MERLIN single inlay-hints -start 1:0 -end 2:0 \ > -filename inlay.ml < let f ~x ~y:z = x + z > EOF @@ -67,7 +67,7 @@ Labeled argument Case argument - $ $MERLIN single inlay-hints -start 1:0 -end 2:0 -avoid-ghost-location false \ + $ $MERLIN single inlay-hints -start 1:0 -end 2:0 \ > -filename inlay.ml < let f (Some x) = x + 1 > EOF @@ -112,7 +112,7 @@ Record arguments 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 \ > -filename inlay.ml < let f x = > match x with @@ -135,7 +135,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 \ > -pattern-binding true \ > -filename inlay.ml < let f x = @@ -167,7 +167,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 \ > -let-binding false \ > -filename inlay.ml < let f () = let y = 0 in y @@ -180,7 +180,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 \ > -let-binding true \ > -filename inlay.ml < let f () = let y = 0 in y @@ -201,7 +201,7 @@ Let bindings with let hinting Class-level 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 \ > -let-binding false \ > -filename inlay.ml < class c x = let y = 1 in object method s = x + y end @@ -229,7 +229,7 @@ Class-level let bindings without let hinting Class-level 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 \ > -let-binding true \ > -filename inlay.ml < class c x = let y = 1 in object method s = x + y end @@ -257,7 +257,7 @@ Class-level let bindings with let hinting Top-level 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 \ > -let-binding false \ > -filename inlay.ml < let y = 0 @@ -270,7 +270,7 @@ Top-level let bindings without let hinting Top-level 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 \ > -let-binding true \ > -filename inlay.ml < let y = 0 @@ -283,7 +283,7 @@ Top-level let bindings with let hinting Support for @merlin.hide - $ $MERLIN single inlay-hints -start 1:0 -end 3:0 -avoid-ghost-location false \ + $ $MERLIN single inlay-hints -start 1:0 -end 3:0 \ > -filename inlay.ml < let[@merlin.hide] f x = 2 > let f x = (fun y -> x+y+1) [@merlin.hide] From 3c5fc357a534788cb325c13f547fbbcfd1f37aa1 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Wed, 5 Feb 2025 16:44:11 +0100 Subject: [PATCH 4/8] Accept changes --- tests/test-dirs/inlay-hint/samples.t | 65 ++++++++++++++++++---------- 1 file changed, 41 insertions(+), 24 deletions(-) diff --git a/tests/test-dirs/inlay-hint/samples.t b/tests/test-dirs/inlay-hint/samples.t index de8127eb18..33052ce67b 100644 --- a/tests/test-dirs/inlay-hint/samples.t +++ b/tests/test-dirs/inlay-hint/samples.t @@ -93,7 +93,22 @@ Pair arguments > EOF { "class": "return", - "value": [], + "value": [ + { + "pos": { + "line": 1, + "col": 10 + }, + "label": "int" + }, + { + "pos": { + "line": 1, + "col": 8 + }, + "label": "int" + } + ], "notifications": [] } @@ -106,7 +121,22 @@ Record arguments > EOF { "class": "return", - "value": [], + "value": [ + { + "pos": { + "line": 2, + "col": 12 + }, + "label": "int" + }, + { + "pos": { + "line": 2, + "col": 8 + }, + "label": "int" + } + ], "notifications": [] } @@ -209,13 +239,6 @@ Class-level let bindings without let hinting { "class": "return", "value": [ - { - "pos": { - "line": 1, - "col": 17 - }, - "label": "int" - }, { "pos": { "line": 1, @@ -277,7 +300,15 @@ Top-level let bindings with let hinting > EOF { "class": "return", - "value": [], + "value": [ + { + "pos": { + "line": 1, + "col": 5 + }, + "label": "int" + } + ], "notifications": [] } @@ -291,26 +322,12 @@ Support for @merlin.hide { "class": "return", "value": [ - { - "pos": { - "line": 2, - "col": 16 - }, - "label": "int" - }, { "pos": { "line": 2, "col": 7 }, "label": "int" - }, - { - "pos": { - "line": 1, - "col": 21 - }, - "label": "'a" } ], "notifications": [] From 1440a86c90ff399471bedf2953497955331daabb Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Wed, 5 Feb 2025 18:15:31 +0100 Subject: [PATCH 5/8] Add an entry in CHANGES.md --- CHANGES.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES.md b/CHANGES.md index 2bc63248a8..13b88fff5e 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -6,6 +6,7 @@ unreleased (#1888) - `locate` can now disambiguate between files with identical names and contents (#1882) + - Improve Inlay Hints Handling with [@merlin.hide] and remove support for "avoid-ghost-location" (#1894) + ocaml-index - Improve the granularity of index reading by segmenting the marshalization of the involved data-structures. (#1889) From 9b69539d58a4ae5c52ecee6077c4e78264b2af47 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Thu, 6 Feb 2025 10:02:15 +0100 Subject: [PATCH 6/8] Do not annotate top-level structure items --- src/analysis/inlay_hints.ml | 15 ++++++++++++++- tests/test-dirs/inlay-hint/samples.t | 10 +--------- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/src/analysis/inlay_hints.ml b/src/analysis/inlay_hints.ml index 4473a0b397..c5010a822a 100644 --- a/src/analysis/inlay_hints.ml +++ b/src/analysis/inlay_hints.ml @@ -65,7 +65,20 @@ let structure_iterator hint_let_binding hint_pattern_binding typedtree range let structure_item_iterator (iterator : Iterator.iterator) item = if Location_aux.overlap_with_range range item.Typedtree.str_loc then let () = log ~title:"structure_item" "overlap" in - super.structure_item iterator item + match item.str_desc with + | Tstr_value (_, bindings) -> + List.iter + ~f:(fun binding -> + (* We do not annotate structure item let-bindings (even when hint_let_binding is enabled) + because they are already annotated by code lenses. *) + iterator.value_binding + { iterator with + expr = (fun _ -> iterator.expr iterator); + pat = (fun _ -> ignore) + } + binding) + bindings + | _ -> super.structure_item iterator item in let pattern_iterator (type a) iterator (pattern : a Typedtree.general_pattern) diff --git a/tests/test-dirs/inlay-hint/samples.t b/tests/test-dirs/inlay-hint/samples.t index 33052ce67b..f6063d94a6 100644 --- a/tests/test-dirs/inlay-hint/samples.t +++ b/tests/test-dirs/inlay-hint/samples.t @@ -300,15 +300,7 @@ Top-level let bindings with let hinting > EOF { "class": "return", - "value": [ - { - "pos": { - "line": 1, - "col": 5 - }, - "label": "int" - } - ], + "value": [], "notifications": [] } From 48602a4aefa2a7cca6cfa24233fb65419e1fb4c0 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Thu, 6 Feb 2025 10:32:30 +0100 Subject: [PATCH 7/8] Add a test for binding-operators --- tests/test-dirs/inlay-hint/samples.t | 174 +++++++++++++++++++++++++++ 1 file changed, 174 insertions(+) diff --git a/tests/test-dirs/inlay-hint/samples.t b/tests/test-dirs/inlay-hint/samples.t index f6063d94a6..5957d79391 100644 --- a/tests/test-dirs/inlay-hint/samples.t +++ b/tests/test-dirs/inlay-hint/samples.t @@ -304,6 +304,180 @@ Top-level let bindings with let hinting "notifications": [] } +Binding operators without let hinting + + $ $MERLIN single inlay-hints -start 1:0 -end 5:0 \ + > -let-binding false \ + > -filename inlay.ml < let ( let* ) x f = match x with None -> None | Some x -> f x + > let ( let+ ) x f = match x with None -> None | Some x -> Some (f x) + > let ( and+ ) x y = let* x = x in let+ y = y in (x, y) + > let f x y = let+ x = x and+ y = y in x + y + > EOF + { + "class": "return", + "value": [ + { + "pos": { + "line": 4, + "col": 9 + }, + "label": "int option" + }, + { + "pos": { + "line": 4, + "col": 7 + }, + "label": "int option" + }, + { + "pos": { + "line": 3, + "col": 16 + }, + "label": "'a option" + }, + { + "pos": { + "line": 3, + "col": 14 + }, + "label": "'a option" + }, + { + "pos": { + "line": 2, + "col": 16 + }, + "label": "'a -> 'b" + }, + { + "pos": { + "line": 2, + "col": 14 + }, + "label": "'a option" + }, + { + "pos": { + "line": 1, + "col": 16 + }, + "label": "'a -> 'b option" + }, + { + "pos": { + "line": 1, + "col": 14 + }, + "label": "'a option" + } + ], + "notifications": [] + } + +Binding operators with let hinting + + $ $MERLIN single inlay-hints -start 1:0 -end 5:0 \ + > -let-binding true \ + > -filename inlay.ml < let ( let* ) x f = match x with None -> None | Some x -> f x + > let ( let+ ) x f = match x with None -> None | Some x -> Some (f x) + > let ( and+ ) x y = let* x = x in let+ y = y in (x, y) + > let f x y = let+ x = x and+ y = y in x + y + > EOF + { + "class": "return", + "value": [ + { + "pos": { + "line": 4, + "col": 29 + }, + "label": "int" + }, + { + "pos": { + "line": 4, + "col": 18 + }, + "label": "int" + }, + { + "pos": { + "line": 4, + "col": 9 + }, + "label": "int option" + }, + { + "pos": { + "line": 4, + "col": 7 + }, + "label": "int option" + }, + { + "pos": { + "line": 3, + "col": 39 + }, + "label": "'a" + }, + { + "pos": { + "line": 3, + "col": 25 + }, + "label": "'a" + }, + { + "pos": { + "line": 3, + "col": 16 + }, + "label": "'a option" + }, + { + "pos": { + "line": 3, + "col": 14 + }, + "label": "'a option" + }, + { + "pos": { + "line": 2, + "col": 16 + }, + "label": "'a -> 'b" + }, + { + "pos": { + "line": 2, + "col": 14 + }, + "label": "'a option" + }, + { + "pos": { + "line": 1, + "col": 16 + }, + "label": "'a -> 'b option" + }, + { + "pos": { + "line": 1, + "col": 14 + }, + "label": "'a option" + } + ], + "notifications": [] + } + Support for @merlin.hide $ $MERLIN single inlay-hints -start 1:0 -end 3:0 \ From c19c2c41d6895c100174dacc4dc4488359f27e8b Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Wed, 5 Mar 2025 10:55:19 +0100 Subject: [PATCH 8/8] Cleanup. --- CHANGES.md | 1 - 1 file changed, 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 9757877980..b254bac67b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -8,7 +8,6 @@ unreleased (#1882) - Improve Inlay Hints Handling with [@merlin.hide] and remove support for "avoid-ghost-location" (#1894) - `occurrences` now reports stale files (#1885) - + ocaml-index - Improve the granularity of index reading by segmenting the marshalization of the involved data-structures. (#1889)