From 6a7dff1cf5d039edae5c0d7ae034573e9c9e1bd2 Mon Sep 17 00:00:00 2001 From: Aaron Bauer Date: Mon, 20 May 2024 15:33:52 -0400 Subject: [PATCH] Improve the infer-interface code action and add an update-signature code action (#1289) * improving infer-interface code action and adding update-signature code action --- CHANGES.md | 7 + ocaml-lsp-server/src/code_actions.ml | 1 + .../code_actions/action_update_signature.ml | 43 +++ ocaml-lsp-server/src/document.ml | 2 +- ocaml-lsp-server/src/import.ml | 19 +- ocaml-lsp-server/src/inference.ml | 227 +++++++++++- ocaml-lsp-server/src/inference.mli | 22 ++ ocaml-lsp-server/test/e2e-new/code_actions.ml | 336 ++++++++++++++++++ 8 files changed, 646 insertions(+), 11 deletions(-) create mode 100644 ocaml-lsp-server/src/code_actions/action_update_signature.ml diff --git a/CHANGES.md b/CHANGES.md index aefc5f24c..8ae91ffbf 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -31,6 +31,13 @@ - Introduce a `destruct-line` code action. This is an improved version of the old `destruct` code action. (#1283) +- Improve signature inference to only include types for elements that were + absent from the signature. Previously, all signature items would always be + inserted. (#1289) + +- Add an `update-signature` code action to update the types of elements that + were already present in the signature (#1289) + ## Fixes - Detect document kind by looking at merlin's `suffixes` config. diff --git a/ocaml-lsp-server/src/code_actions.ml b/ocaml-lsp-server/src/code_actions.ml index f76529599..2d90ac73d 100644 --- a/ocaml-lsp-server/src/code_actions.ml +++ b/ocaml-lsp-server/src/code_actions.ml @@ -36,6 +36,7 @@ let compute_ocaml_code_actions (params : CodeActionParams.t) state doc = ~f:action_is_enabled [ Action_destruct_line.t state ; Action_destruct.t state + ; Action_update_signature.t state ; Action_inferred_intf.t state ; Action_type_annotate.t ; Action_remove_type_annotation.t diff --git a/ocaml-lsp-server/src/code_actions/action_update_signature.ml b/ocaml-lsp-server/src/code_actions/action_update_signature.ml new file mode 100644 index 000000000..25d907cf1 --- /dev/null +++ b/ocaml-lsp-server/src/code_actions/action_update_signature.ml @@ -0,0 +1,43 @@ +open Import +open Fiber.O + +let action_kind = "update_intf" + +let code_action_of_intf doc text_edits = + let edit : WorkspaceEdit.t = + let doc_edit = + let edits = List.map text_edits ~f:(fun e -> `TextEdit e) in + let textDocument = + let uri = Document.uri doc in + let version = Document.version doc in + OptionalVersionedTextDocumentIdentifier.create ~uri ~version () + in + TextDocumentEdit.create ~textDocument ~edits + in + WorkspaceEdit.create ~documentChanges:[ `TextDocumentEdit doc_edit ] () + in + let title = + String.capitalize_ascii "update signature(s) to match implementation" + in + CodeAction.create + ~title + ~kind:(CodeActionKind.Other action_kind) + ~edit + ~isPreferred:false + () + +let code_action (state : State.t) doc (params : CodeActionParams.t) = + match Document.kind doc with + | `Other -> Fiber.return None + | `Merlin m when Document.Merlin.kind m = Impl -> Fiber.return None + | `Merlin intf_merlin -> ( + let* text_edits = + Inference.update_signatures ~state ~doc ~range:params.range ~intf_merlin + in + match text_edits with + | [] -> Fiber.return None + | _ -> Fiber.return (Some (code_action_of_intf doc text_edits))) + +let kind = CodeActionKind.Other action_kind + +let t state = { Code_action.kind; run = `Non_batchable (code_action state) } diff --git a/ocaml-lsp-server/src/document.ml b/ocaml-lsp-server/src/document.ml index 0f9fae3df..1d95fe7d2 100644 --- a/ocaml-lsp-server/src/document.ml +++ b/ocaml-lsp-server/src/document.ml @@ -419,7 +419,7 @@ let get_impl_intf_counterparts m uri = let files_to_switch_to = match find_switch exts_to_switch_to with | [] -> - let switch_to_ext = List.hd exts_to_switch_to in + let switch_to_ext = List.hd_exn exts_to_switch_to in let switch_to_fpath = fpath_w_ext switch_to_ext in [ switch_to_fpath ] | to_switch_to -> to_switch_to diff --git a/ocaml-lsp-server/src/import.ml b/ocaml-lsp-server/src/import.ml index e250ec7eb..b4bc66470 100644 --- a/ocaml-lsp-server/src/import.ml +++ b/ocaml-lsp-server/src/import.ml @@ -21,7 +21,24 @@ include struct module Fdecl = Fdecl module Fpath = Path module Int = Int - module List = List + + module List = struct + include List + open Base + + let findi xs ~f = List.findi xs ~f + + let sub xs ~pos ~len = List.sub xs ~pos ~len + + let hd_exn t = List.hd_exn t + + let nth_exn t n = List.nth_exn t n + + let hd t = List.hd t + + let filter t ~f = List.filter t ~f + end + module Map = Map module Monoid = Monoid module Option = Option diff --git a/ocaml-lsp-server/src/inference.ml b/ocaml-lsp-server/src/inference.ml index 4fe51daf1..f8a628934 100644 --- a/ocaml-lsp-server/src/inference.ml +++ b/ocaml-lsp-server/src/inference.ml @@ -1,6 +1,48 @@ open Import open Fiber.O +module Printtyp = Merlin_analysis.Type_utils.Printtyp +let get_typer doc = + Document.Merlin.with_pipeline_exn ~name:"infer interface" doc (fun pipeline -> + Mpipeline.typer_result pipeline) + +let get_doc_signature typer = + let typedtree = Mtyper.get_typedtree typer in + match typedtree with + | `Interface intf -> intf.sig_type + | `Implementation impl -> impl.str_type + +(** Called by the code action for insert-interface. *) +let infer_missing_intf_for_impl impl_doc intf_doc = + match (Document.kind impl_doc, Document.kind intf_doc) with + | `Merlin impl, `Merlin intf + when Document.Merlin.kind impl = Impl && Document.Merlin.kind intf = Intf + -> ( + let drop_existing_ids full_sig cur_sig = + let existing_ids = List.map cur_sig ~f:Types.signature_item_id in + List.filter + ~f:(fun si -> + let id = Types.signature_item_id si in + not (List.mem existing_ids id ~equal:Ident.equal)) + full_sig + in + let* typers = Fiber.parallel_map ~f:get_typer [ impl; intf ] in + match typers with + | [ impl_typer; intf_typer ] -> + let full_sig = get_doc_signature impl_typer in + let cur_sig = get_doc_signature intf_typer in + let sig_update = drop_existing_ids full_sig cur_sig in + let env = Mtyper.initial_env impl_typer in + let* intf_cfg = Document.Merlin.mconfig intf in + let verbosity = intf_cfg.query.verbosity in + Printtyp.wrap_printing_env ~verbosity env (fun () -> + Format.asprintf "%a@." Printtyp.signature sig_update) + |> Fiber.return + | _ -> Code_error.raise "promblem encountered with Merlin typer_result" []) + | _ -> Code_error.raise "expected implementation and interface documents" [] + +(* No longer involved in the insert-interface code action, but still used by the + [ocamllsp/inferIntf] custom request. *) let infer_intf_for_impl doc = match Document.kind doc with | `Other -> @@ -25,7 +67,6 @@ let infer_intf_for_impl doc = in let env = Mtyper.initial_env typer in let verbosity = (Mpipeline.final_config pipeline).query.verbosity in - let module Printtyp = Merlin_analysis.Type_utils.Printtyp in Printtyp.wrap_printing_env ~verbosity env (fun () -> Format.asprintf "%a@." Printtyp.signature sig_)) @@ -66,25 +107,193 @@ let open_document_from_file (state : State.t) uri = in Some doc) -let infer_intf (state : State.t) doc = - match Document.kind doc with +let infer_intf (state : State.t) intf_doc = + match Document.kind intf_doc with | `Other -> Code_error.raise "the provided document is not a merlin source." [] | `Merlin m when Document.Merlin.kind m = Impl -> Code_error.raise "the provided document is not an interface." [] | `Merlin m -> Fiber.of_thunk (fun () -> - let intf_uri = Document.uri doc in + let intf_uri = Document.uri intf_doc in let impl_uri = - Document.get_impl_intf_counterparts (Some m) intf_uri |> List.hd + Document.get_impl_intf_counterparts (Some m) intf_uri |> List.hd_exn in - let* impl = + let* impl_opt = match Document_store.get_opt state.store impl_uri with | Some impl -> Fiber.return (Some impl) | None -> open_document_from_file state impl_uri in - match impl with + match impl_opt with | None -> Fiber.return None - | Some impl -> - let+ res = infer_intf_for_impl impl in + | Some impl_doc -> + let+ res = infer_missing_intf_for_impl impl_doc intf_doc in Some res) + +(** Extracts an [Ident.t] from all variants that have one at the top level. For + many of the other variants, it would be possible to extract a list of IDs, + but that's not needed for the update-signatures code action. *) +let top_level_id (item : Typedtree.signature_item) = + match item.sig_desc with + | Typedtree.Tsig_value { val_id; _ } -> Some val_id + | Typedtree.Tsig_module { md_id; _ } -> md_id + | Typedtree.Tsig_modsubst { ms_id; _ } -> Some ms_id + | Typedtree.Tsig_modtype { mtd_id; _ } -> Some mtd_id + | Typedtree.Tsig_modtypesubst { mtd_id; _ } -> Some mtd_id + | Typedtree.Tsig_type _ + | Typedtree.Tsig_typesubst _ + | Typedtree.Tsig_typext _ + | Typedtree.Tsig_exception _ + | Typedtree.Tsig_recmodule _ + | Typedtree.Tsig_open _ + | Typedtree.Tsig_include _ + | Typedtree.Tsig_class _ + | Typedtree.Tsig_class_type _ + | Typedtree.Tsig_attribute _ -> None + +(** Represents an item that's present in the existing interface and has a + (possibly differing) signature inferred from the implementation. *) +type shared_signature = + { range : Range.t (* location in the interface *) + ; old_sig : Types.signature_item (* found in the interface *) + ; new_sig : Types.signature_item (* inferred from the implementation *) + } + +(** Try to make a [shared_signature], if an ID can be extracted from the + [tree_item] and a matching ID can be found in both signature lists. *) +let find_shared_signature tree_item ~old_sigs ~new_sigs = + let open Option.O in + let* id = top_level_id tree_item in + let id_equal sig_item = Ident.equal id (Types.signature_item_id sig_item) in + let* old_sig = List.find ~f:id_equal old_sigs in + let* new_sig = List.find ~f:id_equal new_sigs in + let range = Range.of_loc tree_item.sig_loc in + Some { range; old_sig; new_sig } + +(** Slices out the signatures between [first] and [last] to speed up future + searches. This assumes that [first] and [last] came from the [sig_items] + field on a [Typedtree.signature], and [sig_type_list] is the [sig_type] + field on the same [Typedtree.signature], meaning that the lists will be in + the same order. *) +let select_matching_range ~first ~last sig_type_list = + let index_of item = + let open Option.O in + let* item in + let* id = top_level_id item in + let* i, _ = + List.findi sig_type_list ~f:(fun _ item -> + Ident.equal id (Types.signature_item_id item)) + in + Some i + in + let start_index = index_of first |> Option.value ~default:0 in + let end_index = + index_of last |> Option.value ~default:(List.length sig_type_list - 1) + in + List.sub sig_type_list ~pos:start_index ~len:(end_index + 1 - start_index) + +(** Formats both the old and new signatures as they would appear in the + interface. If they differ, create a text edit that updates to the new + signature. *) +let text_edit_opt shared_signature ~formatter = + (* CR-someday bwiedenbeck: We're relying on string equivalence of how the two signatures + are printed to decide if there's been an update. It'd be nice to check some sort of + logical equivalence on the actual types and then only format the ones that differ, + but that's not practical with the type information we have easy access to. *) + let+ sig_strings = + Fiber.parallel_map + ~f:formatter + [ shared_signature.old_sig; shared_signature.new_sig ] + in + match sig_strings with + | [ oldText; newText ] when not (String.equal oldText newText) -> + Some ({ range = shared_signature.range; newText } : TextEdit.t) + | _ -> None + +(** Produces text edits for every signature where the [formatter] produces a + different string on the [signature_item]s from the old interface and the new + implementation. *) +let build_signature_edits ~(old_intf : Typedtree.signature) + ~(* Extracted by Merlin from the interface. *) + (range : Range.t) + ~(* Selected range in the interface. *) + (new_sigs : Types.signature) + ~(* Inferred by Merlin from the implementation. *) + (formatter : Types.signature_item -> string Fiber.t) = + (* These are [Typedtree.signature_item]s, and we need them for the location. *) + let in_range_tree_items = + List.filter old_intf.sig_items ~f:(fun si -> + Range.overlaps range (Range.of_loc si.sig_loc)) + in + let first = List.hd in_range_tree_items in + let last = List.last in_range_tree_items in + (* These are [Types.signature_item]s, and we need them to match up types. *) + let in_range_old_sigs = + select_matching_range ~first ~last old_intf.sig_type + in + let in_range_new_sigs = + (* This list can be big and we might search it many times when finding + [shared_signatures], so it's worth doing a scan that shrinks it. *) + List.filter new_sigs ~f:(fun si -> + let in_range_old_ids = + List.map in_range_old_sigs ~f:Types.signature_item_id + in + let id = Types.signature_item_id si in + List.mem in_range_old_ids id ~equal:Ident.equal) + in + let shared_signatures = + List.filter_map + in_range_tree_items + ~f: + (find_shared_signature + ~old_sigs:in_range_old_sigs + ~new_sigs:in_range_new_sigs) + in + let+ updates = + Fiber.parallel_map shared_signatures ~f:(text_edit_opt ~formatter) + in + List.filter_opt updates + +(** Called by the code action for update-signatures. *) +let update_signatures ~(state : State.t) ~(intf_merlin : Document.Merlin.t) + ~(doc : Document.t) ~(range : Range.t) = + Fiber.of_thunk (fun () -> + let intf_uri = Document.uri doc in + let impl_uri = + Document.get_impl_intf_counterparts (Some intf_merlin) intf_uri + |> List.hd_exn + in + let* impl_doc = + match Document_store.get_opt state.store impl_uri with + | Some impl -> Fiber.return (Some impl) + | None -> open_document_from_file state impl_uri + in + match impl_doc with + | None -> Fiber.return [] + | Some impl_doc -> ( + let impl_merlin = Document.merlin_exn impl_doc in + (* CR-someday bwiedenbeck: These calls to Merlin to get the type information (and + the subsequent processing we do with it) are expensive on large documents. + This can cause problems if someone is trying to invoke some other code action, + because the LSP currently determines which CAs are possible by trying them all. + We've decided for now to allow slow code actions (especially since users are + less likely to be doing lots of little CAs in the mli file) and think more + about the broader CA protocol in the future. *) + let* typers = + Fiber.parallel_map [ intf_merlin; impl_merlin ] ~f:get_typer + in + let intf_typer = List.hd_exn typers in + let impl_typer = List.nth_exn typers 1 in + match Mtyper.get_typedtree intf_typer with + | `Interface old_intf -> + let formatter sig_item = + let* config = Document.Merlin.mconfig intf_merlin in + let verbosity = config.query.verbosity in + let env = Mtyper.initial_env intf_typer in + Fiber.return + (Printtyp.wrap_printing_env ~verbosity env (fun () -> + Format.asprintf "%a@." Printtyp.signature [ sig_item ])) + in + let new_sigs = get_doc_signature impl_typer in + build_signature_edits ~old_intf ~new_sigs ~range ~formatter + | _ -> Code_error.raise "expected an interface" [])) diff --git a/ocaml-lsp-server/src/inference.mli b/ocaml-lsp-server/src/inference.mli index 9e7f116f0..e569dafac 100644 --- a/ocaml-lsp-server/src/inference.mli +++ b/ocaml-lsp-server/src/inference.mli @@ -1,3 +1,25 @@ val infer_intf_for_impl : Document.t -> string Fiber.t +(** Called by the code action "insert inferred interface". Gets the Merlin + typer_result for both the implementation and interface documents, and uses + the diff between them to produce the updated interface. Any names present in + the existing interface are omitted from the inserted code (regardless of + whether their signatures have changed). *) +val infer_missing_intf_for_impl : + Document.t (** implementation *) + -> Document.t (** interface *) + -> string Fiber.t +(** code to be inserted in the interface *) + val infer_intf : State.t -> Document.t -> string option Fiber.t + +(** Called by the code action "update signature(s) to match implementation". + Compares signatures found in the selected range of the interface document + with ones inferred from the corresponding implementation document, and + produces text edits for any that can be updated. *) +val update_signatures : + state:State.t + -> intf_merlin:Document.Merlin.t + -> doc:Document.t + -> range:Range.t + -> Import.TextEdit.t list Fiber.t diff --git a/ocaml-lsp-server/test/e2e-new/code_actions.ml b/ocaml-lsp-server/test/e2e-new/code_actions.ml index 1d79ddce3..c9b95efd3 100644 --- a/ocaml-lsp-server/test/e2e-new/code_actions.ml +++ b/ocaml-lsp-server/test/e2e-new/code_actions.ml @@ -825,6 +825,342 @@ let f (x : t) = x "title": "Insert inferred interface" } |}] +let%expect_test "inferred interface excludes existing names" = + let impl_source = + {ocaml| +type t = Foo of int | Bar of bool +let f (x : t) = x +|ocaml} + in + let uri = DocumentUri.of_path "foo.ml" in + let prep client = Test.openDocument ~client ~uri ~source:impl_source in + let intf_source = {ocaml| +val f : t -> t +|ocaml} in + let range = + let start = Position.create ~line:0 ~character:0 in + let end_ = Position.create ~line:0 ~character:0 in + Range.create ~start ~end_ + in + print_code_actions + intf_source + range + ~prep + ~path:"foo.mli" + ~filter:(find_action "inferred_intf"); + [%expect + {| + Code actions: + { + "edit": { + "documentChanges": [ + { + "edits": [ + { + "newText": "type t = Foo of int | Bar of bool\n", + "range": { + "end": { "character": 0, "line": 0 }, + "start": { "character": 0, "line": 0 } + } + } + ], + "textDocument": { "uri": "file:///foo.mli", "version": 0 } + } + ] + }, + "isPreferred": false, + "kind": "inferred_intf", + "title": "Insert inferred interface" + } + |}] + +let%expect_test "update-signatures adds new function args" = + let impl_source = + {ocaml| +type t = Foo of int | Bar of bool +let f (x : t) (d : bool) = + match x with + |Bar x -> x + |Foo _ -> d +|ocaml} + in + let uri = DocumentUri.of_path "foo.ml" in + let prep client = Test.openDocument ~client ~uri ~source:impl_source in + let intf_source = + {ocaml| +type t = Foo of int | Bar of bool +val f : t -> bool +|ocaml} + in + let range = + let start = Position.create ~line:2 ~character:0 in + let end_ = Position.create ~line:2 ~character:0 in + Range.create ~start ~end_ + in + print_code_actions + intf_source + range + ~prep + ~path:"foo.mli" + ~filter:(find_action "update_intf"); + [%expect + {| + Code actions: + { + "edit": { + "documentChanges": [ + { + "edits": [ + { + "newText": "val f : t -> bool -> bool\n", + "range": { + "end": { "character": 17, "line": 2 }, + "start": { "character": 0, "line": 2 } + } + } + ], + "textDocument": { "uri": "file:///foo.mli", "version": 0 } + } + ] + }, + "isPreferred": false, + "kind": "update_intf", + "title": "Update signature(s) to match implementation" + } + |}] + +let%expect_test "update-signatures removes old function args" = + let impl_source = + {ocaml| +let f i s b = + if b then String.length s > i else String.length s < i +|ocaml} + in + let uri = DocumentUri.of_path "foo.ml" in + let prep client = Test.openDocument ~client ~uri ~source:impl_source in + let intf_source = + {ocaml| +val f : int -> string -> 'a list -> bool -> bool +|ocaml} + in + let range = + let start = Position.create ~line:1 ~character:10 in + let end_ = Position.create ~line:1 ~character:10 in + Range.create ~start ~end_ + in + print_code_actions + intf_source + range + ~prep + ~path:"foo.mli" + ~filter:(find_action "update_intf"); + [%expect + {| + Code actions: + { + "edit": { + "documentChanges": [ + { + "edits": [ + { + "newText": "val f : int -> string -> bool -> bool\n", + "range": { + "end": { "character": 48, "line": 1 }, + "start": { "character": 0, "line": 1 } + } + } + ], + "textDocument": { "uri": "file:///foo.mli", "version": 0 } + } + ] + }, + "isPreferred": false, + "kind": "update_intf", + "title": "Update signature(s) to match implementation" + } + |}] + +let%expect_test "update-signatures updates parameter types" = + let impl_source = + {ocaml| +let f i s l b = + if b then List.length s > i else List.length l < i + |ocaml} + in + let uri = DocumentUri.of_path "foo.ml" in + let prep client = Test.openDocument ~client ~uri ~source:impl_source in + let intf_source = + {ocaml| +val f : int -> string -> 'a list -> bool -> bool +|ocaml} + in + let range = + let start = Position.create ~line:1 ~character:1 in + let end_ = Position.create ~line:1 ~character:12 in + Range.create ~start ~end_ + in + print_code_actions + intf_source + range + ~prep + ~path:"foo.mli" + ~filter:(find_action "update_intf"); + [%expect + {| + Code actions: + { + "edit": { + "documentChanges": [ + { + "edits": [ + { + "newText": "val f : int -> 'a list -> 'b list -> bool -> bool\n", + "range": { + "end": { "character": 48, "line": 1 }, + "start": { "character": 0, "line": 1 } + } + } + ], + "textDocument": { "uri": "file:///foo.mli", "version": 0 } + } + ] + }, + "isPreferred": false, + "kind": "update_intf", + "title": "Update signature(s) to match implementation" + } + |}] + +let%expect_test "update-signatures preserves functions and their comments" = + let impl_source = + {ocaml| +let f x = x + 1;; + +let g x y z ~another_arg ~yet_another_arg ~keep_them_coming = x - y + z + another_arg + yet_another_arg + keep_them_coming;; + +let h x = x *. 2.0;; + |ocaml} + in + let uri = DocumentUri.of_path "foo.ml" in + let prep client = Test.openDocument ~client ~uri ~source:impl_source in + let intf_source = + {ocaml| +val f : + int (* This comment should stay. *) + -> int + +val g : int + -> int (* This comment should disappear since the function changes. *) + -> int + +(* This comment should stay even though the function changes. *) +val h : int -> bool +|ocaml} + in + let range = + let start = Position.create ~line:1 ~character:0 in + let end_ = Position.create ~line:10 ~character:19 in + Range.create ~start ~end_ + in + print_code_actions + intf_source + range + ~prep + ~path:"foo.mli" + ~filter:(find_action "update_intf"); + [%expect + {| + Code actions: + { + "edit": { + "documentChanges": [ + { + "edits": [ + { + "newText": "val g :\n int ->\n int ->\n int ->\n another_arg:int -> yet_another_arg:int -> keep_them_coming:int -> int\n", + "range": { + "end": { "character": 10, "line": 7 }, + "start": { "character": 0, "line": 5 } + } + }, + { + "newText": "val h : float -> float\n", + "range": { + "end": { "character": 19, "line": 10 }, + "start": { "character": 0, "line": 10 } + } + } + ], + "textDocument": { "uri": "file:///foo.mli", "version": 0 } + } + ] + }, + "isPreferred": false, + "kind": "update_intf", + "title": "Update signature(s) to match implementation" + } + |}] + +let%expect_test "update-signatures updates modules" = + let impl_source = + {ocaml| +module M = struct + type t = + | I of int + | F of float + ;; + let f (x : t) ~long_name_for_an_integer_argument = + match x with + | I i -> i + | F f -> long_name_for_an_integer_argument + ;; +end +|ocaml} + in + let uri = DocumentUri.of_path "foo.ml" in + let prep client = Test.openDocument ~client ~uri ~source:impl_source in + let intf_source = + {ocaml| +module M : sig type t = I of int | B of bool end +|ocaml} + in + let range = + let start = Position.create ~line:1 ~character:0 in + let end_ = Position.create ~line:1 ~character:0 in + Range.create ~start ~end_ + in + print_code_actions + intf_source + range + ~prep + ~path:"foo.mli" + ~filter:(find_action "update_intf"); + [%expect + {| + Code actions: + { + "edit": { + "documentChanges": [ + { + "edits": [ + { + "newText": "module M :\n sig\n type t = I of int | F of float\n val f : t -> long_name_for_an_integer_argument:int -> int\n end\n", + "range": { + "end": { "character": 48, "line": 1 }, + "start": { "character": 0, "line": 1 } + } + } + ], + "textDocument": { "uri": "file:///foo.mli", "version": 0 } + } + ] + }, + "isPreferred": false, + "kind": "update_intf", + "title": "Update signature(s) to match implementation" + } + |}] + let position_of_offset src x = assert (0 <= x && x < String.length src); let cnum = ref 0