diff --git a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md index a4f6ec3081..2b8a0dc261 100644 --- a/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md +++ b/analysis/reanalyze/DEADCODE_REFACTOR_PLAN.md @@ -152,14 +152,14 @@ Each task should: - [x] ~~Use the `DceConfig.t` already created, thread it through DCE analysis functions~~ - [x] ~~Replace all DCE code's `!Common.Cli.debug`, `runConfig.transitive`, etc. reads with `config.debug`, `config.run.transitive`~~ - [x] ~~Make all config parameters required (not optional) - no `config option` anywhere~~ -- [ ] **Thread config through Exception and Arnold analyses** - they currently call `DceConfig.current()` at each use site -- [ ] **Single entry point**: Only `Reanalyze.runAnalysisAndReport` should call `DceConfig.current()` once, then pass explicit config everywhere +- [x] Thread config through Exception and Arnold analyses (no `DceConfig.current()` in analysis code) +- [x] Single entry point: only the CLI/entry wrappers (`runAnalysisAndReport`, `DceCommand`) call `DceConfig.current()` once, then pass explicit config everywhere -**Status**: DCE code complete ✅. Exception/Arnold still need threading. +**Status**: Complete ✅ (DCE + Exception + Arnold). **Test**: Create two configs with different settings, run analysis with each - should respect the config, not read globals. -**Estimated effort**: Medium (DCE done; Exception/Arnold similar effort) +**Estimated effort**: Medium (done) ### Task 3: Make `ProcessDeadAnnotations` state explicit (P3) @@ -262,13 +262,13 @@ Each task should: **Value**: Enforce purity - no hidden global reads. **Changes**: -- [ ] Verify `DceConfig.current()` only called in `Reanalyze.runAnalysisAndReport` (entry point) -- [ ] Verify no calls to `DceConfig.current()` in `Dead*.ml`, `Exception.ml`, `Arnold.ml` analysis code -- [ ] All analysis functions take explicit `~config` parameter +- [x] Verify `DceConfig.current()` only called in entry wrappers (CLI / `runAnalysisAndReport`) +- [x] Verify no calls to `DceConfig.current()` in `Dead*.ml`, `Exception.ml`, `Arnold.ml` analysis code +- [x] All analysis functions take explicit `~config` parameter -**Test**: `grep -r "DceConfig.current" analysis/reanalyze/src/{Dead,Exception,Arnold}.ml` returns zero results. +**Test**: `grep -r "DceConfig.current" analysis/reanalyze/src/{Dead,Exception,Arnold}.ml` returns zero results. ✅ -**Estimated effort**: Trivial (verification only, assuming Task 2 complete) +**Estimated effort**: Trivial (done) ### Task 11: Integration and order-independence verification diff --git a/analysis/reanalyze/src/Arnold.ml b/analysis/reanalyze/src/Arnold.ml index 36d01ca1d1..e065d0748d 100644 --- a/analysis/reanalyze/src/Arnold.ml +++ b/analysis/reanalyze/src/Arnold.ml @@ -107,11 +107,11 @@ module Stats = struct let logLoop () = incr nInfiniteLoops - let logCache ~functionCall ~hit ~loc = + let logCache ~config ~functionCall ~hit ~loc = incr nCacheChecks; if hit then incr nCacheHits; - if !Common.Cli.debug then - Log_.warning ~config:(DceConfig.current ()) ~forStats:false ~loc + if config.DceConfig.cli.debug then + Log_.warning ~config ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -123,9 +123,9 @@ module Stats = struct (FunctionCall.toString functionCall); }) - let logResult ~functionCall ~loc ~resString = - if !Common.Cli.debug then - Log_.warning ~config:(DceConfig.current ()) ~forStats:false ~loc + let logResult ~config ~functionCall ~loc ~resString = + if config.DceConfig.cli.debug then + Log_.warning ~config ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -591,7 +591,8 @@ module ExtendFunctionTable = struct if args |> List.for_all checkArg then Some (path, loc) else None | _ -> None - let traverseExpr ~functionTable ~progressFunctions ~valueBindingsTable = + let traverseExpr ~config ~functionTable ~progressFunctions ~valueBindingsTable + = let super = Tast_mapper.default in let expr (self : Tast_mapper.mapper) (e : Typedtree.expression) = (match e.exp_desc with @@ -609,8 +610,8 @@ module ExtendFunctionTable = struct if not (callee |> FunctionTable.isInFunctionInTable ~functionTable) then ( functionTable |> FunctionTable.addFunction ~functionName; - if !Common.Cli.debug then - Log_.warning ~config:(DceConfig.current ()) ~forStats:false ~loc + if config.DceConfig.cli.debug then + Log_.warning ~config ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -631,9 +632,8 @@ module ExtendFunctionTable = struct -> functionTable |> FunctionTable.addLabelToKind ~functionName ~label; - if !Common.Cli.debug then - Log_.warning ~config:(DceConfig.current ()) ~forStats:false - ~loc + if config.DceConfig.cli.debug then + Log_.warning ~config ~forStats:false ~loc (Termination { termination = TerminationAnalysisInternal; @@ -649,16 +649,16 @@ module ExtendFunctionTable = struct in {super with Tast_mapper.expr} - let run ~functionTable ~progressFunctions ~valueBindingsTable + let run ~config ~functionTable ~progressFunctions ~valueBindingsTable (expression : Typedtree.expression) = let traverseExpr = - traverseExpr ~functionTable ~progressFunctions ~valueBindingsTable + traverseExpr ~config ~functionTable ~progressFunctions ~valueBindingsTable in expression |> traverseExpr.expr traverseExpr |> ignore end module CheckExpressionWellFormed = struct - let traverseExpr ~functionTable ~valueBindingsTable = + let traverseExpr ~config ~functionTable ~valueBindingsTable = let super = Tast_mapper.default in let checkIdent ~path ~loc = if path |> FunctionTable.isInFunctionInTable ~functionTable then @@ -699,9 +699,8 @@ module CheckExpressionWellFormed = struct |> FunctionTable.addFunction ~functionName; functionTable |> FunctionTable.addLabelToKind ~functionName ~label; - if !Common.Cli.debug then - Log_.warning ~config:(DceConfig.current ()) - ~forStats:false ~loc:body.exp_loc + if config.DceConfig.cli.debug then + Log_.warning ~config ~forStats:false ~loc:body.exp_loc (Termination { termination = TerminationAnalysisInternal; @@ -719,14 +718,17 @@ module CheckExpressionWellFormed = struct in {super with Tast_mapper.expr} - let run ~functionTable ~valueBindingsTable (expression : Typedtree.expression) - = - let traverseExpr = traverseExpr ~functionTable ~valueBindingsTable in + let run ~config ~functionTable ~valueBindingsTable + (expression : Typedtree.expression) = + let traverseExpr = + traverseExpr ~config ~functionTable ~valueBindingsTable + in expression |> traverseExpr.expr traverseExpr |> ignore end module Compile = struct type ctx = { + config: DceConfig.t; currentFunctionName: FunctionName.t; functionTable: FunctionTable.t; innerRecursiveFunctions: (FunctionName.t, FunctionName.t) Hashtbl.t; @@ -734,7 +736,9 @@ module Compile = struct } let rec expression ~ctx (expr : Typedtree.expression) = - let {currentFunctionName; functionTable; isProgressFunction} = ctx in + let {config; currentFunctionName; functionTable; isProgressFunction} = + ctx + in let loc = expr.exp_loc in let notImplemented case = Log_.error ~loc @@ -874,8 +878,8 @@ module Compile = struct Hashtbl.replace ctx.innerRecursiveFunctions oldFunctionName newFunctionName; newFunctionDefinition.body <- Some (vb_expr |> expression ~ctx:newCtx); - if !Common.Cli.debug then - Log_.warning ~config:(DceConfig.current ()) ~forStats:false ~loc:pat_loc + if config.DceConfig.cli.debug then + Log_.warning ~config ~forStats:false ~loc:pat_loc (Termination { termination = TerminationAnalysisInternal; @@ -1069,8 +1073,9 @@ module Eval = struct let lookupCache ~functionCall (cache : cache) = Hashtbl.find_opt cache functionCall - let updateCache ~functionCall ~loc ~state (cache : cache) = - Stats.logResult ~functionCall ~resString:(state |> State.toString) ~loc; + let updateCache ~config ~functionCall ~loc ~state (cache : cache) = + Stats.logResult ~config ~functionCall ~resString:(state |> State.toString) + ~loc; if not (Hashtbl.mem cache functionCall) then Hashtbl.replace cache functionCall state @@ -1101,7 +1106,7 @@ module Eval = struct true) else false - let rec runFunctionCall ~cache ~callStack ~functionArgs ~functionTable + let rec runFunctionCall ~config ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn ~loc ~state functionCallToInstantiate : State.t = let pos = loc.Location.loc_start in let functionCall = @@ -1113,7 +1118,7 @@ module Eval = struct let stateAfterCall = match cache |> lookupCache ~functionCall with | Some stateAfterCall -> - Stats.logCache ~functionCall ~hit:true ~loc; + Stats.logCache ~config ~functionCall ~hit:true ~loc; { stateAfterCall with trace = Trace.Tcall (call, stateAfterCall.progress); @@ -1126,7 +1131,7 @@ module Eval = struct ~loc ~state then {state with trace = Trace.Tcall (call, state.progress)} else ( - Stats.logCache ~functionCall ~hit:false ~loc; + Stats.logCache ~config ~functionCall ~hit:false ~loc; let functionDefinition = functionTable |> FunctionTable.getFunctionDefinition ~functionName in @@ -1138,10 +1143,11 @@ module Eval = struct in let stateAfterCall = body - |> run ~cache ~callStack ~functionArgs:functionCall.functionArgs - ~functionTable ~madeProgressOn ~state:(State.init ()) + |> run ~config ~cache ~callStack + ~functionArgs:functionCall.functionArgs ~functionTable + ~madeProgressOn ~state:(State.init ()) in - cache |> updateCache ~functionCall ~loc ~state:stateAfterCall; + cache |> updateCache ~config ~functionCall ~loc ~state:stateAfterCall; (* Invariant: run should restore the callStack *) callStack |> CallStack.removeFunctionCall ~functionCall; let trace = Trace.Tcall (call, stateAfterCall.progress) in @@ -1149,12 +1155,12 @@ module Eval = struct in State.seq state stateAfterCall - and run ~(cache : cache) ~callStack ~functionArgs ~functionTable + and run ~config ~(cache : cache) ~callStack ~functionArgs ~functionTable ~madeProgressOn ~state (command : Command.t) : State.t = match command with | Call (FunctionCall functionCall, loc) -> functionCall - |> runFunctionCall ~cache ~callStack ~functionArgs ~functionTable + |> runFunctionCall ~config ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn ~loc ~state | Call ((ProgressFunction _ as call), _pos) -> let state1 = @@ -1179,7 +1185,7 @@ module Eval = struct | c :: nextCommands -> let state1 = c - |> run ~cache ~callStack ~functionArgs ~functionTable + |> run ~config ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn ~state in let madeProgressOn, callStack = @@ -1202,7 +1208,7 @@ module Eval = struct commands |> List.map (fun c -> c - |> run ~cache ~callStack ~functionArgs ~functionTable + |> run ~config ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn ~state:stateNoTrace) in State.seq state (states |> State.unorderedSequence) @@ -1213,36 +1219,36 @@ module Eval = struct commands |> List.map (fun c -> c - |> run ~cache ~callStack ~functionArgs ~functionTable + |> run ~config ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn ~state:stateNoTrace) in State.seq state (states |> State.nondet) | SwitchOption {functionCall; loc; some; none} -> ( let stateAfterCall = functionCall - |> runFunctionCall ~cache ~callStack ~functionArgs ~functionTable - ~madeProgressOn ~loc ~state + |> runFunctionCall ~config ~cache ~callStack ~functionArgs + ~functionTable ~madeProgressOn ~loc ~state in match stateAfterCall.valuesOpt with | None -> Command.nondet [some; none] - |> run ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn - ~state:stateAfterCall + |> run ~config ~cache ~callStack ~functionArgs ~functionTable + ~madeProgressOn ~state:stateAfterCall | Some values -> let runOpt c progressOpt = match progressOpt with | None -> State.init ~progress:Progress () | Some progress -> c - |> run ~cache ~callStack ~functionArgs ~functionTable + |> run ~config ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn ~state:(State.init ~progress ()) in let stateNone = values |> Values.getNone |> runOpt none in let stateSome = values |> Values.getSome |> runOpt some in State.seq stateAfterCall (State.nondet [stateSome; stateNone])) - let analyzeFunction ~cache ~functionTable ~loc functionName = - if !Common.Cli.debug then + let analyzeFunction ~config ~cache ~functionTable ~loc functionName = + if config.DceConfig.cli.debug then Log_.log "@[@,@{Termination Analysis@} for @{%s@}@]@." functionName; let pos = loc.Location.loc_start in @@ -1263,10 +1269,10 @@ module Eval = struct in let state = body - |> run ~cache ~callStack ~functionArgs ~functionTable + |> run ~config ~cache ~callStack ~functionArgs ~functionTable ~madeProgressOn:FunctionCallSet.empty ~state:(State.init ()) in - cache |> updateCache ~functionCall ~loc ~state + cache |> updateCache ~config ~functionCall ~loc ~state end let progressFunctionsFromAttributes attributes = @@ -1285,7 +1291,7 @@ let progressFunctionsFromAttributes attributes = | _ -> []) else None -let traverseAst ~valueBindingsTable = +let traverseAst ~config ~valueBindingsTable = let super = Tast_mapper.default in let value_bindings (self : Tast_mapper.mapper) (recFlag, valueBindings) = (* Update the table of value bindings for variables *) @@ -1352,12 +1358,13 @@ let traverseAst ~valueBindingsTable = recursiveDefinitions |> List.iter (fun (_, body) -> body - |> ExtendFunctionTable.run ~functionTable ~progressFunctions - ~valueBindingsTable); + |> ExtendFunctionTable.run ~config ~functionTable + ~progressFunctions ~valueBindingsTable); recursiveDefinitions |> List.iter (fun (_, body) -> body - |> CheckExpressionWellFormed.run ~functionTable ~valueBindingsTable); + |> CheckExpressionWellFormed.run ~config ~functionTable + ~valueBindingsTable); functionTable |> Hashtbl.iter (fun @@ -1376,17 +1383,19 @@ let traverseAst ~valueBindingsTable = |> Compile.expression ~ctx: { + config; currentFunctionName = functionName; functionTable; innerRecursiveFunctions = Hashtbl.create 1; isProgressFunction; })) ~functionName); - if !Common.Cli.debug then FunctionTable.dump functionTable; + if config.DceConfig.cli.debug then FunctionTable.dump functionTable; let cache = Eval.createCache () in functionsToAnalyze |> List.iter (fun (functionName, loc) -> - functionName |> Eval.analyzeFunction ~cache ~functionTable ~loc); + functionName + |> Eval.analyzeFunction ~config ~cache ~functionTable ~loc); Stats.newRecursiveFunctions ~numFunctions:(Hashtbl.length functionTable)); valueBindings |> List.iter (fun valueBinding -> @@ -1395,16 +1404,16 @@ let traverseAst ~valueBindingsTable = in {super with Tast_mapper.value_bindings} -let processStructure (structure : Typedtree.structure) = +let processStructure ~config (structure : Typedtree.structure) = Stats.newFile (); let valueBindingsTable = Hashtbl.create 1 in - let traverseAst = traverseAst ~valueBindingsTable in + let traverseAst = traverseAst ~config ~valueBindingsTable in structure |> traverseAst.structure traverseAst |> ignore -let processCmt (cmt_infos : Cmt_format.cmt_infos) = +let processCmt ~config (cmt_infos : Cmt_format.cmt_infos) = match cmt_infos.cmt_annots with | Interface _ -> () - | Implementation structure -> processStructure structure + | Implementation structure -> processStructure ~config structure | _ -> () -let reportStats () = Stats.dump ~ppf:Format.std_formatter +let reportStats ~config:_ = Stats.dump ~ppf:Format.std_formatter diff --git a/analysis/reanalyze/src/Exception.ml b/analysis/reanalyze/src/Exception.ml index de54d583c0..0bca11a9b0 100644 --- a/analysis/reanalyze/src/Exception.ml +++ b/analysis/reanalyze/src/Exception.ml @@ -101,8 +101,8 @@ module Event = struct nestedEvents |> List.iter (fun e -> Format.fprintf ppf "%a " print e)) () - let combine ~moduleName events = - if !Common.Cli.debug then ( + let combine ~config ~moduleName events = + if config.DceConfig.cli.debug then ( Log_.item "@."; Log_.item "Events combine: #events %d@." (events |> List.length)); let exnTable = Hashtbl.create 1 in @@ -119,11 +119,11 @@ module Event = struct let rec loop exnSet events = match events with | ({kind = Throws; exceptions; loc} as ev) :: rest -> - if !Common.Cli.debug then Log_.item "%a@." print ev; + if config.DceConfig.cli.debug then Log_.item "%a@." print ev; exceptions |> Exceptions.iter (fun exn -> extendExnTable exn loc); loop (Exceptions.union exnSet exceptions) rest | ({kind = Call {callee; modulePath}; loc} as ev) :: rest -> - if !Common.Cli.debug then Log_.item "%a@." print ev; + if config.DceConfig.cli.debug then Log_.item "%a@." print ev; let exceptions = match callee |> Values.findPath ~moduleName ~modulePath with | Some exceptions -> exceptions @@ -135,7 +135,7 @@ module Event = struct exceptions |> Exceptions.iter (fun exn -> extendExnTable exn loc); loop (Exceptions.union exnSet exceptions) rest | ({kind = DoesNotThrow nestedEvents; loc} as ev) :: rest -> - if !Common.Cli.debug then Log_.item "%a@." print ev; + if config.DceConfig.cli.debug then Log_.item "%a@." print ev; let nestedExceptions = loop Exceptions.empty nestedEvents in (if Exceptions.isEmpty nestedExceptions (* catch-all *) then let name = @@ -143,7 +143,7 @@ module Event = struct | {kind = Call {callee}} :: _ -> callee |> Common.Path.toName | _ -> "expression" |> Name.create in - Log_.warning ~config:(DceConfig.current ()) ~loc + Log_.warning ~config ~loc (Common.ExceptionAnalysis { message = @@ -154,7 +154,7 @@ module Event = struct })); loop exnSet rest | ({kind = Catches nestedEvents; exceptions} as ev) :: rest -> - if !Common.Cli.debug then Log_.item "%a@." print ev; + if config.DceConfig.cli.debug then Log_.item "%a@." print ev; if Exceptions.isEmpty exceptions then loop exnSet rest else let nestedExceptions = loop Exceptions.empty nestedEvents in @@ -187,8 +187,8 @@ module Checks = struct let add ~events ~exceptions ~loc ?(locFull = loc) ~moduleName exnName = checks := {events; exceptions; loc; locFull; moduleName; exnName} :: !checks - let doCheck {events; exceptions; loc; locFull; moduleName; exnName} = - let throwSet, exnTable = events |> Event.combine ~moduleName in + let doCheck ~config {events; exceptions; loc; locFull; moduleName; exnName} = + let throwSet, exnTable = events |> Event.combine ~config ~moduleName in let missingAnnotations = Exceptions.diff throwSet exceptions in let redundantAnnotations = Exceptions.diff exceptions throwSet in (if not (Exceptions.isEmpty missingAnnotations) then @@ -196,9 +196,9 @@ module Checks = struct Common.ExceptionAnalysisMissing {exnName; exnTable; throwSet; missingAnnotations; locFull} in - Log_.warning ~config:(DceConfig.current ()) ~loc description); + Log_.warning ~config ~loc description); if not (Exceptions.isEmpty redundantAnnotations) then - Log_.warning ~config:(DceConfig.current ()) ~loc + Log_.warning ~config ~loc (Common.ExceptionAnalysis { message = @@ -217,10 +217,10 @@ module Checks = struct redundantAnnotations); }) - let doChecks () = !checks |> List.rev |> List.iter doCheck + let doChecks ~config = !checks |> List.rev |> List.iter (doCheck ~config) end -let traverseAst () = +let traverseAst ~config () = ModulePath.init (); let super = Tast_mapper.default in let currentId = ref "" in @@ -281,7 +281,7 @@ let traverseAst () = in let calleeName = callee |> Common.Path.toName in if calleeName |> Name.toString |> isThrow then - Log_.warning ~config:(DceConfig.current ()) ~loc + Log_.warning ~config ~loc (Common.ExceptionAnalysis { message = @@ -474,14 +474,14 @@ let traverseAst () = let open Tast_mapper in {super with expr; value_binding; structure_item} -let processStructure (structure : Typedtree.structure) = - let traverseAst = traverseAst () in +let processStructure ~config (structure : Typedtree.structure) = + let traverseAst = traverseAst ~config () in structure |> traverseAst.structure traverseAst |> ignore -let processCmt (cmt_infos : Cmt_format.cmt_infos) = +let processCmt ~config (cmt_infos : Cmt_format.cmt_infos) = match cmt_infos.cmt_annots with | Interface _ -> () | Implementation structure -> Values.newCmt (); - structure |> processStructure + structure |> processStructure ~config | _ -> () diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml index a53e52dd60..6000549a73 100644 --- a/analysis/reanalyze/src/Reanalyze.ml +++ b/analysis/reanalyze/src/Reanalyze.ml @@ -33,8 +33,10 @@ let loadCmtFile ~config cmtFilePath = |> Name.create ~isInterface:(Filename.check_suffix !currentSrc "i"); if config.DceConfig.run.dce then cmt_infos |> DeadCode.processCmt ~config ~cmtFilePath; - if runConfig.exception_ then cmt_infos |> Exception.processCmt; - if runConfig.termination then cmt_infos |> Arnold.processCmt + if config.DceConfig.run.exception_ then + cmt_infos |> Exception.processCmt ~config; + if config.DceConfig.run.termination then + cmt_infos |> Arnold.processCmt ~config | _ -> () let processCmtFiles ~config ~cmtRoot = @@ -94,8 +96,10 @@ let runAnalysis ~dce_config ~cmtRoot = DeadCommon.reportDead ~config:dce_config ~checkOptionalArg:DeadOptionalArgs.check; WriteDeadAnnotations.write ~config:dce_config); - if runConfig.exception_ then Exception.Checks.doChecks (); - if runConfig.termination && !Common.Cli.debug then Arnold.reportStats () + if dce_config.DceConfig.run.exception_ then + Exception.Checks.doChecks ~config:dce_config; + if dce_config.DceConfig.run.termination && dce_config.DceConfig.cli.debug then + Arnold.reportStats ~config:dce_config let runAnalysisAndReport ~cmtRoot = Log_.Color.setup ();