diff --git a/AGENTS.md b/AGENTS.md index 9afb254749..f1cfc63048 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -42,6 +42,9 @@ 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. + +- **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. diff --git a/analysis/reanalyze/ARCHITECTURE.md b/analysis/reanalyze/ARCHITECTURE.md new file mode 100644 index 0000000000..23e6e5c662 --- /dev/null +++ b/analysis/reanalyze/ARCHITECTURE.md @@ -0,0 +1,225 @@ +# Dead Code Analysis Architecture + +This document describes the architecture of the reanalyze dead code analysis pipeline. + +## Overview + +The DCE (Dead Code Elimination) analysis is structured as a **pure pipeline** with four phases: + +1. **MAP** - Process each `.cmt` file independently → per-file data +2. **MERGE** - Combine all per-file data → immutable project-wide view +3. **SOLVE** - Compute dead/live status → immutable result with issues +4. **REPORT** - Output issues (side effects only here) + +This design enables: +- **Order independence** - Processing files in any order gives identical results +- **Incremental updates** - Replace one file's data without reprocessing others +- **Testability** - Each phase is independently testable with pure functions +- **Parallelization potential** - Phases 1-3 work on immutable data + +--- + +## Pipeline Diagram + +``` +┌─────────────────────────────────────────────────────────────────────────────┐ +│ DCE ANALYSIS PIPELINE │ +└─────────────────────────────────────────────────────────────────────────────┘ + + ┌─────────────┐ + │ DceConfig.t │ (explicit configuration) + └──────┬──────┘ + │ + ╔════════════════════════════════╪════════════════════════════════════════╗ + ║ PHASE 1: MAP (per-file) │ ║ + ╠════════════════════════════════╪════════════════════════════════════════╣ + ║ ▼ ║ + ║ ┌──────────┐ process_cmt_file ┌───────────────────────────────┐ ║ + ║ │ file1.cmt├──────────────────────►│ file_data { │ ║ + ║ └──────────┘ │ annotations: builder │ ║ + ║ ┌──────────┐ process_cmt_file │ decls: builder │ ║ + ║ │ file2.cmt├──────────────────────►│ refs: builder │ ║ + ║ └──────────┘ │ file_deps: builder │ ║ + ║ ┌──────────┐ process_cmt_file │ cross_file: builder │ ║ + ║ │ file3.cmt├──────────────────────►│ } │ ║ + ║ └──────────┘ └───────────────────────────────┘ ║ + ║ │ ║ + ║ Local mutable state OK │ file_data list ║ + ╚══════════════════════════════════════════════════╪══════════════════════╝ + │ + ╔══════════════════════════════════════════════════╪══════════════════════╗ + ║ PHASE 2: MERGE (combine builders) │ ║ + ╠══════════════════════════════════════════════════╪══════════════════════╣ + ║ ▼ ║ + ║ ┌─────────────────────────────────────────────────────────────────┐ ║ + ║ │ FileAnnotations.merge_all → annotations: FileAnnotations.t │ ║ + ║ │ Declarations.merge_all → decls: Declarations.t │ ║ + ║ │ References.merge_all → refs: References.t │ ║ + ║ │ FileDeps.merge_all → file_deps: FileDeps.t │ ║ + ║ │ CrossFileItems.merge_all → cross_file: CrossFileItems.t │ ║ + ║ │ │ ║ + ║ │ CrossFileItems.compute_optional_args_state │ ║ + ║ │ → optional_args_state: State.t │ ║ + ║ └─────────────────────────────────────────────────────────────────┘ ║ + ║ │ ║ + ║ Pure functions, immutable output │ merged data ║ + ╚══════════════════════════════════════════════════╪══════════════════════╝ + │ + ╔══════════════════════════════════════════════════╪══════════════════════╗ + ║ PHASE 3: SOLVE (pure deadness computation) │ ║ + ╠══════════════════════════════════════════════════╪══════════════════════╣ + ║ ▼ ║ + ║ ┌─────────────────────────────────────────────────────────────────┐ ║ + ║ │ DeadCommon.solveDead │ ║ + ║ │ ~annotations ~decls ~refs ~file_deps │ ║ + ║ │ ~optional_args_state ~config ~checkOptionalArg │ ║ + ║ │ │ ║ + ║ │ → AnalysisResult.t { issues: Issue.t list } │ ║ + ║ └─────────────────────────────────────────────────────────────────┘ ║ + ║ │ ║ + ║ Pure function: immutable in → immutable out │ issues ║ + ╚══════════════════════════════════════════════════╪══════════════════════╝ + │ + ╔══════════════════════════════════════════════════╪══════════════════════╗ + ║ PHASE 4: REPORT (side effects at the edge) │ ║ + ╠══════════════════════════════════════════════════╪══════════════════════╣ + ║ ▼ ║ + ║ ┌─────────────────────────────────────────────────────────────────┐ ║ + ║ │ AnalysisResult.get_issues │ ║ + ║ │ |> List.iter (fun issue -> Log_.warning ~loc issue.description) │ ║ + ║ │ │ ║ + ║ │ (Optional: EmitJson for JSON output) │ ║ + ║ └─────────────────────────────────────────────────────────────────┘ ║ + ║ ║ + ║ Side effects only here: logging, JSON output ║ + ╚════════════════════════════════════════════════════════════════════════╝ +``` + +--- + +## Key Data Types + +| Type | Purpose | Mutability | +|------|---------|------------| +| `DceFileProcessing.file_data` | Per-file collected data | Builders (mutable during AST walk) | +| `FileAnnotations.t` | Source annotations (`@dead`, `@live`) | Immutable after merge | +| `Declarations.t` | All exported declarations (pos → Decl.t) | Immutable after merge | +| `References.t` | Value/type references (pos → PosSet.t) | Immutable after merge | +| `FileDeps.t` | Cross-file dependencies (file → FileSet.t) | Immutable after merge | +| `OptionalArgsState.t` | Computed optional arg state per-decl | Immutable | +| `AnalysisResult.t` | Solver output with Issue.t list | Immutable | +| `DceConfig.t` | Analysis configuration | Immutable (passed explicitly) | + +--- + +## Phase Details + +### Phase 1: MAP (Per-File Processing) + +**Entry point**: `DceFileProcessing.process_cmt_file` + +**Input**: `.cmt` file path + `DceConfig.t` + +**Output**: `file_data` containing builders for: +- `annotations` - `@dead`, `@live` annotations from source +- `decls` - Exported value/type/exception declarations +- `refs` - References to other declarations +- `file_deps` - Which files this file depends on +- `cross_file` - Items needing cross-file resolution (optional args, exceptions) + +**Key property**: Local mutable state is OK here (performance). Each file is processed independently. + +### Phase 2: MERGE (Combine Builders) + +**Entry point**: `Reanalyze.runAnalysis` (merge section) + +**Input**: `file_data list` + +**Output**: Immutable project-wide data structures + +**Operations**: +```ocaml +let annotations = FileAnnotations.merge_all (file_data_list |> List.map (fun fd -> fd.annotations)) +let decls = Declarations.merge_all (file_data_list |> List.map (fun fd -> fd.decls)) +let refs = References.merge_all (file_data_list |> List.map (fun fd -> fd.refs)) +let file_deps = FileDeps.merge_all (file_data_list |> List.map (fun fd -> fd.file_deps)) +``` + +**Key property**: Merge operations are commutative - order of `file_data_list` doesn't matter. + +### Phase 3: SOLVE (Deadness Computation) + +**Entry point**: `DeadCommon.solveDead` + +**Input**: All merged data + config + +**Output**: `AnalysisResult.t` containing `Issue.t list` + +**Algorithm**: +1. Build file dependency order (roots to leaves) +2. Sort declarations by dependency order +3. For each declaration, resolve references recursively +4. Determine dead/live status based on reference count +5. Collect issues for dead declarations + +**Key property**: Pure function - immutable in, immutable out. No side effects. + +### Phase 4: REPORT (Output) + +**Entry point**: `Reanalyze.runAnalysis` (report section) + +**Input**: `AnalysisResult.t` + +**Output**: Logging / JSON to stdout + +**Operations**: +```ocaml +AnalysisResult.get_issues analysis_result +|> List.iter (fun issue -> Log_.warning ~loc:issue.loc issue.description) +``` + +**Key property**: All side effects live here at the edge. The solver never logs directly. + +--- + +## Incremental Updates (Future) + +The architecture enables incremental updates when a file changes: + +1. Re-run Phase 1 for changed file only → new `file_data` +2. Replace in `file_data` map (keyed by filename) +3. Re-run Phase 2 (merge) - fast, pure function +4. Re-run Phase 3 (solve) - fast, pure function + +The key insight: **immutable data structures enable safe incremental updates** - you can swap one file's data without affecting others. + +--- + +## Testing + +**Order-independence test**: Run with `-test-shuffle` flag to randomize file processing order. The test (`make test-reanalyze-order-independence`) verifies that shuffled runs produce identical output. + +**Unit testing**: Each phase can be tested independently: +- Phase 1: Process a single `.cmt` file, verify `file_data` +- Phase 2: Merge known builders, verify merged result +- Phase 3: Call solver with known inputs, verify issues + +--- + +## Key Modules + +| Module | Responsibility | +|--------|---------------| +| `Reanalyze` | Entry point, orchestrates pipeline | +| `DceFileProcessing` | Phase 1: Per-file AST processing | +| `DceConfig` | Configuration (CLI flags + run config) | +| `DeadCommon` | Phase 3: Solver (`solveDead`) | +| `Declarations` | Declaration storage (builder/immutable) | +| `References` | Reference tracking (builder/immutable) | +| `FileAnnotations` | Source annotation tracking | +| `FileDeps` | Cross-file dependency graph | +| `CrossFileItems` | Cross-file optional args and exceptions | +| `AnalysisResult` | Immutable solver output | +| `Issue` | Issue type definitions | +| `Log_` | Phase 4: Logging output | + diff --git a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md new file mode 100644 index 0000000000..107493bb28 --- /dev/null +++ b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md @@ -0,0 +1,679 @@ +## Dead Code Analysis – Pure Pipeline Refactor Plan + +**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 +- **Incremental analysis is possible** - can reprocess one file without redoing everything + +**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) + +--- + +## Key Design Principles + +### 1. Local mutable state during AST processing, immutable after + +**AST processing phase** (per-file): +- Uses local mutable state for performance (hashtables, etc.) +- Returns **immutable** `file_data` when done +- This phase is inherently sequential per-file + +**Analysis phase** (project-wide): +- Works only with **immutable data structures** +- Must be parallelizable, reorderable +- Static guarantees from this point on + +```ocaml +(* AST processing: local mutable state OK, returns immutable *) +let process_file config cmt_infos : file_data = + let local_state = Hashtbl.create 256 in (* local mutable *) + ... traverse AST, mutate local_state ... + freeze_to_file_data local_state (* return immutable *) + +(* Analysis: immutable in, immutable out - parallelizable *) +let solve_deadness config (files : file_data list) : analysis_result = + ... pure computation on immutable data ... +``` + +### 2. Clear phase boundaries + +| Phase | Input | Mutability | Output | Parallelizable? | +|-------|-------|------------|--------|-----------------| +| **AST processing** | cmt file | Local mutable OK | Immutable `file_data` | Per-file yes | +| **Merge** | `file_data list` | None | Immutable merged view | Yes | +| **Analysis** | Merged view | None | Immutable `result` | Yes | +| **Reporting** | `result` | I/O side effects | None | N/A | + +### 3. Enable incremental updates + +When file F changes: +1. Re-run AST processing for F only → new `file_data` +2. Replace in `file_data` map (keyed by filename) +3. Re-run merge and analysis (on immutable data) + +The key is that **immutable data structures enable safe incremental updates** - +you can swap one file's data without affecting others. + +--- + +## Architecture + +See [ARCHITECTURE.md](./ARCHITECTURE.md) for the full architecture documentation with diagrams. + +--- + +## Current Problems (What We're Fixing) + +### 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. + +**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 +- `ValueReferences.table` - all value references +- `TypeReferences.table` - all type references +- `FileReferences.table` - cross-file dependencies + +**Impact**: Can't analyze a subset of files without reanalyzing everything. Can't clear state between test runs without module reloading. + +### P3: Cross-file processing queues +**Problem**: Several analyses use global queues that get "flushed" later: +- `DeadOptionalArgs.delayedItems` - cross-file optional arg analysis → DELETED (now `CrossFileItems`) +- `DeadException.delayedItems` - cross-file exception checks → DELETED (now `CrossFileItems`) +- `DeadType.TypeDependencies.delayedItems` - per-file type deps (already handled per-file) +- `ProcessDeadAnnotations.positionsAnnotated` - annotation tracking + +**Additional problem**: `positionsAnnotated` mixes **input** (source annotations from AST) with **output** (positions the solver determines are dead). The solver mutates this during analysis, violating purity. + +**Impact**: Order-dependent. Processing files in different orders can give different results because queue processing happens at arbitrary times. Mixing input/output prevents incremental analysis. + +### 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 +- `EmitJson` - JSON output +- ~~`WriteDeadAnnotations` - file I/O~~ (removed - added complexity with little value) +- 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 +(* ===== IMMUTABLE DATA TYPES ===== *) + +(* Configuration: immutable *) +type config = { ... } + +(* Per-file data - IMMUTABLE, returned by AST processing *) +type file_data = { + source_path : string; + module_name : Name.t; + is_interface : bool; + source_annotations : AnnotationMap.t; (* immutable map *) + decls : DeclMap.t; (* immutable map *) + value_refs : RefMap.t; (* immutable map *) + type_refs : RefMap.t; + file_deps : StringSet.t; (* files this depends on *) +} + +(* Project-wide merged view - IMMUTABLE *) +type merged_view = { + all_annotations : AnnotationMap.t; + all_decls : DeclMap.t; + all_value_refs : RefMap.t; + all_type_refs : RefMap.t; + file_graph : FileGraph.t; +} + +(* Analysis results - IMMUTABLE *) +type analysis_result = { + dead_decls : decl list; + issues : issue list; + annotations_to_write : (string * line_annotation list) list; +} + +(* ===== PHASE 1: AST PROCESSING (local mutable OK) ===== *) + +(* Uses local mutable hashtables for performance, returns immutable *) +let process_file config cmt_infos : file_data = + (* Local mutable state - not visible outside this function *) + let annotations = Hashtbl.create 64 in + let decls = Hashtbl.create 256 in + let refs = Hashtbl.create 256 in + + (* Traverse AST, populate local tables *) + traverse_ast ~annotations ~decls ~refs cmt_infos; + + (* Freeze into immutable data *) + { + source_annotations = AnnotationMap.of_hashtbl annotations; + decls = DeclMap.of_hashtbl decls; + value_refs = RefMap.of_hashtbl refs; + ... + } + +(* ===== PHASE 2: MERGE (pure, parallelizable) ===== *) + +let merge_files (files : file_data StringMap.t) : merged_view = + (* Pure merge of immutable data - can parallelize *) + ... + +(* ===== PHASE 3: ANALYSIS (pure, parallelizable) ===== *) + +let solve_deadness config (view : merged_view) : analysis_result = + (* Pure computation on immutable data *) + (* Can be parallelized, reordered, memoized *) + ... + +(* ===== ORCHESTRATION ===== *) + +let run_analysis ~config ~cmt_files = + (* Phase 1: Process files (can parallelize per-file) *) + let files = + cmt_files + |> List.map (fun path -> (path, process_file config (load_cmt path))) + |> StringMap.of_list + in + (* Phase 2: Merge *) + let merged = merge_files files in + (* Phase 3: Analyze *) + let result = solve_deadness config merged in + (* Phase 4: Report (side effects) *) + report result + +(* Incremental: only re-process changed file *) +let update_file ~config ~files ~changed_file = + let new_data = process_file config (load_cmt changed_file) in + let files = StringMap.add changed_file new_data files in + let merged = merge_files files in + solve_deadness config merged +``` + +--- + +## Refactor Tasks + +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 + +### Task 1: Remove global "current file" context (P1) + +**Value**: Makes it possible to process files concurrently or out of order. + +**Changes**: +- [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. + +**Estimated effort**: Medium (touches ~10 functions, mostly mechanical) + +### Task 2: Extract configuration into explicit value (P4) + +**Value**: Can run analysis with different configs without mutating globals. Can test with different configs. + +**Changes**: +- [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~~ +- [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**: 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 (done) + +### Task 3: Source annotations use map → list → merge pattern (P3) + +**Value**: Demonstrates the "local mutable → immutable" architecture for one data type. +Shows the reusable pattern: **map** (per-file) → **list** → **merge** → **immutable result**. + +**Changes**: +- [x] Create `FileAnnotations` module with two types: + - `builder` - mutable, for AST processing + - `t` - immutable, for solver (read-only) +- [x] `DceFileProcessing.process_cmt_file` returns `builder` (local mutable state) +- [x] `processCmtFiles` collects builders into a list (order doesn't matter) +- [x] `FileAnnotations.merge_all : builder list -> t` combines all into immutable result +- [x] Solver receives `t` (read-only, no mutation functions available) +- [x] **Remove solver mutation**: `resolveRecursiveRefs` no longer calls `annotate_dead` +- [x] **Use `decl.resolvedDead` directly**: Already-resolved decls use their stored result + +**Status**: Complete ✅ + +**The Pattern** (reusable for Tasks 4-7): +```ocaml +(* Two types: mutable builder, immutable result *) +type builder (* mutable - for AST processing *) +type t (* immutable - for solver *) + +(* Builder API *) +val create_builder : unit -> builder +val annotate_* : builder -> ... -> unit + +(* Merge: list of builders → immutable result *) +val merge_all : builder list -> t + +(* Read-only API for t *) +val is_annotated_* : t -> ... -> bool +``` + +**Architecture achieved**: +``` +┌─────────────────────────────────────────────────────────────┐ +│ MAP: process each file (parallelizable) │ +│ process_cmt_file → builder (local mutable) │ +└─────────────────────────────────────────────────────────────┘ + │ + ▼ + [ builder list ] + (order doesn't matter) + │ + ▼ +┌─────────────────────────────────────────────────────────────┐ +│ MERGE: combine all (pure) │ +│ merge_all builders → t (immutable) │ +└─────────────────────────────────────────────────────────────┘ + │ + ▼ +┌─────────────────────────────────────────────────────────────┐ +│ ANALYZE: use immutable data │ +│ reportDead ~annotations:t (read-only) │ +└─────────────────────────────────────────────────────────────┘ +``` + +**Key properties**: +- **Order independence**: builders collected in any order → same result +- **Parallelizable**: map phase can run concurrently +- **Incremental**: replace one builder in list, re-merge +- **Type-safe**: `t` has no mutation functions in API + +**Test**: Process files in different orders - results should be identical. + +**Estimated effort**: Small (well-scoped module) + +### Task 4: Declarations use map → list → merge pattern (P2) + +**Value**: Declarations become immutable after AST processing. Enables parallelizable analysis. + +**Pattern**: Same as Task 3 - `builder` (mutable) → `builder list` → `merge_all` → `t` (immutable) + +**Changes**: +- [x] Create `Declarations` module with `builder` and `t` types +- [x] `process_cmt_file` returns `DceFileProcessing.file_data` containing both `annotations` and `decls` builders +- [x] `processCmtFiles` collects into `file_data list` +- [x] `Declarations.merge_all : builder list -> t` +- [x] Solver uses immutable `Declarations.t` +- [x] Delete global `DeadCommon.decls` +- [x] Update `DeadOptionalArgs.forceDelayedItems` to take `~decls:Declarations.t` + +**Status**: Complete ✅ + +**Test**: Process files in different orders - results should be identical. + +**Estimated effort**: Medium (core data structure, many call sites) + +### Task 5: References use map → list → merge pattern (P2) + +**Value**: References become immutable after AST processing. + +**Pattern**: Same as Task 3/4. + +**Changes**: +- [x] Create `References` module with `builder` and `t` types +- [x] Thread `~refs:References.builder` through `addValueReference`, `addTypeReference` +- [x] `process_cmt_file` returns `References.builder` in `file_data` +- [x] Merge refs into builder, process delayed items, then freeze +- [x] Solver uses `References.t` via `find_value_refs` and `find_type_refs` +- [x] Delete global `ValueReferences.table` and `TypeReferences.table` + +**Status**: Complete ✅ + +**Test**: Process files in different orders - results should be identical. + +**Estimated effort**: Medium (similar to Task 4) + +### Task 6: Cross-file items use map → list → merge pattern (P3) + +**Value**: No global queues. Cross-file items are per-file immutable data. + +**Pattern**: Same as Task 3/4/5. + +**Changes**: +- [x] Create `CrossFileItems` module with `builder` and `t` types +- [x] Thread `~cross_file:CrossFileItems.builder` through AST processing +- [x] `process_cmt_file` returns `CrossFileItems.builder` in `file_data` +- [x] `CrossFileItems.merge_all : builder list -> t` +- [x] `process_exception_refs` and `process_optional_args` are pure functions on merged `t` +- [x] Delete global `delayedItems` refs from `DeadException` and `DeadOptionalArgs` + +**Status**: Complete ✅ + +**Note**: `DeadType.TypeDependencies` was already per-file (processed within `process_cmt_file`), +so it didn't need to be included. + +**Key insight**: Cross-file items are references that span file boundaries. +They should follow the same pattern as everything else. + +**Test**: Process files in different orders - results should be identical. + +**Estimated effort**: Medium (3 modules) + +### Task 7: File dependencies use map → list → merge pattern (P2 + P3) + +**Value**: File graph built from immutable per-file data. + +**Pattern**: Same as Task 3/4/5/6. + +**Changes**: +- [x] Create `FileDeps` module with `builder` and `t` types +- [x] `process_cmt_file` returns `FileDeps.builder` +- [x] `FileDeps.merge_all : builder list -> t` +- [x] Thread `~file_deps` through `addValueReference` +- [x] `iter_files_from_roots_to_leaves : t -> (string -> unit) -> unit` (pure function) +- [x] Delete global `FileReferences` from `Common.ml` + +**Status**: Complete ✅ + +**Test**: Build file graph, verify topological ordering is correct. + +**Estimated effort**: Medium (cross-file logic, but well-contained) + +### Task 8: Analysis phase is pure (P5) + +**Value**: Analysis phase works on immutable merged data, returns immutable results. +Can be parallelized, memoized, reordered. + +**Architecture goal**: +``` +merged_view (immutable) + │ + ▼ +solve_deadness (pure function) + │ + ▼ +analysis_result (immutable) + │ + ▼ +report (side effects here only) +``` + +**Approach**: Break into small, behavior-preserving steps. Each step can be verified +before moving to the next. The key is: change return type, then immediately log at +the call site, so behavior stays identical. + +--- + +#### Task 8.1: Create `AnalysisResult` module ✅ + +**Changes**: +- [x] Create `AnalysisResult.ml/mli` with `type t = { issues: Common.issue list }` +- [x] Add constructors: `empty`, `add_issue`, `get_issues` +- [x] Add issue constructors: `make_dead_issue`, `make_dead_module_issue` + +**Verify**: Build succeeds. No behavior change (module not used yet). + +--- + +#### Task 8.2: Make `emitWarning` return issue (behavior preserving) ✅ + +**Changes**: +- [x] Add `makeDeadIssue` (pure function) +- [x] `emitWarning` uses `makeDeadIssue` internally (later removed) + +**Verify**: `make test-analysis` passes with identical output. + +--- + +#### Task 8.3: Make `Decl.report` return issue option (behavior preserving) ✅ + +**Changes**: +- [x] Change `Decl.report` signature to return `issue option` +- [x] Use `makeDeadIssue` internally +- [x] At call site in `reportDead`, log returned issue + +**Verify**: `make test-analysis` passes with identical output. + +--- + +#### Task 8.4: Make `DeadOptionalArgs.check` return issues (behavior preserving) ✅ + +**Changes**: +- [x] Add `foldUnused`, `foldAlwaysUsed` to `OptionalArgs` module +- [x] Change `check` signature to return `issue list` instead of `unit` +- [x] At call site in `resolveRecursiveRefs`, immediately log returned issues + +**Verify**: `make test-analysis` passes with identical output. + +--- + +#### Task 8.5: Collect incorrect annotation issues (behavior preserving) ✅ + +**Changes**: +- [x] Use `makeDeadIssue` for incorrect `@dead` annotation issues +- [x] Log immediately at call site +- [x] Remove `emitWarning` function (no longer needed) + +**Verify**: `make test-analysis` passes with identical output. + +--- + +#### Task 8.6: Make `DeadModules.checkModuleDead` return issue (behavior preserving) ✅ + +**Changes**: +- [x] Change `DeadModules.checkModuleDead` to return `issue option` +- [x] At call sites, log returned issue immediately + +**Verify**: `make test-analysis` passes with identical output. + +--- + +#### Task 8.7: Collect all issues in `reportDead` (behavior preserving) ✅ + +**Changes**: +- [x] Change `Decl.report` to return `issue list` (includes dead module issues) +- [x] Use `List.concat_map` to collect all issues +- [x] Log all issues at the end of `reportDead` + +**Verify**: `make test-analysis` passes with identical output. + +--- + +#### Task 8.8: Return `AnalysisResult.t` from `reportDead` ✅ + +**Changes**: +- [x] Change `reportDead` to return `AnalysisResult.t` instead of `unit` +- [x] Move logging from `reportDead` to caller in `Reanalyze.ml` + +**Verify**: `make test-analysis` passes with identical output. + +--- + +**Status**: Complete ✅ + +**Key guarantee**: The analysis phase (`reportDead`) now returns an immutable +`AnalysisResult.t` containing all dead code issues. Side effects (logging) +only happen in the caller (`Reanalyze.runAnalysis`). + +**Note**: Optional args and incorrect annotation issues were logged inline +during `resolveRecursiveRefs`. Fixed in Task 8b. + +### Task 8b: Collect all issues in AnalysisResult.t (P5) ✅ + +**Value**: Complete the pure analysis phase - all issues returned in result, no inline logging. + +**Problem**: `resolveRecursiveRefs` was logging two types of issues inline: +1. Optional args issues (from `checkOptionalArgFn`) +2. Incorrect `@dead` annotation issues + +These bypassed `AnalysisResult.t` and were logged directly via `Log_.warning`. + +**Changes**: +- [x] Pass `~issues:(Common.issue list ref)` through `resolveRecursiveRefs` +- [x] Collect optional args issues instead of logging inline +- [x] Collect incorrect annotation issues instead of logging inline +- [x] Add collected issues to `AnalysisResult.t` in `reportDead` +- [x] Remove all `Log_.warning` calls from `resolveRecursiveRefs` + +**Status**: Complete ✅ + +**Key guarantee**: No `Log_.warning` calls in `resolveRecursiveRefs`. All issues +are collected in `AnalysisResult.t` and logged by the caller. + +### Task 9: ~~Separate annotation computation from file writing (P5)~~ REMOVED + +**Status**: Removed ✅ - `WriteDeadAnnotations` feature was deleted entirely. + +The `-write` flag that auto-inserted `@dead` annotations into source files was removed +as it added significant complexity (global state, file I/O during analysis, extra types) +for a rarely-used feature. Users who want to suppress dead code warnings can manually +add `@dead` annotations. + +### Task 10: Verify zero `DceConfig.current()` calls in analysis code + +**Value**: Enforce purity - no hidden global reads. + +**Changes**: +- [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. ✅ + +**Estimated effort**: Trivial (done) + +### Task 11: Integration and order-independence verification + +**Value**: Verify the refactor achieved its goals. + +**Changes**: +- [x] Write property test: process files in random orders, verify identical results + - Added `-test-shuffle` CLI flag to randomize file processing order + - Added `test-order-independence.sh` script that runs 3 shuffled iterations and compares output + - Run via `make test-reanalyze-order-independence` (not part of default test) +- [x] Solver takes explicit inputs (no global state) - verified by architecture +- [x] Document the new architecture and API - added "Architecture Diagram" section + +**Test**: The tests are the task. + +**Status**: Complete ✅ + +**Estimated effort**: Small (mostly writing tests) + +--- + +## Execution Strategy + +**Completed**: Task 1 ✅, Task 2 ✅, Task 3 ✅, Task 10 ✅, Task 11 ✅ + +**Remaining order**: 4 → 5 → 6 → 7 → 8 → 9 → 11 (test) + +**Why this order?** +- Tasks 1-2 remove implicit dependencies (file context, config) - ✅ DONE +- Task 3 makes source annotations read-only (solver no longer mutates) - ✅ DONE +- Tasks 4-7 make state **per-file** for incremental updates +- Task 8 makes reporting **pure** with immutable results +- Task 9 separates annotation computation from file writing +- Task 10 verifies no global config reads remain - ✅ DONE +- Task 11 validates everything including incremental updates + +**Key architectural milestones**: +1. **After Task 7**: All state is per-file, keyed by filename +2. **After Task 8**: Solver is pure, returns immutable results +3. **After Task 11**: Incremental updates verified working + +**Time estimate**: +- Best case (everything goes smoothly): 2-3 days +- Realistic (with bugs/complications): 1 week +- Worst case (major architectural issues): 2 weeks + +--- + +## Optional Future Tasks + +### Optional Task: Make OptionalArgs tracking immutable ✅ + +**Value**: `OptionalArgs.t` is now fully immutable. No mutation of declarations. + +**Changes made**: +- [x] Made `OptionalArgs.t` immutable (no mutable fields) +- [x] Added pure functions: `apply_call`, `combine_pair` +- [x] Created `OptionalArgsState` module in `Common.ml` for state map +- [x] `compute_optional_args_state` returns immutable state map +- [x] `DeadOptionalArgs.check` looks up state from map + +**Architecture**: +- Declaration's `optionalArgs` = initial state (what args exist) +- `OptionalArgsState.t` = computed state (after all calls/combines) +- Solver uses `OptionalArgsState.find_opt` to get final state + +**Status**: Complete ✅ + +--- + +## Success Criteria + +After all tasks: + +✅ **Local mutable → Immutable boundary** +- AST processing uses local mutable state (performance) +- Returns **immutable** `file_data` +- Analysis phase works **only** on immutable data + +✅ **Pure analysis phase** +- `solve_deadness : merged_view -> analysis_result` is pure +- No side effects (logging, I/O) in analysis +- Can parallelize, memoize, reorder + +✅ **Incremental updates** +- Replace one file's `file_data` without touching others +- Re-merge is pure function on immutable data +- Re-analyze is pure function on immutable data + +✅ **Order independence** +- Processing files in any order → identical `file_data` +- Merging in any order → identical `merged_view` +- Property test verifies this + +✅ **Static guarantees** +- Type system enforces immutability after AST processing +- No `ref` or mutable `Hashtbl` visible in analysis phase API +- Compiler catches violations + +✅ **Testable** +- Test AST processing in isolation (per-file) +- Test merge function in isolation (pure) +- Test analysis in isolation (pure) +- No mocking needed - just pass immutable data diff --git a/analysis/reanalyze/src/AnalysisResult.ml b/analysis/reanalyze/src/AnalysisResult.ml new file mode 100644 index 0000000000..dd145b4c4b --- /dev/null +++ b/analysis/reanalyze/src/AnalysisResult.ml @@ -0,0 +1,50 @@ +(** Analysis result - immutable output from the solver. + + The solver returns this instead of logging directly. + All side effects (logging, JSON output) happen in the reporting phase. *) + +type t = {issues: Issue.t list} +(** Immutable analysis result *) + +let empty = {issues = []} + +let add_issue result issue = {issues = issue :: result.issues} + +let add_issues result new_issues = + {issues = List.rev_append new_issues result.issues} + +let get_issues result = result.issues |> List.rev + +let issue_count result = List.length result.issues + +(** Create a dead code issue *) +let make_dead_issue ~loc ~deadWarning ~path ~message : Issue.t = + { + Issue.name = + (match deadWarning with + | Issue.WarningDeadException -> "Warning Dead Exception" + | WarningDeadType -> "Warning Dead Type" + | WarningDeadValue -> "Warning Dead Value" + | WarningDeadValueWithSideEffects -> + "Warning Dead Value With Side Effects" + | IncorrectDeadAnnotation -> "Incorrect Dead Annotation"); + severity = Warning; + loc; + description = DeadWarning {deadWarning; path; message}; + } + +(** Create a dead module issue *) +let make_dead_module_issue ~loc ~moduleName : Issue.t = + { + Issue.name = "Warning Dead Module"; + severity = Warning; + loc; + description = + DeadModule + { + message = + Format.asprintf "@{%s@} %s" + (moduleName |> Name.toInterface |> Name.toString) + "is a dead module as all its items are dead."; + }; + } diff --git a/analysis/reanalyze/src/AnalysisResult.mli b/analysis/reanalyze/src/AnalysisResult.mli new file mode 100644 index 0000000000..beee4e4d4e --- /dev/null +++ b/analysis/reanalyze/src/AnalysisResult.mli @@ -0,0 +1,35 @@ +(** Analysis result - immutable output from the solver. + + The solver returns this instead of logging directly. + All side effects (logging, JSON output) happen in the reporting phase. *) + +type t +(** Immutable analysis result *) + +val empty : t +(** Empty result with no issues *) + +val add_issue : t -> Issue.t -> t +(** Add a single issue to the result *) + +val add_issues : t -> Issue.t list -> t +(** Add multiple issues to the result *) + +val get_issues : t -> Issue.t list +(** Get all issues in order they were added *) + +val issue_count : t -> int +(** Count of issues *) + +(** {2 Issue constructors} *) + +val make_dead_issue : + loc:Location.t -> + deadWarning:Issue.deadWarning -> + path:string -> + message:string -> + Issue.t +(** Create a dead code warning issue *) + +val make_dead_module_issue : loc:Location.t -> moduleName:Name.t -> Issue.t +(** Create a dead module warning issue *) diff --git a/analysis/reanalyze/src/Arnold.ml b/analysis/reanalyze/src/Arnold.ml index d3a1677e50..cc917725a9 100644 --- a/analysis/reanalyze/src/Arnold.ml +++ b/analysis/reanalyze/src/Arnold.ml @@ -107,10 +107,10 @@ 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 + if config.DceConfig.cli.debug then Log_.warning ~forStats:false ~loc (Termination { @@ -123,8 +123,8 @@ module Stats = struct (FunctionCall.toString functionCall); }) - let logResult ~functionCall ~loc ~resString = - if !Common.Cli.debug then + let logResult ~config ~functionCall ~loc ~resString = + if config.DceConfig.cli.debug then Log_.warning ~forStats:false ~loc (Termination { @@ -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,7 +610,7 @@ module ExtendFunctionTable = struct if not (callee |> FunctionTable.isInFunctionInTable ~functionTable) then ( functionTable |> FunctionTable.addFunction ~functionName; - if !Common.Cli.debug then + if config.DceConfig.cli.debug then Log_.warning ~forStats:false ~loc (Termination { @@ -631,7 +632,7 @@ module ExtendFunctionTable = struct -> functionTable |> FunctionTable.addLabelToKind ~functionName ~label; - if !Common.Cli.debug then + if config.DceConfig.cli.debug then Log_.warning ~forStats:false ~loc (Termination { @@ -648,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 @@ -698,7 +699,7 @@ module CheckExpressionWellFormed = struct |> FunctionTable.addFunction ~functionName; functionTable |> FunctionTable.addLabelToKind ~functionName ~label; - if !Common.Cli.debug then + if config.DceConfig.cli.debug then Log_.warning ~forStats:false ~loc:body.exp_loc (Termination { @@ -717,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; @@ -732,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 @@ -872,7 +878,7 @@ module Compile = struct Hashtbl.replace ctx.innerRecursiveFunctions oldFunctionName newFunctionName; newFunctionDefinition.body <- Some (vb_expr |> expression ~ctx:newCtx); - if !Common.Cli.debug then + if config.DceConfig.cli.debug then Log_.warning ~forStats:false ~loc:pat_loc (Termination { @@ -1067,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 @@ -1099,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 = @@ -1111,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); @@ -1124,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 @@ -1136,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 @@ -1147,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 = @@ -1177,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 = @@ -1200,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) @@ -1211,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 @@ -1261,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 = @@ -1283,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 *) @@ -1350,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 @@ -1374,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 -> @@ -1393,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 ~file:_ (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/Cli.ml b/analysis/reanalyze/src/Cli.ml new file mode 100644 index 0000000000..550244486a --- /dev/null +++ b/analysis/reanalyze/src/Cli.ml @@ -0,0 +1,23 @@ +(** Command-line interface options for reanalyze. + These refs are set by argument parsing in Reanalyze.ml *) + +let debug = ref false +let ci = ref false + +(** The command was a -cmt variant (e.g. -exception-cmt) *) +let cmtCommand = ref false + +let experimental = ref false +let json = ref false + +(* names to be considered live values *) +let liveNames = ref ([] : string list) + +(* paths of files where all values are considered live *) +let livePaths = ref ([] : string list) + +(* paths of files to exclude from analysis *) +let excludePaths = ref ([] : string list) + +(* test flag: shuffle file order to verify order-independence *) +let testShuffle = ref false diff --git a/analysis/reanalyze/src/CollectAnnotations.ml b/analysis/reanalyze/src/CollectAnnotations.ml new file mode 100644 index 0000000000..ef8246daa5 --- /dev/null +++ b/analysis/reanalyze/src/CollectAnnotations.ml @@ -0,0 +1,148 @@ +(** AST traversal to collect source annotations (@dead, @live, @genType). + + This module traverses the typed AST to find attribute annotations + and records them in a FileAnnotations.builder. *) + +open DeadCommon + +let processAttributes ~state ~config ~doGenType ~name ~pos attributes = + let getPayloadFun f = attributes |> Annotation.getAttributePayload f in + let getPayload (x : string) = + attributes |> Annotation.getAttributePayload (( = ) x) + in + if + doGenType + && getPayloadFun Annotation.tagIsOneOfTheGenTypeAnnotations <> None + then FileAnnotations.annotate_gentype state pos; + if getPayload "dead" <> None then FileAnnotations.annotate_dead state pos; + let nameIsInLiveNamesOrPaths () = + config.DceConfig.cli.live_names |> List.mem name + || + let fname = + match Filename.is_relative pos.pos_fname with + | true -> pos.pos_fname + | false -> Filename.concat (Sys.getcwd ()) pos.pos_fname + in + let fnameLen = String.length fname in + config.DceConfig.cli.live_paths + |> List.exists (fun prefix -> + String.length prefix <= fnameLen + && + try String.sub fname 0 (String.length prefix) = prefix + with Invalid_argument _ -> false) + in + if getPayload liveAnnotation <> None || nameIsInLiveNamesOrPaths () then + FileAnnotations.annotate_live state pos; + if attributes |> Annotation.isOcamlSuppressDeadWarning then + FileAnnotations.annotate_live state pos + +let collectExportLocations ~state ~config ~doGenType = + let super = Tast_mapper.default in + let currentlyDisableWarnings = ref false in + let value_binding self + ({vb_attributes; vb_pat} as value_binding : Typedtree.value_binding) = + (match vb_pat.pat_desc with + | Tpat_var (id, {loc = {loc_start = pos}}) + | Tpat_alias ({pat_desc = Tpat_any}, id, {loc = {loc_start = pos}}) -> + if !currentlyDisableWarnings then FileAnnotations.annotate_live state pos; + vb_attributes + |> processAttributes ~state ~config ~doGenType ~name:(id |> Ident.name) + ~pos + | _ -> ()); + super.value_binding self value_binding + in + let type_kind toplevelAttrs self (typeKind : Typedtree.type_kind) = + (match typeKind with + | Ttype_record labelDeclarations -> + labelDeclarations + |> List.iter + (fun ({ld_attributes; ld_loc} : Typedtree.label_declaration) -> + toplevelAttrs @ ld_attributes + |> processAttributes ~state ~config ~doGenType:false ~name:"" + ~pos:ld_loc.loc_start) + | Ttype_variant constructorDeclarations -> + constructorDeclarations + |> List.iter + (fun + ({cd_attributes; cd_loc; cd_args} : + Typedtree.constructor_declaration) + -> + let _process_inline_records = + match cd_args with + | Cstr_record flds -> + List.iter + (fun ({ld_attributes; ld_loc} : Typedtree.label_declaration) + -> + toplevelAttrs @ cd_attributes @ ld_attributes + |> processAttributes ~state ~config ~doGenType:false + ~name:"" ~pos:ld_loc.loc_start) + flds + | Cstr_tuple _ -> () + in + toplevelAttrs @ cd_attributes + |> processAttributes ~state ~config ~doGenType:false ~name:"" + ~pos:cd_loc.loc_start) + | _ -> ()); + super.type_kind self typeKind + in + let type_declaration self (typeDeclaration : Typedtree.type_declaration) = + let attributes = typeDeclaration.typ_attributes in + let _ = type_kind attributes self typeDeclaration.typ_kind in + typeDeclaration + in + let value_description self + ({val_attributes; val_id; val_val = {val_loc = {loc_start = pos}}} as + value_description : + Typedtree.value_description) = + if !currentlyDisableWarnings then FileAnnotations.annotate_live state pos; + val_attributes + |> processAttributes ~state ~config ~doGenType ~name:(val_id |> Ident.name) + ~pos; + super.value_description self value_description + in + let structure_item self (item : Typedtree.structure_item) = + (match item.str_desc with + | Tstr_attribute attribute + when [attribute] |> Annotation.isOcamlSuppressDeadWarning -> + currentlyDisableWarnings := true + | _ -> ()); + super.structure_item self item + in + let structure self (structure : Typedtree.structure) = + let oldDisableWarnings = !currentlyDisableWarnings in + super.structure self structure |> ignore; + currentlyDisableWarnings := oldDisableWarnings; + structure + in + let signature_item self (item : Typedtree.signature_item) = + (match item.sig_desc with + | Tsig_attribute attribute + when [attribute] |> Annotation.isOcamlSuppressDeadWarning -> + currentlyDisableWarnings := true + | _ -> ()); + super.signature_item self item + in + let signature self (signature : Typedtree.signature) = + let oldDisableWarnings = !currentlyDisableWarnings in + super.signature self signature |> ignore; + currentlyDisableWarnings := oldDisableWarnings; + signature + in + { + super with + signature; + signature_item; + structure; + structure_item; + type_declaration; + value_binding; + value_description; + } + +let structure ~state ~config ~doGenType structure = + let mapper = collectExportLocations ~state ~config ~doGenType in + structure |> mapper.structure mapper |> ignore + +let signature ~state ~config signature = + let mapper = collectExportLocations ~state ~config ~doGenType:true in + signature |> mapper.signature mapper |> ignore diff --git a/analysis/reanalyze/src/CollectAnnotations.mli b/analysis/reanalyze/src/CollectAnnotations.mli new file mode 100644 index 0000000000..c81279e396 --- /dev/null +++ b/analysis/reanalyze/src/CollectAnnotations.mli @@ -0,0 +1,18 @@ +(** AST traversal to collect source annotations (@dead, @live, @genType). + + Traverses the typed AST and records annotations in a FileAnnotations.builder. *) + +val structure : + state:FileAnnotations.builder -> + config:DceConfig.t -> + doGenType:bool -> + Typedtree.structure -> + unit +(** Traverse a structure and collect annotations. *) + +val signature : + state:FileAnnotations.builder -> + config:DceConfig.t -> + Typedtree.signature -> + unit +(** Traverse a signature and collect annotations. *) diff --git a/analysis/reanalyze/src/Common.ml b/analysis/reanalyze/src/Common.ml deleted file mode 100644 index 9e4d1c3352..0000000000 --- a/analysis/reanalyze/src/Common.ml +++ /dev/null @@ -1,254 +0,0 @@ -let currentSrc = ref "" -let currentModule = ref "" -let currentModuleName = ref ("" |> Name.create) -let runConfig = RunConfig.runConfig - -(* Location printer: `filename:line: ' *) -let posToString (pos : Lexing.position) = - let file = pos.Lexing.pos_fname in - let line = pos.Lexing.pos_lnum in - let col = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in - (file |> Filename.basename) - ^ ":" ^ string_of_int line ^ ":" ^ string_of_int col - -module Cli = struct - let debug = ref false - let ci = ref false - - (** The command was a -cmt variant (e.g. -exception-cmt) *) - let cmtCommand = ref false - - let experimental = ref false - let json = ref false - let write = ref false - - (* names to be considered live values *) - let liveNames = ref ([] : string list) - - (* paths of files where all values are considered live *) - - let livePaths = ref ([] : string list) - - (* paths of files to exclude from analysis *) - let excludePaths = ref ([] : string list) -end - -module StringSet = Set.Make (String) - -module LocSet = Set.Make (struct - include Location - - let compare = compare -end) - -module FileSet = Set.Make (String) - -module FileHash = struct - include Hashtbl.Make (struct - type t = string - - let hash (x : t) = Hashtbl.hash x - let equal (x : t) y = x = y - end) -end - -module FileReferences = struct - (* references across files *) - let table = (FileHash.create 256 : FileSet.t FileHash.t) - - let findSet table key = - try FileHash.find table key with Not_found -> FileSet.empty - - let add (locFrom : Location.t) (locTo : Location.t) = - let key = locFrom.loc_start.pos_fname in - let set = findSet table key in - FileHash.replace table key (FileSet.add locTo.loc_start.pos_fname set) - - let addFile fileName = - let set = findSet table fileName in - FileHash.replace table fileName set - - let exists fileName = FileHash.mem table fileName - - let find fileName = - match FileHash.find_opt table fileName with - | Some set -> set - | None -> FileSet.empty - - let iter f = FileHash.iter f table -end - -module Path = struct - type t = Name.t list - - let toName (path : t) = - path |> List.rev_map Name.toString |> String.concat "." |> Name.create - - let toString path = path |> toName |> Name.toString - - let withoutHead path = - match - path |> List.rev_map (fun n -> n |> Name.toInterface |> Name.toString) - with - | _ :: tl -> tl |> String.concat "." - | [] -> "" - - let onOkPath ~whenContainsApply ~f path = - match path |> Path.flatten with - | `Ok (id, mods) -> f (Ident.name id :: mods |> String.concat ".") - | `Contains_apply -> whenContainsApply - - let fromPathT path = - match path |> Path.flatten with - | `Ok (id, mods) -> Ident.name id :: mods |> List.rev_map Name.create - | `Contains_apply -> [] - - let moduleToImplementation path = - match path |> List.rev with - | moduleName :: rest -> - (moduleName |> Name.toImplementation) :: rest |> List.rev - | [] -> path - - let moduleToInterface path = - match path |> List.rev with - | moduleName :: rest -> (moduleName |> Name.toInterface) :: rest |> List.rev - | [] -> path - - let toModuleName ~isType path = - match path with - | _ :: tl when not isType -> tl |> toName - | _ :: _ :: tl when isType -> tl |> toName - | _ -> "" |> Name.create - - let typeToInterface path = - match path with - | typeName :: rest -> (typeName |> Name.toInterface) :: rest - | [] -> path -end - -module OptionalArgs = struct - type t = { - mutable count: int; - mutable unused: StringSet.t; - mutable alwaysUsed: StringSet.t; - } - - let empty = - {unused = StringSet.empty; alwaysUsed = StringSet.empty; count = 0} - - let fromList l = - {unused = StringSet.of_list l; alwaysUsed = StringSet.empty; count = 0} - - let isEmpty x = StringSet.is_empty x.unused - - let call ~argNames ~argNamesMaybe x = - let nameSet = argNames |> StringSet.of_list in - let nameSetMaybe = argNamesMaybe |> StringSet.of_list in - let nameSetAlways = StringSet.diff nameSet nameSetMaybe in - if x.count = 0 then x.alwaysUsed <- nameSetAlways - else x.alwaysUsed <- StringSet.inter nameSetAlways x.alwaysUsed; - argNames - |> List.iter (fun name -> x.unused <- StringSet.remove name x.unused); - x.count <- x.count + 1 - - let combine x y = - let unused = StringSet.inter x.unused y.unused in - x.unused <- unused; - y.unused <- unused; - let alwaysUsed = StringSet.inter x.alwaysUsed y.alwaysUsed in - x.alwaysUsed <- alwaysUsed; - y.alwaysUsed <- alwaysUsed - - let iterUnused f x = StringSet.iter f x.unused - let iterAlwaysUsed f x = StringSet.iter (fun s -> f s x.count) x.alwaysUsed -end - -module DeclKind = struct - type t = - | Exception - | RecordLabel - | VariantCase - | Value of { - isToplevel: bool; - mutable optionalArgs: OptionalArgs.t; - sideEffects: bool; - } - - let isType dk = - match dk with - | RecordLabel | VariantCase -> true - | Exception | Value _ -> false - - let toString dk = - match dk with - | Exception -> "Exception" - | RecordLabel -> "RecordLabel" - | VariantCase -> "VariantCase" - | Value _ -> "Value" -end - -type posAdjustment = FirstVariant | OtherVariant | Nothing - -type decl = { - declKind: DeclKind.t; - moduleLoc: Location.t; - posAdjustment: posAdjustment; - path: Path.t; - pos: Lexing.position; - posEnd: Lexing.position; - posStart: Lexing.position; - mutable resolvedDead: bool option; - mutable report: bool; -} - -type line = {mutable declarations: decl list; original: string} - -module ExnSet = Set.Make (Exn) - -type missingThrowInfo = { - exnName: string; - exnTable: (Exn.t, LocSet.t) Hashtbl.t; - locFull: Location.t; - missingAnnotations: ExnSet.t; - throwSet: ExnSet.t; -} - -type severity = Warning | Error -type deadOptional = WarningUnusedArgument | WarningRedundantOptionalArgument - -type termination = - | ErrorHygiene - | ErrorNotImplemented - | ErrorTermination - | TerminationAnalysisInternal - -type deadWarning = - | WarningDeadException - | WarningDeadType - | WarningDeadValue - | WarningDeadValueWithSideEffects - | IncorrectDeadAnnotation - -type lineAnnotation = (decl * line) option - -type description = - | Circular of {message: string} - | ExceptionAnalysis of {message: string} - | ExceptionAnalysisMissing of missingThrowInfo - | DeadModule of {message: string} - | DeadOptional of {deadOptional: deadOptional; message: string} - | DeadWarning of { - deadWarning: deadWarning; - path: string; - message: string; - shouldWriteLineAnnotation: bool; - lineAnnotation: lineAnnotation; - } - | Termination of {termination: termination; message: string} - -type issue = { - name: string; - severity: severity; - loc: Location.t; - description: description; -} diff --git a/analysis/reanalyze/src/CrossFileItems.ml b/analysis/reanalyze/src/CrossFileItems.ml new file mode 100644 index 0000000000..c7c5f5504a --- /dev/null +++ b/analysis/reanalyze/src/CrossFileItems.ml @@ -0,0 +1,106 @@ +(** Cross-file items collected during AST processing. + + These are references that span file boundaries and need to be resolved + after all files are processed. *) + +(** {2 Item types} *) + +type exception_ref = {exception_path: DcePath.t; loc_from: Location.t} + +type optional_arg_call = { + pos_to: Lexing.position; + arg_names: string list; + arg_names_maybe: string list; +} + +type function_ref = {pos_from: Lexing.position; pos_to: Lexing.position} + +(** {2 Types} *) + +type t = { + exception_refs: exception_ref list; + optional_arg_calls: optional_arg_call list; + function_refs: function_ref list; +} + +type builder = { + mutable exception_refs: exception_ref list; + mutable optional_arg_calls: optional_arg_call list; + mutable function_refs: function_ref list; +} + +(** {2 Builder API} *) + +let create_builder () : builder = + {exception_refs = []; optional_arg_calls = []; function_refs = []} + +let add_exception_ref (b : builder) ~exception_path ~loc_from = + b.exception_refs <- {exception_path; loc_from} :: b.exception_refs + +let add_optional_arg_call (b : builder) ~pos_to ~arg_names ~arg_names_maybe = + b.optional_arg_calls <- + {pos_to; arg_names; arg_names_maybe} :: b.optional_arg_calls + +let add_function_reference (b : builder) ~pos_from ~pos_to = + b.function_refs <- {pos_from; pos_to} :: b.function_refs + +(** {2 Merge API} *) + +let merge_all (builders : builder list) : t = + let exception_refs = + builders |> List.concat_map (fun b -> b.exception_refs) + in + let optional_arg_calls = + builders |> List.concat_map (fun b -> b.optional_arg_calls) + in + let function_refs = builders |> List.concat_map (fun b -> b.function_refs) in + {exception_refs; optional_arg_calls; function_refs} + +(** {2 Processing API} *) + +let process_exception_refs (t : t) ~refs ~file_deps ~find_exception ~config = + t.exception_refs + |> List.iter (fun {exception_path; loc_from} -> + match find_exception exception_path with + | None -> () + | Some loc_to -> + DeadCommon.addValueReference ~config ~refs ~file_deps + ~binding:Location.none ~addFileReference:true ~locFrom:loc_from + ~locTo:loc_to) + +(** Compute optional args state from calls and function references. + Returns a map from position to final OptionalArgs.t state. + Pure function - does not mutate declarations. *) +let compute_optional_args_state (t : t) ~decls : OptionalArgsState.t = + let state = OptionalArgsState.create () in + (* Initialize state from declarations *) + let get_state pos = + match OptionalArgsState.find_opt state pos with + | Some s -> s + | None -> ( + match Declarations.find_opt decls pos with + | Some {declKind = Value {optionalArgs}} -> optionalArgs + | _ -> OptionalArgs.empty) + in + let set_state pos s = OptionalArgsState.set state pos s in + (* Process optional arg calls *) + t.optional_arg_calls + |> List.iter (fun {pos_to; arg_names; arg_names_maybe} -> + let current = get_state pos_to in + let updated = + OptionalArgs.apply_call ~argNames:arg_names + ~argNamesMaybe:arg_names_maybe current + in + set_state pos_to updated); + (* Process function references *) + t.function_refs + |> List.iter (fun {pos_from; pos_to} -> + let state_from = get_state pos_from in + let state_to = get_state pos_to in + if not (OptionalArgs.isEmpty state_to) then ( + let updated_from, updated_to = + OptionalArgs.combine_pair state_from state_to + in + set_state pos_from updated_from; + set_state pos_to updated_to)); + state diff --git a/analysis/reanalyze/src/CrossFileItems.mli b/analysis/reanalyze/src/CrossFileItems.mli new file mode 100644 index 0000000000..34620b6917 --- /dev/null +++ b/analysis/reanalyze/src/CrossFileItems.mli @@ -0,0 +1,57 @@ +(** Cross-file items collected during AST processing. + + These are references that span file boundaries and need to be resolved + after all files are processed. Two types are provided: + - [builder] - mutable, for AST processing + - [t] - immutable, for processing after merge *) + +(** {2 Types} *) + +type t +(** Immutable cross-file items - for processing after merge *) + +type builder +(** Mutable builder - for AST processing *) + +(** {2 Builder API - for AST processing} *) + +val create_builder : unit -> builder + +val add_exception_ref : + builder -> exception_path:DcePath.t -> loc_from:Location.t -> unit +(** Add a cross-file exception reference (defined in another file). *) + +val add_optional_arg_call : + builder -> + pos_to:Lexing.position -> + arg_names:string list -> + arg_names_maybe:string list -> + unit +(** Add a cross-file optional argument call. *) + +val add_function_reference : + builder -> pos_from:Lexing.position -> pos_to:Lexing.position -> unit +(** Add a cross-file function reference (for optional args combining). *) + +(** {2 Merge API} *) + +val merge_all : builder list -> t +(** Merge all builders into one immutable result. Order doesn't matter. *) + +(** {2 Processing API - for after merge} *) + +val process_exception_refs : + t -> + refs:References.builder -> + file_deps:FileDeps.builder -> + find_exception:(DcePath.t -> Location.t option) -> + config:DceConfig.t -> + unit +(** Process cross-file exception references. *) + +(** {2 Optional Args State} *) + +val compute_optional_args_state : + t -> decls:Declarations.t -> OptionalArgsState.t +(** Compute final optional args state from calls and function references. + Pure function - does not mutate declarations. *) diff --git a/analysis/reanalyze/src/DceConfig.ml b/analysis/reanalyze/src/DceConfig.ml new file mode 100644 index 0000000000..ce7a074061 --- /dev/null +++ b/analysis/reanalyze/src/DceConfig.ml @@ -0,0 +1,32 @@ +(** 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; + 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 [Cli] refs + to produce a single immutable configuration value. *) +let current () = + let cli = + { + debug = !Cli.debug; + ci = !Cli.ci; + json = !Cli.json; + live_names = !Cli.liveNames; + live_paths = !Cli.livePaths; + exclude_paths = !Cli.excludePaths; + } + in + {run = RunConfig.runConfig; cli} diff --git a/analysis/reanalyze/src/DceFileProcessing.ml b/analysis/reanalyze/src/DceFileProcessing.ml new file mode 100644 index 0000000000..a012b163ec --- /dev/null +++ b/analysis/reanalyze/src/DceFileProcessing.ml @@ -0,0 +1,87 @@ +(** Per-file AST processing for dead code analysis. + + This module coordinates per-file processing using local mutable builders + and returns them for merging. The caller freezes them before + passing to the solver. *) + +open DeadCommon + +(* ===== File context ===== *) + +type file_context = { + source_path: string; + module_name: string; + is_interface: bool; +} + +let module_name_tagged (file : file_context) = + file.module_name |> Name.create ~isInterface:file.is_interface + +(* ===== Signature processing ===== *) + +let processSignature ~config ~decls ~(file : file_context) ~doValues ~doTypes + (signature : Types.signature) = + let dead_common_file : FileContext.t = + { + source_path = file.source_path; + module_name = file.module_name; + is_interface = file.is_interface; + } + in + signature + |> List.iter (fun sig_item -> + DeadValue.processSignatureItem ~config ~decls ~file:dead_common_file + ~doValues ~doTypes ~moduleLoc:Location.none + ~path:[module_name_tagged file] + sig_item) + +(* ===== Main entry point ===== *) + +type file_data = { + annotations: FileAnnotations.builder; + decls: Declarations.builder; + refs: References.builder; + cross_file: CrossFileItems.builder; + file_deps: FileDeps.builder; +} + +let process_cmt_file ~config ~(file : file_context) ~cmtFilePath + (cmt_infos : Cmt_format.cmt_infos) : file_data = + (* Convert to DeadCommon.FileContext for functions that need it *) + let dead_common_file : FileContext.t = + { + source_path = file.source_path; + module_name = file.module_name; + is_interface = file.is_interface; + } + in + (* Mutable builders for AST processing *) + let annotations = FileAnnotations.create_builder () in + let decls = Declarations.create_builder () in + let refs = References.create_builder () in + let cross_file = CrossFileItems.create_builder () in + let file_deps = FileDeps.create_builder () in + (* Register this file *) + FileDeps.add_file file_deps file.source_path; + (match cmt_infos.cmt_annots with + | Interface signature -> + CollectAnnotations.signature ~state:annotations ~config signature; + processSignature ~config ~decls ~file ~doValues:true ~doTypes:true + signature.sig_type + | Implementation structure -> + let cmtiExists = + Sys.file_exists ((cmtFilePath |> Filename.remove_extension) ^ ".cmti") + in + CollectAnnotations.structure ~state:annotations ~config + ~doGenType:(not cmtiExists) structure; + processSignature ~config ~decls ~file ~doValues:true ~doTypes:false + structure.str_type; + let doExternals = false in + DeadValue.processStructure ~config ~decls ~refs ~file_deps ~cross_file + ~file:dead_common_file ~doTypes:true ~doExternals + ~cmt_value_dependencies:cmt_infos.cmt_value_dependencies structure + | _ -> ()); + DeadType.TypeDependencies.forceDelayedItems ~config ~refs; + DeadType.TypeDependencies.clear (); + (* Return builders - caller will merge and freeze *) + {annotations; decls; refs; cross_file; file_deps} diff --git a/analysis/reanalyze/src/DceFileProcessing.mli b/analysis/reanalyze/src/DceFileProcessing.mli new file mode 100644 index 0000000000..09b12aa322 --- /dev/null +++ b/analysis/reanalyze/src/DceFileProcessing.mli @@ -0,0 +1,30 @@ +(** Per-file AST processing for dead code analysis. + + This module uses mutable builders during AST traversal + and returns them for merging. The caller freezes the accumulated + builders before passing to the solver. *) + +type file_context = { + source_path: string; + module_name: string; + is_interface: bool; +} +(** File context for processing *) + +type file_data = { + annotations: FileAnnotations.builder; + decls: Declarations.builder; + refs: References.builder; + cross_file: CrossFileItems.builder; + file_deps: FileDeps.builder; +} +(** Result of processing a cmt file - annotations, declarations, references, cross-file items, and file dependencies *) + +val process_cmt_file : + config:DceConfig.t -> + file:file_context -> + cmtFilePath:string -> + Cmt_format.cmt_infos -> + file_data +(** Process a cmt file and return mutable builders. + Caller should merge builders and freeze before passing to solver. *) diff --git a/analysis/reanalyze/src/DcePath.ml b/analysis/reanalyze/src/DcePath.ml new file mode 100644 index 0000000000..5d73e9ff04 --- /dev/null +++ b/analysis/reanalyze/src/DcePath.ml @@ -0,0 +1,48 @@ +(** Path representation for dead code analysis. + A path is a list of names, e.g. [MyModule; myFunction] *) + +type t = Name.t list + +let toName (path : t) = + path |> List.rev_map Name.toString |> String.concat "." |> Name.create + +let toString path = path |> toName |> Name.toString + +let withoutHead path = + match + path |> List.rev_map (fun n -> n |> Name.toInterface |> Name.toString) + with + | _ :: tl -> tl |> String.concat "." + | [] -> "" + +let onOkPath ~whenContainsApply ~f path = + match path |> Path.flatten with + | `Ok (id, mods) -> f (Ident.name id :: mods |> String.concat ".") + | `Contains_apply -> whenContainsApply + +let fromPathT path = + match path |> Path.flatten with + | `Ok (id, mods) -> Ident.name id :: mods |> List.rev_map Name.create + | `Contains_apply -> [] + +let moduleToImplementation path = + match path |> List.rev with + | moduleName :: rest -> + (moduleName |> Name.toImplementation) :: rest |> List.rev + | [] -> path + +let moduleToInterface path = + match path |> List.rev with + | moduleName :: rest -> (moduleName |> Name.toInterface) :: rest |> List.rev + | [] -> path + +let toModuleName ~isType path = + match path with + | _ :: tl when not isType -> tl |> toName + | _ :: _ :: tl when isType -> tl |> toName + | _ -> "" |> Name.create + +let typeToInterface path = + match path with + | typeName :: rest -> (typeName |> Name.toInterface) :: rest + | [] -> path diff --git a/analysis/reanalyze/src/DeadCode.ml b/analysis/reanalyze/src/DeadCode.ml index 63323a88d2..d52b784a47 100644 --- a/analysis/reanalyze/src/DeadCode.ml +++ b/analysis/reanalyze/src/DeadCode.ml @@ -1,32 +1,4 @@ -open DeadCommon +(** Dead code analysis - cmt file processing. + Delegates to DceFileProcessing for AST traversal. *) -let processSignature ~doValues ~doTypes (signature : Types.signature) = - signature - |> List.iter (fun sig_item -> - DeadValue.processSignatureItem ~doValues ~doTypes - ~moduleLoc:Location.none - ~path:[!Common.currentModuleName] - sig_item) - -let processCmt ~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 - | 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; - 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 - ~cmt_value_dependencies:cmt_infos.cmt_value_dependencies structure - | _ -> ()); - DeadType.TypeDependencies.forceDelayedItems (); - DeadType.TypeDependencies.clear () +let processCmt = DceFileProcessing.process_cmt_file diff --git a/analysis/reanalyze/src/DeadCommon.ml b/analysis/reanalyze/src/DeadCommon.ml index 9dbacba7bf..9f3ad1f21a 100644 --- a/analysis/reanalyze/src/DeadCommon.ml +++ b/analysis/reanalyze/src/DeadCommon.ml @@ -1,12 +1,12 @@ -(* Adapted from https://github.com/LexiFi/dead_code_analyzer *) - -open Common +module FileContext = struct + type t = {source_path: string; module_name: string; is_interface: bool} -module PosSet = Set.Make (struct - type t = Lexing.position + (** 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 - let compare = compare -end) +(* Adapted from https://github.com/LexiFi/dead_code_analyzer *) module Config = struct (* Turn on type analysis *) @@ -18,14 +18,6 @@ module Config = struct let warnOnCircularDependencies = false end -module Current = struct - let bindings = ref PosSet.empty - let lastBinding = ref Location.none - - (** max end position of a value reported dead *) - let maxValuePosEnd = ref Lexing.dummy_pos -end - let rec checkSub s1 s2 n = n <= 0 || (try s1.[n] = s2.[n] with Invalid_argument _ -> false) @@ -37,49 +29,39 @@ let fileIsImplementationOf s1 s2 = let liveAnnotation = "live" -module PosHash = struct - include Hashtbl.Make (struct - type t = Lexing.position - - let hash x = - let s = Filename.basename x.Lexing.pos_fname in - Hashtbl.hash (x.Lexing.pos_cnum, s) - - let equal (x : t) y = x = y - end) +(* Helper functions for PosHash with PosSet values *) +let posHashFindSet h k = try PosHash.find h k with Not_found -> PosSet.empty - let findSet h k = try find h k with Not_found -> PosSet.empty +let posHashAddSet h k v = + let set = posHashFindSet h k in + PosHash.replace h k (PosSet.add v set) - let addSet h k v = - let set = findSet h k in - replace h k (PosSet.add v set) -end +type decls = Decl.t PosHash.t +(** type alias for declaration hashtables *) -type decls = decl PosHash.t -(** all exported declarations *) +(* NOTE: Global decls removed - now using Declarations.builder/t pattern *) -let decls = (PosHash.create 256 : decls) +(* NOTE: Global ValueReferences removed - now using References.builder/t pattern *) -module ValueReferences = struct - (** all value references *) - let table = (PosHash.create 256 : PosSet.t PosHash.t) +(* 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 add posTo posFrom = PosHash.addSet table posTo posFrom - let find pos = PosHash.findSet table pos + 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) - - let add posTo posFrom = PosHash.addSet table posTo posFrom - let find pos = PosHash.findSet table pos -end +(* NOTE: Global TypeReferences removed - now using References.builder/t pattern *) let declGetLoc decl = let loc_start = let offset = - WriteDeadAnnotations.offsetOfPosAdjustment decl.posAdjustment + match decl.Decl.posAdjustment with + | FirstVariant | Nothing -> 0 + | OtherVariant -> 2 in let cnumWithOffset = decl.posStart.pos_cnum + offset in if cnumWithOffset < decl.posEnd.pos_cnum then @@ -88,274 +70,32 @@ 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 = - match lastBinding = Location.none with - | true -> locFrom - | false -> lastBinding - in - if not locFrom.loc_ghost then ( - if !Cli.debug then +let addValueReference ~config ~refs ~file_deps ~(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 config.DceConfig.cli.debug then Log_.item "addValueReference %s --> %s@." - (locFrom.loc_start |> posToString) - (locTo.loc_start |> posToString); - ValueReferences.add locTo.loc_start locFrom.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) - -let iterFilesFromRootsToLeaves 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 *) - let referencesByNumber = (Hashtbl.create 1 : (int, FileSet.t) Hashtbl.t) in - let getNum fileName = - try Hashtbl.find inverseReferences fileName with Not_found -> 0 - in - let getSet num = - try Hashtbl.find referencesByNumber num with Not_found -> FileSet.empty - in - let addIncomingEdge fileName = - let oldNum = getNum fileName in - let newNum = oldNum + 1 in - let oldSetAtNum = getSet oldNum in - let newSetAtNum = FileSet.remove fileName oldSetAtNum in - let oldSetAtNewNum = getSet newNum in - let newSetAtNewNum = FileSet.add fileName oldSetAtNewNum in - Hashtbl.replace inverseReferences fileName newNum; - Hashtbl.replace referencesByNumber oldNum newSetAtNum; - Hashtbl.replace referencesByNumber newNum newSetAtNewNum - in - let removeIncomingEdge fileName = - let oldNum = getNum fileName in - let newNum = oldNum - 1 in - let oldSetAtNum = getSet oldNum in - let newSetAtNum = FileSet.remove fileName oldSetAtNum in - let oldSetAtNewNum = getSet newNum in - let newSetAtNewNum = FileSet.add fileName oldSetAtNewNum in - Hashtbl.replace inverseReferences fileName newNum; - Hashtbl.replace referencesByNumber oldNum newSetAtNum; - Hashtbl.replace referencesByNumber newNum newSetAtNewNum - in - let addEdge fromFile toFile = - if FileReferences.exists fromFile then addIncomingEdge toFile - in - let removeEdge fromFile toFile = - if FileReferences.exists fromFile then removeIncomingEdge toFile - in - FileReferences.iter (fun fromFile set -> - if getNum fromFile = 0 then - Hashtbl.replace referencesByNumber 0 (FileSet.add fromFile (getSet 0)); - set |> FileSet.iter (fun toFile -> addEdge fromFile toFile)); - while getSet 0 <> FileSet.empty do - let filesWithNoIncomingReferences = getSet 0 in - Hashtbl.remove referencesByNumber 0; - filesWithNoIncomingReferences - |> FileSet.iter (fun fileName -> - iterFun fileName; - let references = FileReferences.find fileName in - references |> FileSet.iter (fun toFile -> removeEdge fileName toFile)) - done; - (* Process any remaining items in case of circular references *) - referencesByNumber - |> Hashtbl.iter (fun _num set -> - if FileSet.is_empty set then () - else - set - |> FileSet.iter (fun fileName -> - let pos = {Lexing.dummy_pos with pos_fname = fileName} in - let loc = - {Location.none with loc_start = pos; loc_end = pos} - in - if Config.warnOnCircularDependencies then - Log_.warning ~loc - (Circular - { - message = - Format.asprintf - "Results for %s could be inaccurate because of \ - circular references" - fileName; - }); - iterFun fileName)) - -(** Keep track of the location of values annotated @genType or @dead *) -module ProcessDeadAnnotations = struct - type annotatedAs = GenType | Dead | Live - - let positionsAnnotated = PosHash.create 1 - let isAnnotatedDead pos = PosHash.find_opt positionsAnnotated pos = Some Dead - - let isAnnotatedGenTypeOrLive pos = - match PosHash.find_opt positionsAnnotated pos with - | Some (Live | GenType) -> true - | Some Dead | None -> false - - let isAnnotatedGenTypeOrDead pos = - match PosHash.find_opt positionsAnnotated pos with - | Some (Dead | GenType) -> true - | Some Live | None -> false - - let annotateGenType (pos : Lexing.position) = - PosHash.replace positionsAnnotated pos GenType - - let annotateDead (pos : Lexing.position) = - PosHash.replace positionsAnnotated pos Dead - - let annotateLive (pos : Lexing.position) = - PosHash.replace positionsAnnotated pos Live - - let processAttributes ~doGenType ~name ~pos attributes = - let getPayloadFun f = attributes |> Annotation.getAttributePayload f in - let getPayload (x : string) = - attributes |> Annotation.getAttributePayload (( = ) x) - in + (effectiveFrom.loc_start |> Pos.toString) + (locTo.loc_start |> Pos.toString); + References.add_value_ref refs ~posTo:locTo.loc_start + ~posFrom:effectiveFrom.loc_start; if - doGenType - && getPayloadFun Annotation.tagIsOneOfTheGenTypeAnnotations <> None - then pos |> annotateGenType; - if getPayload WriteDeadAnnotations.deadAnnotation <> None then - pos |> annotateDead; - let nameIsInLiveNamesOrPaths () = - !Cli.liveNames |> List.mem name - || - let fname = - match Filename.is_relative pos.pos_fname with - | true -> pos.pos_fname - | false -> Filename.concat (Sys.getcwd ()) pos.pos_fname - in - let fnameLen = String.length fname in - !Cli.livePaths - |> List.exists (fun prefix -> - String.length prefix <= fnameLen - && - try String.sub fname 0 (String.length prefix) = prefix - with Invalid_argument _ -> false) - in - if getPayload liveAnnotation <> None || nameIsInLiveNamesOrPaths () then - pos |> annotateLive; - if attributes |> Annotation.isOcamlSuppressDeadWarning then - pos |> annotateLive - - let collectExportLocations ~doGenType = - let super = Tast_mapper.default in - let currentlyDisableWarnings = ref false in - let value_binding self - ({vb_attributes; vb_pat} as value_binding : Typedtree.value_binding) = - (match vb_pat.pat_desc with - | Tpat_var (id, {loc = {loc_start = pos}}) - | 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 - | _ -> ()); - super.value_binding self value_binding - in - let type_kind toplevelAttrs self (typeKind : Typedtree.type_kind) = - (match typeKind with - | Ttype_record labelDeclarations -> - labelDeclarations - |> List.iter - (fun ({ld_attributes; ld_loc} : Typedtree.label_declaration) -> - toplevelAttrs @ ld_attributes - |> processAttributes ~doGenType:false ~name:"" - ~pos:ld_loc.loc_start) - | Ttype_variant constructorDeclarations -> - constructorDeclarations - |> List.iter - (fun - ({cd_attributes; cd_loc; cd_args} : - Typedtree.constructor_declaration) - -> - let _process_inline_records = - match cd_args with - | Cstr_record flds -> - List.iter - (fun ({ld_attributes; ld_loc} : - Typedtree.label_declaration) -> - toplevelAttrs @ cd_attributes @ ld_attributes - |> processAttributes ~doGenType:false ~name:"" - ~pos:ld_loc.loc_start) - flds - | Cstr_tuple _ -> () - in - toplevelAttrs @ cd_attributes - |> processAttributes ~doGenType:false ~name:"" - ~pos:cd_loc.loc_start) - | _ -> ()); - super.type_kind self typeKind - in - let type_declaration self (typeDeclaration : Typedtree.type_declaration) = - let attributes = typeDeclaration.typ_attributes in - let _ = type_kind attributes self typeDeclaration.typ_kind in - typeDeclaration - in - let value_description self - ({val_attributes; val_id; val_val = {val_loc = {loc_start = pos}}} as - value_description : - Typedtree.value_description) = - if !currentlyDisableWarnings then pos |> annotateLive; - val_attributes - |> processAttributes ~doGenType ~name:(val_id |> Ident.name) ~pos; - super.value_description self value_description - in - let structure_item self (item : Typedtree.structure_item) = - (match item.str_desc with - | Tstr_attribute attribute - when [attribute] |> Annotation.isOcamlSuppressDeadWarning -> - currentlyDisableWarnings := true - | _ -> ()); - super.structure_item self item - in - let structure self (structure : Typedtree.structure) = - let oldDisableWarnings = !currentlyDisableWarnings in - super.structure self structure |> ignore; - currentlyDisableWarnings := oldDisableWarnings; - structure - in - let signature_item self (item : Typedtree.signature_item) = - (match item.sig_desc with - | Tsig_attribute attribute - when [attribute] |> Annotation.isOcamlSuppressDeadWarning -> - currentlyDisableWarnings := true - | _ -> ()); - super.signature_item self item - in - let signature self (signature : Typedtree.signature) = - let oldDisableWarnings = !currentlyDisableWarnings in - super.signature self signature |> ignore; - currentlyDisableWarnings := oldDisableWarnings; - signature - in - { - super with - signature; - signature_item; - structure; - structure_item; - type_declaration; - value_binding; - value_description; - } + addFileReference && (not locTo.loc_ghost) + && (not effectiveFrom.loc_ghost) + && effectiveFrom.loc_start.pos_fname <> locTo.loc_start.pos_fname + then + FileDeps.add_dep file_deps ~from_file:effectiveFrom.loc_start.pos_fname + ~to_file:locTo.loc_start.pos_fname) - let structure ~doGenType structure = - let collectExportLocations = collectExportLocations ~doGenType in - structure - |> collectExportLocations.structure collectExportLocations - |> ignore +(* NOTE: iterFilesFromRootsToLeaves moved to FileDeps.iter_files_from_roots_to_leaves *) - let signature signature = - let collectExportLocations = collectExportLocations ~doGenType:true in - signature - |> collectExportLocations.signature collectExportLocations - |> ignore -end +let iterFilesFromRootsToLeaves ~file_deps iterFun = + FileDeps.iter_files_from_roots_to_leaves file_deps iterFun -let addDeclaration_ ?posEnd ?posStart ~declKind ~path ~(loc : Location.t) - ?(posAdjustment = Nothing) ~moduleLoc (name : Name.t) = +let addDeclaration_ ~config ~decls ~(file : FileContext.t) ?posEnd ?posStart + ~declKind ~path ~(loc : Location.t) ?(posAdjustment = Decl.Nothing) + ~moduleLoc (name : Name.t) = let pos = loc.loc_start in let posStart = match posStart with @@ -372,17 +112,14 @@ let addDeclaration_ ?posEnd ?posStart ~declKind ~path ~(loc : Location.t) 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 !Cli.debug 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) - (name |> Name.toString) (pos |> posToString) (path |> Path.toString); + (declKind |> Decl.Kind.toString) + (name |> Name.toString) (pos |> Pos.toString) (path |> DcePath.toString); let decl = { - declKind; + Decl.declKind; moduleLoc; posAdjustment; path = name :: path; @@ -393,217 +130,139 @@ let addDeclaration_ ?posEnd ?posStart ~declKind ~path ~(loc : Location.t) report = true; } in - PosHash.replace decls pos decl) + Declarations.add decls pos decl) -let addValueDeclaration ?(isToplevel = true) ~(loc : Location.t) ~moduleLoc - ?(optionalArgs = OptionalArgs.empty) ~path ~sideEffects name = +let addValueDeclaration ~config ~decls ~file ?(isToplevel = true) + ~(loc : Location.t) ~moduleLoc ?(optionalArgs = OptionalArgs.empty) ~path + ~sideEffects name = name - |> addDeclaration_ + |> addDeclaration_ ~config ~decls ~file ~declKind:(Value {isToplevel; optionalArgs; sideEffects}) ~loc ~moduleLoc ~path -let emitWarning ~decl ~message deadWarning = +(** Create a dead code issue. Pure - no side effects. *) +let makeDeadIssue ~decl ~message deadWarning : Issue.t = let loc = decl |> declGetLoc in - let isToplevelValueWithSideEffects decl = - match decl.declKind with - | Value {isToplevel; sideEffects} -> isToplevel && sideEffects - | _ -> false - in - let shouldWriteLineAnnotation = - (not (isToplevelValueWithSideEffects decl)) - && Suppress.filter decl.pos - && deadWarning <> IncorrectDeadAnnotation + AnalysisResult.make_dead_issue ~loc ~deadWarning + ~path:(DcePath.withoutHead decl.path) + ~message + +let isInsideReportedValue (ctx : ReportingContext.t) decl = + let max_end = ReportingContext.get_max_end ctx in + let fileHasChanged = max_end.pos_fname <> decl.Decl.pos.pos_fname in + let insideReportedValue = + decl |> Decl.isValue && (not fileHasChanged) + && max_end.pos_cnum > decl.pos.pos_cnum in - let lineAnnotation = - if shouldWriteLineAnnotation then - WriteDeadAnnotations.addLineAnnotation ~decl - else None - in - decl.path - |> Path.toModuleName ~isType:(decl.declKind |> DeclKind.isType) - |> DeadModules.checkModuleDead ~fileName:decl.pos.pos_fname; - Log_.warning ~loc - (DeadWarning - { - deadWarning; - path = Path.withoutHead decl.path; - message; - lineAnnotation; - shouldWriteLineAnnotation; - }) - -module Decl = struct - let isValue decl = - match decl.declKind with - | Value _ (* | Exception *) -> true - | _ -> false - - let isToplevelValueWithSideEffects decl = - match decl.declKind with - | Value {isToplevel; sideEffects} -> isToplevel && sideEffects - | _ -> false - - let compareUsingDependencies ~orderedFiles - { - declKind = kind1; - path = _path1; - pos = - { - pos_fname = fname1; - pos_lnum = lnum1; - pos_bol = bol1; - pos_cnum = cnum1; - }; - } - { - declKind = kind2; - path = _path2; - pos = - { - pos_fname = fname2; - pos_lnum = lnum2; - pos_bol = bol2; - pos_cnum = cnum2; - }; - } = - let findPosition fn = Hashtbl.find orderedFiles fn [@@raises Not_found] in - (* From the root of the file dependency DAG to the leaves. - From the bottom of the file to the top. *) - let position1, position2 = - try (fname1 |> findPosition, fname2 |> findPosition) - with Not_found -> (0, 0) + if not insideReportedValue then + if decl |> Decl.isValue then + if fileHasChanged || decl.posEnd.pos_cnum > max_end.pos_cnum then + ReportingContext.set_max_end ctx decl.posEnd; + insideReportedValue + +(** Report a dead declaration. Returns list of issues (dead module first, then dead value). + Caller is responsible for logging. *) +let reportDeclaration ~config ~refs (ctx : ReportingContext.t) decl : + Issue.t list = + let insideReportedValue = decl |> isInsideReportedValue ctx in + if not decl.report then [] + else + let deadWarning, message = + match decl.declKind with + | Exception -> + (Issue.WarningDeadException, "is never raised or passed as value") + | Value {sideEffects} -> ( + let noSideEffectsOrUnderscore = + (not sideEffects) + || + match decl.path with + | hd :: _ -> hd |> Name.startsWithUnderscore + | [] -> false + in + ( (match not noSideEffectsOrUnderscore with + | true -> WarningDeadValueWithSideEffects + | false -> WarningDeadValue), + match decl.path with + | name :: _ when name |> Name.isUnderscore -> + "has no side effects and can be removed" + | _ -> ( + "is never used" + ^ + match not noSideEffectsOrUnderscore with + | true -> " and could have side effects" + | false -> "") )) + | RecordLabel -> + (WarningDeadType, "is a record label never used to read a value") + | VariantCase -> + (WarningDeadType, "is a variant case which is never constructed") in - compare - (position1, lnum2, bol2, cnum2, kind1) - (position2, lnum1, bol1, cnum1, kind2) - - let compareForReporting - { - declKind = kind1; - pos = - { - pos_fname = fname1; - pos_lnum = lnum1; - pos_bol = bol1; - pos_cnum = cnum1; - }; - } - { - declKind = kind2; - pos = - { - pos_fname = fname2; - pos_lnum = lnum2; - pos_bol = bol2; - pos_cnum = cnum2; - }; - } = - compare - (fname1, lnum1, bol1, cnum1, kind1) - (fname2, lnum2, bol2, cnum2, kind2) - - let isInsideReportedValue decl = - let fileHasChanged = - !Current.maxValuePosEnd.pos_fname <> decl.pos.pos_fname + let hasRefBelow () = + let decl_refs = References.find_value_refs refs decl.pos in + let refIsBelow (pos : Lexing.position) = + decl.pos.pos_fname <> pos.pos_fname + || decl.pos.pos_cnum < pos.pos_cnum + && + (* not a function defined inside a function, e.g. not a callback *) + decl.posEnd.pos_cnum < pos.pos_cnum + in + decl_refs |> PosSet.exists refIsBelow in - let insideReportedValue = - decl |> isValue && (not fileHasChanged) - && !Current.maxValuePosEnd.pos_cnum > decl.pos.pos_cnum + let shouldEmitWarning = + (not insideReportedValue) + && (match decl.path with + | name :: _ when name |> Name.isUnderscore -> Config.reportUnderscore + | _ -> true) + && (config.DceConfig.run.transitive || not (hasRefBelow ())) in - if not insideReportedValue then - if decl |> isValue then - if - fileHasChanged - || decl.posEnd.pos_cnum > !Current.maxValuePosEnd.pos_cnum - then Current.maxValuePosEnd := decl.posEnd; - insideReportedValue - - let report decl = - let insideReportedValue = decl |> isInsideReportedValue in - if decl.report then - let name, message = - match decl.declKind with - | Exception -> - (WarningDeadException, "is never raised or passed as value") - | Value {sideEffects} -> ( - let noSideEffectsOrUnderscore = - (not sideEffects) - || - match decl.path with - | hd :: _ -> hd |> Name.startsWithUnderscore - | [] -> false - in - ( (match not noSideEffectsOrUnderscore with - | true -> WarningDeadValueWithSideEffects - | false -> WarningDeadValue), - match decl.path with - | name :: _ when name |> Name.isUnderscore -> - "has no side effects and can be removed" - | _ -> ( - "is never used" - ^ - match not noSideEffectsOrUnderscore with - | true -> " and could have side effects" - | false -> "") )) - | RecordLabel -> - (WarningDeadType, "is a record label never used to read a value") - | VariantCase -> - (WarningDeadType, "is a variant case which is never constructed") - in - let hasRefBelow () = - let refs = ValueReferences.find decl.pos in - let refIsBelow (pos : Lexing.position) = - decl.pos.pos_fname <> pos.pos_fname - || decl.pos.pos_cnum < pos.pos_cnum - && - (* not a function defined inside a function, e.g. not a callback *) - decl.posEnd.pos_cnum < pos.pos_cnum - in - refs |> PosSet.exists refIsBelow - in - let shouldEmitWarning = - (not insideReportedValue) - && (match decl.path with - | name :: _ when name |> Name.isUnderscore -> Config.reportUnderscore - | _ -> true) - && (runConfig.transitive || not (hasRefBelow ())) - in - if shouldEmitWarning then ( + if shouldEmitWarning then + let dead_module_issue = decl.path - |> Path.toModuleName ~isType:(decl.declKind |> DeclKind.isType) - |> DeadModules.checkModuleDead ~fileName:decl.pos.pos_fname; - emitWarning ~decl ~message name) -end - -let declIsDead ~refs decl = + |> DcePath.toModuleName ~isType:(decl.declKind |> Decl.Kind.isType) + |> DeadModules.checkModuleDead ~config ~fileName:decl.pos.pos_fname + in + let dead_value_issue = makeDeadIssue ~decl ~message deadWarning in + (* Return in order: dead module first (if any), then dead value *) + match dead_module_issue with + | Some mi -> [mi; dead_value_issue] + | None -> [dead_value_issue] + else [] + +let declIsDead ~annotations ~refs decl = let liveRefs = refs - |> PosSet.filter (fun p -> not (ProcessDeadAnnotations.isAnnotatedDead p)) + |> PosSet.filter (fun p -> + not (FileAnnotations.is_annotated_dead annotations p)) in liveRefs |> PosSet.cardinal = 0 - && not (ProcessDeadAnnotations.isAnnotatedGenTypeOrLive decl.pos) - -let doReportDead pos = not (ProcessDeadAnnotations.isAnnotatedGenTypeOrDead pos) - -let rec resolveRecursiveRefs ~checkOptionalArg ~deadDeclarations ~level - ~orderedFiles ~refs ~refsBeingResolved decl : bool = - match decl.pos with + && not + (FileAnnotations.is_annotated_gentype_or_live annotations decl.Decl.pos) + +let doReportDead ~annotations pos = + not (FileAnnotations.is_annotated_gentype_or_dead annotations pos) + +let rec resolveRecursiveRefs ~all_refs ~annotations ~config ~decls + ~checkOptionalArg: + (checkOptionalArgFn : config:DceConfig.t -> Decl.t -> Issue.t list) + ~deadDeclarations ~issues ~level ~orderedFiles ~refs ~refsBeingResolved decl + : bool = + match decl.Decl.pos with | _ when decl.resolvedDead <> None -> if Config.recursiveDebug then Log_.item "recursiveDebug %s [%d] already resolved@." - (decl.path |> Path.toString) + (decl.path |> DcePath.toString) level; - decl.pos |> ProcessDeadAnnotations.isAnnotatedDead + (* Use the already-resolved value, not source annotations *) + Option.get decl.resolvedDead | _ when PosSet.mem decl.pos !refsBeingResolved -> if Config.recursiveDebug then Log_.item "recursiveDebug %s [%d] is being resolved: assume dead@." - (decl.path |> Path.toString) + (decl.path |> DcePath.toString) level; true | _ -> if Config.recursiveDebug then Log_.item "recursiveDebug resolving %s [%d]@." - (decl.path |> Path.toString) + (decl.path |> DcePath.toString) level; refsBeingResolved := PosSet.add decl.pos !refsBeingResolved; let allDepsResolved = ref true in @@ -613,82 +272,100 @@ let rec resolveRecursiveRefs ~checkOptionalArg ~deadDeclarations ~level if pos = decl.pos then ( if Config.recursiveDebug then Log_.item "recursiveDebug %s ignoring reference to self@." - (decl.path |> Path.toString); + (decl.path |> DcePath.toString); false) else - match PosHash.find_opt decls pos with + match Declarations.find_opt decls pos with | None -> if Config.recursiveDebug then Log_.item "recursiveDebug can't find decl for %s@." - (pos |> posToString); + (pos |> Pos.toString); true | Some xDecl -> let xRefs = - match xDecl.declKind |> DeclKind.isType with - | true -> TypeReferences.find pos - | false -> ValueReferences.find pos + match xDecl.declKind |> Decl.Kind.isType with + | true -> References.find_type_refs all_refs pos + | false -> References.find_value_refs all_refs pos in let xDeclIsDead = xDecl - |> resolveRecursiveRefs ~checkOptionalArg ~deadDeclarations - ~level:(level + 1) ~orderedFiles ~refs:xRefs + |> resolveRecursiveRefs ~all_refs ~annotations ~config ~decls + ~checkOptionalArg:checkOptionalArgFn ~deadDeclarations + ~issues ~level:(level + 1) ~orderedFiles ~refs:xRefs ~refsBeingResolved in if xDecl.resolvedDead = None then allDepsResolved := false; not xDeclIsDead) in - let isDead = decl |> declIsDead ~refs:newRefs in + let isDead = decl |> declIsDead ~annotations ~refs:newRefs in let isResolved = (not isDead) || !allDepsResolved || level = 0 in if isResolved then ( decl.resolvedDead <- Some isDead; if isDead then ( decl.path - |> DeadModules.markDead - ~isType:(decl.declKind |> DeclKind.isType) + |> DeadModules.markDead ~config + ~isType:(decl.declKind |> Decl.Kind.isType) ~loc:decl.moduleLoc; - if not (decl.pos |> doReportDead) then decl.report <- false; - deadDeclarations := decl :: !deadDeclarations; - if not (Decl.isToplevelValueWithSideEffects decl) then - decl.pos |> ProcessDeadAnnotations.annotateDead) + if not (doReportDead ~annotations decl.pos) then decl.report <- false; + deadDeclarations := decl :: !deadDeclarations) else ( - checkOptionalArg decl; + (* Collect optional args issues *) + checkOptionalArgFn ~config decl + |> List.iter (fun issue -> issues := issue :: !issues); decl.path - |> DeadModules.markLive - ~isType:(decl.declKind |> DeclKind.isType) + |> DeadModules.markLive ~config + ~isType:(decl.declKind |> Decl.Kind.isType) ~loc:decl.moduleLoc; - if decl.pos |> ProcessDeadAnnotations.isAnnotatedDead then - emitWarning ~decl ~message:" is annotated @dead but is live" - IncorrectDeadAnnotation); - if !Cli.debug then + if FileAnnotations.is_annotated_dead annotations decl.pos then ( + (* Collect incorrect @dead annotation issue *) + let issue = + makeDeadIssue ~decl ~message:" is annotated @dead but is live" + IncorrectDeadAnnotation + in + decl.path + |> DcePath.toModuleName ~isType:(decl.declKind |> Decl.Kind.isType) + |> DeadModules.checkModuleDead ~config ~fileName:decl.pos.pos_fname + |> Option.iter (fun mod_issue -> issues := mod_issue :: !issues); + issues := issue :: !issues)); + if config.DceConfig.cli.debug then let refsString = - newRefs |> PosSet.elements |> List.map posToString + newRefs |> PosSet.elements |> List.map Pos.toString |> String.concat ", " in Log_.item "%s %s %s: %d references (%s) [%d]@." (match isDead with | true -> "Dead" | false -> "Live") - (decl.declKind |> DeclKind.toString) - (decl.path |> Path.toString) + (decl.declKind |> Decl.Kind.toString) + (decl.path |> DcePath.toString) (newRefs |> PosSet.cardinal) refsString level); isDead -let reportDead ~checkOptionalArg = - let iterDeclInOrder ~deadDeclarations ~orderedFiles decl = - let refs = +let solveDead ~annotations ~config ~decls ~refs ~file_deps ~optional_args_state + ~checkOptionalArg: + (checkOptionalArgFn : + optional_args_state:OptionalArgsState.t -> + annotations:FileAnnotations.t -> + config:DceConfig.t -> + Decl.t -> + Issue.t list) : AnalysisResult.t = + let iterDeclInOrder ~deadDeclarations ~issues ~orderedFiles decl = + let decl_refs = match decl |> Decl.isValue with - | true -> ValueReferences.find decl.pos - | false -> TypeReferences.find decl.pos + | true -> References.find_value_refs refs decl.pos + | false -> References.find_type_refs refs decl.pos in - resolveRecursiveRefs ~checkOptionalArg ~deadDeclarations ~level:0 - ~orderedFiles ~refsBeingResolved:(ref PosSet.empty) ~refs decl + resolveRecursiveRefs ~all_refs:refs ~annotations ~config ~decls + ~checkOptionalArg:(checkOptionalArgFn ~optional_args_state ~annotations) + ~deadDeclarations ~issues ~level:0 ~orderedFiles + ~refsBeingResolved:(ref PosSet.empty) ~refs:decl_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 -> + FileDeps.iter_deps file_deps (fun file files -> fileList := (file, files) :: !fileList); !fileList |> List.sort (fun (f1, _) (f2, _) -> String.compare f1 f2) @@ -698,10 +375,12 @@ let reportDead ~checkOptionalArg = (files |> FileSet.elements |> List.map Filename.basename |> String.concat ", "))); let declarations = - PosHash.fold (fun _pos decl declarations -> decl :: declarations) decls [] + Declarations.fold + (fun _pos decl declarations -> decl :: declarations) + decls [] in let orderedFiles = Hashtbl.create 256 in - iterFilesFromRootsToLeaves + iterFilesFromRootsToLeaves ~file_deps (let current = ref 0 in fun fileName -> incr current; @@ -711,10 +390,22 @@ let reportDead ~checkOptionalArg = declarations |> List.fast_sort (Decl.compareUsingDependencies ~orderedFiles) in let deadDeclarations = ref [] in + let inline_issues = ref [] in orderedDeclarations - |> List.iter (iterDeclInOrder ~orderedFiles ~deadDeclarations); + |> List.iter + (iterDeclInOrder ~orderedFiles ~deadDeclarations ~issues:inline_issues); let sortedDeadDeclarations = !deadDeclarations |> List.fast_sort Decl.compareForReporting in - (* XXX *) - sortedDeadDeclarations |> List.iter Decl.report + (* Collect issues from dead declarations *) + let reporting_ctx = ReportingContext.create () in + let dead_issues = + sortedDeadDeclarations + |> List.concat_map (fun decl -> + reportDeclaration ~config ~refs reporting_ctx decl) + in + (* Combine all issues: inline issues first (they were logged during analysis), + then dead declaration issues *) + let all_issues = List.rev !inline_issues @ dead_issues in + (* Return result - caller is responsible for logging *) + AnalysisResult.add_issues AnalysisResult.empty all_issues diff --git a/analysis/reanalyze/src/DeadException.ml b/analysis/reanalyze/src/DeadException.ml index 023bee3f68..caaa108cb4 100644 --- a/analysis/reanalyze/src/DeadException.ml +++ b/analysis/reanalyze/src/DeadException.ml @@ -1,33 +1,26 @@ open DeadCommon -open Common -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 ~decls ~file ~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 - ~declKind:Exception ~moduleLoc:(ModulePath.getCurrent ()).loc ~path ~loc + |> addDeclaration_ ~config ~decls ~file ~posEnd:strLoc.loc_end + ~posStart:strLoc.loc_start ~declKind:Exception + ~moduleLoc:(ModulePath.getCurrent ()).loc ~path ~loc -let forceDelayedItems () = - let items = !delayedItems |> List.rev in - delayedItems := []; - items - |> List.iter (fun {exceptionPath; locFrom} -> - match Hashtbl.find_opt declarations exceptionPath with - | None -> () - | Some locTo -> - addValueReference ~addFileReference:true ~locFrom ~locTo) +let find_exception path = Hashtbl.find_opt declarations path -let markAsUsed ~(locFrom : Location.t) ~(locTo : Location.t) path_ = +let markAsUsed ~config ~refs ~file_deps ~cross_file ~(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 *) let exceptionPath = - path_ |> Path.fromPathT |> Path.moduleToImplementation + path_ |> DcePath.fromPathT |> DcePath.moduleToImplementation in - delayedItems := {exceptionPath; locFrom} :: !delayedItems - else addValueReference ~addFileReference:true ~locFrom ~locTo + CrossFileItems.add_exception_ref cross_file ~exception_path:exceptionPath + ~loc_from:locFrom + else + addValueReference ~config ~refs ~file_deps ~binding ~addFileReference:true + ~locFrom ~locTo diff --git a/analysis/reanalyze/src/DeadModules.ml b/analysis/reanalyze/src/DeadModules.ml index 572748bcfa..c8d512c371 100644 --- a/analysis/reanalyze/src/DeadModules.ml +++ b/analysis/reanalyze/src/DeadModules.ml @@ -1,26 +1,28 @@ -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 moduleName = path |> Common.Path.toModuleName ~isType in +let markDead ~config ~isType ~loc path = + if active ~config then + let moduleName = path |> DcePath.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 moduleName = path |> Common.Path.toModuleName ~isType in +let markLive ~config ~isType ~(loc : Location.t) path = + if active ~config then + let moduleName = path |> DcePath.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 +(** Check if a module is dead and return issue if so. Pure - no logging. *) +let checkModuleDead ~config ~fileName:pos_fname moduleName : Issue.t option = + if not (active ~config) then None + else match Hashtbl.find_opt table moduleName with | Some (false, loc) -> Hashtbl.remove table moduleName; @@ -33,12 +35,5 @@ let checkModuleDead ~fileName:pos_fname moduleName = {Location.loc_start = pos; loc_end = pos; loc_ghost = false} else loc in - Log_.warning ~loc - (Common.DeadModule - { - message = - Format.asprintf "@{%s@} %s" - (moduleName |> Name.toInterface |> Name.toString) - "is a dead module as all its items are dead."; - }) - | _ -> () + Some (AnalysisResult.make_dead_module_issue ~loc ~moduleName) + | _ -> None diff --git a/analysis/reanalyze/src/DeadOptionalArgs.ml b/analysis/reanalyze/src/DeadOptionalArgs.ml index 4e1fcc032f..d5842e5eaa 100644 --- a/analysis/reanalyze/src/DeadOptionalArgs.ml +++ b/analysis/reanalyze/src/DeadOptionalArgs.ml @@ -1,32 +1,25 @@ open DeadCommon -open Common let active () = true -type item = { - posTo: Lexing.position; - argNames: string list; - argNamesMaybe: string list; -} - -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 ~decls ~cross_file ~(locFrom : Location.t) + ~(locTo : Location.t) = if active () then let posTo = locTo.loc_start in let posFrom = locFrom.loc_start in + (* Check if target has optional args - for filtering and debug logging *) let shouldAdd = - match PosHash.find_opt decls posTo with + match Declarations.find_opt_builder decls posTo with | Some {declKind = Value {optionalArgs}} -> not (OptionalArgs.isEmpty optionalArgs) | _ -> 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) + (posFrom |> Pos.toString) (posTo |> Pos.toString); + CrossFileItems.add_function_reference cross_file ~pos_from:posFrom + ~pos_to:posTo) let rec hasOptionalArgs (texpr : Types.type_expr) = match texpr.desc with @@ -46,71 +39,87 @@ let rec fromTypeExpr (texpr : Types.type_expr) = | Tsubst t -> fromTypeExpr t | _ -> [] -let addReferences ~(locFrom : Location.t) ~(locTo : Location.t) ~path - (argNames, argNamesMaybe) = +let addReferences ~config ~cross_file ~(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 + CrossFileItems.add_optional_arg_call cross_file ~pos_to:posTo + ~arg_names:argNames ~arg_names_maybe:argNamesMaybe; + if config.DceConfig.cli.debug then Log_.item "DeadOptionalArgs.addReferences %s called with optional argNames:%s \ argNamesMaybe:%s %s@." - (path |> Path.fromPathT |> Path.toString) + (path |> DcePath.fromPathT |> DcePath.toString) (argNames |> String.concat ", ") (argNamesMaybe |> String.concat ", ") - (posFrom |> posToString)) + (posFrom |> Pos.toString)) -let forceDelayedItems () = - let items = !delayedItems |> List.rev in - delayedItems := []; - items - |> List.iter (fun {posTo; argNames; argNamesMaybe} -> - match PosHash.find_opt decls posTo with - | Some {declKind = Value r} -> - r.optionalArgs |> OptionalArgs.call ~argNames ~argNamesMaybe - | _ -> ()); - let fRefs = !functionReferences |> List.rev in - functionReferences := []; - fRefs - |> List.iter (fun (posFrom, posTo) -> - match - (PosHash.find_opt decls posFrom, PosHash.find_opt decls posTo) - with - | Some {declKind = Value rFrom}, Some {declKind = Value rTo} -> - OptionalArgs.combine rFrom.optionalArgs rTo.optionalArgs - | _ -> ()) - -let check decl = +(** Check for optional args issues. Returns issues instead of logging. + Uses optional_args_state map for final computed state. *) +let check ~optional_args_state ~annotations ~config:_ decl : Issue.t list = match decl with - | {declKind = Value {optionalArgs}} + | {Decl.declKind = Value {optionalArgs}} when active () - && not (ProcessDeadAnnotations.isAnnotatedGenTypeOrLive decl.pos) -> - optionalArgs - |> OptionalArgs.iterUnused (fun s -> - Log_.warning ~loc:(decl |> declGetLoc) - (DeadOptional - { - deadOptional = WarningUnusedArgument; - message = - Format.asprintf - "optional argument @{%s@} of function @{%s@} \ - is never used" - s - (decl.path |> Path.withoutHead); - })); - optionalArgs - |> OptionalArgs.iterAlwaysUsed (fun s nCalls -> - Log_.warning ~loc:(decl |> declGetLoc) - (DeadOptional - { - deadOptional = WarningRedundantOptionalArgument; - message = - Format.asprintf - "optional argument @{%s@} of function @{%s@} \ - is always supplied (%d calls)" - s - (decl.path |> Path.withoutHead) - nCalls; - })) - | _ -> () + && not + (FileAnnotations.is_annotated_gentype_or_live annotations decl.pos) + -> + (* Look up computed state from map, fall back to declaration's initial state *) + let state = + match OptionalArgsState.find_opt optional_args_state decl.pos with + | Some s -> s + | None -> optionalArgs + in + let loc = decl |> declGetLoc in + let unused_issues = + OptionalArgs.foldUnused + (fun s acc -> + let issue : Issue.t = + { + name = "Warning Unused Argument"; + severity = Warning; + loc; + description = + DeadOptional + { + deadOptional = WarningUnusedArgument; + message = + Format.asprintf + "optional argument @{%s@} of function \ + @{%s@} is never used" + s + (decl.path |> DcePath.withoutHead); + }; + } + in + issue :: acc) + state [] + in + let redundant_issues = + OptionalArgs.foldAlwaysUsed + (fun s nCalls acc -> + let issue : Issue.t = + { + name = "Warning Redundant Optional Argument"; + severity = Warning; + loc; + description = + DeadOptional + { + deadOptional = WarningRedundantOptionalArgument; + message = + Format.asprintf + "optional argument @{%s@} of function \ + @{%s@} is always supplied (%d calls)" + s + (decl.path |> DcePath.withoutHead) + nCalls; + }; + } + in + issue :: acc) + state [] + in + (* Reverse to maintain original order from iterUnused/iterAlwaysUsed *) + List.rev unused_issues @ List.rev redundant_issues + | _ -> [] diff --git a/analysis/reanalyze/src/DeadType.ml b/analysis/reanalyze/src/DeadType.ml index d7e2383579..402c4b0340 100644 --- a/analysis/reanalyze/src/DeadType.ml +++ b/analysis/reanalyze/src/DeadType.ml @@ -1,50 +1,51 @@ (* Adapted from https://github.com/LexiFi/dead_code_analyzer *) -open Common open DeadCommon module TypeLabels = struct (* map from type path (for record/variant label) to its location *) - let table = (Hashtbl.create 256 : (Path.t, Location.t) Hashtbl.t) + let table = (Hashtbl.create 256 : (DcePath.t, Location.t) Hashtbl.t) let add path loc = Hashtbl.replace table path loc let find path = Hashtbl.find_opt table path end -let addTypeReference ~posFrom ~posTo = - if !Common.Cli.debug then - Log_.item "addTypeReference %s --> %s@." (posFrom |> posToString) - (posTo |> posToString); - TypeReferences.add posTo posFrom +let addTypeReference ~config ~refs ~posFrom ~posTo = + if config.DceConfig.cli.debug then + Log_.item "addTypeReference %s --> %s@." (posFrom |> Pos.toString) + (posTo |> Pos.toString); + References.add_type_ref refs ~posTo ~posFrom module TypeDependencies = struct let delayedItems = ref [] let add loc1 loc2 = delayedItems := (loc1, loc2) :: !delayedItems let clear () = delayedItems := [] - let processTypeDependency + let processTypeDependency ~config ~refs ( ({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 ~refs ~posTo ~posFrom - let forceDelayedItems () = List.iter processTypeDependency !delayedItems + let forceDelayedItems ~config ~refs = + List.iter (processTypeDependency ~config ~refs) !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); + (loc1.loc_start |> Pos.toString) + (loc2.loc_start |> Pos.toString); TypeDependencies.add loc1 loc2) (* Type dependencies between Foo.re and Foo.rei *) -let addTypeDependenciesAcrossFiles ~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 + let path_1 = pathToType |> DcePath.moduleToInterface in + let path_2 = path_1 |> DcePath.typeToInterface in let path1 = typeLabelName :: path_1 in let path2 = typeLabelName :: path_2 in match TypeLabels.find path1 with @@ -52,45 +53,46 @@ 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 path_1 = pathToType |> DcePath.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 ~decls ~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 + let processTypeLabel ?(posAdjustment = Decl.Nothing) typeLabelName ~declKind ~(loc : Location.t) = - addDeclaration_ ~declKind ~path:pathToType ~loc + addDeclaration_ ~config ~decls ~file ~declKind ~path:pathToType ~loc ~moduleLoc:currentModulePath.loc ~posAdjustment typeLabelName; - addTypeDependenciesAcrossFiles ~pathToType ~loc ~typeLabelName; - addTypeDependenciesInnerModule ~pathToType ~loc ~typeLabelName; + addTypeDependenciesAcrossFiles ~config ~file ~pathToType ~loc ~typeLabelName; + addTypeDependenciesInnerModule ~config ~pathToType ~loc ~typeLabelName; TypeLabels.add (typeLabelName :: pathToType) loc in match typeKind with @@ -116,8 +118,12 @@ let addDeclaration ~(typeId : Ident.t) ~(typeKind : Types.type_kind) = in let posAdjustment = (* In Res the variant loc can include the | and spaces after it *) - if WriteDeadAnnotations.posLanguage cd_loc.loc_start = Res then - if i = 0 then FirstVariant else OtherVariant + let isRes = + let fname = cd_loc.loc_start.pos_fname in + Filename.check_suffix fname ".res" + || Filename.check_suffix fname ".resi" + in + if isRes then if i = 0 then Decl.FirstVariant else OtherVariant else Nothing in Ident.name cd_id |> Name.create diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index df8b6aa0e2..6197ce7417 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -2,23 +2,23 @@ open DeadCommon -let checkAnyValueBindingWithNoSideEffects +let checkAnyValueBindingWithNoSideEffects ~config ~decls ~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 ~path ~loc ~moduleLoc:currentModulePath.loc - ~sideEffects:false + |> addValueDeclaration ~config ~decls ~file ~path ~loc + ~moduleLoc:currentModulePath.loc ~sideEffects:false | _ -> () -let collectValueBinding super self (vb : Typedtree.value_binding) = - let oldCurrentBindings = !Current.bindings in - let oldLastBinding = !Current.lastBinding in - checkAnyValueBindingWithNoSideEffects vb; +let collectValueBinding ~config ~decls ~file ~(current_binding : Location.t) + (vb : Typedtree.value_binding) = + let oldLastBinding = current_binding in + checkAnyValueBindingWithNoSideEffects ~config ~decls ~file vb; let loc = match vb.vb_pat.pat_desc with | Tpat_var (id, {loc = {loc_start; loc_ghost} as loc}) @@ -28,17 +28,19 @@ let collectValueBinding super self (vb : Typedtree.value_binding) = let name = Ident.name id |> Name.create ~isInterface:false in let optionalArgs = vb.vb_expr.exp_type |> DeadOptionalArgs.fromTypeExpr - |> Common.OptionalArgs.fromList + |> OptionalArgs.fromList in let exists = - match PosHash.find_opt decls loc_start with + match Declarations.find_opt_builder decls loc_start with | Some {declKind = Value r} -> r.optionalArgs <- optionalArgs; true | _ -> 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,9 +51,9 @@ let collectValueBinding super self (vb : Typedtree.value_binding) = let isToplevel = oldLastBinding = Location.none in let sideEffects = SideEffects.checkExpr vb.vb_expr in name - |> addValueDeclaration ~isToplevel ~loc + |> addValueDeclaration ~config ~decls ~file ~isToplevel ~loc ~moduleLoc:currentModulePath.loc ~optionalArgs ~path ~sideEffects); - (match PosHash.find_opt decls loc_start with + (match Declarations.find_opt_builder decls loc_start with | None -> () | Some decl -> (* Value bindings contain the correct location for the entire declaration: update final position. @@ -59,11 +61,11 @@ let collectValueBinding super self (vb : Typedtree.value_binding) = let declKind = match decl.declKind with | Value vk -> - Common.DeclKind.Value + Decl.Kind.Value {vk with sideEffects = SideEffects.checkExpr vb.vb_expr} | dk -> dk in - PosHash.replace decls loc_start + Declarations.replace_builder decls loc_start { decl with declKind; @@ -71,16 +73,12 @@ let collectValueBinding super self (vb : Typedtree.value_binding) = posStart = vb.vb_loc.loc_start; }); loc - | _ -> !Current.lastBinding + | _ -> current_binding in - Current.bindings := PosSet.add loc.loc_start !Current.bindings; - Current.lastBinding := loc; - let r = super.Tast_mapper.value_binding self vb in - Current.bindings := oldCurrentBindings; - Current.lastBinding := oldLastBinding; - r + loc -let processOptionalArgs ~expType ~(locFrom : Location.t) ~locTo ~path args = +let processOptionalArgs ~config ~cross_file ~expType ~(locFrom : Location.t) + ~locTo ~path args = if expType |> DeadOptionalArgs.hasOptionalArgs then ( let supplied = ref [] in let suppliedMaybe = ref [] in @@ -109,22 +107,27 @@ 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 ~cross_file ~locFrom ~locTo ~path) -let rec collectExpr super self (e : Typedtree.expression) = +let rec collectExpr ~config ~refs ~file_deps ~cross_file + ~(last_binding : Location.t) super self (e : Typedtree.expression) = let locFrom = e.exp_loc 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; *) 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 addValueReference ~addFileReference:true ~locFrom ~locTo + (Location.none.loc_start |> Pos.toString) + (locTo.loc_start |> Pos.toString); + References.add_value_ref refs ~posTo:locTo.loc_start + ~posFrom:Location.none.loc_start) + else + addValueReference ~config ~refs ~file_deps ~binding ~addFileReference:true + ~locFrom ~locTo | Texp_apply { funct = @@ -137,7 +140,7 @@ let rec collectExpr super self (e : Typedtree.expression) = args; } -> args - |> processOptionalArgs ~expType:exp_type + |> processOptionalArgs ~config ~cross_file ~expType:exp_type ~locFrom:(locFrom : Location.t) ~locTo ~path | Texp_let @@ -178,22 +181,25 @@ let rec collectExpr super self (e : Typedtree.expression) = && Ident.name etaArg = "eta" && Path.name idArg2 = "arg" -> args - |> processOptionalArgs ~expType:exp_type + |> processOptionalArgs ~config ~cross_file ~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 ~refs ~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 ~locFrom ~locTo + | Cstr_extension path -> + path + |> DeadException.markAsUsed ~config ~refs ~file_deps ~cross_file ~binding + ~locFrom ~locTo | _ -> ()); if !Config.analyzeTypes && not loc_ghost then - DeadType.addTypeReference ~posTo ~posFrom:locFrom.loc_start + DeadType.addTypeReference ~config ~refs ~posTo ~posFrom:locFrom.loc_start | Texp_record {fields} -> fields |> Array.iter (fun (_, record_label_definition, _) -> @@ -202,7 +208,9 @@ 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 ~config ~refs ~file_deps ~cross_file ~last_binding + super self e + |> ignore | _ -> ()) | _ -> ()); super.Tast_mapper.expr self e @@ -217,7 +225,8 @@ let rec collectExpr super self (e : Typedtree.expression) = 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 ~refs : + _ -> _ -> Typedtree.pattern -> Typedtree.pattern = fun super self pat -> let posFrom = pat.Typedtree.pat_loc.loc_start in (match pat.pat_desc with @@ -225,7 +234,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 ~refs ~posFrom ~posTo) | _ -> ()); super.Tast_mapper.pat self pat @@ -235,13 +244,14 @@ let rec getSignature (moduleType : Types.module_type) = | Mty_functor (_, _mtParam, mt) -> getSignature mt | _ -> [] -let rec processSignatureItem ~doTypes ~doValues ~moduleLoc ~path - (si : Types.signature_item) = +let rec processSignatureItem ~config ~decls ~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 ~typeId:id ~typeKind:t.type_kind + DeadType.addDeclaration ~config ~decls ~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 @@ -252,16 +262,15 @@ let rec processSignatureItem ~doTypes ~doValues ~moduleLoc ~path in if (not isPrimitive) || !Config.analyzeExternals then let optionalArgs = - val_type |> DeadOptionalArgs.fromTypeExpr - |> Common.OptionalArgs.fromList + val_type |> DeadOptionalArgs.fromTypeExpr |> OptionalArgs.fromList in (* if Ident.name id = "someValue" then Printf.printf "XXX %s\n" (Ident.name id); *) Ident.name id |> Name.create ~isInterface:false - |> addValueDeclaration ~loc ~moduleLoc ~optionalArgs ~path - ~sideEffects:false + |> addValueDeclaration ~config ~decls ~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}) -> ModulePath.setCurrent @@ -278,94 +287,129 @@ let rec processSignatureItem ~doTypes ~doValues ~moduleLoc ~path if collect then getSignature moduleType |> List.iter - (processSignatureItem ~doTypes ~doValues ~moduleLoc + (processSignatureItem ~config ~decls ~file ~doTypes ~doValues + ~moduleLoc ~path:((id |> Ident.name |> Name.create) :: path)) | _ -> ()); ModulePath.setCurrent oldModulePath (* Traverse the AST *) -let traverseStructure ~doTypes ~doExternals = - let super = Tast_mapper.default in - let expr self e = e |> collectExpr super self in - let pat self p = p |> collectPattern super self in - let value_binding self vb = vb |> collectValueBinding 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 ~config ~decls ~refs ~file_deps ~cross_file ~file ~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 ~config ~refs ~file_deps ~cross_file ~last_binding + super mapper); + pat = (fun _self p -> p |> collectPattern ~config ~refs 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 ~config ~decls ~file ~doTypes + ~doValues:false ~moduleLoc:mb_expr.mod_loc + ~path: + ((ModulePath.getCurrent ()).path + @ [FileContext.module_name_tagged file])) + | _ -> ()) + | Tstr_primitive vd when doExternals && !Config.analyzeExternals -> + let currentModulePath = ModulePath.getCurrent () in + let path = + currentModulePath.path @ [FileContext.module_name_tagged file] + in + let exists = + match + Declarations.find_opt_builder 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 ~config ~decls ~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 ~decls ~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 + @ [FileContext.module_name_tagged file] + in + incl_type + |> List.iter + (processSignatureItem ~config ~decls ~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 + @ [FileContext.module_name_tagged file] + in + let name = id |> Ident.name |> Name.create in + name + |> DeadException.add ~config ~decls ~file ~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 ~config ~decls ~file + ~current_binding:last_binding + in + let nested_mapper = create_mapper loc in + super.Tast_mapper.value_binding nested_mapper vb); + } + in + mapper in - {super with expr; pat; structure_item; value_binding} + let mapper = create_mapper Location.none in + mapper.structure mapper structure |> ignore (* Merge a location's references to another one's *) -let processValueDependency +let processValueDependency ~config ~decls ~refs ~file_deps ~cross_file ( ({ val_loc = {loc_start = {pos_fname = fnTo} as posTo; loc_ghost = ghost1} as @@ -380,12 +424,17 @@ let processValueDependency Types.value_description) ) = if (not ghost1) && (not ghost2) && posTo <> posFrom then ( let addFileReference = fileIsImplementationOf fnTo fnFrom in - addValueReference ~addFileReference ~locFrom ~locTo; - DeadOptionalArgs.addFunctionReference ~locFrom ~locTo) + addValueReference ~config ~refs ~file_deps ~binding:Location.none + ~addFileReference ~locFrom ~locTo; + DeadOptionalArgs.addFunctionReference ~config ~decls ~cross_file ~locFrom + ~locTo) -let processStructure ~cmt_value_dependencies ~doTypes ~doExternals +let processStructure ~config ~decls ~refs ~file_deps ~cross_file ~file + ~cmt_value_dependencies ~doTypes ~doExternals (structure : Typedtree.structure) = - let traverseStructure = traverseStructure ~doTypes ~doExternals in - structure |> traverseStructure.structure traverseStructure |> ignore; + traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes + ~doExternals structure; let valueDependencies = cmt_value_dependencies |> List.rev in - valueDependencies |> List.iter processValueDependency + valueDependencies + |> List.iter + (processValueDependency ~config ~decls ~refs ~file_deps ~cross_file) diff --git a/analysis/reanalyze/src/Decl.ml b/analysis/reanalyze/src/Decl.ml new file mode 100644 index 0000000000..0ce1d08af2 --- /dev/null +++ b/analysis/reanalyze/src/Decl.ml @@ -0,0 +1,81 @@ +(** Declaration types for dead code analysis. *) + +module Kind = struct + type t = + | Exception + | RecordLabel + | VariantCase + | Value of { + isToplevel: bool; + mutable optionalArgs: OptionalArgs.t; + sideEffects: bool; + } + + let isType dk = + match dk with + | RecordLabel | VariantCase -> true + | Exception | Value _ -> false + + let toString dk = + match dk with + | Exception -> "Exception" + | RecordLabel -> "RecordLabel" + | VariantCase -> "VariantCase" + | Value _ -> "Value" +end + +type posAdjustment = FirstVariant | OtherVariant | Nothing + +type t = { + declKind: Kind.t; + moduleLoc: Location.t; + posAdjustment: posAdjustment; + path: DcePath.t; + pos: Lexing.position; + posEnd: Lexing.position; + posStart: Lexing.position; + mutable resolvedDead: bool option; + mutable report: bool; +} + +let isValue decl = + match decl.declKind with + | Value _ (* | Exception *) -> true + | _ -> false + +let compareUsingDependencies ~orderedFiles + { + declKind = kind1; + path = _path1; + pos = + {pos_fname = fname1; pos_lnum = lnum1; pos_bol = bol1; pos_cnum = cnum1}; + } + { + declKind = kind2; + path = _path2; + pos = + {pos_fname = fname2; pos_lnum = lnum2; pos_bol = bol2; pos_cnum = cnum2}; + } = + let findPosition fn = Hashtbl.find orderedFiles fn [@@raises Not_found] in + (* From the root of the file dependency DAG to the leaves. + From the bottom of the file to the top. *) + let position1, position2 = + try (fname1 |> findPosition, fname2 |> findPosition) + with Not_found -> (0, 0) + in + compare + (position1, lnum2, bol2, cnum2, kind1) + (position2, lnum1, bol1, cnum1, kind2) + +let compareForReporting + { + declKind = kind1; + pos = + {pos_fname = fname1; pos_lnum = lnum1; pos_bol = bol1; pos_cnum = cnum1}; + } + { + declKind = kind2; + pos = + {pos_fname = fname2; pos_lnum = lnum2; pos_bol = bol2; pos_cnum = cnum2}; + } = + compare (fname1, lnum1, bol1, cnum1, kind1) (fname2, lnum2, bol2, cnum2, kind2) diff --git a/analysis/reanalyze/src/Declarations.ml b/analysis/reanalyze/src/Declarations.ml new file mode 100644 index 0000000000..cf49afdd5a --- /dev/null +++ b/analysis/reanalyze/src/Declarations.ml @@ -0,0 +1,37 @@ +(** Declarations collected during dead code analysis. + + Two types are provided: + - [builder] - mutable, for AST processing + - [t] - immutable, for solver (read-only access) *) + +(* Both types have the same representation, but different semantics *) +type t = Decl.t PosHash.t +type builder = Decl.t PosHash.t + +(* ===== Builder API ===== *) + +let create_builder () : builder = PosHash.create 256 + +let add (builder : builder) (pos : Lexing.position) (decl : Decl.t) = + PosHash.replace builder pos decl + +let find_opt_builder (builder : builder) pos = PosHash.find_opt builder pos + +let replace_builder (builder : builder) (pos : Lexing.position) (decl : Decl.t) + = + PosHash.replace builder pos decl + +let merge_all (builders : builder list) : t = + let result = PosHash.create 256 in + builders + |> List.iter (fun builder -> + PosHash.iter (fun pos decl -> PosHash.replace result pos decl) builder); + result + +(* ===== Read-only API ===== *) + +let find_opt (t : t) pos = PosHash.find_opt t pos + +let fold f (t : t) init = PosHash.fold f t init + +let iter f (t : t) = PosHash.iter f t diff --git a/analysis/reanalyze/src/Declarations.mli b/analysis/reanalyze/src/Declarations.mli new file mode 100644 index 0000000000..31bbb7934a --- /dev/null +++ b/analysis/reanalyze/src/Declarations.mli @@ -0,0 +1,32 @@ +(** Declarations collected during dead code analysis. + + Two types are provided: + - [builder] - mutable, for AST processing + - [t] - immutable, for solver (read-only access) + + Only DceFileProcessing should use [builder]. + The solver uses [t] which is frozen/immutable. *) + +(** {2 Types} *) + +type t +(** Immutable declarations - for solver (read-only) *) + +type builder +(** Mutable builder - for AST processing *) + +(** {2 Builder API - for DceFileProcessing only} *) + +val create_builder : unit -> builder +val add : builder -> Lexing.position -> Decl.t -> unit +val find_opt_builder : builder -> Lexing.position -> Decl.t option +val replace_builder : builder -> Lexing.position -> Decl.t -> unit + +val merge_all : builder list -> t +(** Merge all builders into one immutable result. Order doesn't matter. *) + +(** {2 Read-only API for t - for solver} *) + +val find_opt : t -> Lexing.position -> Decl.t option +val fold : (Lexing.position -> Decl.t -> 'a -> 'a) -> t -> 'a -> 'a +val iter : (Lexing.position -> Decl.t -> unit) -> t -> unit diff --git a/analysis/reanalyze/src/Exception.ml b/analysis/reanalyze/src/Exception.ml index ce33c0fbd5..9cf5d4ff39 100644 --- a/analysis/reanalyze/src/Exception.ml +++ b/analysis/reanalyze/src/Exception.ml @@ -1,6 +1,4 @@ -let posToString = Common.posToString - -module LocSet = Common.LocSet +open DeadCommon module Values = struct let valueBindingsTable = @@ -10,10 +8,10 @@ module Values = struct let add ~name exceptions = let path = (name |> Name.create) :: (ModulePath.getCurrent ()).path in - Hashtbl.replace !currentFileTable (path |> Common.Path.toName) exceptions + Hashtbl.replace !currentFileTable (path |> DcePath.toName) exceptions - let getFromModule ~moduleName ~modulePath (path_ : Common.Path.t) = - let name = path_ @ modulePath |> Common.Path.toName in + let getFromModule ~moduleName ~modulePath (path_ : DcePath.t) = + let name = path_ @ modulePath |> DcePath.toName in match Hashtbl.find_opt valueBindingsTable (String.capitalize_ascii moduleName) with @@ -50,22 +48,22 @@ module Values = struct match (findExternal ~externalModuleName ~pathRev, pathRev) with | (Some _ as found), _ -> found | None, externalModuleName2 :: pathRev2 - when !Common.Cli.cmtCommand && pathRev2 <> [] -> + when !Cli.cmtCommand && pathRev2 <> [] -> (* Simplistic namespace resolution for dune namespace: skip the root of the path *) findExternal ~externalModuleName:externalModuleName2 ~pathRev:pathRev2 | None, _ -> None) | [] -> 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 type kind = | Catches of t list (* with | E => ... *) - | Call of {callee: Common.Path.t; modulePath: Common.Path.t} (* foo() *) + | Call of {callee: DcePath.t; modulePath: DcePath.t} (* foo() *) | DoesNotThrow of t list (* DoesNotThrow(events) where events come from an expression *) | Throws (** throw E *) @@ -76,33 +74,33 @@ module Event = struct match event with | {kind = Call {callee; modulePath}; exceptions; loc} -> Format.fprintf ppf "%s Call(%s, modulePath:%s) %a@." - (loc.loc_start |> posToString) - (callee |> Common.Path.toString) - (modulePath |> Common.Path.toString) + (loc.loc_start |> Pos.toString) + (callee |> DcePath.toString) + (modulePath |> DcePath.toString) (Exceptions.pp ~exnTable:None) exceptions | {kind = DoesNotThrow nestedEvents; loc} -> Format.fprintf ppf "%s DoesNotThrow(%a)@." - (loc.loc_start |> posToString) + (loc.loc_start |> Pos.toString) (fun ppf () -> nestedEvents |> List.iter (fun e -> Format.fprintf ppf "%a " print e)) () | {kind = Throws; exceptions; loc} -> Format.fprintf ppf "%s throws %a@." - (loc.loc_start |> posToString) + (loc.loc_start |> Pos.toString) (Exceptions.pp ~exnTable:None) exceptions | {kind = Catches nestedEvents; exceptions; loc} -> Format.fprintf ppf "%s Catches exceptions:%a nestedEvents:%a@." - (loc.loc_start |> posToString) + (loc.loc_start |> Pos.toString) (Exceptions.pp ~exnTable:None) exceptions (fun ppf () -> 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 +117,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,16 +133,16 @@ 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 = match nestedEvents with - | {kind = Call {callee}} :: _ -> callee |> Common.Path.toName + | {kind = Call {callee}} :: _ -> callee |> DcePath.toName | _ -> "expression" |> Name.create in Log_.warning ~loc - (Common.ExceptionAnalysis + (Issue.ExceptionAnalysis { message = Format.asprintf @@ -154,7 +152,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,19 +185,19 @@ 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 let description = - Common.ExceptionAnalysisMissing + Issue.ExceptionAnalysisMissing {exnName; exnTable; throwSet; missingAnnotations; locFull} in Log_.warning ~loc description); if not (Exceptions.isEmpty redundantAnnotations) then Log_.warning ~loc - (Common.ExceptionAnalysis + (Issue.ExceptionAnalysis { message = (let throwsDescription ppf () = @@ -217,10 +215,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 ~file () = ModulePath.init (); let super = Tast_mapper.default in let currentId = ref "" in @@ -276,13 +274,11 @@ let traverseAst () = if isDoesNoThrow then currentEvents := []; (match expr.exp_desc with | Texp_ident (callee_, _, _) -> - let callee = - callee_ |> Common.Path.fromPathT |> ModulePath.resolveAlias - in - let calleeName = callee |> Common.Path.toName in + let callee = callee_ |> DcePath.fromPathT |> ModulePath.resolveAlias in + let calleeName = callee |> DcePath.toName in if calleeName |> Name.toString |> isThrow then Log_.warning ~loc - (Common.ExceptionAnalysis + (Issue.ExceptionAnalysis { message = Format.asprintf @@ -394,7 +390,7 @@ let traverseAst () = 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) @@ -421,7 +417,7 @@ let traverseAst () = | Tstr_module {mb_id; mb_expr = {mod_desc = Tmod_ident (path_, _lid)}} -> ModulePath.addAlias ~name:(mb_id |> Ident.name |> Name.create) - ~path:(path_ |> Common.Path.fromPathT) + ~path:(path_ |> DcePath.fromPathT) | _ -> ()); result in @@ -442,7 +438,7 @@ let traverseAst () = 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 +470,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 ~file (structure : Typedtree.structure) = + let traverseAst = traverseAst ~file () in structure |> traverseAst.structure traverseAst |> ignore -let processCmt (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 + Values.newCmt ~moduleName:file.FileContext.module_name; + structure |> processStructure ~file | _ -> () diff --git a/analysis/reanalyze/src/Exceptions.ml b/analysis/reanalyze/src/Exceptions.ml index 06d4d5c187..91ae2000aa 100644 --- a/analysis/reanalyze/src/Exceptions.ml +++ b/analysis/reanalyze/src/Exceptions.ml @@ -1,4 +1,4 @@ -open Common +module ExnSet = Set.Make (Exn) type t = ExnSet.t @@ -22,11 +22,11 @@ let pp ~exnTable ppf exceptions = match Hashtbl.find_opt exnTable exn with | Some locSet -> let positions = - locSet |> Common.LocSet.elements + locSet |> LocSet.elements |> List.map (fun loc -> loc.Location.loc_start) in Format.fprintf ppf "%s@{%s@} (@{%s@})" separator name - (positions |> List.map posToString |> String.concat " ") + (positions |> List.map Pos.toString |> String.concat " ") | None -> Format.fprintf ppf "%s@{%s@}" separator name) | None -> Format.fprintf ppf "%s@{%s@}" separator name in diff --git a/analysis/reanalyze/src/ExnLib.ml b/analysis/reanalyze/src/ExnLib.ml index 3b9f2602ff..1104661b71 100644 --- a/analysis/reanalyze/src/ExnLib.ml +++ b/analysis/reanalyze/src/ExnLib.ml @@ -240,5 +240,5 @@ let raisesLibTable : (Name.t, Exceptions.t) Hashtbl.t = (e |> Exceptions.fromList))); table -let find (path : Common.Path.t) = - Hashtbl.find_opt raisesLibTable (path |> Common.Path.toName) +let find (path : DcePath.t) = + Hashtbl.find_opt raisesLibTable (path |> DcePath.toName) diff --git a/analysis/reanalyze/src/FileAnnotations.ml b/analysis/reanalyze/src/FileAnnotations.ml new file mode 100644 index 0000000000..c8344a201f --- /dev/null +++ b/analysis/reanalyze/src/FileAnnotations.ml @@ -0,0 +1,47 @@ +(** Source annotations (@dead, @live, @genType). + + Two types are provided: + - [builder] - mutable, for AST processing and merging + - [t] - immutable, for solver (read-only access) *) + +type annotated_as = GenType | Dead | Live + +(* Both types have the same representation, but different semantics *) +type t = annotated_as PosHash.t +type builder = annotated_as PosHash.t + +(* ===== Builder API ===== *) + +let create_builder () : builder = PosHash.create 1 + +let annotate_gentype (state : builder) (pos : Lexing.position) = + PosHash.replace state pos GenType + +let annotate_dead (state : builder) (pos : Lexing.position) = + PosHash.replace state pos Dead + +let annotate_live (state : builder) (pos : Lexing.position) = + PosHash.replace state pos Live + +let merge_all (builders : builder list) : t = + let result = PosHash.create 1 in + builders + |> List.iter (fun builder -> + PosHash.iter + (fun pos value -> PosHash.replace result pos value) + builder); + result + +(* ===== Read-only API ===== *) + +let is_annotated_dead (state : t) pos = PosHash.find_opt state pos = Some Dead + +let is_annotated_gentype_or_live (state : t) pos = + match PosHash.find_opt state pos with + | Some (Live | GenType) -> true + | Some Dead | None -> false + +let is_annotated_gentype_or_dead (state : t) pos = + match PosHash.find_opt state pos with + | Some (Dead | GenType) -> true + | Some Live | None -> false diff --git a/analysis/reanalyze/src/FileAnnotations.mli b/analysis/reanalyze/src/FileAnnotations.mli new file mode 100644 index 0000000000..dd3df7d861 --- /dev/null +++ b/analysis/reanalyze/src/FileAnnotations.mli @@ -0,0 +1,32 @@ +(** Source annotations (@dead, @live, @genType). + + Two types are provided: + - [builder] - mutable, for AST processing and merging + - [t] - immutable, for solver (read-only access) + + Only DceFileProcessing should use [builder]. + The solver uses [t] which is frozen/immutable. *) + +(** {2 Types} *) + +type t +(** Immutable annotations - for solver (read-only) *) + +type builder +(** Mutable builder - for AST processing and merging *) + +(** {2 Builder API - for DceFileProcessing only} *) + +val create_builder : unit -> builder +val annotate_gentype : builder -> Lexing.position -> unit +val annotate_dead : builder -> Lexing.position -> unit +val annotate_live : builder -> Lexing.position -> unit + +val merge_all : builder list -> t +(** Merge all builders into one immutable result. Order doesn't matter. *) + +(** {2 Read-only API for t - for solver} *) + +val is_annotated_dead : t -> Lexing.position -> bool +val is_annotated_gentype_or_live : t -> Lexing.position -> bool +val is_annotated_gentype_or_dead : t -> Lexing.position -> bool diff --git a/analysis/reanalyze/src/FileDeps.ml b/analysis/reanalyze/src/FileDeps.ml new file mode 100644 index 0000000000..ed34e7c4c6 --- /dev/null +++ b/analysis/reanalyze/src/FileDeps.ml @@ -0,0 +1,138 @@ +(** File dependencies collected during AST processing. + + Tracks which files reference which other files. *) + +(* File-keyed hashtable *) +module FileHash = Hashtbl.Make (struct + type t = string + + let hash (x : t) = Hashtbl.hash x + let equal (x : t) y = x = y +end) + +(** {2 Types} *) + +type t = { + files: FileSet.t; + deps: FileSet.t FileHash.t; (* from_file -> set of to_files *) +} + +type builder = {mutable files: FileSet.t; deps: FileSet.t FileHash.t} + +(** {2 Builder API} *) + +let create_builder () : builder = + {files = FileSet.empty; deps = FileHash.create 256} + +let add_file (b : builder) file = + b.files <- FileSet.add file b.files; + (* Ensure file has an entry even if no deps *) + if not (FileHash.mem b.deps file) then + FileHash.replace b.deps file FileSet.empty + +let add_dep (b : builder) ~from_file ~to_file = + let set = + match FileHash.find_opt b.deps from_file with + | Some s -> s + | None -> FileSet.empty + in + FileHash.replace b.deps from_file (FileSet.add to_file set) + +(** {2 Merge API} *) + +let merge_into_builder ~(from : builder) ~(into : builder) = + into.files <- FileSet.union into.files from.files; + FileHash.iter + (fun from_file to_files -> + let existing = + match FileHash.find_opt into.deps from_file with + | Some s -> s + | None -> FileSet.empty + in + FileHash.replace into.deps from_file (FileSet.union existing to_files)) + from.deps + +let freeze_builder (b : builder) : t = + (* This is a zero-copy operation, so it's "unsafe" if the builder is + subsequently mutated. However, the calling discipline is that the + builder is no longer used after freezing. *) + {files = b.files; deps = b.deps} + +let merge_all (builders : builder list) : t = + let merged_builder = create_builder () in + builders + |> List.iter (fun b -> merge_into_builder ~from:b ~into:merged_builder); + freeze_builder merged_builder + +(** {2 Read-only API} *) + +let get_files (t : t) = t.files + +let get_deps (t : t) file = + match FileHash.find_opt t.deps file with + | Some s -> s + | None -> FileSet.empty + +let iter_deps (t : t) f = FileHash.iter f t.deps + +let file_exists (t : t) file = FileHash.mem t.deps file + +(** {2 Topological ordering} *) + +let iter_files_from_roots_to_leaves (t : t) iterFun = + (* For each file, the number of incoming references *) + let inverseReferences = (Hashtbl.create 256 : (string, int) Hashtbl.t) in + (* For each number of incoming references, the files *) + let referencesByNumber = (Hashtbl.create 256 : (int, FileSet.t) Hashtbl.t) in + let getNum fileName = + try Hashtbl.find inverseReferences fileName with Not_found -> 0 + in + let getSet num = + try Hashtbl.find referencesByNumber num with Not_found -> FileSet.empty + in + let addIncomingEdge fileName = + let oldNum = getNum fileName in + let newNum = oldNum + 1 in + let oldSetAtNum = getSet oldNum in + let newSetAtNum = FileSet.remove fileName oldSetAtNum in + let oldSetAtNewNum = getSet newNum in + let newSetAtNewNum = FileSet.add fileName oldSetAtNewNum in + Hashtbl.replace inverseReferences fileName newNum; + Hashtbl.replace referencesByNumber oldNum newSetAtNum; + Hashtbl.replace referencesByNumber newNum newSetAtNewNum + in + let removeIncomingEdge fileName = + let oldNum = getNum fileName in + let newNum = oldNum - 1 in + let oldSetAtNum = getSet oldNum in + let newSetAtNum = FileSet.remove fileName oldSetAtNum in + let oldSetAtNewNum = getSet newNum in + let newSetAtNewNum = FileSet.add fileName oldSetAtNewNum in + Hashtbl.replace inverseReferences fileName newNum; + Hashtbl.replace referencesByNumber oldNum newSetAtNum; + Hashtbl.replace referencesByNumber newNum newSetAtNewNum + in + let addEdge fromFile toFile = + if file_exists t fromFile then addIncomingEdge toFile + in + let removeEdge fromFile toFile = + if file_exists t fromFile then removeIncomingEdge toFile + in + iter_deps t (fun fromFile set -> + if getNum fromFile = 0 then + Hashtbl.replace referencesByNumber 0 (FileSet.add fromFile (getSet 0)); + set |> FileSet.iter (fun toFile -> addEdge fromFile toFile)); + while getSet 0 <> FileSet.empty do + let filesWithNoIncomingReferences = getSet 0 in + Hashtbl.remove referencesByNumber 0; + filesWithNoIncomingReferences + |> FileSet.iter (fun fileName -> + iterFun fileName; + let references = get_deps t fileName in + references |> FileSet.iter (fun toFile -> removeEdge fileName toFile)) + done; + (* Process any remaining items in case of circular references *) + referencesByNumber + |> Hashtbl.iter (fun _num set -> + if FileSet.is_empty set then () + else set |> FileSet.iter (fun fileName -> iterFun fileName)) diff --git a/analysis/reanalyze/src/FileDeps.mli b/analysis/reanalyze/src/FileDeps.mli new file mode 100644 index 0000000000..2975e5ceca --- /dev/null +++ b/analysis/reanalyze/src/FileDeps.mli @@ -0,0 +1,56 @@ +(** File dependencies collected during AST processing. + + Tracks which files reference which other files. + Two types are provided: + - [builder] - mutable, for AST processing + - [t] - immutable, for analysis *) + +(** {2 Types} *) + +type t +(** Immutable file dependencies - for analysis *) + +type builder +(** Mutable builder - for AST processing *) + +(** {2 Builder API - for AST processing} *) + +val create_builder : unit -> builder + +val add_file : builder -> string -> unit +(** Register a file as existing (even if it has no outgoing refs). *) + +val add_dep : builder -> from_file:string -> to_file:string -> unit +(** Add a dependency from one file to another. *) + +(** {2 Merge API} *) + +val merge_into_builder : from:builder -> into:builder -> unit +(** Merge one builder into another. *) + +val freeze_builder : builder -> t +(** Freeze a builder into an immutable result. + Note: Zero-copy - caller must not mutate builder after freezing. *) + +val merge_all : builder list -> t +(** Merge all builders into one immutable result. Order doesn't matter. *) + +(** {2 Read-only API for t - for analysis} *) + +val get_files : t -> FileSet.t +(** Get all files. *) + +val get_deps : t -> string -> FileSet.t +(** Get files that a given file depends on. *) + +val iter_deps : t -> (string -> FileSet.t -> unit) -> unit +(** Iterate over all file dependencies. *) + +val file_exists : t -> string -> bool +(** Check if a file exists in the graph. *) + +(** {2 Topological ordering} *) + +val iter_files_from_roots_to_leaves : t -> (string -> unit) -> unit +(** Iterate over files in topological order (roots first, leaves last). + Files with no incoming references are processed first. *) diff --git a/analysis/reanalyze/src/FileHash.ml b/analysis/reanalyze/src/FileHash.ml new file mode 100644 index 0000000000..433c7ee8a0 --- /dev/null +++ b/analysis/reanalyze/src/FileHash.ml @@ -0,0 +1,8 @@ +(** File name hashtable. *) + +include Hashtbl.Make (struct + type t = string + + let hash (x : t) = Hashtbl.hash x + let equal (x : t) y = x = y +end) diff --git a/analysis/reanalyze/src/FileSet.ml b/analysis/reanalyze/src/FileSet.ml new file mode 100644 index 0000000000..8caf46fe2d --- /dev/null +++ b/analysis/reanalyze/src/FileSet.ml @@ -0,0 +1,3 @@ +(** File name set. *) + +include Set.Make (String) diff --git a/analysis/reanalyze/src/FindSourceFile.ml b/analysis/reanalyze/src/FindSourceFile.ml index 3c92f8120c..a61dfcdd07 100644 --- a/analysis/reanalyze/src/FindSourceFile.ml +++ b/analysis/reanalyze/src/FindSourceFile.ml @@ -17,11 +17,11 @@ let rec implementation items = let cmt cmt_annots = match cmt_annots with | Cmt_format.Interface signature -> - if !Common.Cli.debug && signature.sig_items = [] then + if !Cli.debug && signature.sig_items = [] then Log_.item "Interface %d@." (signature.sig_items |> List.length); interface signature.sig_items | Implementation structure -> - if !Common.Cli.debug && structure.str_items = [] then + if !Cli.debug && structure.str_items = [] then Log_.item "Implementation %d@." (structure.str_items |> List.length); implementation structure.str_items | _ -> None diff --git a/analysis/reanalyze/src/Issue.ml b/analysis/reanalyze/src/Issue.ml new file mode 100644 index 0000000000..ed9ab87b22 --- /dev/null +++ b/analysis/reanalyze/src/Issue.ml @@ -0,0 +1,45 @@ +(** Issue types for dead code analysis. + + These types represent the various issues that can be reported. *) + +module ExnSet = Set.Make (Exn) + +type missingThrowInfo = { + exnName: string; + exnTable: (Exn.t, LocSet.t) Hashtbl.t; + locFull: Location.t; + missingAnnotations: ExnSet.t; + throwSet: ExnSet.t; +} + +type severity = Warning | Error +type deadOptional = WarningUnusedArgument | WarningRedundantOptionalArgument + +type termination = + | ErrorHygiene + | ErrorNotImplemented + | ErrorTermination + | TerminationAnalysisInternal + +type deadWarning = + | WarningDeadException + | WarningDeadType + | WarningDeadValue + | WarningDeadValueWithSideEffects + | IncorrectDeadAnnotation + +type description = + | Circular of {message: string} + | ExceptionAnalysis of {message: string} + | ExceptionAnalysisMissing of missingThrowInfo + | DeadModule of {message: string} + | DeadOptional of {deadOptional: deadOptional; message: string} + | DeadWarning of {deadWarning: deadWarning; path: string; message: string} + | Termination of {termination: termination; message: string} + +type t = { + name: string; + severity: severity; + loc: Location.t; + description: description; +} diff --git a/analysis/reanalyze/src/LocSet.ml b/analysis/reanalyze/src/LocSet.ml new file mode 100644 index 0000000000..9823d6eb1d --- /dev/null +++ b/analysis/reanalyze/src/LocSet.ml @@ -0,0 +1,5 @@ +include Set.Make (struct + include Location + + let compare = compare +end) diff --git a/analysis/reanalyze/src/Log_.ml b/analysis/reanalyze/src/Log_.ml index ca333e1544..a50a73cd68 100644 --- a/analysis/reanalyze/src/Log_.ml +++ b/analysis/reanalyze/src/Log_.ml @@ -1,5 +1,3 @@ -open Common - module Color = struct let color_enabled = lazy (Unix.isatty Unix.stdout) let forceColor = ref false @@ -97,7 +95,7 @@ let item x = Format.fprintf Format.std_formatter " "; Format.fprintf Format.std_formatter x -let missingRaiseInfoToText {missingAnnotations; locFull} = +let missingRaiseInfoToText {Issue.missingAnnotations; locFull} = let missingTxt = Format.asprintf "%a" (Exceptions.pp ~exnTable:None) missingAnnotations in @@ -107,18 +105,14 @@ let missingRaiseInfoToText {missingAnnotations; locFull} = ~text:(Format.asprintf "@throws(%s)\\n" missingTxt) else "" -let logAdditionalInfo ~(description : description) = +let logAdditionalInfo ~(description : Issue.description) = match description with - | DeadWarning {lineAnnotation; shouldWriteLineAnnotation} -> - if shouldWriteLineAnnotation then - WriteDeadAnnotations.lineAnnotationToString lineAnnotation - else "" | ExceptionAnalysisMissing missingRaiseInfo -> missingRaiseInfoToText missingRaiseInfo | _ -> "" -let missingThrowInfoToMessage {exnTable; exnName; missingAnnotations; throwSet} - = +let missingThrowInfoToMessage + {Issue.exnTable; exnName; missingAnnotations; throwSet} = let throwsTxt = Format.asprintf "%a" (Exceptions.pp ~exnTable:(Some exnTable)) throwSet in @@ -129,7 +123,7 @@ let missingThrowInfoToMessage {exnTable; exnName; missingAnnotations; throwSet} "@{%s@} might throw %s and is not annotated with @throws(%s)" exnName throwsTxt missingTxt -let descriptionToMessage (description : description) = +let descriptionToMessage (description : Issue.description) = match description with | Circular {message} -> message | DeadModule {message} -> message @@ -141,7 +135,7 @@ let descriptionToMessage (description : description) = missingThrowInfoToMessage missingRaiseInfo | Termination {message} -> message -let descriptionToName (description : description) = +let descriptionToName (description : Issue.description) = match description with | Circular _ -> Issues.warningDeadAnalysisCycle | DeadModule _ -> Issues.warningDeadModule @@ -166,10 +160,10 @@ let descriptionToName (description : description) = | Termination {termination = TerminationAnalysisInternal} -> Issues.terminationAnalysisInternal -let logIssue ~(issue : issue) = +let logIssue ~config ~(issue : Issue.t) = 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 @@ -188,7 +182,7 @@ let logIssue ~(issue : issue) = ~message) () (logAdditionalInfo ~description:issue.description) - (if !Cli.json then EmitJson.emitClose () else "") + (if config.DceConfig.cli.json then EmitJson.emitClose () else "") else let color = match issue.severity with @@ -201,13 +195,13 @@ let logIssue ~(issue : issue) = module Stats = struct let issues = ref [] - let addIssue (issue : issue) = issues := issue :: !issues + let addIssue (issue : Issue.t) = issues := issue :: !issues let clear () = issues := [] let getSortedIssues () = let counters2 = Hashtbl.create 1 in !issues - |> List.iter (fun (issue : issue) -> + |> List.iter (fun (issue : Issue.t) -> let counter = match Hashtbl.find_opt counters2 issue.name with | Some counter -> counter @@ -225,11 +219,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 diff --git a/analysis/reanalyze/src/ModulePath.ml b/analysis/reanalyze/src/ModulePath.ml index 1955da1810..3d9e6b9aad 100644 --- a/analysis/reanalyze/src/ModulePath.ml +++ b/analysis/reanalyze/src/ModulePath.ml @@ -1,8 +1,7 @@ -open Common module NameMap = Map.Make (Name) (* Keep track of the module path while traversing with Tast_mapper *) -type t = {aliases: Path.t NameMap.t; loc: Location.t; path: Path.t} +type t = {aliases: DcePath.t NameMap.t; loc: Location.t; path: DcePath.t} let initial = ({aliases = NameMap.empty; loc = Location.none; path = []} : t) let current = (ref initial : t ref) @@ -15,19 +14,18 @@ let normalizePath ~aliases path = | None -> path | Some path1 -> let newPath = List.rev (path1 @ restRev) in - if !Common.Cli.debug then - Log_.item "Resolve Alias: %s to %s@." - (path |> Common.Path.toString) - (newPath |> Common.Path.toString); + if !Cli.debug then + Log_.item "Resolve Alias: %s to %s@." (path |> DcePath.toString) + (newPath |> DcePath.toString); newPath) | _ -> path let addAlias ~name ~path = let aliases = !current.aliases in let pathNormalized = path |> normalizePath ~aliases in - if !Common.Cli.debug then + if !Cli.debug then Log_.item "Module Alias: %s = %s@." (name |> Name.toString) - (Path.toString pathNormalized); + (DcePath.toString pathNormalized); current := {!current with aliases = NameMap.add name pathNormalized aliases} let resolveAlias path = path |> normalizePath ~aliases:!current.aliases diff --git a/analysis/reanalyze/src/OptionalArgs.ml b/analysis/reanalyze/src/OptionalArgs.ml new file mode 100644 index 0000000000..1010075979 --- /dev/null +++ b/analysis/reanalyze/src/OptionalArgs.ml @@ -0,0 +1,45 @@ +(** Immutable record tracking optional argument usage. + - unused: args that have never been passed + - alwaysUsed: args that are always passed (when count > 0) + - count: number of calls observed *) + +module StringSet = Set.Make (String) + +type t = {count: int; unused: StringSet.t; alwaysUsed: StringSet.t} + +let empty = {unused = StringSet.empty; alwaysUsed = StringSet.empty; count = 0} + +let fromList l = + {unused = StringSet.of_list l; alwaysUsed = StringSet.empty; count = 0} + +let isEmpty x = StringSet.is_empty x.unused + +(** Apply a call to the optional args state. Returns new state. *) +let apply_call ~argNames ~argNamesMaybe x = + let nameSet = argNames |> StringSet.of_list in + let nameSetMaybe = argNamesMaybe |> StringSet.of_list in + let nameSetAlways = StringSet.diff nameSet nameSetMaybe in + let alwaysUsed = + if x.count = 0 then nameSetAlways + else StringSet.inter nameSetAlways x.alwaysUsed + in + let unused = + argNames + |> List.fold_left (fun acc name -> StringSet.remove name acc) x.unused + in + {count = x.count + 1; unused; alwaysUsed} + +(** Combine two optional args states (for function references). + Returns a pair of updated states with intersected unused/alwaysUsed. *) +let combine_pair x y = + let unused = StringSet.inter x.unused y.unused in + let alwaysUsed = StringSet.inter x.alwaysUsed y.alwaysUsed in + ({x with unused; alwaysUsed}, {y with unused; alwaysUsed}) + +let iterUnused f x = StringSet.iter f x.unused +let iterAlwaysUsed f x = StringSet.iter (fun s -> f s x.count) x.alwaysUsed + +let foldUnused f x init = StringSet.fold f x.unused init + +let foldAlwaysUsed f x init = + StringSet.fold (fun s acc -> f s x.count acc) x.alwaysUsed init diff --git a/analysis/reanalyze/src/OptionalArgsState.ml b/analysis/reanalyze/src/OptionalArgsState.ml new file mode 100644 index 0000000000..66a0d0cee6 --- /dev/null +++ b/analysis/reanalyze/src/OptionalArgsState.ml @@ -0,0 +1,10 @@ +(** State map for computed OptionalArgs. + Maps declaration position to final state after all calls/combines. *) + +type t = OptionalArgs.t PosHash.t + +let create () : t = PosHash.create 256 + +let find_opt (state : t) pos = PosHash.find_opt state pos + +let set (state : t) pos value = PosHash.replace state pos value diff --git a/analysis/reanalyze/src/Paths.ml b/analysis/reanalyze/src/Paths.ml index a3471e31c4..70b399932a 100644 --- a/analysis/reanalyze/src/Paths.ml +++ b/analysis/reanalyze/src/Paths.ml @@ -1,4 +1,3 @@ -open Common module StringMap = Map_string let bsconfig = "bsconfig.json" @@ -25,6 +24,8 @@ let rec findProjectRoot ~dir = assert false) else findProjectRoot ~dir:parent +let runConfig = RunConfig.runConfig + let setReScriptProjectRoot = lazy (runConfig.projectRoot <- findProjectRoot ~dir:(Sys.getcwd ()); diff --git a/analysis/reanalyze/src/Pos.ml b/analysis/reanalyze/src/Pos.ml new file mode 100644 index 0000000000..07b053bb4c --- /dev/null +++ b/analysis/reanalyze/src/Pos.ml @@ -0,0 +1,9 @@ +(** Position utilities. *) + +(** Format a position as "filename:line:col" *) +let toString (pos : Lexing.position) = + let file = pos.Lexing.pos_fname in + let line = pos.Lexing.pos_lnum in + let col = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in + (file |> Filename.basename) + ^ ":" ^ string_of_int line ^ ":" ^ string_of_int col diff --git a/analysis/reanalyze/src/PosHash.ml b/analysis/reanalyze/src/PosHash.ml new file mode 100644 index 0000000000..35e49a1422 --- /dev/null +++ b/analysis/reanalyze/src/PosHash.ml @@ -0,0 +1,12 @@ +(** Position-keyed hashtable. + Used throughout dead code analysis for mapping source positions to data. *) + +include Hashtbl.Make (struct + type t = Lexing.position + + let hash x = + let s = Filename.basename x.Lexing.pos_fname in + Hashtbl.hash (x.Lexing.pos_cnum, s) + + let equal (x : t) y = x = y +end) diff --git a/analysis/reanalyze/src/PosSet.ml b/analysis/reanalyze/src/PosSet.ml new file mode 100644 index 0000000000..28ef935428 --- /dev/null +++ b/analysis/reanalyze/src/PosSet.ml @@ -0,0 +1,8 @@ +(** Position set. + Used for tracking sets of source positions in dead code analysis. *) + +include Set.Make (struct + type t = Lexing.position + + let compare = compare +end) diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml index 7378264908..4b8619e751 100644 --- a/analysis/reanalyze/src/Reanalyze.ml +++ b/analysis/reanalyze/src/Reanalyze.ml @@ -1,9 +1,11 @@ -open Common +let runConfig = RunConfig.runConfig -let loadCmtFile cmtFilePath = +(** Process a cmt file and return its file_data (if DCE enabled). + Conceptually: map over files, then merge results. *) +let loadCmtFile ~config cmtFilePath : DceFileProcessing.file_data option = 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,28 +19,57 @@ let loadCmtFile cmtFilePath = in match cmt_infos.cmt_annots |> FindSourceFile.cmt with | Some sourceFile when not (excludePath sourceFile) -> - if !Cli.debug then + let is_interface = + match cmt_infos.cmt_annots with + | Interface _ -> true + | _ -> Filename.check_suffix sourceFile "i" + in + let module_name = sourceFile |> Paths.getModuleName in + (* File context for DceFileProcessing (breaks cycle with DeadCommon) *) + let dce_file_context : DceFileProcessing.file_context = + {source_path = sourceFile; module_name; is_interface} + in + (* File context for Exception/Arnold (uses DeadCommon.FileContext) *) + 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 !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; - currentSrc := sourceFile; - currentModule := Paths.getModuleName sourceFile; - currentModuleName := - !currentModule - |> Name.create ~isInterface:(Filename.check_suffix !currentSrc "i"); - if runConfig.dce then cmt_infos |> DeadCode.processCmt ~cmtFilePath; - if runConfig.exception_ then cmt_infos |> Exception.processCmt; - if runConfig.termination then cmt_infos |> Arnold.processCmt - | _ -> () + (* Process file for DCE - return file_data *) + let file_data_opt = + if config.DceConfig.run.dce then + Some + (cmt_infos + |> DceFileProcessing.process_cmt_file ~config ~file:dce_file_context + ~cmtFilePath) + else None + in + if config.DceConfig.run.exception_ then + cmt_infos |> Exception.processCmt ~file:file_context; + if config.DceConfig.run.termination then + cmt_infos |> Arnold.processCmt ~config ~file:file_context; + file_data_opt + | _ -> None -let processCmtFiles ~cmtRoot = +(** Process all cmt files and return list of file_data. + Conceptually: map process_cmt_file over all files. *) +let processCmtFiles ~config ~cmtRoot : DceFileProcessing.file_data list = let ( +++ ) = Filename.concat in - match cmtRoot with + (* Local mutable state for collecting results - does not escape this function *) + let file_data_list = ref [] in + let processFile cmtFilePath = + match loadCmtFile ~config cmtFilePath with + | Some file_data -> file_data_list := file_data :: !file_data_list + | None -> () + in + (match cmtRoot with | Some root -> Cli.cmtCommand := true; let rec walkSubDirs dir = @@ -57,7 +88,7 @@ let processCmtFiles ~cmtRoot = else if Filename.check_suffix absDir ".cmt" || Filename.check_suffix absDir ".cmti" - then absDir |> loadCmtFile + then processFile absDir in walkSubDirs "" | None -> @@ -83,25 +114,90 @@ let processCmtFiles ~cmtRoot = cmtFiles |> List.sort String.compare |> List.iter (fun cmtFile -> let cmtFilePath = Filename.concat libBsSourceDir cmtFile in - cmtFilePath |> loadCmtFile)) + processFile cmtFilePath))); + !file_data_list -let runAnalysis ~cmtRoot = - processCmtFiles ~cmtRoot; - if runConfig.dce then ( - DeadException.forceDelayedItems (); - DeadOptionalArgs.forceDelayedItems (); - DeadCommon.reportDead ~checkOptionalArg:DeadOptionalArgs.check; - WriteDeadAnnotations.write ()); - if runConfig.exception_ then Exception.Checks.doChecks (); - if runConfig.termination && !Common.Cli.debug then Arnold.reportStats () +(* Shuffle a list using Fisher-Yates algorithm *) +let shuffle_list lst = + let arr = Array.of_list lst in + let n = Array.length arr in + for i = n - 1 downto 1 do + let j = Random.int (i + 1) in + let tmp = arr.(i) in + arr.(i) <- arr.(j); + arr.(j) <- tmp + done; + Array.to_list arr + +let runAnalysis ~dce_config ~cmtRoot = + (* Map: process each file -> list of file_data *) + let file_data_list = processCmtFiles ~config:dce_config ~cmtRoot in + (* Optionally shuffle for order-independence testing *) + let file_data_list = + if !Cli.testShuffle then ( + Random.self_init (); + if dce_config.DceConfig.cli.debug then + Log_.item "Shuffling file order for order-independence test@."; + shuffle_list file_data_list) + else file_data_list + in + if dce_config.DceConfig.run.dce then ( + (* Merge: combine all builders -> immutable data *) + let annotations = + FileAnnotations.merge_all + (file_data_list |> List.map (fun fd -> fd.DceFileProcessing.annotations)) + in + let decls = + Declarations.merge_all + (file_data_list |> List.map (fun fd -> fd.DceFileProcessing.decls)) + in + let cross_file = + CrossFileItems.merge_all + (file_data_list |> List.map (fun fd -> fd.DceFileProcessing.cross_file)) + in + (* Merge refs and file_deps into builders for cross-file items processing *) + let refs_builder = References.create_builder () in + let file_deps_builder = FileDeps.create_builder () in + file_data_list + |> List.iter (fun fd -> + References.merge_into_builder ~from:fd.DceFileProcessing.refs + ~into:refs_builder; + FileDeps.merge_into_builder ~from:fd.DceFileProcessing.file_deps + ~into:file_deps_builder); + (* Process cross-file exception refs - they write to refs_builder and file_deps_builder *) + CrossFileItems.process_exception_refs cross_file ~refs:refs_builder + ~file_deps:file_deps_builder ~find_exception:DeadException.find_exception + ~config:dce_config; + (* Compute optional args state (pure - no mutation) *) + let optional_args_state = + CrossFileItems.compute_optional_args_state cross_file ~decls + in + (* Now freeze refs and file_deps for solver *) + let refs = References.freeze_builder refs_builder in + let file_deps = FileDeps.freeze_builder file_deps_builder in + (* Run the solver - returns immutable AnalysisResult.t *) + let analysis_result = + DeadCommon.solveDead ~annotations ~decls ~refs ~file_deps + ~optional_args_state ~config:dce_config + ~checkOptionalArg:DeadOptionalArgs.check + in + (* Report all issues *) + AnalysisResult.get_issues analysis_result + |> List.iter (fun (issue : Issue.t) -> + Log_.warning ~loc:issue.loc issue.description)); + 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 (); - if !Common.Cli.json then EmitJson.start (); - runAnalysis ~cmtRoot; - Log_.Stats.report (); + if !Cli.json then EmitJson.start (); + 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 () + if !Cli.json then EmitJson.finish () let cli () = let analysisKindSet = ref false in @@ -157,28 +253,28 @@ let cli () = String (fun s -> let paths = s |> String.split_on_char ',' in - Common.Cli.excludePaths := paths @ Common.Cli.excludePaths.contents), + Cli.excludePaths := paths @ Cli.excludePaths.contents), "comma-separated-path-prefixes Exclude from analysis files whose path \ has a prefix in the list" ); ( "-experimental", - Set Common.Cli.experimental, + Set Cli.experimental, "Turn on experimental analyses (this option is currently unused)" ); ( "-externals", Set DeadCommon.Config.analyzeExternals, "Report on externals in dead code analysis" ); - ("-json", Set Common.Cli.json, "Print reports in json format"); + ("-json", Set Cli.json, "Print reports in json format"); ( "-live-names", String (fun s -> let names = s |> String.split_on_char ',' in - Common.Cli.liveNames := names @ Common.Cli.liveNames.contents), + Cli.liveNames := names @ Cli.liveNames.contents), "comma-separated-names Consider all values with the given names as live" ); ( "-live-paths", String (fun s -> let paths = s |> String.split_on_char ',' in - Common.Cli.livePaths := paths @ Common.Cli.livePaths.contents), + Cli.livePaths := paths @ Cli.livePaths.contents), "comma-separated-path-prefixes Consider all values whose path has a \ prefix in the list as live" ); ( "-suppress", @@ -203,11 +299,12 @@ let cli () = "comma-separated-path-prefixes Report on files whose path has a prefix \ in the list, overriding -suppress (no-op if -suppress is not \ specified)" ); + ( "-test-shuffle", + Set Cli.testShuffle, + "Test flag: shuffle file processing order to verify order-independence" + ); ("-version", Unit versionAndExit, "Show version information and exit"); ("--version", Unit versionAndExit, "Show version information and exit"); - ( "-write", - Set Common.Cli.write, - "Write @dead annotations directly in the source files" ); ] in Arg.parse speclist print_endline usage; @@ -217,4 +314,5 @@ let cli () = [@@raises exit] module RunConfig = RunConfig +module DceConfig = DceConfig module Log_ = Log_ diff --git a/analysis/reanalyze/src/References.ml b/analysis/reanalyze/src/References.ml new file mode 100644 index 0000000000..632dbd7861 --- /dev/null +++ b/analysis/reanalyze/src/References.ml @@ -0,0 +1,57 @@ +(** References collected during dead code analysis. + + Two types are provided: + - [builder] - mutable, for AST processing + - [t] - immutable, for solver (read-only access) *) + +(* Helper to add to a set in a hashtable *) +let addSet h k v = + let set = try PosHash.find h k with Not_found -> PosSet.empty in + PosHash.replace h k (PosSet.add v set) + +(* Helper to find a set in a hashtable *) +let findSet h k = try PosHash.find h k with Not_found -> PosSet.empty + +(* Internal representation: two hashtables *) +type refs_table = PosSet.t PosHash.t + +type builder = {value_refs: refs_table; type_refs: refs_table} + +type t = {value_refs: refs_table; type_refs: refs_table} + +(* ===== Builder API ===== *) + +let create_builder () : builder = + {value_refs = PosHash.create 256; type_refs = PosHash.create 256} + +let add_value_ref (builder : builder) ~posTo ~posFrom = + addSet builder.value_refs posTo posFrom + +let add_type_ref (builder : builder) ~posTo ~posFrom = + addSet builder.type_refs posTo posFrom + +let merge_into_builder ~(from : builder) ~(into : builder) = + PosHash.iter + (fun pos refs -> + refs |> PosSet.iter (fun fromPos -> addSet into.value_refs pos fromPos)) + from.value_refs; + PosHash.iter + (fun pos refs -> + refs |> PosSet.iter (fun fromPos -> addSet into.type_refs pos fromPos)) + from.type_refs + +let merge_all (builders : builder list) : t = + let result = create_builder () in + builders + |> List.iter (fun builder -> merge_into_builder ~from:builder ~into:result); + {value_refs = result.value_refs; type_refs = result.type_refs} + +let freeze_builder (builder : builder) : t = + (* Zero-copy freeze - builder should not be used after this *) + {value_refs = builder.value_refs; type_refs = builder.type_refs} + +(* ===== Read-only API ===== *) + +let find_value_refs (t : t) pos = findSet t.value_refs pos + +let find_type_refs (t : t) pos = findSet t.type_refs pos diff --git a/analysis/reanalyze/src/References.mli b/analysis/reanalyze/src/References.mli new file mode 100644 index 0000000000..05228b7b8e --- /dev/null +++ b/analysis/reanalyze/src/References.mli @@ -0,0 +1,38 @@ +(** References collected during dead code analysis. + + Two types are provided: + - [builder] - mutable, for AST processing + - [t] - immutable, for solver (read-only access) + + References track which positions reference which declarations. + Both value references and type references are tracked. *) + +(** {2 Types} *) + +type t +(** Immutable references - for solver (read-only) *) + +type builder +(** Mutable builder - for AST processing *) + +(** {2 Builder API - for AST processing} *) + +val create_builder : unit -> builder +val add_value_ref : + builder -> posTo:Lexing.position -> posFrom:Lexing.position -> unit +val add_type_ref : + builder -> posTo:Lexing.position -> posFrom:Lexing.position -> unit + +val merge_into_builder : from:builder -> into:builder -> unit +(** Merge one builder into another. *) + +val merge_all : builder list -> t +(** Merge all builders into one immutable result. Order doesn't matter. *) + +val freeze_builder : builder -> t +(** Convert builder to immutable t. Builder should not be used after this. *) + +(** {2 Read-only API for t - for solver} *) + +val find_value_refs : t -> Lexing.position -> PosSet.t +val find_type_refs : t -> Lexing.position -> PosSet.t diff --git a/analysis/reanalyze/src/SideEffects.ml b/analysis/reanalyze/src/SideEffects.ml index 5aceaf124d..89d5756bf1 100644 --- a/analysis/reanalyze/src/SideEffects.ml +++ b/analysis/reanalyze/src/SideEffects.ml @@ -18,7 +18,7 @@ let whiteTableSideEffects = let pathIsWhitelistedForSideEffects path = path - |> Common.Path.onOkPath ~whenContainsApply:false ~f:(fun s -> + |> DcePath.onOkPath ~whenContainsApply:false ~f:(fun s -> Hashtbl.mem (Lazy.force whiteTableSideEffects) s) let rec exprNoSideEffects (expr : Typedtree.expression) = diff --git a/analysis/reanalyze/src/StringSet.ml b/analysis/reanalyze/src/StringSet.ml new file mode 100644 index 0000000000..cbd76247a9 --- /dev/null +++ b/analysis/reanalyze/src/StringSet.ml @@ -0,0 +1,3 @@ +(** String set. *) + +include Set.Make (String) diff --git a/analysis/reanalyze/src/Suppress.ml b/analysis/reanalyze/src/Suppress.ml index dc9c521a5d..0502ce9d3f 100644 --- a/analysis/reanalyze/src/Suppress.ml +++ b/analysis/reanalyze/src/Suppress.ml @@ -1,4 +1,4 @@ -open Common +let runConfig = RunConfig.runConfig let checkPrefix prefix_ = let prefix = diff --git a/analysis/reanalyze/src/WriteDeadAnnotations.ml b/analysis/reanalyze/src/WriteDeadAnnotations.ml deleted file mode 100644 index 642bb3d875..0000000000 --- a/analysis/reanalyze/src/WriteDeadAnnotations.ml +++ /dev/null @@ -1,154 +0,0 @@ -open Common - -type language = Ml | Res - -let posLanguage (pos : Lexing.position) = - if - Filename.check_suffix pos.pos_fname ".res" - || Filename.check_suffix pos.pos_fname ".resi" - then Res - else Ml - -let deadAnnotation = "dead" -let annotateAtEnd ~pos = - match posLanguage pos with - | Res -> false - | Ml -> true - -let getPosAnnotation decl = - match annotateAtEnd ~pos:decl.pos with - | true -> decl.posEnd - | false -> decl.posStart - -let rec lineToString_ {original; declarations} = - match declarations with - | [] -> original - | ({declKind; path; pos} as decl) :: nextDeclarations -> - let language = posLanguage pos in - let annotationStr = - match language with - | Res -> - "@" ^ deadAnnotation ^ "(\"" ^ (path |> Path.withoutHead) ^ "\") " - | Ml -> - " " ^ "[" - ^ (match declKind |> DeclKind.isType with - | true -> "@" - | false -> "@@") - ^ deadAnnotation ^ " \"" ^ (path |> Path.withoutHead) ^ "\"] " - in - let posAnnotation = decl |> getPosAnnotation in - let col = posAnnotation.pos_cnum - posAnnotation.pos_bol in - let originalLen = String.length original in - { - original = - (if String.length original >= col && col > 0 then - let original1, original2 = - try - ( String.sub original 0 col, - String.sub original col (originalLen - col) ) - with Invalid_argument _ -> (original, "") - in - if language = Res && declKind = VariantCase then - if - String.length original2 >= 2 - && (String.sub [@doesNotRaise]) original2 0 2 = "| " - then - original1 ^ "| " ^ annotationStr - ^ (String.sub [@doesNotRaise]) original2 2 - (String.length original2 - 2) - else if - String.length original2 >= 1 - && (String.sub [@doesNotRaise]) original2 0 1 = "|" - then - original1 ^ "|" ^ annotationStr - ^ (String.sub [@doesNotRaise]) original2 1 - (String.length original2 - 1) - else original1 ^ "| " ^ annotationStr ^ original2 - else original1 ^ annotationStr ^ original2 - else - match language = Ml with - | true -> original ^ annotationStr - | false -> annotationStr ^ original); - declarations = nextDeclarations; - } - |> lineToString_ - -let lineToString {original; declarations} = - let declarations = - declarations - |> List.sort (fun decl1 decl2 -> - (getPosAnnotation decl2).pos_cnum - (getPosAnnotation decl1).pos_cnum) - in - lineToString_ {original; declarations} - -let currentFile = ref "" -let currentFileLines = (ref [||] : line array ref) - -let readFile fileName = - let channel = open_in fileName in - let lines = ref [] in - let rec loop () = - let line = {original = input_line channel; declarations = []} in - lines := line :: !lines; - loop () - [@@raises End_of_file] - in - try loop () - with End_of_file -> - close_in_noerr channel; - !lines |> List.rev |> Array.of_list - -let writeFile fileName lines = - if fileName <> "" && !Cli.write then ( - let channel = open_out fileName in - let lastLine = Array.length lines in - lines - |> Array.iteri (fun n line -> - output_string channel (line |> lineToString); - if n < lastLine - 1 then output_char channel '\n'); - close_out_noerr channel) - -let offsetOfPosAdjustment = function - | FirstVariant | Nothing -> 0 - | OtherVariant -> 2 - -let getLineAnnotation ~decl ~line = - if !Cli.json then - let posAnnotation = decl |> getPosAnnotation in - let offset = decl.posAdjustment |> offsetOfPosAdjustment in - EmitJson.emitAnnotate - ~pos: - ( posAnnotation.pos_lnum - 1, - posAnnotation.pos_cnum - posAnnotation.pos_bol + offset ) - ~text: - (if decl.posAdjustment = FirstVariant then - (* avoid syntax error *) - "| @dead " - else "@dead ") - ~action:"Suppress dead code warning" - else - Format.asprintf "@. <-- line %d@. %s" decl.pos.pos_lnum - (line |> lineToString) - -let cantFindLine () = if !Cli.json then "" else "\n <-- Can't find line" - -let lineAnnotationToString = function - | None -> cantFindLine () - | Some (decl, line) -> getLineAnnotation ~decl ~line - -let addLineAnnotation ~decl : lineAnnotation = - let fileName = decl.pos.pos_fname in - if Sys.file_exists fileName then ( - if fileName <> !currentFile then ( - writeFile !currentFile !currentFileLines; - currentFile := fileName; - currentFileLines := readFile fileName); - let indexInLines = (decl |> getPosAnnotation).pos_lnum - 1 in - match !currentFileLines.(indexInLines) with - | line -> - line.declarations <- decl :: line.declarations; - Some (decl, line) - | exception Invalid_argument _ -> None) - else None - -let write () = writeFile !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) diff --git a/tests/analysis_tests/tests-reanalyze/Makefile b/tests/analysis_tests/tests-reanalyze/Makefile index cfb84e2bd6..a199668e64 100644 --- a/tests/analysis_tests/tests-reanalyze/Makefile +++ b/tests/analysis_tests/tests-reanalyze/Makefile @@ -8,10 +8,15 @@ test: make -C deadcode test make -C termination test +# Order-independence test for reanalyze - not run by default (takes longer) +# Verifies that processing files in different orders produces identical results +test-reanalyze-order-independence: + make -C deadcode test-reanalyze-order-independence + clean: make -C deadcode clean make -C termination clean .DEFAULT_GOAL := build -.PHONY: build clean clean test +.PHONY: build clean test test-reanalyze-order-independence diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/Makefile b/tests/analysis_tests/tests-reanalyze/deadcode/Makefile index a7018a9b65..3257028f91 100644 --- a/tests/analysis_tests/tests-reanalyze/deadcode/Makefile +++ b/tests/analysis_tests/tests-reanalyze/deadcode/Makefile @@ -6,9 +6,14 @@ build: test: build node_modules/.bin/rescript ./test.sh +# Order-independence test for reanalyze - not run by default (takes longer) +# Verifies that processing files in different orders produces identical results +test-reanalyze-order-independence: build node_modules/.bin/rescript + ./test-order-independence.sh + clean: yarn clean .DEFAULT_GOAL := build -.PHONY: build clean test +.PHONY: build clean test test-reanalyze-order-independence diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt index 14c6a37e2c..51493cee84 100644 --- a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt +++ b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt @@ -2550,44 +2550,30 @@ File References Warning Dead Type AutoAnnotate.res:1:16-21 variant.R is a variant case which is never constructed - <-- line 1 - type variant = | @dead("variant.R") R(int) Warning Dead Type AutoAnnotate.res:4:16-31 record.variant is a record label never used to read a value - <-- line 4 - type record = {@dead("record.variant") variant: variant} Warning Dead Type AutoAnnotate.res:6:12-18 r2.r2 is a record label never used to read a value - <-- line 6 - type r2 = {@dead("r2.r2") r2: int} Warning Dead Type AutoAnnotate.res:8:12-18 r3.r3 is a record label never used to read a value - <-- line 8 - type r3 = {@dead("r3.r3") r3: int} Warning Dead Type AutoAnnotate.res:10:12-18 r4.r4 is a record label never used to read a value - <-- line 10 - type r4 = {@dead("r4.r4") r4: int} Warning Dead Type AutoAnnotate.res:14:3-14 annotatedVariant.R2 is a variant case which is never constructed - <-- line 14 - | @dead("annotatedVariant.R2") R2(r2, r3) Warning Dead Type AutoAnnotate.res:15:5-10 annotatedVariant.R4 is a variant case which is never constructed - <-- line 15 - | @dead("annotatedVariant.R4") R4(r4) Warning Dead Module BucklescriptAnnotations.res:0:1 @@ -2596,32 +2582,22 @@ File References Warning Dead Value BucklescriptAnnotations.res:22:1-70 bar is never used - <-- line 22 - @dead("bar") let bar = (x: someMethods) => { Warning Dead Exception DeadExn.res:7:1-15 DeadE is never raised or passed as value - <-- line 7 - @dead("DeadE") exception DeadE Warning Dead Value DeadExn.res:8:1-25 eToplevel is never used - <-- line 8 - @dead("eToplevel") let eToplevel = Etoplevel Warning Dead Value DeadRT.res:5:1-116 emitModuleAccessPath is never used - <-- line 5 - @dead("emitModuleAccessPath") let rec emitModuleAccessPath = moduleAccessPath => Warning Dead Value DeadTest.res:2:1-17 fortytwo is never used - <-- line 2 - @dead("fortytwo") let fortytwo = 42 Warning Dead Module DeadTest.res:27:8-97 @@ -2630,86 +2606,58 @@ File References Warning Dead Value DeadTest.res:31:3-34 M.thisSignatureItemIsDead is never used - <-- line 31 - @dead("M.thisSignatureItemIsDead") let thisSignatureItemIsDead = 34 Warning Dead Value DeadTest.res:61:3-12 MM.y is never used - <-- line 61 - @dead("MM.y") let y: int Warning Dead Value DeadTest.res:65:3-35 MM.valueOnlyInImplementation is never used - <-- line 65 - @dead("MM.valueOnlyInImplementation") let valueOnlyInImplementation = 7 Warning Dead Value DeadTest.res:75:1-37 unusedRec is never used - <-- line 75 - @dead("unusedRec") let rec unusedRec = () => unusedRec() Warning Dead Value DeadTest.res:77:1-60 split_map is never used - <-- line 77 - @dead("split_map") let rec split_map = l => { Warning Dead Value DeadTest.res:82:1-27 rec1 is never used - <-- line 82 - @dead("rec1") let rec rec1 = () => rec2() Warning Dead Value DeadTest.res:83:1-23 rec2 is never used - <-- line 83 - @dead("rec2") and rec2 = () => rec1() Warning Dead Value DeadTest.res:85:1-77 recWithCallback is never used - <-- line 85 - @dead("recWithCallback") let rec recWithCallback = () => { Warning Dead Value DeadTest.res:90:1-53 foo is never used - <-- line 90 - @dead("foo") let rec foo = () => { Warning Dead Value DeadTest.res:94:1-21 bar is never used - <-- line 94 - @dead("bar") and bar = () => foo() Warning Dead Value DeadTest.res:96:1-71 withDefaultValue is never used - <-- line 96 - @dead("withDefaultValue") let withDefaultValue = (~paramWithDefault=3, y) => paramWithDefault + y Warning Dead Value DeadTest.res:104:1-52 zzz is never used - <-- line 104 - @dead("zzz") let zzz = { Warning Dead Value DeadTest.res:112:1-14 second is never used - <-- line 112 - @dead("second") let second = 1 Warning Dead Value DeadTest.res:114:1-21 deadRef is never used - <-- line 114 - @dead("deadRef") let deadRef = ref(12) Warning Dead Value With Side Effects DeadTest.res:121:1-40 @@ -2722,14 +2670,10 @@ File References Warning Dead Type DeadTest.res:151:12-17 rc.a is a record label never used to read a value - <-- line 151 - type rc = {@dead("rc.a") a: int} Warning Dead Type DeadTest.res:158:25-30 inlineRecord.IR.a is a record label never used to read a value - <-- line 158 - type inlineRecord = IR({@dead("inlineRecord.IR.a") a: int, b: int, c: string, @dead d: int, @live e: int}) Warning Dead Module DeadTestBlacklist.res:0:1 @@ -2738,8 +2682,6 @@ File References Warning Dead Value DeadTestBlacklist.res:1:1-10 x is never used - <-- line 1 - @dead("x") let x = 34 Warning Dead Module DeadTestWithInterface.res:1:8-54 @@ -2748,80 +2690,54 @@ File References Warning Dead Value DeadTestWithInterface.res:2:3-12 Ext_buffer.x is never used - <-- line 2 - @dead("Ext_buffer.x") let x: int Warning Dead Value DeadTestWithInterface.res:4:3-12 Ext_buffer.x is never used - <-- line 4 - @dead("Ext_buffer.x") let x = 42 Warning Dead Type DeadTypeTest.res:3:5 t.B is a variant case which is never constructed - <-- line 3 - | @dead("t.B") B Warning Dead Value DeadTypeTest.res:4:1-9 a is never used - <-- line 4 - @dead("a") let a = A Warning Dead Type DeadTypeTest.res:10:5-13 deadType.InNeither is a variant case which is never constructed - <-- line 10 - | @dead("deadType.InNeither") InNeither Warning Dead Type DeadTypeTest.resi:3:5 t.B is a variant case which is never constructed - <-- line 3 - | @dead("t.B") B Warning Dead Value DeadTypeTest.resi:4:1-8 a is never used - <-- line 4 - @dead("a") let a: t Warning Dead Type DeadTypeTest.resi:10:5-13 deadType.InNeither is a variant case which is never constructed - <-- line 10 - | @dead("deadType.InNeither") InNeither Warning Dead Value DeadValueTest.res:2:1-17 valueDead is never used - <-- line 2 - @dead("valueDead") let valueDead = 2 Warning Dead Value DeadValueTest.res:4:1-33 valueOnlyInImplementation is never used - <-- line 4 - @dead("valueOnlyInImplementation") let valueOnlyInImplementation = 3 Warning Dead Value DeadValueTest.res:6:1-260 subList is never used - <-- line 6 - @dead("subList") let rec subList = (b, e, l) => Warning Dead Value DeadValueTest.resi:2:1-18 valueDead is never used - <-- line 2 - @dead("valueDead") let valueDead: int Warning Dead Type Docstrings.res:61:5 t.B is a variant case which is never constructed - <-- line 61 - | @dead("t.B") B Warning Dead Module ErrorHandler.res:0:1 @@ -2830,8 +2746,6 @@ File References Warning Dead Value ErrorHandler.res:11:1-19 x is never used - <-- line 12 - @dead("x") @genType Warning Dead Module ErrorHandler.resi:0:1 @@ -2840,8 +2754,6 @@ File References Warning Dead Value ErrorHandler.resi:10:1-10 x is never used - <-- line 10 - @dead("x") let x: int Warning Dead Module EverythingLiveHere.res:0:1 @@ -2850,20 +2762,14 @@ File References Warning Dead Value EverythingLiveHere.res:1:1-9 x is never used - <-- line 1 - @dead("x") let x = 1 Warning Dead Value EverythingLiveHere.res:3:1-9 y is never used - <-- line 3 - @dead("y") let y = 3 Warning Dead Value EverythingLiveHere.res:5:1-9 z is never used - <-- line 5 - @dead("z") let z = 4 Warning Dead Module FirstClassModulesInterface.res:0:1 @@ -2872,20 +2778,14 @@ File References Warning Dead Type FirstClassModulesInterface.res:2:3-8 record.x is a record label never used to read a value - <-- line 2 - @dead("record.x") x: int, Warning Dead Type FirstClassModulesInterface.res:3:3-11 record.y is a record label never used to read a value - <-- line 3 - @dead("record.y") y: string, Warning Dead Value FirstClassModulesInterface.res:6:1-26 r is never used - <-- line 6 - @dead("r") let r = {x: 3, y: "hello"} Warning Dead Module FirstClassModulesInterface.resi:0:1 @@ -2894,788 +2794,526 @@ File References Warning Dead Type FirstClassModulesInterface.resi:3:3-8 record.x is a record label never used to read a value - <-- line 3 - @dead("record.x") x: int, Warning Dead Type FirstClassModulesInterface.resi:4:3-11 record.y is a record label never used to read a value - <-- line 4 - @dead("record.y") y: string, Warning Dead Value FirstClassModulesInterface.resi:7:1-13 r is never used - <-- line 7 - @dead("r") let r: record Warning Dead Type Hooks.res:50:11-19 r.x is a record label never used to read a value - <-- line 50 - type r = {@dead("r.x") x: string} Warning Dead Value ImmutableArray.res:16:3-41 toArray is never used - <-- line 16 - @dead("toArray") let toArray = a => Array.copy(a->fromT) Warning Dead Value ImmutableArray.res:20:3-42 length is never used - <-- line 20 - @dead("length") let length = a => Array.length(a->fromT) Warning Dead Value ImmutableArray.res:22:3-38 size is never used - <-- line 22 - @dead("size") let size = a => Array.size(a->fromT) Warning Dead Value ImmutableArray.res:26:3-50 getExn is never used - <-- line 26 - @dead("getExn") let getExn = (a, x) => Array.getExn(a->fromT, x) Warning Dead Value ImmutableArray.res:28:3-56 getUnsafe is never used - <-- line 28 - @dead("getUnsafe") let getUnsafe = (a, x) => Array.getUnsafe(a->fromT, x) Warning Dead Value ImmutableArray.res:30:3-62 getUndefined is never used - <-- line 30 - @dead("getUndefined") let getUndefined = (a, x) => Array.getUndefined(a->fromT, x) Warning Dead Value ImmutableArray.res:32:3-49 shuffle is never used - <-- line 32 - @dead("shuffle") let shuffle = x => Array.shuffle(x->fromT)->toT Warning Dead Value ImmutableArray.res:34:3-49 reverse is never used - <-- line 34 - @dead("reverse") let reverse = x => Array.reverse(x->fromT)->toT Warning Dead Value ImmutableArray.res:36:3-62 makeUninitialized is never used - <-- line 36 - @dead("makeUninitialized") let makeUninitialized = x => Array.makeUninitialized(x)->toT Warning Dead Value ImmutableArray.res:38:3-74 makeUninitializedUnsafe is never used - <-- line 38 - @dead("makeUninitializedUnsafe") let makeUninitializedUnsafe = x => Array.makeUninitializedUnsafe(x)->toT Warning Dead Value ImmutableArray.res:40:3-44 make is never used - <-- line 40 - @dead("make") let make = (x, y) => Array.make(x, y)->toT Warning Dead Value ImmutableArray.res:42:3-46 range is never used - <-- line 42 - @dead("range") let range = (x, y) => Array.range(x, y)->toT Warning Dead Value ImmutableArray.res:44:3-64 rangeBy is never used - <-- line 44 - @dead("rangeBy") let rangeBy = (x, y, ~step) => Array.rangeBy(x, y, ~step)->toT Warning Dead Value ImmutableArray.res:46:3-50 makeByU is never used - <-- line 46 - @dead("makeByU") let makeByU = (c, f) => Array.makeByU(c, f)->toT Warning Dead Value ImmutableArray.res:47:3-48 makeBy is never used - <-- line 47 - @dead("makeBy") let makeBy = (c, f) => Array.makeBy(c, f)->toT Warning Dead Value ImmutableArray.res:49:3-70 makeByAndShuffleU is never used - <-- line 49 - @dead("makeByAndShuffleU") let makeByAndShuffleU = (c, f) => Array.makeByAndShuffleU(c, f)->toT Warning Dead Value ImmutableArray.res:50:3-68 makeByAndShuffle is never used - <-- line 50 - @dead("makeByAndShuffle") let makeByAndShuffle = (c, f) => Array.makeByAndShuffle(c, f)->toT Warning Dead Value ImmutableArray.res:52:3-61 zip is never used - <-- line 52 - @dead("zip") let zip = (a1, a2) => Array.zip(fromT(a1), fromT(a2))->toTp Warning Dead Value ImmutableArray.res:54:3-72 zipByU is never used - <-- line 54 - @dead("zipByU") let zipByU = (a1, a2, f) => Array.zipByU(fromT(a1), fromT(a2), f)->toT Warning Dead Value ImmutableArray.res:55:3-70 zipBy is never used - <-- line 55 - @dead("zipBy") let zipBy = (a1, a2, f) => Array.zipBy(fromT(a1), fromT(a2), f)->toT Warning Dead Value ImmutableArray.res:57:3-47 unzip is never used - <-- line 57 - @dead("unzip") let unzip = a => Array.unzip(a->fromTp)->toT2 Warning Dead Value ImmutableArray.res:59:3-66 concat is never used - <-- line 59 - @dead("concat") let concat = (a1, a2) => Array.concat(a1->fromT, a2->fromT)->toT Warning Dead Value ImmutableArray.res:61:3-67 concatMany is never used - <-- line 61 - @dead("concatMany") let concatMany = (a: t>) => Array.concatMany(a->fromTT)->toT Warning Dead Value ImmutableArray.res:63:3-77 slice is never used - <-- line 63 - @dead("slice") let slice = (a, ~offset, ~len) => Array.slice(a->fromT, ~offset, ~len)->toT Warning Dead Value ImmutableArray.res:65:3-63 sliceToEnd is never used - <-- line 65 - @dead("sliceToEnd") let sliceToEnd = (a, b) => Array.sliceToEnd(a->fromT, b)->toT Warning Dead Value ImmutableArray.res:67:3-43 copy is never used - <-- line 67 - @dead("copy") let copy = a => Array.copy(a->fromT)->toT Warning Dead Value ImmutableArray.res:69:3-54 forEachU is never used - <-- line 69 - @dead("forEachU") let forEachU = (a, f) => Array.forEachU(a->fromT, f) Warning Dead Value ImmutableArray.res:70:3-52 forEach is never used - <-- line 70 - @dead("forEach") let forEach = (a, f) => Array.forEach(a->fromT, f) Warning Dead Value ImmutableArray.res:72:3-51 mapU is never used - <-- line 72 - @dead("mapU") let mapU = (a, f) => Array.mapU(a->fromT, f)->toT Warning Dead Value ImmutableArray.res:73:3-49 map is never used - <-- line 73 - @dead("map") let map = (a, f) => Array.map(a->fromT, f)->toT Warning Dead Value ImmutableArray.res:75:3-71 keepWithIndexU is never used - <-- line 75 - @dead("keepWithIndexU") let keepWithIndexU = (a, f) => Array.keepWithIndexU(a->fromT, f)->toT Warning Dead Value ImmutableArray.res:76:3-69 keepWithIndex is never used - <-- line 76 - @dead("keepWithIndex") let keepWithIndex = (a, f) => Array.keepWithIndex(a->fromT, f)->toT Warning Dead Value ImmutableArray.res:78:3-59 keepMapU is never used - <-- line 78 - @dead("keepMapU") let keepMapU = (a, f) => Array.keepMapU(a->fromT, f)->toT Warning Dead Value ImmutableArray.res:79:3-57 keepMap is never used - <-- line 79 - @dead("keepMap") let keepMap = (a, f) => Array.keepMap(a->fromT, f)->toT Warning Dead Value ImmutableArray.res:81:3-72 forEachWithIndexU is never used - <-- line 81 - @dead("forEachWithIndexU") let forEachWithIndexU = (a, f) => Array.forEachWithIndexU(a->fromT, f) Warning Dead Value ImmutableArray.res:82:3-70 forEachWithIndex is never used - <-- line 82 - @dead("forEachWithIndex") let forEachWithIndex = (a, f) => Array.forEachWithIndex(a->fromT, f) Warning Dead Value ImmutableArray.res:84:3-69 mapWithIndexU is never used - <-- line 84 - @dead("mapWithIndexU") let mapWithIndexU = (a, f) => Array.mapWithIndexU(a->fromT, f)->toT Warning Dead Value ImmutableArray.res:85:3-67 mapWithIndex is never used - <-- line 85 - @dead("mapWithIndex") let mapWithIndex = (a, f) => Array.mapWithIndex(a->fromT, f)->toT Warning Dead Value ImmutableArray.res:87:3-64 partitionU is never used - <-- line 87 - @dead("partitionU") let partitionU = (a, f) => Array.partitionU(a->fromT, f)->toT2 Warning Dead Value ImmutableArray.res:88:3-62 partition is never used - <-- line 88 - @dead("partition") let partition = (a, f) => Array.partition(a->fromT, f)->toT2 Warning Dead Value ImmutableArray.res:90:3-58 reduceU is never used - <-- line 90 - @dead("reduceU") let reduceU = (a, b, f) => Array.reduceU(a->fromT, b, f) Warning Dead Value ImmutableArray.res:91:3-56 reduce is never used - <-- line 91 - @dead("reduce") let reduce = (a, b, f) => Array.reduce(a->fromT, b, f) Warning Dead Value ImmutableArray.res:93:3-72 reduceReverseU is never used - <-- line 93 - @dead("reduceReverseU") let reduceReverseU = (a, b, f) => Array.reduceReverseU(a->fromT, b, f) Warning Dead Value ImmutableArray.res:94:3-70 reduceReverse is never used - <-- line 94 - @dead("reduceReverse") let reduceReverse = (a, b, f) => Array.reduceReverse(a->fromT, b, f) Warning Dead Value ImmutableArray.res:96:3-91 reduceReverse2U is never used - <-- line 96 - @dead("reduceReverse2U") let reduceReverse2U = (a1, a2, c, f) => Array.reduceReverse2U(fromT(a1), fromT(a2), c, f) Warning Dead Value ImmutableArray.res:97:3-89 reduceReverse2 is never used - <-- line 97 - @dead("reduceReverse2") let reduceReverse2 = (a1, a2, c, f) => Array.reduceReverse2(fromT(a1), fromT(a2), c, f) Warning Dead Value ImmutableArray.res:99:3-48 someU is never used - <-- line 99 - @dead("someU") let someU = (a, f) => Array.someU(a->fromT, f) Warning Dead Value ImmutableArray.res:100:3-46 some is never used - <-- line 100 - @dead("some") let some = (a, f) => Array.some(a->fromT, f) Warning Dead Value ImmutableArray.res:102:3-50 everyU is never used - <-- line 102 - @dead("everyU") let everyU = (a, f) => Array.everyU(a->fromT, f) Warning Dead Value ImmutableArray.res:103:3-48 every is never used - <-- line 103 - @dead("every") let every = (a, f) => Array.every(a->fromT, f) Warning Dead Value ImmutableArray.res:105:3-69 every2U is never used - <-- line 105 - @dead("every2U") let every2U = (a1, a2, f) => Array.every2U(fromT(a1), fromT(a2), f) Warning Dead Value ImmutableArray.res:106:3-67 every2 is never used - <-- line 106 - @dead("every2") let every2 = (a1, a2, f) => Array.every2(fromT(a1), fromT(a2), f) Warning Dead Value ImmutableArray.res:108:3-67 some2U is never used - <-- line 108 - @dead("some2U") let some2U = (a1, a2, f) => Array.some2U(fromT(a1), fromT(a2), f) Warning Dead Value ImmutableArray.res:109:3-65 some2 is never used - <-- line 109 - @dead("some2") let some2 = (a1, a2, f) => Array.some2(fromT(a1), fromT(a2), f) Warning Dead Value ImmutableArray.res:111:3-63 cmpU is never used - <-- line 111 - @dead("cmpU") let cmpU = (a1, a2, f) => Array.cmpU(fromT(a1), fromT(a2), f) Warning Dead Value ImmutableArray.res:112:3-61 cmp is never used - <-- line 112 - @dead("cmp") let cmp = (a1, a2, f) => Array.cmp(fromT(a1), fromT(a2), f) Warning Dead Value ImmutableArray.res:114:3-61 eqU is never used - <-- line 114 - @dead("eqU") let eqU = (a1, a2, f) => Array.eqU(fromT(a1), fromT(a2), f) Warning Dead Value ImmutableArray.res:115:3-59 eq is never used - <-- line 115 - @dead("eq") let eq = (a1, a2, f) => Array.eq(fromT(a1), fromT(a2), f) Warning Dead Value ImmutableArray.resi:12:1-31 toArray is never used - <-- line 12 - @dead("toArray") let toArray: t<'a> => array<'a> Warning Dead Value ImmutableArray.resi:14:1-107 length is never used - <-- line 14 - @dead("length") @ocaml.doc(" Subset of the Belt.Array oprerations that do not mutate the array. ") Warning Dead Value ImmutableArray.resi:17:1-22 size is never used - <-- line 17 - @dead("size") let size: t<'a> => int Warning Dead Value ImmutableArray.resi:19:1-35 get is never used - <-- line 19 - @dead("get") let get: (t<'a>, int) => option<'a> Warning Dead Value ImmutableArray.resi:21:1-30 getExn is never used - <-- line 21 - @dead("getExn") let getExn: (t<'a>, int) => 'a Warning Dead Value ImmutableArray.resi:23:1-33 getUnsafe is never used - <-- line 23 - @dead("getUnsafe") let getUnsafe: (t<'a>, int) => 'a Warning Dead Value ImmutableArray.resi:25:1-50 getUndefined is never used - <-- line 25 - @dead("getUndefined") let getUndefined: (t<'a>, int) => Js.undefined<'a> Warning Dead Value ImmutableArray.resi:27:1-27 shuffle is never used - <-- line 27 - @dead("shuffle") let shuffle: t<'a> => t<'a> Warning Dead Value ImmutableArray.resi:29:1-27 reverse is never used - <-- line 29 - @dead("reverse") let reverse: t<'a> => t<'a> Warning Dead Value ImmutableArray.resi:31:1-49 makeUninitialized is never used - <-- line 31 - @dead("makeUninitialized") let makeUninitialized: int => t> Warning Dead Value ImmutableArray.resi:33:1-41 makeUninitializedUnsafe is never used - <-- line 33 - @dead("makeUninitializedUnsafe") let makeUninitializedUnsafe: int => t<'a> Warning Dead Value ImmutableArray.resi:35:1-28 make is never used - <-- line 35 - @dead("make") let make: (int, 'a) => t<'a> Warning Dead Value ImmutableArray.resi:37:1-31 range is never used - <-- line 37 - @dead("range") let range: (int, int) => t Warning Dead Value ImmutableArray.resi:39:1-45 rangeBy is never used - <-- line 39 - @dead("rangeBy") let rangeBy: (int, int, ~step: int) => t Warning Dead Value ImmutableArray.resi:41:1-42 makeByU is never used - <-- line 41 - @dead("makeByU") let makeByU: (int, (. int) => 'a) => t<'a> Warning Dead Value ImmutableArray.resi:42:1-37 makeBy is never used - <-- line 42 - @dead("makeBy") let makeBy: (int, int => 'a) => t<'a> Warning Dead Value ImmutableArray.resi:44:1-52 makeByAndShuffleU is never used - <-- line 44 - @dead("makeByAndShuffleU") let makeByAndShuffleU: (int, (. int) => 'a) => t<'a> Warning Dead Value ImmutableArray.resi:45:1-47 makeByAndShuffle is never used - <-- line 45 - @dead("makeByAndShuffle") let makeByAndShuffle: (int, int => 'a) => t<'a> Warning Dead Value ImmutableArray.resi:47:1-38 zip is never used - <-- line 47 - @dead("zip") let zip: (t<'a>, t<'b>) => t<('a, 'b)> Warning Dead Value ImmutableArray.resi:49:1-53 zipByU is never used - <-- line 49 - @dead("zipByU") let zipByU: (t<'a>, t<'b>, (. 'a, 'b) => 'c) => t<'c> Warning Dead Value ImmutableArray.resi:50:1-50 zipBy is never used - <-- line 50 - @dead("zipBy") let zipBy: (t<'a>, t<'b>, ('a, 'b) => 'c) => t<'c> Warning Dead Value ImmutableArray.resi:52:1-40 unzip is never used - <-- line 52 - @dead("unzip") let unzip: t<('a, 'a)> => (t<'a>, t<'a>) Warning Dead Value ImmutableArray.resi:54:1-35 concat is never used - <-- line 54 - @dead("concat") let concat: (t<'a>, t<'a>) => t<'a> Warning Dead Value ImmutableArray.resi:56:1-33 concatMany is never used - <-- line 56 - @dead("concatMany") let concatMany: t> => t<'a> Warning Dead Value ImmutableArray.resi:58:1-52 slice is never used - <-- line 58 - @dead("slice") let slice: (t<'a>, ~offset: int, ~len: int) => t<'a> Warning Dead Value ImmutableArray.resi:60:1-37 sliceToEnd is never used - <-- line 60 - @dead("sliceToEnd") let sliceToEnd: (t<'a>, int) => t<'a> Warning Dead Value ImmutableArray.resi:62:1-24 copy is never used - <-- line 62 - @dead("copy") let copy: t<'a> => t<'a> Warning Dead Value ImmutableArray.resi:64:1-45 forEachU is never used - <-- line 64 - @dead("forEachU") let forEachU: (t<'a>, (. 'a) => unit) => unit Warning Dead Value ImmutableArray.resi:65:1-40 forEach is never used - <-- line 65 - @dead("forEach") let forEach: (t<'a>, 'a => unit) => unit Warning Dead Value ImmutableArray.resi:67:1-40 mapU is never used - <-- line 67 - @dead("mapU") let mapU: (t<'a>, (. 'a) => 'b) => t<'b> Warning Dead Value ImmutableArray.resi:68:1-35 map is never used - <-- line 68 - @dead("map") let map: (t<'a>, 'a => 'b) => t<'b> Warning Dead Value ImmutableArray.resi:70:1-57 keepWithIndexU is never used - <-- line 70 - @dead("keepWithIndexU") let keepWithIndexU: (t<'a>, (. 'a, int) => bool) => t<'a> Warning Dead Value ImmutableArray.resi:71:1-54 keepWithIndex is never used - <-- line 71 - @dead("keepWithIndex") let keepWithIndex: (t<'a>, ('a, int) => bool) => t<'a> Warning Dead Value ImmutableArray.resi:73:1-52 keepMapU is never used - <-- line 73 - @dead("keepMapU") let keepMapU: (t<'a>, (. 'a) => option<'b>) => t<'b> Warning Dead Value ImmutableArray.resi:74:1-47 keepMap is never used - <-- line 74 - @dead("keepMap") let keepMap: (t<'a>, 'a => option<'b>) => t<'b> Warning Dead Value ImmutableArray.resi:76:1-59 forEachWithIndexU is never used - <-- line 76 - @dead("forEachWithIndexU") let forEachWithIndexU: (t<'a>, (. int, 'a) => unit) => unit Warning Dead Value ImmutableArray.resi:77:1-56 forEachWithIndex is never used - <-- line 77 - @dead("forEachWithIndex") let forEachWithIndex: (t<'a>, (int, 'a) => unit) => unit Warning Dead Value ImmutableArray.resi:79:1-54 mapWithIndexU is never used - <-- line 79 - @dead("mapWithIndexU") let mapWithIndexU: (t<'a>, (. int, 'a) => 'b) => t<'b> Warning Dead Value ImmutableArray.resi:80:1-51 mapWithIndex is never used - <-- line 80 - @dead("mapWithIndex") let mapWithIndex: (t<'a>, (int, 'a) => 'b) => t<'b> Warning Dead Value ImmutableArray.resi:82:1-57 partitionU is never used - <-- line 82 - @dead("partitionU") let partitionU: (t<'a>, (. 'a) => bool) => (t<'a>, t<'a>) Warning Dead Value ImmutableArray.resi:83:1-52 partition is never used - <-- line 83 - @dead("partition") let partition: (t<'a>, 'a => bool) => (t<'a>, t<'a>) Warning Dead Value ImmutableArray.resi:85:1-48 reduceU is never used - <-- line 85 - @dead("reduceU") let reduceU: (t<'a>, 'b, (. 'b, 'a) => 'b) => 'b Warning Dead Value ImmutableArray.resi:86:1-45 reduce is never used - <-- line 86 - @dead("reduce") let reduce: (t<'a>, 'b, ('b, 'a) => 'b) => 'b Warning Dead Value ImmutableArray.resi:88:1-55 reduceReverseU is never used - <-- line 88 - @dead("reduceReverseU") let reduceReverseU: (t<'a>, 'b, (. 'b, 'a) => 'b) => 'b Warning Dead Value ImmutableArray.resi:89:1-52 reduceReverse is never used - <-- line 89 - @dead("reduceReverse") let reduceReverse: (t<'a>, 'b, ('b, 'a) => 'b) => 'b Warning Dead Value ImmutableArray.resi:91:1-67 reduceReverse2U is never used - <-- line 91 - @dead("reduceReverse2U") let reduceReverse2U: (t<'a>, t<'b>, 'c, (. 'c, 'a, 'b) => 'c) => 'c Warning Dead Value ImmutableArray.resi:92:1-64 reduceReverse2 is never used - <-- line 92 - @dead("reduceReverse2") let reduceReverse2: (t<'a>, t<'b>, 'c, ('c, 'a, 'b) => 'c) => 'c Warning Dead Value ImmutableArray.resi:94:1-42 someU is never used - <-- line 94 - @dead("someU") let someU: (t<'a>, (. 'a) => bool) => bool Warning Dead Value ImmutableArray.resi:95:1-37 some is never used - <-- line 95 - @dead("some") let some: (t<'a>, 'a => bool) => bool Warning Dead Value ImmutableArray.resi:97:1-43 everyU is never used - <-- line 97 - @dead("everyU") let everyU: (t<'a>, (. 'a) => bool) => bool Warning Dead Value ImmutableArray.resi:98:1-38 every is never used - <-- line 98 - @dead("every") let every: (t<'a>, 'a => bool) => bool Warning Dead Value ImmutableArray.resi:100:1-55 every2U is never used - <-- line 100 - @dead("every2U") let every2U: (t<'a>, t<'b>, (. 'a, 'b) => bool) => bool Warning Dead Value ImmutableArray.resi:101:1-52 every2 is never used - <-- line 101 - @dead("every2") let every2: (t<'a>, t<'b>, ('a, 'b) => bool) => bool Warning Dead Value ImmutableArray.resi:103:1-54 some2U is never used - <-- line 103 - @dead("some2U") let some2U: (t<'a>, t<'b>, (. 'a, 'b) => bool) => bool Warning Dead Value ImmutableArray.resi:104:1-51 some2 is never used - <-- line 104 - @dead("some2") let some2: (t<'a>, t<'b>, ('a, 'b) => bool) => bool Warning Dead Value ImmutableArray.resi:106:1-50 cmpU is never used - <-- line 106 - @dead("cmpU") let cmpU: (t<'a>, t<'a>, (. 'a, 'a) => int) => int Warning Dead Value ImmutableArray.resi:107:1-47 cmp is never used - <-- line 107 - @dead("cmp") let cmp: (t<'a>, t<'a>, ('a, 'a) => int) => int Warning Dead Value ImmutableArray.resi:109:1-51 eqU is never used - <-- line 109 - @dead("eqU") let eqU: (t<'a>, t<'a>, (. 'a, 'a) => bool) => bool Warning Dead Value ImmutableArray.resi:110:1-48 eq is never used - <-- line 110 - @dead("eq") let eq: (t<'a>, t<'a>, ('a, 'a) => bool) => bool Warning Dead Type ImportHookDefault.res:2:3-14 person.name is a record label never used to read a value - <-- line 2 - @dead("person.name") name: string, Warning Dead Type ImportHookDefault.res:3:3-10 person.age is a record label never used to read a value - <-- line 3 - @dead("person.age") age: int, Warning Dead Type ImportHooks.res:3:3-14 person.name is a record label never used to read a value - <-- line 3 - @dead("person.name") name: string, Warning Dead Type ImportHooks.res:4:3-10 person.age is a record label never used to read a value - <-- line 4 - @dead("person.age") age: int, Warning Dead Type ImportJsValue.res:11:3-8 point.x is a record label never used to read a value - <-- line 11 - @dead("point.x") x: int, Warning Dead Type ImportJsValue.res:12:3-16 point.y is a record label never used to read a value - <-- line 12 - @dead("point.y") y: option, Warning Dead Type ImportJsValue.res:67:3-10 variant.I is a variant case which is never constructed - <-- line 67 - | @dead("variant.I") I(int) Warning Dead Type ImportJsValue.res:68:5-13 variant.S is a variant case which is never constructed - <-- line 68 - | @dead("variant.S") S(string) Warning Dead Type ImportMyBanner.res:5:17-28 message.text is a record label never used to read a value - <-- line 5 - type message = {@dead("message.text") text: string} Warning Dead Value ImportMyBanner.res:12:1-15 make is never used - <-- line 12 - @dead("make") let make = make Warning Dead Module ModuleAliases.res:2:10-56 @@ -3684,8 +3322,6 @@ File References Warning Dead Type ModuleAliases.res:3:20-32 Outer.Inner.innerT.inner is a record label never used to read a value - <-- line 3 - type innerT = {@dead("Outer.Inner.innerT.inner") inner: string} Warning Dead Module ModuleAliases.res:10:12-61 @@ -3694,8 +3330,6 @@ File References Warning Dead Type ModuleAliases.res:11:17-27 Outer2.Inner2.InnerNested.t.nested is a record label never used to read a value - <-- line 11 - type t = {@dead("Outer2.Inner2.InnerNested.t.nested") nested: int} Warning Dead Module ModuleAliases2.res:0:1 @@ -3704,14 +3338,10 @@ File References Warning Dead Type ModuleAliases2.res:3:3-8 record.x is a record label never used to read a value - <-- line 3 - @dead("record.x") x: int, Warning Dead Type ModuleAliases2.res:4:3-11 record.y is a record label never used to read a value - <-- line 4 - @dead("record.y") y: string, Warning Dead Module ModuleAliases2.res:7:8-130 @@ -3720,8 +3350,6 @@ File References Warning Dead Type ModuleAliases2.res:9:17-29 Outer.outer.outer is a record label never used to read a value - <-- line 9 - type outer = {@dead("Outer.outer.outer") outer: string} Warning Dead Module ModuleAliases2.res:11:10-68 @@ -3730,14 +3358,10 @@ File References Warning Dead Type ModuleAliases2.res:13:19-31 Outer.Inner.inner.inner is a record label never used to read a value - <-- line 13 - type inner = {@dead("Outer.Inner.inner.inner") inner: string} Warning Dead Value ModuleAliases2.res:21:1-10 q is never used - <-- line 21 - @dead("q") let q = 42 Warning Dead Module ModuleExceptionBug.res:1:8-52 @@ -3746,68 +3370,46 @@ File References Warning Dead Value ModuleExceptionBug.res:2:3-35 Dep.customDouble is never used - <-- line 2 - @dead("Dep.customDouble") let customDouble = foo => foo * 2 Warning Dead Exception ModuleExceptionBug.res:5:1-26 MyOtherException is never raised or passed as value - <-- line 5 - @dead("MyOtherException") exception MyOtherException Warning Dead Value NestedModules.res:8:3-22 Universe.notExported is never used - <-- line 8 - @dead("Universe.notExported") let notExported = 33 Warning Dead Value NestedModules.res:14:5-13 Universe.Nested2.x is never used - <-- line 14 - @dead("Universe.Nested2.x") let x = 0 Warning Dead Value NestedModules.res:19:5-13 Universe.Nested2.y is never used - <-- line 19 - @dead("Universe.Nested2.y") let y = 2 Warning Dead Value NestedModules.res:25:7-15 Universe.Nested2.Nested3.x is never used - <-- line 25 - @dead("Universe.Nested2.Nested3.x") let x = 0 Warning Dead Value NestedModules.res:26:7-15 Universe.Nested2.Nested3.y is never used - <-- line 26 - @dead("Universe.Nested2.Nested3.y") let y = 1 Warning Dead Value NestedModules.res:27:7-15 Universe.Nested2.Nested3.z is never used - <-- line 27 - @dead("Universe.Nested2.Nested3.z") let z = 2 Warning Dead Value NestedModules.res:28:7-15 Universe.Nested2.Nested3.w is never used - <-- line 28 - @dead("Universe.Nested2.Nested3.w") let w = 3 Warning Dead Type NestedModules.res:46:5-7 Universe.variant.A is a variant case which is never constructed - <-- line 46 - | @dead("Universe.variant.A") A Warning Dead Type NestedModules.res:47:7-15 Universe.variant.B is a variant case which is never constructed - <-- line 47 - | @dead("Universe.variant.B") B(string) Warning Dead Module Newsyntax.res:0:1 @@ -3816,182 +3418,122 @@ File References Warning Dead Value Newsyntax.res:1:1-10 x is never used - <-- line 1 - @dead("x") let x = 34 Warning Dead Value Newsyntax.res:3:1-10 y is never used - <-- line 3 - @dead("y") let y = 11 Warning Dead Type Newsyntax.res:6:3-10 record.xxx is a record label never used to read a value - <-- line 6 - @dead("record.xxx") xxx: int, Warning Dead Type Newsyntax.res:7:3-10 record.yyy is a record label never used to read a value - <-- line 7 - @dead("record.yyy") yyy: int, Warning Dead Type Newsyntax.res:10:16 variant.A is a variant case which is never constructed - <-- line 10 - type variant = | @dead("variant.A") A | @dead("variant.B") B(int)|@dead("variant.C") C Warning Dead Type Newsyntax.res:10:20-25 variant.B is a variant case which is never constructed - <-- line 10 - type variant = | @dead("variant.A") A | @dead("variant.B") B(int)|@dead("variant.C") C Warning Dead Type Newsyntax.res:10:26-27 variant.C is a variant case which is never constructed - <-- line 10 - type variant = | @dead("variant.A") A | @dead("variant.B") B(int)|@dead("variant.C") C Warning Dead Type Newsyntax.res:12:17-22 record2.xx is a record label never used to read a value - <-- line 12 - type record2 = {@dead("record2.xx") xx:int,@dead("record2.yy") yy:int} Warning Dead Type Newsyntax.res:12:24-29 record2.yy is a record label never used to read a value - <-- line 12 - type record2 = {@dead("record2.xx") xx:int,@dead("record2.yy") yy:int} Warning Dead Type Opaque.res:2:26-41 opaqueFromRecords.A is a variant case which is never constructed - <-- line 2 - type opaqueFromRecords = | @dead("opaqueFromRecords.A") A(Records.coord) Warning Dead Value OptArg.resi:1:1-54 foo is never used - <-- line 1 - @dead("foo") let foo: (~x: int=?, ~y: int=?, ~z: int=?, int) => int Warning Dead Type Records.res:24:3-14 person.name is a record label never used to read a value - <-- line 24 - @dead("person.name") name: string, Warning Dead Type Records.res:25:3-10 person.age is a record label never used to read a value - <-- line 25 - @dead("person.age") age: int, Warning Dead Type Records.res:31:3-14 business.name is a record label never used to read a value - <-- line 31 - @dead("business.name") name: string, Warning Dead Type Records.res:60:3-10 payload.num is a record label never used to read a value - <-- line 60 - @dead("payload.num") num: int, Warning Dead Type Records.res:70:3-8 record.w is a record label never used to read a value - <-- line 70 - @dead("record.w") w: int, Warning Dead Type Records.res:90:3-14 business2.name is a record label never used to read a value - <-- line 90 - @dead("business2.name") name: string, Warning Dead Type Records.res:91:3-30 business2.owner is a record label never used to read a value - <-- line 91 - @dead("business2.owner") owner: Js.Nullable.t, Warning Dead Type References.res:39:28-33 requiresConversion.x is a record label never used to read a value - <-- line 39 - type requiresConversion = {@dead("requiresConversion.x") x: int} Warning Dead Type RepeatedLabel.res:2:3-9 userData.a is a record label never used to read a value - <-- line 2 - @dead("userData.a") a: bool, Warning Dead Type RepeatedLabel.res:3:3-8 userData.b is a record label never used to read a value - <-- line 3 - @dead("userData.b") b: int, Warning Dead Type RepeatedLabel.res:9:3-11 tabState.f is a record label never used to read a value - <-- line 9 - @dead("tabState.f") f: string, Warning Dead Value Shadow.res:11:3-22 M.test is never used - <-- line 11 - @dead("M.test") let test = () => "a" Warning Dead Value TestImmutableArray.res:12:1-54 testBeltArrayGet is never used - <-- line 12 - @dead("testBeltArrayGet") let testBeltArrayGet = arr => { Warning Dead Value TestImmutableArray.res:17:1-58 testBeltArraySet is never used - <-- line 17 - @dead("testBeltArraySet") let testBeltArraySet = arr => { Warning Dead Value TestImport.res:13:1-43 innerStuffContents is never used - <-- line 13 - @dead("innerStuffContents") let innerStuffContents = innerStuffContents Warning Dead Type TestImport.res:22:17-28 message.text is a record label never used to read a value - <-- line 22 - type message = {@dead("message.text") text: string} Warning Dead Value TestImport.res:27:1-15 make is never used - <-- line 27 - @dead("make") let make = make Warning Dead Type TestPromise.res:6:3-8 fromPayload.x is a record label never used to read a value - <-- line 6 - @dead("fromPayload.x") x: int, Warning Dead Type TestPromise.res:11:19-32 toPayload.result is a record label never used to read a value - <-- line 11 - type toPayload = {@dead("toPayload.result") result: string} Warning Dead Module TransitiveType2.res:0:1 @@ -4000,20 +3542,14 @@ File References Warning Dead Value TransitiveType2.res:7:1-28 convertT2 is never used - <-- line 7 - @dead("convertT2") let convertT2 = (x: t2) => x Warning Dead Type TransitiveType3.res:3:3-8 t3.i is a record label never used to read a value - <-- line 3 - @dead("t3.i") i: int, Warning Dead Type TransitiveType3.res:4:3-11 t3.s is a record label never used to read a value - <-- line 4 - @dead("t3.s") s: string, Warning Dead Module TypeParams1.res:0:1 @@ -4022,8 +3558,6 @@ File References Warning Dead Value TypeParams1.res:4:1-24 exportSomething is never used - <-- line 4 - @dead("exportSomething") let exportSomething = 10 Warning Dead Module TypeParams2.res:0:1 @@ -4032,62 +3566,42 @@ File References Warning Dead Type TypeParams2.res:2:14-20 item.id is a record label never used to read a value - <-- line 2 - type item = {@dead("item.id") id: int} Warning Dead Value TypeParams2.res:10:1-24 exportSomething is never used - <-- line 10 - @dead("exportSomething") let exportSomething = 10 Warning Dead Type Types.res:12:3-13 typeWithVars.A is a variant case which is never constructed - <-- line 12 - | @dead("typeWithVars.A") A('x, 'y) Warning Dead Type Types.res:13:5-9 typeWithVars.B is a variant case which is never constructed - <-- line 13 - | @dead("typeWithVars.B") B('z) Warning Dead Type Types.res:35:27-47 mutuallyRecursiveB.a is a record label never used to read a value - <-- line 35 - and mutuallyRecursiveB = {@dead("mutuallyRecursiveB.a") a: mutuallyRecursiveA} Warning Dead Type Types.res:56:3-5 opaqueVariant.A is a variant case which is never constructed - <-- line 56 - | @dead("opaqueVariant.A") A Warning Dead Type Types.res:57:5 opaqueVariant.B is a variant case which is never constructed - <-- line 57 - | @dead("opaqueVariant.B") B Warning Dead Type Types.res:84:3-8 record.i is a record label never used to read a value - <-- line 84 - @dead("record.i") i: int, Warning Dead Type Types.res:85:3-11 record.s is a record label never used to read a value - <-- line 85 - @dead("record.s") s: string, Warning Dead Type Types.res:130:20-26 someRecord.id is a record label never used to read a value - <-- line 130 - type someRecord = {@dead("someRecord.id") id: int} Warning Dead Module Types.res:158:8-79 @@ -4096,115 +3610,77 @@ File References Warning Dead Value Types.res:163:3-11 ObjectId.x is never used - <-- line 163 - @dead("ObjectId.x") let x = 1 Warning Dead Type Unboxed.res:2:11-16 v1.A is a variant case which is never constructed - <-- line 2 - type v1 = | @dead("v1.A") A(int) Warning Dead Type Unboxed.res:5:11-16 v2.A is a variant case which is never constructed - <-- line 5 - type v2 = | @dead("v2.A") A(int) Warning Dead Type Unboxed.res:11:12-17 r1.x is a record label never used to read a value - <-- line 11 - type r1 = {@dead("r1.x") x: int} Warning Dead Type Unboxed.res:14:11-24 r2.B is a variant case which is never constructed - <-- line 14 - type r2 = | @dead("r2.B") B({@dead("r2.B.g") g: string}) Warning Dead Type Unboxed.res:14:14-22 r2.B.g is a record label never used to read a value - <-- line 14 - type r2 = | @dead("r2.B") B({@dead("r2.B.g") g: string}) Warning Dead Type Variants.res:95:14-39 type_.Type is a variant case which is never constructed - <-- line 95 - type type_ = | @dead("type_.Type") @genType.as("type") Type Warning Dead Type Variants.res:102:3-10 result1.Ok is a variant case which is never constructed - <-- line 102 - | @dead("result1.Ok") Ok('a) Warning Dead Type Variants.res:103:5-13 result1.Error is a variant case which is never constructed - <-- line 103 - | @dead("result1.Error") Error('b) Warning Dead Type VariantsWithPayload.res:49:3-5 simpleVariant.A is a variant case which is never constructed - <-- line 49 - | @dead("simpleVariant.A") A Warning Dead Type VariantsWithPayload.res:50:5 simpleVariant.B is a variant case which is never constructed - <-- line 50 - | @dead("simpleVariant.B") B Warning Dead Type VariantsWithPayload.res:51:5 simpleVariant.C is a variant case which is never constructed - <-- line 51 - | @dead("simpleVariant.C") C Warning Dead Type VariantsWithPayload.res:58:3-29 variantWithPayloads.A is a variant case which is never constructed - <-- line 58 - | @dead("variantWithPayloads.A") @genType.as("ARenamed") A Warning Dead Type VariantsWithPayload.res:59:5-10 variantWithPayloads.B is a variant case which is never constructed - <-- line 59 - | @dead("variantWithPayloads.B") B(int) Warning Dead Type VariantsWithPayload.res:60:5-15 variantWithPayloads.C is a variant case which is never constructed - <-- line 60 - | @dead("variantWithPayloads.C") C(int, int) Warning Dead Type VariantsWithPayload.res:61:5-17 variantWithPayloads.D is a variant case which is never constructed - <-- line 61 - | @dead("variantWithPayloads.D") D((int, int)) Warning Dead Type VariantsWithPayload.res:62:5-23 variantWithPayloads.E is a variant case which is never constructed - <-- line 62 - | @dead("variantWithPayloads.E") E(int, string, int) Warning Dead Type VariantsWithPayload.res:90:20-25 variant1Int.R is a variant case which is never constructed - <-- line 90 - type variant1Int = | @dead("variant1Int.R") R(int) Warning Dead Type VariantsWithPayload.res:96:23-32 variant1Object.R is a variant case which is never constructed - <-- line 96 - type variant1Object = | @dead("variant1Object.R") R(payload) Analysis reported 302 issues (Incorrect Dead Annotation:1, Warning Dead Exception:2, Warning Dead Module:21, Warning Dead Type:87, Warning Dead Value:173, Warning Dead Value With Side Effects:2, Warning Redundant Optional Argument:5, Warning Unused Argument:11) diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/test-order-independence.sh b/tests/analysis_tests/tests-reanalyze/deadcode/test-order-independence.sh new file mode 100755 index 0000000000..7a01fd67a2 --- /dev/null +++ b/tests/analysis_tests/tests-reanalyze/deadcode/test-order-independence.sh @@ -0,0 +1,41 @@ +#!/bin/bash +# Test order-independence: verify that shuffling file order produces identical results +# This test runs the analysis multiple times with different file orderings. + +set -e + +warningYellow='\033[0;33m' +successGreen='\033[0;32m' +reset='\033[0m' + +if [ "$RUNNER_OS" == "Windows" ]; then + exclude_dirs="src\exception" + suppress="src\ToSuppress.res" +else + exclude_dirs="src/exception" + suppress="src/ToSuppress.res" +fi + +# Run analysis without shuffle (baseline) +baseline_output=$(mktemp) +dune exec rescript-editor-analysis -- reanalyze -dce -ci -exclude-paths $exclude_dirs -live-names globallyLive1 -live-names globallyLive2,globallyLive3 -suppress $suppress > "$baseline_output" 2>&1 + +# Run analysis with shuffle (3 times to increase confidence) +for i in 1 2 3; do + shuffled_output=$(mktemp) + dune exec rescript-editor-analysis -- reanalyze -dce -ci -test-shuffle -exclude-paths $exclude_dirs -live-names globallyLive1 -live-names globallyLive2,globallyLive3 -suppress $suppress > "$shuffled_output" 2>&1 + + # Compare outputs + if ! diff -q "$baseline_output" "$shuffled_output" > /dev/null 2>&1; then + printf "${warningYellow}⚠️ Order-independence test failed on iteration $i!${reset}\n" + printf "Baseline and shuffled outputs differ:\n" + diff "$baseline_output" "$shuffled_output" || true + rm -f "$baseline_output" "$shuffled_output" + exit 1 + fi + rm -f "$shuffled_output" +done + +rm -f "$baseline_output" +printf "${successGreen}✅ Order-independence test passed (3 shuffled runs matched baseline).${reset}\n" +