From a8688aaacb24b15b4cec612915d4a018d918c33c Mon Sep 17 00:00:00 2001 From: xvw Date: Tue, 24 Sep 2024 14:40:36 +0200 Subject: [PATCH] Include `with-doc` arg for search by type --- .ocamlformat | 3 - .ocamlformat-enable | 2 - CHANGES.md | 2 +- doc/dev/PROTOCOL.md | 3 +- src/analysis/polarity_search.ml | 21 +- src/analysis/type_search.ml | 52 +++-- src/analysis/type_search.mli | 17 +- src/commands/new_commands.ml | 19 +- src/commands/query_json.ml | 5 +- src/frontend/query_commands.ml | 30 +-- src/frontend/query_protocol.ml | 2 +- ...ch-by-type-comparison-to-polarity-search.t | 12 +- tests/test-dirs/search-by-type.t/run.t | 192 +++++++++++------- 13 files changed, 185 insertions(+), 175 deletions(-) delete mode 100644 .ocamlformat delete mode 100644 .ocamlformat-enable diff --git a/.ocamlformat b/.ocamlformat deleted file mode 100644 index ac0c5851b..000000000 --- a/.ocamlformat +++ /dev/null @@ -1,3 +0,0 @@ -disable=true -parse-docstrings -break-cases=fit-or-vertical \ No newline at end of file diff --git a/.ocamlformat-enable b/.ocamlformat-enable deleted file mode 100644 index a4c62a180..000000000 --- a/.ocamlformat-enable +++ /dev/null @@ -1,2 +0,0 @@ -src/sherlodoc/** -tests/test-units/** \ No newline at end of file diff --git a/CHANGES.md b/CHANGES.md index 72cf20366..c9a76ea71 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -8,7 +8,7 @@ unreleased - destruct: Refinement in the presence of optional arguments (#1800 #1807, fixes #1770) - Implement new expand-node command for expanding PPX annotations (#1745) - Implement new inlay-hints command for adding hints on a sourcetree (#1812) - - Implement new search-by-type command for searching values by types (#1828) + - Implement new search-by-type command for searching values by types (#1828) + editor modes - vim: fix python-3.12 syntax warnings in merlin.py (#1798) - vim: Dead code / doc removal for previously deleted MerlinPhrase command (#1804) diff --git a/doc/dev/PROTOCOL.md b/doc/dev/PROTOCOL.md index 286875837..16fac57f0 100644 --- a/doc/dev/PROTOCOL.md +++ b/doc/dev/PROTOCOL.md @@ -432,11 +432,12 @@ Returns the type of the expression when typechecked in the environment around th Returns a list (in the form of a completion list) of values matching the query. A query is defined by polarity (and does not support type parameters). Arguments are prefixed with `-` and the return type is prefixed with `+`. For example, to find a function that takes a string and returns an integer: `-string +int`. `-list +option` will returns every definition that take a list an option. -### `search-by-type` -position -query -limit +### `search-by-type` -position -query -limit -with-doc -position Position to search -query The query -limit a maximum-size of the result set + -with-doc if doc should be included in the result Returns a list of values matching the query. A query is a type expression, ie: `string -> int option` will search every definition that take a string and returns an option of int. It is also possible to search by polarity. diff --git a/src/analysis/polarity_search.ml b/src/analysis/polarity_search.ml index 33134221a..ba0ccebf1 100644 --- a/src/analysis/polarity_search.ml +++ b/src/analysis/polarity_search.ml @@ -152,15 +152,7 @@ let execute_query query env dirs = in List.fold_left dirs ~init:(direct None []) ~f:recurse -let execute_query_as_type_search - ?(limit = 100) - ~config - ~local_defs - ~comments - ~pos - ~env - ~query - ~modules () = +let execute_query_as_type_search ?(limit = 100) ~env ~query ~modules doc_ctx = let direct dir acc = Env.fold_values (fun _ path desc acc -> let d = desc.Types.val_type in @@ -168,16 +160,7 @@ let execute_query_as_type_search | Some cost -> let path = Printtyp.rewrite_double_underscore_paths env path in let name = Format.asprintf "%a" Printtyp.path path in - let doc = - Locate.get_doc - ~config - ~env - ~local_defs - ~comments - ~pos - (`User_input name) - |> Type_search.doc_to_option - in + let doc = Type_search.get_doc doc_ctx env name in let loc = desc.Types.val_loc in let typ = Format.asprintf "%a" diff --git a/src/analysis/type_search.ml b/src/analysis/type_search.ml index 30a343849..a80b3de47 100644 --- a/src/analysis/type_search.ml +++ b/src/analysis/type_search.ml @@ -70,6 +70,20 @@ let doc_to_option = function | `Found doc -> Some doc | _ -> None + +let get_doc doc_ctx env name = + match doc_ctx with + | None -> None + | Some (config, local_defs, comments, pos) -> + Locate.get_doc + ~config + ~env + ~local_defs + ~comments + ~pos + (`User_input name) + |> doc_to_option + let compare_result Query_protocol.{cost = cost_a; name = a; doc = doc_a; _} Query_protocol.{cost = cost_b; name = b; doc = doc_b; _} @@ -85,9 +99,7 @@ let compare_result | _ -> c else c -let compute_value - (config, local_defs, comments, pos, query) env - _ path desc acc = +let compute_value doc_ctx query env _ path desc acc = let open Merlin_sherlodoc in let d = desc.Types.val_type in let typ = sherlodoc_type_of env d in @@ -96,16 +108,7 @@ let compute_value let cost = Query.distance_for query ~path:name typ in if cost >= 1000 then acc else - let doc = - Locate.get_doc - ~config - ~env - ~local_defs - ~comments - ~pos - (`User_input name) - |> doc_to_option - in + let doc = get_doc doc_ctx env name in let loc = desc.Types.val_loc in let typ = Format.asprintf "%a" @@ -115,15 +118,15 @@ let compute_value let constructible = make_constructible name d in Query_protocol.{cost; name; typ; loc; doc; constructible} :: acc -let compute_values ctx env lident acc = - Env.fold_values (compute_value ctx env) lident env acc +let compute_values doc_ctx query env lident acc = + Env.fold_values (compute_value doc_ctx query env) lident env acc -let values_from_module ctx env lident acc = +let values_from_module doc_ctx query env lident acc = let rec aux acc lident = match Env.find_module_by_name lident env with | exception _ -> acc | _ -> - let acc = compute_values ctx env (Some lident) acc in + let acc = compute_values doc_ctx query env (Some lident) acc in Env.fold_modules (fun name _ mdl acc -> match mdl.Types.md_type with | Types.Mty_alias _ -> acc @@ -135,23 +138,14 @@ let values_from_module ctx env lident acc = aux acc lident -let run - ?(limit = 100) - ~config - ~local_defs - ~comments - ~pos - ~env - ~query - ~modules () = - let ctx = (config, local_defs, comments, pos, query) in - let init = compute_values ctx env None [] in +let run ?(limit = 100) ~env ~query ~modules doc_ctx = + let init = compute_values doc_ctx query env None [] in modules |> List.fold_left ~init ~f:(fun acc name -> let lident = Longident.Lident name in - values_from_module ctx env lident acc + values_from_module doc_ctx query env lident acc ) |> List.sort ~cmp:compare_result |> List.take_n limit diff --git a/src/analysis/type_search.mli b/src/analysis/type_search.mli index 0c28ed383..5596cefdb 100644 --- a/src/analysis/type_search.mli +++ b/src/analysis/type_search.mli @@ -33,17 +33,22 @@ (** Compute the list of candidates from a query inside a given environment. *) val run : ?limit:int -> - config:Mconfig.t -> - local_defs:Mtyper.typedtree -> - comments:(string * Location.t) list -> - pos:Lexing.position -> env:Env.t -> query:Merlin_sherlodoc.Query.t -> modules:string list - -> unit + -> (Mconfig.t + * Mtyper.typedtree + * (string * Location.t) list + * Lexing.position) + option -> Query_protocol.type_search_result list -val doc_to_option : [> `Builtin of string | `Found of string ] -> string option +val get_doc : + (Mconfig.t + * Mtyper.typedtree + * (string * Warnings.loc) list + * Lexing.position) option -> Env.t -> string -> string option + val make_constructible : string -> Types.type_expr -> string val compare_result : Query_protocol.type_search_result -> diff --git a/src/commands/new_commands.ml b/src/commands/new_commands.ml index a6ef3953a..8e7bfe0c5 100644 --- a/src/commands/new_commands.ml +++ b/src/commands/new_commands.ml @@ -576,16 +576,23 @@ of the buffer." ~doc:"return a list of values that match a query" ~spec:[ arg "-position" " to complete" - (marg_position (fun pos (query, _pos, limit) -> (query, pos, limit))); + (marg_position (fun pos (query, _pos, limit, with_doc) -> + (query, pos, limit, with_doc))); arg "-query" " to request values" (Marg.param - "string" (fun query (_query, pos, limit) -> (Some query, pos, limit))); + "string" (fun query (_query, pos, limit, with_doc) -> + (Some query, pos, limit, with_doc))); optional "-limit" " the maximal amount of results (default is 100)" (Marg.int - (fun limit (query, pos, _limit) -> (query, pos, limit))) + (fun limit (query, pos, _limit, with_doc) -> + (query, pos, limit, with_doc))); + optional "-with-doc" " include docstring (default is false)" + (Marg.bool + (fun with_doc (query, pos, limit, _with_doc) -> + (query, pos, limit, with_doc))) ] - ~default:(None, `None, 100) - begin fun buffer (query, pos, limit) -> + ~default:(None, `None, 100, false) + begin fun buffer (query, pos, limit, with_doc) -> match (query, pos) with | (None, `None) -> failwith "-position and -query are mandatory" @@ -594,7 +601,7 @@ of the buffer." | (_, `None) -> failwith "-position is mandatory" | (Some query, (#Msource.position as pos)) -> - run buffer (Query_protocol.Type_search (query, pos, limit)) + run buffer (Query_protocol.Type_search (query, pos, limit, with_doc)) end ; diff --git a/src/commands/query_json.ml b/src/commands/query_json.ml index bf5dfc3a3..48c1d65fb 100644 --- a/src/commands/query_json.ml +++ b/src/commands/query_json.ml @@ -211,11 +211,12 @@ let dump (type a) : a t -> json = "query", `String query; "position", mk_position pos; ] - | Type_search (query, pos, limit) -> + | Type_search (query, pos, limit, with_doc) -> mk "type-search" [ "query", `String query; "position", mk_position pos; - "limit", `Int limit + "limit", `Int limit; + "with-doc", `Bool with_doc ] | Occurrences (`Ident_at pos, scope) -> mk "occurrences" [ diff --git a/src/frontend/query_commands.ml b/src/frontend/query_commands.ml index 9d957cee0..2f3015187 100644 --- a/src/frontend/query_commands.ml +++ b/src/frontend/query_commands.ml @@ -465,39 +465,29 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = in { Compl. entries ; context = `Unknown } - | Type_search (query, pos, limit) -> + | Type_search (query, pos, limit, with_doc) -> let typer = Mpipeline.typer_result pipeline in - let local_defs = Mtyper.get_typedtree typer in let pos = Mpipeline.get_lexing_pos pipeline pos in let node = Mtyper.node_at typer pos in let env, _ = Mbrowse.leaf_node node in let config = Mpipeline.final_config pipeline in - let comments = Mpipeline.reader_comments pipeline in let modules = Mconfig.global_modules config in + let doc_ctx = + if with_doc then + let comments = Mpipeline.reader_comments pipeline in + let local_defs = Mtyper.get_typedtree typer in + Some (config, local_defs, comments, pos) + else None + in begin match Type_search.classify_query query with | `By_type query -> let query = Merlin_sherlodoc.Query.from_string query in - Type_search.run - ~limit - ~config - ~local_defs - ~comments - ~pos - ~env - ~query - ~modules () + Type_search.run ~limit ~env ~query ~modules doc_ctx | `Polarity query -> let query = Polarity_search.prepare_query env query in let modules = Polarity_search.directories ~global_modules:modules env in Polarity_search.execute_query_as_type_search - ~limit - ~config - ~local_defs - ~comments - ~pos - ~env - ~query - ~modules () + ~limit ~env ~query ~modules doc_ctx end | Refactor_open (mode, pos) -> diff --git a/src/frontend/query_protocol.ml b/src/frontend/query_protocol.ml index bee0bb4f9..0394f4033 100644 --- a/src/frontend/query_protocol.ml +++ b/src/frontend/query_protocol.ml @@ -171,7 +171,7 @@ type _ t = : string * Msource.position -> completions t | Type_search - : string * Msource.position * int + : string * Msource.position * int * bool -> type_search_result list t | Refactor_open : [`Qualify | `Unqualify] * Msource.position diff --git a/tests/test-dirs/search-by-type-comparison-to-polarity-search.t b/tests/test-dirs/search-by-type-comparison-to-polarity-search.t index 31048d7aa..dc5aa5f88 100644 --- a/tests/test-dirs/search-by-type-comparison-to-polarity-search.t +++ b/tests/test-dirs/search-by-type-comparison-to-polarity-search.t @@ -132,17 +132,17 @@ map). "name": "Seq.map", "type": "('a -> 'b) -> 'a Stdlib__Seq.t -> 'b Stdlib__Seq.t" } - { - "name": "List.concat_map", - "type": "('a -> 'b list) -> 'a list -> 'b list" - } { "name": "List.filter_map", "type": "('a -> 'b option) -> 'a list -> 'b list" } { - "name": "ListLabels.concat_map", - "type": "f:('a -> 'b list) -> 'a list -> 'b list" + "name": "List.concat_map", + "type": "('a -> 'b list) -> 'a list -> 'b list" + } + { + "name": "ListLabels.filter_map", + "type": "f:('a -> 'b option) -> 'a list -> 'b list" } diff --git a/tests/test-dirs/search-by-type.t/run.t b/tests/test-dirs/search-by-type.t/run.t index e9f36f47f..849b3de60 100644 --- a/tests/test-dirs/search-by-type.t/run.t +++ b/tests/test-dirs/search-by-type.t/run.t @@ -5,61 +5,61 @@ "name": "int_of_string_opt", "type": "string -> int option", "cost": 0, - "doc": "Convert the given string to an integer. The string is read in decimal (by default, or if the string begins with [0u]), in hexadecimal (if it begins with [0x] or [0X]), in octal (if it begins with [0o] or [0O]), or in binary (if it begins with [0b] or [0B]). The [0u] prefix reads the input as an unsigned integer in the range [[0, 2*max_int+1]]. If the input exceeds {!max_int} it is converted to the signed integer [min_int + input - max_int - 1]. The [_] (underscore) character can appear anywhere in the string and is ignored. Return [None] if the given string is not a valid representation of an integer, or if the integer represented exceeds the range of integers representable in type [int]. @since 4.05" + "doc": null } { "name": "int_of_string_opt", "type": "string -> int option", "cost": 0, - "doc": "Convert the given string to an integer. The string is read in decimal (by default, or if the string begins with [0u]), in hexadecimal (if it begins with [0x] or [0X]), in octal (if it begins with [0o] or [0O]), or in binary (if it begins with [0b] or [0B]). The [0u] prefix reads the input as an unsigned integer in the range [[0, 2*max_int+1]]. If the input exceeds {!max_int} it is converted to the signed integer [min_int + input - max_int - 1]. The [_] (underscore) character can appear anywhere in the string and is ignored. Return [None] if the given string is not a valid representation of an integer, or if the integer represented exceeds the range of integers representable in type [int]. @since 4.05" + "doc": null } { "name": "Int64.of_string_opt", "type": "string -> int64 option", "cost": 2, - "doc": "Same as [of_string], but return [None] instead of raising. @since 4.05" + "doc": null } { "name": "Int32.of_string_opt", "type": "string -> int32 option", "cost": 2, - "doc": "Same as [of_string], but return [None] instead of raising. @since 4.05" + "doc": null } { "name": "Sys.getenv_opt", "type": "string -> string option", "cost": 4, - "doc": "Return the value associated to a variable in the process environment or [None] if the variable is unbound. @since 4.05" + "doc": null } { "name": "bool_of_string_opt", "type": "string -> bool option", "cost": 4, - "doc": "Convert the given string to a boolean. Return [None] if the string is not [\"true\"] or [\"false\"]. @since 4.05" + "doc": null } { "name": "bool_of_string_opt", "type": "string -> bool option", "cost": 4, - "doc": "Convert the given string to a boolean. Return [None] if the string is not [\"true\"] or [\"false\"]. @since 4.05" + "doc": null } { "name": "Float.of_string_opt", "type": "string -> float option", "cost": 4, - "doc": "Same as [of_string], but returns [None] instead of raising." + "doc": null } { "name": "float_of_string_opt", "type": "string -> float option", "cost": 4, - "doc": "Convert the given string to a float. The string is read in decimal (by default) or in hexadecimal (marked by [0x] or [0X]). The format of decimal floating-point numbers is [ [-] dd.ddd (e|E) [+|-] dd ], where [d] stands for a decimal digit. The format of hexadecimal floating-point numbers is [ [-] 0(x|X) hh.hhh (p|P) [+|-] dd ], where [h] stands for an hexadecimal digit and [d] for a decimal digit. In both cases, at least one of the integer and fractional parts must be given; the exponent part is optional. The [_] (underscore) character can appear anywhere in the string and is ignored. Depending on the execution platforms, other representations of floating-point numbers can be accepted, but should not be relied upon. Return [None] if the given string is not a valid representation of a float. @since 4.05" + "doc": null } { "name": "float_of_string_opt", "type": "string -> float option", "cost": 4, - "doc": "Convert the given string to a float. The string is read in decimal (by default) or in hexadecimal (marked by [0x] or [0X]). The format of decimal floating-point numbers is [ [-] dd.ddd (e|E) [+|-] dd ], where [d] stands for a decimal digit. The format of hexadecimal floating-point numbers is [ [-] 0(x|X) hh.hhh (p|P) [+|-] dd ], where [h] stands for an hexadecimal digit and [d] for a decimal digit. In both cases, at least one of the integer and fractional parts must be given; the exponent part is optional. The [_] (underscore) character can appear anywhere in the string and is ignored. Depending on the execution platforms, other representations of floating-point numbers can be accepted, but should not be relied upon. Return [None] if the given string is not a valid representation of a float. @since 4.05" + "doc": null } @@ -70,61 +70,61 @@ "name": "List.map", "type": "('a -> 'b) -> 'a list -> 'b list", "cost": 0, - "doc": "[map f [a1; ...; an]] applies function [f] to [a1, ..., an], and builds the list [[f a1; ...; f an]] with the results returned by [f]." + "doc": null } { "name": "List.rev_map", "type": "('a -> 'b) -> 'a list -> 'b list", "cost": 0, - "doc": "[rev_map f l] gives the same result as {!rev}[ (]{!map}[ f l)], but is more efficient." + "doc": null } { "name": "ListLabels.map", "type": "f:('a -> 'b) -> 'a list -> 'b list", "cost": 0, - "doc": "[map ~f [a1; ...; an]] applies function [f] to [a1, ..., an], and builds the list [[f a1; ...; f an]] with the results returned by [f]." + "doc": null } { "name": "ListLabels.rev_map", "type": "f:('a -> 'b) -> 'a list -> 'b list", "cost": 0, - "doc": "[rev_map ~f l] gives the same result as {!rev}[ (]{!map}[ f l)], but is more efficient." + "doc": null } { "name": "List.mapi", "type": "(int -> 'a -> 'b) -> 'a list -> 'b list", "cost": 5, - "doc": "Same as {!map}, but the function is applied to the index of the element as first argument (counting from 0), and the element itself as second argument. @since 4.00" + "doc": null } { "name": "ListLabels.mapi", "type": "f:(int -> 'a -> 'b) -> 'a list -> 'b list", "cost": 5, - "doc": "Same as {!map}, but the function is applied to the index of the element as first argument (counting from 0), and the element itself as second argument. @since 4.00" + "doc": null } { "name": "Seq.map", "type": "('a -> 'b) -> 'a Stdlib__Seq.t -> 'b Stdlib__Seq.t", "cost": 10, - "doc": "[map f xs] is the image of the sequence [xs] through the transformation [f]. If [xs] is the sequence [x0; x1; ...] then [map f xs] is the sequence [f x0; f x1; ...]." + "doc": null } { - "name": "List.concat_map", - "type": "('a -> 'b list) -> 'a list -> 'b list", + "name": "List.filter_map", + "type": "('a -> 'b option) -> 'a list -> 'b list", "cost": 10, - "doc": "[concat_map f l] gives the same result as {!concat}[ (]{!map}[ f l)]. Tail-recursive. @since 4.10" + "doc": null } { - "name": "List.filter_map", - "type": "('a -> 'b option) -> 'a list -> 'b list", + "name": "List.concat_map", + "type": "('a -> 'b list) -> 'a list -> 'b list", "cost": 10, - "doc": "[filter_map f l] applies [f] to every element of [l], filters out the [None] elements and returns the list of the arguments of the [Some] elements. @since 4.08" + "doc": null } { - "name": "ListLabels.concat_map", - "type": "f:('a -> 'b list) -> 'a list -> 'b list", + "name": "ListLabels.filter_map", + "type": "f:('a -> 'b option) -> 'a list -> 'b list", "cost": 10, - "doc": "[concat_map ~f l] gives the same result as {!concat}[ (]{!map}[ f l)]. Tail-recursive. @since 4.10" + "doc": null } $ $MERLIN single search-by-type -filename ./context.ml \ @@ -146,16 +146,7 @@ "name": "Hashtbl.add", "type": "('a, 'b) Stdlib__Hashtbl.t -> 'a -> 'b -> unit", "cost": 1, - "doc": "[Hashtbl.add tbl key data] adds a binding of [key] to [data] - in table [tbl]. - - {b Warning}: Previous bindings for [key] are not removed, but simply - hidden. That is, after performing {!remove}[ tbl key], - the previous binding for [key], if any, is restored. - (Same behavior as with association lists.) - - If you desire the classic behavior of replacing elements, - see {!replace}.", + "doc": null, "constructible": "Hashtbl.add _ _ _" }, { @@ -171,11 +162,7 @@ "name": "Hashtbl.replace", "type": "('a, 'b) Stdlib__Hashtbl.t -> 'a -> 'b -> unit", "cost": 2, - "doc": "[Hashtbl.replace tbl key data] replaces the current binding of [key] - in [tbl] by a binding of [key] to [data]. If [key] is unbound in [tbl], - a binding of [key] to [data] is added to [tbl]. - This is functionally equivalent to {!remove}[ tbl key] - followed by {!add}[ tbl key data].", + "doc": null, "constructible": "Hashtbl.replace _ _ _" }, { @@ -191,8 +178,7 @@ "name": "Hashtbl.add_seq", "type": "('a, 'b) Stdlib__Hashtbl.t -> ('a * 'b) Seq.t -> unit", "cost": 24, - "doc": "Add the given bindings to the table, using {!add} - @since 4.07", + "doc": null, "constructible": "Hashtbl.add_seq _ _" }, { @@ -208,8 +194,7 @@ "name": "Hashtbl.replace_seq", "type": "('a, 'b) Stdlib__Hashtbl.t -> ('a * 'b) Seq.t -> unit", "cost": 25, - "doc": "Add the given bindings to the table, using {!replace} - @since 4.07", + "doc": null, "constructible": "Hashtbl.replace_seq _ _" }, { @@ -227,8 +212,7 @@ right:('b1 -> 'b2) -> ('a1, 'b1) Stdlib__Either.t -> ('a2, 'b2) Stdlib__Either.t", "cost": 44, - "doc": "[map ~left ~right (Left v)] is [Left (left v)], - [map ~left ~right (Right v)] is [Right (right v)].", + "doc": null, "constructible": "Either.map ~left:_ ~right:_ _" }, { @@ -244,54 +228,40 @@ "name": "MoreLabels.Hashtbl.add", "type": "('a, 'b) Stdlib__MoreLabels.Hashtbl.t -> key:'a -> data:'b -> unit", "cost": 47, - "doc": "[Hashtbl.add tbl ~key ~data] adds a binding of [key] to [data] - in table [tbl]. - - {b Warning}: Previous bindings for [key] are not removed, but simply - hidden. That is, after performing {!remove}[ tbl key], - the previous binding for [key], if any, is restored. - (Same behavior as with association lists.) - - If you desire the classic behavior of replacing elements, - see {!replace}.", + "doc": null, "constructible": "MoreLabels.Hashtbl.add _ ~key:_ ~data:_" }, { "file": "moreLabels.mli", "start": { - "line": 318, + "line": 168, "col": 2 }, "end": { - "line": 318, - "col": 52 + "line": 168, + "col": 55 }, - "name": "MoreLabels.Hashtbl.add_seq", - "type": "('a, 'b) Stdlib__MoreLabels.Hashtbl.t -> ('a * 'b) Seq.t -> unit", + "name": "MoreLabels.Hashtbl.replace", + "type": "('a, 'b) Stdlib__MoreLabels.Hashtbl.t -> key:'a -> data:'b -> unit", "cost": 48, - "doc": "Add the given bindings to the table, using {!add} - @since 4.07", - "constructible": "MoreLabels.Hashtbl.add_seq _ _" + "doc": null, + "constructible": "MoreLabels.Hashtbl.replace _ ~key:_ ~data:_" }, { "file": "moreLabels.mli", "start": { - "line": 168, + "line": 318, "col": 2 }, "end": { - "line": 168, - "col": 55 + "line": 318, + "col": 52 }, - "name": "MoreLabels.Hashtbl.replace", - "type": "('a, 'b) Stdlib__MoreLabels.Hashtbl.t -> key:'a -> data:'b -> unit", + "name": "MoreLabels.Hashtbl.add_seq", + "type": "('a, 'b) Stdlib__MoreLabels.Hashtbl.t -> ('a * 'b) Seq.t -> unit", "cost": 48, - "doc": "[Hashtbl.replace tbl ~key ~data] replaces the current binding of [key] - in [tbl] by a binding of [key] to [data]. If [key] is unbound in [tbl], - a binding of [key] to [data] is added to [tbl]. - This is functionally equivalent to {!remove}[ tbl key] - followed by {!add}[ tbl key data].", - "constructible": "MoreLabels.Hashtbl.replace _ ~key:_ ~data:_" + "doc": null, + "constructible": "MoreLabels.Hashtbl.add_seq _ _" }, { "file": "moreLabels.mli", @@ -306,8 +276,7 @@ "name": "MoreLabels.Hashtbl.replace_seq", "type": "('a, 'b) Stdlib__MoreLabels.Hashtbl.t -> ('a * 'b) Seq.t -> unit", "cost": 49, - "doc": "Add the given bindings to the table, using {!replace} - @since 4.07", + "doc": null, "constructible": "MoreLabels.Hashtbl.replace_seq _ _" }, { @@ -323,9 +292,74 @@ "name": "Ephemeron.K2.query", "type": "('k1, 'k2, 'd) Stdlib__Ephemeron.K2.t -> 'k1 -> 'k2 -> 'd option", "cost": 53, - "doc": "Same as {!Ephemeron.K1.query}", + "doc": null, "constructible": "Ephemeron.K2.query _ _ _" } ], "notifications": [] } + + + $ $MERLIN single search-by-type -filename ./context.ml \ + > -position 5:25 -limit 10 -with-doc true -query "string -> int option" | + > tr '\n' ' ' | jq '.value[] | {name,type,cost,doc}' + { + "name": "int_of_string_opt", + "type": "string -> int option", + "cost": 0, + "doc": "Convert the given string to an integer. The string is read in decimal (by default, or if the string begins with [0u]), in hexadecimal (if it begins with [0x] or [0X]), in octal (if it begins with [0o] or [0O]), or in binary (if it begins with [0b] or [0B]). The [0u] prefix reads the input as an unsigned integer in the range [[0, 2*max_int+1]]. If the input exceeds {!max_int} it is converted to the signed integer [min_int + input - max_int - 1]. The [_] (underscore) character can appear anywhere in the string and is ignored. Return [None] if the given string is not a valid representation of an integer, or if the integer represented exceeds the range of integers representable in type [int]. @since 4.05" + } + { + "name": "int_of_string_opt", + "type": "string -> int option", + "cost": 0, + "doc": "Convert the given string to an integer. The string is read in decimal (by default, or if the string begins with [0u]), in hexadecimal (if it begins with [0x] or [0X]), in octal (if it begins with [0o] or [0O]), or in binary (if it begins with [0b] or [0B]). The [0u] prefix reads the input as an unsigned integer in the range [[0, 2*max_int+1]]. If the input exceeds {!max_int} it is converted to the signed integer [min_int + input - max_int - 1]. The [_] (underscore) character can appear anywhere in the string and is ignored. Return [None] if the given string is not a valid representation of an integer, or if the integer represented exceeds the range of integers representable in type [int]. @since 4.05" + } + { + "name": "Int64.of_string_opt", + "type": "string -> int64 option", + "cost": 2, + "doc": "Same as [of_string], but return [None] instead of raising. @since 4.05" + } + { + "name": "Int32.of_string_opt", + "type": "string -> int32 option", + "cost": 2, + "doc": "Same as [of_string], but return [None] instead of raising. @since 4.05" + } + { + "name": "Sys.getenv_opt", + "type": "string -> string option", + "cost": 4, + "doc": "Return the value associated to a variable in the process environment or [None] if the variable is unbound. @since 4.05" + } + { + "name": "bool_of_string_opt", + "type": "string -> bool option", + "cost": 4, + "doc": "Convert the given string to a boolean. Return [None] if the string is not [\"true\"] or [\"false\"]. @since 4.05" + } + { + "name": "bool_of_string_opt", + "type": "string -> bool option", + "cost": 4, + "doc": "Convert the given string to a boolean. Return [None] if the string is not [\"true\"] or [\"false\"]. @since 4.05" + } + { + "name": "Float.of_string_opt", + "type": "string -> float option", + "cost": 4, + "doc": "Same as [of_string], but returns [None] instead of raising." + } + { + "name": "float_of_string_opt", + "type": "string -> float option", + "cost": 4, + "doc": "Convert the given string to a float. The string is read in decimal (by default) or in hexadecimal (marked by [0x] or [0X]). The format of decimal floating-point numbers is [ [-] dd.ddd (e|E) [+|-] dd ], where [d] stands for a decimal digit. The format of hexadecimal floating-point numbers is [ [-] 0(x|X) hh.hhh (p|P) [+|-] dd ], where [h] stands for an hexadecimal digit and [d] for a decimal digit. In both cases, at least one of the integer and fractional parts must be given; the exponent part is optional. The [_] (underscore) character can appear anywhere in the string and is ignored. Depending on the execution platforms, other representations of floating-point numbers can be accepted, but should not be relied upon. Return [None] if the given string is not a valid representation of a float. @since 4.05" + } + { + "name": "float_of_string_opt", + "type": "string -> float option", + "cost": 4, + "doc": "Convert the given string to a float. The string is read in decimal (by default) or in hexadecimal (marked by [0x] or [0X]). The format of decimal floating-point numbers is [ [-] dd.ddd (e|E) [+|-] dd ], where [d] stands for a decimal digit. The format of hexadecimal floating-point numbers is [ [-] 0(x|X) hh.hhh (p|P) [+|-] dd ], where [h] stands for an hexadecimal digit and [d] for a decimal digit. In both cases, at least one of the integer and fractional parts must be given; the exponent part is optional. The [_] (underscore) character can appear anywhere in the string and is ignored. Depending on the execution platforms, other representations of floating-point numbers can be accepted, but should not be relied upon. Return [None] if the given string is not a valid representation of a float. @since 4.05" + }