Fix incorrect analysis report for optional function args

CHANGELOG.md

@@ -20,6 +20,8 @@
 
 #### :bug: Bug fix
 
+- Fix reanalyze optional-argument diagnostics for functions passed or returned as first-class values. https://github.com/rescript-lang/rescript/pull/8321
+
 #### :memo: Documentation
 
 #### :nail_care: Polish

analysis/reanalyze/src/cross_file_items.ml

@@ -16,24 +16,36 @@ type optional_arg_call = {
 
 type function_ref = {pos_from: Lexing.position; pos_to: Lexing.position}
 
+type optional_arg_value_escape = {
+  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;
+  optional_arg_value_escapes: optional_arg_value_escape list;
 }
 
 type builder = {
   mutable exception_refs: exception_ref list;
   mutable optional_arg_calls: optional_arg_call list;
   mutable function_refs: function_ref list;
+  mutable optional_arg_value_escapes: optional_arg_value_escape list;
 }
 
 (** {2 Builder API} *)
 
 let create_builder () : builder =
-  {exception_refs = []; optional_arg_calls = []; function_refs = []}
+  {
+    exception_refs = [];
+    optional_arg_calls = [];
+    function_refs = [];
+    optional_arg_value_escapes = [];
+  }
 
 let add_exception_ref (b : builder) ~exception_path ~loc_from =
   b.exception_refs <- {exception_path; loc_from} :: b.exception_refs
@@ -46,6 +58,10 @@ let add_optional_arg_call (b : builder) ~pos_from ~pos_to ~arg_names
 let add_function_reference (b : builder) ~pos_from ~pos_to =
   b.function_refs <- {pos_from; pos_to} :: b.function_refs
 
+let add_optional_arg_value_escape (b : builder) ~pos_from ~pos_to =
+  b.optional_arg_value_escapes <-
+    {pos_from; pos_to} :: b.optional_arg_value_escapes
+
 (** {2 Merge API} *)
 
 let merge_all (builders : builder list) : t =
@@ -56,7 +72,15 @@ let merge_all (builders : builder list) : t =
     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}
+  let optional_arg_value_escapes =
+    builders |> List.concat_map (fun b -> b.optional_arg_value_escapes)
+  in
+  {
+    exception_refs;
+    optional_arg_calls;
+    function_refs;
+    optional_arg_value_escapes;
+  }
 
 (** {2 Builder extraction for reactive merge} *)
 
@@ -65,6 +89,7 @@ let builder_to_t (builder : builder) : t =
     exception_refs = builder.exception_refs;
     optional_arg_calls = builder.optional_arg_calls;
     function_refs = builder.function_refs;
+    optional_arg_value_escapes = builder.optional_arg_value_escapes;
   }
 
 (** {2 Processing API} *)

analysis/reanalyze/src/cross_file_items.mli

@@ -18,12 +18,18 @@ type optional_arg_call = {
 
 type function_ref = {pos_from: Lexing.position; pos_to: Lexing.position}
 
+type optional_arg_value_escape = {
+  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;
+  optional_arg_value_escapes: optional_arg_value_escape list;
 }
 (** Immutable cross-file items - for processing after merge *)
 
@@ -49,7 +55,10 @@ val add_optional_arg_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). *)
+
+val add_optional_arg_value_escape :
+  builder -> pos_from:Lexing.position -> pos_to:Lexing.position -> unit
+(** Record an optional-arg function used as a first-class value. *)
 
 (** {2 Merge API} *)
 

analysis/reanalyze/src/cross_file_items_store.ml

@@ -28,6 +28,15 @@ let iter_function_refs t f =
       (fun _path items -> List.iter f items.Cross_file_items.function_refs)
       r
 
+let iter_optional_arg_value_escapes t f =
+  match t with
+  | Frozen cfi -> List.iter f cfi.Cross_file_items.optional_arg_value_escapes
+  | Reactive r ->
+    Reactive.iter
+      (fun _path items ->
+        List.iter f items.Cross_file_items.optional_arg_value_escapes)
+      r
+
 (** 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. *)
@@ -65,3 +74,27 @@ let compute_optional_args_state (store : t) ~find_decl ~is_live :
           set_state pos_from updated_from;
           set_state pos_to updated_to));
   state
+
+let compute_live_optional_arg_value_escapes (store : t) ~is_live : Pos_set.t =
+  let escapes = ref Pos_set.empty in
+  iter_optional_arg_value_escapes store
+    (fun {Cross_file_items.pos_from; pos_to} ->
+      if is_live pos_from then escapes := Pos_set.add pos_to !escapes);
+  let function_refs = ref [] in
+  iter_function_refs store (fun {Cross_file_items.pos_from; pos_to} ->
+      if is_live pos_from then
+        function_refs := (pos_from, pos_to) :: !function_refs);
+  (* A function reference aliases both declaration positions. Close escapes over
+     the undirected links so aliases and interface/implementation pairs agree. *)
+  let rec propagate escapes =
+    let propagated =
+      List.fold_left
+        (fun escapes (pos_from, pos_to) ->
+          if Pos_set.mem pos_from escapes then Pos_set.add pos_to escapes
+          else if Pos_set.mem pos_to escapes then Pos_set.add pos_from escapes
+          else escapes)
+        escapes !function_refs
+    in
+    if Pos_set.equal propagated escapes then escapes else propagate propagated
+  in
+  propagate !escapes

analysis/reanalyze/src/cross_file_items_store.mli

@@ -22,9 +22,17 @@ val iter_optional_arg_calls :
 val iter_function_refs : t -> (Cross_file_items.function_ref -> unit) -> unit
 (** Iterate over all function refs *)
 
+val iter_optional_arg_value_escapes :
+  t -> (Cross_file_items.optional_arg_value_escape -> unit) -> unit
+(** Iterate over optional-arg functions used as first-class values *)
+
 val compute_optional_args_state :
   t ->
   find_decl:(Lexing.position -> Decl.t option) ->
   is_live:(Lexing.position -> bool) ->
   Optional_args_state.t
 (** Compute optional args state from calls and function references *)
+
+val compute_live_optional_arg_value_escapes :
+  t -> is_live:(Lexing.position -> bool) -> Pos_set.t
+(** Compute optional-arg declarations with live first-class value escapes *)

analysis/reanalyze/src/dead_common.ml

@@ -124,11 +124,13 @@ let addDeclaration_ ~config ~decls ~(file : File_context.t) ?pos_end ?pos_start
     Declarations.add decls pos decl)
 
 let add_value_declaration ~config ~decls ~file ?(is_toplevel = true)
-    ~(loc : Location.t) ~module_loc ?(optional_args = Optional_args.empty) ~path
-    ~side_effects name =
+    ?(reports_optional_args = false) ~(loc : Location.t) ~module_loc
+    ?(optional_args = Optional_args.empty) ~path ~side_effects name =
   name
   |> addDeclaration_ ~config ~decls ~file
-       ~decl_kind:(Value {is_toplevel; optional_args; side_effects})
+       ~decl_kind:
+         (Value
+            {is_toplevel; reports_optional_args; optional_args; side_effects})
        ~loc ~module_loc ~path
 
 (** Create a dead code issue. Pure - no side effects. *)

analysis/reanalyze/src/dead_optional_args.ml

@@ -2,25 +2,6 @@ open Dead_common
 
 let active () = true
 
-let add_function_reference ~config ~decls ~cross_file ~(loc_from : Location.t)
-    ~(loc_to : Location.t) =
-  if active () then
-    let pos_to = loc_to.loc_start in
-    let pos_from = loc_from.loc_start in
-    (* Check if target has optional args - for filtering and debug logging *)
-    let should_add =
-      match Declarations.find_opt_builder decls pos_to with
-      | Some {decl_kind = Value {optional_args}} ->
-        not (Optional_args.is_empty optional_args)
-      | _ -> false
-    in
-    if should_add then (
-      if config.Dce_config.cli.debug then
-        Log_.item "OptionalArgs.addFunctionReference %s %s@."
-          (pos_from |> Pos.to_string)
-          (pos_to |> Pos.to_string);
-      Cross_file_items.add_function_reference cross_file ~pos_from ~pos_to)
-
 let rec has_optional_args (texpr : Types.type_expr) =
   match texpr.desc with
   | _ when not (active ()) -> false
@@ -30,6 +11,17 @@ let rec has_optional_args (texpr : Types.type_expr) =
   | Tsubst t -> has_optional_args t
   | _ -> false
 
+let add_function_reference ~config ~cross_file ~(loc_from : Location.t)
+    ~(loc_to : Location.t) ~type_from ~type_to =
+  if has_optional_args type_from && has_optional_args type_to then (
+    let pos_to = loc_to.loc_start in
+    let pos_from = loc_from.loc_start in
+    if config.Dce_config.cli.debug then
+      Log_.item "OptionalArgs.addFunctionReference %s %s@."
+        (pos_from |> Pos.to_string)
+        (pos_to |> Pos.to_string);
+    Cross_file_items.add_function_reference cross_file ~pos_from ~pos_to)
+
 let rec from_type_expr (texpr : Types.type_expr) =
   match texpr.desc with
   | _ when not (active ()) -> []
@@ -39,6 +31,18 @@ let rec from_type_expr (texpr : Types.type_expr) =
   | Tsubst t -> from_type_expr t
   | _ -> []
 
+let rec from_type_expr_with_arity (texpr : Types.type_expr) arity =
+  if arity <= 0 then []
+  else
+    match texpr.desc with
+    | _ when not (active ()) -> []
+    | Tarrow ({lbl = Optional {txt = s}}, t_to, _, _) ->
+      s :: from_type_expr_with_arity t_to (arity - 1)
+    | Tarrow (_, t_to, _, _) -> from_type_expr_with_arity t_to (arity - 1)
+    | Tlink t -> from_type_expr_with_arity t arity
+    | Tsubst t -> from_type_expr_with_arity t arity
+    | _ -> []
+
 let add_references ~config ~cross_file ~(loc_from : Location.t)
     ~(loc_to : Location.t) ~(binding : Location.t) ~path
     (arg_names, arg_names_maybe) =
@@ -59,10 +63,12 @@ let add_references ~config ~cross_file ~(loc_from : Location.t)
 
 (** Check for optional args issues. Returns issues instead of logging.
     Uses optional_args_state map for final computed state. *)
-let check ~optional_args_state ~ann_store ~config:_ decl : Issue.t list =
+let check ~optional_args_state ~optional_arg_value_escapes ~ann_store ~config:_
+    decl : Issue.t list =
   match decl with
-  | {Decl.decl_kind = Value {optional_args}}
+  | {Decl.decl_kind = Value {reports_optional_args = true; optional_args}}
     when active ()
+         && (not (Pos_set.mem decl.pos optional_arg_value_escapes))
          && not
               (Annotation_store.is_annotated_gentype_or_live ann_store decl.pos)
     ->