Read @throws from library declarations in exception analysis

Why:
    The exception analysis knew what library functions throw only from a
    table kept by hand in exn_lib.ml. The table drifted: the Temporal
    `fromStringOrThrow` functions were never added (#9182), and neither
    were a few Intl and Belt ones. Third-party libraries and a project's
    own externals had no way to say what they throw.

A call now takes the exceptions named by the `@throws` on the declaration
of the value it calls, and the table is gone. The `.cmi` keeps the
attributes of externals and interface declarations, so their `@throws`
reaches calls in other modules and packages, through aliases, `open`,
`include`, functors and first-class modules. For a `let` in a module
without an interface, the type checker now copies the binding's `@throws`
into the inferred signature, as it already did for `@deprecated`. The
stdlib and Belt declare what their throwing functions throw, and a guard
in the reanalyze tests fails when a stdlib or Belt `*OrThrow` or `*Exn`
declaration has no `@throws(...)`.

Analysis modified (exceptions of a call to `f`, `Exception.Event` loop):
Before (rule):
    throws(`f`) = values(`f`)   when `f` is in the values table
    throws(`f`) = table(`f`)   otherwise
After (rule):
    throws(`f`) = declared(`f`) ∪ values(`f`)

Signature modified (inferred signature of a module without an interface, `Typemod.type_structure`):
Example:
    /** Finds the value. */
    @throws(Not_found)
    let find = x => x > 0 ? x : throw(Not_found)
Before (rescript): the signature in the .cmi
    let find: int => int
After (rescript):
    @throws(Not_found)
    let find: int => int

Reanalyze modified (calls to annotated externals):
Example:
    // Lib.res
    @throws(JsExn)
    external parse: string => int = "parseInt"

    // App.res
    let parse = s => Lib.parse(s)

    @throws(JsExn)
    let parseAnnotated = s => Lib.parse(s)

    let date = () => Temporal.PlainDate.fromStringOrThrow("x")
Before (reanalyze):
    Exception Analysis
    App.res:4:5-18
    parseAnnotated throws nothing and is annotated with redundant @throws(JsExn)

    Analysis reported 1 issues (Exception Analysis:1)
After (reanalyze):
    Exception Analysis
    App.res:1:5-9
    parse might throw JsExn (App.res:1:17) and is not annotated with @throws(JsExn)

    Exception Analysis
    App.res:6:5-8
    date might throw JsExn (App.res:6:17) and is not annotated with @throws(JsExn)

    Analysis reported 2 issues (Exception Analysis:2)

Review: Why the union of the declaration and the values table, rather than
one winning? The values table holds the `@throws` on the implementation's
binding, the declaration the one in its interface. Either can be the only
one written, as with an annotated `.resi` `let` whose `.res` isn't
annotated, so the call can throw what either names.

Review: Why does the inferred signature take only the `@throws` family and
`@deprecated`, and not every attribute? A doc comment is an attribute too:
in the `.cmi` it would make editing a comment recompile the module's
dependents. A module with a `.resi` is unchanged, since its `.cmi` holds
the interface's declarations.

Review: What does a `@throws` without a payload mean? Nothing, as on a
binding. The guard requires a payload, and the stdlib's two payload-less
`@throws` in Stdlib_JSON.res now name `JsExn`.

Fixes #9182

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01Kbf3gGhHjzBTXqSo8Dckpb
Signed-off-by: Christoph Knittel <ck@cca.io>

Author: cknitt

analysis/reanalyze/src/exception.ml

@@ -127,17 +127,18 @@ module Event = struct
         if config.Dce_config.cli.debug then Log_.item "%a@." print ev;
         exceptions |> Exceptions.iter (fun exn -> extend_exn_table exn loc);
         loop (Exceptions.union exn_set exceptions) rest
-      | ({kind = Call {callee; module_path}; loc} as ev) :: rest ->
+      | ({kind = Call {callee; module_path}; exceptions = declared; loc} as ev)
+        :: rest ->
         if config.Dce_config.cli.debug then Log_.item "%a@." print ev;
+        (* [declared] comes from the declaration's [@throws], the values table
+           from the [@throws] of the implementation's binding. Both describe
+           what the call can throw, so take both. *)
         let exceptions =
           match
             callee |> Values.find_path values_table ~module_name ~module_path
           with
-          | Some exceptions -> exceptions
-          | _ -> (
-            match Exn_lib.find callee with
-            | Some exceptions -> exceptions
-            | None -> Exceptions.empty)
+          | Some exceptions -> Exceptions.union declared exceptions
+          | None -> declared
         in
         exceptions |> Exceptions.iter (fun exn -> extend_exn_table exn loc);
         loop (Exceptions.union exn_set exceptions) rest
@@ -280,7 +281,7 @@ let traverse_ast ~file ~values_builder ~checks_builder () =
         case.c_rhs |> iter_expr self)
   in
   let is_throw s = s = "Pervasives.raise" || s = "Pervasives.throw" in
-  (* [/] and [mod] are listed in [Exn_lib] as throwing [Division_by_zero].
+  (* [/] and [mod] are declared with [@throws(Division_by_zero)] in Pervasives.
      They cannot throw when the divisor is a non-zero literal, as in [x / 10]. *)
   let is_division s =
     s = "Pervasives./" || s = "Pervasives.mod" || s = "Stdlib./"
@@ -322,14 +323,40 @@ let traverse_ast ~file ~values_builder ~checks_builder () =
       | _ -> false)
     <> None
   in
+  let get_exceptions_from_annotations attributes =
+    let throws_annotation_payload =
+      attributes
+      |> Annotation.get_attribute_payload (fun s ->
+          s = "throws" || s = "throw" || s = "raises" || s = "raise")
+    in
+    let rec get_exceptions payload =
+      match payload with
+      | Annotation.StringPayload s ->
+        [Exn.from_string s] |> Exceptions.from_list
+      | Annotation.ConstructPayload s when s <> "::" ->
+        [Exn.from_string s] |> Exceptions.from_list
+      | Annotation.IdentPayload s ->
+        [Exn.from_string (s |> Longident.flatten |> String.concat ".")]
+        |> Exceptions.from_list
+      | Annotation.TuplePayload tuple ->
+        tuple
+        |> List.map (fun payload ->
+            payload |> get_exceptions |> Exceptions.to_list)
+        |> List.concat |> Exceptions.from_list
+      | _ -> Exceptions.empty
+    in
+    match throws_annotation_payload with
+    | None -> Exceptions.empty
+    | Some payload -> payload |> get_exceptions
+  in
   let expr ~(module_path : Module_path.t) (self : Tast_mapper.mapper)
       (expr : Typedtree.expression) =
     let loc = expr.exp_loc in
     let is_does_no_throw = expr.exp_attributes |> does_not_throw in
     let old_events = !current_events in
     if is_does_no_throw then current_events := [];
     (match expr.exp_desc with
-    | Texp_ident (callee_, _, _) ->
+    | Texp_ident (callee_, _, vd) ->
       let callee =
         callee_ |> Dce_path.from_path_t |> Module_path.resolve_alias module_path
       in
@@ -343,9 +370,12 @@ let traverse_ast ~file ~values_builder ~checks_builder () =
                    "@{<info>%s@} can be analyzed only if called directly"
                    (callee_name |> Name.to_string);
              });
+      (* A [@throws] on the declaration (an external, a [let] in an
+         interface, or a library's) is kept in the .cmi, so it reaches calls
+         from other modules and packages. *)
       current_events :=
         {
-          Event.exceptions = Exceptions.empty;
+          Event.exceptions = get_exceptions_from_annotations vd.val_attributes;
           loc;
           kind = Call {callee; module_path = module_path.path};
         }
@@ -423,32 +453,6 @@ let traverse_ast ~file ~values_builder ~checks_builder () =
          :: old_events);
     expr
   in
-  let get_exceptions_from_annotations attributes =
-    let throws_annotation_payload =
-      attributes
-      |> Annotation.get_attribute_payload (fun s ->
-          s = "throws" || s = "throw" || s = "raises" || s = "raise")
-    in
-    let rec get_exceptions payload =
-      match payload with
-      | Annotation.StringPayload s ->
-        [Exn.from_string s] |> Exceptions.from_list
-      | Annotation.ConstructPayload s when s <> "::" ->
-        [Exn.from_string s] |> Exceptions.from_list
-      | Annotation.IdentPayload s ->
-        [Exn.from_string (s |> Longident.flatten |> String.concat ".")]
-        |> Exceptions.from_list
-      | Annotation.TuplePayload tuple ->
-        tuple
-        |> List.map (fun payload ->
-            payload |> get_exceptions |> Exceptions.to_list)
-        |> List.concat |> Exceptions.from_list
-      | _ -> Exceptions.empty
-    in
-    match throws_annotation_payload with
-    | None -> Exceptions.empty
-    | Some payload -> payload |> get_exceptions
-  in
   let toplevel_eval (self : Tast_mapper.mapper) (expr : Typedtree.expression)
       attributes =
     let old_id = !current_id in

analysis/reanalyze/src/exn.ml

@@ -1,15 +1,7 @@
 type t = string
 
 let compare = String.compare
-let decode_error = "DecodeError"
-let assert_failure = "Assert_failure"
-let division_by_zero = "Division_by_zero"
-let invalid_argument = "Invalid_argument"
-let js_exn = "JsExn"
 let match_failure = "Match_failure"
-let not_found = "Not_found"
 let from_lid lid = lid |> Longident.flatten |> String.concat "."
 let from_string s = s
 let to_string s = s
-let yojson_json_error = "Yojson.Json_error"
-let yojson_type_error = "Yojson.Basic.Util.Type_error"

analysis/reanalyze/src/exn.mli

@@ -1,15 +1,7 @@
 type t
 
 val compare : t -> t -> int
-val assert_failure : t
-val decode_error : t
-val division_by_zero : t
 val from_lid : Longident.t -> t
 val from_string : string -> t
-val invalid_argument : t
-val js_exn : t
 val match_failure : t
-val not_found : t
 val to_string : t -> string
-val yojson_json_error : t
-val yojson_type_error : t

analysis/reanalyze/src/exn_lib.ml

@@ -0,0 +1 @@
+- Exception analysis reads `@throws` from library and external declarations, including third-party ones, instead of a built-in list, and a `@throws` on a `let` now reaches other modules even without an interface.

changes/reanalyze-throws-from-declarations.feature.md

@@ -1442,11 +1442,18 @@ and type_structure funct_body anchor env sstr =
       in
       (* The environment keeps let-bound values without attributes, so uses
          in this module do not warn. The signature carries their [deprecated]
-         attributes, so uses from other modules do. *)
-      let deprecated =
+         attributes, so uses from other modules do, and their [throws]
+         attributes, which reanalyze's exception analysis reads at calls from
+         other modules. Other attributes stay out: a doc comment in the .cmi
+         would make editing it recompile the module's dependents. *)
+      let signature_attributes (attrs : Parsetree.attributes) =
+        Builtin_attributes.deprecated_attributes attrs
+        @ List.filter (fun ({txt}, _) -> txt = "throws") attrs
+      in
+      let kept_attributes =
         List.concat_map
           (fun (vb : value_binding) ->
-            match Builtin_attributes.deprecated_attributes vb.vb_attributes with
+            match signature_attributes vb.vb_attributes with
             | [] -> []
             | attrs ->
               List.map (fun id -> (id, attrs)) (pat_bound_idents vb.vb_pat))
@@ -1460,7 +1467,9 @@ and type_structure funct_body anchor env sstr =
             let vd = Env.find_value (Pident id) newenv in
             let vd =
               match
-                List.find_opt (fun (id', _) -> Ident.same id id') deprecated
+                List.find_opt
+                  (fun (id', _) -> Ident.same id id')
+                  kept_attributes
               with
               | None -> vd
               | Some (_, attrs) ->