From c3e9c692d00fadf48960ba42e12accc0f30a58e2 Mon Sep 17 00:00:00 2001 From: xvw Date: Tue, 24 Sep 2024 16:28:25 +0200 Subject: [PATCH] Apply OCamlformat --- src/analysis/polarity_search.ml | 25 ++-- src/analysis/type_search.ml | 114 +++++++--------- src/analysis/type_search.mli | 83 ++++++------ src/sherlodoc/name_cost.ml | 12 +- src/sherlodoc/name_cost.mli | 6 +- src/sherlodoc/query.ml | 18 +-- src/sherlodoc/query.mli | 10 +- src/sherlodoc/type_distance.ml | 126 +++++++++--------- src/sherlodoc/type_distance.mli | 2 +- src/sherlodoc/type_expr.ml | 40 +++--- src/sherlodoc/type_expr.mli | 8 +- src/sherlodoc/type_parsed.mli | 2 +- src/sherlodoc/type_polarity.mli | 8 +- src/utils/marg.ml | 10 +- tests/test-units/sherldoc/name_cost_test.ml | 10 +- tests/test-units/sherldoc/query_test.ml | 5 +- tests/test-units/sherldoc/sherlodoc_test.ml | 5 +- .../test-units/sherldoc/type_distance_test.ml | 5 +- tests/test-units/sherldoc/type_expr_test.ml | 5 +- 19 files changed, 237 insertions(+), 257 deletions(-) diff --git a/src/analysis/polarity_search.ml b/src/analysis/polarity_search.ml index afc78f06d..2c7ada451 100644 --- a/src/analysis/polarity_search.ml +++ b/src/analysis/polarity_search.ml @@ -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 = @@ -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 @@ -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 diff --git a/src/analysis/type_search.ml b/src/analysis/type_search.ml index a80b3de47..9ab04e5f1 100644 --- a/src/analysis/type_search.ml +++ b/src/analysis/type_search.ml @@ -1,37 +1,37 @@ (* {{{ COPYING *( - This file is part of Merlin, an helper for ocaml editors - - Copyright (C) 2013 - 2024 Frédéric Bour - Thomas Refis - Simon Castellan - Arthur Wendling - Xavier Van de Woestyne - - 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 + Thomas Refis + Simon Castellan + Arthur Wendling + Xavier Van de Woestyne + + 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 @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/src/analysis/type_search.mli b/src/analysis/type_search.mli index 5596cefdb..a4dc9dd51 100644 --- a/src/analysis/type_search.mli +++ b/src/analysis/type_search.mli @@ -1,32 +1,32 @@ (* {{{ COPYING *( - This file is part of Merlin, an helper for ocaml editors - - Copyright (C) 2013 - 2024 Frédéric Bour - Thomas Refis - Simon Castellan - Arthur Wendling - Xavier Van de Woestyne - - 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 + Thomas Refis + Simon Castellan + Arthur Wendling + Xavier Van de Woestyne + + 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. *) @@ -34,25 +34,24 @@ 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 ] diff --git a/src/sherlodoc/name_cost.ml b/src/sherlodoc/name_cost.ml index ef2dd143a..c69009cfc 100644 --- a/src/sherlodoc/name_cost.ml +++ b/src/sherlodoc/name_cost.ml @@ -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 diff --git a/src/sherlodoc/name_cost.mli b/src/sherlodoc/name_cost.mli index 28f943fca..51a7b90b0 100644 --- a/src/sherlodoc/name_cost.mli +++ b/src/sherlodoc/name_cost.mli @@ -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 diff --git a/src/sherlodoc/query.ml b/src/sherlodoc/query.ml index 121c538b5..8d81d50ea 100644 --- a/src/sherlodoc/query.ml +++ b/src/sherlodoc/query.ml @@ -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 } diff --git a/src/sherlodoc/query.mli b/src/sherlodoc/query.mli index 71999ff8b..2cd5cd316 100644 --- a/src/sherlodoc/query.mli +++ b/src/sherlodoc/query.mli @@ -29,18 +29,18 @@ (** Prepares a query based on a string of characters. A query acts on the identifier of a function and its type.. *) -type t = { words : string list; type_expr : Type_expr.t option } (** Describes a search on an identifier and a type. *) +type t = { words : string list; type_expr : Type_expr.t option } -val from_string : string -> t (** Converts a string into a search query. *) +val from_string : string -> t -val to_string : t -> string (** Inspect a query (mostly for debugging purpose). *) +val to_string : t -> string -val equal : t -> t -> bool (** Equality between queries. *) +val equal : t -> t -> bool -val distance_for : t -> path:string -> Type_expr.t -> int (** [distance_for query ~path typexpr] returns a score for a [query] observing a given value, (a [path] and a [type_expr]). *) +val distance_for : t -> path:string -> Type_expr.t -> int diff --git a/src/sherlodoc/type_distance.ml b/src/sherlodoc/type_distance.ml index 60dbda453..7a3481dd1 100644 --- a/src/sherlodoc/type_distance.ml +++ b/src/sherlodoc/type_distance.ml @@ -43,25 +43,25 @@ let make_path t = | Type_expr.Wildcard -> [ Wildcard :: prefix ] | Type_expr.Tyvar x -> [ Tyvar x :: prefix ] | Type_expr.Arrow (a, b) -> - List.rev_append - (aux (Left_arrow :: prefix) a) - (aux (Right_arrow :: prefix) b) + List.rev_append + (aux (Left_arrow :: prefix) a) + (aux (Right_arrow :: prefix) b) | Type_expr.Tycon (constr, []) -> [ Tyname constr :: prefix ] | Type_expr.Tycon (constr, args) -> - let length = String.length constr in - let prefix = Tyname constr :: prefix in - args - |> List.mapi (fun position arg -> - let prefix = Argument { position; length } :: prefix in - aux prefix arg) - |> List.fold_left (fun acc xs -> List.rev_append xs acc) [] + let length = String.length constr in + let prefix = Tyname constr :: prefix in + args + |> List.mapi (fun position arg -> + let prefix = Argument { position; length } :: prefix in + aux prefix arg) + |> List.fold_left (fun acc xs -> List.rev_append xs acc) [] | Type_expr.Tuple args -> - let length = List.length args in - args - |> List.mapi (fun position arg -> - let prefix = Product { position; length } :: prefix in - aux prefix arg) - |> List.fold_left (fun acc xs -> List.rev_append xs acc) [] + let length = List.length args in + args + |> List.mapi (fun position arg -> + let prefix = Product { position; length } :: prefix in + aux prefix arg) + |> List.fold_left (fun acc xs -> List.rev_append xs acc) [] in List.map List.rev (aux [] t) @@ -90,31 +90,31 @@ let distance xs ys = | _, [] -> max_distance | [ Tyvar _ ], [ Wildcard ] when P.equal xpolarity ypolarity -> 0 | [ Tyvar x ], [ Tyvar y ] when P.equal xpolarity ypolarity -> - if Int.equal x y then 0 else 1 + if Int.equal x y then 0 else 1 | Left_arrow :: xs, Left_arrow :: ys -> - let xpolarity = P.negate xpolarity and ypolarity = P.negate ypolarity in - memo ~xpolarity ~ypolarity (succ i) (succ j) xs ys + let xpolarity = P.negate xpolarity and ypolarity = P.negate ypolarity in + memo ~xpolarity ~ypolarity (succ i) (succ j) xs ys | Left_arrow :: xs, _ -> - let xpolarity = P.negate xpolarity in - memo ~xpolarity ~ypolarity (succ i) j xs ys + let xpolarity = P.negate xpolarity in + memo ~xpolarity ~ypolarity (succ i) j xs ys | _, Left_arrow :: ys -> - let ypolarity = P.negate ypolarity in - memo ~xpolarity ~ypolarity i (succ j) xs ys + let ypolarity = P.negate ypolarity in + memo ~xpolarity ~ypolarity i (succ j) xs ys | _, Right_arrow :: ys -> memo ~xpolarity ~ypolarity i (succ j) xs ys | Right_arrow :: xs, _ -> memo ~xpolarity ~ypolarity (succ i) j xs ys | Product { length = a; _ } :: xs, Product { length = b; _ } :: ys | Argument { length = a; _ } :: xs, Argument { length = b; _ } :: ys -> - let l = abs (a - b) in - l + memo ~xpolarity ~ypolarity (succ i) (succ j) xs ys + let l = abs (a - b) in + l + memo ~xpolarity ~ypolarity (succ i) (succ j) xs ys | Product _ :: xs, ys -> 1 + memo ~xpolarity ~ypolarity (succ i) j xs ys | xs, Product _ :: ys -> 1 + memo ~xpolarity ~ypolarity i (succ j) xs ys | Tyname x :: xs', Tyname y :: ys' when P.equal xpolarity ypolarity -> ( - match Name_cost.distance x y with - | None -> skip_entry + memo ~xpolarity ~ypolarity i (succ j) xs ys' - | Some cost -> - cost + memo ~xpolarity ~ypolarity (succ i) (succ j) xs' ys') + match Name_cost.distance x y with + | None -> skip_entry + memo ~xpolarity ~ypolarity i (succ j) xs ys' + | Some cost -> cost + memo ~xpolarity ~ypolarity (succ i) (succ j) xs' ys' + ) | xs, Tyname _ :: ys -> - skip_entry + memo ~xpolarity ~ypolarity i (succ j) xs ys + skip_entry + memo ~xpolarity ~ypolarity i (succ j) xs ys | xs, Argument _ :: ys -> memo ~xpolarity ~ypolarity i (succ j) xs ys | _, (Wildcard | Tyvar _) :: _ -> max_distance in @@ -146,39 +146,39 @@ let replace_score best score = best := Int.min score !best let minimize = function | [] -> 0 | list -> - let used, arr, heuristics = init_heuristic list in - let best = ref 1000 and limit = ref 0 in - let len_a = Array.length arr in - let rec aux rem acc i = - let () = incr limit in - if !limit > max_distance then false - else if rem <= 0 then - let score = acc + (1000 * (len_a - i)) in - let () = replace_score best score in - true - else if i >= len_a then - let score = acc + (5 * rem) in - let () = replace_score best score in - true - else if acc + heuristics.(i) >= !best then true - else - let rec find = function - | [] -> true - | (cost, j) :: rest -> - let continue = - if used.(j) then true - else - let () = used.(j) <- true in - let continue = aux (pred rem) (acc + cost) (succ i) in - let () = used.(j) <- false in - continue - in - if continue then find rest else false - in - find arr.(i) - in - let _ = aux (Array.length used) 0 0 in - !best + let used, arr, heuristics = init_heuristic list in + let best = ref 1000 and limit = ref 0 in + let len_a = Array.length arr in + let rec aux rem acc i = + let () = incr limit in + if !limit > max_distance then false + else if rem <= 0 then + let score = acc + (1000 * (len_a - i)) in + let () = replace_score best score in + true + else if i >= len_a then + let score = acc + (5 * rem) in + let () = replace_score best score in + true + else if acc + heuristics.(i) >= !best then true + else + let rec find = function + | [] -> true + | (cost, j) :: rest -> + let continue = + if used.(j) then true + else + let () = used.(j) <- true in + let continue = aux (pred rem) (acc + cost) (succ i) in + let () = used.(j) <- false in + continue + in + if continue then find rest else false + in + find arr.(i) + in + let _ = aux (Array.length used) 0 0 in + !best let compute ~query ~entry = let query = make_path query in diff --git a/src/sherlodoc/type_distance.mli b/src/sherlodoc/type_distance.mli index d4bd0b3d8..f492d0495 100644 --- a/src/sherlodoc/type_distance.mli +++ b/src/sherlodoc/type_distance.mli @@ -28,6 +28,6 @@ (** Calculate an approximation of the distance between two types. *) -val compute : query:Type_expr.t -> entry:Type_expr.t -> int (** [compute a b] calculates an approximation of the distance between [query] and [entry]. *) +val compute : query:Type_expr.t -> entry:Type_expr.t -> int diff --git a/src/sherlodoc/type_expr.ml b/src/sherlodoc/type_expr.ml index b7322b163..d613a80da 100644 --- a/src/sherlodoc/type_expr.ml +++ b/src/sherlodoc/type_expr.ml @@ -78,15 +78,15 @@ and as_list acc = function | [] -> acc ^ unhandled | [ x ] -> acc ^ to_string x | x :: xs -> - let acc = acc ^ to_string x ^ ", " in - as_list acc xs + let acc = acc ^ to_string x ^ ", " in + as_list acc xs and as_tuple acc = function | [] -> acc ^ unhandled | [ x ] -> acc ^ with_parens x | x :: xs -> - let acc = acc ^ with_parens x ^ " * " in - as_tuple acc xs + let acc = acc ^ with_parens x ^ " * " in + as_tuple acc xs module SMap = Map.Make (String) @@ -106,25 +106,25 @@ let normalize_type_parameters ty = | Type_parsed.Unhandled -> (i, map, Unhandled) | Type_parsed.Wildcard -> (i, map, Wildcard) | Type_parsed.Arrow (a, b) -> - let i, map, a = aux i map a in - let i, map, b = aux i map b in - (i, map, Arrow (a, b)) + let i, map, a = aux i map a in + let i, map, b = aux i map b in + (i, map, Arrow (a, b)) | Type_parsed.Tycon (s, r) -> - let i, map, r = map_with_state aux i map r in - (i, map, Tycon (s, r)) + let i, map, r = map_with_state aux i map r in + (i, map, Tycon (s, r)) | Type_parsed.Tuple r -> - let i, map, r = map_with_state aux i map r in - (i, map, Tuple r) + let i, map, r = map_with_state aux i map r in + (i, map, Tuple r) | Type_parsed.Tyvar var -> - let i, map, value = - match SMap.find_opt var map with - | Some value -> (i, map, value) - | None -> - let i = succ i in - let map = SMap.add var i map in - (i, map, i) - in - (i, map, Tyvar value) + let i, map, value = + match SMap.find_opt var map with + | Some value -> (i, map, value) + | None -> + let i = succ i in + let map = SMap.add var i map in + (i, map, i) + in + (i, map, Tyvar value) in let _, _, normalized = aux ~-1 SMap.empty ty in normalized diff --git a/src/sherlodoc/type_expr.mli b/src/sherlodoc/type_expr.mli index ea3cb6382..413003897 100644 --- a/src/sherlodoc/type_expr.mli +++ b/src/sherlodoc/type_expr.mli @@ -43,15 +43,15 @@ type t = | Wildcard | Unhandled -val normalize_type_parameters : Type_parsed.t -> t (** [normalize_type_parameters ty] replace string based type variables to integer based type variables. *) +val normalize_type_parameters : Type_parsed.t -> t -val from_string : string -> t option (** Try deserializing a string into a typed expression. *) +val from_string : string -> t option -val to_string : t -> string (** Render a type to a string. *) +val to_string : t -> string -val equal : t -> t -> bool (** Equality between types *) +val equal : t -> t -> bool diff --git a/src/sherlodoc/type_parsed.mli b/src/sherlodoc/type_parsed.mli index f2a36136f..970796f66 100644 --- a/src/sherlodoc/type_parsed.mli +++ b/src/sherlodoc/type_parsed.mli @@ -37,8 +37,8 @@ type t = | Wildcard | Unhandled -val tuple : t list -> t (** Create a tuple using a rather naive heuristic: - If the list is empty, it produces a type [unit] - If the list contains only one element, that element is returned - Otherwise, a tuple is constructed. *) +val tuple : t list -> t diff --git a/src/sherlodoc/type_polarity.mli b/src/sherlodoc/type_polarity.mli index db282dbe6..99592b796 100644 --- a/src/sherlodoc/type_polarity.mli +++ b/src/sherlodoc/type_polarity.mli @@ -35,15 +35,15 @@ type t val positive : t val negative : t -val negate : t -> t (** [negate x] returns [positive] if [x] is [negative] and [negative] if [x] is [positive]. *) +val negate : t -> t -val equal : t -> t -> bool (** Equality between polarity sign. *) +val equal : t -> t -> bool -val compare : t -> t -> int (** A comparison that act that [negative < positive]. *) +val compare : t -> t -> int -val to_string : t -> string (** Simple printer for polarity sign. *) +val to_string : t -> string diff --git a/src/utils/marg.ml b/src/utils/marg.ml index 7046cf96a..2d4e3a130 100644 --- a/src/utils/marg.ml +++ b/src/utils/marg.ml @@ -26,11 +26,11 @@ let bool f = failwithf "expecting boolean (%s), got %S." "yes|y|Y|true|1 / no|n|N|false|0" str) -let int f = param "int" (fun str -> - match int_of_string_opt str with - | None -> failwithf "expecting integer got %S." str - | Some x -> f x - ) +let int f = + param "int" (fun str -> + match int_of_string_opt str with + | None -> failwithf "expecting integer got %S." str + | Some x -> f x) type docstring = string diff --git a/tests/test-units/sherldoc/name_cost_test.ml b/tests/test-units/sherldoc/name_cost_test.ml index 8320b2b1c..8d9befbb1 100644 --- a/tests/test-units/sherldoc/name_cost_test.ml +++ b/tests/test-units/sherldoc/name_cost_test.ml @@ -7,8 +7,7 @@ let test_distance_1 = and computed = List.map (Name_cost.distance "decode") - [ - "decode"; + [ "decode"; "decade"; "decede"; "decide"; @@ -16,7 +15,7 @@ let test_distance_1 = "bbcode"; "become"; "code"; - "derobe"; + "derobe" ] in check (list @@ option int) "should be equal" expected computed) @@ -110,8 +109,7 @@ let test_best_distance_3 = let cases = ( "name_cost", - [ - test_distance_1; + [ test_distance_1; test_distance_2; test_distance_3; test_distance_4; @@ -122,5 +120,5 @@ let cases = test_distance_substring_4; test_best_distance_1; test_best_distance_2; - test_best_distance_3; + test_best_distance_3 ] ) diff --git a/tests/test-units/sherldoc/query_test.ml b/tests/test-units/sherldoc/query_test.ml index 429dbf9d5..37be9f4e2 100644 --- a/tests/test-units/sherldoc/query_test.ml +++ b/tests/test-units/sherldoc/query_test.ml @@ -114,13 +114,12 @@ let test_distance_8 = let cases = ( "query-parser", - [ - test_distance_1; + [ test_distance_1; test_distance_2; test_distance_3; test_distance_4; test_distance_5; test_distance_6; test_distance_7; - test_distance_8; + test_distance_8 ] ) diff --git a/tests/test-units/sherldoc/sherlodoc_test.ml b/tests/test-units/sherldoc/sherlodoc_test.ml index a043d98ff..d58b10d9f 100644 --- a/tests/test-units/sherldoc/sherlodoc_test.ml +++ b/tests/test-units/sherldoc/sherlodoc_test.ml @@ -1,8 +1,7 @@ let () = Alcotest.run "merlin-lib.sherlodoc" - [ - Type_expr_test.cases; + [ Type_expr_test.cases; Name_cost_test.cases; Type_distance_test.cases; - Query_test.cases; + Query_test.cases ] diff --git a/tests/test-units/sherldoc/type_distance_test.ml b/tests/test-units/sherldoc/type_distance_test.ml index b8aabd391..2b4707092 100644 --- a/tests/test-units/sherldoc/type_distance_test.ml +++ b/tests/test-units/sherldoc/type_distance_test.ml @@ -15,8 +15,7 @@ let expected_distance query entry expected = let cases = ( "type_distance", - [ - expected_distance "int" "int" 0; + [ expected_distance "int" "int" 0; expected_distance "string" "string" 0; expected_distance "string -> int" "string -> int" 0; expected_distance "string -> int -> float" "string -> int -> float" 0; @@ -41,5 +40,5 @@ let cases = expected_distance "('a -> 'a) -> 'a list -> 'a list" "('a -> 'b) -> 'a list -> 'b list" 2; expected_distance "'a -> 'b option -> 'a option" - "'b option -> 'a -> 'a option" 3; + "'b option -> 'a -> 'a option" 3 ] ) diff --git a/tests/test-units/sherldoc/type_expr_test.ml b/tests/test-units/sherldoc/type_expr_test.ml index 0a5b7b18f..7034a802a 100644 --- a/tests/test-units/sherldoc/type_expr_test.ml +++ b/tests/test-units/sherldoc/type_expr_test.ml @@ -135,12 +135,11 @@ let test_long_poly_identifier_1 = let cases = ( "type_expr", - [ - test_parse_simple_type_1; + [ test_parse_simple_type_1; test_parse_simple_type_2; test_parse_simple_type_3; test_parse_simple_type_4; test_simple_isomorphismic_poly_function_1; test_poly_identifier_1; - test_long_poly_identifier_1; + test_long_poly_identifier_1 ] )