Refactor: all types in SharedTypes.

Author: cristianoc

analysis/.depend

@@ -13,28 +13,26 @@ src/Hover.cmx : src/Utils.cmx src/SharedTypes.cmx src/Shared.cmx \
 src/Infix.cmx : src/Log.cmx src/Files.cmx
 src/Log.cmx :
 src/ModuleResolution.cmx : src/Infix.cmx src/Files.cmx
-src/NewCompletions.cmx : src/Utils.cmx src/Uri2.cmx src/TopTypes.cmx \
-    src/SharedTypes.cmx src/Shared.cmx src/Protocol.cmx src/ProcessCmt.cmx \
-    src/PartialParser.cmx src/Log.cmx src/Infix.cmx src/Hover.cmx
-src/Packages.cmx : src/Uri2.cmx src/TopTypes.cmx src/SharedTypes.cmx \
-    src/Log.cmx src/vendor/Json.cmx src/Infix.cmx src/FindFiles.cmx \
-    src/Files.cmx src/BuildSystem.cmx
+src/NewCompletions.cmx : src/Utils.cmx src/Uri2.cmx src/SharedTypes.cmx \
+    src/Shared.cmx src/Protocol.cmx src/ProcessCmt.cmx src/PartialParser.cmx \
+    src/Log.cmx src/Infix.cmx src/Hover.cmx
+src/Packages.cmx : src/Uri2.cmx src/SharedTypes.cmx src/Log.cmx \
+    src/vendor/Json.cmx src/Infix.cmx src/FindFiles.cmx src/Files.cmx \
+    src/BuildSystem.cmx
 src/PartialParser.cmx : src/SharedTypes.cmx
 src/PrepareUtils.cmx :
 src/PrintType.cmx : src/vendor/res_outcome_printer/res_outcome_printer.cmx \
     src/vendor/res_outcome_printer/res_doc.cmx
 src/ProcessAttributes.cmx : src/SharedTypes.cmx src/PrepareUtils.cmx
-src/ProcessCmt.cmx : src/Utils.cmx src/Uri2.cmx src/TopTypes.cmx \
-    src/SharedTypes.cmx src/Shared.cmx src/ProcessAttributes.cmx \
-    src/Packages.cmx src/Log.cmx src/Infix.cmx src/FindFiles.cmx \
-    src/Files.cmx src/BuildSystem.cmx
+src/ProcessCmt.cmx : src/Utils.cmx src/Uri2.cmx src/SharedTypes.cmx \
+    src/Shared.cmx src/ProcessAttributes.cmx src/Packages.cmx src/Log.cmx \
+    src/Infix.cmx src/FindFiles.cmx src/Files.cmx src/BuildSystem.cmx
 src/Protocol.cmx : src/vendor/Json.cmx
-src/References.cmx : src/Utils.cmx src/Uri2.cmx src/TopTypes.cmx \
-    src/SharedTypes.cmx src/ProcessCmt.cmx src/Log.cmx src/Infix.cmx
+src/References.cmx : src/Utils.cmx src/Uri2.cmx src/SharedTypes.cmx \
+    src/ProcessCmt.cmx src/Log.cmx src/Infix.cmx
 src/Shared.cmx : src/PrintType.cmx src/Files.cmx
 src/SharedTypes.cmx : src/Utils.cmx src/Uri2.cmx src/Shared.cmx \
     src/Infix.cmx
-src/TopTypes.cmx : src/Uri2.cmx src/SharedTypes.cmx
 src/Uri2.cmx : src/Files.cmx
 src/Utils.cmx : src/Protocol.cmx
 src/vendor/Json.cmx :

analysis/src/NewCompletions.ml

@@ -278,7 +278,7 @@ let attributeCompletions ~(env : ProcessCmt.queryEnv) ~suffix =
 (* TODO filter out things that are defined after the current position *)
 let resolveRawOpens ~env ~rawOpens ~package =
   (* TODO Stdlib instead of Pervasives *)
-  let packageOpens = "Pervasives" :: package.TopTypes.opens in
+  let packageOpens = "Pervasives" :: package.opens in
   Log.log ("Package opens " ^ String.concat " " packageOpens);
   let opens =
     resolveOpens ~env
@@ -296,7 +296,7 @@ let getItems ~full ~package ~rawOpens ~allModules ~pos ~parts =
     ^ " "
     ^ String.concat " ... " (rawOpens |> List.map pathToString));
   let env = ProcessCmt.fileEnv full.file in
-  let packageOpens = "Pervasives" :: package.TopTypes.opens in
+  let packageOpens = "Pervasives" :: package.opens in
   Log.log ("Package opens " ^ String.concat " " packageOpens);
   let resolvedOpens = resolveRawOpens ~env ~rawOpens ~package in
   Log.log
@@ -523,7 +523,7 @@ let processCompletable ~findItems ~package ~rawOpens
     in
     let removePackageOpens modulePath =
       match modulePath with
-      | toplevel :: rest when package.TopTypes.opens |> List.mem toplevel ->
+      | toplevel :: rest when package.opens |> List.mem toplevel ->
         rest
       | _ -> modulePath
     in
@@ -649,7 +649,7 @@ let computeCompletions ~full ~maybeText ~package ~pos =
       | Some completable ->
         let rawOpens = PartialParser.findOpens text offset in
         let allModules =
-          package.TopTypes.localModules @ package.dependencyModules
+          package.localModules @ package.dependencyModules
         in
         let findItems ~exact parts =
           let items =

analysis/src/Packages.ml

@@ -1,5 +1,4 @@
 open Infix
-open TopTypes
 
 (* Creates the `pathsForModule` hashtbl, which maps a `moduleName` to it's `paths` (the ml/re, mli/rei, cmt, and cmti files) *)
 let makePathsForModule (localModules : (string * SharedTypes.paths) list)
@@ -29,7 +28,8 @@ let newBsPackage rootPath =
       match compiledBase with
       | None ->
         Error
-          "Please run the build first so that the editor can analyze the project's artifacts."
+          "Please run the build first so that the editor can analyze the \
+           project's artifacts."
       | Some compiledBase ->
         Ok
           (let namespace = FindFiles.getNamespace config in
@@ -92,7 +92,7 @@ let newBsPackage rootPath =
              Hashtbl.create (List.length localModules)
            in
            {
-             rootPath;
+             SharedTypes.rootPath;
              localModules = localModules |> List.map fst;
              dependencyModules = dependencyModules |> List.map fst;
              pathsForModule;
@@ -112,6 +112,7 @@ let findRoot ~uri packagesByRoot =
   loop (Filename.dirname path)
 
 let getPackage ~uri =
+  let open SharedTypes in
   if Hashtbl.mem state.rootForUri uri then
     Ok (Hashtbl.find state.packagesByRoot (Hashtbl.find state.rootForUri uri))
   else

analysis/src/ProcessCmt.ml

@@ -1132,13 +1132,13 @@ let extraForCmt ~file ({cmt_annots} : Cmt_format.cmt_infos) =
   | Partial_interface _ | Interface _ -> forItems ~file [] [||]
   | _ -> forItems ~file [] [||]
 
-let fullForCmt ~moduleName ~uri cmt =
+let fullForCmt ~moduleName ~package ~uri cmt =
   match Shared.tryReadCmt cmt with
   | Error e -> Error e
   | Ok infos ->
     let file = forCmt ~moduleName ~uri infos in
     let extra = extraForCmt ~file infos in
-    Ok {SharedTypes.file; extra}
+    Ok {file; extra; package}
 
 open SharedTypes
 
@@ -1166,7 +1166,7 @@ let getFullFromCmt ~uri =
     match Hashtbl.find_opt package.pathsForModule moduleName with
     | Some paths -> (
       let cmt = SharedTypes.getCmt ~interface:(Utils.endsWith path "i") paths in
-      match fullForCmt ~moduleName ~uri cmt with
+      match fullForCmt ~moduleName ~package ~uri cmt with
       | Error message ->
         prerr_endline message;
         None
@@ -1184,15 +1184,15 @@ let fileForUri uri =
   | Some (_package, full) -> Some full
 
 let extraForModule ~package modname =
-  if Hashtbl.mem package.TopTypes.pathsForModule modname then
+  if Hashtbl.mem package.pathsForModule modname then
     let paths = Hashtbl.find package.pathsForModule modname in
     match SharedTypes.getSrc paths with
     | None -> None
     | Some src -> getFullFromCmt ~uri:(Uri2.fromPath src)
   else None
 
 let docsForCmt ~moduleName cmt src state =
-  if Hashtbl.mem state.TopTypes.cmtCache cmt then
+  if Hashtbl.mem state.cmtCache cmt then
     let mtime, docs = Hashtbl.find state.cmtCache cmt in
     (* TODO: I should really throttle this mtime checking to like every 50 ms or so *)
     match Files.getMtime cmt with
@@ -1213,15 +1213,15 @@ let docsForCmt ~moduleName cmt src state =
     | Some changed -> newDocsForCmt ~moduleName state.cmtCache changed cmt src
 
 let docsForModule modname ~package =
-  if Hashtbl.mem package.TopTypes.pathsForModule modname then (
+  if Hashtbl.mem package.pathsForModule modname then (
     let paths = Hashtbl.find package.pathsForModule modname in
     (* TODO: do better *)
     let cmt = SharedTypes.getCmt paths in
     let src = SharedTypes.getSrc paths in
     Log.log ("FINDING docs for module " ^ SharedTypes.showPaths paths);
     let open Infix in
     Log.log ("FINDING " ^ cmt ^ " src " ^ (src |? ""));
-    match docsForCmt ~moduleName:modname cmt src TopTypes.state with
+    match docsForCmt ~moduleName:modname cmt src state with
     | None -> None
     | Some docs -> Some (docs, src))
   else (

analysis/src/References.ml

@@ -159,7 +159,7 @@ let declaredForExportedTip ~(stamps : stamps) ~(exported : exported) name tip =
     Hashtbl.find_opt stamps.modules stamp |?>> fun x -> {x with item = ()}
 
 let alternateDeclared ~file ~package declared tip =
-  match Hashtbl.find_opt package.TopTypes.pathsForModule file.moduleName with
+  match Hashtbl.find_opt package.pathsForModule file.moduleName with
   | None -> None
   | Some paths -> (
     maybeLog ("paths for " ^ file.moduleName);

analysis/src/SharedTypes.ml

@@ -204,7 +204,21 @@ type extra = {
 }
 (** These are the bits of info that we need to make in-app stuff awesome *)
 
-type full = {extra : extra; file : file}
+type moduleName = string
+
+(* Here are the things that will be different between jbuilder things *)
+type package = {
+  rootPath : filePath;
+  (* Depend on bsb having already run *)
+  localModules : moduleName list;
+  interModuleDependencies : (moduleName, moduleName list) Hashtbl.t;
+  dependencyModules : moduleName list;
+  pathsForModule : (moduleName, paths) Hashtbl.t;
+  namespace : string option;
+  opens : string list;
+}
+
+type full = {extra : extra; file : file; package : package}
 
 let initExtra () =
   {
@@ -214,6 +228,20 @@ let initExtra () =
     opens = Hashtbl.create 10;
   }
 
+type state = {
+  packagesByRoot : (string, package) Hashtbl.t;
+  rootForUri : (Uri2.t, string) Hashtbl.t;
+  cmtCache : (filePath, float * file) Hashtbl.t;
+}
+
+(* There's only one state, so it can as well be global *)
+let state =
+  {
+    packagesByRoot = Hashtbl.create 1;
+    rootForUri = Hashtbl.create 30;
+    cmtCache = Hashtbl.create 30;
+  }
+
 let hashList h = Hashtbl.fold (fun a b c -> (a, b) :: c) h []
 
 let locKindToString = function