Skip to content

Commit da9ba2f

Browse files
cristianoccristianoc
committed
reanalyze: remove global TypeLabels table (pure)
Stop using a global TypeLabels hashtable during AST processing. Instead, compute type-label dependencies in a post-merge pass from merged Declarations and add the corresponding type-reference edges before solving. Fix: use raw decl positions (not declGetLoc/posAdjustment) when building cross-file label indices, since reference graph keys are raw positions. Note: debug output in deadcode expected logs is reordered due to moving label linking from per-file traversal to the post-merge pass. Signed-Off-By: Cristiano Calcagno <cristiano.calcagno@gmail.com>
1 parent 0586a95 commit da9ba2f

File tree

5 files changed

+212
-120
lines changed

5 files changed

+212
-120
lines changed

‎analysis/reanalyze/src/DceFileProcessing.ml‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -19,8 +19,8 @@ let module_name_tagged (file : file_context) =
1919

2020
(* ===== Signature processing ===== *)
2121

22-
let processSignature ~config ~decls ~refs ~(file : file_context) ~doValues
23-
~doTypes (signature : Types.signature) =
22+
let processSignature ~config ~decls ~(file : file_context) ~doValues ~doTypes
23+
(signature : Types.signature) =
2424
let dead_common_file : FileContext.t =
2525
{
2626
source_path = file.source_path;
@@ -31,7 +31,7 @@ let processSignature ~config ~decls ~refs ~(file : file_context) ~doValues
3131
signature
3232
|> List.iter (fun sig_item ->
3333
DeadValue.processSignatureItem ~config ~decls ~file:dead_common_file
34-
~refs ~doValues ~doTypes ~moduleLoc:Location.none
34+
~doValues ~doTypes ~moduleLoc:Location.none
3535
~modulePath:ModulePath.initial
3636
~path:[module_name_tagged file]
3737
sig_item)
@@ -67,15 +67,15 @@ let process_cmt_file ~config ~(file : file_context) ~cmtFilePath
6767
(match cmt_infos.cmt_annots with
6868
| Interface signature ->
6969
CollectAnnotations.signature ~state:annotations ~config signature;
70-
processSignature ~config ~decls ~refs ~file ~doValues:true ~doTypes:true
70+
processSignature ~config ~decls ~file ~doValues:true ~doTypes:true
7171
signature.sig_type
7272
| Implementation structure ->
7373
let cmtiExists =
7474
Sys.file_exists ((cmtFilePath |> Filename.remove_extension) ^ ".cmti")
7575
in
7676
CollectAnnotations.structure ~state:annotations ~config
7777
~doGenType:(not cmtiExists) structure;
78-
processSignature ~config ~decls ~refs ~file ~doValues:true ~doTypes:false
78+
processSignature ~config ~decls ~file ~doValues:true ~doTypes:false
7979
structure.str_type;
8080
let doExternals = false in
8181
DeadValue.processStructure ~config ~decls ~refs ~file_deps ~cross_file

‎analysis/reanalyze/src/DeadType.ml‎

Lines changed: 101 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -2,14 +2,6 @@
22

33
open DeadCommon
44

5-
module TypeLabels = struct
6-
(* map from type path (for record/variant label) to its location *)
7-
8-
let table = (Hashtbl.create 256 : (DcePath.t, Location.t) Hashtbl.t)
9-
let add path loc = Hashtbl.replace table path loc
10-
let find path = Hashtbl.find_opt table path
11-
end
12-
135
let addTypeReference ~config ~refs ~posFrom ~posTo =
146
if config.DceConfig.cli.debug then
157
Log_.item "addTypeReference %s --> %s@." (posFrom |> Pos.toString)
@@ -26,49 +18,7 @@ let extendTypeDependencies ~config ~refs (loc1 : Location.t) (loc2 : Location.t)
2618
(posFrom |> Pos.toString);
2719
addTypeReference ~config ~refs ~posFrom ~posTo)
2820

29-
(* Type dependencies between Foo.re and Foo.rei *)
30-
let addTypeDependenciesAcrossFiles ~config ~refs ~file ~pathToType ~loc
31-
~typeLabelName =
32-
let isInterface = file.FileContext.is_interface in
33-
if not isInterface then (
34-
let path_1 = pathToType |> DcePath.moduleToInterface in
35-
let path_2 = path_1 |> DcePath.typeToInterface in
36-
let path1 = typeLabelName :: path_1 in
37-
let path2 = typeLabelName :: path_2 in
38-
match TypeLabels.find path1 with
39-
| None -> (
40-
match TypeLabels.find path2 with
41-
| None -> ()
42-
| Some loc2 ->
43-
extendTypeDependencies ~config ~refs loc loc2;
44-
if not Config.reportTypesDeadOnlyInInterface then
45-
extendTypeDependencies ~config ~refs loc2 loc)
46-
| Some loc1 ->
47-
extendTypeDependencies ~config ~refs loc loc1;
48-
if not Config.reportTypesDeadOnlyInInterface then
49-
extendTypeDependencies ~config ~refs loc1 loc)
50-
else
51-
let path_1 = pathToType |> DcePath.moduleToImplementation in
52-
let path1 = typeLabelName :: path_1 in
53-
match TypeLabels.find path1 with
54-
| None -> ()
55-
| Some loc1 ->
56-
extendTypeDependencies ~config ~refs loc1 loc;
57-
if not Config.reportTypesDeadOnlyInInterface then
58-
extendTypeDependencies ~config ~refs loc loc1
59-
60-
(* Add type dependencies between implementation and interface in inner module *)
61-
let addTypeDependenciesInnerModule ~config ~refs ~pathToType ~loc ~typeLabelName
62-
=
63-
let path = typeLabelName :: pathToType in
64-
match TypeLabels.find path with
65-
| Some loc2 ->
66-
extendTypeDependencies ~config ~refs loc loc2;
67-
if not Config.reportTypesDeadOnlyInInterface then
68-
extendTypeDependencies ~config ~refs loc2 loc
69-
| None -> TypeLabels.add path loc
70-
71-
let addDeclaration ~config ~decls ~refs ~file ~(modulePath : ModulePath.t)
21+
let addDeclaration ~config ~decls ~file ~(modulePath : ModulePath.t)
7222
~(typeId : Ident.t) ~(typeKind : Types.type_kind) =
7323
let pathToType =
7424
(typeId |> Ident.name |> Name.create)
@@ -77,11 +27,7 @@ let addDeclaration ~config ~decls ~refs ~file ~(modulePath : ModulePath.t)
7727
let processTypeLabel ?(posAdjustment = Decl.Nothing) typeLabelName ~declKind
7828
~(loc : Location.t) =
7929
addDeclaration_ ~config ~decls ~file ~declKind ~path:pathToType ~loc
80-
~moduleLoc:modulePath.loc ~posAdjustment typeLabelName;
81-
addTypeDependenciesAcrossFiles ~config ~refs ~file ~pathToType ~loc
82-
~typeLabelName;
83-
addTypeDependenciesInnerModule ~config ~refs ~pathToType ~loc ~typeLabelName;
84-
TypeLabels.add (typeLabelName :: pathToType) loc
30+
~moduleLoc:modulePath.loc ~posAdjustment typeLabelName
8531
in
8632
match typeKind with
8733
| Type_record (l, _) ->
@@ -118,3 +64,102 @@ let addDeclaration ~config ~decls ~refs ~file ~(modulePath : ModulePath.t)
11864
|> processTypeLabel ~declKind:VariantCase ~loc:cd_loc ~posAdjustment)
11965
decls
12066
| _ -> ()
67+
68+
module PathMap = Map.Make (struct
69+
type t = DcePath.t
70+
71+
let compare = Stdlib.compare
72+
end)
73+
74+
let process_type_label_dependencies ~config ~decls ~refs =
75+
(* Use raw declaration positions, not [declGetLoc], because references are keyed
76+
by raw positions (decl.pos). [declGetLoc] applies [posAdjustment] (e.g. +2
77+
for OtherVariant), which is intended for reporting locations, not for
78+
reference graph keys. *)
79+
let decl_raw_loc (decl : Decl.t) : Location.t =
80+
{Location.loc_start = decl.pos; loc_end = decl.posEnd; loc_ghost = false}
81+
in
82+
(* Build an index from full label path -> list of locations *)
83+
let index =
84+
Declarations.fold
85+
(fun _pos decl acc ->
86+
match decl.Decl.declKind with
87+
| RecordLabel | VariantCase ->
88+
let loc = decl |> decl_raw_loc in
89+
let path = decl.path in
90+
let existing =
91+
PathMap.find_opt path acc |> Option.value ~default:[]
92+
in
93+
PathMap.add path (loc :: existing) acc
94+
| _ -> acc)
95+
decls PathMap.empty
96+
in
97+
(* Inner-module duplicates: if the same full path appears multiple times (e.g. from signature+structure),
98+
connect them together. *)
99+
index
100+
|> PathMap.iter (fun _key locs ->
101+
match locs with
102+
| [] | [_] -> ()
103+
| loc0 :: rest ->
104+
rest
105+
|> List.iter (fun loc ->
106+
extendTypeDependencies ~config ~refs loc loc0;
107+
if not Config.reportTypesDeadOnlyInInterface then
108+
extendTypeDependencies ~config ~refs loc0 loc));
109+
110+
(* Cross-file impl<->intf linking, modeled after the previous lookup logic. *)
111+
let hd_opt = function
112+
| [] -> None
113+
| x :: _ -> Some x
114+
in
115+
let find_one path =
116+
match PathMap.find_opt path index with
117+
| None -> None
118+
| Some locs -> hd_opt locs
119+
in
120+
121+
let is_interface_of_pathToType (pathToType : DcePath.t) =
122+
match List.rev pathToType with
123+
| moduleNameTag :: _ -> (
124+
try (moduleNameTag |> Name.toString).[0] <> '+'
125+
with Invalid_argument _ -> true)
126+
| [] -> true
127+
in
128+
129+
Declarations.iter
130+
(fun _pos decl ->
131+
match decl.Decl.declKind with
132+
| RecordLabel | VariantCase -> (
133+
match decl.path with
134+
| [] -> ()
135+
| typeLabelName :: pathToType -> (
136+
let loc = decl |> decl_raw_loc in
137+
let isInterface = is_interface_of_pathToType pathToType in
138+
if not isInterface then
139+
let path_1 = pathToType |> DcePath.moduleToInterface in
140+
let path_2 = path_1 |> DcePath.typeToInterface in
141+
let path1 = typeLabelName :: path_1 in
142+
let path2 = typeLabelName :: path_2 in
143+
match find_one path1 with
144+
| Some loc1 ->
145+
extendTypeDependencies ~config ~refs loc loc1;
146+
if not Config.reportTypesDeadOnlyInInterface then
147+
extendTypeDependencies ~config ~refs loc1 loc
148+
| None -> (
149+
match find_one path2 with
150+
| Some loc2 ->
151+
extendTypeDependencies ~config ~refs loc loc2;
152+
if not Config.reportTypesDeadOnlyInInterface then
153+
extendTypeDependencies ~config ~refs loc2 loc
154+
| None -> ())
155+
else
156+
let path_1 = pathToType |> DcePath.moduleToImplementation in
157+
let path1 = typeLabelName :: path_1 in
158+
match find_one path1 with
159+
| None -> ()
160+
| Some loc1 ->
161+
extendTypeDependencies ~config ~refs loc1 loc;
162+
if not Config.reportTypesDeadOnlyInInterface then
163+
extendTypeDependencies ~config ~refs loc loc1))
164+
| _ -> ())
165+
decls

‎analysis/reanalyze/src/DeadValue.ml‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -242,12 +242,12 @@ let rec getSignature (moduleType : Types.module_type) =
242242
| Mty_functor (_, _mtParam, mt) -> getSignature mt
243243
| _ -> []
244244

245-
let rec processSignatureItem ~config ~decls ~refs ~file ~doTypes ~doValues
246-
~moduleLoc ~(modulePath : ModulePath.t) ~path (si : Types.signature_item) =
245+
let rec processSignatureItem ~config ~decls ~file ~doTypes ~doValues ~moduleLoc
246+
~(modulePath : ModulePath.t) ~path (si : Types.signature_item) =
247247
match si with
248248
| Sig_type (id, t, _) when doTypes ->
249249
if !Config.analyzeTypes then
250-
DeadType.addDeclaration ~config ~decls ~refs ~file ~modulePath ~typeId:id
250+
DeadType.addDeclaration ~config ~decls ~file ~modulePath ~typeId:id
251251
~typeKind:t.type_kind
252252
| Sig_value (id, {Types.val_loc = loc; val_kind = kind; val_type})
253253
when doValues ->
@@ -283,7 +283,7 @@ let rec processSignatureItem ~config ~decls ~refs ~file ~doTypes ~doValues
283283
if collect then
284284
getSignature moduleType
285285
|> List.iter
286-
(processSignatureItem ~config ~decls ~refs ~file ~doTypes ~doValues
286+
(processSignatureItem ~config ~decls ~file ~doTypes ~doValues
287287
~moduleLoc ~modulePath:modulePath'
288288
~path:((id |> Ident.name |> Name.create) :: path))
289289
| _ -> ()
@@ -323,7 +323,7 @@ let traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes
323323
| Mty_signature signature ->
324324
signature
325325
|> List.iter
326-
(processSignatureItem ~config ~decls ~refs ~file ~doTypes
326+
(processSignatureItem ~config ~decls ~file ~doTypes
327327
~doValues:false ~moduleLoc:mb_expr.mod_loc
328328
~modulePath:modulePath'
329329
~path:
@@ -361,7 +361,7 @@ let traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes
361361
typeDeclarations
362362
|> List.iter
363363
(fun (typeDeclaration : Typedtree.type_declaration) ->
364-
DeadType.addDeclaration ~config ~decls ~refs ~file
364+
DeadType.addDeclaration ~config ~decls ~file
365365
~modulePath ~typeId:typeDeclaration.typ_id
366366
~typeKind:typeDeclaration.typ_type.type_kind);
367367
None
@@ -373,7 +373,7 @@ let traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes
373373
in
374374
incl_type
375375
|> List.iter
376-
(processSignatureItem ~config ~decls ~refs ~file ~doTypes
376+
(processSignatureItem ~config ~decls ~file ~doTypes
377377
~doValues:false (* TODO: also values? *)
378378
~moduleLoc:incl_mod.mod_loc ~modulePath
379379
~path:currentPath)

‎analysis/reanalyze/src/Reanalyze.ml‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -164,6 +164,9 @@ let runAnalysis ~dce_config ~cmtRoot =
164164
~into:refs_builder;
165165
FileDeps.merge_into_builder ~from:fd.DceFileProcessing.file_deps
166166
~into:file_deps_builder);
167+
(* Compute type-label dependencies after merge (no global TypeLabels table during traversal) *)
168+
DeadType.process_type_label_dependencies ~config:dce_config ~decls
169+
~refs:refs_builder;
167170
(* Process cross-file exception refs - they write to refs_builder and file_deps_builder *)
168171
CrossFileItems.process_exception_refs cross_file ~refs:refs_builder
169172
~file_deps:file_deps_builder ~find_exception:DeadException.find_exception

0 commit comments

Comments
 (0)