Add some scrapping of dune files

Merlin files no longer get generated (ocaml/dune#3554);

It's quite nice actually, but I think it's also valuable to keep a simple and
lightweight way of extracting basic info about the project structure, such as
what library a module belongs to, or what modules are open at compilation time.

This usually follows from directory structures, but that's not a requirement.
So, following the "simplest approximation" policy this project adheres to, this
patch adds trivial parsing of `dune` files, just to infer what library a module
belongs to. This in turn enables the search engine to know about the
corresponding open module, and helps get proper cross-module references.

libs/dunextract.ml

@@ -0,0 +1,124 @@
+(**************************************************************************)
+(*                                                                        *)
+(*  Copyright 2021 OCamlPro                                               *)
+(*                                                                        *)
+(*  All rights reserved.  This file is distributed under the terms of     *)
+(*  the Lesser GNU Public License version 3.0.                            *)
+(*                                                                        *)
+(*  This software is distributed in the hope that it will be useful,      *)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
+(*  Lesser GNU General Public License for more details.                   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type sexp = A of string | T of sexp list
+
+let atom str i =
+  let rec escaped j =
+    if j >= String.length str then j
+    else match str.[j] with
+      | '"' -> j+1
+      | '\\' -> escaped (j+2)
+      | _ -> escaped (j+1)
+  in
+  let rec unescaped j =
+    if j >= String.length str then j
+    else match str.[j] with
+    | ' ' | '\n' | '\t' | '\r' | '(' | ')' -> j
+    | '\\' -> unescaped (j+2)
+    | _ -> unescaped (j+1)
+  in
+  let j = match str.[i] with
+    | '"' -> escaped (i+1)
+    | _ -> unescaped (i+1)
+  in
+  j, String.sub str i (j - i)
+
+let rec sexp_parse str i =
+  if i >= String.length str then i, []
+  else
+    match str.[i] with
+    | ' ' | '\n' | '\t' | '\r' -> sexp_parse str (i+1)
+    | '(' ->
+        let i, t1 = sexp_parse str (i+1) in
+        let i, t = sexp_parse str i in
+        i, T t1 :: t
+    | ')' -> i+1, []
+    | ';' ->
+        let i =
+          try String.index_from str (i+1) '\n' + 1
+          with Not_found -> String.length str
+        in
+        sexp_parse str i
+    | _ ->
+        let i, a = atom str i in
+        let i, t = sexp_parse str i in
+        i, A a :: t
+
+let rec cut_list a acc = function
+  | x :: r -> if x = a then acc, r else cut_list a (x::acc) r
+  | [] -> acc, []
+
+let module_eq name = function
+  | A n -> IndexMisc.capitalize n = name
+  | _ -> false
+
+let rec get_lib_name modname = function
+  | T (A "library" :: t) :: r ->
+      if List.mem (T [A "wrapped"; A "false"]) t then get_lib_name modname r
+      else
+        let libname =
+          match
+            List.find_opt (function T (A "name" :: _) -> true | _ -> false) t
+          with
+          | Some (T [_; A name]) -> name
+          | _ -> ""
+        in
+        (match
+           List.find_opt (function T ( A "modules" :: _) -> true | _ -> false) t
+         with
+         | None -> Some libname
+         | Some (T (_ :: ms)) ->
+             let inc, exc = cut_list (A "\\") [] ms in
+             if not (List.exists (module_eq modname) exc) &&
+                List.exists (fun n -> module_eq modname n || n = A ":standard")
+                  inc
+             then Some libname
+             else
+               get_lib_name modname r
+         | Some _ -> assert false)
+  | _ :: r -> get_lib_name modname r
+  | [] -> None
+
+let string_of_channel ic =
+  let n = 4096 in
+  let s = Bytes.create n in
+  let b = Buffer.create 1024 in
+  let rec iter ic b s =
+    let nread =
+      try input ic s 0 n
+      with End_of_file -> 0 in
+    if nread > 0 then (
+      Buffer.add_subbytes b s 0 nread;
+      iter ic b s
+    ) in
+  iter ic b s;
+  Buffer.contents b
+
+let read_dune dir =
+  try
+    let ic = open_in (Filename.concat dir "dune") in
+    let s = string_of_channel ic in
+    let r = sexp_parse s 0 in
+    close_in ic;
+    Some r
+  with Sys_error _ -> None
+
+let get_libname file =
+  let modname =
+    IndexMisc.capitalize (Filename.(basename (remove_extension file)))
+  in
+  match read_dune (Filename.dirname file) with
+  | Some (_, sexp) -> get_lib_name modname sexp
+  | None -> None

libs/dunextract.mli

@@ -0,0 +1,17 @@
+(**************************************************************************)
+(*                                                                        *)
+(*  Copyright 2021 OCamlPro                                               *)
+(*                                                                        *)
+(*  All rights reserved.  This file is distributed under the terms of     *)
+(*  the Lesser GNU Public License version 3.0.                            *)
+(*                                                                        *)
+(*  This software is distributed in the hope that it will be useful,      *)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
+(*  Lesser GNU General Public License for more details.                   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Looks up a 'dune' file in the dirname of the given file, and attempts to
+    extract the name of the (wrapped) library the module belongs to. *)
+val get_libname: string -> string option

libs/indexBuild.ml

@@ -1233,13 +1233,8 @@ let load_files t dirfiles =
     try
       let i = String.rindex file '.' in
       let len = String.length file in
-#if OCAML_VERSION >= (4,03,0)
-      let modul = String.capitalize_ascii (String.sub file 0 i) in
-      let ext = String.lowercase_ascii (String.sub file (i+1) (len-i-1)) in
-#else
-      let modul = String.capitalize (String.sub file 0 i) in
-      let ext = String.lowercase (String.sub file (i+1) (len-i-1)) in
-#endif
+      let modul = capitalize (String.sub file 0 i) in
+      let ext = lowercase (String.sub file (i+1) (len-i-1)) in
       modul, ext
     with Not_found -> file, ""
   in

libs/indexMisc.ml

@@ -185,3 +185,17 @@ let project_root ?(path=Sys.getcwd()) () =
   match find path with
   | None -> None, None
   | Some (root, build) -> Some root, Some build
+
+let capitalize =
+#if OCAML_VERSION >= (4,03,0)
+    String.capitalize_ascii
+#else
+    String.capitalize
+#endif
+
+let lowercase =
+#if OCAML_VERSION >= (4,03,0)
+    String.lowercase_ascii
+#else
+    String.lowercase
+#endif

libs/indexMisc.mli

@@ -55,3 +55,9 @@ val find_build_dir: string -> string option
 
 (** Shorten [file] by making it relative to current [path] (default cwd) *)
 val make_relative: ?path:string -> string -> string
+
+(** [String.capitalize_ascii], but compatibile across OCaml versions *)
+val capitalize: string -> string
+
+(** [String.lowercase_ascii], but compatibile across OCaml versions *)
+val lowercase: string -> string

src/indexOptions.ml

@@ -268,18 +268,23 @@ let common_opts ?(default_filter = default_filter) () : t Term.t =
           let chan = match file with Some f -> open_in f | None -> stdin in
           let scope = IndexScope.read ?line ?column chan in
           let () = match file with Some _ -> close_in chan | None -> () in
-          let merlin_open =
+          let context_opens =
             match file with
-            | Some f -> IndexScope.from_dot_merlin (Filename.dirname f)
             | None -> []
+            | Some f ->
+                match IndexScope.from_dot_merlin (Filename.dirname f) with
+                | _::_ as opens -> opens
+                | [] -> match Dunextract.get_libname f with
+                  | Some libname -> [Open [String.capitalize_ascii libname]]
+                  | None -> []
           in
           let info =
             List.fold_left (fun info -> function
                 | IndexScope.Open path ->
                     LibIndex.open_module ~cleanup_path:true info path
                 | IndexScope.Alias (name,path) ->
                     LibIndex.alias ~cleanup_path:true info path [name])
-              info (merlin_open @ IndexScope.to_list scope)
+              info (context_opens @ IndexScope.to_list scope)
           in
           info
     in