Refactor Exception analysis to eliminate global mutable state

- Replace global Values.valueBindingsTable with per-file values_builder
- Replace global Checks.checks with per-file checks_builder
- processCmt now returns file_result with per-file data
- Add runChecks to process all checks after merging values tables
- Update Reanalyze.ml to collect exception results and run checks at end
- This enables future parallelization of AST processing

Author: cristianoc

analysis/reanalyze/src/Exception.ml

@@ -1,46 +1,54 @@
 open DeadCommon
 
-module Values = struct
-  let valueBindingsTable =
-    (Hashtbl.create 15 : (string, (Name.t, Exceptions.t) Hashtbl.t) Hashtbl.t)
+(** Per-file mutable builder for exception values during AST processing *)
+type values_builder = (Name.t, Exceptions.t) Hashtbl.t
+
+(** Merged immutable table for cross-file lookups *)
+type values_table = (string, (Name.t, Exceptions.t) Hashtbl.t) Hashtbl.t
+
+let create_values_builder () : values_builder = Hashtbl.create 15
 
-  let currentFileTable = ref (Hashtbl.create 1)
+let values_builder_add (builder : values_builder) ~modulePath ~name exceptions =
+  let path = (name |> Name.create) :: modulePath.ModulePath.path in
+  Hashtbl.replace builder (path |> DcePath.toName) exceptions
 
-  let add ~modulePath ~name exceptions =
-    let path = (name |> Name.create) :: modulePath.ModulePath.path in
-    Hashtbl.replace !currentFileTable (path |> DcePath.toName) exceptions
+(** Merge all per-file builders into a single lookup table *)
+let merge_values_builders (builders : (string * values_builder) list) :
+    values_table =
+  let table = Hashtbl.create 15 in
+  builders
+  |> List.iter (fun (moduleName, builder) ->
+         Hashtbl.replace table moduleName builder);
+  table
 
-  let getFromModule ~moduleName ~modulePath (path_ : DcePath.t) =
+module Values = struct
+  let getFromModule (table : values_table) ~moduleName ~modulePath
+      (path_ : DcePath.t) =
     let name = path_ @ modulePath |> DcePath.toName in
-    match
-      Hashtbl.find_opt valueBindingsTable (String.capitalize_ascii moduleName)
-    with
+    match Hashtbl.find_opt table (String.capitalize_ascii moduleName) with
     | Some tbl -> Hashtbl.find_opt tbl name
     | None -> (
-      match
-        Hashtbl.find_opt valueBindingsTable
-          (String.uncapitalize_ascii moduleName)
-      with
+      match Hashtbl.find_opt table (String.uncapitalize_ascii moduleName) with
       | Some tbl -> Hashtbl.find_opt tbl name
       | None -> None)
 
-  let rec findLocal ~moduleName ~modulePath path =
-    match path |> getFromModule ~moduleName ~modulePath with
+  let rec findLocal (table : values_table) ~moduleName ~modulePath path =
+    match path |> getFromModule table ~moduleName ~modulePath with
     | Some exceptions -> Some exceptions
     | None -> (
       match modulePath with
       | [] -> None
       | _ :: restModulePath ->
-        path |> findLocal ~moduleName ~modulePath:restModulePath)
+        path |> findLocal table ~moduleName ~modulePath:restModulePath)
 
-  let findPath ~moduleName ~modulePath path =
+  let findPath (table : values_table) ~moduleName ~modulePath path =
     let findExternal ~externalModuleName ~pathRev =
       pathRev |> List.rev
-      |> getFromModule
+      |> getFromModule table
            ~moduleName:(externalModuleName |> Name.toString)
            ~modulePath:[]
     in
-    match path |> findLocal ~moduleName ~modulePath with
+    match path |> findLocal table ~moduleName ~modulePath with
     | None -> (
       (* Search in another file *)
       match path |> List.rev with
@@ -54,10 +62,6 @@ module Values = struct
         | None, _ -> None)
       | [] -> None)
     | Some exceptions -> Some exceptions
-
-  let newCmt ~moduleName =
-    currentFileTable := Hashtbl.create 15;
-    Hashtbl.replace valueBindingsTable moduleName !currentFileTable
 end
 
 module Event = struct
@@ -99,7 +103,7 @@ module Event = struct
           nestedEvents |> List.iter (fun e -> Format.fprintf ppf "%a " print e))
         ()
 
-  let combine ~config ~moduleName events =
+  let combine ~(values_table : values_table) ~config ~moduleName events =
     if config.DceConfig.cli.debug then (
       Log_.item "@.";
       Log_.item "Events combine: #events %d@." (events |> List.length));
@@ -123,7 +127,9 @@ module Event = struct
       | ({kind = Call {callee; modulePath}; loc} as ev) :: rest ->
         if config.DceConfig.cli.debug then Log_.item "%a@." print ev;
         let exceptions =
-          match callee |> Values.findPath ~moduleName ~modulePath with
+          match
+            callee |> Values.findPath values_table ~moduleName ~modulePath
+          with
           | Some exceptions -> exceptions
           | _ -> (
             match ExnLib.find callee with
@@ -168,25 +174,33 @@ module Event = struct
     (exnSet, exnTable)
 end
 
-module Checks = struct
-  type check = {
-    events: Event.t list;
-    loc: Location.t;
-    locFull: Location.t;
-    moduleName: string;
-    exnName: string;
-    exceptions: Exceptions.t;
-  }
+(** Per-file mutable builder for checks during AST processing *)
+type checks_builder = check list ref
+
+and check = {
+  events: Event.t list;
+  loc: Location.t;
+  locFull: Location.t;
+  moduleName: string;
+  exnName: string;
+  exceptions: Exceptions.t;
+}
 
-  type t = check list
+let create_checks_builder () : checks_builder = ref []
 
-  let checks = (ref [] : t ref)
+let checks_builder_add (builder : checks_builder) ~events ~exceptions ~loc
+    ?(locFull = loc) ~moduleName exnName =
+  builder := {events; exceptions; loc; locFull; moduleName; exnName} :: !builder
 
-  let add ~events ~exceptions ~loc ?(locFull = loc) ~moduleName exnName =
-    checks := {events; exceptions; loc; locFull; moduleName; exnName} :: !checks
+let checks_builder_to_list (builder : checks_builder) : check list =
+  !builder |> List.rev
 
-  let doCheck ~config {events; exceptions; loc; locFull; moduleName; exnName} =
-    let throwSet, exnTable = events |> Event.combine ~config ~moduleName in
+module Checks = struct
+  let doCheck ~(values_table : values_table) ~config
+      {events; exceptions; loc; locFull; moduleName; exnName} =
+    let throwSet, exnTable =
+      events |> Event.combine ~values_table ~config ~moduleName
+    in
     let missingAnnotations = Exceptions.diff throwSet exceptions in
     let redundantAnnotations = Exceptions.diff exceptions throwSet in
     (if not (Exceptions.isEmpty missingAnnotations) then
@@ -215,13 +229,28 @@ module Checks = struct
                   redundantAnnotations);
            })
 
-  let doChecks ~config = !checks |> List.rev |> List.iter (doCheck ~config)
+  let doChecks ~values_table ~config (checks : check list) =
+    checks |> List.iter (doCheck ~values_table ~config)
 end
 
-let traverseAst ~file () =
+let traverseAst ~file ~values_builder ~checks_builder () =
   let super = Tast_mapper.default in
   let currentId = ref "" in
   let currentEvents = ref [] in
+  (* For local lookups during AST processing, we look up in the current file's builder *)
+  let findLocalExceptions ~modulePath path =
+    let name = path @ modulePath |> DcePath.toName in
+    Hashtbl.find_opt values_builder name
+  in
+  let rec findLocalPath ~modulePath path =
+    match path |> findLocalExceptions ~modulePath with
+    | Some exceptions -> Some exceptions
+    | None -> (
+      match modulePath with
+      | [] -> None
+      | _ :: restModulePath ->
+        path |> findLocalPath ~modulePath:restModulePath)
+  in
   let exceptionsOfPatterns patterns =
     patterns
     |> List.fold_left
@@ -394,7 +423,7 @@ let traverseAst ~file () =
     currentEvents := [];
     let moduleName = file.FileContext.module_name in
     self.expr self expr |> ignore;
-    Checks.add ~events:!currentEvents
+    checks_builder_add checks_builder ~events:!currentEvents
       ~exceptions:(getExceptionsFromAnnotations attributes)
       ~loc:expr.exp_loc ~moduleName name;
     currentId := oldId;
@@ -416,19 +445,18 @@ let traverseAst ~file () =
       let exceptionsFromAnnotations =
         getExceptionsFromAnnotations vb.vb_attributes
       in
-      exceptionsFromAnnotations |> Values.add ~modulePath ~name;
+      values_builder_add values_builder ~modulePath ~name
+        exceptionsFromAnnotations;
       let res = super.value_binding self vb in
       let moduleName = file.FileContext.module_name in
       let path = [name |> Name.create] in
       let exceptions =
-        match
-          path |> Values.findPath ~moduleName ~modulePath:modulePath.path
-        with
+        match path |> findLocalPath ~modulePath:modulePath.path with
         | Some exceptions -> exceptions
         | _ -> Exceptions.empty
       in
-      Checks.add ~events:!currentEvents ~exceptions ~loc:vb.vb_pat.pat_loc
-        ~locFull:vb.vb_loc ~moduleName name;
+      checks_builder_add checks_builder ~events:!currentEvents ~exceptions
+        ~loc:vb.vb_pat.pat_loc ~locFull:vb.vb_loc ~moduleName name;
       currentId := oldId;
       currentEvents := oldEvents;
       res
@@ -509,14 +537,42 @@ let traverseAst ~file () =
   fun (structure : Typedtree.structure) ->
     process_structure ModulePath.initial structure
 
-let processStructure ~file (structure : Typedtree.structure) =
-  let process = traverseAst ~file () in
+(** Result of processing a single file *)
+type file_result = {
+  module_name: string;
+  values_builder: values_builder;
+  checks: check list;
+}
+
+let processStructure ~file ~values_builder ~checks_builder
+    (structure : Typedtree.structure) =
+  let process = traverseAst ~file ~values_builder ~checks_builder () in
   process structure
 
-let processCmt ~file (cmt_infos : Cmt_format.cmt_infos) =
+let processCmt ~file (cmt_infos : Cmt_format.cmt_infos) : file_result option =
   match cmt_infos.cmt_annots with
-  | Interface _ -> ()
+  | Interface _ -> None
   | Implementation structure ->
-    Values.newCmt ~moduleName:file.FileContext.module_name;
-    structure |> processStructure ~file
-  | _ -> ()
+    let values_builder = create_values_builder () in
+    let checks_builder = create_checks_builder () in
+    structure |> processStructure ~file ~values_builder ~checks_builder;
+    Some
+      {
+        module_name = file.FileContext.module_name;
+        values_builder;
+        checks = checks_builder_to_list checks_builder;
+      }
+  | _ -> None
+
+(** Process all accumulated checks using merged values table *)
+let runChecks ~config (all_results : file_result list) =
+  (* Merge all values builders *)
+  let values_table =
+    all_results
+    |> List.map (fun r -> (r.module_name, r.values_builder))
+    |> merge_values_builders
+  in
+  (* Collect all checks *)
+  let all_checks = all_results |> List.concat_map (fun r -> r.checks) in
+  (* Run checks with merged table *)
+  Checks.doChecks ~values_table ~config all_checks