DCE: Make ProcessDeadAnnotations state explicit

cristianoc · cristianoc · commit 5066e281c960 · 2025-12-07T04:42:15.000+01:00
- Create AnnotationState module with explicit state type and accessor functions
- Thread annotation_state through DeadCode.processCmt and Reanalyze pipeline
- Update declIsDead, doReportDead, resolveRecursiveRefs to use explicit state
- Update DeadOptionalArgs.check to take explicit state
- Remove global positionsAnnotated hashtable from ProcessDeadAnnotations
- Remove unused ~config parameter from iterFilesFromRootsToLeaves

Note: Current implementation still mixes input (source annotations) with
output (analysis results). This will be properly separated in Task 8.
diff --git a/analysis/reanalyze/src/DeadCode.ml b/analysis/reanalyze/src/DeadCode.ml
@@ -9,17 +9,18 @@ let processSignature ~config ~file ~doValues ~doTypes
            ~path:[FileContext.module_name_tagged file]
            sig_item)
 
-let processCmt ~config ~file ~cmtFilePath (cmt_infos : Cmt_format.cmt_infos) =
+let processCmt ~state ~config ~file ~cmtFilePath
+    (cmt_infos : Cmt_format.cmt_infos) =
   (match cmt_infos.cmt_annots with
   | Interface signature ->
-    ProcessDeadAnnotations.signature ~config signature;
+    ProcessDeadAnnotations.signature ~state ~config signature;
     processSignature ~config ~file ~doValues:true ~doTypes:true
       signature.sig_type
   | Implementation structure ->
     let cmtiExists =
       Sys.file_exists ((cmtFilePath |> Filename.remove_extension) ^ ".cmti")
     in
-    ProcessDeadAnnotations.structure ~config ~doGenType:(not cmtiExists)
+    ProcessDeadAnnotations.structure ~state ~config ~doGenType:(not cmtiExists)
       structure;
     processSignature ~config ~file ~doValues:true ~doTypes:false
       structure.str_type;
diff --git a/analysis/reanalyze/src/DeadCommon.ml b/analysis/reanalyze/src/DeadCommon.ml
@@ -55,6 +55,35 @@ module PosHash = struct
     replace h k (PosSet.add v set)
 end
 
+(** State tracking positions annotated as @dead, @live, or @genType *)
+module AnnotationState = struct
+  type annotated_as = GenType | Dead | Live
+  type t = annotated_as PosHash.t
+
+  let create () : t = PosHash.create 1
+
+  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
+
+  let annotate_gentype (state : t) (pos : Lexing.position) =
+    PosHash.replace state pos GenType
+
+  let annotate_dead (state : t) (pos : Lexing.position) =
+    PosHash.replace state pos Dead
+
+  let annotate_live (state : t) (pos : Lexing.position) =
+    PosHash.replace state pos Live
+end
+
 type decls = decl PosHash.t
 (** all exported declarations *)
 
@@ -114,7 +143,7 @@ let addValueReference ~config ~(binding : Location.t) ~addFileReference
       && effectiveFrom.loc_start.pos_fname <> locTo.loc_start.pos_fname
     then FileReferences.add effectiveFrom locTo)
 
-let iterFilesFromRootsToLeaves ~config iterFun =
+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 *)
@@ -189,43 +218,19 @@ let iterFilesFromRootsToLeaves ~config iterFun =
                          });
                   iterFun fileName))
 
-(** Keep track of the location of values annotated @genType or @dead *)
+(** Process AST to collect locations annotated @genType, @dead, or @live *)
 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 ~config ~doGenType ~name ~pos attributes =
+  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 pos |> annotateGenType;
+    then AnnotationState.annotate_gentype state pos;
     if getPayload WriteDeadAnnotations.deadAnnotation <> None then
-      pos |> annotateDead;
+      AnnotationState.annotate_dead state pos;
     let nameIsInLiveNamesOrPaths () =
       config.DceConfig.cli.live_names |> List.mem name
       ||
@@ -243,21 +248,23 @@ module ProcessDeadAnnotations = struct
              with Invalid_argument _ -> false)
     in
     if getPayload liveAnnotation <> None || nameIsInLiveNamesOrPaths () then
-      pos |> annotateLive;
+      AnnotationState.annotate_live state pos;
     if attributes |> Annotation.isOcamlSuppressDeadWarning then
-      pos |> annotateLive
+      AnnotationState.annotate_live state pos
 
-  let collectExportLocations ~config ~doGenType =
+  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 pos |> annotateLive;
+        if !currentlyDisableWarnings then
+          AnnotationState.annotate_live state pos;
         vb_attributes
-        |> processAttributes ~config ~doGenType ~name:(id |> Ident.name) ~pos
+        |> processAttributes ~state ~config ~doGenType ~name:(id |> Ident.name)
+             ~pos
       | _ -> ());
       super.value_binding self value_binding
     in
@@ -268,7 +275,7 @@ module ProcessDeadAnnotations = struct
         |> List.iter
              (fun ({ld_attributes; ld_loc} : Typedtree.label_declaration) ->
                toplevelAttrs @ ld_attributes
-               |> processAttributes ~config ~doGenType:false ~name:""
+               |> processAttributes ~state ~config ~doGenType:false ~name:""
                     ~pos:ld_loc.loc_start)
       | Ttype_variant constructorDeclarations ->
         constructorDeclarations
@@ -284,13 +291,13 @@ module ProcessDeadAnnotations = struct
                      (fun ({ld_attributes; ld_loc} :
                             Typedtree.label_declaration) ->
                        toplevelAttrs @ cd_attributes @ ld_attributes
-                       |> processAttributes ~config ~doGenType:false ~name:""
-                            ~pos:ld_loc.loc_start)
+                       |> processAttributes ~state ~config ~doGenType:false
+                            ~name:"" ~pos:ld_loc.loc_start)
                      flds
                  | Cstr_tuple _ -> ()
                in
                toplevelAttrs @ cd_attributes
-               |> processAttributes ~config ~doGenType:false ~name:""
+               |> processAttributes ~state ~config ~doGenType:false ~name:""
                     ~pos:cd_loc.loc_start)
       | _ -> ());
       super.type_kind self typeKind
@@ -304,9 +311,10 @@ module ProcessDeadAnnotations = struct
         ({val_attributes; val_id; val_val = {val_loc = {loc_start = pos}}} as
          value_description :
           Typedtree.value_description) =
-      if !currentlyDisableWarnings then pos |> annotateLive;
+      if !currentlyDisableWarnings then AnnotationState.annotate_live state pos;
       val_attributes
-      |> processAttributes ~config ~doGenType ~name:(val_id |> Ident.name) ~pos;
+      |> 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) =
@@ -348,15 +356,17 @@ module ProcessDeadAnnotations = struct
       value_description;
     }
 
-  let structure ~config ~doGenType structure =
-    let collectExportLocations = collectExportLocations ~config ~doGenType in
+  let structure ~state ~config ~doGenType structure =
+    let collectExportLocations =
+      collectExportLocations ~state ~config ~doGenType
+    in
     structure
     |> collectExportLocations.structure collectExportLocations
     |> ignore
 
-  let signature ~config signature =
+  let signature ~state ~config signature =
     let collectExportLocations =
-      collectExportLocations ~config ~doGenType:true
+      collectExportLocations ~state ~config ~doGenType:true
     in
     signature
     |> collectExportLocations.signature collectExportLocations
@@ -579,17 +589,18 @@ module Decl = struct
         emitWarning ~config ~decl ~message name)
 end
 
-let declIsDead ~refs decl =
+let declIsDead ~state ~refs decl =
   let liveRefs =
     refs
-    |> PosSet.filter (fun p -> not (ProcessDeadAnnotations.isAnnotatedDead p))
+    |> PosSet.filter (fun p -> not (AnnotationState.is_annotated_dead state p))
   in
   liveRefs |> PosSet.cardinal = 0
-  && not (ProcessDeadAnnotations.isAnnotatedGenTypeOrLive decl.pos)
+  && not (AnnotationState.is_annotated_gentype_or_live state decl.pos)
 
-let doReportDead pos = not (ProcessDeadAnnotations.isAnnotatedGenTypeOrDead pos)
+let doReportDead ~state pos =
+  not (AnnotationState.is_annotated_gentype_or_dead state pos)
 
-let rec resolveRecursiveRefs ~config
+let rec resolveRecursiveRefs ~state ~config
     ~checkOptionalArg:(checkOptionalArgFn : config:DceConfig.t -> decl -> unit)
     ~deadDeclarations ~level ~orderedFiles ~refs ~refsBeingResolved decl : bool
     =
@@ -599,7 +610,7 @@ let rec resolveRecursiveRefs ~config
       Log_.item "recursiveDebug %s [%d] already resolved@."
         (decl.path |> Path.toString)
         level;
-    decl.pos |> ProcessDeadAnnotations.isAnnotatedDead
+    AnnotationState.is_annotated_dead state decl.pos
   | _ when PosSet.mem decl.pos !refsBeingResolved ->
     if Config.recursiveDebug then
       Log_.item "recursiveDebug %s [%d] is being resolved: assume dead@."
@@ -636,15 +647,15 @@ let rec resolveRecursiveRefs ~config
                  in
                  let xDeclIsDead =
                    xDecl
-                   |> resolveRecursiveRefs ~config
+                   |> resolveRecursiveRefs ~state ~config
                         ~checkOptionalArg:checkOptionalArgFn ~deadDeclarations
                         ~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 ~state ~refs:newRefs in
     let isResolved = (not isDead) || !allDepsResolved || level = 0 in
     if isResolved then (
       decl.resolvedDead <- Some isDead;
@@ -653,17 +664,17 @@ let rec resolveRecursiveRefs ~config
         |> DeadModules.markDead ~config
              ~isType:(decl.declKind |> DeclKind.isType)
              ~loc:decl.moduleLoc;
-        if not (decl.pos |> doReportDead) then decl.report <- false;
+        if not (doReportDead ~state decl.pos) then decl.report <- false;
         deadDeclarations := decl :: !deadDeclarations;
         if not (Decl.isToplevelValueWithSideEffects decl) then
-          decl.pos |> ProcessDeadAnnotations.annotateDead)
+          AnnotationState.annotate_dead state decl.pos)
       else (
         checkOptionalArgFn ~config decl;
         decl.path
         |> DeadModules.markLive ~config
              ~isType:(decl.declKind |> DeclKind.isType)
              ~loc:decl.moduleLoc;
-        if decl.pos |> ProcessDeadAnnotations.isAnnotatedDead then
+        if AnnotationState.is_annotated_dead state decl.pos then
           emitWarning ~config ~decl ~message:" is annotated @dead but is live"
             IncorrectDeadAnnotation);
       if config.DceConfig.cli.debug then
@@ -681,16 +692,18 @@ let rec resolveRecursiveRefs ~config
           refsString level);
     isDead
 
-let reportDead ~config
-    ~checkOptionalArg:(checkOptionalArgFn : config:DceConfig.t -> decl -> unit)
-    =
+let reportDead ~state ~config
+    ~checkOptionalArg:
+      (checkOptionalArgFn :
+        state:AnnotationState.t -> config:DceConfig.t -> decl -> unit) =
   let iterDeclInOrder ~deadDeclarations ~orderedFiles decl =
     let refs =
       match decl |> Decl.isValue with
       | true -> ValueReferences.find decl.pos
       | false -> TypeReferences.find decl.pos
     in
-    resolveRecursiveRefs ~config ~checkOptionalArg:checkOptionalArgFn
+    resolveRecursiveRefs ~state ~config
+      ~checkOptionalArg:(checkOptionalArgFn ~state)
       ~deadDeclarations ~level:0 ~orderedFiles
       ~refsBeingResolved:(ref PosSet.empty) ~refs decl
     |> ignore
@@ -711,7 +724,7 @@ let reportDead ~config
     PosHash.fold (fun _pos decl declarations -> decl :: declarations) decls []
   in
   let orderedFiles = Hashtbl.create 256 in
-  iterFilesFromRootsToLeaves ~config
+  iterFilesFromRootsToLeaves
     (let current = ref 0 in
      fun fileName ->
        incr current;
diff --git a/analysis/reanalyze/src/DeadOptionalArgs.ml b/analysis/reanalyze/src/DeadOptionalArgs.ml
@@ -81,11 +81,11 @@ let forceDelayedItems () =
            OptionalArgs.combine rFrom.optionalArgs rTo.optionalArgs
          | _ -> ())
 
-let check ~config:_ decl =
+let check ~state ~config:_ decl =
   match decl with
   | {declKind = Value {optionalArgs}}
     when active ()
-         && not (ProcessDeadAnnotations.isAnnotatedGenTypeOrLive decl.pos) ->
+         && not (AnnotationState.is_annotated_gentype_or_live state decl.pos) ->
     optionalArgs
     |> OptionalArgs.iterUnused (fun s ->
            Log_.warning ~loc:(decl |> declGetLoc)
diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml
@@ -1,6 +1,6 @@
 open Common
 
-let loadCmtFile ~config cmtFilePath =
+let loadCmtFile ~annotation_state ~config cmtFilePath =
   let cmt_infos = Cmt_format.read_cmt cmtFilePath in
   let excludePath sourceFile =
     config.DceConfig.cli.exclude_paths
@@ -37,14 +37,16 @@ let loadCmtFile ~config cmtFilePath =
         | false -> sourceFile);
     FileReferences.addFile sourceFile;
     if config.DceConfig.run.dce then
-      cmt_infos |> DeadCode.processCmt ~config ~file:file_context ~cmtFilePath;
+      cmt_infos
+      |> DeadCode.processCmt ~state:annotation_state ~config ~file:file_context
+           ~cmtFilePath;
     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
   | _ -> ()
 
-let processCmtFiles ~config ~cmtRoot =
+let processCmtFiles ~annotation_state ~config ~cmtRoot =
   let ( +++ ) = Filename.concat in
   match cmtRoot with
   | Some root ->
@@ -65,7 +67,7 @@ let processCmtFiles ~config ~cmtRoot =
         else if
           Filename.check_suffix absDir ".cmt"
           || Filename.check_suffix absDir ".cmti"
-        then absDir |> loadCmtFile ~config
+        then absDir |> loadCmtFile ~annotation_state ~config
     in
     walkSubDirs ""
   | None ->
@@ -91,14 +93,15 @@ let processCmtFiles ~config ~cmtRoot =
            cmtFiles |> List.sort String.compare
            |> List.iter (fun cmtFile ->
                   let cmtFilePath = Filename.concat libBsSourceDir cmtFile in
-                  cmtFilePath |> loadCmtFile ~config))
+                  cmtFilePath |> loadCmtFile ~annotation_state ~config))
 
 let runAnalysis ~dce_config ~cmtRoot =
-  processCmtFiles ~config:dce_config ~cmtRoot;
+  let annotation_state = DeadCommon.AnnotationState.create () in
+  processCmtFiles ~annotation_state ~config:dce_config ~cmtRoot;
   if dce_config.DceConfig.run.dce then (
     DeadException.forceDelayedItems ~config:dce_config;
     DeadOptionalArgs.forceDelayedItems ();
-    DeadCommon.reportDead ~config:dce_config
+    DeadCommon.reportDead ~state:annotation_state ~config:dce_config
       ~checkOptionalArg:DeadOptionalArgs.check;
     WriteDeadAnnotations.write ~config:dce_config);
   if dce_config.DceConfig.run.exception_ then
