Skip to content

Commit ba64e1a

Browse files
cristianoccristianoc
committed
DCE: Task 4 - Declarations use map → list → merge pattern
Applies the same architectural pattern from Task 3 (annotations) to declarations. ## New modules - Declarations.ml/.mli: builder (mutable) and t (immutable) types - CollectAnnotations.ml/.mli: AST traversal for @dead/@live/@genType annotations ## Key changes 1. **Declarations pattern**: - process_cmt_file creates local Declarations.builder - processCmtFiles collects file_data list (annotations + decls) - Declarations.merge_all combines into immutable t - Solver uses Declarations.t (read-only) 2. **Global state removed**: - Deleted global DeadCommon.decls - All declaration access now through explicit ~decls parameter 3. **AST processing separation**: - CollectAnnotations.ml: annotation traversal (~150 lines) - DceFileProcessing.ml: coordinator (~80 lines, was ~230) 4. **Threading ~decls:builder through AST processing**: - addDeclaration_, addValueDeclaration - DeadValue.processStructure, processSignatureItem, traverseStructure - DeadType.addDeclaration - DeadException.add - DeadOptionalArgs.addFunctionReference ## Data flow process_cmt_file (per-file) ├── CollectAnnotations → FileAnnotations.builder └── DeadValue/Type/Exception → Declarations.builder Merge phase: FileAnnotations.merge_all → FileAnnotations.t Declarations.merge_all → Declarations.t Solver: reportDead ~annotations ~decls (both immutable) ## Benefits - Order independence: files can be processed in any order - Parallelizable: map phase can run concurrently (future) - Incremental: replace one file's builders, re-merge (future) - Type-safe: t types have no mutation functions
1 parent 217c4fa commit ba64e1a

13 files changed

+383
-252
lines changed

‎analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md‎

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -325,12 +325,15 @@ val is_annotated_* : t -> ... -> bool
325325
**Pattern**: Same as Task 3 - `builder` (mutable) → `builder list` → `merge_all` → `t` (immutable)
326326

327327
**Changes**:
328-
- [ ] Create `Declarations` module with `builder` and `t` types
329-
- [ ] `process_cmt_file` returns `Declarations.builder` (local mutable)
330-
- [ ] `processCmtFiles` collects into `builder list`
331-
- [ ] `Declarations.merge_all : builder list -> t`
332-
- [ ] Solver uses immutable `Declarations.t`
333-
- [ ] Delete global `DeadCommon.decls`
328+
- [x] Create `Declarations` module with `builder` and `t` types
329+
- [x] `process_cmt_file` returns `DceFileProcessing.file_data` containing both `annotations` and `decls` builders
330+
- [x] `processCmtFiles` collects into `file_data list`
331+
- [x] `Declarations.merge_all : builder list -> t`
332+
- [x] Solver uses immutable `Declarations.t`
333+
- [x] Delete global `DeadCommon.decls`
334+
- [x] Update `DeadOptionalArgs.forceDelayedItems` to take `~decls:Declarations.t`
335+
336+
**Status**: Complete ✅
334337

335338
**Test**: Process files in different orders - results should be identical.
336339

‎analysis/reanalyze/src/CollectAnnotations.ml‎

Lines changed: 149 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,149 @@
1+
(** AST traversal to collect source annotations (@dead, @live, @genType).
2+
3+
This module traverses the typed AST to find attribute annotations
4+
and records them in a FileAnnotations.builder. *)
5+
6+
open DeadCommon
7+
8+
let processAttributes ~state ~config ~doGenType ~name ~pos attributes =
9+
let getPayloadFun f = attributes |> Annotation.getAttributePayload f in
10+
let getPayload (x : string) =
11+
attributes |> Annotation.getAttributePayload (( = ) x)
12+
in
13+
if
14+
doGenType
15+
&& getPayloadFun Annotation.tagIsOneOfTheGenTypeAnnotations <> None
16+
then FileAnnotations.annotate_gentype state pos;
17+
if getPayload WriteDeadAnnotations.deadAnnotation <> None then
18+
FileAnnotations.annotate_dead state pos;
19+
let nameIsInLiveNamesOrPaths () =
20+
config.DceConfig.cli.live_names |> List.mem name
21+
||
22+
let fname =
23+
match Filename.is_relative pos.pos_fname with
24+
| true -> pos.pos_fname
25+
| false -> Filename.concat (Sys.getcwd ()) pos.pos_fname
26+
in
27+
let fnameLen = String.length fname in
28+
config.DceConfig.cli.live_paths
29+
|> List.exists (fun prefix ->
30+
String.length prefix <= fnameLen
31+
&&
32+
try String.sub fname 0 (String.length prefix) = prefix
33+
with Invalid_argument _ -> false)
34+
in
35+
if getPayload liveAnnotation <> None || nameIsInLiveNamesOrPaths () then
36+
FileAnnotations.annotate_live state pos;
37+
if attributes |> Annotation.isOcamlSuppressDeadWarning then
38+
FileAnnotations.annotate_live state pos
39+
40+
let collectExportLocations ~state ~config ~doGenType =
41+
let super = Tast_mapper.default in
42+
let currentlyDisableWarnings = ref false in
43+
let value_binding self
44+
({vb_attributes; vb_pat} as value_binding : Typedtree.value_binding) =
45+
(match vb_pat.pat_desc with
46+
| Tpat_var (id, {loc = {loc_start = pos}})
47+
| Tpat_alias ({pat_desc = Tpat_any}, id, {loc = {loc_start = pos}}) ->
48+
if !currentlyDisableWarnings then FileAnnotations.annotate_live state pos;
49+
vb_attributes
50+
|> processAttributes ~state ~config ~doGenType ~name:(id |> Ident.name)
51+
~pos
52+
| _ -> ());
53+
super.value_binding self value_binding
54+
in
55+
let type_kind toplevelAttrs self (typeKind : Typedtree.type_kind) =
56+
(match typeKind with
57+
| Ttype_record labelDeclarations ->
58+
labelDeclarations
59+
|> List.iter
60+
(fun ({ld_attributes; ld_loc} : Typedtree.label_declaration) ->
61+
toplevelAttrs @ ld_attributes
62+
|> processAttributes ~state ~config ~doGenType:false ~name:""
63+
~pos:ld_loc.loc_start)
64+
| Ttype_variant constructorDeclarations ->
65+
constructorDeclarations
66+
|> List.iter
67+
(fun
68+
({cd_attributes; cd_loc; cd_args} :
69+
Typedtree.constructor_declaration)
70+
->
71+
let _process_inline_records =
72+
match cd_args with
73+
| Cstr_record flds ->
74+
List.iter
75+
(fun ({ld_attributes; ld_loc} : Typedtree.label_declaration)
76+
->
77+
toplevelAttrs @ cd_attributes @ ld_attributes
78+
|> processAttributes ~state ~config ~doGenType:false
79+
~name:"" ~pos:ld_loc.loc_start)
80+
flds
81+
| Cstr_tuple _ -> ()
82+
in
83+
toplevelAttrs @ cd_attributes
84+
|> processAttributes ~state ~config ~doGenType:false ~name:""
85+
~pos:cd_loc.loc_start)
86+
| _ -> ());
87+
super.type_kind self typeKind
88+
in
89+
let type_declaration self (typeDeclaration : Typedtree.type_declaration) =
90+
let attributes = typeDeclaration.typ_attributes in
91+
let _ = type_kind attributes self typeDeclaration.typ_kind in
92+
typeDeclaration
93+
in
94+
let value_description self
95+
({val_attributes; val_id; val_val = {val_loc = {loc_start = pos}}} as
96+
value_description :
97+
Typedtree.value_description) =
98+
if !currentlyDisableWarnings then FileAnnotations.annotate_live state pos;
99+
val_attributes
100+
|> processAttributes ~state ~config ~doGenType ~name:(val_id |> Ident.name)
101+
~pos;
102+
super.value_description self value_description
103+
in
104+
let structure_item self (item : Typedtree.structure_item) =
105+
(match item.str_desc with
106+
| Tstr_attribute attribute
107+
when [attribute] |> Annotation.isOcamlSuppressDeadWarning ->
108+
currentlyDisableWarnings := true
109+
| _ -> ());
110+
super.structure_item self item
111+
in
112+
let structure self (structure : Typedtree.structure) =
113+
let oldDisableWarnings = !currentlyDisableWarnings in
114+
super.structure self structure |> ignore;
115+
currentlyDisableWarnings := oldDisableWarnings;
116+
structure
117+
in
118+
let signature_item self (item : Typedtree.signature_item) =
119+
(match item.sig_desc with
120+
| Tsig_attribute attribute
121+
when [attribute] |> Annotation.isOcamlSuppressDeadWarning ->
122+
currentlyDisableWarnings := true
123+
| _ -> ());
124+
super.signature_item self item
125+
in
126+
let signature self (signature : Typedtree.signature) =
127+
let oldDisableWarnings = !currentlyDisableWarnings in
128+
super.signature self signature |> ignore;
129+
currentlyDisableWarnings := oldDisableWarnings;
130+
signature
131+
in
132+
{
133+
super with
134+
signature;
135+
signature_item;
136+
structure;
137+
structure_item;
138+
type_declaration;
139+
value_binding;
140+
value_description;
141+
}
142+
143+
let structure ~state ~config ~doGenType structure =
144+
let mapper = collectExportLocations ~state ~config ~doGenType in
145+
structure |> mapper.structure mapper |> ignore
146+
147+
let signature ~state ~config signature =
148+
let mapper = collectExportLocations ~state ~config ~doGenType:true in
149+
signature |> mapper.signature mapper |> ignore

‎analysis/reanalyze/src/CollectAnnotations.mli‎

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
(** AST traversal to collect source annotations (@dead, @live, @genType).
2+
3+
Traverses the typed AST and records annotations in a FileAnnotations.builder. *)
4+
5+
val structure :
6+
state:FileAnnotations.builder ->
7+
config:DceConfig.t ->
8+
doGenType:bool ->
9+
Typedtree.structure ->
10+
unit
11+
(** Traverse a structure and collect annotations. *)
12+
13+
val signature :
14+
state:FileAnnotations.builder ->
15+
config:DceConfig.t ->
16+
Typedtree.signature ->
17+
unit
18+
(** Traverse a signature and collect annotations. *)

0 commit comments

Comments
 (0)