Skip to content

Commit

Permalink
Apply OCamlformat
Browse files Browse the repository at this point in the history
  • Loading branch information
xvw committed Sep 24, 2024
1 parent e33facc commit c3e9c69
Show file tree
Hide file tree
Showing 19 changed files with 237 additions and 257 deletions.
25 changes: 14 additions & 11 deletions src/analysis/polarity_search.ml
Original file line number Diff line number Diff line change
Expand Up @@ -85,15 +85,17 @@ let build_query ~positive ~negative env =

let prepare_query env query =
let re = Str.regexp "[ |\t]+" in
let pos,neg = Str.split re query |> List.partition ~f:(fun s->s.[0]<>'-') in
let pos, neg =
Str.split re query |> List.partition ~f:(fun s -> s.[0] <> '-')
in
let prepare s =
Longident.parse @@
if s.[0] = '-' || s.[0] = '+'
then String.sub s ~pos:1 ~len:(String.length s - 1)
Longident.parse
@@
if s.[0] = '-' || s.[0] = '+' then
String.sub s ~pos:1 ~len:(String.length s - 1)
else s
in
build_query env
~positive:(List.map pos ~f:prepare)
build_query env ~positive:(List.map pos ~f:prepare)
~negative:(List.map neg ~f:prepare)

let directories ~global_modules env =
Expand Down Expand Up @@ -145,8 +147,9 @@ let execute_query query env dirs =

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
Env.fold_values
(fun _ path desc acc ->
let d = desc.Types.val_type in
match match_query env query d with
| Some cost ->
let path = Printtyp.rewrite_double_underscore_paths env path in
Expand All @@ -159,9 +162,9 @@ let execute_query_as_type_search ?(limit = 100) ~env ~query ~modules doc_ctx =
desc.Types.val_type
in
let constructible = Type_search.make_constructible name d in
Query_protocol.{cost; name; typ; loc; doc; constructible} :: acc
| None -> acc
) dir env acc
Query_protocol.{ cost; name; typ; loc; doc; constructible } :: acc
| None -> acc)
dir env acc
in
let rec recurse acc (Trie (_, dir, children)) =
match
Expand Down
114 changes: 49 additions & 65 deletions src/analysis/type_search.ml
Original file line number Diff line number Diff line change
@@ -1,37 +1,37 @@
(* {{{ COPYING *(
This file is part of Merlin, an helper for ocaml editors
Copyright (C) 2013 - 2024 Frédéric Bour <frederic.bour(_)lakaban.net>
Thomas Refis <refis.thomas(_)gmail.com>
Simon Castellan <simon.castellan(_)iuwt.fr>
Arthur Wendling <arthur(_)tarides.com>
Xavier Van de Woestyne <xaviervdw(_)gmail.com>
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation the
rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
sell copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
The Software is provided "as is", without warranty of any kind, express or
implied, including but not limited to the warranties of merchantability,
fitness for a particular purpose and noninfringement. In no event shall
the authors or copyright holders be liable for any claim, damages or other
liability, whether in an action of contract, tort or otherwise, arising
from, out of or in connection with the software or the use or other dealings
in the Software.
)* }}} *)
This file is part of Merlin, an helper for ocaml editors
Copyright (C) 2013 - 2024 Frédéric Bour <frederic.bour(_)lakaban.net>
Thomas Refis <refis.thomas(_)gmail.com>
Simon Castellan <simon.castellan(_)iuwt.fr>
Arthur Wendling <arthur(_)tarides.com>
Xavier Van de Woestyne <xaviervdw(_)gmail.com>
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation the
rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
sell copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
The Software is provided "as is", without warranty of any kind, express or
implied, including but not limited to the warranties of merchantability,
fitness for a particular purpose and noninfringement. In no event shall
the authors or copyright holders be liable for any claim, damages or other
liability, whether in an action of contract, tort or otherwise, arising
from, out of or in connection with the software or the use or other dealings
in the Software.
)* }}} *)

open Std

let sherlodoc_type_of env typ =
let open Merlin_sherlodoc in
let open Merlin_sherlodoc in
let rec aux typ =
match Types.get_desc typ with
| Types.Tvar None -> Type_parsed.Wildcard
Expand All @@ -43,15 +43,16 @@ let sherlodoc_type_of env typ =
let name = Format.asprintf "%a" Printtyp.path p in
Type_parsed.Tycon (name, List.map ~f:aux args)
| _ -> Type_parsed.Unhandled
in typ |> aux |> Type_expr.normalize_type_parameters
in
typ |> aux |> Type_expr.normalize_type_parameters

let make_constructible path desc =
let holes = match Types.get_desc desc with
let holes =
match Types.get_desc desc with
| Types.Tarrow (l, _, b, _) ->
let rec aux acc t =
match Types.get_desc t with
| Types.Tarrow (l, _, b, _) ->
aux (acc ^ with_label l) b
| Types.Tarrow (l, _, b, _) -> aux (acc ^ with_label l) b
| _ -> acc
and with_label l =
match l with
Expand All @@ -64,38 +65,26 @@ let make_constructible path desc =
in
path ^ holes


let doc_to_option = function
| `Builtin doc
| `Found doc -> Some doc
| `Builtin doc | `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)
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; _}
=
let compare_result Query_protocol.{ cost = cost_a; name = a; doc = doc_a; _ }
Query_protocol.{ cost = cost_b; name = b; doc = doc_b; _ } =
let c = Int.compare cost_a cost_b in
if Int.equal c 0 then
let c = Int.compare (String.length a) (String.length b) in
match c, doc_a, doc_b with
match (c, doc_a, doc_b) with
| 0, Some _, None -> 1
| 0, None, Some _ -> -1
| 0, Some a, Some b ->
Int.compare (String.length a) (String.length b)
| 0, Some a, Some b -> Int.compare (String.length a) (String.length b)
| _ -> c
else c

Expand All @@ -116,7 +105,7 @@ let compute_value doc_ctx query env _ path desc acc =
desc.Types.val_type
in
let constructible = make_constructible name d in
Query_protocol.{cost; name; typ; loc; doc; constructible} :: acc
Query_protocol.{ cost; name; typ; loc; doc; constructible } :: acc

let compute_values doc_ctx query env lident acc =
Env.fold_values (compute_value doc_ctx query env) lident env acc
Expand All @@ -125,36 +114,31 @@ 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 doc_ctx query env (Some lident) acc in
Env.fold_modules (fun name _ mdl acc ->
Env.fold_modules
(fun name _ mdl acc ->
match mdl.Types.md_type with
| Types.Mty_alias _ -> acc
| _ ->
let lident = Longident.Ldot (lident, name) in
aux acc lident
) (Some lident) env acc
aux acc lident)
(Some lident) env acc
in
aux acc lident


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 doc_ctx query env lident acc
)
|> List.fold_left ~init ~f:(fun acc name ->
let lident = Longident.Lident name in
values_from_module doc_ctx query env lident acc)
|> List.sort ~cmp:compare_result
|> List.take_n limit


let classify_query query =
let query = String.trim query in
match query.[0] with
| '+' | '-' -> `Polarity query
| _ -> `By_type query
| exception (Invalid_argument _) -> `Polarity query

| exception Invalid_argument _ -> `Polarity query
83 changes: 41 additions & 42 deletions src/analysis/type_search.mli
Original file line number Diff line number Diff line change
@@ -1,58 +1,57 @@
(* {{{ COPYING *(
This file is part of Merlin, an helper for ocaml editors
Copyright (C) 2013 - 2024 Frédéric Bour <frederic.bour(_)lakaban.net>
Thomas Refis <refis.thomas(_)gmail.com>
Simon Castellan <simon.castellan(_)iuwt.fr>
Arthur Wendling <arthur(_)tarides.com>
Xavier Van de Woestyne <xaviervdw(_)gmail.com>
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation the
rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
sell copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
The Software is provided "as is", without warranty of any kind, express or
implied, including but not limited to the warranties of merchantability,
fitness for a particular purpose and noninfringement. In no event shall
the authors or copyright holders be liable for any claim, damages or other
liability, whether in an action of contract, tort or otherwise, arising
from, out of or in connection with the software or the use or other dealings
in the Software.
)* }}} *)
This file is part of Merlin, an helper for ocaml editors
Copyright (C) 2013 - 2024 Frédéric Bour <frederic.bour(_)lakaban.net>
Thomas Refis <refis.thomas(_)gmail.com>
Simon Castellan <simon.castellan(_)iuwt.fr>
Arthur Wendling <arthur(_)tarides.com>
Xavier Van de Woestyne <xaviervdw(_)gmail.com>
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation the
rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
sell copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
The Software is provided "as is", without warranty of any kind, express or
implied, including but not limited to the warranties of merchantability,
fitness for a particular purpose and noninfringement. In no event shall
the authors or copyright holders be liable for any claim, damages or other
liability, whether in an action of contract, tort or otherwise, arising
from, out of or in connection with the software or the use or other dealings
in the Software.
)* }}} *)

(** Search by type in the current environment. *)

(** Compute the list of candidates from a query inside a given environment. *)
val run :
?limit:int ->
env:Env.t ->
query:Merlin_sherlodoc.Query.t
-> modules:string list
-> (Mconfig.t
* Mtyper.typedtree
* (string * Location.t) list
* Lexing.position)
option
-> Query_protocol.type_search_result list
query:Merlin_sherlodoc.Query.t ->
modules:string list ->
(Mconfig.t * Mtyper.typedtree * (string * Location.t) list * Lexing.position)
option ->
Query_protocol.type_search_result list

val get_doc :
(Mconfig.t
* Mtyper.typedtree
* (string * Warnings.loc) list
* Lexing.position) option -> Env.t -> string -> string option

* 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 ->
Query_protocol.type_search_result ->
int
Query_protocol.type_search_result -> Query_protocol.type_search_result -> int

val classify_query : string -> [ `By_type of string | `Polarity of string ]
12 changes: 6 additions & 6 deletions src/sherlodoc/name_cost.ml
Original file line number Diff line number Diff line change
Expand Up @@ -92,11 +92,11 @@ let best_distance ?cutoff words entry =
let rec aux acc = function
| [] -> acc |> Option.value ~default:0
| x :: xs -> (
match distance_of_substring ?cutoff x entry with
| None -> aux acc xs
| Some 0 -> 0
| Some x ->
let acc = Int.min x (Option.value ~default:x acc) in
aux (Some acc) xs)
match distance_of_substring ?cutoff x entry with
| None -> aux acc xs
| Some 0 -> 0
| Some x ->
let acc = Int.min x (Option.value ~default:x acc) in
aux (Some acc) xs)
in
aux None words
6 changes: 3 additions & 3 deletions src/sherlodoc/name_cost.mli
Original file line number Diff line number Diff line change
Expand Up @@ -28,15 +28,15 @@

(** Utilities for calculating distances between names. *)

val distance : ?cutoff:int -> string -> string -> int option
(** [distance ?cutoff a b] returns the
{{:https://en.wikipedia.org/wiki/Damerau%E2%80%93Levenshtein_distance}
Damerau-Levenshtein} between [a] and [b]. *)
val distance : ?cutoff:int -> string -> string -> int option

val distance_of_substring : ?cutoff:int -> string -> string -> int option
(** [distance_of_substring ?cutoff a b] compute the distance by extracting
relevant substring from [b] *)
val distance_of_substring : ?cutoff:int -> string -> string -> int option

val best_distance : ?cutoff:int -> string list -> string -> int
(** [best_distance ?cutoff words entry] compute the best distance of a list of
string according to a given string. *)
val best_distance : ?cutoff:int -> string list -> string -> int
18 changes: 9 additions & 9 deletions src/sherlodoc/query.ml
Original file line number Diff line number Diff line change
Expand Up @@ -70,16 +70,16 @@ let from_string str =
let words, type_expr =
match String.index_opt str ':' with
| None ->
if guess_type_search len str then
let str = balance_parens len str in
("", Type_expr.from_string str)
else (str, None)
if guess_type_search len str then
let str = balance_parens len str in
("", Type_expr.from_string str)
else (str, None)
| Some loc ->
let str_name = String.sub str 0 loc
and str_type = String.sub str (succ loc) (len - loc - 1) in
let len = String.length str_type in
let str_type = balance_parens len str_type in
(str_name, Type_expr.from_string str_type)
let str_name = String.sub str 0 loc
and str_type = String.sub str (succ loc) (len - loc - 1) in
let len = String.length str_type in
let str_type = balance_parens len str_type in
(str_name, Type_expr.from_string str_type)
in
let words = naive_of_string words in
{ words; type_expr }
Expand Down
Loading

0 comments on commit c3e9c69

Please sign in to comment.