From 176d7cc387fe536775f7b570da22c40431c72e03 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 29 Nov 2025 07:06:10 +0100 Subject: [PATCH 1/8] docs(reanalyze): add DCE refactor plan --- analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md | 401 +++++++++++++++++++ 1 file changed, 401 insertions(+) create mode 100644 analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md diff --git a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md new file mode 100644 index 0000000000..4b4004516d --- /dev/null +++ b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md @@ -0,0 +1,401 @@ +## Dead Code Analysis – Pure Pipeline Refactor Plan + +This document tracks the plan to turn the **reanalyze dead code analysis** into a transparent, effect‑free pipeline expressed as pure function composition. It is deliberately fine‑grained so each task can be done and checked off independently, while always keeping the system runnable and behaviour‑preserving. + +Scope: only the **dead code / DCE** parts under `analysis/reanalyze/src`: +- `Reanalyze.ml` (DCE wiring) +- `DeadCode.ml` +- `DeadCommon.ml` +- `DeadValue.ml` +- `DeadType.ml` +- `DeadOptionalArgs.ml` +- `DeadException.ml` +- `DeadModules.ml` +- `SideEffects.ml` +- `WriteDeadAnnotations.ml` (only the pieces tied to DCE) +- Supporting shared state in `Common.ml`, `ModulePath.ml`, `Paths.ml`, `RunConfig.ml`, `Log_.ml` + +Exception and termination analyses (`Exception.ml`, `Arnold.ml`, etc.) are out of scope except where they share state that must be disentangled. + +--- + +## 1. Target Architecture: Pure Pipeline (End State) + +This section describes the desired **end state**, not something to implement in one big change. + +### 1.1 Top‑level inputs and outputs + +**Inputs** +- CLI / configuration: + - `RunConfig.t` (DCE flags, project root, transitive, suppression lists, etc.). + - CLI flags from `Common.Cli` (`debug`, `ci`, `json`, `write`, `liveNames`, `livePaths`, `excludePaths`). +- Project context: + - Root directory / `cmtRoot` or inferred `projectRoot`. + - Discovered `cmt` / `cmti` files and their associated source files. +- Per‑file compiler artifacts: + - `Cmt_format.cmt_infos` for each `*.cmt` / `*.cmti`. + +**Outputs** +- Pure analysis results: + - List of `Common.issue` values (dead values, dead types, dead exceptions, dead modules, dead/always‑supplied optional args, incorrect `@dead` annotations, circular dependency warnings). + - Derived `@dead` line annotations per file (to be written back to source when enabled). +- Side‑effectful consumers (kept at the edges): + - Terminal logging / JSON output (`Log_`, `EmitJson`). + - File rewriting for `@dead` annotations (`WriteDeadAnnotations`). + +### 1.2 File‑level pure API (end state) + +Conceptual end‑state per‑file API: + +```ocaml +type cli_config = { + debug : bool; + ci : bool; + write_annotations : bool; + live_names : string list; + live_paths : string list; + exclude_paths : string list; +} + +type dce_config = { + run : RunConfig.t; + cli : cli_config; +} + +type file_input = { + cmt_path : string; + source_path : string; + cmt_infos : Cmt_format.cmt_infos; +} + +type file_dce_result = { + issues : Common.issue list; + dead_annotations : WriteDeadAnnotations.line_annotation list; +} + +val analyze_file_dce : dce_config -> file_input -> file_dce_result +``` + +The implementation of `analyze_file_dce` should be expressible as composition of small, pure steps (collect annotations, collect decls and refs, resolve dependencies, solve deadness, derive issues/annotations). + +### 1.3 Project‑level pure API (end state) + +End‑state project‑level API: + +```ocaml +type project_input = { + config : dce_config; + files : file_input list; +} + +type project_dce_result = { + per_file : (string * file_dce_result) list; (* keyed by source path *) + cross_file_issues : Common.issue list; (* e.g. circular deps, dead modules *) +} + +val analyze_project_dce : project_input -> project_dce_result +``` + +The actual implementation will be obtained incrementally by refactoring existing code; we do **not** introduce these types until they are immediately used in a small, behaviour‑preserving change. + +--- + +## 2. Current Mutation and Order Dependencies (High‑Level) + +This section summarises the main sources of mutation / order dependence that the tasks in §4 will address. + +### 2.1 Global “current file” context + +- `Common.currentSrc : string ref` +- `Common.currentModule : string ref` +- `Common.currentModuleName : Name.t ref` +- Set in `Reanalyze.loadCmtFile` before calling `DeadCode.processCmt`. +- Read by: + - `DeadCommon.addDeclaration_` (filters declarations by `!currentSrc`). + - `DeadType.addTypeDependenciesAcrossFiles` (decides interface vs implementation using `!currentSrc`). + - `DeadValue` (builds paths using `!currentModuleName`). + +### 2.2 Global declaration / reference tables and binding state + +In `DeadCommon`: +- `decls : decl PosHash.t` – all declarations. +- `ValueReferences.table` – value references. +- `TypeReferences.table` – type references. +- `Current.bindings`, `Current.lastBinding`, `Current.maxValuePosEnd` – per‑file binding/reporting state. +- `ProcessDeadAnnotations.positionsAnnotated` – global annotation map. +- `FileReferences.table` / `iterFilesFromRootsToLeaves` – cross‑file graph and ordering using `Hashtbl`s. +- `reportDead` – mutates global state, constructs orderings, and logs warnings directly. + +### 2.3 Per‑analysis mutable queues/sets + +- `DeadOptionalArgs.delayedItems` / `functionReferences`. +- `DeadException.delayedItems` / `declarations`. +- `DeadType.TypeDependencies.delayedItems`. +- `DeadModules.table`. + +All of these are refs or Hashtbls, updated during traversal and flushed later, with ordering mattering. + +### 2.4 CLI/config globals and logging / annotation I/O + +- `Common.Cli` refs, `RunConfig.runConfig` mutation. +- `Log_.warning`, `Log_.item`, `EmitJson` calls inside analysis modules. +- `WriteDeadAnnotations` holding refs to current file and lines, writing directly during analysis. + +--- + +## 3. End‑State Summary + +At the end of the refactor: + +- All DCE computations are pure: + - No `ref` / mutable `Hashtbl` in the core analysis path. + - No writes to global state from `Dead*` modules. + - No direct logging or file I/O from the dead‑code logic. +- Impure actions live only at the edges: + - CLI parsing (`Reanalyze.cli`). + - Discovering `cmt` / `cmti` files. + - Logging / JSON (`Log_`, `EmitJson`). + - Applying annotations to files (`WriteDeadAnnotations`). +- Results are order‑independent: + - Processing files in different orders yields the same `project_dce_result`. + +--- + +## 4. Refactor Tasks – From Mutable to Pure + +This section lists **small, incremental changes**. Each checkbox is intended as a single PR/patch that: +- Starts from a clean, runnable state and returns to a clean, runnable state. +- Does **not** change user‑visible behaviour of DCE. +- Only introduces data structures that are immediately used to remove a specific mutation or implicit dependency. + +Think “replace one wheel at a time while the car is moving”: every step should feel like a polished state, not a half‑converted architecture. + +### 4.1 Make DCE configuration explicit (minimal surface) + +Goal: introduce an explicit configuration value for DCE **without** changing how internals read it yet. + +- [ ] Add a small `dce_config` record type (e.g. in `RunConfig.ml` or a new `DceConfig.ml`) that just wraps existing data, for example: + `type dce_config = { run : RunConfig.t; cli_debug : bool; cli_json : bool; cli_write : bool }` +- [ ] Add a helper `DceConfig.current () : dce_config` that reads from `RunConfig.runConfig` and `Common.Cli` and returns a value. +- [ ] Change `Reanalyze.runAnalysis` to take a `dce_config` parameter, but initially always pass `DceConfig.current ()` and keep all existing global reads unchanged. + +Result: a single, well‑typed configuration value is threaded at the top level, but internals still use the old globals. No behaviour change. + +### 4.2 Encapsulate global “current file” state (one module at a time) + +Goal: step‑wise removal of `Common.currentSrc`, `currentModule`, `currentModuleName` as implicit inputs. + +- [ ] Define a lightweight `file_ctx` record (e.g. in a new `DeadFileContext` module): + `type t = { source_path : string; module_name : Name.t; module_path : Name.t list; is_interface : bool }` +- [ ] In `Reanalyze.loadCmtFile`, build a `file_ctx` value *in addition to* updating `Common.current*` so behaviour stays identical. +- [ ] Update `DeadCommon.addDeclaration_` to take a `file_ctx` parameter and use it **only to replace** the check that currently uses `!currentSrc` / `!currentModule`. Call sites pass the new `file_ctx` while still relying on globals elsewhere. +- [ ] In a follow‑up patch, change `DeadType.addTypeDependenciesAcrossFiles` to take `is_interface` from `file_ctx` instead of reading `!Common.currentSrc`. Again, call sites pass `file_ctx`. +- [ ] Update `DeadValue` call sites that construct paths (using `!Common.currentModuleName`) to accept `file_ctx` and use its `module_name` instead. +- [ ] Once all reads of `Common.currentSrc`, `currentModule`, `currentModuleName` in DCE code are replaced by fields from `file_ctx`, remove or deprecate these globals from the DCE path (they may still exist for other analyses). + +Each bullet above should be done as a separate patch touching only a small set of functions. + +### 4.3 Localise `Current.*` binding state + +Goal: remove `DeadCommon.Current.bindings`, `lastBinding`, and `maxValuePosEnd` as mutable globals by turning them into local state threaded through functions. + +- [ ] In `DeadCommon`, define: + ```ocaml + type current_state = { + bindings : PosSet.t; + last_binding : Location.t; + max_value_pos_end : Lexing.position; + } + + let empty_current_state = { + bindings = PosSet.empty; + last_binding = Location.none; + max_value_pos_end = Lexing.dummy_pos; + } + ``` +- [ ] Change `addValueReference` to take a `current_state` and return an updated `current_state` instead of reading/writing `Current.*`. For the first patch, implement it by calling the existing global‑based logic and then mirroring the resulting values into a `current_state`, so behaviour is identical. +- [ ] Update the places that call `addValueReference` (mainly in `DeadValue`) to thread a `current_state` value through, starting from `empty_current_state`, and ignore `Current.*`. +- [ ] In a follow‑up patch, re‑implement `addValueReference` and any other helpers that touch `Current.*` purely in terms of `current_state` and delete the `Current.*` refs from DCE code. + +At the end of this step, binding‑related state is explicit and confined to the call chains that need it. + +### 4.4 Make `ProcessDeadAnnotations` state explicit + +Goal: turn `ProcessDeadAnnotations.positionsAnnotated` into an explicit value rather than a hidden global. + +- [ ] Introduce: + ```ocaml + module ProcessDeadAnnotations : sig + type state + val empty : state + (* new, pure API; existing API kept temporarily *) + end + ``` +- [ ] Add pure variants of the mutating functions: + - `annotateGenType' : state -> Lexing.position -> state` + - `annotateDead' : state -> Lexing.position -> state` + - `annotateLive' : state -> Lexing.position -> state` + - `isAnnotated*' : state -> Lexing.position -> bool` + leaving the old global‑based functions in place for now. +- [ ] Change `ProcessDeadAnnotations.structure` and `.signature` to: + - Take an explicit `state`, + - Call the `'` functions, + - Return the updated `state` along with the original AST. +- [ ] Update `DeadCode.processCmt` to allocate a fresh `ProcessDeadAnnotations.state` per file, thread it through the structure/signature walkers, and store it alongside other per‑file information. +- [ ] Once all users have switched to the state‑passing API, delete or deprecate direct uses of `positionsAnnotated` and the old global helpers. + +### 4.5 De‑globalize `DeadOptionalArgs` (minimal slice) + +Goal: remove the `delayedItems` and `functionReferences` refs, one small step at a time. + +- [ ] Introduce in `DeadOptionalArgs`: + ```ocaml + type state = { + delayed_items : item list; + function_refs : (Lexing.position * Lexing.position) list; + } + + let empty_state = { delayed_items = []; function_refs = [] } + ``` +- [ ] Add pure variants: + - `addReferences' : state -> ... -> state` + - `addFunctionReference' : state -> ... -> state` + - `forceDelayedItems' : state -> decls -> state * decls` + and make the existing functions delegate to these, passing a hidden global `state` for now. +- [ ] Update `DeadValue` to allocate a `DeadOptionalArgs.state` per file and call the `'` variants, **without** changing behaviour (the old global still exists for other callers until fully migrated). +- [ ] Update `Reanalyze.runAnalysis` (or the relevant driver) to call `forceDelayedItems'` with an explicit state instead of `DeadOptionalArgs.forceDelayedItems`. +- [ ] When all call sites use the new API, remove `delayedItems` and `functionReferences` refs and the global wrapper. + +### 4.6 De‑globalize `DeadException` (minimal slice) + +Goal: make delayed exception uses explicit. + +- [ ] Introduce: + ```ocaml + type state = { + delayed_items : item list; + declarations : (Path.t, Location.t) Hashtbl.t; + } + + val empty_state : unit -> state + ``` +- [ ] Add state‑passing versions of `add`, `markAsUsed`, and `forceDelayedItems` that operate on a `state` value, with old variants delegating to them using a hidden global state. +- [ ] Update `DeadValue` and any other DCE callers to allocate a `DeadException.state` per file and use the state‑passing API. +- [ ] Replace the global `DeadException.forceDelayedItems` call in `Reanalyze.runAnalysis` with a call on the explicit state. +- [ ] Remove the old globals once all uses go through the new API. + +### 4.7 Localise `decls`, `ValueReferences`, and `TypeReferences` + +Goal: move the main declaration and reference tables out of global scope, **one structure at a time**. + +- [ ] For `decls`: + - Introduce `type decl_state = decl PosHash.t`. + - Change `addDeclaration_` to take and return a `decl_state`, with an adapter that still passes the existing global `decls` to keep behaviour unchanged. + - Thread `decl_state` through `DeadValue`, `DeadType`, and `DeadCode.processCmt`, returning the updated `decl_state` per file. +- [ ] For value references: + - Introduce `type value_refs_state = PosSet.t PosHash.t`. + - Parameterise `ValueReferences.add` / `find` over `value_refs_state`, with wrappers that still use the global table. + - Thread `value_refs_state` through the same paths that currently use `ValueReferences.table`. +- [ ] For type references: + - Introduce `type type_refs_state = PosSet.t PosHash.t`. + - Parameterise `TypeReferences.add` / `find` over `type_refs_state` in the same way. +- [ ] Once all three structures are threaded explicitly per file, delete the global `decls`, `ValueReferences.table`, and `TypeReferences.table` in DCE code and construct fresh instances in `DeadCode.processCmt`. + +Each of these bullets should be implemented as a separate patch (decls first, then value refs, then type refs). + +### 4.8 Pure `TypeDependencies` in `DeadType` + +Goal: make `DeadType.TypeDependencies` operate on explicit state rather than a ref. + +- [ ] Introduce `type type_deps_state = (Location.t * Location.t) list` (or a small record) to represent delayed type dependency pairs. +- [ ] Change `TypeDependencies.add`, `clear`, and `forceDelayedItems` to take and return a `type_deps_state` instead of writing to a ref, keeping wrappers that still use the old global for the first patch. +- [ ] Update `DeadType.addDeclaration` and any other callers to thread a `type_deps_state` along with other per‑file state. +- [ ] Remove the global `delayedItems` ref once all calls have been migrated to the new API. + +### 4.9 De‑globalize `DeadModules` + +Goal: turn module deadness tracking into project‑level data passed explicitly. + +- [ ] Introduce `type module_dead_state = (Name.t, (bool * Location.t)) Hashtbl.t` in `DeadModules` and keep the existing `table` as `module_dead_state` for the first patch. +- [ ] Change `markDead` and `markLive` to take a `module_dead_state` and operate on it, with wrappers that pass the global `table`. +- [ ] Update the calls in deadness resolution (in `DeadCommon.resolveRecursiveRefs`) to use a `module_dead_state` passed in from the caller. +- [ ] Replace `DeadModules.checkModuleDead` so that it: + - Takes `module_dead_state` and file name, + - Returns a list of `Common.issue` values, leaving logging to the caller. +- [ ] Once all uses go through explicit state, remove the global `table` and construct a `module_dead_state` in a project‑level driver. + +### 4.10 Pure `FileReferences` and `iterFilesFromRootsToLeaves` + +Goal: make file ordering and cross‑file references explicit and order‑independent. + +- [ ] Extract `FileReferences.table` into a new type `file_refs_state` (e.g. `string -> FileSet.t`) and parameterise `add`, `addFile`, and `iter` over this state, with wrappers retaining the old global behaviour initially. +- [ ] Rewrite `iterFilesFromRootsToLeaves` to: + - Take a `file_refs_state`, + - Return an ordered list of file names (plus any diagnostics for circular dependencies), + - Avoid any hidden mutation beyond local variables. +- [ ] Update `DeadCommon.reportDead` to: + - Call the new pure `iterFilesFromRootsToLeaves`, + - Use the returned ordering instead of relying on a global `orderedFiles` table. +- [ ] Remove the global `FileReferences.table` once the project‑level driver constructs and passes in a `file_refs_state`. + +### 4.11 Separate deadness solving from reporting + +Goal: compute which declarations are dead/live purely, then render/report in a separate step. + +- [ ] Extract the recursive deadness logic (`resolveRecursiveRefs`, `declIsDead`, plus the bookkeeping that populates `deadDeclarations`) into a function that: + - Takes a fully built project‑level state (decls, refs, annotations, module_dead_state), + - Returns the same state augmented with dead/live flags and a list of “dead declaration” descriptors. +- [ ] Replace `Decl.report`’s direct calls to `Log_.warning` with construction of `Common.issue` values, collected into a list. +- [ ] Change `DeadCommon.reportDead` to: + - Return the list of `issue`s instead of logging them, + - Leave logging and JSON emission to the caller (`Reanalyze`). + +This should only be done after the relevant state has been made explicit by earlier tasks. + +### 4.12 Make CLI / configuration explicit internally + +Goal: stop reading `Common.Cli.*` and `RunConfig.runConfig` directly inside DCE code. + +- [ ] Replace direct reads in `DeadCommon`, `DeadValue`, `DeadType`, `DeadOptionalArgs`, `DeadModules` with fields from the `dce_config` value introduced in 4.1, passed down from `Reanalyze`. +- [ ] Ensure each function that previously reached into globals now takes the specific configuration flags it needs (or a narrowed config record), minimising the surface area. +- [ ] Once all reads have been converted, keep `DceConfig.current ()` as the only place that touches the global `RunConfig` and `Common.Cli` for DCE. + +### 4.13 Isolate logging / JSON and annotation writing + +Goal: keep the core analysis free of side‑effects and move all I/O into thin wrappers. + +- [ ] Identify all calls to `Log_.warning`, `Log_.item`, and `EmitJson` in DCE modules and replace them with construction of `Common.issue` values (or similar purely data‑oriented records). +- [ ] Add a `DceReporter` (or reuse `Reanalyze`) that: + - Takes `issue list`, + - Emits logs / JSON using `Log_` and `EmitJson`. +- [ ] In `WriteDeadAnnotations`, introduce a pure function that, given per‑file deadness information, computes the textual updates to apply. Keep file I/O in a separate `apply_updates` wrapper. +- [ ] Update `Reanalyze.runAnalysis` to: + - Call the pure analysis pipeline, + - Then call `DceReporter` and `WriteDeadAnnotations.apply_updates` as needed. + +### 4.14 Verify order independence + +Goal: ensure the new pure pipeline is not order‑dependent. + +- [ ] Add tests (or property checks) that: + - Compare `project_dce_result` when files are processed in different orders, + - Verify deadness decisions for declarations do not change with traversal order. +- [ ] If order dependence is discovered, treat it as a bug and introduce explicit data flow to remove it (document any necessary constraints in this plan). + +--- + +## 5. Suggested Execution Order + +Recommended rough order of tasks (each remains independent and small): + +1. 4.1 – Introduce and thread `dce_config` at the top level. +2. 4.2 – Start passing explicit `file_ctx` and remove `current*` reads. +3. 4.3 / 4.4 – Localise binding state and annotation state. +4. 4.5 / 4.6 / 4.7 / 4.8 – De‑globalize optional args, exceptions, decls/refs, and type dependencies in small slices. +5. 4.9 / 4.10 – Make file/module state explicit and pure. +6. 4.11 – Separate deadness solving from reporting, returning issues instead of logging. +7. 4.12 / 4.13 – Remove remaining global config/logging/annotation side‑effects. +8. 4.14 – Add and maintain order‑independence tests. + +Each checkbox above should be updated to `[x]` as the corresponding change lands, keeping the codebase runnable and behaviour‑preserving after every step. + From 687ce52a03961b32798dbdc80a0310c88e931956 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 30 Nov 2025 05:46:20 +0100 Subject: [PATCH 2/8] refactor(reanalyze): thread binding state and remove globals --- AGENTS.md | 1 + analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md | 27 ++------ analysis/reanalyze/src/DeadCommon.ml | 68 ++++++++++++-------- analysis/reanalyze/src/DeadException.ml | 12 +++- analysis/reanalyze/src/DeadValue.ml | 38 ++++++----- 5 files changed, 77 insertions(+), 69 deletions(-) diff --git a/AGENTS.md b/AGENTS.md index 9afb254749..dcf296590f 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -42,6 +42,7 @@ The Makefile’s targets build on each other in this order: - **Test early and often** - Add tests immediately after modifying each compiler layer to catch problems early, rather than waiting until all changes are complete - **Use underscore patterns carefully** - Don't use `_` patterns as lazy placeholders for new language features that then get forgotten. Only use them when you're certain the value should be ignored for that specific case. Ensure all new language features are handled correctly and completely across all compiler layers +- **Avoid `let _ = …` for side effects** - If you need to call a function only for its side effects, use `ignore expr` (or bind the result and thread state explicitly). Do not write `let _ = expr in ()`, and do not discard stateful results—plumb them through instead. - **Be careful with similar constructor names across different IRs** - Note that `Lam` (Lambda IR) and `Lambda` (typed lambda) have variants with similar constructor names like `Ltrywith`, but they represent different things in different compilation phases. diff --git a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md index 4b4004516d..ec86510545 100644 --- a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md +++ b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md @@ -195,29 +195,13 @@ Goal: step‑wise removal of `Common.currentSrc`, `currentModule`, `currentModul Each bullet above should be done as a separate patch touching only a small set of functions. -### 4.3 Localise `Current.*` binding state +### 4.3 Localise `Current.*` binding/reporting state -Goal: remove `DeadCommon.Current.bindings`, `lastBinding`, and `maxValuePosEnd` as mutable globals by turning them into local state threaded through functions. +Goal: remove `DeadCommon.Current` globals for binding/reporting by threading explicit state. -- [ ] In `DeadCommon`, define: - ```ocaml - type current_state = { - bindings : PosSet.t; - last_binding : Location.t; - max_value_pos_end : Lexing.position; - } - - let empty_current_state = { - bindings = PosSet.empty; - last_binding = Location.none; - max_value_pos_end = Lexing.dummy_pos; - } - ``` -- [ ] Change `addValueReference` to take a `current_state` and return an updated `current_state` instead of reading/writing `Current.*`. For the first patch, implement it by calling the existing global‑based logic and then mirroring the resulting values into a `current_state`, so behaviour is identical. -- [ ] Update the places that call `addValueReference` (mainly in `DeadValue`) to thread a `current_state` value through, starting from `empty_current_state`, and ignore `Current.*`. -- [ ] In a follow‑up patch, re‑implement `addValueReference` and any other helpers that touch `Current.*` purely in terms of `current_state` and delete the `Current.*` refs from DCE code. - -At the end of this step, binding‑related state is explicit and confined to the call chains that need it. +- [x] Add `Current.state`/helpers in `DeadCommon` and thread it through `DeadValue` (bindings) and `DeadException.markAsUsed` so `last_binding` is no longer a global ref. +- [x] Replace `Current.maxValuePosEnd` with a per‑reporting `Current.state` in `Decl.report`/`reportDead`. +- [ ] Follow‑up: remove `Current.state ref` usage by making traversals return an updated state (pure, no mutation). Adjust `addValueReference_state` (or its successor) to be purely functional and always return the new state. ### 4.4 Make `ProcessDeadAnnotations` state explicit @@ -398,4 +382,3 @@ Recommended rough order of tasks (each remains independent and small): 8. 4.14 – Add and maintain order‑independence tests. Each checkbox above should be updated to `[x]` as the corresponding change lands, keeping the codebase runnable and behaviour‑preserving after every step. - diff --git a/analysis/reanalyze/src/DeadCommon.ml b/analysis/reanalyze/src/DeadCommon.ml index 9dbacba7bf..c1a250b8aa 100644 --- a/analysis/reanalyze/src/DeadCommon.ml +++ b/analysis/reanalyze/src/DeadCommon.ml @@ -19,11 +19,26 @@ module Config = struct end module Current = struct - let bindings = ref PosSet.empty - let lastBinding = ref Location.none + type state = { + last_binding: Location.t; + max_value_pos_end: Lexing.position; + } - (** max end position of a value reported dead *) - let maxValuePosEnd = ref Lexing.dummy_pos + let empty_state = + { + last_binding = Location.none; + max_value_pos_end = Lexing.dummy_pos; + } + + let get_last_binding (s : state) = s.last_binding + + let with_last_binding (loc : Location.t) (s : state) : state = + {s with last_binding = loc} + + let get_max_end (s : state) = s.max_value_pos_end + + let with_max_end (pos : Lexing.position) (s : state) : state = + {s with max_value_pos_end = pos} end let rec checkSub s1 s2 n = @@ -88,24 +103,26 @@ let declGetLoc decl = in {Location.loc_start; loc_end = decl.posEnd; loc_ghost = false} -let addValueReference ~addFileReference ~(locFrom : Location.t) - ~(locTo : Location.t) = - let lastBinding = !Current.lastBinding in - let locFrom = +let addValueReference_state ~(current : Current.state) ~addFileReference + ~(locFrom : Location.t) ~(locTo : Location.t) : unit = + let lastBinding = current.last_binding in + let effectiveFrom = match lastBinding = Location.none with | true -> locFrom | false -> lastBinding in - if not locFrom.loc_ghost then ( + if not effectiveFrom.loc_ghost then ( if !Cli.debug then Log_.item "addValueReference %s --> %s@." - (locFrom.loc_start |> posToString) + (effectiveFrom.loc_start |> posToString) (locTo.loc_start |> posToString); - ValueReferences.add locTo.loc_start locFrom.loc_start; + ValueReferences.add locTo.loc_start effectiveFrom.loc_start; if - addFileReference && (not locTo.loc_ghost) && (not locFrom.loc_ghost) - && locFrom.loc_start.pos_fname <> locTo.loc_start.pos_fname - then FileReferences.add locFrom locTo) + addFileReference && (not locTo.loc_ghost) + && (not effectiveFrom.loc_ghost) + && effectiveFrom.loc_start.pos_fname <> locTo.loc_start.pos_fname + then FileReferences.add effectiveFrom locTo); + () let iterFilesFromRootsToLeaves iterFun = (* For each file, the number of incoming references *) @@ -502,24 +519,20 @@ module Decl = struct (fname1, lnum1, bol1, cnum1, kind1) (fname2, lnum2, bol2, cnum2, kind2) - let isInsideReportedValue decl = - let fileHasChanged = - !Current.maxValuePosEnd.pos_fname <> decl.pos.pos_fname - in + let isInsideReportedValue (current_state : Current.state ref) decl = + let max_end = Current.get_max_end !current_state in + let fileHasChanged = max_end.pos_fname <> decl.pos.pos_fname in let insideReportedValue = - decl |> isValue && (not fileHasChanged) - && !Current.maxValuePosEnd.pos_cnum > decl.pos.pos_cnum + decl |> isValue && (not fileHasChanged) && max_end.pos_cnum > decl.pos.pos_cnum in if not insideReportedValue then if decl |> isValue then - if - fileHasChanged - || decl.posEnd.pos_cnum > !Current.maxValuePosEnd.pos_cnum - then Current.maxValuePosEnd := decl.posEnd; + if fileHasChanged || decl.posEnd.pos_cnum > max_end.pos_cnum then + current_state := Current.with_max_end decl.posEnd !current_state; insideReportedValue - let report decl = - let insideReportedValue = decl |> isInsideReportedValue in + let report current_state decl = + let insideReportedValue = decl |> isInsideReportedValue current_state in if decl.report then let name, message = match decl.declKind with @@ -717,4 +730,5 @@ let reportDead ~checkOptionalArg = !deadDeclarations |> List.fast_sort Decl.compareForReporting in (* XXX *) - sortedDeadDeclarations |> List.iter Decl.report + let current_state = ref Current.empty_state in + sortedDeadDeclarations |> List.iter (Decl.report current_state) diff --git a/analysis/reanalyze/src/DeadException.ml b/analysis/reanalyze/src/DeadException.ml index 023bee3f68..02e54b1e3b 100644 --- a/analysis/reanalyze/src/DeadException.ml +++ b/analysis/reanalyze/src/DeadException.ml @@ -21,13 +21,19 @@ let forceDelayedItems () = match Hashtbl.find_opt declarations exceptionPath with | None -> () | Some locTo -> - addValueReference ~addFileReference:true ~locFrom ~locTo) + (* Delayed exception references don't need a binding context; use an empty state. *) + DeadCommon.addValueReference_state + ~current:DeadCommon.Current.empty_state ~addFileReference:true + ~locFrom ~locTo) -let markAsUsed ~(locFrom : Location.t) ~(locTo : Location.t) path_ = +let markAsUsed ~(current_state : Current.state ref) ~(locFrom : Location.t) + ~(locTo : Location.t) path_ = if locTo.loc_ghost then (* Probably defined in another file, delay processing and check at the end *) let exceptionPath = path_ |> Path.fromPathT |> Path.moduleToImplementation in delayedItems := {exceptionPath; locFrom} :: !delayedItems - else addValueReference ~addFileReference:true ~locFrom ~locTo + else + DeadCommon.addValueReference_state ~current:!current_state + ~addFileReference:true ~locFrom ~locTo diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index df8b6aa0e2..3f80684def 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -15,9 +15,9 @@ let checkAnyValueBindingWithNoSideEffects ~sideEffects:false | _ -> () -let collectValueBinding super self (vb : Typedtree.value_binding) = - let oldCurrentBindings = !Current.bindings in - let oldLastBinding = !Current.lastBinding in +let collectValueBinding current_state super self (vb : Typedtree.value_binding) + = + let oldLastBinding = Current.get_last_binding !current_state in checkAnyValueBindingWithNoSideEffects vb; let loc = match vb.vb_pat.pat_desc with @@ -71,13 +71,11 @@ let collectValueBinding super self (vb : Typedtree.value_binding) = posStart = vb.vb_loc.loc_start; }); loc - | _ -> !Current.lastBinding + | _ -> Current.get_last_binding !current_state in - Current.bindings := PosSet.add loc.loc_start !Current.bindings; - Current.lastBinding := loc; + current_state := Current.with_last_binding loc !current_state; let r = super.Tast_mapper.value_binding self vb in - Current.bindings := oldCurrentBindings; - Current.lastBinding := oldLastBinding; + current_state := Current.with_last_binding oldLastBinding !current_state; r let processOptionalArgs ~expType ~(locFrom : Location.t) ~locTo ~path args = @@ -111,7 +109,7 @@ let processOptionalArgs ~expType ~(locFrom : Location.t) ~locTo ~path args = (!supplied, !suppliedMaybe) |> DeadOptionalArgs.addReferences ~locFrom ~locTo ~path) -let rec collectExpr super self (e : Typedtree.expression) = +let rec collectExpr current_state super self (e : Typedtree.expression) = let locFrom = e.exp_loc in (match e.exp_desc with | Texp_ident (_path, _, {Types.val_loc = {loc_ghost = false; _} as locTo}) -> @@ -124,7 +122,9 @@ let rec collectExpr super self (e : Typedtree.expression) = (Location.none.loc_start |> Common.posToString) (locTo.loc_start |> Common.posToString); ValueReferences.add locTo.loc_start Location.none.loc_start) - else addValueReference ~addFileReference:true ~locFrom ~locTo + else + DeadCommon.addValueReference_state ~current:!current_state + ~addFileReference:true ~locFrom ~locTo | Texp_apply { funct = @@ -190,7 +190,8 @@ let rec collectExpr super self (e : Typedtree.expression) = {cstr_loc = {Location.loc_start = posTo; loc_ghost} as locTo; cstr_tag}, _ ) -> (match cstr_tag with - | Cstr_extension path -> path |> DeadException.markAsUsed ~locFrom ~locTo + | Cstr_extension path -> + path |> DeadException.markAsUsed ~current_state ~locFrom ~locTo | _ -> ()); if !Config.analyzeTypes && not loc_ghost then DeadType.addTypeReference ~posTo ~posFrom:locFrom.loc_start @@ -202,7 +203,7 @@ let rec collectExpr super self (e : Typedtree.expression) = -> (* Punned field in OCaml projects has ghost location in expression *) let e = {e with exp_loc = {exp_loc with loc_ghost = false}} in - collectExpr super self e |> ignore + collectExpr current_state super self e |> ignore | _ -> ()) | _ -> ()); super.Tast_mapper.expr self e @@ -286,9 +287,10 @@ let rec processSignatureItem ~doTypes ~doValues ~moduleLoc ~path (* Traverse the AST *) let traverseStructure ~doTypes ~doExternals = let super = Tast_mapper.default in - let expr self e = e |> collectExpr super self in + let current_state = ref Current.empty_state in + let expr self e = e |> collectExpr current_state super self in let pat self p = p |> collectPattern super self in - let value_binding self vb = vb |> collectValueBinding super self in + let value_binding self vb = vb |> collectValueBinding current_state super self in let structure_item self (structureItem : Typedtree.structure_item) = let oldModulePath = ModulePath.getCurrent () in (match structureItem.str_desc with @@ -365,7 +367,7 @@ let traverseStructure ~doTypes ~doExternals = {super with expr; pat; structure_item; value_binding} (* Merge a location's references to another one's *) -let processValueDependency +let processValueDependency current_state ( ({ val_loc = {loc_start = {pos_fname = fnTo} as posTo; loc_ghost = ghost1} as @@ -380,7 +382,8 @@ let processValueDependency Types.value_description) ) = if (not ghost1) && (not ghost2) && posTo <> posFrom then ( let addFileReference = fileIsImplementationOf fnTo fnFrom in - addValueReference ~addFileReference ~locFrom ~locTo; + DeadCommon.addValueReference_state ~current:!current_state + ~addFileReference ~locFrom ~locTo; DeadOptionalArgs.addFunctionReference ~locFrom ~locTo) let processStructure ~cmt_value_dependencies ~doTypes ~doExternals @@ -388,4 +391,5 @@ let processStructure ~cmt_value_dependencies ~doTypes ~doExternals let traverseStructure = traverseStructure ~doTypes ~doExternals in structure |> traverseStructure.structure traverseStructure |> ignore; let valueDependencies = cmt_value_dependencies |> List.rev in - valueDependencies |> List.iter processValueDependency + let current_state = ref Current.empty_state in + valueDependencies |> List.iter (processValueDependency current_state) From ae08f4bb11c4d346bbb20e6dc8059b9981e6c5e0 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 1 Dec 2025 18:26:02 +0100 Subject: [PATCH 3/8] reanalyze: localise dead-code binding and reporting state - Introduce BindingContext in DeadValue to track the current binding location during dead-code traversal, so binding context is explicit and locally encapsulated. - Introduce ReportingContext in DeadCommon to track, per file, the end position of the last reported value when deciding whether to suppress nested warnings. - Replace addValueReference_state with addValueReference ~binding, so value-reference bookkeeping is driven by an explicit binding location rather than a threaded analysis state. - Update dead-code value and exception handling to use the new addValueReference API. - Refresh DEADCODE_REFACTOR_PLAN.md to mark these state-localisation steps as completed and to narrow the remaining follow-up to making the binding context fully pure. - Verified with make test-analysis that behaviour and expected outputs remain unchanged. --- analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md | 5 +- analysis/reanalyze/src/DeadCommon.ml | 51 +++-- analysis/reanalyze/src/DeadException.ml | 10 +- analysis/reanalyze/src/DeadValue.ml | 206 ++++++++++--------- 4 files changed, 146 insertions(+), 126 deletions(-) diff --git a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md index ec86510545..e6699e8bc9 100644 --- a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md +++ b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md @@ -200,8 +200,9 @@ Each bullet above should be done as a separate patch touching only a small set o Goal: remove `DeadCommon.Current` globals for binding/reporting by threading explicit state. - [x] Add `Current.state`/helpers in `DeadCommon` and thread it through `DeadValue` (bindings) and `DeadException.markAsUsed` so `last_binding` is no longer a global ref. -- [x] Replace `Current.maxValuePosEnd` with a per‑reporting `Current.state` in `Decl.report`/`reportDead`. -- [ ] Follow‑up: remove `Current.state ref` usage by making traversals return an updated state (pure, no mutation). Adjust `addValueReference_state` (or its successor) to be purely functional and always return the new state. +- [x] Replace `Current.maxValuePosEnd` with a per‑reporting state in `Decl.report`/`reportDead` (now encapsulated in `ReportingContext`). +- [x] Replace `addValueReference_state` with `addValueReference ~binding` so reference bookkeeping no longer threads `Current.state` or returns a fake “updated state”. +- [ ] Follow‑up: remove the remaining local `Current.state ref` in `BindingContext` by making traversals return an updated binding context (pure, no mutation). At that point, binding context becomes an explicit input/output of the traversal, not hidden state. ### 4.4 Make `ProcessDeadAnnotations` state explicit diff --git a/analysis/reanalyze/src/DeadCommon.ml b/analysis/reanalyze/src/DeadCommon.ml index c1a250b8aa..9b8e5a4ae1 100644 --- a/analysis/reanalyze/src/DeadCommon.ml +++ b/analysis/reanalyze/src/DeadCommon.ml @@ -19,16 +19,10 @@ module Config = struct end module Current = struct - type state = { - last_binding: Location.t; - max_value_pos_end: Lexing.position; - } + type state = {last_binding: Location.t; max_value_pos_end: Lexing.position} let empty_state = - { - last_binding = Location.none; - max_value_pos_end = Lexing.dummy_pos; - } + {last_binding = Location.none; max_value_pos_end = Lexing.dummy_pos} let get_last_binding (s : state) = s.last_binding @@ -83,6 +77,17 @@ module ValueReferences = struct let find pos = PosHash.findSet table pos end +(* Local reporting context used only while emitting dead-code warnings. + It tracks, per file, the end position of the last value we reported on, + so nested values inside that range don't get duplicate warnings. *) +module ReportingContext = struct + type t = Lexing.position ref + + let create () : t = ref Lexing.dummy_pos + let get_max_end (ctx : t) = !ctx + let set_max_end (ctx : t) (pos : Lexing.position) = ctx := pos +end + module TypeReferences = struct (** all type references *) let table = (PosHash.create 256 : PosSet.t PosHash.t) @@ -103,14 +108,9 @@ let declGetLoc decl = in {Location.loc_start; loc_end = decl.posEnd; loc_ghost = false} -let addValueReference_state ~(current : Current.state) ~addFileReference +let addValueReference ~(binding : Location.t) ~addFileReference ~(locFrom : Location.t) ~(locTo : Location.t) : unit = - let lastBinding = current.last_binding in - let effectiveFrom = - match lastBinding = Location.none with - | true -> locFrom - | false -> lastBinding - in + let effectiveFrom = if binding = Location.none then locFrom else binding in if not effectiveFrom.loc_ghost then ( if !Cli.debug then Log_.item "addValueReference %s --> %s@." @@ -121,8 +121,7 @@ let addValueReference_state ~(current : Current.state) ~addFileReference addFileReference && (not locTo.loc_ghost) && (not effectiveFrom.loc_ghost) && effectiveFrom.loc_start.pos_fname <> locTo.loc_start.pos_fname - then FileReferences.add effectiveFrom locTo); - () + then FileReferences.add effectiveFrom locTo) let iterFilesFromRootsToLeaves iterFun = (* For each file, the number of incoming references *) @@ -519,20 +518,21 @@ module Decl = struct (fname1, lnum1, bol1, cnum1, kind1) (fname2, lnum2, bol2, cnum2, kind2) - let isInsideReportedValue (current_state : Current.state ref) decl = - let max_end = Current.get_max_end !current_state in + let isInsideReportedValue (ctx : ReportingContext.t) decl = + let max_end = ReportingContext.get_max_end ctx in let fileHasChanged = max_end.pos_fname <> decl.pos.pos_fname in let insideReportedValue = - decl |> isValue && (not fileHasChanged) && max_end.pos_cnum > decl.pos.pos_cnum + decl |> isValue && (not fileHasChanged) + && max_end.pos_cnum > decl.pos.pos_cnum in if not insideReportedValue then if decl |> isValue then if fileHasChanged || decl.posEnd.pos_cnum > max_end.pos_cnum then - current_state := Current.with_max_end decl.posEnd !current_state; + ReportingContext.set_max_end ctx decl.posEnd; insideReportedValue - let report current_state decl = - let insideReportedValue = decl |> isInsideReportedValue current_state in + let report (ctx : ReportingContext.t) decl = + let insideReportedValue = decl |> isInsideReportedValue ctx in if decl.report then let name, message = match decl.declKind with @@ -729,6 +729,5 @@ let reportDead ~checkOptionalArg = let sortedDeadDeclarations = !deadDeclarations |> List.fast_sort Decl.compareForReporting in - (* XXX *) - let current_state = ref Current.empty_state in - sortedDeadDeclarations |> List.iter (Decl.report current_state) + let reporting_ctx = ReportingContext.create () in + sortedDeadDeclarations |> List.iter (Decl.report reporting_ctx) diff --git a/analysis/reanalyze/src/DeadException.ml b/analysis/reanalyze/src/DeadException.ml index 02e54b1e3b..f9bde2d2e4 100644 --- a/analysis/reanalyze/src/DeadException.ml +++ b/analysis/reanalyze/src/DeadException.ml @@ -22,11 +22,10 @@ let forceDelayedItems () = | None -> () | Some locTo -> (* Delayed exception references don't need a binding context; use an empty state. *) - DeadCommon.addValueReference_state - ~current:DeadCommon.Current.empty_state ~addFileReference:true - ~locFrom ~locTo) + DeadCommon.addValueReference ~binding:Location.none + ~addFileReference:true ~locFrom ~locTo) -let markAsUsed ~(current_state : Current.state ref) ~(locFrom : Location.t) +let markAsUsed ~(binding : Location.t) ~(locFrom : Location.t) ~(locTo : Location.t) path_ = if locTo.loc_ghost then (* Probably defined in another file, delay processing and check at the end *) @@ -35,5 +34,4 @@ let markAsUsed ~(current_state : Current.state ref) ~(locFrom : Location.t) in delayedItems := {exceptionPath; locFrom} :: !delayedItems else - DeadCommon.addValueReference_state ~current:!current_state - ~addFileReference:true ~locFrom ~locTo + DeadCommon.addValueReference ~binding ~addFileReference:true ~locFrom ~locTo diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index 3f80684def..169c8211f5 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -2,6 +2,23 @@ open DeadCommon +module BindingContext = struct + (* Local, encapsulated mutable state for tracking the current binding location + during traversal. This ref does not escape the module. *) + type t = Current.state ref + + let create () : t = ref Current.empty_state + + let get_binding (ctx : t) : Location.t = !ctx |> Current.get_last_binding + + let with_binding (ctx : t) (loc : Location.t) (f : unit -> 'a) : 'a = + let old_state = !ctx in + ctx := Current.with_last_binding loc old_state; + let result = f () in + ctx := old_state; + result +end + let checkAnyValueBindingWithNoSideEffects ({vb_pat = {pat_desc}; vb_expr = expr; vb_loc = loc} : Typedtree.value_binding) = @@ -15,9 +32,9 @@ let checkAnyValueBindingWithNoSideEffects ~sideEffects:false | _ -> () -let collectValueBinding current_state super self (vb : Typedtree.value_binding) - = - let oldLastBinding = Current.get_last_binding !current_state in +let collectValueBinding ~(current_binding : Location.t) + (vb : Typedtree.value_binding) = + let oldLastBinding = current_binding in checkAnyValueBindingWithNoSideEffects vb; let loc = match vb.vb_pat.pat_desc with @@ -71,12 +88,9 @@ let collectValueBinding current_state super self (vb : Typedtree.value_binding) posStart = vb.vb_loc.loc_start; }); loc - | _ -> Current.get_last_binding !current_state + | _ -> current_binding in - current_state := Current.with_last_binding loc !current_state; - let r = super.Tast_mapper.value_binding self vb in - current_state := Current.with_last_binding oldLastBinding !current_state; - r + loc let processOptionalArgs ~expType ~(locFrom : Location.t) ~locTo ~path args = if expType |> DeadOptionalArgs.hasOptionalArgs then ( @@ -109,8 +123,10 @@ let processOptionalArgs ~expType ~(locFrom : Location.t) ~locTo ~path args = (!supplied, !suppliedMaybe) |> DeadOptionalArgs.addReferences ~locFrom ~locTo ~path) -let rec collectExpr current_state super self (e : Typedtree.expression) = +let rec collectExpr ~(binding_ctx : BindingContext.t) super self + (e : Typedtree.expression) = let locFrom = e.exp_loc in + let binding = BindingContext.get_binding binding_ctx in (match e.exp_desc with | Texp_ident (_path, _, {Types.val_loc = {loc_ghost = false; _} as locTo}) -> (* if Path.name _path = "rc" then assert false; *) @@ -123,8 +139,8 @@ let rec collectExpr current_state super self (e : Typedtree.expression) = (locTo.loc_start |> Common.posToString); ValueReferences.add locTo.loc_start Location.none.loc_start) else - DeadCommon.addValueReference_state ~current:!current_state - ~addFileReference:true ~locFrom ~locTo + DeadCommon.addValueReference ~binding ~addFileReference:true ~locFrom + ~locTo | Texp_apply { funct = @@ -191,7 +207,7 @@ let rec collectExpr current_state super self (e : Typedtree.expression) = _ ) -> (match cstr_tag with | Cstr_extension path -> - path |> DeadException.markAsUsed ~current_state ~locFrom ~locTo + path |> DeadException.markAsUsed ~binding ~locFrom ~locTo | _ -> ()); if !Config.analyzeTypes && not loc_ghost then DeadType.addTypeReference ~posTo ~posFrom:locFrom.loc_start @@ -203,7 +219,7 @@ let rec collectExpr current_state super self (e : Typedtree.expression) = -> (* Punned field in OCaml projects has ghost location in expression *) let e = {e with exp_loc = {exp_loc with loc_ghost = false}} in - collectExpr current_state super self e |> ignore + collectExpr ~binding_ctx super self e |> ignore | _ -> ()) | _ -> ()); super.Tast_mapper.expr self e @@ -286,88 +302,95 @@ let rec processSignatureItem ~doTypes ~doValues ~moduleLoc ~path (* Traverse the AST *) let traverseStructure ~doTypes ~doExternals = - let super = Tast_mapper.default in - let current_state = ref Current.empty_state in - let expr self e = e |> collectExpr current_state super self in - let pat self p = p |> collectPattern super self in - let value_binding self vb = vb |> collectValueBinding current_state super self in - let structure_item self (structureItem : Typedtree.structure_item) = - let oldModulePath = ModulePath.getCurrent () in - (match structureItem.str_desc with - | Tstr_module {mb_expr; mb_id; mb_loc} -> ( - let hasInterface = - match mb_expr.mod_desc with - | Tmod_constraint _ -> true - | _ -> false - in - ModulePath.setCurrent - { - oldModulePath with - loc = mb_loc; - path = (mb_id |> Ident.name |> Name.create) :: oldModulePath.path; - }; - if hasInterface then - match mb_expr.mod_type with - | Mty_signature signature -> - signature + let binding_ctx = BindingContext.create () in + let customize super = + let expr self e = e |> collectExpr ~binding_ctx super self in + let value_binding self vb = + let current_binding = BindingContext.get_binding binding_ctx in + let loc = vb |> collectValueBinding ~current_binding in + BindingContext.with_binding binding_ctx loc (fun () -> + super.Tast_mapper.value_binding self vb) + in + let pat self p = p |> collectPattern super self in + let structure_item self (structureItem : Typedtree.structure_item) = + let oldModulePath = ModulePath.getCurrent () in + (match structureItem.str_desc with + | Tstr_module {mb_expr; mb_id; mb_loc} -> ( + let hasInterface = + match mb_expr.mod_desc with + | Tmod_constraint _ -> true + | _ -> false + in + ModulePath.setCurrent + { + oldModulePath with + loc = mb_loc; + path = (mb_id |> Ident.name |> Name.create) :: oldModulePath.path; + }; + if hasInterface then + match mb_expr.mod_type with + | Mty_signature signature -> + signature + |> List.iter + (processSignatureItem ~doTypes ~doValues:false + ~moduleLoc:mb_expr.mod_loc + ~path: + ((ModulePath.getCurrent ()).path + @ [!Common.currentModuleName])) + | _ -> ()) + | Tstr_primitive vd when doExternals && !Config.analyzeExternals -> + let currentModulePath = ModulePath.getCurrent () in + let path = currentModulePath.path @ [!Common.currentModuleName] in + let exists = + match PosHash.find_opt decls vd.val_loc.loc_start with + | Some {declKind = Value _} -> true + | _ -> false + in + let id = vd.val_id |> Ident.name in + Printf.printf "Primitive %s\n" id; + if + (not exists) && id <> "unsafe_expr" + (* see https://github.com/BuckleScript/bucklescript/issues/4532 *) + then + id + |> Name.create ~isInterface:false + |> addValueDeclaration ~path ~loc:vd.val_loc + ~moduleLoc:currentModulePath.loc ~sideEffects:false + | Tstr_type (_recFlag, typeDeclarations) when doTypes -> + if !Config.analyzeTypes then + typeDeclarations + |> List.iter (fun (typeDeclaration : Typedtree.type_declaration) -> + DeadType.addDeclaration ~typeId:typeDeclaration.typ_id + ~typeKind:typeDeclaration.typ_type.type_kind) + | Tstr_include {incl_mod; incl_type} -> ( + match incl_mod.mod_desc with + | Tmod_ident (_path, _lid) -> + let currentPath = + (ModulePath.getCurrent ()).path @ [!Common.currentModuleName] + in + incl_type |> List.iter - (processSignatureItem ~doTypes ~doValues:false - ~moduleLoc:mb_expr.mod_loc - ~path: - ((ModulePath.getCurrent ()).path - @ [!Common.currentModuleName])) + (processSignatureItem ~doTypes + ~doValues:false (* TODO: also values? *) + ~moduleLoc:incl_mod.mod_loc ~path:currentPath) | _ -> ()) - | Tstr_primitive vd when doExternals && !Config.analyzeExternals -> - let currentModulePath = ModulePath.getCurrent () in - let path = currentModulePath.path @ [!Common.currentModuleName] in - let exists = - match PosHash.find_opt decls vd.val_loc.loc_start with - | Some {declKind = Value _} -> true - | _ -> false - in - let id = vd.val_id |> Ident.name in - Printf.printf "Primitive %s\n" id; - if - (not exists) && id <> "unsafe_expr" - (* see https://github.com/BuckleScript/bucklescript/issues/4532 *) - then - id - |> Name.create ~isInterface:false - |> addValueDeclaration ~path ~loc:vd.val_loc - ~moduleLoc:currentModulePath.loc ~sideEffects:false - | Tstr_type (_recFlag, typeDeclarations) when doTypes -> - if !Config.analyzeTypes then - typeDeclarations - |> List.iter (fun (typeDeclaration : Typedtree.type_declaration) -> - DeadType.addDeclaration ~typeId:typeDeclaration.typ_id - ~typeKind:typeDeclaration.typ_type.type_kind) - | Tstr_include {incl_mod; incl_type} -> ( - match incl_mod.mod_desc with - | Tmod_ident (_path, _lid) -> - let currentPath = + | Tstr_exception {ext_id = id; ext_loc = loc} -> + let path = (ModulePath.getCurrent ()).path @ [!Common.currentModuleName] in - incl_type - |> List.iter - (processSignatureItem ~doTypes - ~doValues:false (* TODO: also values? *) - ~moduleLoc:incl_mod.mod_loc ~path:currentPath) - | _ -> ()) - | Tstr_exception {ext_id = id; ext_loc = loc} -> - let path = - (ModulePath.getCurrent ()).path @ [!Common.currentModuleName] - in - let name = id |> Ident.name |> Name.create in - name |> DeadException.add ~path ~loc ~strLoc:structureItem.str_loc - | _ -> ()); - let result = super.structure_item self structureItem in - ModulePath.setCurrent oldModulePath; - result + let name = id |> Ident.name |> Name.create in + name |> DeadException.add ~path ~loc ~strLoc:structureItem.str_loc + | _ -> ()); + let result = super.structure_item self structureItem in + ModulePath.setCurrent oldModulePath; + result + in + {super with expr; pat; structure_item; value_binding} in - {super with expr; pat; structure_item; value_binding} + customize Tast_mapper.default (* Merge a location's references to another one's *) -let processValueDependency current_state +let processValueDependency ( ({ val_loc = {loc_start = {pos_fname = fnTo} as posTo; loc_ghost = ghost1} as @@ -382,8 +405,8 @@ let processValueDependency current_state Types.value_description) ) = if (not ghost1) && (not ghost2) && posTo <> posFrom then ( let addFileReference = fileIsImplementationOf fnTo fnFrom in - DeadCommon.addValueReference_state ~current:!current_state - ~addFileReference ~locFrom ~locTo; + DeadCommon.addValueReference ~binding:Location.none ~addFileReference + ~locFrom ~locTo; DeadOptionalArgs.addFunctionReference ~locFrom ~locTo) let processStructure ~cmt_value_dependencies ~doTypes ~doExternals @@ -391,5 +414,4 @@ let processStructure ~cmt_value_dependencies ~doTypes ~doExternals let traverseStructure = traverseStructure ~doTypes ~doExternals in structure |> traverseStructure.structure traverseStructure |> ignore; let valueDependencies = cmt_value_dependencies |> List.rev in - let current_state = ref Current.empty_state in - valueDependencies |> List.iter (processValueDependency current_state) + valueDependencies |> List.iter processValueDependency From 430988da99d23b0b926bb327391379b9ace05738 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 5 Dec 2025 04:58:28 +0100 Subject: [PATCH 4/8] Simplify binding state tracking in DeadValue - Remove BindingContext module wrapper (was just forwarding to Current) - Remove Current module entirely (unnecessary abstraction) - Simplify to pass Location.t directly instead of record type - Remove unused max_value_pos_end field - Refactor traverseStructure to use pure functional mapper creation - Update DEADCODE_REFACTOR_PLAN.md to mark task 4.3 as complete This eliminates ~40 lines of wrapper code and makes the binding state tracking pure and simpler to understand. --- analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md | 2 +- analysis/reanalyze/src/DeadCommon.ml | 16 -- analysis/reanalyze/src/DeadValue.ml | 204 +++++++++---------- 3 files changed, 98 insertions(+), 124 deletions(-) diff --git a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md index e6699e8bc9..8a06143641 100644 --- a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md +++ b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md @@ -202,7 +202,7 @@ Goal: remove `DeadCommon.Current` globals for binding/reporting by threading exp - [x] Add `Current.state`/helpers in `DeadCommon` and thread it through `DeadValue` (bindings) and `DeadException.markAsUsed` so `last_binding` is no longer a global ref. - [x] Replace `Current.maxValuePosEnd` with a per‑reporting state in `Decl.report`/`reportDead` (now encapsulated in `ReportingContext`). - [x] Replace `addValueReference_state` with `addValueReference ~binding` so reference bookkeeping no longer threads `Current.state` or returns a fake “updated state”. -- [ ] Follow‑up: remove the remaining local `Current.state ref` in `BindingContext` by making traversals return an updated binding context (pure, no mutation). At that point, binding context becomes an explicit input/output of the traversal, not hidden state. +- [x] Follow‑up: remove the remaining local `Current.state ref` in `BindingContext` by making traversals return an updated binding context (pure, no mutation). At that point, binding context becomes an explicit input/output of the traversal, not hidden state. ### 4.4 Make `ProcessDeadAnnotations` state explicit diff --git a/analysis/reanalyze/src/DeadCommon.ml b/analysis/reanalyze/src/DeadCommon.ml index 9b8e5a4ae1..d75c71f1bf 100644 --- a/analysis/reanalyze/src/DeadCommon.ml +++ b/analysis/reanalyze/src/DeadCommon.ml @@ -18,22 +18,6 @@ module Config = struct let warnOnCircularDependencies = false end -module Current = struct - type state = {last_binding: Location.t; max_value_pos_end: Lexing.position} - - let empty_state = - {last_binding = Location.none; max_value_pos_end = Lexing.dummy_pos} - - let get_last_binding (s : state) = s.last_binding - - let with_last_binding (loc : Location.t) (s : state) : state = - {s with last_binding = loc} - - let get_max_end (s : state) = s.max_value_pos_end - - let with_max_end (pos : Lexing.position) (s : state) : state = - {s with max_value_pos_end = pos} -end let rec checkSub s1 s2 n = n <= 0 diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index 169c8211f5..ffffdb4427 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -2,23 +2,6 @@ open DeadCommon -module BindingContext = struct - (* Local, encapsulated mutable state for tracking the current binding location - during traversal. This ref does not escape the module. *) - type t = Current.state ref - - let create () : t = ref Current.empty_state - - let get_binding (ctx : t) : Location.t = !ctx |> Current.get_last_binding - - let with_binding (ctx : t) (loc : Location.t) (f : unit -> 'a) : 'a = - let old_state = !ctx in - ctx := Current.with_last_binding loc old_state; - let result = f () in - ctx := old_state; - result -end - let checkAnyValueBindingWithNoSideEffects ({vb_pat = {pat_desc}; vb_expr = expr; vb_loc = loc} : Typedtree.value_binding) = @@ -123,10 +106,10 @@ let processOptionalArgs ~expType ~(locFrom : Location.t) ~locTo ~path args = (!supplied, !suppliedMaybe) |> DeadOptionalArgs.addReferences ~locFrom ~locTo ~path) -let rec collectExpr ~(binding_ctx : BindingContext.t) super self +let rec collectExpr ~(last_binding : Location.t) super self (e : Typedtree.expression) = let locFrom = e.exp_loc in - let binding = BindingContext.get_binding binding_ctx in + let binding = last_binding in (match e.exp_desc with | Texp_ident (_path, _, {Types.val_loc = {loc_ghost = false; _} as locTo}) -> (* if Path.name _path = "rc" then assert false; *) @@ -219,7 +202,7 @@ let rec collectExpr ~(binding_ctx : BindingContext.t) super self -> (* Punned field in OCaml projects has ghost location in expression *) let e = {e with exp_loc = {exp_loc with loc_ghost = false}} in - collectExpr ~binding_ctx super self e |> ignore + collectExpr ~last_binding super self e |> ignore | _ -> ()) | _ -> ()); super.Tast_mapper.expr self e @@ -301,93 +284,101 @@ let rec processSignatureItem ~doTypes ~doValues ~moduleLoc ~path ModulePath.setCurrent oldModulePath (* Traverse the AST *) -let traverseStructure ~doTypes ~doExternals = - let binding_ctx = BindingContext.create () in - let customize super = - let expr self e = e |> collectExpr ~binding_ctx super self in - let value_binding self vb = - let current_binding = BindingContext.get_binding binding_ctx in - let loc = vb |> collectValueBinding ~current_binding in - BindingContext.with_binding binding_ctx loc (fun () -> - super.Tast_mapper.value_binding self vb) - in - let pat self p = p |> collectPattern super self in - let structure_item self (structureItem : Typedtree.structure_item) = - let oldModulePath = ModulePath.getCurrent () in - (match structureItem.str_desc with - | Tstr_module {mb_expr; mb_id; mb_loc} -> ( - let hasInterface = - match mb_expr.mod_desc with - | Tmod_constraint _ -> true - | _ -> false - in - ModulePath.setCurrent - { - oldModulePath with - loc = mb_loc; - path = (mb_id |> Ident.name |> Name.create) :: oldModulePath.path; - }; - if hasInterface then - match mb_expr.mod_type with - | Mty_signature signature -> - signature - |> List.iter - (processSignatureItem ~doTypes ~doValues:false - ~moduleLoc:mb_expr.mod_loc - ~path: - ((ModulePath.getCurrent ()).path - @ [!Common.currentModuleName])) - | _ -> ()) - | Tstr_primitive vd when doExternals && !Config.analyzeExternals -> - let currentModulePath = ModulePath.getCurrent () in - let path = currentModulePath.path @ [!Common.currentModuleName] in - let exists = - match PosHash.find_opt decls vd.val_loc.loc_start with - | Some {declKind = Value _} -> true - | _ -> false - in - let id = vd.val_id |> Ident.name in - Printf.printf "Primitive %s\n" id; - if - (not exists) && id <> "unsafe_expr" - (* see https://github.com/BuckleScript/bucklescript/issues/4532 *) - then - id - |> Name.create ~isInterface:false - |> addValueDeclaration ~path ~loc:vd.val_loc - ~moduleLoc:currentModulePath.loc ~sideEffects:false - | Tstr_type (_recFlag, typeDeclarations) when doTypes -> - if !Config.analyzeTypes then - typeDeclarations - |> List.iter (fun (typeDeclaration : Typedtree.type_declaration) -> - DeadType.addDeclaration ~typeId:typeDeclaration.typ_id - ~typeKind:typeDeclaration.typ_type.type_kind) - | Tstr_include {incl_mod; incl_type} -> ( - match incl_mod.mod_desc with - | Tmod_ident (_path, _lid) -> - let currentPath = - (ModulePath.getCurrent ()).path @ [!Common.currentModuleName] - in - incl_type - |> List.iter - (processSignatureItem ~doTypes - ~doValues:false (* TODO: also values? *) - ~moduleLoc:incl_mod.mod_loc ~path:currentPath) - | _ -> ()) - | Tstr_exception {ext_id = id; ext_loc = loc} -> - let path = - (ModulePath.getCurrent ()).path @ [!Common.currentModuleName] - in - let name = id |> Ident.name |> Name.create in - name |> DeadException.add ~path ~loc ~strLoc:structureItem.str_loc - | _ -> ()); - let result = super.structure_item self structureItem in - ModulePath.setCurrent oldModulePath; - result +let traverseStructure ~doTypes ~doExternals (structure : Typedtree.structure) : + unit = + let rec create_mapper (last_binding : Location.t) = + let super = Tast_mapper.default in + let rec mapper = + { + super with + expr = (fun _self e -> e |> collectExpr ~last_binding super mapper); + pat = (fun _self p -> p |> collectPattern super mapper); + structure_item = + (fun _self (structureItem : Typedtree.structure_item) -> + let oldModulePath = ModulePath.getCurrent () in + (match structureItem.str_desc with + | Tstr_module {mb_expr; mb_id; mb_loc} -> ( + let hasInterface = + match mb_expr.mod_desc with + | Tmod_constraint _ -> true + | _ -> false + in + ModulePath.setCurrent + { + oldModulePath with + loc = mb_loc; + path = + (mb_id |> Ident.name |> Name.create) :: oldModulePath.path; + }; + if hasInterface then + match mb_expr.mod_type with + | Mty_signature signature -> + signature + |> List.iter + (processSignatureItem ~doTypes ~doValues:false + ~moduleLoc:mb_expr.mod_loc + ~path: + ((ModulePath.getCurrent ()).path + @ [!Common.currentModuleName])) + | _ -> ()) + | Tstr_primitive vd when doExternals && !Config.analyzeExternals -> + let currentModulePath = ModulePath.getCurrent () in + let path = currentModulePath.path @ [!Common.currentModuleName] in + let exists = + match PosHash.find_opt decls vd.val_loc.loc_start with + | Some {declKind = Value _} -> true + | _ -> false + in + let id = vd.val_id |> Ident.name in + Printf.printf "Primitive %s\n" id; + if + (not exists) && id <> "unsafe_expr" + (* see https://github.com/BuckleScript/bucklescript/issues/4532 *) + then + id + |> Name.create ~isInterface:false + |> addValueDeclaration ~path ~loc:vd.val_loc + ~moduleLoc:currentModulePath.loc ~sideEffects:false + | Tstr_type (_recFlag, typeDeclarations) when doTypes -> + if !Config.analyzeTypes then + typeDeclarations + |> List.iter + (fun (typeDeclaration : Typedtree.type_declaration) -> + DeadType.addDeclaration ~typeId:typeDeclaration.typ_id + ~typeKind:typeDeclaration.typ_type.type_kind) + | Tstr_include {incl_mod; incl_type} -> ( + match incl_mod.mod_desc with + | Tmod_ident (_path, _lid) -> + let currentPath = + (ModulePath.getCurrent ()).path @ [!Common.currentModuleName] + in + incl_type + |> List.iter + (processSignatureItem ~doTypes + ~doValues:false (* TODO: also values? *) + ~moduleLoc:incl_mod.mod_loc ~path:currentPath) + | _ -> ()) + | Tstr_exception {ext_id = id; ext_loc = loc} -> + let path = + (ModulePath.getCurrent ()).path @ [!Common.currentModuleName] + in + let name = id |> Ident.name |> Name.create in + name |> DeadException.add ~path ~loc ~strLoc:structureItem.str_loc + | _ -> ()); + let result = super.structure_item mapper structureItem in + ModulePath.setCurrent oldModulePath; + result); + value_binding = + (fun _self vb -> + let loc = vb |> collectValueBinding ~current_binding:last_binding in + let nested_mapper = create_mapper loc in + super.Tast_mapper.value_binding nested_mapper vb); + } in - {super with expr; pat; structure_item; value_binding} + mapper in - customize Tast_mapper.default + let mapper = create_mapper Location.none in + mapper.structure mapper structure |> ignore (* Merge a location's references to another one's *) let processValueDependency @@ -411,7 +402,6 @@ let processValueDependency let processStructure ~cmt_value_dependencies ~doTypes ~doExternals (structure : Typedtree.structure) = - let traverseStructure = traverseStructure ~doTypes ~doExternals in - structure |> traverseStructure.structure traverseStructure |> ignore; + traverseStructure ~doTypes ~doExternals structure; let valueDependencies = cmt_value_dependencies |> List.rev in valueDependencies |> List.iter processValueDependency From a4c5466908d4d7211359ddf2fc0e23f6fd278ba6 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 5 Dec 2025 16:02:24 +0100 Subject: [PATCH 5/8] Rewrite DCE refactor plan to be pragmatic and value-focused The original plan was too granular with many 'add scaffolding but don't use it yet' tasks. This rewrite focuses on: - Problem-first structure: each task solves a real architectural issue - Combined related changes: no pointless intermediate states - Clear value propositions: why each task matters - Testable success criteria: how we know it worked - Realistic effort estimates Reduces 14 fine-grained tasks down to 10 focused tasks that each leave the codebase measurably better. Signed-off-by: Cursor AI --- analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md | 543 ++++++++----------- 1 file changed, 236 insertions(+), 307 deletions(-) diff --git a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md index 8a06143641..9d7dc30d5f 100644 --- a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md +++ b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md @@ -1,385 +1,314 @@ ## Dead Code Analysis – Pure Pipeline Refactor Plan -This document tracks the plan to turn the **reanalyze dead code analysis** into a transparent, effect‑free pipeline expressed as pure function composition. It is deliberately fine‑grained so each task can be done and checked off independently, while always keeping the system runnable and behaviour‑preserving. - -Scope: only the **dead code / DCE** parts under `analysis/reanalyze/src`: -- `Reanalyze.ml` (DCE wiring) -- `DeadCode.ml` -- `DeadCommon.ml` -- `DeadValue.ml` -- `DeadType.ml` -- `DeadOptionalArgs.ml` -- `DeadException.ml` -- `DeadModules.ml` -- `SideEffects.ml` -- `WriteDeadAnnotations.ml` (only the pieces tied to DCE) -- Supporting shared state in `Common.ml`, `ModulePath.ml`, `Paths.ml`, `RunConfig.ml`, `Log_.ml` - -Exception and termination analyses (`Exception.ml`, `Arnold.ml`, etc.) are out of scope except where they share state that must be disentangled. +**Goal**: Turn the reanalyze dead code analysis into a transparent, effect-free pipeline where: +- Analysis is a pure function from inputs → results +- Global mutable state is eliminated +- Side effects (logging, file I/O) live at the edges +- Processing files in different orders gives the same results + +**Why?** The current architecture makes: +- Incremental/reactive analysis impossible (can't reprocess one file) +- Testing hard (global state persists between tests) +- Parallelization impossible (shared mutable state) +- Reasoning difficult (order-dependent hidden mutations) --- -## 1. Target Architecture: Pure Pipeline (End State) +## Current Problems (What We're Fixing) -This section describes the desired **end state**, not something to implement in one big change. +### P1: Global "current file" context +**Problem**: `Common.currentSrc`, `currentModule`, `currentModuleName` are global refs set before processing each file. Every function implicitly depends on "which file are we processing right now?". This makes it impossible to process multiple files concurrently or incrementally. -### 1.1 Top‑level inputs and outputs +**Used by**: `DeadCommon.addDeclaration_`, `DeadType.addTypeDependenciesAcrossFiles`, `DeadValue` path construction. -**Inputs** -- CLI / configuration: - - `RunConfig.t` (DCE flags, project root, transitive, suppression lists, etc.). - - CLI flags from `Common.Cli` (`debug`, `ci`, `json`, `write`, `liveNames`, `livePaths`, `excludePaths`). -- Project context: - - Root directory / `cmtRoot` or inferred `projectRoot`. - - Discovered `cmt` / `cmti` files and their associated source files. -- Per‑file compiler artifacts: - - `Cmt_format.cmt_infos` for each `*.cmt` / `*.cmti`. +### P2: Global analysis tables +**Problem**: All analysis results accumulate in global hashtables: +- `DeadCommon.decls` - all declarations +- `ValueReferences.table` - all value references +- `TypeReferences.table` - all type references +- `FileReferences.table` - cross-file dependencies -**Outputs** -- Pure analysis results: - - List of `Common.issue` values (dead values, dead types, dead exceptions, dead modules, dead/always‑supplied optional args, incorrect `@dead` annotations, circular dependency warnings). - - Derived `@dead` line annotations per file (to be written back to source when enabled). -- Side‑effectful consumers (kept at the edges): - - Terminal logging / JSON output (`Log_`, `EmitJson`). - - File rewriting for `@dead` annotations (`WriteDeadAnnotations`). +**Impact**: Can't analyze a subset of files without reanalyzing everything. Can't clear state between test runs without module reloading. -### 1.2 File‑level pure API (end state) +### P3: Delayed/deferred processing queues +**Problem**: Several analyses use global queues that get "flushed" later: +- `DeadOptionalArgs.delayedItems` - deferred optional arg analysis +- `DeadException.delayedItems` - deferred exception checks +- `DeadType.TypeDependencies.delayedItems` - deferred type deps +- `ProcessDeadAnnotations.positionsAnnotated` - annotation tracking -Conceptual end‑state per‑file API: +**Impact**: Order-dependent. Processing files in different orders can give different results because queue processing happens at arbitrary times. + +### P4: Global configuration reads +**Problem**: Analysis code directly reads `!Common.Cli.debug`, `RunConfig.runConfig.transitive`, etc. scattered throughout. Can't run analysis with different configs without mutating globals. + +### P5: Side effects mixed with analysis +**Problem**: Analysis functions directly call: +- `Log_.warning` - logging +- `EmitJson` - JSON output +- `WriteDeadAnnotations` - file I/O +- Direct mutation of result data structures + +**Impact**: Can't get analysis results as data. Can't test without capturing I/O. Can't reuse analysis logic for different output formats. + +### P6: Binding/reporting state +**Problem**: `DeadCommon.Current.bindings`, `lastBinding`, `maxValuePosEnd` are per-file state stored globally. + +**Status**: ✅ ALREADY FIXED in previous work - now explicit state threaded through traversals. + +--- + +## End State ```ocaml -type cli_config = { +(* Configuration: all inputs as immutable data *) +type config = { + run : RunConfig.t; (* transitive, suppress lists, etc. *) debug : bool; - ci : bool; write_annotations : bool; live_names : string list; live_paths : string list; exclude_paths : string list; } -type dce_config = { - run : RunConfig.t; - cli : cli_config; +(* Per-file analysis state - everything needed to analyze one file *) +type file_state = { + source_path : string; + module_name : Name.t; + is_interface : bool; + annotations : annotation_state; + (* ... other per-file state *) } -type file_input = { - cmt_path : string; - source_path : string; - cmt_infos : Cmt_format.cmt_infos; +(* Project-level analysis state - accumulated across all files *) +type project_state = { + decls : decl PosHash.t; + value_refs : PosSet.t PosHash.t; + type_refs : PosSet.t PosHash.t; + file_refs : FileSet.t FileHash.t; + optional_args : optional_args_state; + exceptions : exception_state; + (* ... *) } -type file_dce_result = { +(* Pure analysis function *) +val analyze_file : config -> file_state -> project_state -> Cmt_format.cmt_infos -> project_state + +(* Pure deadness solver *) +val solve_deadness : config -> project_state -> analysis_result + +type analysis_result = { + dead_decls : decl list; issues : Common.issue list; - dead_annotations : WriteDeadAnnotations.line_annotation list; + annotations_to_write : (string * line_annotation list) list; } -val analyze_file_dce : dce_config -> file_input -> file_dce_result +(* Side effects at the edge *) +let run_analysis ~config ~cmt_files = + (* Pure: analyze all files *) + let project_state = + cmt_files + |> List.fold_left (fun state file -> + analyze_file config (file_state_for file) state (load_cmt file) + ) empty_project_state + in + (* Pure: solve deadness *) + let result = solve_deadness config project_state in + (* Impure: report results *) + result.issues |> List.iter report_issue; + if config.write_annotations then + result.annotations_to_write |> List.iter write_annotations_to_file ``` -The implementation of `analyze_file_dce` should be expressible as composition of small, pure steps (collect annotations, collect decls and refs, resolve dependencies, solve deadness, derive issues/annotations). +--- -### 1.3 Project‑level pure API (end state) +## Refactor Tasks -End‑state project‑level API: +Each task should: +- ✅ Fix a real problem listed above +- ✅ Leave the code in a measurably better state +- ✅ Be testable (behavior preserved, but architecture improved) +- ❌ NOT add scaffolding that isn't immediately used -```ocaml -type project_input = { - config : dce_config; - files : file_input list; -} +### Task 1: Remove global "current file" context (P1) -type project_dce_result = { - per_file : (string * file_dce_result) list; (* keyed by source path *) - cross_file_issues : Common.issue list; (* e.g. circular deps, dead modules *) -} +**Value**: Makes it possible to process files concurrently or out of order. -val analyze_project_dce : project_input -> project_dce_result -``` +**Changes**: +- [ ] Create `DeadFileContext.t` type with `source_path`, `module_name`, `is_interface` fields +- [ ] Thread through `DeadCode.processCmt`, `DeadValue`, `DeadType`, `DeadCommon.addDeclaration_` +- [ ] Remove all reads of `Common.currentSrc`, `currentModule`, `currentModuleName` from DCE code +- [ ] Delete the globals (or mark as deprecated if still used by Exception/Arnold) -The actual implementation will be obtained incrementally by refactoring existing code; we do **not** introduce these types until they are immediately used in a small, behaviour‑preserving change. +**Test**: Run analysis on same files but vary the order - should get identical results. ---- +**Estimated effort**: Medium (touches ~10 functions, mostly mechanical) -## 2. Current Mutation and Order Dependencies (High‑Level) +### Task 2: Extract configuration into explicit value (P4) -This section summarises the main sources of mutation / order dependence that the tasks in §4 will address. +**Value**: Can run analysis with different configs without mutating globals. Can test with different configs. -### 2.1 Global “current file” context +**Changes**: +- [ ] Use the `DceConfig.t` already created, thread it through analysis functions +- [ ] Replace all `!Common.Cli.debug`, `runConfig.transitive`, etc. reads with `config.debug`, `config.run.transitive` +- [ ] Only `DceConfig.current()` reads globals; everything else uses explicit config -- `Common.currentSrc : string ref` -- `Common.currentModule : string ref` -- `Common.currentModuleName : Name.t ref` -- Set in `Reanalyze.loadCmtFile` before calling `DeadCode.processCmt`. -- Read by: - - `DeadCommon.addDeclaration_` (filters declarations by `!currentSrc`). - - `DeadType.addTypeDependenciesAcrossFiles` (decides interface vs implementation using `!currentSrc`). - - `DeadValue` (builds paths using `!currentModuleName`). +**Test**: Create two configs with different settings, run analysis with each - should respect the config, not read globals. -### 2.2 Global declaration / reference tables and binding state +**Estimated effort**: Medium (many small changes across multiple files) -In `DeadCommon`: -- `decls : decl PosHash.t` – all declarations. -- `ValueReferences.table` – value references. -- `TypeReferences.table` – type references. -- `Current.bindings`, `Current.lastBinding`, `Current.maxValuePosEnd` – per‑file binding/reporting state. -- `ProcessDeadAnnotations.positionsAnnotated` – global annotation map. -- `FileReferences.table` / `iterFilesFromRootsToLeaves` – cross‑file graph and ordering using `Hashtbl`s. -- `reportDead` – mutates global state, constructs orderings, and logs warnings directly. +### Task 3: Make `ProcessDeadAnnotations` state explicit (P3) -### 2.3 Per‑analysis mutable queues/sets +**Value**: Removes hidden global state. Makes annotation tracking testable. -- `DeadOptionalArgs.delayedItems` / `functionReferences`. -- `DeadException.delayedItems` / `declarations`. -- `DeadType.TypeDependencies.delayedItems`. -- `DeadModules.table`. +**Changes**: +- [ ] Change `ProcessDeadAnnotations` functions to take/return explicit `state` instead of mutating `positionsAnnotated` ref +- [ ] Thread `annotation_state` through `DeadCode.processCmt` +- [ ] Delete the global `positionsAnnotated` -All of these are refs or Hashtbls, updated during traversal and flushed later, with ordering mattering. +**Test**: Process two files "simultaneously" (two separate state values) - should not interfere. -### 2.4 CLI/config globals and logging / annotation I/O +**Estimated effort**: Small (well-scoped module) -- `Common.Cli` refs, `RunConfig.runConfig` mutation. -- `Log_.warning`, `Log_.item`, `EmitJson` calls inside analysis modules. -- `WriteDeadAnnotations` holding refs to current file and lines, writing directly during analysis. +### Task 4: Localize analysis tables (P2) - Part 1: Declarations ---- +**Value**: First step toward incremental analysis. Can analyze a subset of files with isolated state. -## 3. End‑State Summary +**Changes**: +- [ ] Change `DeadCommon.addDeclaration_` and friends to take `decl_state : decl PosHash.t` parameter +- [ ] Thread through `DeadCode.processCmt` - allocate fresh state, pass through, return updated state +- [ ] Accumulate per-file states in `Reanalyze.processCmtFiles` +- [ ] Delete global `DeadCommon.decls` -At the end of the refactor: +**Test**: Analyze files with separate decl tables - should not interfere. -- All DCE computations are pure: - - No `ref` / mutable `Hashtbl` in the core analysis path. - - No writes to global state from `Dead*` modules. - - No direct logging or file I/O from the dead‑code logic. -- Impure actions live only at the edges: - - CLI parsing (`Reanalyze.cli`). - - Discovering `cmt` / `cmti` files. - - Logging / JSON (`Log_`, `EmitJson`). - - Applying annotations to files (`WriteDeadAnnotations`). -- Results are order‑independent: - - Processing files in different orders yields the same `project_dce_result`. +**Estimated effort**: Medium (core data structure, many call sites) ---- +### Task 5: Localize analysis tables (P2) - Part 2: References -## 4. Refactor Tasks – From Mutable to Pure +**Value**: Completes the localization of analysis state. -This section lists **small, incremental changes**. Each checkbox is intended as a single PR/patch that: -- Starts from a clean, runnable state and returns to a clean, runnable state. -- Does **not** change user‑visible behaviour of DCE. -- Only introduces data structures that are immediately used to remove a specific mutation or implicit dependency. - -Think “replace one wheel at a time while the car is moving”: every step should feel like a polished state, not a half‑converted architecture. - -### 4.1 Make DCE configuration explicit (minimal surface) - -Goal: introduce an explicit configuration value for DCE **without** changing how internals read it yet. +**Changes**: +- [ ] Same pattern as Task 4 but for `ValueReferences.table` and `TypeReferences.table` +- [ ] Thread explicit `value_refs` and `type_refs` parameters +- [ ] Delete global reference tables -- [ ] Add a small `dce_config` record type (e.g. in `RunConfig.ml` or a new `DceConfig.ml`) that just wraps existing data, for example: - `type dce_config = { run : RunConfig.t; cli_debug : bool; cli_json : bool; cli_write : bool }` -- [ ] Add a helper `DceConfig.current () : dce_config` that reads from `RunConfig.runConfig` and `Common.Cli` and returns a value. -- [ ] Change `Reanalyze.runAnalysis` to take a `dce_config` parameter, but initially always pass `DceConfig.current ()` and keep all existing global reads unchanged. - -Result: a single, well‑typed configuration value is threaded at the top level, but internals still use the old globals. No behaviour change. - -### 4.2 Encapsulate global “current file” state (one module at a time) - -Goal: step‑wise removal of `Common.currentSrc`, `currentModule`, `currentModuleName` as implicit inputs. - -- [ ] Define a lightweight `file_ctx` record (e.g. in a new `DeadFileContext` module): - `type t = { source_path : string; module_name : Name.t; module_path : Name.t list; is_interface : bool }` -- [ ] In `Reanalyze.loadCmtFile`, build a `file_ctx` value *in addition to* updating `Common.current*` so behaviour stays identical. -- [ ] Update `DeadCommon.addDeclaration_` to take a `file_ctx` parameter and use it **only to replace** the check that currently uses `!currentSrc` / `!currentModule`. Call sites pass the new `file_ctx` while still relying on globals elsewhere. -- [ ] In a follow‑up patch, change `DeadType.addTypeDependenciesAcrossFiles` to take `is_interface` from `file_ctx` instead of reading `!Common.currentSrc`. Again, call sites pass `file_ctx`. -- [ ] Update `DeadValue` call sites that construct paths (using `!Common.currentModuleName`) to accept `file_ctx` and use its `module_name` instead. -- [ ] Once all reads of `Common.currentSrc`, `currentModule`, `currentModuleName` in DCE code are replaced by fields from `file_ctx`, remove or deprecate these globals from the DCE path (they may still exist for other analyses). - -Each bullet above should be done as a separate patch touching only a small set of functions. - -### 4.3 Localise `Current.*` binding/reporting state - -Goal: remove `DeadCommon.Current` globals for binding/reporting by threading explicit state. +**Test**: Same as Task 4. -- [x] Add `Current.state`/helpers in `DeadCommon` and thread it through `DeadValue` (bindings) and `DeadException.markAsUsed` so `last_binding` is no longer a global ref. -- [x] Replace `Current.maxValuePosEnd` with a per‑reporting state in `Decl.report`/`reportDead` (now encapsulated in `ReportingContext`). -- [x] Replace `addValueReference_state` with `addValueReference ~binding` so reference bookkeeping no longer threads `Current.state` or returns a fake “updated state”. -- [x] Follow‑up: remove the remaining local `Current.state ref` in `BindingContext` by making traversals return an updated binding context (pure, no mutation). At that point, binding context becomes an explicit input/output of the traversal, not hidden state. - -### 4.4 Make `ProcessDeadAnnotations` state explicit - -Goal: turn `ProcessDeadAnnotations.positionsAnnotated` into an explicit value rather than a hidden global. - -- [ ] Introduce: - ```ocaml - module ProcessDeadAnnotations : sig - type state - val empty : state - (* new, pure API; existing API kept temporarily *) - end - ``` -- [ ] Add pure variants of the mutating functions: - - `annotateGenType' : state -> Lexing.position -> state` - - `annotateDead' : state -> Lexing.position -> state` - - `annotateLive' : state -> Lexing.position -> state` - - `isAnnotated*' : state -> Lexing.position -> bool` - leaving the old global‑based functions in place for now. -- [ ] Change `ProcessDeadAnnotations.structure` and `.signature` to: - - Take an explicit `state`, - - Call the `'` functions, - - Return the updated `state` along with the original AST. -- [ ] Update `DeadCode.processCmt` to allocate a fresh `ProcessDeadAnnotations.state` per file, thread it through the structure/signature walkers, and store it alongside other per‑file information. -- [ ] Once all users have switched to the state‑passing API, delete or deprecate direct uses of `positionsAnnotated` and the old global helpers. - -### 4.5 De‑globalize `DeadOptionalArgs` (minimal slice) - -Goal: remove the `delayedItems` and `functionReferences` refs, one small step at a time. - -- [ ] Introduce in `DeadOptionalArgs`: - ```ocaml - type state = { - delayed_items : item list; - function_refs : (Lexing.position * Lexing.position) list; - } - - let empty_state = { delayed_items = []; function_refs = [] } - ``` -- [ ] Add pure variants: - - `addReferences' : state -> ... -> state` - - `addFunctionReference' : state -> ... -> state` - - `forceDelayedItems' : state -> decls -> state * decls` - and make the existing functions delegate to these, passing a hidden global `state` for now. -- [ ] Update `DeadValue` to allocate a `DeadOptionalArgs.state` per file and call the `'` variants, **without** changing behaviour (the old global still exists for other callers until fully migrated). -- [ ] Update `Reanalyze.runAnalysis` (or the relevant driver) to call `forceDelayedItems'` with an explicit state instead of `DeadOptionalArgs.forceDelayedItems`. -- [ ] When all call sites use the new API, remove `delayedItems` and `functionReferences` refs and the global wrapper. +**Estimated effort**: Medium (similar to Task 4) -### 4.6 De‑globalize `DeadException` (minimal slice) +### Task 6: Localize delayed processing queues (P3) -Goal: make delayed exception uses explicit. +**Value**: Removes order dependence. Makes analysis deterministic. -- [ ] Introduce: - ```ocaml - type state = { - delayed_items : item list; - declarations : (Path.t, Location.t) Hashtbl.t; - } +**Changes**: +- [ ] `DeadOptionalArgs`: Thread explicit `state` with `delayed_items` and `function_refs`, delete global refs +- [ ] `DeadException`: Thread explicit `state` with `delayed_items` and `declarations`, delete global refs +- [ ] `DeadType.TypeDependencies`: Thread explicit `type_deps_state`, delete global ref +- [ ] Update `forceDelayedItems` calls to operate on explicit state - val empty_state : unit -> state - ``` -- [ ] Add state‑passing versions of `add`, `markAsUsed`, and `forceDelayedItems` that operate on a `state` value, with old variants delegating to them using a hidden global state. -- [ ] Update `DeadValue` and any other DCE callers to allocate a `DeadException.state` per file and use the state‑passing API. -- [ ] Replace the global `DeadException.forceDelayedItems` call in `Reanalyze.runAnalysis` with a call on the explicit state. -- [ ] Remove the old globals once all uses go through the new API. +**Test**: Process files in different orders - delayed items should be processed consistently. -### 4.7 Localise `decls`, `ValueReferences`, and `TypeReferences` - -Goal: move the main declaration and reference tables out of global scope, **one structure at a time**. - -- [ ] For `decls`: - - Introduce `type decl_state = decl PosHash.t`. - - Change `addDeclaration_` to take and return a `decl_state`, with an adapter that still passes the existing global `decls` to keep behaviour unchanged. - - Thread `decl_state` through `DeadValue`, `DeadType`, and `DeadCode.processCmt`, returning the updated `decl_state` per file. -- [ ] For value references: - - Introduce `type value_refs_state = PosSet.t PosHash.t`. - - Parameterise `ValueReferences.add` / `find` over `value_refs_state`, with wrappers that still use the global table. - - Thread `value_refs_state` through the same paths that currently use `ValueReferences.table`. -- [ ] For type references: - - Introduce `type type_refs_state = PosSet.t PosHash.t`. - - Parameterise `TypeReferences.add` / `find` over `type_refs_state` in the same way. -- [ ] Once all three structures are threaded explicitly per file, delete the global `decls`, `ValueReferences.table`, and `TypeReferences.table` in DCE code and construct fresh instances in `DeadCode.processCmt`. - -Each of these bullets should be implemented as a separate patch (decls first, then value refs, then type refs). - -### 4.8 Pure `TypeDependencies` in `DeadType` - -Goal: make `DeadType.TypeDependencies` operate on explicit state rather than a ref. - -- [ ] Introduce `type type_deps_state = (Location.t * Location.t) list` (or a small record) to represent delayed type dependency pairs. -- [ ] Change `TypeDependencies.add`, `clear`, and `forceDelayedItems` to take and return a `type_deps_state` instead of writing to a ref, keeping wrappers that still use the old global for the first patch. -- [ ] Update `DeadType.addDeclaration` and any other callers to thread a `type_deps_state` along with other per‑file state. -- [ ] Remove the global `delayedItems` ref once all calls have been migrated to the new API. - -### 4.9 De‑globalize `DeadModules` - -Goal: turn module deadness tracking into project‑level data passed explicitly. - -- [ ] Introduce `type module_dead_state = (Name.t, (bool * Location.t)) Hashtbl.t` in `DeadModules` and keep the existing `table` as `module_dead_state` for the first patch. -- [ ] Change `markDead` and `markLive` to take a `module_dead_state` and operate on it, with wrappers that pass the global `table`. -- [ ] Update the calls in deadness resolution (in `DeadCommon.resolveRecursiveRefs`) to use a `module_dead_state` passed in from the caller. -- [ ] Replace `DeadModules.checkModuleDead` so that it: - - Takes `module_dead_state` and file name, - - Returns a list of `Common.issue` values, leaving logging to the caller. -- [ ] Once all uses go through explicit state, remove the global `table` and construct a `module_dead_state` in a project‑level driver. - -### 4.10 Pure `FileReferences` and `iterFilesFromRootsToLeaves` - -Goal: make file ordering and cross‑file references explicit and order‑independent. - -- [ ] Extract `FileReferences.table` into a new type `file_refs_state` (e.g. `string -> FileSet.t`) and parameterise `add`, `addFile`, and `iter` over this state, with wrappers retaining the old global behaviour initially. -- [ ] Rewrite `iterFilesFromRootsToLeaves` to: - - Take a `file_refs_state`, - - Return an ordered list of file names (plus any diagnostics for circular dependencies), - - Avoid any hidden mutation beyond local variables. -- [ ] Update `DeadCommon.reportDead` to: - - Call the new pure `iterFilesFromRootsToLeaves`, - - Use the returned ordering instead of relying on a global `orderedFiles` table. -- [ ] Remove the global `FileReferences.table` once the project‑level driver constructs and passes in a `file_refs_state`. - -### 4.11 Separate deadness solving from reporting +**Estimated effort**: Medium (3 modules, each similar to Task 3) -Goal: compute which declarations are dead/live purely, then render/report in a separate step. +### Task 7: Localize file/module tracking (P2 + P3) -- [ ] Extract the recursive deadness logic (`resolveRecursiveRefs`, `declIsDead`, plus the bookkeeping that populates `deadDeclarations`) into a function that: - - Takes a fully built project‑level state (decls, refs, annotations, module_dead_state), - - Returns the same state augmented with dead/live flags and a list of “dead declaration” descriptors. -- [ ] Replace `Decl.report`’s direct calls to `Log_.warning` with construction of `Common.issue` values, collected into a list. -- [ ] Change `DeadCommon.reportDead` to: - - Return the list of `issue`s instead of logging them, - - Leave logging and JSON emission to the caller (`Reanalyze`). - -This should only be done after the relevant state has been made explicit by earlier tasks. +**Value**: Removes last major global state. Makes cross-file analysis explicit. -### 4.12 Make CLI / configuration explicit internally +**Changes**: +- [ ] `FileReferences`: Replace global `table` with explicit `file_refs_state` parameter +- [ ] `DeadModules`: Replace global `table` with explicit `module_state` parameter +- [ ] Thread both through analysis pipeline +- [ ] `iterFilesFromRootsToLeaves`: take explicit state, return ordered file list (pure) -Goal: stop reading `Common.Cli.*` and `RunConfig.runConfig` directly inside DCE code. +**Test**: Build file reference graph in isolation, verify topological ordering is correct. -- [ ] Replace direct reads in `DeadCommon`, `DeadValue`, `DeadType`, `DeadOptionalArgs`, `DeadModules` with fields from the `dce_config` value introduced in 4.1, passed down from `Reanalyze`. -- [ ] Ensure each function that previously reached into globals now takes the specific configuration flags it needs (or a narrowed config record), minimising the surface area. -- [ ] Once all reads have been converted, keep `DceConfig.current ()` as the only place that touches the global `RunConfig` and `Common.Cli` for DCE. +**Estimated effort**: Medium (cross-file logic, but well-contained) -### 4.13 Isolate logging / JSON and annotation writing +### Task 8: Separate analysis from reporting (P5) -Goal: keep the core analysis free of side‑effects and move all I/O into thin wrappers. +**Value**: Core analysis is now pure. Can get results as data. Can test without I/O. -- [ ] Identify all calls to `Log_.warning`, `Log_.item`, and `EmitJson` in DCE modules and replace them with construction of `Common.issue` values (or similar purely data‑oriented records). -- [ ] Add a `DceReporter` (or reuse `Reanalyze`) that: - - Takes `issue list`, - - Emits logs / JSON using `Log_` and `EmitJson`. -- [ ] In `WriteDeadAnnotations`, introduce a pure function that, given per‑file deadness information, computes the textual updates to apply. Keep file I/O in a separate `apply_updates` wrapper. -- [ ] Update `Reanalyze.runAnalysis` to: - - Call the pure analysis pipeline, - - Then call `DceReporter` and `WriteDeadAnnotations.apply_updates` as needed. +**Changes**: +- [ ] `DeadCommon.reportDead`: Return `issue list` instead of calling `Log_.warning` +- [ ] `Decl.report`: Return `issue` instead of logging +- [ ] Remove all `Log_.warning`, `Log_.item`, `EmitJson` calls from `Dead*.ml` modules +- [ ] `Reanalyze.runAnalysis`: Call pure analysis, then separately report issues -### 4.14 Verify order independence +**Test**: Run analysis, capture result list, verify no I/O side effects occurred. -Goal: ensure the new pure pipeline is not order‑dependent. +**Estimated effort**: Medium (many logging call sites, but mechanical) -- [ ] Add tests (or property checks) that: - - Compare `project_dce_result` when files are processed in different orders, - - Verify deadness decisions for declarations do not change with traversal order. -- [ ] If order dependence is discovered, treat it as a bug and introduce explicit data flow to remove it (document any necessary constraints in this plan). +### Task 9: Separate annotation computation from file writing (P5) + +**Value**: Can compute what to write without actually writing. Testable. + +**Changes**: +- [ ] `WriteDeadAnnotations`: Split into pure `compute_annotations` and impure `write_to_files` +- [ ] Pure function takes deadness results, returns `(filepath * line_annotation list) list` +- [ ] Impure function takes that list and does file I/O +- [ ] Remove file I/O from analysis path + +**Test**: Compute annotations, verify correct without touching filesystem. + +**Estimated effort**: Small (single module) + +### Task 10: Integration and order-independence verification + +**Value**: Verify the refactor achieved its goals. + +**Changes**: +- [ ] Write property test: process files in random orders, verify identical results +- [ ] Write test: analyze with different configs, verify each is respected +- [ ] Write test: analyze subset of files without initializing globals +- [ ] Document the new architecture and API + +**Test**: The tests are the task. + +**Estimated effort**: Small (mostly writing tests) --- -## 5. Suggested Execution Order +## Execution Strategy + +**Recommended order**: 1 → 2 → 3 → 4 → 5 → 6 → 7 → 8 → 9 → 10 + +**Why this order?** +- Tasks 1-2 remove implicit dependencies (file context, config) - these are foundational +- Tasks 3-7 localize global state - can be done incrementally once inputs are explicit +- Tasks 8-9 separate pure/impure - can only do this once state is local +- Task 10 validates everything + +**Alternative**: Could do 3-7 in any order (they're mostly independent). + +**Time estimate**: +- Best case (everything goes smoothly): 2-3 days +- Realistic (with bugs/complications): 1 week +- Worst case (major architectural issues): 2 weeks + +--- + +## Success Criteria + +After all tasks: + +✅ **No global mutable state in analysis path** +- No `ref` or mutable `Hashtbl` in `Dead*.ml` modules +- All state is local or explicitly threaded + +✅ **Order independence** +- Processing files in any order gives identical results +- Property test verifies this -Recommended rough order of tasks (each remains independent and small): +✅ **Pure analysis function** +- Can call analysis and get results as data +- No side effects (logging, file I/O) during analysis -1. 4.1 – Introduce and thread `dce_config` at the top level. -2. 4.2 – Start passing explicit `file_ctx` and remove `current*` reads. -3. 4.3 / 4.4 – Localise binding state and annotation state. -4. 4.5 / 4.6 / 4.7 / 4.8 – De‑globalize optional args, exceptions, decls/refs, and type dependencies in small slices. -5. 4.9 / 4.10 – Make file/module state explicit and pure. -6. 4.11 – Separate deadness solving from reporting, returning issues instead of logging. -7. 4.12 / 4.13 – Remove remaining global config/logging/annotation side‑effects. -8. 4.14 – Add and maintain order‑independence tests. +✅ **Incremental analysis possible** +- Can create empty state and analyze just one file +- Can update state with new file without reanalyzing everything -Each checkbox above should be updated to `[x]` as the corresponding change lands, keeping the codebase runnable and behaviour‑preserving after every step. +✅ **Testable** +- Can test analysis without mocking I/O +- Can test with different configs without mutating globals +- Can test with isolated state From 72edbe99352b70af0773565c40b6e98ccfceb068 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 5 Dec 2025 16:38:02 +0100 Subject: [PATCH 6/8] refactor(dce): extract configuration into explicit value (Task 2) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Replace global config reads with explicit ~config parameter threading throughout the DCE analysis pipeline. This makes the analysis pure and testable with different configurations. ## Changes ### New module - DceConfig: Encapsulates DCE configuration (cli + run config) - DceConfig.current() captures global state once - All analysis functions now take explicit ~config parameter ### DCE Analysis (fully pure - no global reads) - DeadCode: threads config to all Dead* modules - DeadValue: replaced ~15 !Cli.debug reads with config.cli.debug - DeadType: replaced ~7 !Cli.debug reads with config.cli.debug - DeadOptionalArgs: takes ~config, passes to Log_.warning - DeadModules: uses config.run.transitive - DeadCommon: threads config through reporting pipeline - WriteDeadAnnotations: uses config.cli.write/json - ProcessDeadAnnotations: uses config.cli.live_names/live_paths ### Logging infrastructure - Log_.warning: now requires ~config (no optional) - Log_.logIssue: now requires ~config (no optional) - Log_.Stats.report: now requires ~config (no optional) - Consistent API - no conditional logic on Some/None ### Non-DCE analyses (call DceConfig.current() at use sites) - Exception: 4 call sites updated - Arnold: 7 call sites updated - TODO: Thread config through these for full purity ### Other - Common.ml: removed unused lineAnnotationStr field - Reanalyze: single DceConfig.current() call at entry point - DEADCODE_REFACTOR_PLAN.md: updated Task 2, added verification task ## Impact ✅ DCE analysis is now pure - takes explicit config, no global reads ✅ All config parameters required (zero 'config option' types) ✅ Can run analysis with different configs without mutating globals ✅ All tests pass - no regressions ## Remaining Work (Task 2) - Thread config through Exception/Arnold to eliminate DceConfig.current() - Verify zero DceConfig.current() calls in analysis code Signed-off-by: Cursor AI Signed-off-by: Cristiano Calcagno --- AGENTS.md | 2 + analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md | 34 +++++-- analysis/reanalyze/src/Arnold.ml | 14 +-- analysis/reanalyze/src/DceConfig.ml | 34 +++++++ analysis/reanalyze/src/DeadCode.ml | 19 ++-- analysis/reanalyze/src/DeadCommon.ml | 99 ++++++++++--------- analysis/reanalyze/src/DeadException.ml | 13 +-- analysis/reanalyze/src/DeadModules.ml | 18 ++-- analysis/reanalyze/src/DeadOptionalArgs.ml | 14 +-- analysis/reanalyze/src/DeadType.ml | 43 ++++---- analysis/reanalyze/src/DeadValue.ml | 87 ++++++++-------- analysis/reanalyze/src/Exception.ml | 8 +- analysis/reanalyze/src/Log_.ml | 22 ++--- analysis/reanalyze/src/Reanalyze.ml | 38 +++---- .../reanalyze/src/WriteDeadAnnotations.ml | 23 ++--- analysis/src/DceCommand.ml | 3 +- 16 files changed, 276 insertions(+), 195 deletions(-) create mode 100644 analysis/reanalyze/src/DceConfig.ml diff --git a/AGENTS.md b/AGENTS.md index dcf296590f..f1cfc63048 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -44,6 +44,8 @@ The Makefile’s targets build on each other in this order: - **Use underscore patterns carefully** - Don't use `_` patterns as lazy placeholders for new language features that then get forgotten. Only use them when you're certain the value should be ignored for that specific case. Ensure all new language features are handled correctly and completely across all compiler layers - **Avoid `let _ = …` for side effects** - If you need to call a function only for its side effects, use `ignore expr` (or bind the result and thread state explicitly). Do not write `let _ = expr in ()`, and do not discard stateful results—plumb them through instead. +- **Don't use unit `()` with mandatory labeled arguments** - When a function has a mandatory labeled argument (like `~config`), don't add a trailing `()` parameter. The labeled argument already prevents accidental partial application. Only use `()` when all parameters are optional and you need to force evaluation. Example: `let forceDelayedItems ~config = ...` not `let forceDelayedItems ~config () = ...` + - **Be careful with similar constructor names across different IRs** - Note that `Lam` (Lambda IR) and `Lambda` (typed lambda) have variants with similar constructor names like `Ltrywith`, but they represent different things in different compilation phases. - **Avoid warning suppressions** - Never use `[@@warning "..."]` to silence warnings. Instead, fix the underlying issue properly diff --git a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md index 9d7dc30d5f..a4f6ec3081 100644 --- a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md +++ b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md @@ -149,13 +149,17 @@ Each task should: **Value**: Can run analysis with different configs without mutating globals. Can test with different configs. **Changes**: -- [ ] Use the `DceConfig.t` already created, thread it through analysis functions -- [ ] Replace all `!Common.Cli.debug`, `runConfig.transitive`, etc. reads with `config.debug`, `config.run.transitive` -- [ ] Only `DceConfig.current()` reads globals; everything else uses explicit config +- [x] ~~Use the `DceConfig.t` already created, thread it through DCE analysis functions~~ +- [x] ~~Replace all DCE code's `!Common.Cli.debug`, `runConfig.transitive`, etc. reads with `config.debug`, `config.run.transitive`~~ +- [x] ~~Make all config parameters required (not optional) - no `config option` anywhere~~ +- [ ] **Thread config through Exception and Arnold analyses** - they currently call `DceConfig.current()` at each use site +- [ ] **Single entry point**: Only `Reanalyze.runAnalysisAndReport` should call `DceConfig.current()` once, then pass explicit config everywhere + +**Status**: DCE code complete ✅. Exception/Arnold still need threading. **Test**: Create two configs with different settings, run analysis with each - should respect the config, not read globals. -**Estimated effort**: Medium (many small changes across multiple files) +**Estimated effort**: Medium (DCE done; Exception/Arnold similar effort) ### Task 3: Make `ProcessDeadAnnotations` state explicit (P3) @@ -253,7 +257,20 @@ Each task should: **Estimated effort**: Small (single module) -### Task 10: Integration and order-independence verification +### Task 10: Verify zero `DceConfig.current()` calls in analysis code + +**Value**: Enforce purity - no hidden global reads. + +**Changes**: +- [ ] Verify `DceConfig.current()` only called in `Reanalyze.runAnalysisAndReport` (entry point) +- [ ] Verify no calls to `DceConfig.current()` in `Dead*.ml`, `Exception.ml`, `Arnold.ml` analysis code +- [ ] All analysis functions take explicit `~config` parameter + +**Test**: `grep -r "DceConfig.current" analysis/reanalyze/src/{Dead,Exception,Arnold}.ml` returns zero results. + +**Estimated effort**: Trivial (verification only, assuming Task 2 complete) + +### Task 11: Integration and order-independence verification **Value**: Verify the refactor achieved its goals. @@ -271,13 +288,15 @@ Each task should: ## Execution Strategy -**Recommended order**: 1 → 2 → 3 → 4 → 5 → 6 → 7 → 8 → 9 → 10 +**Recommended order**: 1 → 2 (complete all analyses) → 3 → 4 → 5 → 6 → 7 → 8 → 9 → 10 (verify) → 11 (test) **Why this order?** - Tasks 1-2 remove implicit dependencies (file context, config) - these are foundational +- Task 2 must be **fully complete** (DCE + Exception + Arnold) before proceeding - Tasks 3-7 localize global state - can be done incrementally once inputs are explicit - Tasks 8-9 separate pure/impure - can only do this once state is local -- Task 10 validates everything +- Task 10 verifies no global config reads remain +- Task 11 validates everything **Alternative**: Could do 3-7 in any order (they're mostly independent). @@ -295,6 +314,7 @@ After all tasks: ✅ **No global mutable state in analysis path** - No `ref` or mutable `Hashtbl` in `Dead*.ml` modules - All state is local or explicitly threaded +- **Zero `DceConfig.current()` calls in analysis code** - only at entry point ✅ **Order independence** - Processing files in any order gives identical results diff --git a/analysis/reanalyze/src/Arnold.ml b/analysis/reanalyze/src/Arnold.ml index d3a1677e50..36d01ca1d1 100644 --- a/analysis/reanalyze/src/Arnold.ml +++ b/analysis/reanalyze/src/Arnold.ml @@ -111,7 +111,7 @@ module Stats = struct incr nCacheChecks; if hit then incr nCacheHits; if !Common.Cli.debug then - Log_.warning ~forStats:false ~loc + Log_.warning ~config:(DceConfig.current ()) ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -125,7 +125,7 @@ module Stats = struct let logResult ~functionCall ~loc ~resString = if !Common.Cli.debug then - Log_.warning ~forStats:false ~loc + Log_.warning ~config:(DceConfig.current ()) ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -610,7 +610,7 @@ module ExtendFunctionTable = struct then ( functionTable |> FunctionTable.addFunction ~functionName; if !Common.Cli.debug then - Log_.warning ~forStats:false ~loc + Log_.warning ~config:(DceConfig.current ()) ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -632,7 +632,8 @@ module ExtendFunctionTable = struct functionTable |> FunctionTable.addLabelToKind ~functionName ~label; if !Common.Cli.debug then - Log_.warning ~forStats:false ~loc + Log_.warning ~config:(DceConfig.current ()) ~forStats:false + ~loc (Termination { termination = TerminationAnalysisInternal; @@ -699,7 +700,8 @@ module CheckExpressionWellFormed = struct functionTable |> FunctionTable.addLabelToKind ~functionName ~label; if !Common.Cli.debug then - Log_.warning ~forStats:false ~loc:body.exp_loc + Log_.warning ~config:(DceConfig.current ()) + ~forStats:false ~loc:body.exp_loc (Termination { termination = TerminationAnalysisInternal; @@ -873,7 +875,7 @@ module Compile = struct newFunctionName; newFunctionDefinition.body <- Some (vb_expr |> expression ~ctx:newCtx); if !Common.Cli.debug then - Log_.warning ~forStats:false ~loc:pat_loc + Log_.warning ~config:(DceConfig.current ()) ~forStats:false ~loc:pat_loc (Termination { termination = TerminationAnalysisInternal; diff --git a/analysis/reanalyze/src/DceConfig.ml b/analysis/reanalyze/src/DceConfig.ml new file mode 100644 index 0000000000..f3a32c8bab --- /dev/null +++ b/analysis/reanalyze/src/DceConfig.ml @@ -0,0 +1,34 @@ +(** Configuration for dead code elimination analysis. + + This module encapsulates all configuration needed for DCE, + gathered from RunConfig and CLI flags. *) + +type cli_config = { + debug: bool; + ci: bool; + json: bool; + write: bool; + live_names: string list; + live_paths: string list; + exclude_paths: string list; +} + +type t = {run: RunConfig.t; cli: cli_config} + +(** Capture the current DCE configuration from global state. + + This reads from [RunConfig.runConfig] and [Common.Cli] refs + to produce a single immutable configuration value. *) +let current () = + let cli = + { + debug = !Common.Cli.debug; + ci = !Common.Cli.ci; + json = !Common.Cli.json; + write = !Common.Cli.write; + live_names = !Common.Cli.liveNames; + live_paths = !Common.Cli.livePaths; + exclude_paths = !Common.Cli.excludePaths; + } + in + {run = Common.runConfig; cli} diff --git a/analysis/reanalyze/src/DeadCode.ml b/analysis/reanalyze/src/DeadCode.ml index 63323a88d2..8dfa4d9815 100644 --- a/analysis/reanalyze/src/DeadCode.ml +++ b/analysis/reanalyze/src/DeadCode.ml @@ -1,32 +1,33 @@ open DeadCommon -let processSignature ~doValues ~doTypes (signature : Types.signature) = +let processSignature ~config ~doValues ~doTypes (signature : Types.signature) = signature |> List.iter (fun sig_item -> - DeadValue.processSignatureItem ~doValues ~doTypes + DeadValue.processSignatureItem ~config ~doValues ~doTypes ~moduleLoc:Location.none ~path:[!Common.currentModuleName] sig_item) -let processCmt ~cmtFilePath (cmt_infos : Cmt_format.cmt_infos) = +let processCmt ~config ~cmtFilePath (cmt_infos : Cmt_format.cmt_infos) = (match cmt_infos.cmt_annots with | Interface signature -> - ProcessDeadAnnotations.signature signature; - processSignature ~doValues:true ~doTypes:true signature.sig_type + ProcessDeadAnnotations.signature ~config signature; + processSignature ~config ~doValues:true ~doTypes:true signature.sig_type | Implementation structure -> let cmtiExists = Sys.file_exists ((cmtFilePath |> Filename.remove_extension) ^ ".cmti") in - ProcessDeadAnnotations.structure ~doGenType:(not cmtiExists) structure; - processSignature ~doValues:true ~doTypes:false structure.str_type; + ProcessDeadAnnotations.structure ~config ~doGenType:(not cmtiExists) + structure; + processSignature ~config ~doValues:true ~doTypes:false structure.str_type; let doExternals = (* This is already handled at the interface level, avoid issues in inconsistent locations https://github.com/BuckleScript/syntax/pull/54 Ideally, the handling should be less location-based, just like other language aspects. *) false in - DeadValue.processStructure ~doTypes:true ~doExternals + DeadValue.processStructure ~config ~doTypes:true ~doExternals ~cmt_value_dependencies:cmt_infos.cmt_value_dependencies structure | _ -> ()); - DeadType.TypeDependencies.forceDelayedItems (); + DeadType.TypeDependencies.forceDelayedItems ~config; DeadType.TypeDependencies.clear () diff --git a/analysis/reanalyze/src/DeadCommon.ml b/analysis/reanalyze/src/DeadCommon.ml index d75c71f1bf..d525c6cac8 100644 --- a/analysis/reanalyze/src/DeadCommon.ml +++ b/analysis/reanalyze/src/DeadCommon.ml @@ -18,7 +18,6 @@ module Config = struct let warnOnCircularDependencies = false end - let rec checkSub s1 s2 n = n <= 0 || (try s1.[n] = s2.[n] with Invalid_argument _ -> false) @@ -92,11 +91,11 @@ let declGetLoc decl = in {Location.loc_start; loc_end = decl.posEnd; loc_ghost = false} -let addValueReference ~(binding : Location.t) ~addFileReference +let addValueReference ~config ~(binding : Location.t) ~addFileReference ~(locFrom : Location.t) ~(locTo : Location.t) : unit = let effectiveFrom = if binding = Location.none then locFrom else binding in if not effectiveFrom.loc_ghost then ( - if !Cli.debug then + if config.DceConfig.cli.debug then Log_.item "addValueReference %s --> %s@." (effectiveFrom.loc_start |> posToString) (locTo.loc_start |> posToString); @@ -107,7 +106,7 @@ let addValueReference ~(binding : Location.t) ~addFileReference && effectiveFrom.loc_start.pos_fname <> locTo.loc_start.pos_fname then FileReferences.add effectiveFrom locTo) -let iterFilesFromRootsToLeaves iterFun = +let iterFilesFromRootsToLeaves ~config iterFun = (* For each file, the number of incoming references *) let inverseReferences = (Hashtbl.create 1 : (string, int) Hashtbl.t) in (* For each number of incoming references, the files *) @@ -171,7 +170,7 @@ let iterFilesFromRootsToLeaves iterFun = {Location.none with loc_start = pos; loc_end = pos} in if Config.warnOnCircularDependencies then - Log_.warning ~loc + Log_.warning ~config ~loc (Circular { message = @@ -208,7 +207,7 @@ module ProcessDeadAnnotations = struct let annotateLive (pos : Lexing.position) = PosHash.replace positionsAnnotated pos Live - let processAttributes ~doGenType ~name ~pos attributes = + let processAttributes ~config ~doGenType ~name ~pos attributes = let getPayloadFun f = attributes |> Annotation.getAttributePayload f in let getPayload (x : string) = attributes |> Annotation.getAttributePayload (( = ) x) @@ -220,7 +219,7 @@ module ProcessDeadAnnotations = struct if getPayload WriteDeadAnnotations.deadAnnotation <> None then pos |> annotateDead; let nameIsInLiveNamesOrPaths () = - !Cli.liveNames |> List.mem name + config.DceConfig.cli.live_names |> List.mem name || let fname = match Filename.is_relative pos.pos_fname with @@ -228,7 +227,7 @@ module ProcessDeadAnnotations = struct | false -> Filename.concat (Sys.getcwd ()) pos.pos_fname in let fnameLen = String.length fname in - !Cli.livePaths + config.DceConfig.cli.live_paths |> List.exists (fun prefix -> String.length prefix <= fnameLen && @@ -240,7 +239,7 @@ module ProcessDeadAnnotations = struct if attributes |> Annotation.isOcamlSuppressDeadWarning then pos |> annotateLive - let collectExportLocations ~doGenType = + let collectExportLocations ~config ~doGenType = let super = Tast_mapper.default in let currentlyDisableWarnings = ref false in let value_binding self @@ -250,7 +249,7 @@ module ProcessDeadAnnotations = struct | Tpat_alias ({pat_desc = Tpat_any}, id, {loc = {loc_start = pos}}) -> if !currentlyDisableWarnings then pos |> annotateLive; vb_attributes - |> processAttributes ~doGenType ~name:(id |> Ident.name) ~pos + |> processAttributes ~config ~doGenType ~name:(id |> Ident.name) ~pos | _ -> ()); super.value_binding self value_binding in @@ -261,7 +260,7 @@ module ProcessDeadAnnotations = struct |> List.iter (fun ({ld_attributes; ld_loc} : Typedtree.label_declaration) -> toplevelAttrs @ ld_attributes - |> processAttributes ~doGenType:false ~name:"" + |> processAttributes ~config ~doGenType:false ~name:"" ~pos:ld_loc.loc_start) | Ttype_variant constructorDeclarations -> constructorDeclarations @@ -277,13 +276,13 @@ module ProcessDeadAnnotations = struct (fun ({ld_attributes; ld_loc} : Typedtree.label_declaration) -> toplevelAttrs @ cd_attributes @ ld_attributes - |> processAttributes ~doGenType:false ~name:"" + |> processAttributes ~config ~doGenType:false ~name:"" ~pos:ld_loc.loc_start) flds | Cstr_tuple _ -> () in toplevelAttrs @ cd_attributes - |> processAttributes ~doGenType:false ~name:"" + |> processAttributes ~config ~doGenType:false ~name:"" ~pos:cd_loc.loc_start) | _ -> ()); super.type_kind self typeKind @@ -299,7 +298,7 @@ module ProcessDeadAnnotations = struct Typedtree.value_description) = if !currentlyDisableWarnings then pos |> annotateLive; val_attributes - |> processAttributes ~doGenType ~name:(val_id |> Ident.name) ~pos; + |> processAttributes ~config ~doGenType ~name:(val_id |> Ident.name) ~pos; super.value_description self value_description in let structure_item self (item : Typedtree.structure_item) = @@ -341,21 +340,23 @@ module ProcessDeadAnnotations = struct value_description; } - let structure ~doGenType structure = - let collectExportLocations = collectExportLocations ~doGenType in + let structure ~config ~doGenType structure = + let collectExportLocations = collectExportLocations ~config ~doGenType in structure |> collectExportLocations.structure collectExportLocations |> ignore - let signature signature = - let collectExportLocations = collectExportLocations ~doGenType:true in + let signature ~config signature = + let collectExportLocations = + collectExportLocations ~config ~doGenType:true + in signature |> collectExportLocations.signature collectExportLocations |> ignore end -let addDeclaration_ ?posEnd ?posStart ~declKind ~path ~(loc : Location.t) - ?(posAdjustment = Nothing) ~moduleLoc (name : Name.t) = +let addDeclaration_ ~config ?posEnd ?posStart ~declKind ~path + ~(loc : Location.t) ?(posAdjustment = Nothing) ~moduleLoc (name : Name.t) = let pos = loc.loc_start in let posStart = match posStart with @@ -376,7 +377,7 @@ let addDeclaration_ ?posEnd ?posStart ~declKind ~path ~(loc : Location.t) (not loc.loc_ghost) && (!currentSrc = pos.pos_fname || !currentModule == "*include*") then ( - if !Cli.debug then + if config.DceConfig.cli.debug then Log_.item "add%sDeclaration %s %s path:%s@." (declKind |> DeclKind.toString) (name |> Name.toString) (pos |> posToString) (path |> Path.toString); @@ -395,14 +396,14 @@ let addDeclaration_ ?posEnd ?posStart ~declKind ~path ~(loc : Location.t) in PosHash.replace decls pos decl) -let addValueDeclaration ?(isToplevel = true) ~(loc : Location.t) ~moduleLoc - ?(optionalArgs = OptionalArgs.empty) ~path ~sideEffects name = +let addValueDeclaration ~config ?(isToplevel = true) ~(loc : Location.t) + ~moduleLoc ?(optionalArgs = OptionalArgs.empty) ~path ~sideEffects name = name - |> addDeclaration_ + |> addDeclaration_ ~config ~declKind:(Value {isToplevel; optionalArgs; sideEffects}) ~loc ~moduleLoc ~path -let emitWarning ~decl ~message deadWarning = +let emitWarning ~config ~decl ~message deadWarning = let loc = decl |> declGetLoc in let isToplevelValueWithSideEffects decl = match decl.declKind with @@ -416,13 +417,13 @@ let emitWarning ~decl ~message deadWarning = in let lineAnnotation = if shouldWriteLineAnnotation then - WriteDeadAnnotations.addLineAnnotation ~decl + WriteDeadAnnotations.addLineAnnotation ~config ~decl else None in decl.path |> Path.toModuleName ~isType:(decl.declKind |> DeclKind.isType) - |> DeadModules.checkModuleDead ~fileName:decl.pos.pos_fname; - Log_.warning ~loc + |> DeadModules.checkModuleDead ~config ~fileName:decl.pos.pos_fname; + Log_.warning ~config ~loc (DeadWarning { deadWarning; @@ -515,7 +516,7 @@ module Decl = struct ReportingContext.set_max_end ctx decl.posEnd; insideReportedValue - let report (ctx : ReportingContext.t) decl = + let report ~config (ctx : ReportingContext.t) decl = let insideReportedValue = decl |> isInsideReportedValue ctx in if decl.report then let name, message = @@ -563,13 +564,13 @@ module Decl = struct && (match decl.path with | name :: _ when name |> Name.isUnderscore -> Config.reportUnderscore | _ -> true) - && (runConfig.transitive || not (hasRefBelow ())) + && (config.DceConfig.run.transitive || not (hasRefBelow ())) in if shouldEmitWarning then ( decl.path |> Path.toModuleName ~isType:(decl.declKind |> DeclKind.isType) - |> DeadModules.checkModuleDead ~fileName:decl.pos.pos_fname; - emitWarning ~decl ~message name) + |> DeadModules.checkModuleDead ~config ~fileName:decl.pos.pos_fname; + emitWarning ~config ~decl ~message name) end let declIsDead ~refs decl = @@ -582,8 +583,10 @@ let declIsDead ~refs decl = let doReportDead pos = not (ProcessDeadAnnotations.isAnnotatedGenTypeOrDead pos) -let rec resolveRecursiveRefs ~checkOptionalArg ~deadDeclarations ~level - ~orderedFiles ~refs ~refsBeingResolved decl : bool = +let rec resolveRecursiveRefs ~config + ~checkOptionalArg:(checkOptionalArgFn : config:DceConfig.t -> decl -> unit) + ~deadDeclarations ~level ~orderedFiles ~refs ~refsBeingResolved decl : bool + = match decl.pos with | _ when decl.resolvedDead <> None -> if Config.recursiveDebug then @@ -627,7 +630,8 @@ let rec resolveRecursiveRefs ~checkOptionalArg ~deadDeclarations ~level in let xDeclIsDead = xDecl - |> resolveRecursiveRefs ~checkOptionalArg ~deadDeclarations + |> resolveRecursiveRefs ~config + ~checkOptionalArg:checkOptionalArgFn ~deadDeclarations ~level:(level + 1) ~orderedFiles ~refs:xRefs ~refsBeingResolved in @@ -640,7 +644,7 @@ let rec resolveRecursiveRefs ~checkOptionalArg ~deadDeclarations ~level decl.resolvedDead <- Some isDead; if isDead then ( decl.path - |> DeadModules.markDead + |> DeadModules.markDead ~config ~isType:(decl.declKind |> DeclKind.isType) ~loc:decl.moduleLoc; if not (decl.pos |> doReportDead) then decl.report <- false; @@ -648,15 +652,15 @@ let rec resolveRecursiveRefs ~checkOptionalArg ~deadDeclarations ~level if not (Decl.isToplevelValueWithSideEffects decl) then decl.pos |> ProcessDeadAnnotations.annotateDead) else ( - checkOptionalArg decl; + checkOptionalArgFn ~config decl; decl.path - |> DeadModules.markLive + |> DeadModules.markLive ~config ~isType:(decl.declKind |> DeclKind.isType) ~loc:decl.moduleLoc; if decl.pos |> ProcessDeadAnnotations.isAnnotatedDead then - emitWarning ~decl ~message:" is annotated @dead but is live" + emitWarning ~config ~decl ~message:" is annotated @dead but is live" IncorrectDeadAnnotation); - if !Cli.debug then + if config.DceConfig.cli.debug then let refsString = newRefs |> PosSet.elements |> List.map posToString |> String.concat ", " @@ -671,18 +675,21 @@ let rec resolveRecursiveRefs ~checkOptionalArg ~deadDeclarations ~level refsString level); isDead -let reportDead ~checkOptionalArg = +let reportDead ~config + ~checkOptionalArg:(checkOptionalArgFn : config:DceConfig.t -> decl -> unit) + = let iterDeclInOrder ~deadDeclarations ~orderedFiles decl = let refs = match decl |> Decl.isValue with | true -> ValueReferences.find decl.pos | false -> TypeReferences.find decl.pos in - resolveRecursiveRefs ~checkOptionalArg ~deadDeclarations ~level:0 - ~orderedFiles ~refsBeingResolved:(ref PosSet.empty) ~refs decl + resolveRecursiveRefs ~config ~checkOptionalArg:checkOptionalArgFn + ~deadDeclarations ~level:0 ~orderedFiles + ~refsBeingResolved:(ref PosSet.empty) ~refs decl |> ignore in - if !Cli.debug then ( + if config.DceConfig.cli.debug then ( Log_.item "@.File References@.@."; let fileList = ref [] in FileReferences.iter (fun file files -> @@ -698,7 +705,7 @@ let reportDead ~checkOptionalArg = PosHash.fold (fun _pos decl declarations -> decl :: declarations) decls [] in let orderedFiles = Hashtbl.create 256 in - iterFilesFromRootsToLeaves + iterFilesFromRootsToLeaves ~config (let current = ref 0 in fun fileName -> incr current; @@ -714,4 +721,4 @@ let reportDead ~checkOptionalArg = !deadDeclarations |> List.fast_sort Decl.compareForReporting in let reporting_ctx = ReportingContext.create () in - sortedDeadDeclarations |> List.iter (Decl.report reporting_ctx) + sortedDeadDeclarations |> List.iter (Decl.report ~config reporting_ctx) diff --git a/analysis/reanalyze/src/DeadException.ml b/analysis/reanalyze/src/DeadException.ml index f9bde2d2e4..d069e9e11a 100644 --- a/analysis/reanalyze/src/DeadException.ml +++ b/analysis/reanalyze/src/DeadException.ml @@ -6,14 +6,14 @@ type item = {exceptionPath: Path.t; locFrom: Location.t} let delayedItems = ref [] let declarations = Hashtbl.create 1 -let add ~path ~loc ~(strLoc : Location.t) name = +let add ~config ~path ~loc ~(strLoc : Location.t) name = let exceptionPath = name :: path in Hashtbl.add declarations exceptionPath loc; name - |> addDeclaration_ ~posEnd:strLoc.loc_end ~posStart:strLoc.loc_start + |> addDeclaration_ ~config ~posEnd:strLoc.loc_end ~posStart:strLoc.loc_start ~declKind:Exception ~moduleLoc:(ModulePath.getCurrent ()).loc ~path ~loc -let forceDelayedItems () = +let forceDelayedItems ~config = let items = !delayedItems |> List.rev in delayedItems := []; items @@ -22,10 +22,10 @@ let forceDelayedItems () = | None -> () | Some locTo -> (* Delayed exception references don't need a binding context; use an empty state. *) - DeadCommon.addValueReference ~binding:Location.none + DeadCommon.addValueReference ~config ~binding:Location.none ~addFileReference:true ~locFrom ~locTo) -let markAsUsed ~(binding : Location.t) ~(locFrom : Location.t) +let markAsUsed ~config ~(binding : Location.t) ~(locFrom : Location.t) ~(locTo : Location.t) path_ = if locTo.loc_ghost then (* Probably defined in another file, delay processing and check at the end *) @@ -34,4 +34,5 @@ let markAsUsed ~(binding : Location.t) ~(locFrom : Location.t) in delayedItems := {exceptionPath; locFrom} :: !delayedItems else - DeadCommon.addValueReference ~binding ~addFileReference:true ~locFrom ~locTo + DeadCommon.addValueReference ~config ~binding ~addFileReference:true + ~locFrom ~locTo diff --git a/analysis/reanalyze/src/DeadModules.ml b/analysis/reanalyze/src/DeadModules.ml index 572748bcfa..66c6697bb0 100644 --- a/analysis/reanalyze/src/DeadModules.ml +++ b/analysis/reanalyze/src/DeadModules.ml @@ -1,26 +1,26 @@ -let active () = +let active ~config = (* When transitive reporting is off, the only dead modules would be empty modules *) - RunConfig.runConfig.transitive + config.DceConfig.run.transitive let table = Hashtbl.create 1 -let markDead ~isType ~loc path = - if active () then +let markDead ~config ~isType ~loc path = + if active ~config then let moduleName = path |> Common.Path.toModuleName ~isType in match Hashtbl.find_opt table moduleName with | Some _ -> () | _ -> Hashtbl.replace table moduleName (false, loc) -let markLive ~isType ~(loc : Location.t) path = - if active () then +let markLive ~config ~isType ~(loc : Location.t) path = + if active ~config then let moduleName = path |> Common.Path.toModuleName ~isType in match Hashtbl.find_opt table moduleName with | None -> Hashtbl.replace table moduleName (true, loc) | Some (false, loc) -> Hashtbl.replace table moduleName (true, loc) | Some (true, _) -> () -let checkModuleDead ~fileName:pos_fname moduleName = - if active () then +let checkModuleDead ~config ~fileName:pos_fname moduleName = + if active ~config then match Hashtbl.find_opt table moduleName with | Some (false, loc) -> Hashtbl.remove table moduleName; @@ -33,7 +33,7 @@ let checkModuleDead ~fileName:pos_fname moduleName = {Location.loc_start = pos; loc_end = pos; loc_ghost = false} else loc in - Log_.warning ~loc + Log_.warning ~config ~loc (Common.DeadModule { message = diff --git a/analysis/reanalyze/src/DeadOptionalArgs.ml b/analysis/reanalyze/src/DeadOptionalArgs.ml index 4e1fcc032f..a253c4e748 100644 --- a/analysis/reanalyze/src/DeadOptionalArgs.ml +++ b/analysis/reanalyze/src/DeadOptionalArgs.ml @@ -12,7 +12,7 @@ type item = { let delayedItems = (ref [] : item list ref) let functionReferences = (ref [] : (Lexing.position * Lexing.position) list ref) -let addFunctionReference ~(locFrom : Location.t) ~(locTo : Location.t) = +let addFunctionReference ~config ~(locFrom : Location.t) ~(locTo : Location.t) = if active () then let posTo = locTo.loc_start in let posFrom = locFrom.loc_start in @@ -23,7 +23,7 @@ let addFunctionReference ~(locFrom : Location.t) ~(locTo : Location.t) = | _ -> false in if shouldAdd then ( - if !Common.Cli.debug then + if config.DceConfig.cli.debug then Log_.item "OptionalArgs.addFunctionReference %s %s@." (posFrom |> posToString) (posTo |> posToString); functionReferences := (posFrom, posTo) :: !functionReferences) @@ -46,13 +46,13 @@ let rec fromTypeExpr (texpr : Types.type_expr) = | Tsubst t -> fromTypeExpr t | _ -> [] -let addReferences ~(locFrom : Location.t) ~(locTo : Location.t) ~path +let addReferences ~config ~(locFrom : Location.t) ~(locTo : Location.t) ~path (argNames, argNamesMaybe) = if active () then ( let posTo = locTo.loc_start in let posFrom = locFrom.loc_start in delayedItems := {posTo; argNames; argNamesMaybe} :: !delayedItems; - if !Common.Cli.debug then + if config.DceConfig.cli.debug then Log_.item "DeadOptionalArgs.addReferences %s called with optional argNames:%s \ argNamesMaybe:%s %s@." @@ -81,14 +81,14 @@ let forceDelayedItems () = OptionalArgs.combine rFrom.optionalArgs rTo.optionalArgs | _ -> ()) -let check decl = +let check ~config decl = match decl with | {declKind = Value {optionalArgs}} when active () && not (ProcessDeadAnnotations.isAnnotatedGenTypeOrLive decl.pos) -> optionalArgs |> OptionalArgs.iterUnused (fun s -> - Log_.warning ~loc:(decl |> declGetLoc) + Log_.warning ~config ~loc:(decl |> declGetLoc) (DeadOptional { deadOptional = WarningUnusedArgument; @@ -101,7 +101,7 @@ let check decl = })); optionalArgs |> OptionalArgs.iterAlwaysUsed (fun s nCalls -> - Log_.warning ~loc:(decl |> declGetLoc) + Log_.warning ~config ~loc:(decl |> declGetLoc) (DeadOptional { deadOptional = WarningRedundantOptionalArgument; diff --git a/analysis/reanalyze/src/DeadType.ml b/analysis/reanalyze/src/DeadType.ml index d7e2383579..64f4747a68 100644 --- a/analysis/reanalyze/src/DeadType.ml +++ b/analysis/reanalyze/src/DeadType.ml @@ -11,8 +11,8 @@ module TypeLabels = struct let find path = Hashtbl.find_opt table path end -let addTypeReference ~posFrom ~posTo = - if !Common.Cli.debug then +let addTypeReference ~config ~posFrom ~posTo = + if config.DceConfig.cli.debug then Log_.item "addTypeReference %s --> %s@." (posFrom |> posToString) (posTo |> posToString); TypeReferences.add posTo posFrom @@ -22,25 +22,26 @@ module TypeDependencies = struct let add loc1 loc2 = delayedItems := (loc1, loc2) :: !delayedItems let clear () = delayedItems := [] - let processTypeDependency + let processTypeDependency ~config ( ({loc_start = posTo; loc_ghost = ghost1} : Location.t), ({loc_start = posFrom; loc_ghost = ghost2} : Location.t) ) = if (not ghost1) && (not ghost2) && posTo <> posFrom then - addTypeReference ~posTo ~posFrom + addTypeReference ~config ~posTo ~posFrom - let forceDelayedItems () = List.iter processTypeDependency !delayedItems + let forceDelayedItems ~config = + List.iter (processTypeDependency ~config) !delayedItems end -let extendTypeDependencies (loc1 : Location.t) (loc2 : Location.t) = +let extendTypeDependencies ~config (loc1 : Location.t) (loc2 : Location.t) = if loc1.loc_start <> loc2.loc_start then ( - if !Common.Cli.debug then + if config.DceConfig.cli.debug then Log_.item "extendTypeDependencies %s --> %s@." (loc1.loc_start |> posToString) (loc2.loc_start |> posToString); TypeDependencies.add loc1 loc2) (* Type dependencies between Foo.re and Foo.rei *) -let addTypeDependenciesAcrossFiles ~pathToType ~loc ~typeLabelName = +let addTypeDependenciesAcrossFiles ~config ~pathToType ~loc ~typeLabelName = let isInterface = Filename.check_suffix !Common.currentSrc "i" in if not isInterface then ( let path_1 = pathToType |> Path.moduleToInterface in @@ -52,34 +53,34 @@ let addTypeDependenciesAcrossFiles ~pathToType ~loc ~typeLabelName = match TypeLabels.find path2 with | None -> () | Some loc2 -> - extendTypeDependencies loc loc2; + extendTypeDependencies ~config loc loc2; if not Config.reportTypesDeadOnlyInInterface then - extendTypeDependencies loc2 loc) + extendTypeDependencies ~config loc2 loc) | Some loc1 -> - extendTypeDependencies loc loc1; + extendTypeDependencies ~config loc loc1; if not Config.reportTypesDeadOnlyInInterface then - extendTypeDependencies loc1 loc) + extendTypeDependencies ~config loc1 loc) else let path_1 = pathToType |> Path.moduleToImplementation in let path1 = typeLabelName :: path_1 in match TypeLabels.find path1 with | None -> () | Some loc1 -> - extendTypeDependencies loc1 loc; + extendTypeDependencies ~config loc1 loc; if not Config.reportTypesDeadOnlyInInterface then - extendTypeDependencies loc loc1 + extendTypeDependencies ~config loc loc1 (* Add type dependencies between implementation and interface in inner module *) -let addTypeDependenciesInnerModule ~pathToType ~loc ~typeLabelName = +let addTypeDependenciesInnerModule ~config ~pathToType ~loc ~typeLabelName = let path = typeLabelName :: pathToType in match TypeLabels.find path with | Some loc2 -> - extendTypeDependencies loc loc2; + extendTypeDependencies ~config loc loc2; if not Config.reportTypesDeadOnlyInInterface then - extendTypeDependencies loc2 loc + extendTypeDependencies ~config loc2 loc | None -> TypeLabels.add path loc -let addDeclaration ~(typeId : Ident.t) ~(typeKind : Types.type_kind) = +let addDeclaration ~config ~(typeId : Ident.t) ~(typeKind : Types.type_kind) = let currentModulePath = ModulePath.getCurrent () in let pathToType = (typeId |> Ident.name |> Name.create) @@ -87,10 +88,10 @@ let addDeclaration ~(typeId : Ident.t) ~(typeKind : Types.type_kind) = in let processTypeLabel ?(posAdjustment = Nothing) typeLabelName ~declKind ~(loc : Location.t) = - addDeclaration_ ~declKind ~path:pathToType ~loc + addDeclaration_ ~config ~declKind ~path:pathToType ~loc ~moduleLoc:currentModulePath.loc ~posAdjustment typeLabelName; - addTypeDependenciesAcrossFiles ~pathToType ~loc ~typeLabelName; - addTypeDependenciesInnerModule ~pathToType ~loc ~typeLabelName; + addTypeDependenciesAcrossFiles ~config ~pathToType ~loc ~typeLabelName; + addTypeDependenciesInnerModule ~config ~pathToType ~loc ~typeLabelName; TypeLabels.add (typeLabelName :: pathToType) loc in match typeKind with diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index ffffdb4427..62d5db8aed 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -2,7 +2,7 @@ open DeadCommon -let checkAnyValueBindingWithNoSideEffects +let checkAnyValueBindingWithNoSideEffects ~config ({vb_pat = {pat_desc}; vb_expr = expr; vb_loc = loc} : Typedtree.value_binding) = match pat_desc with @@ -11,14 +11,14 @@ let checkAnyValueBindingWithNoSideEffects let currentModulePath = ModulePath.getCurrent () in let path = currentModulePath.path @ [!Common.currentModuleName] in name - |> addValueDeclaration ~path ~loc ~moduleLoc:currentModulePath.loc + |> addValueDeclaration ~config ~path ~loc ~moduleLoc:currentModulePath.loc ~sideEffects:false | _ -> () -let collectValueBinding ~(current_binding : Location.t) +let collectValueBinding ~config ~(current_binding : Location.t) (vb : Typedtree.value_binding) = let oldLastBinding = current_binding in - checkAnyValueBindingWithNoSideEffects vb; + checkAnyValueBindingWithNoSideEffects ~config vb; let loc = match vb.vb_pat.pat_desc with | Tpat_var (id, {loc = {loc_start; loc_ghost} as loc}) @@ -49,7 +49,7 @@ let collectValueBinding ~(current_binding : Location.t) let isToplevel = oldLastBinding = Location.none in let sideEffects = SideEffects.checkExpr vb.vb_expr in name - |> addValueDeclaration ~isToplevel ~loc + |> addValueDeclaration ~config ~isToplevel ~loc ~moduleLoc:currentModulePath.loc ~optionalArgs ~path ~sideEffects); (match PosHash.find_opt decls loc_start with | None -> () @@ -75,7 +75,8 @@ let collectValueBinding ~(current_binding : Location.t) in loc -let processOptionalArgs ~expType ~(locFrom : Location.t) ~locTo ~path args = +let processOptionalArgs ~config ~expType ~(locFrom : Location.t) ~locTo ~path + args = if expType |> DeadOptionalArgs.hasOptionalArgs then ( let supplied = ref [] in let suppliedMaybe = ref [] in @@ -104,9 +105,9 @@ let processOptionalArgs ~expType ~(locFrom : Location.t) ~locTo ~path args = if argIsSupplied = None then suppliedMaybe := s :: !suppliedMaybe | _ -> ()); (!supplied, !suppliedMaybe) - |> DeadOptionalArgs.addReferences ~locFrom ~locTo ~path) + |> DeadOptionalArgs.addReferences ~config ~locFrom ~locTo ~path) -let rec collectExpr ~(last_binding : Location.t) super self +let rec collectExpr ~config ~(last_binding : Location.t) super self (e : Typedtree.expression) = let locFrom = e.exp_loc in let binding = last_binding in @@ -116,14 +117,14 @@ let rec collectExpr ~(last_binding : Location.t) super self if locFrom = locTo && _path |> Path.name = "emptyArray" then ( (* Work around lowercase jsx with no children producing an artifact `emptyArray` which is called from its own location as many things are generated on the same location. *) - if !Common.Cli.debug then + if config.DceConfig.cli.debug then Log_.item "addDummyReference %s --> %s@." (Location.none.loc_start |> Common.posToString) (locTo.loc_start |> Common.posToString); ValueReferences.add locTo.loc_start Location.none.loc_start) else - DeadCommon.addValueReference ~binding ~addFileReference:true ~locFrom - ~locTo + DeadCommon.addValueReference ~config ~binding ~addFileReference:true + ~locFrom ~locTo | Texp_apply { funct = @@ -136,7 +137,7 @@ let rec collectExpr ~(last_binding : Location.t) super self args; } -> args - |> processOptionalArgs ~expType:exp_type + |> processOptionalArgs ~config ~expType:exp_type ~locFrom:(locFrom : Location.t) ~locTo ~path | Texp_let @@ -177,23 +178,23 @@ let rec collectExpr ~(last_binding : Location.t) super self && Ident.name etaArg = "eta" && Path.name idArg2 = "arg" -> args - |> processOptionalArgs ~expType:exp_type + |> processOptionalArgs ~config ~expType:exp_type ~locFrom:(locFrom : Location.t) ~locTo ~path | Texp_field (_, _, {lbl_loc = {Location.loc_start = posTo; loc_ghost = false}; _}) -> if !Config.analyzeTypes then - DeadType.addTypeReference ~posTo ~posFrom:locFrom.loc_start + DeadType.addTypeReference ~config ~posTo ~posFrom:locFrom.loc_start | Texp_construct ( _, {cstr_loc = {Location.loc_start = posTo; loc_ghost} as locTo; cstr_tag}, _ ) -> (match cstr_tag with | Cstr_extension path -> - path |> DeadException.markAsUsed ~binding ~locFrom ~locTo + path |> DeadException.markAsUsed ~config ~binding ~locFrom ~locTo | _ -> ()); if !Config.analyzeTypes && not loc_ghost then - DeadType.addTypeReference ~posTo ~posFrom:locFrom.loc_start + DeadType.addTypeReference ~config ~posTo ~posFrom:locFrom.loc_start | Texp_record {fields} -> fields |> Array.iter (fun (_, record_label_definition, _) -> @@ -202,7 +203,7 @@ let rec collectExpr ~(last_binding : Location.t) super self -> (* Punned field in OCaml projects has ghost location in expression *) let e = {e with exp_loc = {exp_loc with loc_ghost = false}} in - collectExpr ~last_binding super self e |> ignore + collectExpr ~config ~last_binding super self e |> ignore | _ -> ()) | _ -> ()); super.Tast_mapper.expr self e @@ -217,7 +218,7 @@ let rec collectExpr ~(last_binding : Location.t) super self With this annotation we declare a new type for each branch to allow the function to be typed. *) -let collectPattern : _ -> _ -> Typedtree.pattern -> Typedtree.pattern = +let collectPattern ~config : _ -> _ -> Typedtree.pattern -> Typedtree.pattern = fun super self pat -> let posFrom = pat.Typedtree.pat_loc.loc_start in (match pat.pat_desc with @@ -225,7 +226,7 @@ let collectPattern : _ -> _ -> Typedtree.pattern -> Typedtree.pattern = cases |> List.iter (fun (_loc, {Types.lbl_loc = {loc_start = posTo}}, _pat, _) -> if !Config.analyzeTypes then - DeadType.addTypeReference ~posFrom ~posTo) + DeadType.addTypeReference ~config ~posFrom ~posTo) | _ -> ()); super.Tast_mapper.pat self pat @@ -235,13 +236,13 @@ let rec getSignature (moduleType : Types.module_type) = | Mty_functor (_, _mtParam, mt) -> getSignature mt | _ -> [] -let rec processSignatureItem ~doTypes ~doValues ~moduleLoc ~path +let rec processSignatureItem ~config ~doTypes ~doValues ~moduleLoc ~path (si : Types.signature_item) = let oldModulePath = ModulePath.getCurrent () in (match si with | Sig_type (id, t, _) when doTypes -> if !Config.analyzeTypes then - DeadType.addDeclaration ~typeId:id ~typeKind:t.type_kind + DeadType.addDeclaration ~config ~typeId:id ~typeKind:t.type_kind | Sig_value (id, {Types.val_loc = loc; val_kind = kind; val_type}) when doValues -> if not loc.Location.loc_ghost then @@ -260,7 +261,7 @@ let rec processSignatureItem ~doTypes ~doValues ~moduleLoc ~path Printf.printf "XXX %s\n" (Ident.name id); *) Ident.name id |> Name.create ~isInterface:false - |> addValueDeclaration ~loc ~moduleLoc ~optionalArgs ~path + |> addValueDeclaration ~config ~loc ~moduleLoc ~optionalArgs ~path ~sideEffects:false | Sig_module (id, {Types.md_type = moduleType; md_loc = moduleLoc}, _) | Sig_modtype (id, {Types.mtd_type = Some moduleType; mtd_loc = moduleLoc}) -> @@ -278,21 +279,22 @@ let rec processSignatureItem ~doTypes ~doValues ~moduleLoc ~path if collect then getSignature moduleType |> List.iter - (processSignatureItem ~doTypes ~doValues ~moduleLoc + (processSignatureItem ~config ~doTypes ~doValues ~moduleLoc ~path:((id |> Ident.name |> Name.create) :: path)) | _ -> ()); ModulePath.setCurrent oldModulePath (* Traverse the AST *) -let traverseStructure ~doTypes ~doExternals (structure : Typedtree.structure) : - unit = +let traverseStructure ~config ~doTypes ~doExternals + (structure : Typedtree.structure) : unit = let rec create_mapper (last_binding : Location.t) = let super = Tast_mapper.default in let rec mapper = { super with - expr = (fun _self e -> e |> collectExpr ~last_binding super mapper); - pat = (fun _self p -> p |> collectPattern super mapper); + expr = + (fun _self e -> e |> collectExpr ~config ~last_binding super mapper); + pat = (fun _self p -> p |> collectPattern ~config super mapper); structure_item = (fun _self (structureItem : Typedtree.structure_item) -> let oldModulePath = ModulePath.getCurrent () in @@ -315,7 +317,7 @@ let traverseStructure ~doTypes ~doExternals (structure : Typedtree.structure) : | Mty_signature signature -> signature |> List.iter - (processSignatureItem ~doTypes ~doValues:false + (processSignatureItem ~config ~doTypes ~doValues:false ~moduleLoc:mb_expr.mod_loc ~path: ((ModulePath.getCurrent ()).path @@ -337,14 +339,15 @@ let traverseStructure ~doTypes ~doExternals (structure : Typedtree.structure) : then id |> Name.create ~isInterface:false - |> addValueDeclaration ~path ~loc:vd.val_loc + |> addValueDeclaration ~config ~path ~loc:vd.val_loc ~moduleLoc:currentModulePath.loc ~sideEffects:false | Tstr_type (_recFlag, typeDeclarations) when doTypes -> if !Config.analyzeTypes then typeDeclarations |> List.iter (fun (typeDeclaration : Typedtree.type_declaration) -> - DeadType.addDeclaration ~typeId:typeDeclaration.typ_id + DeadType.addDeclaration ~config + ~typeId:typeDeclaration.typ_id ~typeKind:typeDeclaration.typ_type.type_kind) | Tstr_include {incl_mod; incl_type} -> ( match incl_mod.mod_desc with @@ -354,7 +357,7 @@ let traverseStructure ~doTypes ~doExternals (structure : Typedtree.structure) : in incl_type |> List.iter - (processSignatureItem ~doTypes + (processSignatureItem ~config ~doTypes ~doValues:false (* TODO: also values? *) ~moduleLoc:incl_mod.mod_loc ~path:currentPath) | _ -> ()) @@ -363,14 +366,18 @@ let traverseStructure ~doTypes ~doExternals (structure : Typedtree.structure) : (ModulePath.getCurrent ()).path @ [!Common.currentModuleName] in let name = id |> Ident.name |> Name.create in - name |> DeadException.add ~path ~loc ~strLoc:structureItem.str_loc + name + |> DeadException.add ~config ~path ~loc + ~strLoc:structureItem.str_loc | _ -> ()); let result = super.structure_item mapper structureItem in ModulePath.setCurrent oldModulePath; result); value_binding = (fun _self vb -> - let loc = vb |> collectValueBinding ~current_binding:last_binding in + let loc = + vb |> collectValueBinding ~config ~current_binding:last_binding + in let nested_mapper = create_mapper loc in super.Tast_mapper.value_binding nested_mapper vb); } @@ -381,7 +388,7 @@ let traverseStructure ~doTypes ~doExternals (structure : Typedtree.structure) : mapper.structure mapper structure |> ignore (* Merge a location's references to another one's *) -let processValueDependency +let processValueDependency ~config ( ({ val_loc = {loc_start = {pos_fname = fnTo} as posTo; loc_ghost = ghost1} as @@ -396,12 +403,12 @@ let processValueDependency Types.value_description) ) = if (not ghost1) && (not ghost2) && posTo <> posFrom then ( let addFileReference = fileIsImplementationOf fnTo fnFrom in - DeadCommon.addValueReference ~binding:Location.none ~addFileReference - ~locFrom ~locTo; - DeadOptionalArgs.addFunctionReference ~locFrom ~locTo) + DeadCommon.addValueReference ~config ~binding:Location.none + ~addFileReference ~locFrom ~locTo; + DeadOptionalArgs.addFunctionReference ~config ~locFrom ~locTo) -let processStructure ~cmt_value_dependencies ~doTypes ~doExternals +let processStructure ~config ~cmt_value_dependencies ~doTypes ~doExternals (structure : Typedtree.structure) = - traverseStructure ~doTypes ~doExternals structure; + traverseStructure ~config ~doTypes ~doExternals structure; let valueDependencies = cmt_value_dependencies |> List.rev in - valueDependencies |> List.iter processValueDependency + valueDependencies |> List.iter (processValueDependency ~config) diff --git a/analysis/reanalyze/src/Exception.ml b/analysis/reanalyze/src/Exception.ml index ce33c0fbd5..de54d583c0 100644 --- a/analysis/reanalyze/src/Exception.ml +++ b/analysis/reanalyze/src/Exception.ml @@ -143,7 +143,7 @@ module Event = struct | {kind = Call {callee}} :: _ -> callee |> Common.Path.toName | _ -> "expression" |> Name.create in - Log_.warning ~loc + Log_.warning ~config:(DceConfig.current ()) ~loc (Common.ExceptionAnalysis { message = @@ -196,9 +196,9 @@ module Checks = struct Common.ExceptionAnalysisMissing {exnName; exnTable; throwSet; missingAnnotations; locFull} in - Log_.warning ~loc description); + Log_.warning ~config:(DceConfig.current ()) ~loc description); if not (Exceptions.isEmpty redundantAnnotations) then - Log_.warning ~loc + Log_.warning ~config:(DceConfig.current ()) ~loc (Common.ExceptionAnalysis { message = @@ -281,7 +281,7 @@ let traverseAst () = in let calleeName = callee |> Common.Path.toName in if calleeName |> Name.toString |> isThrow then - Log_.warning ~loc + Log_.warning ~config:(DceConfig.current ()) ~loc (Common.ExceptionAnalysis { message = diff --git a/analysis/reanalyze/src/Log_.ml b/analysis/reanalyze/src/Log_.ml index ca333e1544..8f1665294c 100644 --- a/analysis/reanalyze/src/Log_.ml +++ b/analysis/reanalyze/src/Log_.ml @@ -107,11 +107,11 @@ let missingRaiseInfoToText {missingAnnotations; locFull} = ~text:(Format.asprintf "@throws(%s)\\n" missingTxt) else "" -let logAdditionalInfo ~(description : description) = +let logAdditionalInfo ~config ~(description : description) = match description with | DeadWarning {lineAnnotation; shouldWriteLineAnnotation} -> if shouldWriteLineAnnotation then - WriteDeadAnnotations.lineAnnotationToString lineAnnotation + WriteDeadAnnotations.lineAnnotationToString ~config lineAnnotation else "" | ExceptionAnalysisMissing missingRaiseInfo -> missingRaiseInfoToText missingRaiseInfo @@ -166,10 +166,10 @@ let descriptionToName (description : description) = | Termination {termination = TerminationAnalysisInternal} -> Issues.terminationAnalysisInternal -let logIssue ~(issue : issue) = +let logIssue ~config ~(issue : issue) = let open Format in let loc = issue.loc in - if !Cli.json then + if config.DceConfig.cli.json then let file = Json.escape loc.loc_start.pos_fname in let startLine = loc.loc_start.pos_lnum - 1 in let startCharacter = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in @@ -187,8 +187,8 @@ let logIssue ~(issue : issue) = ~range:(startLine, startCharacter, endLine, endCharacter) ~message) () - (logAdditionalInfo ~description:issue.description) - (if !Cli.json then EmitJson.emitClose () else "") + (logAdditionalInfo ~config ~description:issue.description) + (if config.DceConfig.cli.json then EmitJson.emitClose () else "") else let color = match issue.severity with @@ -197,7 +197,7 @@ let logIssue ~(issue : issue) = in asprintf "@. %a@. %a@. %s%s@." color issue.name Loc.print issue.loc (descriptionToMessage issue.description) - (logAdditionalInfo ~description:issue.description) + (logAdditionalInfo ~config ~description:issue.description) module Stats = struct let issues = ref [] @@ -225,11 +225,11 @@ module Stats = struct in (issues |> List.sort (fun (n1, _) (n2, _) -> String.compare n1 n2), nIssues) - let report () = + let report ~config = !issues |> List.rev - |> List.iter (fun issue -> logIssue ~issue |> print_string); + |> List.iter (fun issue -> logIssue ~config ~issue |> print_string); let sortedIssues, nIssues = getSortedIssues () in - if not !Cli.json then ( + if not config.DceConfig.cli.json then ( if sortedIssues <> [] then item "@."; item "Analysis reported %d issues%s@." nIssues (match sortedIssues with @@ -247,7 +247,7 @@ let logIssue ~forStats ~severity ~(loc : Location.t) description = if Suppress.filter loc.loc_start then if forStats then Stats.addIssue {name; severity; loc; description} -let warning ?(forStats = true) ~loc description = +let warning ~config ?(forStats = true) ~loc description = description |> logIssue ~severity:Warning ~forStats ~loc let error ~loc description = diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml index 7378264908..a53e52dd60 100644 --- a/analysis/reanalyze/src/Reanalyze.ml +++ b/analysis/reanalyze/src/Reanalyze.ml @@ -1,9 +1,9 @@ open Common -let loadCmtFile cmtFilePath = +let loadCmtFile ~config cmtFilePath = let cmt_infos = Cmt_format.read_cmt cmtFilePath in let excludePath sourceFile = - !Cli.excludePaths + config.DceConfig.cli.exclude_paths |> List.exists (fun prefix_ -> let prefix = match Filename.is_relative sourceFile with @@ -17,12 +17,12 @@ let loadCmtFile cmtFilePath = in match cmt_infos.cmt_annots |> FindSourceFile.cmt with | Some sourceFile when not (excludePath sourceFile) -> - if !Cli.debug then + if config.cli.debug then Log_.item "Scanning %s Source:%s@." - (match !Cli.ci && not (Filename.is_relative cmtFilePath) with + (match config.cli.ci && not (Filename.is_relative cmtFilePath) with | true -> Filename.basename cmtFilePath | false -> cmtFilePath) - (match !Cli.ci && not (Filename.is_relative sourceFile) with + (match config.cli.ci && not (Filename.is_relative sourceFile) with | true -> sourceFile |> Filename.basename | false -> sourceFile); FileReferences.addFile sourceFile; @@ -31,12 +31,13 @@ let loadCmtFile cmtFilePath = currentModuleName := !currentModule |> Name.create ~isInterface:(Filename.check_suffix !currentSrc "i"); - if runConfig.dce then cmt_infos |> DeadCode.processCmt ~cmtFilePath; + if config.DceConfig.run.dce then + cmt_infos |> DeadCode.processCmt ~config ~cmtFilePath; if runConfig.exception_ then cmt_infos |> Exception.processCmt; if runConfig.termination then cmt_infos |> Arnold.processCmt | _ -> () -let processCmtFiles ~cmtRoot = +let processCmtFiles ~config ~cmtRoot = let ( +++ ) = Filename.concat in match cmtRoot with | Some root -> @@ -57,7 +58,7 @@ let processCmtFiles ~cmtRoot = else if Filename.check_suffix absDir ".cmt" || Filename.check_suffix absDir ".cmti" - then absDir |> loadCmtFile + then absDir |> loadCmtFile ~config in walkSubDirs "" | None -> @@ -83,23 +84,25 @@ let processCmtFiles ~cmtRoot = cmtFiles |> List.sort String.compare |> List.iter (fun cmtFile -> let cmtFilePath = Filename.concat libBsSourceDir cmtFile in - cmtFilePath |> loadCmtFile)) + cmtFilePath |> loadCmtFile ~config)) -let runAnalysis ~cmtRoot = - processCmtFiles ~cmtRoot; - if runConfig.dce then ( - DeadException.forceDelayedItems (); +let runAnalysis ~dce_config ~cmtRoot = + processCmtFiles ~config:dce_config ~cmtRoot; + if dce_config.DceConfig.run.dce then ( + DeadException.forceDelayedItems ~config:dce_config; DeadOptionalArgs.forceDelayedItems (); - DeadCommon.reportDead ~checkOptionalArg:DeadOptionalArgs.check; - WriteDeadAnnotations.write ()); + DeadCommon.reportDead ~config:dce_config + ~checkOptionalArg:DeadOptionalArgs.check; + WriteDeadAnnotations.write ~config:dce_config); if runConfig.exception_ then Exception.Checks.doChecks (); if runConfig.termination && !Common.Cli.debug then Arnold.reportStats () let runAnalysisAndReport ~cmtRoot = Log_.Color.setup (); if !Common.Cli.json then EmitJson.start (); - runAnalysis ~cmtRoot; - Log_.Stats.report (); + let dce_config = DceConfig.current () in + runAnalysis ~dce_config ~cmtRoot; + Log_.Stats.report ~config:dce_config; Log_.Stats.clear (); if !Common.Cli.json then EmitJson.finish () @@ -217,4 +220,5 @@ let cli () = [@@raises exit] module RunConfig = RunConfig +module DceConfig = DceConfig module Log_ = Log_ diff --git a/analysis/reanalyze/src/WriteDeadAnnotations.ml b/analysis/reanalyze/src/WriteDeadAnnotations.ml index 642bb3d875..fa512ed0c2 100644 --- a/analysis/reanalyze/src/WriteDeadAnnotations.ml +++ b/analysis/reanalyze/src/WriteDeadAnnotations.ml @@ -98,8 +98,8 @@ let readFile fileName = close_in_noerr channel; !lines |> List.rev |> Array.of_list -let writeFile fileName lines = - if fileName <> "" && !Cli.write then ( +let writeFile ~config fileName lines = + if fileName <> "" && config.DceConfig.cli.write then ( let channel = open_out fileName in let lastLine = Array.length lines in lines @@ -112,8 +112,8 @@ let offsetOfPosAdjustment = function | FirstVariant | Nothing -> 0 | OtherVariant -> 2 -let getLineAnnotation ~decl ~line = - if !Cli.json then +let getLineAnnotation ~config ~decl ~line = + if config.DceConfig.cli.json then let posAnnotation = decl |> getPosAnnotation in let offset = decl.posAdjustment |> offsetOfPosAdjustment in EmitJson.emitAnnotate @@ -130,17 +130,18 @@ let getLineAnnotation ~decl ~line = Format.asprintf "@. <-- line %d@. %s" decl.pos.pos_lnum (line |> lineToString) -let cantFindLine () = if !Cli.json then "" else "\n <-- Can't find line" +let cantFindLine ~config = + if config.DceConfig.cli.json then "" else "\n <-- Can't find line" -let lineAnnotationToString = function - | None -> cantFindLine () - | Some (decl, line) -> getLineAnnotation ~decl ~line +let lineAnnotationToString ~config = function + | None -> cantFindLine ~config + | Some (decl, line) -> getLineAnnotation ~config ~decl ~line -let addLineAnnotation ~decl : lineAnnotation = +let addLineAnnotation ~config ~decl : lineAnnotation = let fileName = decl.pos.pos_fname in if Sys.file_exists fileName then ( if fileName <> !currentFile then ( - writeFile !currentFile !currentFileLines; + writeFile ~config !currentFile !currentFileLines; currentFile := fileName; currentFileLines := readFile fileName); let indexInLines = (decl |> getPosAnnotation).pos_lnum - 1 in @@ -151,4 +152,4 @@ let addLineAnnotation ~decl : lineAnnotation = | exception Invalid_argument _ -> None) else None -let write () = writeFile !currentFile !currentFileLines +let write ~config = writeFile ~config !currentFile !currentFileLines diff --git a/analysis/src/DceCommand.ml b/analysis/src/DceCommand.ml index 8630277edd..1578a66bb4 100644 --- a/analysis/src/DceCommand.ml +++ b/analysis/src/DceCommand.ml @@ -1,5 +1,6 @@ let command () = Reanalyze.RunConfig.dce (); - Reanalyze.runAnalysis ~cmtRoot:None; + let dce_config = Reanalyze.DceConfig.current () in + Reanalyze.runAnalysis ~dce_config ~cmtRoot:None; let issues = !Reanalyze.Log_.Stats.issues in Printf.printf "issues:%d\n" (List.length issues) From 9ba5d2d959966163238776777d1daab44fc657ff Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 6 Dec 2025 05:49:40 +0100 Subject: [PATCH 7/8] Refactor: Thread config parameter instead of using global state - Replace DceConfig.current() and !Common.Cli.debug with explicit config parameter - Thread config through Arnold.ml functions (Stats, ExtendFunctionTable, CheckExpressionWellFormed, Compile, Eval) - Thread config through Exception.ml functions (Event.combine, Checks.doCheck/doChecks, traverseAst) - Update Reanalyze.ml to pass config to all analysis functions - Improves testability and eliminates global state dependencies --- analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md | 18 +-- analysis/reanalyze/src/Arnold.ml | 123 ++++++++++--------- analysis/reanalyze/src/Exception.ml | 36 +++--- analysis/reanalyze/src/Reanalyze.ml | 12 +- 4 files changed, 101 insertions(+), 88 deletions(-) diff --git a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md index a4f6ec3081..2b8a0dc261 100644 --- a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md +++ b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md @@ -152,14 +152,14 @@ Each task should: - [x] ~~Use the `DceConfig.t` already created, thread it through DCE analysis functions~~ - [x] ~~Replace all DCE code's `!Common.Cli.debug`, `runConfig.transitive`, etc. reads with `config.debug`, `config.run.transitive`~~ - [x] ~~Make all config parameters required (not optional) - no `config option` anywhere~~ -- [ ] **Thread config through Exception and Arnold analyses** - they currently call `DceConfig.current()` at each use site -- [ ] **Single entry point**: Only `Reanalyze.runAnalysisAndReport` should call `DceConfig.current()` once, then pass explicit config everywhere +- [x] Thread config through Exception and Arnold analyses (no `DceConfig.current()` in analysis code) +- [x] Single entry point: only the CLI/entry wrappers (`runAnalysisAndReport`, `DceCommand`) call `DceConfig.current()` once, then pass explicit config everywhere -**Status**: DCE code complete ✅. Exception/Arnold still need threading. +**Status**: Complete ✅ (DCE + Exception + Arnold). **Test**: Create two configs with different settings, run analysis with each - should respect the config, not read globals. -**Estimated effort**: Medium (DCE done; Exception/Arnold similar effort) +**Estimated effort**: Medium (done) ### Task 3: Make `ProcessDeadAnnotations` state explicit (P3) @@ -262,13 +262,13 @@ Each task should: **Value**: Enforce purity - no hidden global reads. **Changes**: -- [ ] Verify `DceConfig.current()` only called in `Reanalyze.runAnalysisAndReport` (entry point) -- [ ] Verify no calls to `DceConfig.current()` in `Dead*.ml`, `Exception.ml`, `Arnold.ml` analysis code -- [ ] All analysis functions take explicit `~config` parameter +- [x] Verify `DceConfig.current()` only called in entry wrappers (CLI / `runAnalysisAndReport`) +- [x] Verify no calls to `DceConfig.current()` in `Dead*.ml`, `Exception.ml`, `Arnold.ml` analysis code +- [x] All analysis functions take explicit `~config` parameter -**Test**: `grep -r "DceConfig.current" analysis/reanalyze/src/{Dead,Exception,Arnold}.ml` returns zero results. +**Test**: `grep -r "DceConfig.current" analysis/reanalyze/src/{Dead,Exception,Arnold}.ml` returns zero results. ✅ -**Estimated effort**: Trivial (verification only, assuming Task 2 complete) +**Estimated effort**: Trivial (done) ### Task 11: Integration and order-independence verification diff --git a/analysis/reanalyze/src/Arnold.ml b/analysis/reanalyze/src/Arnold.ml index 36d01ca1d1..e065d0748d 100644 --- a/analysis/reanalyze/src/Arnold.ml +++ b/analysis/reanalyze/src/Arnold.ml @@ -107,11 +107,11 @@ module Stats = struct let logLoop () = incr nInfiniteLoops - let logCache ~functionCall ~hit ~loc = + let logCache ~config ~functionCall ~hit ~loc = incr nCacheChecks; if hit then incr nCacheHits; - if !Common.Cli.debug then - Log_.warning ~config:(DceConfig.current ()) ~forStats:false ~loc + if config.DceConfig.cli.debug then + Log_.warning ~config ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -123,9 +123,9 @@ module Stats = struct (FunctionCall.toString functionCall); }) - let logResult ~functionCall ~loc ~resString = - if !Common.Cli.debug then - Log_.warning ~config:(DceConfig.current ()) ~forStats:false ~loc + let logResult ~config ~functionCall ~loc ~resString = + if config.DceConfig.cli.debug then + Log_.warning ~config ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -591,7 +591,8 @@ module ExtendFunctionTable = struct if args |> List.for_all checkArg then Some (path, loc) else None | _ -> None - let traverseExpr ~functionTable ~progressFunctions ~valueBindingsTable = + let traverseExpr ~config ~functionTable ~progressFunctions ~valueBindingsTable + = let super = Tast_mapper.default in let expr (self : Tast_mapper.mapper) (e : Typedtree.expression) = (match e.exp_desc with @@ -609,8 +610,8 @@ module ExtendFunctionTable = struct if not (callee |> FunctionTable.isInFunctionInTable ~functionTable) then ( functionTable |> FunctionTable.addFunction ~functionName; - if !Common.Cli.debug then - Log_.warning ~config:(DceConfig.current ()) ~forStats:false ~loc + if config.DceConfig.cli.debug then + Log_.warning ~config ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -631,9 +632,8 @@ module ExtendFunctionTable = struct -> functionTable |> FunctionTable.addLabelToKind ~functionName ~label; - if !Common.Cli.debug then - Log_.warning ~config:(DceConfig.current ()) ~forStats:false - ~loc + if config.DceConfig.cli.debug then + Log_.warning ~config ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -649,16 +649,16 @@ module ExtendFunctionTable = struct in {super with Tast_mapper.expr} - let run ~functionTable ~progressFunctions ~valueBindingsTable + let run ~config ~functionTable ~progressFunctions ~valueBindingsTable (expression : Typedtree.expression) = let traverseExpr = - traverseExpr ~functionTable ~progressFunctions ~valueBindingsTable + traverseExpr ~config ~functionTable ~progressFunctions ~valueBindingsTable in expression |> traverseExpr.expr traverseExpr |> ignore end module CheckExpressionWellFormed = struct - let traverseExpr ~functionTable ~valueBindingsTable = + let traverseExpr ~config ~functionTable ~valueBindingsTable = let super = Tast_mapper.default in let checkIdent ~path ~loc = if path |> FunctionTable.isInFunctionInTable ~functionTable then @@ -699,9 +699,8 @@ module CheckExpressionWellFormed = struct |> FunctionTable.addFunction ~functionName; functionTable |> FunctionTable.addLabelToKind ~functionName ~label; - if !Common.Cli.debug then - Log_.warning ~config:(DceConfig.current ()) - ~forStats:false ~loc:body.exp_loc + if config.DceConfig.cli.debug then + Log_.warning ~config ~forStats:false ~loc:body.exp_loc (Termination { termination = TerminationAnalysisInternal; @@ -719,14 +718,17 @@ module CheckExpressionWellFormed = struct in {super with Tast_mapper.expr} - let run ~functionTable ~valueBindingsTable (expression : Typedtree.expression) - = - let traverseExpr = traverseExpr ~functionTable ~valueBindingsTable in + let run ~config ~functionTable ~valueBindingsTable + (expression : Typedtree.expression) = + let traverseExpr = + traverseExpr ~config ~functionTable ~valueBindingsTable + in expression |> traverseExpr.expr traverseExpr |> ignore end module Compile = struct type ctx = { + config: DceConfig.t; currentFunctionName: FunctionName.t; functionTable: FunctionTable.t; innerRecursiveFunctions: (FunctionName.t, FunctionName.t) Hashtbl.t; @@ -734,7 +736,9 @@ module Compile = struct } let rec expression ~ctx (expr : Typedtree.expression) = - let {currentFunctionName; functionTable; isProgressFunction} = ctx in + let {config; currentFunctionName; functionTable; isProgressFunction} = + ctx + in let loc = expr.exp_loc in let notImplemented case = Log_.error ~loc @@ -874,8 +878,8 @@ module Compile = struct Hashtbl.replace ctx.innerRecursiveFunctions oldFunctionName newFunctionName; newFunctionDefinition.body <- Some (vb_expr |> expression ~ctx:newCtx); - if !Common.Cli.debug then - Log_.warning ~config:(DceConfig.current ()) ~forStats:false ~loc:pat_loc + if config.DceConfig.cli.debug then + Log_.warning ~config ~forStats:false ~loc:pat_loc (Termination { termination = TerminationAnalysisInternal; @@ -1069,8 +1073,9 @@ module Eval = struct let lookupCache ~functionCall (cache : cache) = Hashtbl.find_opt cache functionCall - let updateCache ~functionCall ~loc ~state (cache : cache) = - Stats.logResult ~functionCall ~resString:(state |> State.toString) ~loc; + let updateCache ~config ~functionCall ~loc ~state (cache : cache) = + Stats.logResult ~config ~functionCall ~resString:(state |> State.toString) + ~loc; if not (Hashtbl.mem cache functionCall) then Hashtbl.replace cache functionCall state @@ -1101,7 +1106,7 @@ module Eval = struct true) else false - let rec runFunctionCall ~cache ~callStack ~functionArgs ~functionTable + let rec runFunctionCall ~config ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn ~loc ~state functionCallToInstantiate : State.t = let pos = loc.Location.loc_start in let functionCall = @@ -1113,7 +1118,7 @@ module Eval = struct let stateAfterCall = match cache |> lookupCache ~functionCall with | Some stateAfterCall -> - Stats.logCache ~functionCall ~hit:true ~loc; + Stats.logCache ~config ~functionCall ~hit:true ~loc; { stateAfterCall with trace = Trace.Tcall (call, stateAfterCall.progress); @@ -1126,7 +1131,7 @@ module Eval = struct ~loc ~state then {state with trace = Trace.Tcall (call, state.progress)} else ( - Stats.logCache ~functionCall ~hit:false ~loc; + Stats.logCache ~config ~functionCall ~hit:false ~loc; let functionDefinition = functionTable |> FunctionTable.getFunctionDefinition ~functionName in @@ -1138,10 +1143,11 @@ module Eval = struct in let stateAfterCall = body - |> run ~cache ~callStack ~functionArgs:functionCall.functionArgs - ~functionTable ~madeProgressOn ~state:(State.init ()) + |> run ~config ~cache ~callStack + ~functionArgs:functionCall.functionArgs ~functionTable + ~madeProgressOn ~state:(State.init ()) in - cache |> updateCache ~functionCall ~loc ~state:stateAfterCall; + cache |> updateCache ~config ~functionCall ~loc ~state:stateAfterCall; (* Invariant: run should restore the callStack *) callStack |> CallStack.removeFunctionCall ~functionCall; let trace = Trace.Tcall (call, stateAfterCall.progress) in @@ -1149,12 +1155,12 @@ module Eval = struct in State.seq state stateAfterCall - and run ~(cache : cache) ~callStack ~functionArgs ~functionTable + and run ~config ~(cache : cache) ~callStack ~functionArgs ~functionTable ~madeProgressOn ~state (command : Command.t) : State.t = match command with | Call (FunctionCall functionCall, loc) -> functionCall - |> runFunctionCall ~cache ~callStack ~functionArgs ~functionTable + |> runFunctionCall ~config ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn ~loc ~state | Call ((ProgressFunction _ as call), _pos) -> let state1 = @@ -1179,7 +1185,7 @@ module Eval = struct | c :: nextCommands -> let state1 = c - |> run ~cache ~callStack ~functionArgs ~functionTable + |> run ~config ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn ~state in let madeProgressOn, callStack = @@ -1202,7 +1208,7 @@ module Eval = struct commands |> List.map (fun c -> c - |> run ~cache ~callStack ~functionArgs ~functionTable + |> run ~config ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn ~state:stateNoTrace) in State.seq state (states |> State.unorderedSequence) @@ -1213,36 +1219,36 @@ module Eval = struct commands |> List.map (fun c -> c - |> run ~cache ~callStack ~functionArgs ~functionTable + |> run ~config ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn ~state:stateNoTrace) in State.seq state (states |> State.nondet) | SwitchOption {functionCall; loc; some; none} -> ( let stateAfterCall = functionCall - |> runFunctionCall ~cache ~callStack ~functionArgs ~functionTable - ~madeProgressOn ~loc ~state + |> runFunctionCall ~config ~cache ~callStack ~functionArgs + ~functionTable ~madeProgressOn ~loc ~state in match stateAfterCall.valuesOpt with | None -> Command.nondet [some; none] - |> run ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn - ~state:stateAfterCall + |> run ~config ~cache ~callStack ~functionArgs ~functionTable + ~madeProgressOn ~state:stateAfterCall | Some values -> let runOpt c progressOpt = match progressOpt with | None -> State.init ~progress:Progress () | Some progress -> c - |> run ~cache ~callStack ~functionArgs ~functionTable + |> run ~config ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn ~state:(State.init ~progress ()) in let stateNone = values |> Values.getNone |> runOpt none in let stateSome = values |> Values.getSome |> runOpt some in State.seq stateAfterCall (State.nondet [stateSome; stateNone])) - let analyzeFunction ~cache ~functionTable ~loc functionName = - if !Common.Cli.debug then + let analyzeFunction ~config ~cache ~functionTable ~loc functionName = + if config.DceConfig.cli.debug then Log_.log "@[@,@{Termination Analysis@} for @{%s@}@]@." functionName; let pos = loc.Location.loc_start in @@ -1263,10 +1269,10 @@ module Eval = struct in let state = body - |> run ~cache ~callStack ~functionArgs ~functionTable + |> run ~config ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn:FunctionCallSet.empty ~state:(State.init ()) in - cache |> updateCache ~functionCall ~loc ~state + cache |> updateCache ~config ~functionCall ~loc ~state end let progressFunctionsFromAttributes attributes = @@ -1285,7 +1291,7 @@ let progressFunctionsFromAttributes attributes = | _ -> []) else None -let traverseAst ~valueBindingsTable = +let traverseAst ~config ~valueBindingsTable = let super = Tast_mapper.default in let value_bindings (self : Tast_mapper.mapper) (recFlag, valueBindings) = (* Update the table of value bindings for variables *) @@ -1352,12 +1358,13 @@ let traverseAst ~valueBindingsTable = recursiveDefinitions |> List.iter (fun (_, body) -> body - |> ExtendFunctionTable.run ~functionTable ~progressFunctions - ~valueBindingsTable); + |> ExtendFunctionTable.run ~config ~functionTable + ~progressFunctions ~valueBindingsTable); recursiveDefinitions |> List.iter (fun (_, body) -> body - |> CheckExpressionWellFormed.run ~functionTable ~valueBindingsTable); + |> CheckExpressionWellFormed.run ~config ~functionTable + ~valueBindingsTable); functionTable |> Hashtbl.iter (fun @@ -1376,17 +1383,19 @@ let traverseAst ~valueBindingsTable = |> Compile.expression ~ctx: { + config; currentFunctionName = functionName; functionTable; innerRecursiveFunctions = Hashtbl.create 1; isProgressFunction; })) ~functionName); - if !Common.Cli.debug then FunctionTable.dump functionTable; + if config.DceConfig.cli.debug then FunctionTable.dump functionTable; let cache = Eval.createCache () in functionsToAnalyze |> List.iter (fun (functionName, loc) -> - functionName |> Eval.analyzeFunction ~cache ~functionTable ~loc); + functionName + |> Eval.analyzeFunction ~config ~cache ~functionTable ~loc); Stats.newRecursiveFunctions ~numFunctions:(Hashtbl.length functionTable)); valueBindings |> List.iter (fun valueBinding -> @@ -1395,16 +1404,16 @@ let traverseAst ~valueBindingsTable = in {super with Tast_mapper.value_bindings} -let processStructure (structure : Typedtree.structure) = +let processStructure ~config (structure : Typedtree.structure) = Stats.newFile (); let valueBindingsTable = Hashtbl.create 1 in - let traverseAst = traverseAst ~valueBindingsTable in + let traverseAst = traverseAst ~config ~valueBindingsTable in structure |> traverseAst.structure traverseAst |> ignore -let processCmt (cmt_infos : Cmt_format.cmt_infos) = +let processCmt ~config (cmt_infos : Cmt_format.cmt_infos) = match cmt_infos.cmt_annots with | Interface _ -> () - | Implementation structure -> processStructure structure + | Implementation structure -> processStructure ~config structure | _ -> () -let reportStats () = Stats.dump ~ppf:Format.std_formatter +let reportStats ~config:_ = Stats.dump ~ppf:Format.std_formatter diff --git a/analysis/reanalyze/src/Exception.ml b/analysis/reanalyze/src/Exception.ml index de54d583c0..0bca11a9b0 100644 --- a/analysis/reanalyze/src/Exception.ml +++ b/analysis/reanalyze/src/Exception.ml @@ -101,8 +101,8 @@ module Event = struct nestedEvents |> List.iter (fun e -> Format.fprintf ppf "%a " print e)) () - let combine ~moduleName events = - if !Common.Cli.debug then ( + let combine ~config ~moduleName events = + if config.DceConfig.cli.debug then ( Log_.item "@."; Log_.item "Events combine: #events %d@." (events |> List.length)); let exnTable = Hashtbl.create 1 in @@ -119,11 +119,11 @@ module Event = struct let rec loop exnSet events = match events with | ({kind = Throws; exceptions; loc} as ev) :: rest -> - if !Common.Cli.debug then Log_.item "%a@." print ev; + if config.DceConfig.cli.debug then Log_.item "%a@." print ev; exceptions |> Exceptions.iter (fun exn -> extendExnTable exn loc); loop (Exceptions.union exnSet exceptions) rest | ({kind = Call {callee; modulePath}; loc} as ev) :: rest -> - if !Common.Cli.debug then Log_.item "%a@." print ev; + if config.DceConfig.cli.debug then Log_.item "%a@." print ev; let exceptions = match callee |> Values.findPath ~moduleName ~modulePath with | Some exceptions -> exceptions @@ -135,7 +135,7 @@ module Event = struct exceptions |> Exceptions.iter (fun exn -> extendExnTable exn loc); loop (Exceptions.union exnSet exceptions) rest | ({kind = DoesNotThrow nestedEvents; loc} as ev) :: rest -> - if !Common.Cli.debug then Log_.item "%a@." print ev; + if config.DceConfig.cli.debug then Log_.item "%a@." print ev; let nestedExceptions = loop Exceptions.empty nestedEvents in (if Exceptions.isEmpty nestedExceptions (* catch-all *) then let name = @@ -143,7 +143,7 @@ module Event = struct | {kind = Call {callee}} :: _ -> callee |> Common.Path.toName | _ -> "expression" |> Name.create in - Log_.warning ~config:(DceConfig.current ()) ~loc + Log_.warning ~config ~loc (Common.ExceptionAnalysis { message = @@ -154,7 +154,7 @@ module Event = struct })); loop exnSet rest | ({kind = Catches nestedEvents; exceptions} as ev) :: rest -> - if !Common.Cli.debug then Log_.item "%a@." print ev; + if config.DceConfig.cli.debug then Log_.item "%a@." print ev; if Exceptions.isEmpty exceptions then loop exnSet rest else let nestedExceptions = loop Exceptions.empty nestedEvents in @@ -187,8 +187,8 @@ module Checks = struct let add ~events ~exceptions ~loc ?(locFull = loc) ~moduleName exnName = checks := {events; exceptions; loc; locFull; moduleName; exnName} :: !checks - let doCheck {events; exceptions; loc; locFull; moduleName; exnName} = - let throwSet, exnTable = events |> Event.combine ~moduleName in + let doCheck ~config {events; exceptions; loc; locFull; moduleName; exnName} = + let throwSet, exnTable = events |> Event.combine ~config ~moduleName in let missingAnnotations = Exceptions.diff throwSet exceptions in let redundantAnnotations = Exceptions.diff exceptions throwSet in (if not (Exceptions.isEmpty missingAnnotations) then @@ -196,9 +196,9 @@ module Checks = struct Common.ExceptionAnalysisMissing {exnName; exnTable; throwSet; missingAnnotations; locFull} in - Log_.warning ~config:(DceConfig.current ()) ~loc description); + Log_.warning ~config ~loc description); if not (Exceptions.isEmpty redundantAnnotations) then - Log_.warning ~config:(DceConfig.current ()) ~loc + Log_.warning ~config ~loc (Common.ExceptionAnalysis { message = @@ -217,10 +217,10 @@ module Checks = struct redundantAnnotations); }) - let doChecks () = !checks |> List.rev |> List.iter doCheck + let doChecks ~config = !checks |> List.rev |> List.iter (doCheck ~config) end -let traverseAst () = +let traverseAst ~config () = ModulePath.init (); let super = Tast_mapper.default in let currentId = ref "" in @@ -281,7 +281,7 @@ let traverseAst () = in let calleeName = callee |> Common.Path.toName in if calleeName |> Name.toString |> isThrow then - Log_.warning ~config:(DceConfig.current ()) ~loc + Log_.warning ~config ~loc (Common.ExceptionAnalysis { message = @@ -474,14 +474,14 @@ let traverseAst () = let open Tast_mapper in {super with expr; value_binding; structure_item} -let processStructure (structure : Typedtree.structure) = - let traverseAst = traverseAst () in +let processStructure ~config (structure : Typedtree.structure) = + let traverseAst = traverseAst ~config () in structure |> traverseAst.structure traverseAst |> ignore -let processCmt (cmt_infos : Cmt_format.cmt_infos) = +let processCmt ~config (cmt_infos : Cmt_format.cmt_infos) = match cmt_infos.cmt_annots with | Interface _ -> () | Implementation structure -> Values.newCmt (); - structure |> processStructure + structure |> processStructure ~config | _ -> () diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml index a53e52dd60..6000549a73 100644 --- a/analysis/reanalyze/src/Reanalyze.ml +++ b/analysis/reanalyze/src/Reanalyze.ml @@ -33,8 +33,10 @@ let loadCmtFile ~config cmtFilePath = |> Name.create ~isInterface:(Filename.check_suffix !currentSrc "i"); if config.DceConfig.run.dce then cmt_infos |> DeadCode.processCmt ~config ~cmtFilePath; - if runConfig.exception_ then cmt_infos |> Exception.processCmt; - if runConfig.termination then cmt_infos |> Arnold.processCmt + if config.DceConfig.run.exception_ then + cmt_infos |> Exception.processCmt ~config; + if config.DceConfig.run.termination then + cmt_infos |> Arnold.processCmt ~config | _ -> () let processCmtFiles ~config ~cmtRoot = @@ -94,8 +96,10 @@ let runAnalysis ~dce_config ~cmtRoot = DeadCommon.reportDead ~config:dce_config ~checkOptionalArg:DeadOptionalArgs.check; WriteDeadAnnotations.write ~config:dce_config); - if runConfig.exception_ then Exception.Checks.doChecks (); - if runConfig.termination && !Common.Cli.debug then Arnold.reportStats () + if dce_config.DceConfig.run.exception_ then + Exception.Checks.doChecks ~config:dce_config; + if dce_config.DceConfig.run.termination && dce_config.DceConfig.cli.debug then + Arnold.reportStats ~config:dce_config let runAnalysisAndReport ~cmtRoot = Log_.Color.setup (); From 7936d69e74d8bef8cafb836bbb4cb173cbd91854 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 6 Dec 2025 06:53:00 +0100 Subject: [PATCH 8/8] DCE: Remove global file context, thread explicit file_context Task 1 of the dead code refactor plan: eliminate global mutable state for current file context. Changes: - Add DeadCommon.FileContext.t with source_path, module_name, is_interface - Thread ~file parameter through DeadCode, DeadValue, DeadType, DeadCommon - Thread ~file through Exception.processCmt and Arnold.processCmt - Remove Common.currentSrc, currentModule, currentModuleName globals Design improvement: - FileContext.module_name is now a raw string (e.g. "ExnB"), not Name.t - Added FileContext.module_name_tagged helper to create Name.t when needed - This avoids confusion: raw name for hashtable keys, tagged name for paths - Previously the interface encoding (+prefix) leaked into code that expected raw names This makes it possible to process files concurrently or out of order, as analysis no longer depends on hidden global state for file context. --- analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md | 26 +++++--- analysis/reanalyze/src/Arnold.ml | 14 ++--- analysis/reanalyze/src/Common.ml | 3 - analysis/reanalyze/src/DeadCode.ml | 17 ++--- analysis/reanalyze/src/DeadCommon.ml | 26 +++++--- analysis/reanalyze/src/DeadException.ml | 13 ++-- analysis/reanalyze/src/DeadModules.ml | 2 +- analysis/reanalyze/src/DeadOptionalArgs.ml | 6 +- analysis/reanalyze/src/DeadType.ml | 14 +++-- analysis/reanalyze/src/DeadValue.ml | 66 +++++++++++--------- analysis/reanalyze/src/Exception.ml | 32 +++++----- analysis/reanalyze/src/Log_.ml | 2 +- analysis/reanalyze/src/Reanalyze.ml | 21 ++++--- 13 files changed, 134 insertions(+), 108 deletions(-) diff --git a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md index 2b8a0dc261..ed83c9bd3e 100644 --- a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md +++ b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md @@ -21,6 +21,8 @@ **Used by**: `DeadCommon.addDeclaration_`, `DeadType.addTypeDependenciesAcrossFiles`, `DeadValue` path construction. +**Status**: ✅ FIXED in Task 1 - explicit `file_context` now threaded through all analysis functions. + ### P2: Global analysis tables **Problem**: All analysis results accumulate in global hashtables: - `DeadCommon.decls` - all declarations @@ -42,6 +44,8 @@ ### P4: Global configuration reads **Problem**: Analysis code directly reads `!Common.Cli.debug`, `RunConfig.runConfig.transitive`, etc. scattered throughout. Can't run analysis with different configs without mutating globals. +**Status**: ✅ FIXED in Task 2 - explicit `config` now threaded through all analysis functions. + ### P5: Side effects mixed with analysis **Problem**: Analysis functions directly call: - `Log_.warning` - logging @@ -135,10 +139,13 @@ Each task should: **Value**: Makes it possible to process files concurrently or out of order. **Changes**: -- [ ] Create `DeadFileContext.t` type with `source_path`, `module_name`, `is_interface` fields -- [ ] Thread through `DeadCode.processCmt`, `DeadValue`, `DeadType`, `DeadCommon.addDeclaration_` -- [ ] Remove all reads of `Common.currentSrc`, `currentModule`, `currentModuleName` from DCE code -- [ ] Delete the globals (or mark as deprecated if still used by Exception/Arnold) +- [x] Create `DeadCommon.FileContext.t` type with `source_path`, `module_name`, `is_interface` fields +- [x] Thread through `DeadCode.processCmt`, `DeadValue`, `DeadType`, `DeadCommon.addDeclaration_` +- [x] Thread through `Exception.processCmt`, `Arnold.processCmt` +- [x] Remove all reads of `Common.currentSrc`, `currentModule`, `currentModuleName` from DCE code +- [x] Delete the globals `currentSrc`, `currentModule`, `currentModuleName` from `Common.ml` + +**Status**: Complete ✅ **Test**: Run analysis on same files but vary the order - should get identical results. @@ -288,14 +295,15 @@ Each task should: ## Execution Strategy -**Recommended order**: 1 → 2 (complete all analyses) → 3 → 4 → 5 → 6 → 7 → 8 → 9 → 10 (verify) → 11 (test) +**Completed**: Task 1 ✅, Task 2 ✅, Task 10 ✅ + +**Remaining order**: 3 → 4 → 5 → 6 → 7 → 8 → 9 → 11 (test) **Why this order?** -- Tasks 1-2 remove implicit dependencies (file context, config) - these are foundational -- Task 2 must be **fully complete** (DCE + Exception + Arnold) before proceeding -- Tasks 3-7 localize global state - can be done incrementally once inputs are explicit +- Tasks 1-2 remove implicit dependencies (file context, config) - ✅ DONE +- Tasks 3-7 localize global state - can be done incrementally now that inputs are explicit - Tasks 8-9 separate pure/impure - can only do this once state is local -- Task 10 verifies no global config reads remain +- Task 10 verifies no global config reads remain - ✅ DONE - Task 11 validates everything **Alternative**: Could do 3-7 in any order (they're mostly independent). diff --git a/analysis/reanalyze/src/Arnold.ml b/analysis/reanalyze/src/Arnold.ml index e065d0748d..cc917725a9 100644 --- a/analysis/reanalyze/src/Arnold.ml +++ b/analysis/reanalyze/src/Arnold.ml @@ -111,7 +111,7 @@ module Stats = struct incr nCacheChecks; if hit then incr nCacheHits; if config.DceConfig.cli.debug then - Log_.warning ~config ~forStats:false ~loc + Log_.warning ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -125,7 +125,7 @@ module Stats = struct let logResult ~config ~functionCall ~loc ~resString = if config.DceConfig.cli.debug then - Log_.warning ~config ~forStats:false ~loc + Log_.warning ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -611,7 +611,7 @@ module ExtendFunctionTable = struct then ( functionTable |> FunctionTable.addFunction ~functionName; if config.DceConfig.cli.debug then - Log_.warning ~config ~forStats:false ~loc + Log_.warning ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -633,7 +633,7 @@ module ExtendFunctionTable = struct functionTable |> FunctionTable.addLabelToKind ~functionName ~label; if config.DceConfig.cli.debug then - Log_.warning ~config ~forStats:false ~loc + Log_.warning ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -700,7 +700,7 @@ module CheckExpressionWellFormed = struct functionTable |> FunctionTable.addLabelToKind ~functionName ~label; if config.DceConfig.cli.debug then - Log_.warning ~config ~forStats:false ~loc:body.exp_loc + Log_.warning ~forStats:false ~loc:body.exp_loc (Termination { termination = TerminationAnalysisInternal; @@ -879,7 +879,7 @@ module Compile = struct newFunctionName; newFunctionDefinition.body <- Some (vb_expr |> expression ~ctx:newCtx); if config.DceConfig.cli.debug then - Log_.warning ~config ~forStats:false ~loc:pat_loc + Log_.warning ~forStats:false ~loc:pat_loc (Termination { termination = TerminationAnalysisInternal; @@ -1410,7 +1410,7 @@ let processStructure ~config (structure : Typedtree.structure) = let traverseAst = traverseAst ~config ~valueBindingsTable in structure |> traverseAst.structure traverseAst |> ignore -let processCmt ~config (cmt_infos : Cmt_format.cmt_infos) = +let processCmt ~config ~file:_ (cmt_infos : Cmt_format.cmt_infos) = match cmt_infos.cmt_annots with | Interface _ -> () | Implementation structure -> processStructure ~config structure diff --git a/analysis/reanalyze/src/Common.ml b/analysis/reanalyze/src/Common.ml index 9e4d1c3352..3d71075d30 100644 --- a/analysis/reanalyze/src/Common.ml +++ b/analysis/reanalyze/src/Common.ml @@ -1,6 +1,3 @@ -let currentSrc = ref "" -let currentModule = ref "" -let currentModuleName = ref ("" |> Name.create) let runConfig = RunConfig.runConfig (* Location printer: `filename:line: ' *) diff --git a/analysis/reanalyze/src/DeadCode.ml b/analysis/reanalyze/src/DeadCode.ml index 8dfa4d9815..561faa8c14 100644 --- a/analysis/reanalyze/src/DeadCode.ml +++ b/analysis/reanalyze/src/DeadCode.ml @@ -1,32 +1,35 @@ open DeadCommon -let processSignature ~config ~doValues ~doTypes (signature : Types.signature) = +let processSignature ~config ~file ~doValues ~doTypes + (signature : Types.signature) = signature |> List.iter (fun sig_item -> - DeadValue.processSignatureItem ~config ~doValues ~doTypes + DeadValue.processSignatureItem ~config ~file ~doValues ~doTypes ~moduleLoc:Location.none - ~path:[!Common.currentModuleName] + ~path:[FileContext.module_name_tagged file] sig_item) -let processCmt ~config ~cmtFilePath (cmt_infos : Cmt_format.cmt_infos) = +let processCmt ~config ~file ~cmtFilePath (cmt_infos : Cmt_format.cmt_infos) = (match cmt_infos.cmt_annots with | Interface signature -> ProcessDeadAnnotations.signature ~config signature; - processSignature ~config ~doValues:true ~doTypes:true signature.sig_type + processSignature ~config ~file ~doValues:true ~doTypes:true + signature.sig_type | Implementation structure -> let cmtiExists = Sys.file_exists ((cmtFilePath |> Filename.remove_extension) ^ ".cmti") in ProcessDeadAnnotations.structure ~config ~doGenType:(not cmtiExists) structure; - processSignature ~config ~doValues:true ~doTypes:false structure.str_type; + processSignature ~config ~file ~doValues:true ~doTypes:false + structure.str_type; let doExternals = (* This is already handled at the interface level, avoid issues in inconsistent locations https://github.com/BuckleScript/syntax/pull/54 Ideally, the handling should be less location-based, just like other language aspects. *) false in - DeadValue.processStructure ~config ~doTypes:true ~doExternals + DeadValue.processStructure ~config ~file ~doTypes:true ~doExternals ~cmt_value_dependencies:cmt_infos.cmt_value_dependencies structure | _ -> ()); DeadType.TypeDependencies.forceDelayedItems ~config; diff --git a/analysis/reanalyze/src/DeadCommon.ml b/analysis/reanalyze/src/DeadCommon.ml index d525c6cac8..27feffefba 100644 --- a/analysis/reanalyze/src/DeadCommon.ml +++ b/analysis/reanalyze/src/DeadCommon.ml @@ -1,3 +1,11 @@ +module FileContext = struct + type t = {source_path: string; module_name: string; is_interface: bool} + + (** Get module name as Name.t tagged with interface/implementation info *) + let module_name_tagged file = + file.module_name |> Name.create ~isInterface:file.is_interface +end + (* Adapted from https://github.com/LexiFi/dead_code_analyzer *) open Common @@ -170,7 +178,7 @@ let iterFilesFromRootsToLeaves ~config iterFun = {Location.none with loc_start = pos; loc_end = pos} in if Config.warnOnCircularDependencies then - Log_.warning ~config ~loc + Log_.warning ~loc (Circular { message = @@ -355,8 +363,9 @@ module ProcessDeadAnnotations = struct |> ignore end -let addDeclaration_ ~config ?posEnd ?posStart ~declKind ~path - ~(loc : Location.t) ?(posAdjustment = Nothing) ~moduleLoc (name : Name.t) = +let addDeclaration_ ~config ~(file : FileContext.t) ?posEnd ?posStart ~declKind + ~path ~(loc : Location.t) ?(posAdjustment = Nothing) ~moduleLoc + (name : Name.t) = let pos = loc.loc_start in let posStart = match posStart with @@ -373,10 +382,7 @@ let addDeclaration_ ~config ?posEnd ?posStart ~declKind ~path module M : Set.S with type elt = int will create value definitions whose location is in set.mli *) - if - (not loc.loc_ghost) - && (!currentSrc = pos.pos_fname || !currentModule == "*include*") - then ( + if (not loc.loc_ghost) && pos.pos_fname = file.source_path then ( if config.DceConfig.cli.debug then Log_.item "add%sDeclaration %s %s path:%s@." (declKind |> DeclKind.toString) @@ -396,10 +402,10 @@ let addDeclaration_ ~config ?posEnd ?posStart ~declKind ~path in PosHash.replace decls pos decl) -let addValueDeclaration ~config ?(isToplevel = true) ~(loc : Location.t) +let addValueDeclaration ~config ~file ?(isToplevel = true) ~(loc : Location.t) ~moduleLoc ?(optionalArgs = OptionalArgs.empty) ~path ~sideEffects name = name - |> addDeclaration_ ~config + |> addDeclaration_ ~config ~file ~declKind:(Value {isToplevel; optionalArgs; sideEffects}) ~loc ~moduleLoc ~path @@ -423,7 +429,7 @@ let emitWarning ~config ~decl ~message deadWarning = decl.path |> Path.toModuleName ~isType:(decl.declKind |> DeclKind.isType) |> DeadModules.checkModuleDead ~config ~fileName:decl.pos.pos_fname; - Log_.warning ~config ~loc + Log_.warning ~loc (DeadWarning { deadWarning; diff --git a/analysis/reanalyze/src/DeadException.ml b/analysis/reanalyze/src/DeadException.ml index d069e9e11a..01509c8fa2 100644 --- a/analysis/reanalyze/src/DeadException.ml +++ b/analysis/reanalyze/src/DeadException.ml @@ -6,12 +6,13 @@ type item = {exceptionPath: Path.t; locFrom: Location.t} let delayedItems = ref [] let declarations = Hashtbl.create 1 -let add ~config ~path ~loc ~(strLoc : Location.t) name = +let add ~config ~file ~path ~loc ~(strLoc : Location.t) name = let exceptionPath = name :: path in Hashtbl.add declarations exceptionPath loc; name - |> addDeclaration_ ~config ~posEnd:strLoc.loc_end ~posStart:strLoc.loc_start - ~declKind:Exception ~moduleLoc:(ModulePath.getCurrent ()).loc ~path ~loc + |> addDeclaration_ ~config ~file ~posEnd:strLoc.loc_end + ~posStart:strLoc.loc_start ~declKind:Exception + ~moduleLoc:(ModulePath.getCurrent ()).loc ~path ~loc let forceDelayedItems ~config = let items = !delayedItems |> List.rev in @@ -22,7 +23,7 @@ let forceDelayedItems ~config = | None -> () | Some locTo -> (* Delayed exception references don't need a binding context; use an empty state. *) - DeadCommon.addValueReference ~config ~binding:Location.none + addValueReference ~config ~binding:Location.none ~addFileReference:true ~locFrom ~locTo) let markAsUsed ~config ~(binding : Location.t) ~(locFrom : Location.t) @@ -33,6 +34,4 @@ let markAsUsed ~config ~(binding : Location.t) ~(locFrom : Location.t) path_ |> Path.fromPathT |> Path.moduleToImplementation in delayedItems := {exceptionPath; locFrom} :: !delayedItems - else - DeadCommon.addValueReference ~config ~binding ~addFileReference:true - ~locFrom ~locTo + else addValueReference ~config ~binding ~addFileReference:true ~locFrom ~locTo diff --git a/analysis/reanalyze/src/DeadModules.ml b/analysis/reanalyze/src/DeadModules.ml index 66c6697bb0..924a80bd30 100644 --- a/analysis/reanalyze/src/DeadModules.ml +++ b/analysis/reanalyze/src/DeadModules.ml @@ -33,7 +33,7 @@ let checkModuleDead ~config ~fileName:pos_fname moduleName = {Location.loc_start = pos; loc_end = pos; loc_ghost = false} else loc in - Log_.warning ~config ~loc + Log_.warning ~loc (Common.DeadModule { message = diff --git a/analysis/reanalyze/src/DeadOptionalArgs.ml b/analysis/reanalyze/src/DeadOptionalArgs.ml index a253c4e748..00e6faeaff 100644 --- a/analysis/reanalyze/src/DeadOptionalArgs.ml +++ b/analysis/reanalyze/src/DeadOptionalArgs.ml @@ -81,14 +81,14 @@ let forceDelayedItems () = OptionalArgs.combine rFrom.optionalArgs rTo.optionalArgs | _ -> ()) -let check ~config decl = +let check ~config:_ decl = match decl with | {declKind = Value {optionalArgs}} when active () && not (ProcessDeadAnnotations.isAnnotatedGenTypeOrLive decl.pos) -> optionalArgs |> OptionalArgs.iterUnused (fun s -> - Log_.warning ~config ~loc:(decl |> declGetLoc) + Log_.warning ~loc:(decl |> declGetLoc) (DeadOptional { deadOptional = WarningUnusedArgument; @@ -101,7 +101,7 @@ let check ~config decl = })); optionalArgs |> OptionalArgs.iterAlwaysUsed (fun s nCalls -> - Log_.warning ~config ~loc:(decl |> declGetLoc) + Log_.warning ~loc:(decl |> declGetLoc) (DeadOptional { deadOptional = WarningRedundantOptionalArgument; diff --git a/analysis/reanalyze/src/DeadType.ml b/analysis/reanalyze/src/DeadType.ml index 64f4747a68..2144c30d7c 100644 --- a/analysis/reanalyze/src/DeadType.ml +++ b/analysis/reanalyze/src/DeadType.ml @@ -41,8 +41,9 @@ let extendTypeDependencies ~config (loc1 : Location.t) (loc2 : Location.t) = TypeDependencies.add loc1 loc2) (* Type dependencies between Foo.re and Foo.rei *) -let addTypeDependenciesAcrossFiles ~config ~pathToType ~loc ~typeLabelName = - let isInterface = Filename.check_suffix !Common.currentSrc "i" in +let addTypeDependenciesAcrossFiles ~config ~file ~pathToType ~loc ~typeLabelName + = + let isInterface = file.FileContext.is_interface in if not isInterface then ( let path_1 = pathToType |> Path.moduleToInterface in let path_2 = path_1 |> Path.typeToInterface in @@ -80,17 +81,18 @@ let addTypeDependenciesInnerModule ~config ~pathToType ~loc ~typeLabelName = extendTypeDependencies ~config loc2 loc | None -> TypeLabels.add path loc -let addDeclaration ~config ~(typeId : Ident.t) ~(typeKind : Types.type_kind) = +let addDeclaration ~config ~file ~(typeId : Ident.t) + ~(typeKind : Types.type_kind) = let currentModulePath = ModulePath.getCurrent () in let pathToType = (typeId |> Ident.name |> Name.create) - :: (currentModulePath.path @ [!Common.currentModuleName]) + :: (currentModulePath.path @ [FileContext.module_name_tagged file]) in let processTypeLabel ?(posAdjustment = Nothing) typeLabelName ~declKind ~(loc : Location.t) = - addDeclaration_ ~config ~declKind ~path:pathToType ~loc + addDeclaration_ ~config ~file ~declKind ~path:pathToType ~loc ~moduleLoc:currentModulePath.loc ~posAdjustment typeLabelName; - addTypeDependenciesAcrossFiles ~config ~pathToType ~loc ~typeLabelName; + addTypeDependenciesAcrossFiles ~config ~file ~pathToType ~loc ~typeLabelName; addTypeDependenciesInnerModule ~config ~pathToType ~loc ~typeLabelName; TypeLabels.add (typeLabelName :: pathToType) loc in diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index 62d5db8aed..c73443cf7e 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -2,23 +2,23 @@ open DeadCommon -let checkAnyValueBindingWithNoSideEffects ~config +let checkAnyValueBindingWithNoSideEffects ~config ~file ({vb_pat = {pat_desc}; vb_expr = expr; vb_loc = loc} : Typedtree.value_binding) = match pat_desc with | Tpat_any when (not (SideEffects.checkExpr expr)) && not loc.loc_ghost -> let name = "_" |> Name.create ~isInterface:false in let currentModulePath = ModulePath.getCurrent () in - let path = currentModulePath.path @ [!Common.currentModuleName] in + let path = currentModulePath.path @ [FileContext.module_name_tagged file] in name - |> addValueDeclaration ~config ~path ~loc ~moduleLoc:currentModulePath.loc - ~sideEffects:false + |> addValueDeclaration ~config ~file ~path ~loc + ~moduleLoc:currentModulePath.loc ~sideEffects:false | _ -> () -let collectValueBinding ~config ~(current_binding : Location.t) +let collectValueBinding ~config ~file ~(current_binding : Location.t) (vb : Typedtree.value_binding) = let oldLastBinding = current_binding in - checkAnyValueBindingWithNoSideEffects ~config vb; + checkAnyValueBindingWithNoSideEffects ~config ~file vb; let loc = match vb.vb_pat.pat_desc with | Tpat_var (id, {loc = {loc_start; loc_ghost} as loc}) @@ -38,7 +38,9 @@ let collectValueBinding ~config ~(current_binding : Location.t) | _ -> false in let currentModulePath = ModulePath.getCurrent () in - let path = currentModulePath.path @ [!Common.currentModuleName] in + let path = + currentModulePath.path @ [FileContext.module_name_tagged file] + in let isFirstClassModule = match vb.vb_expr.exp_type.desc with | Tpackage _ -> true @@ -49,7 +51,7 @@ let collectValueBinding ~config ~(current_binding : Location.t) let isToplevel = oldLastBinding = Location.none in let sideEffects = SideEffects.checkExpr vb.vb_expr in name - |> addValueDeclaration ~config ~isToplevel ~loc + |> addValueDeclaration ~config ~file ~isToplevel ~loc ~moduleLoc:currentModulePath.loc ~optionalArgs ~path ~sideEffects); (match PosHash.find_opt decls loc_start with | None -> () @@ -123,8 +125,7 @@ let rec collectExpr ~config ~(last_binding : Location.t) super self (locTo.loc_start |> Common.posToString); ValueReferences.add locTo.loc_start Location.none.loc_start) else - DeadCommon.addValueReference ~config ~binding ~addFileReference:true - ~locFrom ~locTo + addValueReference ~config ~binding ~addFileReference:true ~locFrom ~locTo | Texp_apply { funct = @@ -236,13 +237,13 @@ let rec getSignature (moduleType : Types.module_type) = | Mty_functor (_, _mtParam, mt) -> getSignature mt | _ -> [] -let rec processSignatureItem ~config ~doTypes ~doValues ~moduleLoc ~path +let rec processSignatureItem ~config ~file ~doTypes ~doValues ~moduleLoc ~path (si : Types.signature_item) = let oldModulePath = ModulePath.getCurrent () in (match si with | Sig_type (id, t, _) when doTypes -> if !Config.analyzeTypes then - DeadType.addDeclaration ~config ~typeId:id ~typeKind:t.type_kind + DeadType.addDeclaration ~config ~file ~typeId:id ~typeKind:t.type_kind | Sig_value (id, {Types.val_loc = loc; val_kind = kind; val_type}) when doValues -> if not loc.Location.loc_ghost then @@ -261,7 +262,7 @@ let rec processSignatureItem ~config ~doTypes ~doValues ~moduleLoc ~path Printf.printf "XXX %s\n" (Ident.name id); *) Ident.name id |> Name.create ~isInterface:false - |> addValueDeclaration ~config ~loc ~moduleLoc ~optionalArgs ~path + |> addValueDeclaration ~config ~file ~loc ~moduleLoc ~optionalArgs ~path ~sideEffects:false | Sig_module (id, {Types.md_type = moduleType; md_loc = moduleLoc}, _) | Sig_modtype (id, {Types.mtd_type = Some moduleType; mtd_loc = moduleLoc}) -> @@ -279,13 +280,13 @@ let rec processSignatureItem ~config ~doTypes ~doValues ~moduleLoc ~path if collect then getSignature moduleType |> List.iter - (processSignatureItem ~config ~doTypes ~doValues ~moduleLoc + (processSignatureItem ~config ~file ~doTypes ~doValues ~moduleLoc ~path:((id |> Ident.name |> Name.create) :: path)) | _ -> ()); ModulePath.setCurrent oldModulePath (* Traverse the AST *) -let traverseStructure ~config ~doTypes ~doExternals +let traverseStructure ~config ~file ~doTypes ~doExternals (structure : Typedtree.structure) : unit = let rec create_mapper (last_binding : Location.t) = let super = Tast_mapper.default in @@ -317,15 +318,17 @@ let traverseStructure ~config ~doTypes ~doExternals | Mty_signature signature -> signature |> List.iter - (processSignatureItem ~config ~doTypes ~doValues:false - ~moduleLoc:mb_expr.mod_loc + (processSignatureItem ~config ~file ~doTypes + ~doValues:false ~moduleLoc:mb_expr.mod_loc ~path: ((ModulePath.getCurrent ()).path - @ [!Common.currentModuleName])) + @ [FileContext.module_name_tagged file])) | _ -> ()) | Tstr_primitive vd when doExternals && !Config.analyzeExternals -> let currentModulePath = ModulePath.getCurrent () in - let path = currentModulePath.path @ [!Common.currentModuleName] in + let path = + currentModulePath.path @ [FileContext.module_name_tagged file] + in let exists = match PosHash.find_opt decls vd.val_loc.loc_start with | Some {declKind = Value _} -> true @@ -339,35 +342,37 @@ let traverseStructure ~config ~doTypes ~doExternals then id |> Name.create ~isInterface:false - |> addValueDeclaration ~config ~path ~loc:vd.val_loc + |> addValueDeclaration ~config ~file ~path ~loc:vd.val_loc ~moduleLoc:currentModulePath.loc ~sideEffects:false | Tstr_type (_recFlag, typeDeclarations) when doTypes -> if !Config.analyzeTypes then typeDeclarations |> List.iter (fun (typeDeclaration : Typedtree.type_declaration) -> - DeadType.addDeclaration ~config + DeadType.addDeclaration ~config ~file ~typeId:typeDeclaration.typ_id ~typeKind:typeDeclaration.typ_type.type_kind) | Tstr_include {incl_mod; incl_type} -> ( match incl_mod.mod_desc with | Tmod_ident (_path, _lid) -> let currentPath = - (ModulePath.getCurrent ()).path @ [!Common.currentModuleName] + (ModulePath.getCurrent ()).path + @ [FileContext.module_name_tagged file] in incl_type |> List.iter - (processSignatureItem ~config ~doTypes + (processSignatureItem ~config ~file ~doTypes ~doValues:false (* TODO: also values? *) ~moduleLoc:incl_mod.mod_loc ~path:currentPath) | _ -> ()) | Tstr_exception {ext_id = id; ext_loc = loc} -> let path = - (ModulePath.getCurrent ()).path @ [!Common.currentModuleName] + (ModulePath.getCurrent ()).path + @ [FileContext.module_name_tagged file] in let name = id |> Ident.name |> Name.create in name - |> DeadException.add ~config ~path ~loc + |> DeadException.add ~config ~file ~path ~loc ~strLoc:structureItem.str_loc | _ -> ()); let result = super.structure_item mapper structureItem in @@ -376,7 +381,8 @@ let traverseStructure ~config ~doTypes ~doExternals value_binding = (fun _self vb -> let loc = - vb |> collectValueBinding ~config ~current_binding:last_binding + vb + |> collectValueBinding ~config ~file ~current_binding:last_binding in let nested_mapper = create_mapper loc in super.Tast_mapper.value_binding nested_mapper vb); @@ -403,12 +409,12 @@ let processValueDependency ~config Types.value_description) ) = if (not ghost1) && (not ghost2) && posTo <> posFrom then ( let addFileReference = fileIsImplementationOf fnTo fnFrom in - DeadCommon.addValueReference ~config ~binding:Location.none - ~addFileReference ~locFrom ~locTo; + addValueReference ~config ~binding:Location.none ~addFileReference ~locFrom + ~locTo; DeadOptionalArgs.addFunctionReference ~config ~locFrom ~locTo) -let processStructure ~config ~cmt_value_dependencies ~doTypes ~doExternals +let processStructure ~config ~file ~cmt_value_dependencies ~doTypes ~doExternals (structure : Typedtree.structure) = - traverseStructure ~config ~doTypes ~doExternals structure; + traverseStructure ~config ~file ~doTypes ~doExternals structure; let valueDependencies = cmt_value_dependencies |> List.rev in valueDependencies |> List.iter (processValueDependency ~config) diff --git a/analysis/reanalyze/src/Exception.ml b/analysis/reanalyze/src/Exception.ml index 0bca11a9b0..b9822e383c 100644 --- a/analysis/reanalyze/src/Exception.ml +++ b/analysis/reanalyze/src/Exception.ml @@ -1,6 +1,6 @@ -let posToString = Common.posToString - +open DeadCommon module LocSet = Common.LocSet +let posToString = Common.posToString module Values = struct let valueBindingsTable = @@ -57,9 +57,9 @@ module Values = struct | [] -> None) | Some exceptions -> Some exceptions - let newCmt () = + let newCmt ~moduleName = currentFileTable := Hashtbl.create 15; - Hashtbl.replace valueBindingsTable !Common.currentModule !currentFileTable + Hashtbl.replace valueBindingsTable moduleName !currentFileTable end module Event = struct @@ -143,7 +143,7 @@ module Event = struct | {kind = Call {callee}} :: _ -> callee |> Common.Path.toName | _ -> "expression" |> Name.create in - Log_.warning ~config ~loc + Log_.warning ~loc (Common.ExceptionAnalysis { message = @@ -196,9 +196,9 @@ module Checks = struct Common.ExceptionAnalysisMissing {exnName; exnTable; throwSet; missingAnnotations; locFull} in - Log_.warning ~config ~loc description); + Log_.warning ~loc description); if not (Exceptions.isEmpty redundantAnnotations) then - Log_.warning ~config ~loc + Log_.warning ~loc (Common.ExceptionAnalysis { message = @@ -220,7 +220,7 @@ module Checks = struct let doChecks ~config = !checks |> List.rev |> List.iter (doCheck ~config) end -let traverseAst ~config () = +let traverseAst ~file () = ModulePath.init (); let super = Tast_mapper.default in let currentId = ref "" in @@ -281,7 +281,7 @@ let traverseAst ~config () = in let calleeName = callee |> Common.Path.toName in if calleeName |> Name.toString |> isThrow then - Log_.warning ~config ~loc + Log_.warning ~loc (Common.ExceptionAnalysis { message = @@ -394,7 +394,7 @@ let traverseAst ~config () = let name = "Toplevel expression" in currentId := name; currentEvents := []; - let moduleName = !Common.currentModule in + let moduleName = file.FileContext.module_name in self.expr self expr |> ignore; Checks.add ~events:!currentEvents ~exceptions:(getExceptionsFromAnnotations attributes) @@ -442,7 +442,7 @@ let traverseAst ~config () = in exceptionsFromAnnotations |> Values.add ~name; let res = super.value_binding self vb in - let moduleName = !Common.currentModule in + let moduleName = file.FileContext.module_name in let path = [name |> Name.create] in let exceptions = match @@ -474,14 +474,14 @@ let traverseAst ~config () = let open Tast_mapper in {super with expr; value_binding; structure_item} -let processStructure ~config (structure : Typedtree.structure) = - let traverseAst = traverseAst ~config () in +let processStructure ~file (structure : Typedtree.structure) = + let traverseAst = traverseAst ~file () in structure |> traverseAst.structure traverseAst |> ignore -let processCmt ~config (cmt_infos : Cmt_format.cmt_infos) = +let processCmt ~file (cmt_infos : Cmt_format.cmt_infos) = match cmt_infos.cmt_annots with | Interface _ -> () | Implementation structure -> - Values.newCmt (); - structure |> processStructure ~config + Values.newCmt ~moduleName:file.FileContext.module_name; + structure |> processStructure ~file | _ -> () diff --git a/analysis/reanalyze/src/Log_.ml b/analysis/reanalyze/src/Log_.ml index 8f1665294c..166482d886 100644 --- a/analysis/reanalyze/src/Log_.ml +++ b/analysis/reanalyze/src/Log_.ml @@ -247,7 +247,7 @@ let logIssue ~forStats ~severity ~(loc : Location.t) description = if Suppress.filter loc.loc_start then if forStats then Stats.addIssue {name; severity; loc; description} -let warning ~config ?(forStats = true) ~loc description = +let warning ?(forStats = true) ~loc description = description |> logIssue ~severity:Warning ~forStats ~loc let error ~loc description = diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml index 6000549a73..430ee4216f 100644 --- a/analysis/reanalyze/src/Reanalyze.ml +++ b/analysis/reanalyze/src/Reanalyze.ml @@ -17,6 +17,16 @@ let loadCmtFile ~config cmtFilePath = in match cmt_infos.cmt_annots |> FindSourceFile.cmt with | Some sourceFile when not (excludePath sourceFile) -> + let is_interface = + match cmt_infos.cmt_annots with + | Interface _ -> true + | _ -> Filename.check_suffix sourceFile "i" + in + let module_name = sourceFile |> Paths.getModuleName in + let file_context = + DeadCommon.FileContext. + {source_path = sourceFile; module_name; is_interface} + in if config.cli.debug then Log_.item "Scanning %s Source:%s@." (match config.cli.ci && not (Filename.is_relative cmtFilePath) with @@ -26,17 +36,12 @@ let loadCmtFile ~config cmtFilePath = | true -> sourceFile |> Filename.basename | false -> sourceFile); FileReferences.addFile sourceFile; - currentSrc := sourceFile; - currentModule := Paths.getModuleName sourceFile; - currentModuleName := - !currentModule - |> Name.create ~isInterface:(Filename.check_suffix !currentSrc "i"); if config.DceConfig.run.dce then - cmt_infos |> DeadCode.processCmt ~config ~cmtFilePath; + cmt_infos |> DeadCode.processCmt ~config ~file:file_context ~cmtFilePath; if config.DceConfig.run.exception_ then - cmt_infos |> Exception.processCmt ~config; + cmt_infos |> Exception.processCmt ~file:file_context; if config.DceConfig.run.termination then - cmt_infos |> Arnold.processCmt ~config + cmt_infos |> Arnold.processCmt ~config ~file:file_context | _ -> () let processCmtFiles ~config ~cmtRoot =