Skip to content

Commit 54ed67b

Browse files
committed
clean up ResolvePath
1 parent 251e220 commit 54ed67b

File tree

4 files changed

+68
-76
lines changed

4 files changed

+68
-76
lines changed

analysis/src/Files.ml

-3
Original file line numberDiff line numberDiff line change
@@ -41,9 +41,6 @@ let relpath base path =
4141
let maybeStat path =
4242
try Some (Unix.stat path) with Unix.Unix_error (Unix.ENOENT, _, _) -> None
4343

44-
let getMtime path =
45-
match maybeStat path with Some {Unix.st_mtime} -> Some st_mtime | _ -> None
46-
4744
let readFile ~filename =
4845
try
4946
(* windows can't use open_in *)

analysis/src/ProcessExtra.ml

+15-28
Original file line numberDiff line numberDiff line change
@@ -60,19 +60,6 @@ let extraForFile ~(file : File.t) =
6060
| _ -> ());
6161
extra
6262

63-
let rec joinPaths modulePath path =
64-
match modulePath with
65-
| Path.Pident ident -> (ident.stamp, ident.name, path)
66-
| Papply (fnPath, _argPath) -> joinPaths fnPath path
67-
| Pdot (inner, name, _) -> joinPaths inner (name :: path)
68-
69-
let rec makePath modulePath =
70-
match modulePath with
71-
| Path.Pident ident when ident.stamp == 0 -> `GlobalMod ident.name
72-
| Pident ident -> `Stamp ident.stamp
73-
| Papply (fnPath, _argPath) -> makePath fnPath
74-
| Pdot (inner, name, _) -> `Path (joinPaths inner [name])
75-
7663
let addExternalReference ~extra moduleName path tip loc =
7764
(* TODO need to follow the path, and be able to load the files to follow module references... *)
7865
Hashtbl.replace extra.externalReferences moduleName
@@ -161,14 +148,14 @@ let addForPath ~env ~extra path lident loc typ tip =
161148
let identLoc = Utils.endOfLocation loc (String.length identName) in
162149
let locType =
163150
match ResolvePath.fromCompilerPath ~env path with
164-
| `Stamp stamp ->
151+
| Stamp stamp ->
165152
addReference ~extra stamp identLoc;
166153
LocalReference (stamp, tip)
167-
| `Not_found -> NotFound
168-
| `Global (moduleName, path) ->
154+
| NotFound -> NotFound
155+
| Global (moduleName, path) ->
169156
addExternalReference ~extra moduleName path tip identLoc;
170157
GlobalReference (moduleName, path, tip)
171-
| `Exported (env, name) -> (
158+
| Exported (env, name) -> (
172159
match
173160
match tip with
174161
| Type -> Exported.find env.exported Exported.Type name
@@ -178,24 +165,24 @@ let addForPath ~env ~extra path lident loc typ tip =
178165
addReference ~extra stamp identLoc;
179166
LocalReference (stamp, tip)
180167
| None -> NotFound)
181-
| `GlobalMod _ -> NotFound
168+
| GlobalMod _ -> NotFound
182169
in
183170
addLocItem extra loc (Typed (identName, typ, locType))
184171

185172
let addForPathParent ~env ~extra path loc =
186173
let locType =
187174
match ResolvePath.fromCompilerPath ~env path with
188-
| `GlobalMod moduleName ->
175+
| GlobalMod moduleName ->
189176
addFileReference ~extra moduleName loc;
190177
TopLevelModule moduleName
191-
| `Stamp stamp ->
178+
| Stamp stamp ->
192179
addReference ~extra stamp loc;
193180
LModule (LocalReference (stamp, Module))
194-
| `Not_found -> LModule NotFound
195-
| `Global (moduleName, path) ->
181+
| NotFound -> LModule NotFound
182+
| Global (moduleName, path) ->
196183
addExternalReference ~extra moduleName path Module loc;
197184
LModule (GlobalReference (moduleName, path, Module))
198-
| `Exported (env, name) -> (
185+
| Exported (env, name) -> (
199186
match Exported.find env.exported Exported.Module name with
200187
| Some stamp ->
201188
addReference ~extra stamp loc;
@@ -206,18 +193,18 @@ let addForPathParent ~env ~extra path loc =
206193

207194
let getTypeAtPath ~env path =
208195
match ResolvePath.fromCompilerPath ~env path with
209-
| `GlobalMod _ -> `Not_found
210-
| `Global (moduleName, path) -> `Global (moduleName, path)
211-
| `Not_found -> `Not_found
212-
| `Exported (env, name) -> (
196+
| GlobalMod _ -> `Not_found
197+
| Global (moduleName, path) -> `Global (moduleName, path)
198+
| NotFound -> `Not_found
199+
| Exported (env, name) -> (
213200
match Exported.find env.exported Exported.Type name with
214201
| None -> `Not_found
215202
| Some stamp -> (
216203
let declaredType = Stamps.findType env.file.stamps stamp in
217204
match declaredType with
218205
| Some declaredType -> `Local declaredType
219206
| None -> `Not_found))
220-
| `Stamp stamp -> (
207+
| Stamp stamp -> (
221208
let declaredType = Stamps.findType env.file.stamps stamp in
222209
match declaredType with
223210
| Some declaredType -> `Local declaredType

analysis/src/References.ml

+9-10
Original file line numberDiff line numberDiff line change
@@ -223,15 +223,15 @@ let rec resolveModuleReference ?(pathsSeen = []) ~file ~package
223223
| Ident path -> (
224224
let env = QueryEnv.fromFile file in
225225
match ResolvePath.fromCompilerPath ~env path with
226-
| `Not_found -> None
227-
| `Exported (env, name) -> (
226+
| NotFound -> None
227+
| Exported (env, name) -> (
228228
match Exported.find env.exported Exported.Module name with
229229
| None -> None
230230
| Some stamp -> (
231231
match Stamps.findModule env.file.stamps stamp with
232232
| None -> None
233233
| Some md -> Some (env.file, Some md)))
234-
| `Global (moduleName, path) -> (
234+
| Global (moduleName, path) -> (
235235
match ProcessCmt.fileForModule ~package moduleName with
236236
| None -> None
237237
| Some file -> (
@@ -245,18 +245,17 @@ let rec resolveModuleReference ?(pathsSeen = []) ~file ~package
245245
match Stamps.findModule env.file.stamps stamp with
246246
| None -> None
247247
| Some md -> Some (env.file, Some md)))))
248-
| `Stamp stamp -> (
248+
| Stamp stamp -> (
249249
match Stamps.findModule file.stamps stamp with
250250
| None -> None
251251
| Some ({item = Ident path} as md) when not (List.mem path pathsSeen) ->
252252
(* avoid possible infinite loops *)
253253
resolveModuleReference ~file ~package ~pathsSeen:(path :: pathsSeen) md
254254
| Some md -> Some (file, Some md))
255-
| `GlobalMod name -> (
255+
| GlobalMod name -> (
256256
match ProcessCmt.fileForModule ~package name with
257257
| None -> None
258-
| Some file -> Some (file, None))
259-
| _ -> None)
258+
| Some file -> Some (file, None)))
260259

261260
let validateLoc (loc : Location.t) (backup : Location.t) =
262261
if loc.loc_start.pos_cnum = -1 then
@@ -369,12 +368,12 @@ let definitionForLocItem ~full:{file; package} locItem =
369368

370369
let digConstructor ~env ~package path =
371370
match ResolvePath.resolveFromCompilerPath ~env ~package path with
372-
| `Not_found -> None
373-
| `Stamp stamp -> (
371+
| NotFound -> None
372+
| Stamp stamp -> (
374373
match Stamps.findType env.file.stamps stamp with
375374
| None -> None
376375
| Some t -> Some (env, t))
377-
| `Exported (env, name) -> (
376+
| Exported (env, name) -> (
378377
match Exported.find env.exported Exported.Type name with
379378
| None -> None
380379
| Some stamp -> (

analysis/src/ResolvePath.ml

+44-35
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,38 @@
11
open SharedTypes
22

3+
type resolution =
4+
| Exported of QueryEnv.t * filePath
5+
| Global of filePath * filePath list
6+
| GlobalMod of filePath
7+
| NotFound
8+
| Stamp of int
9+
310
let rec joinPaths modulePath path =
411
match modulePath with
512
| Path.Pident ident -> (ident.stamp, ident.name, path)
613
| Papply (fnPath, _argPath) -> joinPaths fnPath path
714
| Pdot (inner, name, _) -> joinPaths inner (name :: path)
815

9-
let rec makePath modulePath =
16+
let rec makePath ~(env : QueryEnv.t) modulePath =
1017
match modulePath with
11-
| Path.Pident ident when ident.stamp == 0 -> `GlobalMod ident.name
12-
| Pident ident -> `Stamp ident.stamp
13-
| Papply (fnPath, _argPath) -> makePath fnPath
14-
| Pdot (inner, name, _) -> `Path (joinPaths inner [name])
18+
| Path.Pident ident when ident.stamp == 0 -> GlobalMod ident.name
19+
| Pident ident -> Stamp ident.stamp
20+
| Papply (fnPath, _argPath) -> makePath ~env fnPath
21+
| Pdot (inner, name, _) -> (
22+
match joinPaths inner [name] with
23+
| 0, moduleName, path -> Global (moduleName, path)
24+
| stamp, _moduleName, path -> (
25+
let res =
26+
match Stamps.findModule env.file.stamps stamp with
27+
| None -> None
28+
| Some {item = kind} -> findInModule ~env kind path
29+
in
30+
match res with
31+
| None -> NotFound
32+
| Some (`Local (env, name)) -> Exported (env, name)
33+
| Some (`Global (moduleName, fullPath)) -> Global (moduleName, fullPath)))
1534

16-
let rec resolvePathInner ~(env : QueryEnv.t) ~path =
35+
and resolvePathInner ~(env : QueryEnv.t) ~path =
1736
match path with
1837
| [] -> None
1938
| [name] -> Some (`Local (env, name))
@@ -25,7 +44,7 @@ let rec resolvePathInner ~(env : QueryEnv.t) ~path =
2544
| None -> None
2645
| Some {item} -> findInModule ~env item subPath))
2746

28-
and findInModule ~env module_ path =
47+
and findInModule ~(env : QueryEnv.t) module_ path =
2948
match module_ with
3049
| Structure {exported} -> resolvePathInner ~env:{env with exported} ~path
3150
| Constraint (_, module1) -> findInModule ~env module1 path
@@ -53,25 +72,17 @@ let rec resolvePath ~env ~path ~package =
5372
| Some file ->
5473
resolvePath ~env:(QueryEnv.fromFile file) ~path:fullPath ~package))
5574

56-
let fromCompilerPath ~(env : QueryEnv.t) path =
57-
match makePath path with
58-
| `Stamp stamp -> `Stamp stamp
59-
| `Path (0, moduleName, path) -> `Global (moduleName, path)
60-
| `GlobalMod name -> `GlobalMod name
61-
| `Path (stamp, _moduleName, path) -> (
62-
let res =
63-
match Stamps.findModule env.file.stamps stamp with
64-
| None -> None
65-
| Some {item = kind} -> findInModule ~env kind path
66-
in
67-
match res with
68-
| None -> `Not_found
69-
| Some (`Local (env, name)) -> `Exported (env, name)
70-
| Some (`Global (moduleName, fullPath)) -> `Global (moduleName, fullPath))
75+
let fromCompilerPath ~(env : QueryEnv.t) path : resolution =
76+
match makePath ~env path with
77+
| Stamp stamp -> Stamp stamp
78+
| GlobalMod name -> GlobalMod name
79+
| NotFound -> NotFound
80+
| Exported (env, name) -> Exported (env, name)
81+
| Global (moduleName, fullPath) -> Global (moduleName, fullPath)
7182

7283
let resolveModuleFromCompilerPath ~env ~package path =
7384
match fromCompilerPath ~env path with
74-
| `Global (moduleName, path) -> (
85+
| Global (moduleName, path) -> (
7586
match ProcessCmt.fileForModule ~package moduleName with
7687
| None -> None
7788
| Some file -> (
@@ -85,18 +96,18 @@ let resolveModuleFromCompilerPath ~env ~package path =
8596
match Stamps.findModule env.file.stamps stamp with
8697
| None -> None
8798
| Some declared -> Some (env, Some declared)))))
88-
| `Stamp stamp -> (
99+
| Stamp stamp -> (
89100
match Stamps.findModule env.file.stamps stamp with
90101
| None -> None
91102
| Some declared -> Some (env, Some declared))
92-
| `GlobalMod moduleName -> (
103+
| GlobalMod moduleName -> (
93104
match ProcessCmt.fileForModule ~package moduleName with
94105
| None -> None
95106
| Some file ->
96107
let env = QueryEnv.fromFile file in
97108
Some (env, None))
98-
| `Not_found -> None
99-
| `Exported (env, name) -> (
109+
| NotFound -> None
110+
| Exported (env, name) -> (
100111
match Exported.find env.exported Exported.Module name with
101112
| None -> None
102113
| Some stamp -> (
@@ -106,21 +117,19 @@ let resolveModuleFromCompilerPath ~env ~package path =
106117

107118
let resolveFromCompilerPath ~env ~package path =
108119
match fromCompilerPath ~env path with
109-
| `Global (moduleName, path) -> (
120+
| Global (moduleName, path) -> (
110121
let res =
111122
match ProcessCmt.fileForModule ~package moduleName with
112123
| None -> None
113124
| Some file ->
114125
let env = QueryEnv.fromFile file in
115126
resolvePath ~env ~package ~path
116127
in
117-
match res with
118-
| None -> `Not_found
119-
| Some (env, name) -> `Exported (env, name))
120-
| `Stamp stamp -> `Stamp stamp
121-
| `GlobalMod _ -> `Not_found
122-
| `Not_found -> `Not_found
123-
| `Exported (env, name) -> `Exported (env, name)
128+
match res with None -> NotFound | Some (env, name) -> Exported (env, name))
129+
| Stamp stamp -> Stamp stamp
130+
| GlobalMod _ -> NotFound
131+
| NotFound -> NotFound
132+
| Exported (env, name) -> Exported (env, name)
124133

125134
let rec getSourceUri ~(env : QueryEnv.t) ~package path =
126135
match path with

0 commit comments

Comments
 (0)