diff --git a/CHANGELOG.md b/CHANGELOG.md
index ea2ed8bef4..a5851dee35 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -36,6 +36,7 @@
 
 #### :bug: Bug fix
 
+- Fix the side-effect analysis treating bigint exponentiation and bounds-checked array and string reads as pure, which let dead-code elimination drop an unused one that throws: `let _ = 2n ** -1n` no longer raised. https://github.com/rescript-lang/rescript/pull/8617
 - Fix excessive parentheses and indentation in function assignments to refs, align record and array assignment formatting across refs and fields, and preserve function return-type parentheses and consistent JSX fragment layout in callbacks. https://github.com/rescript-lang/rescript/pull/8611
 - Fix a recursive module with an empty signature discarding its right-hand side. Lambda-to-Lam conversion rewrote `Pupdate_mod` to unit when the module's shape had no fields, dropping the primitive's arguments - one of which is the right-hand side - so `module rec M: {} = { let () = Console.log("effect") }` emitted nothing for `M`. The elision now happens where the bindings are produced, with the right-hand side still in hand. https://github.com/rescript-lang/rescript/pull/8608
 - Fix a compiler crash on a polymorphic variant whose numeric name exceeds the `int32` range. `#99999999999("a")` and the same name in a pattern failed with `Failure("Int32.of_string")` and no location, because the range check ran in the frontend AST pass and matched only payload-free expressions. It now runs in `Typecore`, next to the integer literal decoding whose overflow error it mirrors, and covers both label positions. A bare `type t = [#99999999999]` still compiles, since nothing decodes a row field name. https://github.com/rescript-lang/rescript/pull/8608
@@ -70,6 +71,7 @@
 
 - Normalize Lambda terms where they are built: a match guard stays structured data until its fallthrough is known, and `apply` and `mk_builtin` go through the folding constructors. https://github.com/rescript-lang/rescript/pull/8615
 - Replace non-escaping local mutable blocks with scalar bindings when all uses are direct field accesses, generalizing reference unboxing to multi-field records and references captured by JavaScript closures. https://github.com/rescript-lang/rescript/pull/8617
+- Split `lambda.ml` into the IR and its traversals, static exits and path translation, so the module defining `Lambda.t` no longer reaches into `Env` or `Path`. https://github.com/rescript-lang/rescript/pull/8618
 - Merge the duplicate Lam intermediate representation into Lambda, removing the conversion layer and obsolete supporting infrastructure. Lambda is now a single private, normalized representation, with generated JavaScript remaining semantically unchanged. https://github.com/rescript-lang/rescript/pull/8608
 - Add genType and source map controls and output to the developer playground. https://github.com/rescript-lang/rescript/pull/8448
 - Rework the object-type representation end to end: object rows are plain field chains carrying a per-field mutability state (no phantom setter members), object literals are typed directly and property access and assignment are first-class AST and Lambda nodes shared between the Lambda and JS pipelines, and dead class-system remnants (the field-presence lattice, the class-abbreviation memo on object types, method-send typing) are removed. https://github.com/rescript-lang/rescript/pull/8597
diff --git a/compiler/core/js_analyzer.ml b/compiler/core/js_analyzer.ml
index f5062363c7..a920b1750c 100644
--- a/compiler/core/js_analyzer.ml
+++ b/compiler/core/js_analyzer.ml
@@ -130,7 +130,21 @@ let rec no_side_effect_expression_desc (x : J.expression_desc) =
     && Ext_list.for_all_snd kvs no_side_effect
   | String_append (a, b) | Seq (a, b) -> no_side_effect a && no_side_effect b
   | Length e | Caml_block_tag (e, _) | Typeof e -> no_side_effect e
-  | Bin (op, a, b) -> op <> Eq && no_side_effect a && no_side_effect b
+  | Bin (Eq, _, _) -> false
+  | Bin (((Pow | Div | Mod) as op), a, b) ->
+    (* On BigInt operands these throw: [**] on a negative exponent, [/] and
+       [%] on a zero divisor. The operand types are not known here, so only a
+       literal right operand that cannot throw is taken as pure. *)
+    let safe_literal =
+      match b.expression_desc with
+      | Number (BigInt {positive; value}) ->
+        if op = Pow then positive else value <> "0"
+      | Number (Int {i}) -> op = Pow || i <> 0l
+      | Number (Float _) -> true
+      | _ -> false
+    in
+    safe_literal && no_side_effect a
+  | Bin (_, a, b) -> no_side_effect a && no_side_effect b
   | Tagged_template (call_expr, _, values) ->
     no_side_effect call_expr && Ext_list.for_all values no_side_effect
   | Js_not e | Js_bnot e -> no_side_effect e
diff --git a/compiler/core/lam_analysis.ml b/compiler/core/lam_analysis.ml
index 3910dde8fc..5e3440173d 100644
--- a/compiler/core/lam_analysis.ml
+++ b/compiler/core/lam_analysis.ml
@@ -45,6 +45,12 @@ let rec no_side_effects (lam : Lambda.t) : bool =
       match args with
       | [_; Lconst cst] -> not_zero_constant cst
       | _ -> false)
+    | Ppowbigint -> (
+      (* Raises on a negative exponent, so pure only when the exponent is a
+         nonnegative constant. *)
+      match args with
+      | [_; Lconst (Const_bigint (true, _))] -> true
+      | _ -> false)
     | Pcreate_extension _ | Ptypeof | Pis_null | Pis_not_none | Psome
     | Psome_not_nest | Pis_undefined | Pis_null_undefined | Pnull_to_opt
     | Pnull_undefined_to_opt | Pjs_object_create _ | Pimport _
@@ -67,14 +73,13 @@ let rec no_side_effects (lam : Lambda.t) : bool =
     | Ppowfloat | Pdivfloat | Pmodfloat | Pfloatcomp _ | Pjscomp _ | Pfloatorder
     | Pfloatmin | Pfloatmax
     (* bigint primitives *)
-    | Pnegbigint | Paddbigint | Psubbigint | Pmulbigint | Ppowbigint
-    | Pnotbigint | Pandbigint | Porbigint | Pxorbigint | Plslbigint | Pasrbigint
+    | Pnegbigint | Paddbigint | Psubbigint | Pmulbigint | Pnotbigint
+    | Pandbigint | Porbigint | Pxorbigint | Plslbigint | Pasrbigint
     | Pbigintcomp _ | Pbigintorder | Pbigintmin | Pbigintmax
     (* string primitives *)
-    | Pstringlength | Pstringrefu | Pstringrefs | Pstringcomp _ | Pstringorder
-    | Pstringmin | Pstringmax
+    | Pstringlength | Pstringcomp _ | Pstringorder | Pstringmin | Pstringmax
     (* array primitives *)
-    | Pmakearray | Parraylength | Parrayrefu | Parrayrefs
+    | Pmakearray | Parraylength | Parrayrefu
     (* list primitives *)
     | Pmakelist
     (* dict primitives *)
@@ -99,7 +104,9 @@ let rec no_side_effects (lam : Lambda.t) : bool =
     (* TODO *)
     | Praw_js_code _
     (* byte swap *)
-    | Parraysets | Parraysetu | Praise | Psetfield _ ->
+    | Parraysets | Parraysetu | Praise | Psetfield _
+    (* bounds-checked reads throw when the index is out of range *)
+    | Parrayrefs | Pstringrefs | Pstringrefu ->
       false)
   | Llet (_, _, arg, body) -> no_side_effects arg && no_side_effects body
   | Lswitch (_, _) -> false
diff --git a/compiler/core/lam_compile.ml b/compiler/core/lam_compile.ml
index 9d3663244f..5910f49291 100644
--- a/compiler/core/lam_compile.ml
+++ b/compiler/core/lam_compile.ml
@@ -1283,7 +1283,7 @@ let compile output_prefix =
       (lambda_cxt : Lam_compile_context.t) =
     let new_cxt = {lambda_cxt with continuation = NeedValue Not_tail} in
     let emitted_id =
-      if Set_ident.mem (Lambda.free_variables body) id then id
+      if Set_ident.mem (Lambda_traverse.free_variables body) id then id
       else Ext_ident.create_tmp ~name:"_for_of" ()
     in
     let block =
@@ -1306,7 +1306,7 @@ let compile output_prefix =
       (body : Lambda.t) (lambda_cxt : Lam_compile_context.t) =
     let new_cxt = {lambda_cxt with continuation = NeedValue Not_tail} in
     let emitted_id =
-      if Set_ident.mem (Lambda.free_variables body) id then id
+      if Set_ident.mem (Lambda_traverse.free_variables body) id then id
       else Ext_ident.create_tmp ~name:"_for_await_of" ()
     in
     let block =
diff --git a/compiler/core/lam_compile_main.ml b/compiler/core/lam_compile_main.ml
index db184955d3..22ca829f68 100644
--- a/compiler/core/lam_compile_main.ml
+++ b/compiler/core/lam_compile_main.ml
@@ -255,7 +255,7 @@ let required_modules (lam : Lambda.t) : Lam_module_ident.Hash_set.t =
     | Lglobal_module id ->
       Lam_module_ident.Hash_set.add required (Lam_module_ident.of_ml id)
     | _ -> ());
-    Lambda.iter collect lam
+    Lambda_traverse.iter collect lam
   in
   collect lam;
   required
diff --git a/compiler/core/lam_dce.ml b/compiler/core/lam_dce.ml
index 7b7a012da7..47ecd47f72 100644
--- a/compiler/core/lam_dce.ml
+++ b/compiler/core/lam_dce.ml
@@ -46,13 +46,14 @@ let remove export_idents (rest : Lam_group.t list) : Lam_group.t list =
     Ext_list.fold_left rest export_idents (fun acc x ->
         match x with
         | Single (kind, id, lam) -> (
-          Hash_ident.add ident_free_vars id (Lambda.free_variables lam);
+          Hash_ident.add ident_free_vars id (Lambda_traverse.free_variables lam);
           match kind with
           | Alias | StrictOpt -> acc
           | Strict | Variable -> id :: acc)
         | Recursive bindings ->
           Ext_list.fold_left bindings acc (fun acc (id, lam) ->
-              Hash_ident.add ident_free_vars id (Lambda.free_variables lam);
+              Hash_ident.add ident_free_vars id
+                (Lambda_traverse.free_variables lam);
               match lam with
               | Lfunction _ -> acc
               | _ -> id :: acc)
@@ -60,8 +61,8 @@ let remove export_idents (rest : Lam_group.t list) : Lam_group.t list =
           if Lam_analysis.no_side_effects lam then acc
           else
             (* its free varaibles here will be defined above *)
-            Set_ident.fold (Lambda.free_variables lam) acc (fun x acc ->
-                x :: acc))
+            Set_ident.fold (Lambda_traverse.free_variables lam) acc
+              (fun x acc -> x :: acc))
   in
   let visited = transitive_closure initial_idents ident_free_vars in
   Ext_list.fold_left rest [] (fun acc x ->
diff --git a/compiler/core/lam_exit_code.ml b/compiler/core/lam_exit_code.ml
index 79c1770b8e..a09dbe55a7 100644
--- a/compiler/core/lam_exit_code.ml
+++ b/compiler/core/lam_exit_code.ml
@@ -28,7 +28,7 @@ let has_exit_code lam exits =
     | Lfunction _ -> false
     (* static exit can not cross function boundary *)
     | Lstaticraise (p, _) when exits p -> true
-    | _ -> Lambda.shallow_exists aux lam
+    | _ -> Lambda_traverse.shallow_exists aux lam
   in
   aux lam
 
@@ -36,4 +36,4 @@ let rec has_exit (lam : Lambda.t) =
   match lam with
   | Lfunction _ -> false
   | Lstaticraise (_, _) -> true
-  | _ -> Lambda.shallow_exists has_exit lam
+  | _ -> Lambda_traverse.shallow_exists has_exit lam
diff --git a/compiler/core/lam_pass_exits.ml b/compiler/core/lam_pass_exits.ml
index 108588c997..04439ca2e5 100644
--- a/compiler/core/lam_pass_exits.ml
+++ b/compiler/core/lam_pass_exits.ml
@@ -197,7 +197,7 @@ let subst_helper (subst : subst_tbl) (query : int -> int) (lam : Lambda.t) :
           Ext_list.fold_right2 xs ys Ident.empty (fun x y t ->
               Ident.add x (Lambda.var y) t)
         in
-        Ext_list.fold_right2 ys ls (Lambda.subst_lambda env handler)
+        Ext_list.fold_right2 ys ls (Lambda_traverse.subst_lambda env handler)
           (fun y l r -> Lambda.let_ Strict y l r)
       | None -> Lambda.staticraise i ls)
     | Lvar _ | Lconst _ -> lam
diff --git a/compiler/core/lam_pass_guard_raises.ml b/compiler/core/lam_pass_guard_raises.ml
index 1b6f4005f8..fe3e2f2c1b 100644
--- a/compiler/core/lam_pass_guard_raises.ml
+++ b/compiler/core/lam_pass_guard_raises.ml
@@ -3,9 +3,9 @@ let rec guard_raises (lam : Lambda.t) : Lambda.t =
   | Lifthenelse (a, (Lprim {primitive = Praise} as b), c) -> (
     match c with
     (* A constant alternative is already as flat as it gets. *)
-    | Lconst _ -> Lambda.shallow_map_sharing guard_raises lam
+    | Lconst _ -> Lambda_traverse.shallow_map_sharing guard_raises lam
     | _ ->
       Lambda.seq
         (Lambda.if_ (guard_raises a) b Lambda.lambda_unit)
         (guard_raises c))
-  | _ -> Lambda.shallow_map_sharing guard_raises lam
+  | _ -> Lambda_traverse.shallow_map_sharing guard_raises lam
diff --git a/compiler/core/lam_pass_sroa.ml b/compiler/core/lam_pass_sroa.ml
index eea1c41a71..e5deff7fe9 100644
--- a/compiler/core/lam_pass_sroa.ml
+++ b/compiler/core/lam_pass_sroa.ml
@@ -47,7 +47,9 @@ let rec analyze block uses (lam : Lambda.t) =
     else false
   | _ ->
     not
-      (Lambda.shallow_exists (fun child -> not (analyze block uses child)) lam)
+      (Lambda_traverse.shallow_exists
+         (fun child -> not (analyze block uses child))
+         lam)
 
 let discard_value value body =
   if Lam_analysis.no_side_effects value then body else Lambda.seq value body
@@ -68,7 +70,7 @@ let rec rewrite block fields uses (lam : Lambda.t) =
      loudly instead of silently losing the write. *)
   | Lvar id when Ident.same id block -> assert false
   | Lassign (id, _) when Ident.same id block -> assert false
-  | _ -> Lambda.shallow_map_sharing (rewrite block fields uses) lam
+  | _ -> Lambda_traverse.shallow_map_sharing (rewrite block fields uses) lam
 
 let fields_for_block block info field_count =
   let fallback () =
@@ -141,4 +143,4 @@ let rec simplify (lam : Lambda.t) =
     | _ ->
       if init' == init && body' == body then lam
       else Lambda.let_ kind block init' body')
-  | _ -> Lambda.shallow_map_sharing simplify lam
+  | _ -> Lambda_traverse.shallow_map_sharing simplify lam
diff --git a/compiler/core/polyvar_pattern_match.ml b/compiler/core/polyvar_pattern_match.ml
index 9f34208467..7ceeb85604 100644
--- a/compiler/core/polyvar_pattern_match.ml
+++ b/compiler/core/polyvar_pattern_match.ml
@@ -45,7 +45,7 @@ let convert (xs : input) : output =
   let os : value list ref = ref [] in
   xs
   |> List.iteri (fun i (hash, (name, act)) ->
-      match Lambda.make_key act with
+      match Lambda_traverse.make_key act with
       | None -> os := {stamp = i; hash_names_act = ([(hash, name)], act)} :: !os
       | Some key ->
         Coll.add_or_update coll key
diff --git a/compiler/ml/lambda.ml b/compiler/ml/lambda.ml
index be06251961..68cad6e908 100644
--- a/compiler/ml/lambda.ml
+++ b/compiler/ml/lambda.ml
@@ -715,7 +715,6 @@ exception Not_simple_form
 
 (**
 
-
    [is_eta_conversion_exn params inner_args outer_args]
    case 1:
    {{
@@ -1150,79 +1149,6 @@ let if_ (a : t) (b : t) (c : t) : t =
         | _ -> Lifthenelse (a, b, c))
       | _ -> Lifthenelse (a, b, c)))
 
-(** [shallow_map_sharing f lam] rewrites [lam]'s immediate children with [f]
-    and rebuilds the node through its smart constructor, so the result is
-    normalized. A node whose children all come back physically unchanged is
-    returned as-is, so a traversal that rewrites nothing allocates nothing. *)
-let shallow_map_sharing (f : t -> t) (lam : t) : t =
-  match lam with
-  | Lvar _ | Lglobal_module _ | Lconst _ | Lbreak | Lcontinue -> lam
-  | Lapply ap ->
-    let fn = f ap.ap_func in
-    let args = Ext_list.map_sharing ap.ap_args f in
-    if fn == ap.ap_func && args == ap.ap_args then lam
-    else apply fn args ap.ap_info ~ap_transformed_jsx:ap.ap_transformed_jsx
-  | Lfunction {params; body; attr; loc} ->
-    let body' = f body in
-    if body' == body then lam else function_ ~loc ~attr ~params ~body:body'
-  | Llet (k, id, e, b) ->
-    let e' = f e and b' = f b in
-    if e' == e && b' == b then lam else let_ k id e' b'
-  | Lletrec (bs, b) ->
-    let bs' = Ext_list.map_snd_sharing bs f and b' = f b in
-    if bs' == bs && b' == b then lam else letrec bs' b'
-  | Lprim {primitive; args; loc} ->
-    let args' = Ext_list.map_sharing args f in
-    if args' == args then lam else prim ~primitive ~args:args' loc
-  | Lswitch (e, sw) ->
-    let e' = f e in
-    let consts = Ext_list.map_snd_sharing sw.sw_consts f in
-    let blocks = Ext_list.map_snd_sharing sw.sw_blocks f in
-    let fail = Ext_option.map_sharing sw.sw_failaction f in
-    if
-      e' == e && consts == sw.sw_consts && blocks == sw.sw_blocks
-      && fail == sw.sw_failaction
-    then lam
-    else
-      switch e'
-        {sw with sw_consts = consts; sw_blocks = blocks; sw_failaction = fail}
-  | Lstringswitch (e, cases, d) ->
-    let e' = f e in
-    let cases' = Ext_list.map_snd_sharing cases f in
-    let d' = Ext_option.map_sharing d f in
-    if e' == e && cases' == cases && d' == d then lam
-    else stringswitch e' cases' d'
-  | Lstaticraise (i, args) ->
-    let args' = Ext_list.map_sharing args f in
-    if args' == args then lam else staticraise i args'
-  | Lstaticcatch (b, h, hd) ->
-    let b' = f b and hd' = f hd in
-    if b' == b && hd' == hd then lam else staticcatch b' h hd'
-  | Ltrywith (b, id, h) ->
-    let b' = f b and h' = f h in
-    if b' == b && h' == h then lam else try_ b' id h'
-  | Lifthenelse (a, b, c) ->
-    let a' = f a and b' = f b and c' = f c in
-    if a' == a && b' == b && c' == c then lam else if_ a' b' c'
-  | Lsequence (a, b) ->
-    let a' = f a and b' = f b in
-    if a' == a && b' == b then lam else seq a' b'
-  | Lwhile (a, b) ->
-    let a' = f a and b' = f b in
-    if a' == a && b' == b then lam else while_ a' b'
-  | Lfor (id, a, b, d, c) ->
-    let a' = f a and b' = f b and c' = f c in
-    if a' == a && b' == b && c' == c then lam else for_ id a' b' d c'
-  | Lfor_of (id, a, b) ->
-    let a' = f a and b' = f b in
-    if a' == a && b' == b then lam else for_of id a' b'
-  | Lfor_await_of (id, a, b) ->
-    let a' = f a and b' = f b in
-    if a' == a && b' == b then lam else for_await_of id a' b'
-  | Lassign (id, b) ->
-    let b' = f b in
-    if b' == b then lam else assign id b'
-
 let sequor l r = if_ l lambda_true r
 
 (** [l && r] *)
@@ -1257,81 +1183,6 @@ let default_function_attribute =
   }
 
 (* Build sharing keys *)
-(*
-   Those keys are later compared with Pervasives.compare.
-   For that reason, they should not include cycles.
-*)
-
-exception Not_simple
-
-let max_raw = 32
-
-let make_key e =
-  let count = ref 0 (* Used for controling size *)
-  and make_key = Ident.make_key_generator () in
-  (* make_key is used for normalizing let-bound variables *)
-  let rec tr_rec env e =
-    incr count;
-    if !count > max_raw then raise_notrace Not_simple;
-    (* Too big ! *)
-    match e with
-    | Lvar id -> ( try Ident.find_same id env with Not_found -> e)
-    | Lglobal_module _ | Lconst _ -> e
-    | Lapply ap ->
-      Lapply
-        {
-          ap with
-          ap_func = tr_rec env ap.ap_func;
-          ap_args = tr_recs env ap.ap_args;
-          ap_info = {ap.ap_info with ap_loc = Location.none};
-        }
-    | Llet (Alias, x, ex, e) ->
-      (* Ignore aliases -> substitute *)
-      let ex = tr_rec env ex in
-      tr_rec (Ident.add x ex env) e
-    | Llet ((Strict | StrictOpt), x, ex, Lvar v) when Ident.same v x ->
-      tr_rec env ex
-    | Llet (str, x, ex, e) ->
-      (* Because of side effects, keep other lets with normalized names *)
-      let ex = tr_rec env ex in
-      let y = make_key x in
-      Llet (str, y, ex, tr_rec (Ident.add x (Lvar y) env) e)
-    | Lprim {primitive = p; args = es; loc = _} ->
-      Lprim {primitive = p; args = tr_recs env es; loc = Location.none}
-    | Lswitch (e, sw) -> Lswitch (tr_rec env e, tr_sw env sw)
-    | Lstringswitch (e, sw, d) ->
-      Lstringswitch
-        ( tr_rec env e,
-          List.map (fun (s, e) -> (s, tr_rec env e)) sw,
-          tr_opt env d )
-    | Lstaticraise (i, es) -> Lstaticraise (i, tr_recs env es)
-    | Lstaticcatch (e1, xs, e2) ->
-      Lstaticcatch (tr_rec env e1, xs, tr_rec env e2)
-    | Ltrywith (e1, x, e2) -> Ltrywith (tr_rec env e1, x, tr_rec env e2)
-    | Lifthenelse (cond, ifso, ifnot) ->
-      Lifthenelse (tr_rec env cond, tr_rec env ifso, tr_rec env ifnot)
-    | Lsequence (e1, e2) -> Lsequence (tr_rec env e1, tr_rec env e2)
-    | Lbreak -> Lbreak
-    | Lcontinue -> Lcontinue
-    | Lassign (x, e) -> Lassign (x, tr_rec env e)
-    | Lletrec _ | Lfunction _ | Lfor _ | Lfor_of _ | Lfor_await_of _ | Lwhile _
-      ->
-      raise_notrace Not_simple
-  and tr_recs env es = List.map (tr_rec env) es
-  and tr_sw env sw =
-    {
-      sw with
-      sw_consts = List.map (fun (i, e) -> (i, tr_rec env e)) sw.sw_consts;
-      sw_blocks = List.map (fun (i, e) -> (i, tr_rec env e)) sw.sw_blocks;
-      sw_failaction = tr_opt env sw.sw_failaction;
-    }
-  and tr_opt env = function
-    | None -> None
-    | Some e -> Some (tr_rec env e)
-  in
-
-  try Some (tr_rec Ident.empty e) with Not_simple -> None
-
 (***************)
 
 let name_lambda strict arg fn =
@@ -1341,152 +1192,6 @@ let name_lambda strict arg fn =
     let id = Ident.create "let" in
     Llet (strict, id, arg, fn id)
 
-(* Does any immediate child satisfy [f]? Short-circuits. *)
-let shallow_exists (f : t -> bool) (lam : t) : bool =
-  match lam with
-  | Lvar _ | Lglobal_module _ | Lconst _ | Lbreak | Lcontinue -> false
-  | Lapply {ap_func; ap_args} -> f ap_func || Ext_list.exists ap_args f
-  | Lfunction {body} -> f body
-  | Llet (_, _, arg, body) -> f arg || f body
-  | Lletrec (decl, body) -> f body || Ext_list.exists_snd decl f
-  | Lprim {args} -> Ext_list.exists args f
-  | Lswitch (arg, {sw_consts; sw_blocks; sw_failaction}) ->
-    f arg
-    || Ext_list.exists_snd sw_consts f
-    || Ext_list.exists_snd sw_blocks f
-    || Ext_option.exists sw_failaction f
-  | Lstringswitch (arg, cases, default) ->
-    f arg || Ext_list.exists_snd cases f || Ext_option.exists default f
-  | Lstaticraise (_, args) -> Ext_list.exists args f
-  | Lstaticcatch (e1, _, e2) -> f e1 || f e2
-  | Ltrywith (e1, _, e2) -> f e1 || f e2
-  | Lifthenelse (e1, e2, e3) -> f e1 || f e2 || f e3
-  | Lsequence (e1, e2) -> f e1 || f e2
-  | Lwhile (e1, e2) -> f e1 || f e2
-  | Lfor (_, e1, e2, _, e3) -> f e1 || f e2 || f e3
-  | Lfor_of (_, e1, e2) | Lfor_await_of (_, e1, e2) -> f e1 || f e2
-  | Lassign (_, e) -> f e
-
-let iter f lam =
-  ignore
-    (shallow_exists
-       (fun x ->
-         f x;
-         false)
-       lam)
-
-let free_ids get l =
-  let fv = ref Set_ident.empty in
-  let rec free l =
-    iter free l;
-    fv := List.fold_left Set_ident.add !fv (get l);
-    match l with
-    | Lfunction {params} ->
-      List.iter (fun param -> fv := Set_ident.remove !fv param) params
-    | Llet (_str, id, _arg, _body) -> fv := Set_ident.remove !fv id
-    | Lletrec (decl, _body) ->
-      List.iter (fun (id, _exp) -> fv := Set_ident.remove !fv id) decl
-    | Lstaticcatch (_e1, (_, vars), _e2) ->
-      List.iter (fun id -> fv := Set_ident.remove !fv id) vars
-    | Ltrywith (_e1, exn, _e2) -> fv := Set_ident.remove !fv exn
-    | Lfor (v, _e1, _e2, _dir, _e3) -> fv := Set_ident.remove !fv v
-    | Lfor_of (v, _e1, _e2) | Lfor_await_of (v, _e1, _e2) ->
-      fv := Set_ident.remove !fv v
-    | Lassign (id, _e) -> fv := Set_ident.add !fv id
-    | Lvar _ | Lglobal_module _ | Lconst _ | Lapply _ | Lprim _ | Lswitch _
-    | Lstringswitch _ | Lstaticraise _ | Lifthenelse _ | Lsequence _ | Lbreak
-    | Lcontinue | Lwhile _ ->
-      ()
-  in
-  free l;
-  !fv
-
-let free_variables l =
-  free_ids
-    (function
-      | Lvar id -> [id]
-      | _ -> [])
-    l
-
-(* Check if an action has a "when" guard *)
-let raise_count = ref 0
-
-let next_raise_count () =
-  incr raise_count;
-  !raise_count
-
-let negative_raise_count = ref 0
-
-let next_negative_raise_count () =
-  decr negative_raise_count;
-  !negative_raise_count
-
-(* Anticipated staticraise, for guards *)
-(* Translate an access path *)
-
-let rec transl_normal_path = function
-  | Path.Pident id ->
-    (* A predefined exception is its own name at runtime, so the reference is
-       that string rather than a module. *)
-    if Ident.is_predef_exn id then Lconst (Const_string id.name)
-    else if Ident.global id then Lglobal_module id
-    else Lvar id
-  | Pdot (p, s, pos) ->
-    Lprim
-      {
-        primitive = Pfield (pos, Fld_module {name = s});
-        args = [transl_normal_path p];
-        loc = Location.none;
-      }
-  | Papply _ -> assert false
-
-(* Translation of identifiers *)
-
-let transl_module_path ?(loc = Location.none) env path =
-  transl_normal_path (Env.normalize_path (Some loc) env path)
-
-let transl_value_path ?(loc = Location.none) env path =
-  transl_normal_path (Env.normalize_path_prefix (Some loc) env path)
-
-let transl_extension_path = transl_value_path
-
-(* Apply a substitution to a lambda-term.
-   Assumes that the bound variables of the lambda-term do not
-   belong to the domain of the substitution.
-   Assumes that the image of the substitution is out of reach
-   of the bound variables of the lambda-term (no capture). *)
-
-(* Substitution rebuilds through [shallow_map_sharing], so the result is
-   normalized and an untouched subterm is returned physically unchanged. *)
-let subst_lambda s lam =
-  let rec subst l =
-    match l with
-    | Lvar id -> ( try Ident.find_same id s with Not_found -> l)
-    | _ -> shallow_map_sharing subst l
-  in
-  subst lam
-
-let make_exit i = Lstaticraise (i, [])
-
-let rec as_simple_exit = function
-  | Lstaticraise (i, []) -> Some i
-  | Llet (Alias, _, _, e) -> as_simple_exit e
-  | _ -> None
-
-(* Introduce a catch around [handler], if worth it. Returns the exit number to
-   raise to, and a function wrapping a body in the catch - a body that turns
-   out to be exactly that raise gets the handler itself instead. *)
-let make_catch_delayed handler =
-  match as_simple_exit handler with
-  | Some i -> (i, fun act -> act)
-  | None -> (
-    let i = next_raise_count () in
-    ( i,
-      fun body ->
-        match body with
-        | Lstaticraise (j, _) -> if i = j then handler else body
-        | _ -> Lstaticcatch (body, (i, []), handler) ))
-
 (* To let-bind expressions to variables *)
 
 let bind str var exp body =
diff --git a/compiler/ml/lambda.mli b/compiler/ml/lambda.mli
index 731dad4956..d10c347064 100644
--- a/compiler/ml/lambda.mli
+++ b/compiler/ml/lambda.mli
@@ -430,7 +430,6 @@ and lambda_switch = t switch
 *)
 
 (* Sharing key *)
-val make_key : t -> t option
 
 val const_int : int -> structured_constant
 
@@ -448,22 +447,12 @@ val const_module_alias : structured_constant
 val lambda_assert_false : t
 val lambda_unit : t
 
-val eq_primitive_approx : primitive -> primitive -> bool
-
 val str_of_field_info : field_dbg_info -> string option
 
-val eq_comparison : comparison -> comparison -> bool
-
 val is_immutable_block : tag_info -> bool
 
 val const_is_allocating : structured_constant -> bool
 
-val const_eq_approx : structured_constant -> structured_constant -> bool
-
-val cmp_int32 : comparison -> int32 -> int32 -> bool
-
-val cmp_float : comparison -> float -> float -> bool
-
 (* Constructors. [t] is private, so every term outside this module is
    built through one of these.
 
@@ -547,12 +536,6 @@ val lambda_true : t
 
 val lambda_false : t
 
-val shallow_map_sharing : (t -> t) -> t -> t
-(** Rewrite a node's immediate children, rebuilding through the constructors
-    so the result is normalized. A node whose children are all physically
-    unchanged is returned as-is, so a traversal that rewrites nothing
-    allocates nothing. *)
-
 val eq_approx : t -> t -> bool
 
 val mk_builtin : builtin -> t list -> Location.t -> t
@@ -561,38 +544,6 @@ val mk_builtin : builtin -> t list -> Location.t -> t
 val lambda_module_alias : t
 val name_lambda : let_kind -> t -> (Ident.t -> t) -> t
 
-val shallow_exists : (t -> bool) -> t -> bool
-(** Does any immediate child satisfy the predicate? Short-circuits. *)
-
-val iter : (t -> unit) -> t -> unit
-val free_variables : t -> Set_ident.t
-
-val transl_normal_path : Path.t -> t (* Path.t is already normal *)
-
-val transl_module_path : ?loc:Location.t -> Env.t -> Path.t -> t
-val transl_value_path : ?loc:Location.t -> Env.t -> Path.t -> t
-val transl_extension_path : ?loc:Location.t -> Env.t -> Path.t -> t
-
-val subst_lambda : t Ident.tbl -> t -> t
 val bind : let_kind -> Ident.t -> t -> t -> t
 
 val default_function_attribute : function_attribute
-
-(***********************)
-(* For static failures *)
-(***********************)
-
-(* Get a new static failure ident *)
-val next_raise_count : unit -> int
-
-val make_exit : int -> t
-
-val as_simple_exit : t -> int option
-
-(* Exit number to raise to, and a wrapper that puts the catch around a body. *)
-val make_catch_delayed : t -> int * (t -> t)
-val next_negative_raise_count : unit -> int
-(* Negative raise counts are used to compile 'match ... with
-   exception x -> ...'.  This disabled some simplifications
-   performed by the Simplif module that assume that static raises
-   are in tail position in their handler. *)
diff --git a/compiler/ml/lambda_exits.ml b/compiler/ml/lambda_exits.ml
new file mode 100644
index 0000000000..d4c3c695d8
--- /dev/null
+++ b/compiler/ml/lambda_exits.ml
@@ -0,0 +1,56 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Static exits: the numbering, and the catch a handler is wrapped in.
+
+   An exit number names a jump; the counters hand out fresh ones. Negative
+   numbers are reserved for the exception cases of pattern matching, where
+   simplifications that assume a static raise sits in tail position of its
+   handler do not apply. *)
+
+open Lambda
+
+let raise_count = ref 0
+
+let next_raise_count () =
+  incr raise_count;
+  !raise_count
+
+let negative_raise_count = ref 0
+
+let next_negative_raise_count () =
+  decr negative_raise_count;
+  !negative_raise_count
+
+let make_exit i = staticraise i []
+
+let rec as_simple_exit = function
+  | Lstaticraise (i, []) -> Some i
+  | Llet (Alias, _, _, e) -> as_simple_exit e
+  | _ -> None
+
+(* Introduce a catch around [handler], if worth it. Returns the exit number to
+   raise to, and a function wrapping a body in the catch - a body that turns
+   out to be exactly that raise gets the handler itself instead. *)
+let make_catch_delayed handler =
+  match as_simple_exit handler with
+  | Some i -> (i, fun act -> act)
+  | None -> (
+    let i = next_raise_count () in
+    ( i,
+      fun body ->
+        match body with
+        | Lstaticraise (j, _) -> if i = j then handler else body
+        | _ -> staticcatch body (i, []) handler ))
diff --git a/compiler/ml/lambda_exits.mli b/compiler/ml/lambda_exits.mli
new file mode 100644
index 0000000000..f357ebf0cc
--- /dev/null
+++ b/compiler/ml/lambda_exits.mli
@@ -0,0 +1,33 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Static exits: the numbering, and the catch a handler is wrapped in. *)
+
+val next_raise_count : unit -> int
+(** A fresh exit number. *)
+
+val next_negative_raise_count : unit -> int
+(** A fresh negative exit number, reserved for [match ... with exception x],
+    where simplifications that assume a static raise sits in tail position of
+    its handler do not apply. *)
+
+val make_exit : int -> Lambda.t
+
+val as_simple_exit : Lambda.t -> int option
+(** The exit a term jumps to, when it is nothing but that jump. *)
+
+val make_catch_delayed : Lambda.t -> int * (Lambda.t -> Lambda.t)
+(** Exit number to raise to, and a wrapper that puts the catch around a body.
+    A body that turns out to be exactly that raise gets the handler itself. *)
diff --git a/compiler/ml/lambda_traverse.ml b/compiler/ml/lambda_traverse.ml
new file mode 100644
index 0000000000..f4e6cd4fe2
--- /dev/null
+++ b/compiler/ml/lambda_traverse.ml
@@ -0,0 +1,241 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Generic walks over a Lambda term: which variables are free, substituting
+   for them, and the canonical key two terms are compared by. Each builds only
+   through Lambda's constructors, so what comes out is normalized like any
+   other term. *)
+
+open Lambda
+
+(** [shallow_map_sharing f lam] rewrites [lam]'s immediate children with [f]
+    and rebuilds the node through its smart constructor, so the result is
+    normalized. A node whose children all come back physically unchanged is
+    returned as-is, so a traversal that rewrites nothing allocates nothing. *)
+let shallow_map_sharing (f : t -> t) (lam : t) : t =
+  match lam with
+  | Lvar _ | Lglobal_module _ | Lconst _ | Lbreak | Lcontinue -> lam
+  | Lapply ap ->
+    let fn = f ap.ap_func in
+    let args = Ext_list.map_sharing ap.ap_args f in
+    if fn == ap.ap_func && args == ap.ap_args then lam
+    else apply fn args ap.ap_info ~ap_transformed_jsx:ap.ap_transformed_jsx
+  | Lfunction {params; body; attr; loc} ->
+    let body' = f body in
+    if body' == body then lam else function_ ~loc ~attr ~params ~body:body'
+  | Llet (k, id, e, b) ->
+    let e' = f e and b' = f b in
+    if e' == e && b' == b then lam else let_ k id e' b'
+  | Lletrec (bs, b) ->
+    let bs' = Ext_list.map_snd_sharing bs f and b' = f b in
+    if bs' == bs && b' == b then lam else letrec bs' b'
+  | Lprim {primitive; args; loc} ->
+    let args' = Ext_list.map_sharing args f in
+    if args' == args then lam else prim ~primitive ~args:args' loc
+  | Lswitch (e, sw) ->
+    let e' = f e in
+    let consts = Ext_list.map_snd_sharing sw.sw_consts f in
+    let blocks = Ext_list.map_snd_sharing sw.sw_blocks f in
+    let fail = Ext_option.map_sharing sw.sw_failaction f in
+    if
+      e' == e && consts == sw.sw_consts && blocks == sw.sw_blocks
+      && fail == sw.sw_failaction
+    then lam
+    else
+      switch e'
+        {sw with sw_consts = consts; sw_blocks = blocks; sw_failaction = fail}
+  | Lstringswitch (e, cases, d) ->
+    let e' = f e in
+    let cases' = Ext_list.map_snd_sharing cases f in
+    let d' = Ext_option.map_sharing d f in
+    if e' == e && cases' == cases && d' == d then lam
+    else stringswitch e' cases' d'
+  | Lstaticraise (i, args) ->
+    let args' = Ext_list.map_sharing args f in
+    if args' == args then lam else staticraise i args'
+  | Lstaticcatch (b, h, hd) ->
+    let b' = f b and hd' = f hd in
+    if b' == b && hd' == hd then lam else staticcatch b' h hd'
+  | Ltrywith (b, id, h) ->
+    let b' = f b and h' = f h in
+    if b' == b && h' == h then lam else try_ b' id h'
+  | Lifthenelse (a, b, c) ->
+    let a' = f a and b' = f b and c' = f c in
+    if a' == a && b' == b && c' == c then lam else if_ a' b' c'
+  | Lsequence (a, b) ->
+    let a' = f a and b' = f b in
+    if a' == a && b' == b then lam else seq a' b'
+  | Lwhile (a, b) ->
+    let a' = f a and b' = f b in
+    if a' == a && b' == b then lam else while_ a' b'
+  | Lfor (id, a, b, d, c) ->
+    let a' = f a and b' = f b and c' = f c in
+    if a' == a && b' == b && c' == c then lam else for_ id a' b' d c'
+  | Lfor_of (id, a, b) ->
+    let a' = f a and b' = f b in
+    if a' == a && b' == b then lam else for_of id a' b'
+  | Lfor_await_of (id, a, b) ->
+    let a' = f a and b' = f b in
+    if a' == a && b' == b then lam else for_await_of id a' b'
+  | Lassign (id, b) ->
+    let b' = f b in
+    if b' == b then lam else assign id b'
+
+(*
+   Those keys are later compared with Pervasives.compare.
+   For that reason, they should not include cycles.
+*)
+
+exception Not_simple
+
+let max_raw = 32
+
+let make_key e =
+  let count = ref 0 (* Used for controling size *)
+  and make_key = Ident.make_key_generator () in
+  (* make_key is used for normalizing let-bound variables *)
+  let rec tr_rec env e =
+    incr count;
+    if !count > max_raw then raise_notrace Not_simple;
+    (* Too big ! *)
+    match e with
+    | Lvar id -> ( try Ident.find_same id env with Not_found -> e)
+    | Lglobal_module _ | Lconst _ -> e
+    | Lapply ap ->
+      apply ~ap_transformed_jsx:ap.ap_transformed_jsx (tr_rec env ap.ap_func)
+        (tr_recs env ap.ap_args)
+        {ap.ap_info with ap_loc = Location.none}
+    | Llet (Alias, x, ex, e) ->
+      (* Ignore aliases -> substitute *)
+      let ex = tr_rec env ex in
+      tr_rec (Ident.add x ex env) e
+    | Llet ((Strict | StrictOpt), x, ex, Lvar v) when Ident.same v x ->
+      tr_rec env ex
+    | Llet (str, x, ex, e) ->
+      (* Because of side effects, keep other lets with normalized names *)
+      let ex = tr_rec env ex in
+      let y = make_key x in
+      let_ str y ex (tr_rec (Ident.add x (var y) env) e)
+    | Lprim {primitive = p; args = es; loc = _} ->
+      prim ~primitive:p ~args:(tr_recs env es) Location.none
+    | Lswitch (e, sw) -> switch (tr_rec env e) (tr_sw env sw)
+    | Lstringswitch (e, sw, d) ->
+      stringswitch (tr_rec env e)
+        (List.map (fun (s, e) -> (s, tr_rec env e)) sw)
+        (tr_opt env d)
+    | Lstaticraise (i, es) -> staticraise i (tr_recs env es)
+    | Lstaticcatch (e1, xs, e2) ->
+      staticcatch (tr_rec env e1) xs (tr_rec env e2)
+    | Ltrywith (e1, x, e2) -> try_ (tr_rec env e1) x (tr_rec env e2)
+    | Lifthenelse (cond, ifso, ifnot) ->
+      if_ (tr_rec env cond) (tr_rec env ifso) (tr_rec env ifnot)
+    | Lsequence (e1, e2) -> seq (tr_rec env e1) (tr_rec env e2)
+    | Lbreak -> break
+    | Lcontinue -> continue
+    | Lassign (x, e) -> assign x (tr_rec env e)
+    | Lletrec _ | Lfunction _ | Lfor _ | Lfor_of _ | Lfor_await_of _ | Lwhile _
+      ->
+      raise_notrace Not_simple
+  and tr_recs env es = List.map (tr_rec env) es
+  and tr_sw env sw =
+    {
+      sw with
+      sw_consts = List.map (fun (i, e) -> (i, tr_rec env e)) sw.sw_consts;
+      sw_blocks = List.map (fun (i, e) -> (i, tr_rec env e)) sw.sw_blocks;
+      sw_failaction = tr_opt env sw.sw_failaction;
+    }
+  and tr_opt env = function
+    | None -> None
+    | Some e -> Some (tr_rec env e)
+  in
+
+  try Some (tr_rec Ident.empty e) with Not_simple -> None
+
+(* Does any immediate child satisfy [f]? Short-circuits. *)
+let shallow_exists (f : t -> bool) (lam : t) : bool =
+  match lam with
+  | Lvar _ | Lglobal_module _ | Lconst _ | Lbreak | Lcontinue -> false
+  | Lapply {ap_func; ap_args} -> f ap_func || Ext_list.exists ap_args f
+  | Lfunction {body} -> f body
+  | Llet (_, _, arg, body) -> f arg || f body
+  | Lletrec (decl, body) -> f body || Ext_list.exists_snd decl f
+  | Lprim {args} -> Ext_list.exists args f
+  | Lswitch (arg, {sw_consts; sw_blocks; sw_failaction}) ->
+    f arg
+    || Ext_list.exists_snd sw_consts f
+    || Ext_list.exists_snd sw_blocks f
+    || Ext_option.exists sw_failaction f
+  | Lstringswitch (arg, cases, default) ->
+    f arg || Ext_list.exists_snd cases f || Ext_option.exists default f
+  | Lstaticraise (_, args) -> Ext_list.exists args f
+  | Lstaticcatch (e1, _, e2) -> f e1 || f e2
+  | Ltrywith (e1, _, e2) -> f e1 || f e2
+  | Lifthenelse (e1, e2, e3) -> f e1 || f e2 || f e3
+  | Lsequence (e1, e2) -> f e1 || f e2
+  | Lwhile (e1, e2) -> f e1 || f e2
+  | Lfor (_, e1, e2, _, e3) -> f e1 || f e2 || f e3
+  | Lfor_of (_, e1, e2) | Lfor_await_of (_, e1, e2) -> f e1 || f e2
+  | Lassign (_, e) -> f e
+
+let iter f lam =
+  ignore
+    (shallow_exists
+       (fun x ->
+         f x;
+         false)
+       lam)
+
+let free_ids get l =
+  let fv = ref Set_ident.empty in
+  let rec free l =
+    iter free l;
+    fv := List.fold_left Set_ident.add !fv (get l);
+    match l with
+    | Lfunction {params} ->
+      List.iter (fun param -> fv := Set_ident.remove !fv param) params
+    | Llet (_str, id, _arg, _body) -> fv := Set_ident.remove !fv id
+    | Lletrec (decl, _body) ->
+      List.iter (fun (id, _exp) -> fv := Set_ident.remove !fv id) decl
+    | Lstaticcatch (_e1, (_, vars), _e2) ->
+      List.iter (fun id -> fv := Set_ident.remove !fv id) vars
+    | Ltrywith (_e1, exn, _e2) -> fv := Set_ident.remove !fv exn
+    | Lfor (v, _e1, _e2, _dir, _e3) -> fv := Set_ident.remove !fv v
+    | Lfor_of (v, _e1, _e2) | Lfor_await_of (v, _e1, _e2) ->
+      fv := Set_ident.remove !fv v
+    | Lassign (id, _e) -> fv := Set_ident.add !fv id
+    | Lvar _ | Lglobal_module _ | Lconst _ | Lapply _ | Lprim _ | Lswitch _
+    | Lstringswitch _ | Lstaticraise _ | Lifthenelse _ | Lsequence _ | Lbreak
+    | Lcontinue | Lwhile _ ->
+      ()
+  in
+  free l;
+  !fv
+
+let free_variables l =
+  free_ids
+    (function
+      | Lvar id -> [id]
+      | _ -> [])
+    l
+
+(* Substitution rebuilds through [shallow_map_sharing], so the result is
+   normalized and an untouched subterm is returned physically unchanged. *)
+let subst_lambda s lam =
+  let rec subst l =
+    match l with
+    | Lvar id -> ( try Ident.find_same id s with Not_found -> l)
+    | _ -> shallow_map_sharing subst l
+  in
+  subst lam
diff --git a/compiler/ml/lambda_traverse.mli b/compiler/ml/lambda_traverse.mli
new file mode 100644
index 0000000000..3e5d0267f3
--- /dev/null
+++ b/compiler/ml/lambda_traverse.mli
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Generic walks over a Lambda term. Each builds only through Lambda's
+   constructors, so what comes out is normalized like any other term. *)
+
+val shallow_exists : (Lambda.t -> bool) -> Lambda.t -> bool
+(** Does any immediate child satisfy the predicate? Short-circuits. *)
+
+val shallow_map_sharing : (Lambda.t -> Lambda.t) -> Lambda.t -> Lambda.t
+(** Rewrite a node's immediate children. A node whose children all come back
+    physically unchanged is returned as-is, so a traversal that rewrites
+    nothing allocates nothing. *)
+
+val iter : (Lambda.t -> unit) -> Lambda.t -> unit
+
+val free_variables : Lambda.t -> Set_ident.t
+
+val subst_lambda : Lambda.t Ident.tbl -> Lambda.t -> Lambda.t
+(** Substitute for the free variables in the domain of the substitution.
+    Assumes the substitution's image is out of reach of the term's bound
+    variables, so no capture can occur. *)
+
+val make_key : Lambda.t -> Lambda.t option
+(** A canonical form for comparing two terms: locations are dropped, alias
+    bindings are substituted away, and remaining binders are renumbered. Only
+    for comparison - the result is not meant to be emitted. [None] when the
+    term is too big, or contains a form the key cannot canonicalize. *)
diff --git a/compiler/ml/matching.ml b/compiler/ml/matching.ml
index aa5fb03e01..15542f4a75 100644
--- a/compiler/ml/matching.ml
+++ b/compiler/ml/matching.ml
@@ -385,12 +385,17 @@ let action_key_term ~fail a = action_body_with ~fail a
 let action_free_variables {binds; guard; body} =
   let inner =
     match guard with
-    | None -> free_variables body
-    | Some g -> Set_ident.union (free_variables body) (free_variables g)
+    | None -> Lambda_traverse.free_variables body
+    | Some g ->
+      Set_ident.union
+        (Lambda_traverse.free_variables body)
+        (Lambda_traverse.free_variables g)
   in
   List.fold_right
     (fun (_, id, e) acc ->
-      Set_ident.union (free_variables e) (Set_ident.remove acc id))
+      Set_ident.union
+        (Lambda_traverse.free_variables e)
+        (Set_ident.remove acc id))
     binds inner
 
 type pattern_matching = {
@@ -491,16 +496,11 @@ module Store_exp = Switch.Store (struct
   type t = Lambda.t
   type key = Lambda.t
   let compare_key = compare
-  let make_key = Lambda.make_key
+  let make_key = Lambda_traverse.make_key
 end)
 
-let raw_action l =
-  match make_key l with
-  | Some l -> l
-  | None -> l
-
 let tr_raw act =
-  match make_key act with
+  match Lambda_traverse.make_key act with
   | Some act -> act
   | None -> raise Exit
 
@@ -870,7 +870,7 @@ let rec split_or argo cls args def =
       let {me = next; matrix; top_default = def}, nexts =
         do_split [] [] [] rem
       in
-      let idef = next_raise_count () in
+      let idef = Lambda_exits.next_raise_count () in
       precompile_or argo yes yesor args
         (cons_default matrix idef def)
         ((idef, next) :: nexts)
@@ -900,7 +900,7 @@ and split_naive cls args def k =
           let {me = next; matrix; top_default = def}, nexts =
             split_exc cstr [cl] rem
           in
-          let idef = next_raise_count () in
+          let idef = Lambda_exits.next_raise_count () in
           let def = cons_default matrix idef def in
           ( {
               me = Pm {cases = yes; args; default = def};
@@ -913,7 +913,7 @@ and split_naive cls args def k =
         let {me = next; matrix; top_default = def}, nexts =
           split_noexc [cl] rem
         in
-        let idef = next_raise_count () in
+        let idef = Lambda_exits.next_raise_count () in
         let def = cons_default matrix idef def in
         ( {
             me = Pm {cases = yes; args; default = def};
@@ -930,7 +930,7 @@ and split_naive cls args def k =
         let {me = next; matrix; top_default = def}, nexts =
           split_exc (pat_as_constr p) [cl] rem
         in
-        let idef = next_raise_count () in
+        let idef = Lambda_exits.next_raise_count () in
         precompile_var args yes
           (cons_default matrix idef def)
           ((idef, next) :: nexts)
@@ -974,7 +974,7 @@ and split_constr cls args def k =
             let {me = next; matrix; top_default = def}, nexts =
               split_noex [cl] [] rem
             in
-            let idef = next_raise_count () in
+            let idef = Lambda_exits.next_raise_count () in
             let def = cons_default matrix idef def in
             ( {
                 me = Pm {cases = yes; args; default = def};
@@ -995,7 +995,7 @@ and split_constr cls args def k =
           let {me = next; matrix; top_default = def}, nexts =
             split_ex [cl] [] rem
           in
-          let idef = next_raise_count () in
+          let idef = Lambda_exits.next_raise_count () in
           precompile_var args yes
             (cons_default matrix idef def)
             ((idef, next) :: nexts))
@@ -1089,7 +1089,7 @@ and precompile_or argo cls ors args def k =
                (extract_vars Set_ident.empty orp)
                (pm_free_variables orpm))
         in
-        let or_num = next_raise_count () in
+        let or_num = Lambda_exits.next_raise_count () in
         let new_patl = Parmatch.omega_list patl in
 
         let mk_new_action vs =
@@ -1565,10 +1565,10 @@ let handle_shared () =
     match act with
     | Switch.Single act -> act
     | Switch.Shared act ->
-      let i, h = make_catch_delayed act in
+      let i, h = Lambda_exits.make_catch_delayed act in
       let ohs = !hs in
       (hs := fun act -> h (ohs act));
-      make_exit i
+      Lambda_exits.make_exit i
   in
   (hs, handle_shared)
 
@@ -1699,7 +1699,7 @@ let reintroduce_fail sw =
   | None ->
     let t = Hashtbl.create 17 in
     let seen (_, l) =
-      match as_simple_exit l with
+      match Lambda_exits.as_simple_exit l with
       | Some i ->
         let old = try Hashtbl.find t i with Not_found -> 0 in
         Hashtbl.replace t i (old + 1)
@@ -1721,7 +1721,7 @@ let reintroduce_fail sw =
       let default = !i_max in
       let remove ls =
         Ext_list.filter ls (fun (_, lam) ->
-            match as_simple_exit lam with
+            match Lambda_exits.as_simple_exit lam with
             | Some j -> j <> default
             | None -> true)
       in
@@ -1735,7 +1735,7 @@ let reintroduce_fail sw =
         sw_blocks_full =
           sw.sw_blocks_full && List.length sw_blocks = List.length sw.sw_blocks;
         sw_blocks;
-        sw_failaction = Some (make_exit default);
+        sw_failaction = Some (Lambda_exits.make_exit default);
       }
     else sw
   | Some _ -> sw
@@ -2130,7 +2130,7 @@ let combine_constructor loc arg ex_pat cstr partial ctx def
         let tests =
           List.fold_right
             (fun (path, act) rem ->
-              let ext = transl_extension_path ex_pat.pat_env path in
+              let ext = Transl_path.transl_extension_path ex_pat.pat_env path in
               if_
                 (prim ~primitive:(Pstringcomp Ceq)
                    ~args:
@@ -2315,6 +2315,24 @@ let compile_list compile_fun division =
   in
   c_rec [] division
 
+(* Is [lam] a jump to a static exit, once alias bindings are seen through?
+   Those bindings are dropped along with [lam], so they are substituted into
+   the raise's arguments rather than left dangling. Recognising this from the
+   term itself keeps Lambda_traverse.make_key's output where it belongs - in comparisons. *)
+let as_exit_call lam =
+  let rec go env lam =
+    match lam with
+    | Lstaticraise (i, args) ->
+      Some
+        ( i,
+          if env == Ident.empty then args
+          else Ext_list.map args (Lambda_traverse.subst_lambda env) )
+    | Llet (Alias, x, ex, body) ->
+      go (Ident.add x (Lambda_traverse.subst_lambda env ex) env) body
+    | _ -> None
+  in
+  go Ident.empty lam
+
 let compile_orhandlers compile_fun lambda1 total1 ctx to_catch =
   let rec do_rec r total_r = function
     | [] -> (r, total_r)
@@ -2322,13 +2340,13 @@ let compile_orhandlers compile_fun lambda1 total1 ctx to_catch =
       try
         let ctx = select_columns mat ctx in
         let handler_i, total_i = compile_fun ctx pm in
-        match raw_action r with
-        | Lstaticraise (j, args) ->
+        match as_exit_call r with
+        | Some (j, args) ->
           if i = j then
             ( List.fold_right2 (bind Alias) vars args handler_i,
               jumps_map (ctx_rshift_num (ncols mat)) total_i )
           else do_rec r total_r rem
-        | _ ->
+        | None ->
           do_rec
             (staticcatch r (i, vars) handler_i)
             (jumps_union (jumps_remove i total_r)
@@ -2638,7 +2656,7 @@ let compile_matching repr handler_fun arg pat_act_list partial =
   let partial = check_partial pat_act_list partial in
   match partial with
   | Partial -> (
-    let raise_num = next_raise_count () in
+    let raise_num = Lambda_exits.next_raise_count () in
     let pm =
       {
         cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
@@ -2672,7 +2690,7 @@ let partial_function loc () =
         prim ~primitive:(Pmakeblock Blk_extension)
           ~args:
             [
-              transl_normal_path Predef.path_match_failure;
+              Transl_path.transl_normal_path Predef.path_match_failure;
               const
                 (Const_block
                    ( Blk_tuple,
@@ -2835,7 +2853,7 @@ let do_for_multiple_match loc paraml pat_act_list partial =
   let raise_num, pm1 =
     match partial with
     | Partial ->
-      let raise_num = next_raise_count () in
+      let raise_num = Lambda_exits.next_raise_count () in
       ( raise_num,
         {
           cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
diff --git a/compiler/ml/switch.ml b/compiler/ml/switch.ml
index 714a030eb8..55c236f83f 100644
--- a/compiler/ml/switch.ml
+++ b/compiler/ml/switch.ml
@@ -732,10 +732,10 @@ let abstract_shared actions =
         match act with
         | Single act -> act
         | Shared act ->
-          let i, h = make_catch_delayed act in
+          let i, h = Lambda_exits.make_catch_delayed act in
           let oh = !handlers in
           (handlers := fun act -> h (oh act));
-          make_exit i)
+          Lambda_exits.make_exit i)
       actions
   in
   (!handlers, actions)
diff --git a/compiler/ml/transl_path.ml b/compiler/ml/transl_path.ml
new file mode 100644
index 0000000000..f811c73f85
--- /dev/null
+++ b/compiler/ml/transl_path.ml
@@ -0,0 +1,52 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Translating a path to the term that reads it. This is translation rather
+   than representation, and is the only part that needed the type checker's
+   environment. *)
+
+open Lambda
+
+(* Translate an access path *)
+
+let rec transl_normal_path = function
+  | Path.Pident id ->
+    (* A predefined exception is its own name at runtime, so the reference is
+       that string rather than a module. *)
+    if Ident.is_predef_exn id then const (Const_string id.name)
+    else if Ident.global id then global_module id
+    else var id
+  | Pdot (p, s, pos) ->
+    prim
+      ~primitive:(Pfield (pos, Fld_module {name = s}))
+      ~args:[transl_normal_path p]
+      Location.none
+  | Papply _ -> assert false
+
+(* Translation of identifiers *)
+
+let transl_module_path ?(loc = Location.none) env path =
+  transl_normal_path (Env.normalize_path (Some loc) env path)
+
+let transl_value_path ?(loc = Location.none) env path =
+  transl_normal_path (Env.normalize_path_prefix (Some loc) env path)
+
+let transl_extension_path = transl_value_path
+
+(* Apply a substitution to a lambda-term.
+   Assumes that the bound variables of the lambda-term do not
+   belong to the domain of the substitution.
+   Assumes that the image of the substitution is out of reach
+   of the bound variables of the lambda-term (no capture). *)
diff --git a/compiler/ml/transl_path.mli b/compiler/ml/transl_path.mli
new file mode 100644
index 0000000000..0f840427a9
--- /dev/null
+++ b/compiler/ml/transl_path.mli
@@ -0,0 +1,25 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Translating a path to the term that reads it. *)
+
+val transl_normal_path : Path.t -> Lambda.t
+(** The path is already normalized. *)
+
+val transl_module_path : ?loc:Location.t -> Env.t -> Path.t -> Lambda.t
+
+val transl_value_path : ?loc:Location.t -> Env.t -> Path.t -> Lambda.t
+
+val transl_extension_path : ?loc:Location.t -> Env.t -> Path.t -> Lambda.t
diff --git a/compiler/ml/transl_recmodule.ml b/compiler/ml/transl_recmodule.ml
index 986aba723d..e22dd39dab 100644
--- a/compiler/ml/transl_recmodule.ml
+++ b/compiler/ml/transl_recmodule.ml
@@ -87,7 +87,7 @@ let reorder_rec_bindings bindings =
   and loc = Array.of_list (List.map (fun (_, loc, _, _) -> loc) bindings)
   and init = Array.of_list (List.map (fun (_, _, init, _) -> init) bindings)
   and rhs = Array.of_list (List.map (fun (_, _, _, rhs) -> rhs) bindings) in
-  let fv = Array.map Lambda.free_variables rhs in
+  let fv = Array.map Lambda_traverse.free_variables rhs in
   let num_bindings = Array.length id in
   let status = Array.make num_bindings Undefined in
   let res = ref [] in
diff --git a/compiler/ml/translcore.ml b/compiler/ml/translcore.ml
index 98677338cb..eeded0f64b 100644
--- a/compiler/ml/translcore.ml
+++ b/compiler/ml/translcore.ml
@@ -50,7 +50,7 @@ let transl_extension_constructor env path ext =
   let loc = ext.ext_loc in
   match ext.ext_kind with
   | Text_decl _ -> prim ~primitive:(Pcreate_extension name) ~args:[] loc
-  | Text_rebind (path, _lid) -> transl_extension_path ~loc env path
+  | Text_rebind (path, _lid) -> Transl_path.transl_extension_path ~loc env path
 
 (* Translation of primitives *)
 
@@ -480,7 +480,7 @@ let import_source_of_arg (arg : Typedtree.expression) : Lambda.import_source =
       Lambda.import_source =
     (* a module path is normalized fully (resolving a final alias hop such
        as a namespace's [module List = Stdlib_List]); a value path
-       normalizes its module prefix, like [transl_value_path] *)
+       normalizes its module prefix, like [Transl_path.transl_value_path] *)
     let path =
       if is_module then Env.normalize_path (Some loc) env path
       else Env.normalize_path_prefix (Some loc) env path
@@ -884,7 +884,7 @@ let assert_failed exp =
         prim ~primitive:(Pmakeblock Blk_extension)
           ~args:
             [
-              transl_normal_path Predef.path_assert_failure;
+              Transl_path.transl_normal_path Predef.path_assert_failure;
               const
                 (Const_block
                    ( Blk_tuple,
@@ -1005,7 +1005,7 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.t =
   | Texp_ident (_, _, ({val_kind = Val_prim p} as vd)) ->
     transl_primitive e.exp_loc p e.exp_env e.exp_type ~val_type:vd.val_type
   | Texp_ident (path, _, {val_kind = Val_reg}) ->
-    transl_value_path ~loc:e.exp_loc e.exp_env path
+    Transl_path.transl_value_path ~loc:e.exp_loc e.exp_env path
   | Texp_constant cst -> const (const_of_typed cst)
   | Texp_let (rec_flag, pat_expr_list, body) ->
     transl_let ~js_hoist:None rec_flag pat_expr_list (transl_exp body)
@@ -1198,9 +1198,10 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.t =
             prim ~primitive:(Pmakeblock tag_info) ~args:ll e.exp_loc)
       | Extension_constructor path ->
         prim ~primitive:(Pmakeblock Blk_extension)
-          ~args:(transl_extension_path e.exp_env path :: ll)
+          ~args:(Transl_path.transl_extension_path e.exp_env path :: ll)
           e.exp_loc)
-  | Texp_extension_constructor (_, path) -> transl_extension_path e.exp_env path
+  | Texp_extension_constructor (_, path) ->
+    Transl_path.transl_extension_path e.exp_env path
   | Texp_variant (l, arg) -> (
     match arg with
     | None -> const (const_polyvar l)
@@ -1538,7 +1539,7 @@ and transl_record loc env fields repres opt_init_expr =
               | Tconstr (p, _, _) -> p
               | _ -> assert false
             in
-            let slot = transl_extension_path env path in
+            let slot = Transl_path.transl_extension_path env path in
             prim
               ~primitive:(Pmakeblock (Lambda.blk_record_ext fields mut))
               ~args:(slot :: ll) loc)
@@ -1581,7 +1582,7 @@ and transl_match e arg pat_expr_list exn_pat_expr_list partial =
   and cases = transl_cases pat_expr_list
   and exn_cases = transl_cases exn_pat_expr_list in
   let static_catch body val_ids handler =
-    let static_exception_id = next_negative_raise_count () in
+    let static_exception_id = Lambda_exits.next_negative_raise_count () in
     let exn_handler = Matching.for_trywith (var id) exn_cases in
     let id, exn_handler = pack_trywith_exn id exn_handler in
     staticcatch
diff --git a/compiler/ml/translmod.ml b/compiler/ml/translmod.ml
index cd8125fc22..6e9d02b88e 100644
--- a/compiler/ml/translmod.ml
+++ b/compiler/ml/translmod.ml
@@ -101,7 +101,7 @@ let rec apply_coercion loc strict (restr : Typedtree.module_coercion) arg =
     Translcore.transl_primitive pc_loc pc_desc pc_env pc_type ~val_type:pc_type
   | Tcoerce_alias (path, cc) ->
     Lambda.name_lambda strict arg (fun _ ->
-        apply_coercion loc Alias cc (Lambda.transl_normal_path path))
+        apply_coercion loc Alias cc (Transl_path.transl_normal_path path))
 
 and apply_coercion_result loc strict funct param arg cc_res =
   Lambda.name_lambda strict funct (fun id ->
@@ -114,7 +114,7 @@ and apply_coercion_result loc strict funct param arg cc_res =
                 {ap_loc = loc; ap_inlined = Default_inline})))
 
 and wrap_id_pos_list loc id_pos_list get_field lam =
-  let fv = Lambda.free_variables lam in
+  let fv = Lambda_traverse.free_variables lam in
   (*Format.eprintf "%a@." Printlambda.lambda lam;
     IdentSet.iter (fun id -> Format.eprintf "%a " Ident.print id) fv;
     Format.eprintf "@.";*)
@@ -130,7 +130,7 @@ and wrap_id_pos_list loc id_pos_list get_field lam =
         else (lam, s))
       (lam, Ident.empty) id_pos_list
   in
-  if s == Ident.empty then lam else Lambda.subst_lambda s lam
+  if s == Ident.empty then lam else Lambda_traverse.subst_lambda s lam
 
 (* Compose two coercions
    apply_coercion c1 (apply_coercion c2 e) behaves like
@@ -274,7 +274,7 @@ and transl_module cc rootpath mexp =
     match mexp.mod_desc with
     | Tmod_ident (path, _) ->
       apply_coercion loc Strict cc
-        (Lambda.transl_module_path ~loc mexp.mod_env path)
+        (Transl_path.transl_module_path ~loc mexp.mod_env path)
     | Tmod_structure str -> fst (transl_struct loc [] cc rootpath str)
     | Tmod_functor _ -> compile_functor mexp cc rootpath loc
     | Tmod_apply (funct, arg, ccarg) ->
diff --git a/tests/ounit_tests/ounit_js_analyzer_tests.ml b/tests/ounit_tests/ounit_js_analyzer_tests.ml
index 47e885e23f..ee8a55aec0 100644
--- a/tests/ounit_tests/ounit_js_analyzer_tests.ml
+++ b/tests/ounit_tests/ounit_js_analyzer_tests.ml
@@ -78,6 +78,29 @@ let suites =
          ( __LOC__ >:: fun _ ->
            OUnit.assert_bool __LOC__
              (not (Js_analyzer.no_side_effect_statement for_of_statement)) );
+         ( __LOC__ >:: fun _ ->
+           (* [2n ** -1n] throws *)
+           OUnit.assert_bool __LOC__
+             (not
+                (Js_analyzer.no_side_effect_expression
+                   (Js_exp_make.bigint_op Js_op.Pow
+                      (Js_exp_make.bigint true "2")
+                      (Js_exp_make.bigint false "1")))) );
+         ( __LOC__ >:: fun _ ->
+           (* an unknown divisor may be a zero BigInt *)
+           OUnit.assert_bool __LOC__
+             (not
+                (Js_analyzer.no_side_effect_expression
+                   (Js_exp_make.bigint_op Js_op.Div
+                      (Js_exp_make.var (Ident.create "a"))
+                      (Js_exp_make.var (Ident.create "b"))))) );
+         ( __LOC__ >:: fun _ ->
+           (* a literal right operand that cannot throw keeps it pure *)
+           OUnit.assert_bool __LOC__
+             (Js_analyzer.no_side_effect_expression
+                (Js_exp_make.bigint_op Js_op.Mod
+                   (Js_exp_make.var (Ident.create "a"))
+                   (Js_exp_make.int 2l))) );
          ( __LOC__ >:: fun _ ->
            OUnit.assert_bool __LOC__
              (not (Js_analyzer.no_side_effect_statement for_await_of_statement))
diff --git a/tests/ounit_tests/ounit_sroa_tests.ml b/tests/ounit_tests/ounit_sroa_tests.ml
index c61dd7feb0..bfc79011d2 100644
--- a/tests/ounit_tests/ounit_sroa_tests.ml
+++ b/tests/ounit_tests/ounit_sroa_tests.ml
@@ -16,6 +16,12 @@ let write block index value =
 
 let debugger = Lambda.prim ~primitive:Pdebugger ~args:[] loc
 
+let bigint_power =
+  Lambda.prim ~primitive:Ppowbigint
+    ~args:
+      [Lambda.var (Ident.create "base"); Lambda.var (Ident.create "exponent")]
+    loc
+
 let count_debuggers lam =
   let count = ref 0 in
   let rec loop (lam : Lambda.t) =
@@ -23,7 +29,7 @@ let count_debuggers lam =
     | Lprim {primitive = Pdebugger} -> incr count
     | _ -> ());
     ignore
-      (Lambda.shallow_exists
+      (Lambda_traverse.shallow_exists
          (fun child ->
            loop child;
            false)
@@ -32,11 +38,19 @@ let count_debuggers lam =
   loop lam;
   !count
 
+let contains_bigint_power lam =
+  let rec loop (lam : Lambda.t) =
+    match lam with
+    | Lprim {primitive = Ppowbigint} -> true
+    | _ -> Lambda_traverse.shallow_exists loop lam
+  in
+  loop lam
+
 let contains_storage lam =
   let rec loop (lam : Lambda.t) =
     match lam with
     | Llet _ | Lassign _ -> true
-    | _ -> Lambda.shallow_exists loop lam
+    | _ -> Lambda_traverse.shallow_exists loop lam
   in
   loop lam
 
@@ -170,6 +184,18 @@ let suites =
              assert_bool "write-only fields have no scalar storage"
                (not (contains_storage replacement))
            | None -> assert_failure "expected write-only fields to scalarize" );
+         ( "keeps a throwing write value as an effect" >:: fun _ ->
+           let block = Ident.create "cell" in
+           match
+             Lam_pass_sroa.replace ~block ~info:Lambda.ref_tag_info
+               ~initializers:[Lambda.const (Lambda.Const_bigint (true, "0"))]
+               (write block 0 bigint_power)
+           with
+           | Some replacement ->
+             assert_bool "the value that may raise is still evaluated"
+               (contains_bigint_power replacement)
+           | None -> assert_failure "expected the write-only field to scalarize"
+         );
          ( "removes write-only storage captured by a closure" >:: fun _ ->
            let block = Ident.create "cell" in
            let closure =
diff --git a/tests/tests/src/effect_analysis_test.mjs b/tests/tests/src/effect_analysis_test.mjs
new file mode 100644
index 0000000000..4878a6cf90
--- /dev/null
+++ b/tests/tests/src/effect_analysis_test.mjs
@@ -0,0 +1,34 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Mocha from "mocha";
+import * as Test_utils from "./test_utils.mjs";
+import * as Primitive_array from "@rescript/runtime/lib/es6/Primitive_array.mjs";
+import * as Primitive_string from "@rescript/runtime/lib/es6/Primitive_string.mjs";
+
+function unusedBigintPower() {
+  2n ** -1n;
+  return 1;
+}
+
+function unusedCheckedArrayRead() {
+  Primitive_array.get([], 100);
+  return 1;
+}
+
+function unusedCheckedStringRead() {
+  Primitive_string.getChar("", 100);
+  return 1;
+}
+
+Mocha.describe("Effect_analysis_test", () => {
+  Mocha.test("keeps an unused bigint power that throws", () => Test_utils.throws("File \"effect_analysis_test.res\", line 26, characters 64-71", unusedBigintPower));
+  Mocha.test("keeps an unused bounds-checked array read", () => Test_utils.throws("File \"effect_analysis_test.res\", line 27, characters 65-72", unusedCheckedArrayRead));
+  Mocha.test("keeps an unused bounds-checked string read", () => Test_utils.throws("File \"effect_analysis_test.res\", line 28, characters 66-73", unusedCheckedStringRead));
+});
+
+export {
+  unusedBigintPower,
+  unusedCheckedArrayRead,
+  unusedCheckedStringRead,
+}
+/*  Not a pure module */
diff --git a/tests/tests/src/effect_analysis_test.res b/tests/tests/src/effect_analysis_test.res
new file mode 100644
index 0000000000..13402c1545
--- /dev/null
+++ b/tests/tests/src/effect_analysis_test.res
@@ -0,0 +1,29 @@
+open Mocha
+open Test_utils
+
+// Bindings that are never read are removed when their value has no side
+// effect. Raising is a side effect: the computations below must survive.
+
+external safeGet: (array<'a>, int) => 'a = "%array_safe_get"
+external charAt: (string, int) => char = "%string_safe_get"
+
+let unusedBigintPower = () => {
+  let _dropped = 2n ** -1n
+  1
+}
+
+let unusedCheckedArrayRead = () => {
+  let _dropped = safeGet([], 100)
+  1
+}
+
+let unusedCheckedStringRead = () => {
+  let _dropped = charAt("", 100)
+  1
+}
+
+describe(__MODULE__, () => {
+  test("keeps an unused bigint power that throws", () => throws(__LOC__, unusedBigintPower))
+  test("keeps an unused bounds-checked array read", () => throws(__LOC__, unusedCheckedArrayRead))
+  test("keeps an unused bounds-checked string read", () => throws(__LOC__, unusedCheckedStringRead))
+})
diff --git a/tests/tests/src/exponentiation_test.mjs b/tests/tests/src/exponentiation_test.mjs
index debb6adbc0..79dc7ff3e9 100644
--- a/tests/tests/src/exponentiation_test.mjs
+++ b/tests/tests/src/exponentiation_test.mjs
@@ -40,7 +40,7 @@ Mocha.describe("Exponentiation_test", () => {
     Test_utils.eq("File \"exponentiation_test.res\", line 32, characters 7-14", 2 ** (0 / 10000), 1);
     Test_utils.eq("File \"exponentiation_test.res\", line 33, characters 7-14", 2 ** (3 * 4), 4096);
     Test_utils.eq("File \"exponentiation_test.res\", line 34, characters 7-14", 2 ** (5 % 3), 4);
-    Test_utils.eq("File \"exponentiation_test.res\", line 35, characters 7-14", 2n ** (3n * 2n), 64n);
+    Test_utils.eq("File \"exponentiation_test.res\", line 35, characters 7-14", bigintPowMul(2n, 3n, 2n), 64n);
   });
 });
 
diff --git a/tests/tests/src/sroa_test.mjs b/tests/tests/src/sroa_test.mjs
index 7364a631be..1d323ae34f 100644
--- a/tests/tests/src/sroa_test.mjs
+++ b/tests/tests/src/sroa_test.mjs
@@ -125,21 +125,27 @@ function readOnlyFieldSnapshotsInitializer() {
   return cell;
 }
 
+function writeOnlyFieldStillRaises() {
+  let cell_live = 42;
+  2n ** -1n;
+  return cell_live;
+}
+
 Mocha.describe("Sroa_test", () => {
-  Mocha.test("scalarizes a local mutable record", () => Test_utils.eq("File \"sroa_test.res\", line 115, characters 53-60", 42, localPair()));
-  Mocha.test("shares scalar fields with closures", () => Test_utils.eq("File \"sroa_test.res\", line 116, characters 54-61", 32, capturedPair()));
-  Mocha.test("preserves initializer order", () => Test_utils.eq("File \"sroa_test.res\", line 117, characters 47-54", [
+  Mocha.test("scalarizes a local mutable record", () => Test_utils.eq("File \"sroa_test.res\", line 123, characters 53-60", 42, localPair()));
+  Mocha.test("shares scalar fields with closures", () => Test_utils.eq("File \"sroa_test.res\", line 124, characters 54-61", 32, capturedPair()));
+  Mocha.test("preserves initializer order", () => Test_utils.eq("File \"sroa_test.res\", line 125, characters 47-54", [
     4,
     [
       1,
       2
     ]
   ], initializationOrder()));
-  Mocha.test("retains an escaping record", () => Test_utils.eq("File \"sroa_test.res\", line 118, characters 46-53", 30, consumePair({
+  Mocha.test("retains an escaping record", () => Test_utils.eq("File \"sroa_test.res\", line 126, characters 46-53", 30, consumePair({
     left: 10,
     right: 20
   })));
-  Mocha.test("cleans up fields according to their uses", () => Test_utils.eq("File \"sroa_test.res\", line 120, characters 7-14", [
+  Mocha.test("cleans up fields according to their uses", () => Test_utils.eq("File \"sroa_test.res\", line 128, characters 7-14", [
     5,
     [
       2,
@@ -149,19 +155,20 @@ Mocha.describe("Sroa_test", () => {
       6
     ]
   ], fieldUseCleanup()));
-  Mocha.test("preserves overwritten initializer effects", () => Test_utils.eq("File \"sroa_test.res\", line 123, characters 7-14", [
+  Mocha.test("preserves overwritten initializer effects", () => Test_utils.eq("File \"sroa_test.res\", line 131, characters 7-14", [
     2,
     [
       1,
       2
     ]
   ], overwrittenBeforeRead()));
-  Mocha.test("removes write-only fields captured by closures", () => Test_utils.eq("File \"sroa_test.res\", line 126, characters 7-14", [
+  Mocha.test("removes write-only fields captured by closures", () => Test_utils.eq("File \"sroa_test.res\", line 134, characters 7-14", [
     1,
     2
   ], capturedWriteOnly()));
-  Mocha.test("does not evaluate writes in uncalled closures", () => Test_utils.eq("File \"sroa_test.res\", line 129, characters 7-14", [1], uncalledWriteOnlyClosure()));
-  Mocha.test("read-only fields snapshot their initializer", () => Test_utils.eq("File \"sroa_test.res\", line 132, characters 7-14", 1, readOnlyFieldSnapshotsInitializer()));
+  Mocha.test("does not evaluate writes in uncalled closures", () => Test_utils.eq("File \"sroa_test.res\", line 137, characters 7-14", [1], uncalledWriteOnlyClosure()));
+  Mocha.test("read-only fields snapshot their initializer", () => Test_utils.eq("File \"sroa_test.res\", line 140, characters 7-14", 1, readOnlyFieldSnapshotsInitializer()));
+  Mocha.test("preserves exceptions from write-only field values", () => Test_utils.throws("File \"sroa_test.res\", line 143, characters 11-18", writeOnlyFieldStillRaises));
 });
 
 export {
@@ -175,5 +182,6 @@ export {
   capturedWriteOnly,
   uncalledWriteOnlyClosure,
   readOnlyFieldSnapshotsInitializer,
+  writeOnlyFieldStillRaises,
 }
 /*  Not a pure module */
diff --git a/tests/tests/src/sroa_test.res b/tests/tests/src/sroa_test.res
index 725178766a..377417a314 100644
--- a/tests/tests/src/sroa_test.res
+++ b/tests/tests/src/sroa_test.res
@@ -16,6 +16,8 @@ type fieldUses = {
 
 type cell = {mutable value: int}
 
+type bigintCell = {mutable dead: bigint, mutable live: int}
+
 let localPair = () => {
   let pair = {left: 10, right: 20}
   pair.left = pair.left + 1
@@ -111,6 +113,12 @@ let readOnlyFieldSnapshotsInitializer = () => {
   cell.value
 }
 
+let writeOnlyFieldStillRaises = () => {
+  let cell = {dead: 0n, live: 42}
+  cell.dead = 2n ** -1n
+  cell.live
+}
+
 describe(__MODULE__, () => {
   test("scalarizes a local mutable record", () => eq(__LOC__, 42, localPair()))
   test("shares scalar fields with closures", () => eq(__LOC__, 32, capturedPair()))
@@ -131,4 +139,7 @@ describe(__MODULE__, () => {
   test("read-only fields snapshot their initializer", () =>
     eq(__LOC__, 1, readOnlyFieldSnapshotsInitializer())
   )
+  test("preserves exceptions from write-only field values", () =>
+    throws(__LOC__, writeOnlyFieldStillRaises)
+  )
 })