Split ProcessCmt to ProcessExtra and ResolvePath.

Author: cristianoc

analysis/src/Cmt.ml

@@ -1,5 +1,13 @@
 open SharedTypes
 
+let fullForCmt ~moduleName ~package ~uri cmt =
+  match Shared.tryReadCmt cmt with
+  | None -> None
+  | Some infos ->
+    let file = ProcessCmt.fileForCmtInfos ~moduleName ~uri infos in
+    let extra = ProcessExtra.getExtra ~file ~infos in
+    Some {file; extra; package}
+
 let fullFromUri ~uri =
   let path = Uri2.toPath uri in
   match Packages.getPackage ~uri with
@@ -11,7 +19,7 @@ let fullFromUri ~uri =
     match Hashtbl.find_opt package.pathsForModule moduleName with
     | Some paths ->
       let cmt = getCmtPath ~uri paths in
-      ProcessCmt.fullForCmt ~moduleName ~package ~uri cmt
+      fullForCmt ~moduleName ~package ~uri cmt
     | None ->
       prerr_endline ("can't find module " ^ moduleName);
       None)
@@ -26,69 +34,3 @@ let fullFromModule ~package ~moduleName =
 let fullFromPath ~path =
   let uri = Uri2.fromPath path in
   fullFromUri ~uri
-
-let resolveModuleFromCompilerPath ~env ~package path =
-  match ProcessCmt.fromCompilerPath ~env path with
-  | `Global (moduleName, path) -> (
-    match ProcessCmt.fileForModule ~package moduleName with
-    | None -> None
-    | Some file -> (
-      let env = QueryEnv.fromFile file in
-      match ProcessCmt.resolvePath ~env ~package ~path with
-      | None -> None
-      | Some (env, name) -> (
-        match Exported.find env.exported Exported.Module name with
-        | None -> None
-        | Some stamp -> (
-          match Stamps.findModule env.file.stamps stamp with
-          | None -> None
-          | Some declared -> Some (env, Some declared)))))
-  | `Stamp stamp -> (
-    match Stamps.findModule env.file.stamps stamp with
-    | None -> None
-    | Some declared -> Some (env, Some declared))
-  | `GlobalMod moduleName -> (
-    match ProcessCmt.fileForModule ~package moduleName with
-    | None -> None
-    | Some file ->
-      let env = QueryEnv.fromFile file in
-      Some (env, None))
-  | `Not_found -> None
-  | `Exported (env, name) -> (
-    match Exported.find env.exported Exported.Module name with
-    | None -> None
-    | Some stamp -> (
-      match Stamps.findModule env.file.stamps stamp with
-      | None -> None
-      | Some declared -> Some (env, Some declared)))
-
-let resolveFromCompilerPath ~env ~package path =
-  match ProcessCmt.fromCompilerPath ~env path with
-  | `Global (moduleName, path) -> (
-    let res =
-      match ProcessCmt.fileForModule ~package moduleName with
-      | None -> None
-      | Some file ->
-        let env = QueryEnv.fromFile file in
-        ProcessCmt.resolvePath ~env ~package ~path
-    in
-    match res with
-    | None -> `Not_found
-    | Some (env, name) -> `Exported (env, name))
-  | `Stamp stamp -> `Stamp stamp
-  | `GlobalMod _ -> `Not_found
-  | `Not_found -> `Not_found
-  | `Exported (env, name) -> `Exported (env, name)
-
-let rec getSourceUri ~(env : QueryEnv.t) ~package path =
-  match path with
-  | File (uri, _moduleName) -> uri
-  | NotVisible -> env.file.uri
-  | IncludedModule (path, inner) -> (
-    Log.log "INCLUDED MODULE";
-    match resolveModuleFromCompilerPath ~env ~package path with
-    | None ->
-      Log.log "NOT FOUND";
-      getSourceUri ~env ~package inner
-    | Some (env, _declared) -> env.file.uri)
-  | ExportedModule (_, inner) -> getSourceUri ~env ~package inner

analysis/src/CompletionBackEnd.ml

@@ -516,20 +516,20 @@ let resolveOpens ~env ~previous opens ~package =
               previous (* TODO: warn? *)
             | Some file -> (
               match
-                ProcessCmt.resolvePath ~env:(QueryEnv.fromFile file) ~package
+                ResolvePath.resolvePath ~env:(QueryEnv.fromFile file) ~package
                   ~path
               with
               | None ->
                 Log.log ("Could not resolve in " ^ name);
                 previous
               | Some (env, _placeholder) -> previous @ [env])))
         | env :: rest -> (
-          match ProcessCmt.resolvePath ~env ~package ~path with
+          match ResolvePath.resolvePath ~env ~package ~path with
           | None -> loop rest
           | Some (env, _placeholder) -> previous @ [env])
       in
       Log.log ("resolving open " ^ pathToString path);
-      match ProcessCmt.resolvePath ~env ~package ~path with
+      match ResolvePath.resolvePath ~env ~package ~path with
       | None ->
         Log.log "Not local";
         loop previous
@@ -652,7 +652,7 @@ let resolvePathFromStamps ~(env : QueryEnv.t) ~package ~scope ~moduleName ~path
   | None -> None
   | Some declared -> (
     (* Log.log("found it"); *)
-    match ProcessCmt.findInModule ~env declared.item path with
+    match ResolvePath.findInModule ~env declared.item path with
     | None -> None
     | Some res -> (
       match res with
@@ -661,15 +661,15 @@ let resolvePathFromStamps ~(env : QueryEnv.t) ~package ~scope ~moduleName ~path
         match ProcessCmt.fileForModule ~package moduleName with
         | None -> None
         | Some file ->
-          ProcessCmt.resolvePath ~env:(QueryEnv.fromFile file) ~path:fullPath
+          ResolvePath.resolvePath ~env:(QueryEnv.fromFile file) ~path:fullPath
             ~package)))
 
 let resolveModuleWithOpens ~opens ~package ~moduleName =
   let rec loop opens =
     match opens with
     | (env : QueryEnv.t) :: rest -> (
       Log.log ("Looking for env in " ^ Uri2.toString env.file.uri);
-      match ProcessCmt.resolvePath ~env ~package ~path:[moduleName; ""] with
+      match ResolvePath.resolvePath ~env ~package ~path:[moduleName; ""] with
       | Some (env, _) -> Some env
       | None -> loop rest)
     | [] -> None
@@ -692,11 +692,11 @@ let getEnvWithOpens ~scope ~(env : QueryEnv.t) ~package
   | Some x -> Some x
   | None -> (
     match resolveModuleWithOpens ~opens ~package ~moduleName with
-    | Some env -> ProcessCmt.resolvePath ~env ~package ~path
+    | Some env -> ResolvePath.resolvePath ~env ~package ~path
     | None -> (
       match resolveFileModule ~moduleName ~package with
       | None -> None
-      | Some env -> ProcessCmt.resolvePath ~env ~package ~path))
+      | Some env -> ResolvePath.resolvePath ~env ~package ~path))
 
 let detail name (kind : Completion.kind) =
   match kind with

analysis/src/Hover.ml

@@ -60,7 +60,7 @@ let newHover ~full:{file; package} locItem =
     | None -> None
     | Some file -> (
       let env = QueryEnv.fromFile file in
-      match ProcessCmt.resolvePath ~env ~path ~package with
+      match ResolvePath.resolvePath ~env ~path ~package with
       | None -> None
       | Some (env, name) -> (
         match References.exportedForTip ~env name tip with