From 6adedae4b2373447a6d9464fe783f4900200c819 Mon Sep 17 00:00:00 2001 From: xvw Date: Wed, 9 Apr 2025 16:53:13 +0200 Subject: [PATCH 1/4] Make `inlay-hints` triggerable for function params --- src/analysis/inlay_hints.ml | 39 +++++------ src/analysis/inlay_hints.mli | 1 + src/commands/new_commands.ml | 119 +++++++++++++++++++++++++++++---- src/commands/query_json.ml | 9 ++- src/frontend/query_commands.ml | 10 ++- src/frontend/query_protocol.ml | 2 +- 6 files changed, 142 insertions(+), 38 deletions(-) diff --git a/src/analysis/inlay_hints.ml b/src/analysis/inlay_hints.ml index 54de9cda65..f9c9c1c4e6 100644 --- a/src/analysis/inlay_hints.ml +++ b/src/analysis/inlay_hints.ml @@ -17,7 +17,7 @@ let pattern_has_constraint (type a) (pattern : a Typedtree.general_pattern) = pattern.pat_extra let structure_iterator hint_let_binding hint_pattern_binding - avoid_ghost_location typedtree range callback = + hint_function_params 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 @@ -63,20 +63,18 @@ 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); _ }; - _ - } - ]; - _ - } ) -> + | Texp_function (args, body) -> ( let () = log ~title:"expression" "on function" in - let () = iterator.pat iterator vb_pat in - iterator.expr iterator body + if hint_function_params then + List.iter args ~f:(fun Typedtree.{ fp_kind; _ } -> + match fp_kind with + | Tparam_pat pat | Tparam_optional_default (pat, _) -> + iterator.pat iterator pat); + match body with + | Tfunction_cases { cases; _ } -> + List.iter cases ~f:(fun case -> + case_iterator hint_pattern_binding iterator case) + | Tfunction_body body -> 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 *) @@ -138,21 +136,24 @@ 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 ~hint_function_params + ~avoid_ghost_location ~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" + "Start on %s to %s with : let: %b, pat: %b, function_param: %b, \ + ghost: %b" (Lexing.print_position () start) (Lexing.print_position () stop) - hint_let_binding hint_pattern_binding avoid_ghost_location) + hint_let_binding hint_pattern_binding hint_function_params + avoid_ghost_location) in 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 -> + hint_function_params 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" diff --git a/src/analysis/inlay_hints.mli b/src/analysis/inlay_hints.mli index 575f8b7778..632b6d208e 100644 --- a/src/analysis/inlay_hints.mli +++ b/src/analysis/inlay_hints.mli @@ -5,6 +5,7 @@ type hint = Lexing.position * string val of_structure : hint_let_binding:bool -> hint_pattern_binding:bool -> + hint_function_params:bool -> avoid_ghost_location:bool -> start:Lexing.position -> stop:Lexing.position -> diff --git a/src/commands/new_commands.ml b/src/commands/new_commands.ml index ebf1aee4ae..7eed73d488 100644 --- a/src/commands/new_commands.ml +++ b/src/commands/new_commands.ml @@ -618,34 +618,120 @@ 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, + function_params, + ghost ) + -> + ( start, + stop, + let_binding, + pattern_binding, + function_params, + ghost ))); 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, + function_params, + ghost ) + -> + ( start, + stop, + let_binding, + pattern_binding, + function_params, + ghost ))); 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))); + ( start, + stop, + _let_binding, + pattern_binding, + function_params, + ghost ) + -> + ( start, + stop, + let_binding, + pattern_binding, + function_params, + ghost ))); 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))); + ( start, + stop, + let_binding, + _pattern_binding, + function_params, + ghost ) + -> + ( start, + stop, + let_binding, + pattern_binding, + function_params, + ghost ))); + optional "-function-params" + " Hint function parameters (default is false)" + (Marg.bool + (fun + function_params + ( start, + stop, + let_binding, + pattern_binding, + _function_params, + ghost ) + -> + ( start, + stop, + let_binding, + pattern_binding, + function_params, + 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))) + (fun + ghost + ( start, + stop, + let_binding, + pattern_binding, + function_params, + _ghost ) + -> + ( start, + stop, + let_binding, + pattern_binding, + function_params, + ghost ))) ] - ~default:(`None, `None, false, false, true) - begin - fun buffer (start, stop, let_binding, pattern_binding, avoid_ghost) -> + ~default:(`None, `None, false, false, false, true) + begin + fun buffer + ( start, + stop, + let_binding, + pattern_binding, + function_params, + avoid_ghost ) + -> match (start, stop) with | `None, `None -> failwith "-start and -end are mandatory" | `None, _ -> failwith "-start is mandatory" @@ -654,7 +740,12 @@ 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, + function_params, + avoid_ghost )) end; command "shape" ~doc: diff --git a/src/commands/query_json.ml b/src/commands/query_json.ml index 4ded2cf581..69e2e336f5 100644 --- a/src/commands/query_json.ml +++ b/src/commands/query_json.ml @@ -134,12 +134,19 @@ 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, + hint_function_params, + ghost ) -> 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); + ("hint-function-params", `Bool hint_function_params); ("avoid-ghost-location", `Bool ghost) ] | Outline -> mk "outline" [] diff --git a/src/frontend/query_commands.ml b/src/frontend/query_commands.ml index 057a8bacee..818246ceb0 100644 --- a/src/frontend/query_commands.ml +++ b/src/frontend/query_commands.ml @@ -796,8 +796,12 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function in (occurrences, status) | Inlay_hints - (start, stop, hint_let_binding, hint_pattern_binding, avoid_ghost_location) - -> + ( start, + stop, + hint_let_binding, + hint_pattern_binding, + hint_function_params, + avoid_ghost_location ) -> 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 @@ -806,7 +810,7 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function | `Interface _ -> [] | `Implementation structure -> Inlay_hints.of_structure ~hint_let_binding ~hint_pattern_binding - ~avoid_ghost_location ~start ~stop structure + ~hint_function_params ~avoid_ghost_location ~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 0c867ca1f0..4c9e9ffaea 100644 --- a/src/frontend/query_protocol.ml +++ b/src/frontend/query_protocol.ml @@ -202,7 +202,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 * bool * bool -> (Lexing.position * string) list t | Outline (* *) : outline t | Shape (* *) : Msource.position -> shape list t From 940667f01e8dad669abcb3b8790d4567dbb52e00 Mon Sep 17 00:00:00 2001 From: xvw Date: Wed, 9 Apr 2025 16:53:36 +0200 Subject: [PATCH 2/4] Test cases for `inlay-hints` on function params --- tests/test-dirs/inlay-hint/samples.t | 89 +++++++++++++++++++++++++++- 1 file changed, 88 insertions(+), 1 deletion(-) diff --git a/tests/test-dirs/inlay-hint/samples.t b/tests/test-dirs/inlay-hint/samples.t index de3be2b4ba..ee3eed780f 100644 --- a/tests/test-dirs/inlay-hint/samples.t +++ b/tests/test-dirs/inlay-hint/samples.t @@ -1,6 +1,77 @@ +Regular function + + $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + > -function-params true \ + > -filename inlay.ml < let f a b c d e f = (a + b, c ^ d, e +. (float_of_string f)) + > EOF + { + "class": "return", + "value": [ + { + "pos": { + "line": 1, + "col": 17 + }, + "label": "string" + }, + { + "pos": { + "line": 1, + "col": 15 + }, + "label": "float" + }, + { + "pos": { + "line": 1, + "col": 13 + }, + "label": "string" + }, + { + "pos": { + "line": 1, + "col": 11 + }, + "label": "string" + }, + { + "pos": { + "line": 1, + "col": 9 + }, + "label": "int" + }, + { + "pos": { + "line": 1, + "col": 7 + }, + "label": "int" + } + ], + "notifications": [] + } + +Regular function without function-params + + $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + > -function-params false \ + > -filename inlay.ml < let f a b c d e f = (a + b, c ^ d, e +. (float_of_string f)) + > EOF + { + "class": "return", + "value": [], + "notifications": [] + } + + Optional argument $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + > -function-params true \ > -filename inlay.ml < let f ?x () = x () > EOF @@ -18,9 +89,22 @@ Optional argument "notifications": [] } +Optional argument without function-params + + $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + > -filename inlay.ml < let f ?x () = x () + > EOF + { + "class": "return", + "value": [], + "notifications": [] + } + Optional argument with value $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + > -function-params true \ > -filename inlay.ml < let f ?(x = 1) () = x > EOF @@ -41,6 +125,7 @@ Optional argument with value Labeled argument $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + > -function-params true \ > -filename inlay.ml < let f ~x = x + 1 > EOF @@ -61,6 +146,7 @@ Labeled argument Case argument $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + > -function-params true \ > -filename inlay.ml < let f (Some x) = x + 1 > EOF @@ -81,6 +167,7 @@ Case argument Pattern variables without pattern-binding hint $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location false \ + > -function-params true \ > -filename inlay.ml < let f x = > match x with @@ -104,7 +191,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 \ - > -pattern-binding true \ + > -pattern-binding true -function-params true \ > -filename inlay.ml < let f x = > match x with From 1d424c8ca11011e7b45d7b3be86e182e351f2d96 Mon Sep 17 00:00:00 2001 From: xvw Date: Wed, 9 Apr 2025 16:56:51 +0200 Subject: [PATCH 3/4] Add CHANGES entry --- CHANGES.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES.md b/CHANGES.md index cde92d2fa9..f2a7238c86 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -7,6 +7,7 @@ unreleased - `locate` can now disambiguate between files with identical names and contents (#1882) - `occurrences` now reports stale files (#1885) + - `inlay-hints` fix inlay hints on function parameters (#1923) + ocaml-index - Improve the granularity of index reading by segmenting the marshalization of the involved data-structures. (#1889) From 7e6ffc8b8448241be43598ae97ba187206f80519 Mon Sep 17 00:00:00 2001 From: xvw Date: Wed, 9 Apr 2025 19:44:47 +0200 Subject: [PATCH 4/4] Fix test since `dune` release --- tests/test-dirs/issue1900.t/run.t | 35 +++++++++---------------------- 1 file changed, 10 insertions(+), 25 deletions(-) diff --git a/tests/test-dirs/issue1900.t/run.t b/tests/test-dirs/issue1900.t/run.t index ea0c643f77..e4575479e1 100644 --- a/tests/test-dirs/issue1900.t/run.t +++ b/tests/test-dirs/issue1900.t/run.t @@ -1,36 +1,14 @@ $ dune exec ./main.exe test -FIXME: There should be no error. +There should be no error. $ $MERLIN single errors -filename main.ml jq '.value.merlin.flags_applied' [ - { - "workdir": "$TESTCASE_ROOT", - "workval": [ - "-open", - "Dune__exe" - ] - }, { "workdir": "$TESTCASE_ROOT", "workval": [ @@ -44,6 +22,13 @@ FIXME: Dune should communicate the -open Dune__exe flag after the others. "Lib", "-g" ] + }, + { + "workdir": "$TESTCASE_ROOT", + "workval": [ + "-open", + "Dune__exe" + ] } ]