Rewrite env lookup without Lazy trie

src/analysis/type_search.ml

@@ -30,10 +30,6 @@
 
 open Std
 
-type trie =
-  | T of string * Longident.t * t Lazy.t
-and t = trie list
-
 let type_of env typ =
       let open Merlin_sherlodoc in
   let rec aux typ =
@@ -68,25 +64,6 @@ let make_constructible path desc =
   in
   path ^ holes
 
-let make_trie env modules =
-  let rec walk env lident =
-    Env.fold_modules (fun name _ mdl acc ->
-        match mdl.Types.md_type with
-        | Types.Mty_alias _ -> acc
-        | _ ->
-          let lident = Longident.Ldot (lident, name) in
-          T (name, lident, lazy (walk env lident)) :: acc
-      ) (Some lident) env []
-  in
-  List.fold_left
-    ~init:[]
-    ~f:(fun acc name ->
-        let lident = Longident.Lident name in
-        match Env.find_module_by_name lident env with
-        | exception _ -> acc
-        | _ -> T (name, lident, lazy (walk env lident)) :: acc
-      )
-    modules
 
 let doc_to_option = function
   | `Builtin doc
@@ -105,48 +82,64 @@ let compare_result (cost_a, a, _, doc_a, _) (cost_b, b, _, doc_b, _) =
     | _ -> c
   else c
 
-let run ?(limit = 100) config local_defs comments pos env query trie =
-  let fold_values dir acc =
-    Env.fold_values (fun _ path desc acc ->
-        let open Merlin_sherlodoc in
-        let d = desc.Types.val_type in
-        let typ = type_of env d in
-        let path = Printtyp.rewrite_double_underscore_paths env path in
-        let path = Format.asprintf "%a" Printtyp.path path in
-        let cost = Query_parser.distance_for query ~path typ in
-        if cost >= 1000 then acc
-        else
-          let doc =
-            Locate.get_doc
-              ~config
-              ~env
-              ~local_defs
-              ~comments
-              ~pos
-              (`User_input path)
-            |> doc_to_option
-          in
-          let constructible = make_constructible path d in
-          (cost, path, desc, doc, constructible) :: acc
-      ) dir env acc
-  in
-  let rec walk acc (T (_, dir, children)) =
-    let force () =
-      let _ = Env.find_module_by_name dir env in
-      Lazy.force children
+let compute_value
+    (config, local_defs, comments, pos, query) env
+    _ path desc acc =
+  let open Merlin_sherlodoc in
+  let d = desc.Types.val_type in
+  let typ = type_of env d in
+  let path = Printtyp.rewrite_double_underscore_paths env path in
+  let path = Format.asprintf "%a" Printtyp.path path in
+  let cost = Query_parser.distance_for query ~path typ in
+  if cost >= 1000 then acc
+  else
+    let doc =
+      Locate.get_doc
+        ~config
+        ~env
+        ~local_defs
+        ~comments
+        ~pos
+        (`User_input path)
+      |> doc_to_option
     in
-    match force () with
-    | computed_children ->
-      let init = fold_values (Some dir) acc in
-      List.fold_left ~init ~f:walk computed_children
+    let constructible = make_constructible path d in
+    (cost, path, desc, doc, constructible) :: acc
+
+let compute_values ctx env lident acc =
+  Env.fold_values (compute_value ctx env) lident env acc
+
+let values_from_module ctx 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
+      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
   in
-  let init = fold_values None [] in
-  trie
-  |> List.fold_left ~init ~f:walk
+  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
+  modules
+  |> List.fold_left
+    ~init
+    ~f:(fun acc name ->
+        let lident = Longident.Lident name in
+        values_from_module ctx 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

src/analysis/type_search.mli

@@ -30,12 +30,6 @@
 
 (** Search by type in the current environment. *)
 
-(** A Lazy trie of the potentials values. *)
-type t
-
-(** Initialize the trie with a given list of directories. *)
-val make_trie : Env.t -> string list -> t
-
 (** Compute the list of candidates from a query inside a given environment. *)
 val run :
   ?limit:int ->
@@ -45,7 +39,7 @@ val run :
   Lexing.position ->
   Env.t ->
   Merlin_sherlodoc.Query_parser.t
-  -> t
+  -> string list
   -> (int * string * Types.value_description * string option * string) list
 
 val doc_to_option : [> `Builtin of string | `Found of string ] -> string option

src/frontend/query_commands.ml

@@ -477,9 +477,8 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a =
     let result = match Type_search.classify_query query with
       | `By_type query ->
         let query = Merlin_sherlodoc.Query_parser.from_string query in
-        let trie = Type_search.make_trie env modules in
         Type_search.run
-          ~limit config local_defs comments pos env query trie
+          ~limit config local_defs comments pos env query modules
       | `Polarity query ->
         let query = Polarity_search.prepare_query env query in
         let dirs = Polarity_search.directories ~global_modules:modules env in

tests/test-dirs/search-by-type-comparison-to-polarity-search.t

@@ -16,14 +16,14 @@ potential failures, so lifting the result in an int option).
     "name": "int_of_string_opt",
     "type": "string -> int option"
   }
-  {
-    "name": "Int32.of_string_opt",
-    "type": "string -> int32 option"
-  }
   {
     "name": "Int64.of_string_opt",
     "type": "string -> int64 option"
   }
+  {
+    "name": "Int32.of_string_opt",
+    "type": "string -> int32 option"
+  }
   {
     "name": "Sys.getenv_opt",
     "type": "string -> string option"

tests/test-dirs/search-by-type.t/run.t

@@ -14,14 +14,14 @@
     "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": "Int32.of_string_opt",
-    "type": "string -> int32 option",
+    "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": "Int64.of_string_opt",
-    "type": "string -> int64 option",
+    "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"
   }