OCaml: analysis commands, completions, hints, llm_index, syntax driver

Author: nojaf

analysis/bin/main.ml

@@ -132,6 +132,24 @@ let main () =
         Cache.deleteCache (Cache.targetFileFromLibBs libBs);
         print_endline "\"OK\"")
     | _ -> print_endline "\"ERR: Did not find root \"")
+  | _ :: "rewatch" :: rewatchArgs -> (
+    match rewatchArgs with
+    | ["completion"] -> CommandsRewatch.completion ()
+    | ["completionResolve"] -> CommandsRewatch.completionResolve ()
+    | ["hover"] -> CommandsRewatch.hover ()
+    | ["definition"] -> CommandsRewatch.definition ()
+    | ["typeDefinition"] -> CommandsRewatch.typeDefinition ()
+    | ["references"] -> CommandsRewatch.references ()
+    | ["documentSymbol"] -> CommandsRewatch.documentSymbol ()
+    | ["prepareRename"] -> CommandsRewatch.prepareRename ()
+    | ["rename"] -> CommandsRewatch.rename ()
+    | ["signatureHelp"] -> CommandsRewatch.signatureHelp ()
+    | ["codeLens"] -> CommandsRewatch.codeLens ()
+    | ["inlayHint"] -> CommandsRewatch.inlayHint ()
+    | ["semanticTokens"] -> CommandsRewatch.semanticTokens ()
+    | ["codeAction"] -> CommandsRewatch.codeAction ()
+    | ["llmIndex"] -> CommandsRewatch.llmIndex ()
+    | _ -> prerr_endline "Unknown rewatch subcommand")
   | [_; "completion"; path; line; col; currentFile] ->
     printHeaderInfo path line col;
     Commands.completion ~debug ~path
@@ -147,7 +165,13 @@ let main () =
     Commands.typeDefinition ~path
       ~pos:(int_of_string line, int_of_string col)
       ~debug
-  | [_; "documentSymbol"; path] -> DocumentSymbol.command ~path
+  | [_; "documentSymbol"; path] ->
+    let source =
+      match Files.readFile path with
+      | Some s -> s
+      | None -> ""
+    in
+    print_endline (DocumentSymbol.command ~path ~source)
   | [_; "hover"; path; line; col; currentFile; supportsMarkdownLinks] ->
     Commands.hover ~path
       ~pos:(int_of_string line, int_of_string col)

analysis/reanalyze/src/Paths.ml

@@ -215,10 +215,23 @@ type cmt_scan_entry = {
 
     If missing, returns the empty list and callers should fall back to legacy behavior. *)
 
+let newerFile a b =
+  match (Sys.file_exists a, Sys.file_exists b) with
+  | true, true ->
+    let mtime_a = (Unix.stat a).st_mtime in
+    let mtime_b = (Unix.stat b).st_mtime in
+    if mtime_b > mtime_a then b else a
+  | true, false -> a
+  | false, true -> b
+  | false, false -> a
+
 let readCmtScan () =
   let sourceDirsFile =
-    ["lib"; "bs"; ".sourcedirs.json"]
-    |> List.fold_left Filename.concat runConfig.bsbProjectRoot
+    newerFile
+      (["lib"; "bs"; ".sourcedirs.json"]
+      |> List.fold_left Filename.concat runConfig.bsbProjectRoot)
+      (["lib"; "lsp"; ".sourcedirs.json"]
+      |> List.fold_left Filename.concat runConfig.bsbProjectRoot)
   in
   let entries = ref [] in
   let read_entry (json : Ext_json_types.t) =

analysis/src/BuildSystem.ml

@@ -40,7 +40,17 @@ let getRuntimeDir rootPath =
         None))
   | true -> Some rootPath
 
-let getLibBs path = Files.ifExists (path /+ "lib" /+ "bs")
+let getLibBs path =
+  let bs = path /+ "lib" /+ "bs" in
+  let lsp = path /+ "lib" /+ "lsp" in
+  let sourcedirs dir = dir /+ ".sourcedirs.json" in
+  match (Sys.file_exists (sourcedirs bs), Sys.file_exists (sourcedirs lsp)) with
+  | true, true ->
+    let mtime f = (Unix.stat f).st_mtime in
+    if mtime (sourcedirs lsp) > mtime (sourcedirs bs) then Some lsp else Some bs
+  | true, false -> Some bs
+  | false, true -> Some lsp
+  | false, false -> Files.ifExists bs
 
 let getStdlib base =
   match getRuntimeDir base with

analysis/src/Cmt.ml

@@ -52,6 +52,20 @@ let loadFullCmtFromPath ~path =
   let uri = Uri.fromPath path in
   fullFromUri ~uri
 
+let loadFullCmtWithPackage ~path ~package =
+  let uri = Uri.fromPath path in
+  let pathStr = Uri.toPath uri in
+  let moduleName =
+    BuildSystem.namespacedName package.namespace (FindFiles.getName pathStr)
+  in
+  match Hashtbl.find_opt package.pathsForModule moduleName with
+  | Some paths ->
+    let cmt = getCmtPath ~uri paths in
+    fullForCmt ~moduleName ~package ~uri cmt
+  | None ->
+    prerr_endline ("can't find module " ^ moduleName);
+    None
+
 let loadCmtInfosFromPath ~path =
   let uri = Uri.fromPath path in
   match Packages.getPackage ~uri with

analysis/src/Commands.ml

@@ -102,13 +102,21 @@ let hover ~path ~pos ~currentFile ~debug ~supportsMarkdownLinks =
 
 let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
   let result =
-    match
-      SignatureHelp.signatureHelp ~path ~pos ~currentFile ~debug
-        ~allowForConstructorPayloads
-    with
-    | None ->
+    match Files.readFile currentFile with
+    | None | Some "" ->
       {Protocol.signatures = []; activeSignature = None; activeParameter = None}
-    | Some res -> res
+    | Some text -> (
+      match
+        SignatureHelp.signatureHelp ~path ~pos ~currentFile ~text ~debug
+          ~allowForConstructorPayloads ()
+      with
+      | None ->
+        {
+          Protocol.signatures = [];
+          activeSignature = None;
+          activeParameter = None;
+        }
+      | Some res -> res)
   in
   print_endline (Protocol.stringifySignatureHelp result)
 
@@ -402,7 +410,7 @@ let test ~path =
             DceCommand.command ()
           | "doc" ->
             print_endline ("DocumentSymbol " ^ path);
-            DocumentSymbol.command ~path
+            print_endline (DocumentSymbol.command ~path ~source:text)
           | "hig" ->
             print_endline ("Highlight " ^ path);
             SemanticTokens.command ~debug:true