From e1573d73f16ada7497d68d4e968c342b91e382ef Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 11 Feb 2026 09:27:51 +0100
Subject: [PATCH 01/17] Compiler: block sharing stats

---
 compiler/lib/code.ml          | 19 +++++++++++++++++++
 compiler/lib/code.mli         |  2 ++
 compiler/lib/deadcode.ml      | 13 ++++++++++---
 compiler/lib/eval.ml          |  3 ++-
 compiler/lib/flow.ml          |  5 ++++-
 compiler/lib/inline.ml        |  5 ++++-
 compiler/lib/phisimpl.ml      |  5 ++++-
 compiler/lib/specialize.ml    | 10 ++++++++--
 compiler/lib/specialize_js.ml |  5 ++++-
 compiler/lib/tailcall.ml      |  5 ++++-
 10 files changed, 61 insertions(+), 11 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index b1bcb9d3ec..68eb503e48 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -928,6 +928,25 @@ let check_updates ~name p1 p2 ~updates =
       print_diff p1 p2;
       assert false
 
+let print_block_sharing ~name p1 p2 =
+  let shared = ref 0 in
+  let updated = ref 0 in
+  Addr.Map.iter
+    (fun pc b2 ->
+      match Addr.Map.find_opt pc p1.blocks with
+      | Some b1 when phys_equal b1 b2 -> incr shared
+      | Some _ -> incr updated
+      | None -> incr updated)
+    p2.blocks;
+  let removed = Addr.Map.cardinal p1.blocks - !shared - !updated in
+  Format.eprintf
+    "Stats - %s sharing: %d/%d blocks shared, %d updated, %d removed@."
+    name
+    !shared
+    (Addr.Map.cardinal p2.blocks)
+    !updated
+    removed
+
 let cont_equal (pc, args) (pc', args') = pc = pc' && List.equal ~eq:Var.equal args args'
 
 let cont_compare (pc, args) (pc', args') =
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index 8901ebf589..eaebe77c85 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -319,6 +319,8 @@ val print_diff : program -> program -> unit
 
 val check_updates : name:string -> program -> program -> updates:int -> unit
 
+val print_block_sharing : name:string -> program -> program -> unit
+
 val invariant : program -> unit
 
 val cont_equal : cont -> cont -> bool
diff --git a/compiler/lib/deadcode.ml b/compiler/lib/deadcode.ml
index fe6dec7bc6..b60d0ed6eb 100644
--- a/compiler/lib/deadcode.ml
+++ b/compiler/lib/deadcode.ml
@@ -213,7 +213,10 @@ let remove_unused_blocks p =
   let t = Timer.make () in
   let p, count = remove_unused_blocks' p in
   if times () then Format.eprintf "  dead block: %a@." Timer.print t;
-  if stats () then Format.eprintf "Stats - dead block: deleted %d@." count;
+  if stats ()
+  then (
+    Format.eprintf "Stats - dead block: deleted %d@." count;
+    Code.print_block_sharing ~name:"dead block" previous_p p);
   if debug_stats () then Code.check_updates ~name:"dead block" previous_p p ~updates:count;
   p
 
@@ -326,7 +329,10 @@ let merge_blocks p =
       Subst.Excluding_Binders.program rename p
   in
   if times () then Format.eprintf "  merge block: %a@." Timer.print t;
-  if stats () then Format.eprintf "Stats - merge block: merged %d@." !merged;
+  if stats ()
+  then (
+    Format.eprintf "Stats - merge block: merged %d@." !merged;
+    Code.print_block_sharing ~name:"merge block" previous_p p);
   if debug_stats ()
   then Code.check_updates ~name:"merge block" previous_p p ~updates:!merged;
   p
@@ -504,7 +510,7 @@ let f pure_funs ({ blocks; _ } as p : Code.program) =
   let p = remove_empty_blocks st p in
   if times () then Format.eprintf "  dead code elim.: %a@." Timer.print t;
   if stats ()
-  then
+  then (
     Format.eprintf
       "Stats - dead code: deleted %d instructions, %d blocks, %d parameters, %d \
        branches@."
@@ -512,6 +518,7 @@ let f pure_funs ({ blocks; _ } as p : Code.program) =
       st.deleted_blocks
       st.deleted_params
       st.block_shortcut;
+    Code.print_block_sharing ~name:"deadcode" previous_p p);
   if debug_stats ()
   then
     Code.check_updates
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index ed46ca0540..1f9c9219d0 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -856,7 +856,7 @@ let f info p =
   let p = { p with blocks } in
   if times () then Format.eprintf "  eval: %a@." Timer.print t;
   if stats ()
-  then
+  then (
     Format.eprintf
       "Stats - eval: %d optimizations, %d inlined cst, %d dropped exception handlers, %d \
        branch updated@."
@@ -864,6 +864,7 @@ let f info p =
       !inline_constant
       !drop_count
       !update_branch;
+    Code.print_block_sharing ~name:"eval" previous_p p);
   if debug_stats ()
   then
     Code.check_updates
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index f3a5650ca7..34847ad66c 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -602,7 +602,10 @@ let f p =
   let p = Subst.Excluding_Binders.program subst p in
   if times () then Format.eprintf "    flow analysis 5: %a@." Timer.print t5;
   if times () then Format.eprintf "  flow analysis: %a@." Timer.print t;
-  if stats () then Format.eprintf "Stats - flow updates: %d@." !count_uniq;
+  if stats ()
+  then (
+    Format.eprintf "Stats - flow updates: %d@." !count_uniq;
+    Code.print_block_sharing ~name:"flow" previous_p p);
   if debug_stats () then Code.check_updates ~name:"flow" previous_p p ~updates:!count_uniq;
   Code.invariant p;
   p, info
diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
index 7503addc9b..66fae92f0b 100644
--- a/compiler/lib/inline.ml
+++ b/compiler/lib/inline.ml
@@ -755,7 +755,10 @@ let f ~profile p live_vars =
   let t = Timer.make () in
   let p = inline ~profile ~inline_count p ~live_vars in
   if times () then Format.eprintf "  inlining: %a@." Timer.print t;
-  if stats () then Format.eprintf "Stats - inlining: %d inlined functions@." !inline_count;
+  if stats ()
+  then (
+    Format.eprintf "Stats - inlining: %d inlined functions@." !inline_count;
+    Code.print_block_sharing ~name:"inline" previous_p p);
   if debug_stats ()
   then Code.check_updates ~name:"inline" previous_p p ~updates:!inline_count;
   let p = Deadcode.remove_unused_blocks p in
diff --git a/compiler/lib/phisimpl.ml b/compiler/lib/phisimpl.ml
index a11b6de70d..128bc34a69 100644
--- a/compiler/lib/phisimpl.ml
+++ b/compiler/lib/phisimpl.ml
@@ -182,7 +182,10 @@ let f p =
   in
   let p = Subst.Excluding_Binders.program subst p in
   if times () then Format.eprintf "  phi-simpl.: %a@." Timer.print t;
-  if stats () then Format.eprintf "Stats - phi updates: %d@." !count_uniq;
+  if stats ()
+  then (
+    Format.eprintf "Stats - phi updates: %d@." !count_uniq;
+    Code.print_block_sharing ~name:"phi" previous_p p);
   if debug_stats () then Code.check_updates ~name:"phi" previous_p p ~updates:!count_uniq;
   Code.invariant p;
   p
diff --git a/compiler/lib/specialize.ml b/compiler/lib/specialize.ml
index c379847eb1..54bc7dd526 100644
--- a/compiler/lib/specialize.ml
+++ b/compiler/lib/specialize.ml
@@ -122,7 +122,10 @@ let f ~shape ~update_def p =
     if Config.Flag.optcall () then specialize_instrs ~shape ~update_def opt_count p else p
   in
   if times () then Format.eprintf "  optcall: %a@." Timer.print t;
-  if stats () then Format.eprintf "Stats - optcall: %d@." !opt_count;
+  if stats ()
+  then (
+    Format.eprintf "Stats - optcall: %d@." !opt_count;
+    Code.print_block_sharing ~name:"optcall" previous_p p);
   if debug_stats ()
   then Code.check_updates ~name:"optcall" previous_p p ~updates:!opt_count;
   Code.invariant p;
@@ -354,7 +357,10 @@ let switches p =
     }
   in
   if times () then Format.eprintf "  switches: %a@." Timer.print t;
-  if stats () then Format.eprintf "Stats - switches: %d@." !opt_count;
+  if stats ()
+  then (
+    Format.eprintf "Stats - switches: %d@." !opt_count;
+    Code.print_block_sharing ~name:"switches" previous_p p);
   if debug_stats ()
   then Code.check_updates ~name:"switches" previous_p p ~updates:!opt_count;
   Deadcode.remove_unused_blocks p
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 15b94ecca4..8d7370030a 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -421,7 +421,10 @@ let f info p =
   let opt_count = ref 0 in
   let p = specialize_all_instrs ~target:(Config.target ()) opt_count info p in
   if times () then Format.eprintf "  specialize_js: %a@." Timer.print t;
-  if stats () then Format.eprintf "Stats - specialize_js: %d@." !opt_count;
+  if stats ()
+  then (
+    Format.eprintf "Stats - specialize_js: %d@." !opt_count;
+    Code.print_block_sharing ~name:"specialize_js" previous_p p);
   if debug_stats ()
   then Code.check_updates ~name:"specialize_js" previous_p p ~updates:!opt_count;
   Code.invariant p;
diff --git a/compiler/lib/tailcall.ml b/compiler/lib/tailcall.ml
index 3d62e1ad16..6881bdd90a 100644
--- a/compiler/lib/tailcall.ml
+++ b/compiler/lib/tailcall.ml
@@ -149,7 +149,10 @@ let f p =
     p.blocks;
   let p = { p with blocks = !blocks; free_pc = !free_pc } in
   if times () then Format.eprintf "  tail calls: %a@." Timer.print t;
-  if stats () then Format.eprintf "Stats - tail calls: %d optimizations@." !update_count;
+  if stats ()
+  then (
+    Format.eprintf "Stats - tail calls: %d optimizations@." !update_count;
+    Code.print_block_sharing ~name:"tailcall" previous_p p);
   if debug_stats ()
   then Code.check_updates ~name:"tailcall" previous_p p ~updates:!update_count;
   Code.invariant p;

From c088177adf32242bca28d5a8671451e390175882 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 11 Feb 2026 09:53:33 +0100
Subject: [PATCH 02/17] Compiler: fix passes for more block sharing

---
 compiler/lib/code.ml          | 15 +++++++--------
 compiler/lib/code.mli         |  2 ++
 compiler/lib/deadcode.ml      |  6 ++++--
 compiler/lib/eval.ml          |  3 ++-
 compiler/lib/specialize_js.ml | 19 +++++++++++--------
 compiler/lib/subst.ml         |  8 +++++++-
 6 files changed, 33 insertions(+), 20 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index 68eb503e48..7715d8d41c 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -884,15 +884,14 @@ let return_values p =
           Var.Map.add name s rets)
     Var.Map.empty
 
+let block_equal b1 b2 =
+  phys_equal b1 b2
+  || (List.equal ~eq:Var.equal b1.params b2.params
+      && Poly.equal b1.branch b2.branch
+      && List.equal ~eq:Poly.equal b1.body b2.body)
+
 let equal p1 p2 =
-  p1.start = p2.start
-  && Addr.Map.equal
-       (fun { params; body; branch } b ->
-         List.equal ~eq:Var.equal params b.params
-         && Poly.equal branch b.branch
-         && List.equal ~eq:Poly.equal body b.body)
-       p1.blocks
-       p2.blocks
+  p1.start = p2.start && Addr.Map.equal block_equal p1.blocks p2.blocks
 
 let print_to_file p =
   let file = Filename.temp_file "jsoo" "prog" in
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index eaebe77c85..46eeb5728c 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -313,6 +313,8 @@ val compact : program -> program
 
 val is_empty : program -> bool
 
+val block_equal : block -> block -> bool
+
 val equal : program -> program -> bool
 
 val print_diff : program -> program -> unit
diff --git a/compiler/lib/deadcode.ml b/compiler/lib/deadcode.ml
index b60d0ed6eb..a6ae329055 100644
--- a/compiler/lib/deadcode.ml
+++ b/compiler/lib/deadcode.ml
@@ -486,7 +486,7 @@ let f pure_funs ({ blocks; _ } as p : Code.program) =
             st.deleted_blocks <- st.deleted_blocks + 1;
             None)
           else
-            Some
+            let block' =
               { params = List.filter block.params ~f:(fun x -> st.live.(Var.idx x) > 0)
               ; body =
                   List.fold_left block.body ~init:[] ~f:(fun acc i ->
@@ -502,7 +502,9 @@ let f pure_funs ({ blocks; _ } as p : Code.program) =
                             acc))
                   |> List.rev
               ; branch = filter_live_last all_blocks st block.branch
-              })
+              }
+            in
+            Some (if Code.block_equal block block' then block else block'))
         blocks
     in
     { p with blocks }
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 1f9c9219d0..886cd53169 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -832,7 +832,8 @@ let eval update_count update_branch inline_constant ~target info blocks =
           ~f:(eval_instr update_count inline_constant ~target info)
       in
       let branch = eval_branch update_branch info block.branch in
-      { block with Code.body; Code.branch })
+      let block' = { block with Code.body; Code.branch } in
+      if Code.block_equal block block' then block else block')
     blocks
 
 let f info p =
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 8d7370030a..c81c3f2be2 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -400,14 +400,17 @@ let specialize_all_instrs ~target opt_count info p =
   let blocks =
     Addr.Map.map
       (fun block ->
-        { block with
-          Code.body =
-            specialize_instrs
-              ~target
-              opt_count
-              info
-              (specialize_string_concat opt_count block.body)
-        })
+        let block' =
+          { block with
+            Code.body =
+              specialize_instrs
+                ~target
+                opt_count
+                info
+                (specialize_string_concat opt_count block.body)
+          }
+        in
+        if Code.block_equal block block' then block else block')
       p.blocks
   in
   { p with blocks }
diff --git a/compiler/lib/subst.ml b/compiler/lib/subst.ml
index 0350a5e39b..fe866aec7b 100644
--- a/compiler/lib/subst.ml
+++ b/compiler/lib/subst.ml
@@ -67,7 +67,13 @@ module Excluding_Binders = struct
     { params = block.params; body = instrs s block.body; branch = last s block.branch }
 
   let program s p =
-    let blocks = Addr.Map.map (fun b -> block s b) p.blocks in
+    let blocks =
+      Addr.Map.map
+        (fun b ->
+          let b' = block s b in
+          if Code.block_equal b b' then b else b')
+        p.blocks
+    in
     { p with blocks }
 
   let rec cont' s pc blocks visited =

From 2d7d0abc3a04252d5016a92a3b5d4fc913195318 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 11 Feb 2026 09:57:33 +0100
Subject: [PATCH 03/17] Compiler: block sharing stats during fixpoint

---
 compiler/lib/driver.ml | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index e6a6eb615e..0d3e86a519 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -210,8 +210,11 @@ let rec loop max name round i (p : 'a) : 'a =
   else if Code.equal p' p
   then (
     if debug then Format.eprintf "%s#%d: fix-point reached.@." name i;
+    if stats () then Code.print_block_sharing ~name:(Printf.sprintf "%s#%d" name i) p p';
     p')
-  else loop max name round (i + 1) p'
+  else (
+    if stats () then Code.print_block_sharing ~name:(Printf.sprintf "%s#%d" name i) p p';
+    loop max name round (i + 1) p')
 
 let round profile : 'a -> 'a =
   print

From b93a3aa75551027787aa97eb1b66716a2b035cb1 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 11 Feb 2026 10:34:14 +0100
Subject: [PATCH 04/17] Compiler: add stats for ref unboxing

---
 compiler/lib/ref_unboxing.ml | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/compiler/lib/ref_unboxing.ml b/compiler/lib/ref_unboxing.ml
index 38040a671b..2d21697298 100644
--- a/compiler/lib/ref_unboxing.ml
+++ b/compiler/lib/ref_unboxing.ml
@@ -37,6 +37,8 @@ let times = Debug.find "times"
 
 let stats = Debug.find "stats"
 
+let debug_stats = Debug.find "stats-debug"
+
 let rewrite_body unboxed_refs body ref_contents subst =
   let ref_contents, subst, l =
     List.fold_left
@@ -138,6 +140,7 @@ let rewrite_function p ~unboxed_refs pc subst =
   { p with blocks }, subst
 
 let f p =
+  let previous_p = p in
   let t = Timer.make () in
   let candidates = Var.Hashtbl.create 128 in
   let updated = Var.Hashtbl.create 128 in
@@ -225,6 +228,11 @@ let f p =
     else Subst.Excluding_Binders.program (Subst.from_map subst) p
   in
   if times () then Format.eprintf "  reference unboxing: %a@." Timer.print t;
+  let updates = Var.Hashtbl.length candidates in
   if stats ()
-  then Format.eprintf "Stats - reference unboxing: %d@." (Var.Hashtbl.length candidates);
+  then (
+    Format.eprintf "Stats - reference unboxing: %d@." updates;
+    Code.print_block_sharing ~name:"ref_unboxing" previous_p p);
+  if debug_stats ()
+  then Code.check_updates ~name:"ref_unboxing" previous_p p ~updates;
   p

From dbbaa5443b5160b934202e106a2ba6bd3a9ccb84 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 11 Feb 2026 10:34:56 +0100
Subject: [PATCH 05/17] Compiler: fix missing updates in stats

---
 compiler/lib/eval.ml          |  5 ++++-
 compiler/lib/inline.ml        | 30 ++++++++++++++++++++----------
 compiler/lib/specialize_js.ml |  1 +
 3 files changed, 25 insertions(+), 11 deletions(-)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 886cd53169..95e06eec20 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -583,13 +583,16 @@ let eval_instr update_count inline_constant ~target info i =
   | Let (x, Prim (Extern "caml_atomic_load_field", [ Pv o; f ])) -> (
       match the_int info f with
       | None -> [ i ]
-      | Some i -> [ Let (x, Field (o, Targetint.to_int_exn i, Non_float)) ])
+      | Some i ->
+          incr update_count;
+          [ Let (x, Field (o, Targetint.to_int_exn i, Non_float)) ])
   | Let (x, Prim (IsInt, [ y ])) -> (
       match is_int info y with
       | Unknown -> [ i ]
       | Y ->
           let c = Constant (bool' true) in
           Flow.Info.update_def info x c;
+          incr update_count;
           [ Let (x, c) ]
       | N ->
           let c = Constant (bool' false) in
diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
index 66fae92f0b..5cf2957fb1 100644
--- a/compiler/lib/inline.ml
+++ b/compiler/lib/inline.ml
@@ -505,7 +505,7 @@ let trace_inlining ~context info x args =
    with an initial continuation pointing to a block belonging to
    another function. This removes these closures. *)
 
-let remove_dead_closures_from_block ~live_vars p pc block =
+let remove_dead_closures_from_block ~dead_closure_count ~live_vars p pc block =
   let is_dead_closure i =
     match i with
     | Let (f, Closure _) ->
@@ -514,7 +514,8 @@ let remove_dead_closures_from_block ~live_vars p pc block =
     | _ -> false
   in
   if List.exists ~f:is_dead_closure block.body
-  then
+  then (
+    incr dead_closure_count;
     { p with
       blocks =
         Addr.Map.add
@@ -530,15 +531,15 @@ let remove_dead_closures_from_block ~live_vars p pc block =
               |> List.rev
           }
           p.blocks
-    }
+    })
   else p
 
-let remove_dead_closures ~live_vars p pc =
+let remove_dead_closures ~dead_closure_count ~live_vars p pc =
   Code.traverse
     { fold = fold_children }
     (fun pc p ->
       let block = Addr.Map.find pc p.blocks in
-      remove_dead_closures_from_block ~live_vars p pc block)
+      remove_dead_closures_from_block ~dead_closure_count ~live_vars p pc block)
     pc
     p.blocks
     p
@@ -668,7 +669,7 @@ let inline_in_block ~context pc block p =
   in
   { p with blocks = Addr.Map.add pc { block with body; branch } p.blocks }
 
-let inline ~profile ~inline_count p ~live_vars =
+let inline ~profile ~inline_count ~dead_closure_count p ~live_vars =
   if debug () then Format.eprintf "====== inlining ======@.";
   (visit_closures
      p
@@ -711,7 +712,7 @@ let inline ~profile ~inline_count p ~live_vars =
            p.blocks
            p
        in
-       let p = remove_dead_closures ~live_vars p pc in
+       let p = remove_dead_closures ~dead_closure_count ~live_vars p pc in
        let env =
          match current_function with
          | Some f ->
@@ -751,16 +752,25 @@ let inline ~profile ~inline_count p ~live_vars =
 let f ~profile p live_vars =
   let previous_p = p in
   let inline_count = ref 0 in
+  let dead_closure_count = ref 0 in
   Code.invariant p;
   let t = Timer.make () in
-  let p = inline ~profile ~inline_count p ~live_vars in
+  let p = inline ~profile ~inline_count ~dead_closure_count p ~live_vars in
   if times () then Format.eprintf "  inlining: %a@." Timer.print t;
   if stats ()
   then (
-    Format.eprintf "Stats - inlining: %d inlined functions@." !inline_count;
+    Format.eprintf
+      "Stats - inlining: %d inlined functions, %d dead closures@."
+      !inline_count
+      !dead_closure_count;
     Code.print_block_sharing ~name:"inline" previous_p p);
   if debug_stats ()
-  then Code.check_updates ~name:"inline" previous_p p ~updates:!inline_count;
+  then
+    Code.check_updates
+      ~name:"inline"
+      previous_p
+      p
+      ~updates:(!inline_count + !dead_closure_count);
   let p = Deadcode.remove_unused_blocks p in
   Code.invariant p;
   p
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index c81c3f2be2..c38fa5e4ef 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -191,6 +191,7 @@ let specialize_instr opt_count ~target info i =
   | Let (x, Prim (Extern "caml_jsoo_runtime_value", [ nm ])), _ -> (
       match the_string_of info nm with
       | Some nm when Javascript.is_ident nm ->
+          incr opt_count;
           Let (x, Prim (Extern "caml_jsoo_runtime_value", [ Pc (String nm) ]))
       | _ -> i)
   | _, _ -> i

From e50653672656f93fffdccb5d05d17984871d603c Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 11 Feb 2026 11:04:24 +0100
Subject: [PATCH 06/17] fast path for sharing

---
 compiler/lib/deadcode.ml      |  56 +++++++++------
 compiler/lib/eval.ml          |  16 ++++-
 compiler/lib/flow.ml          |  13 ++--
 compiler/lib/inline.ml        |   5 +-
 compiler/lib/phisimpl.ml      |  10 +--
 compiler/lib/specialize.ml    | 128 +++++++++++++++++-----------------
 compiler/lib/specialize_js.ml |  21 +++---
 compiler/lib/tailcall.ml      |   4 +-
 8 files changed, 146 insertions(+), 107 deletions(-)

diff --git a/compiler/lib/deadcode.ml b/compiler/lib/deadcode.ml
index a6ae329055..4c11bbc323 100644
--- a/compiler/lib/deadcode.ml
+++ b/compiler/lib/deadcode.ml
@@ -486,30 +486,46 @@ let f pure_funs ({ blocks; _ } as p : Code.program) =
             st.deleted_blocks <- st.deleted_blocks + 1;
             None)
           else
-            let block' =
-              { params = List.filter block.params ~f:(fun x -> st.live.(Var.idx x) > 0)
-              ; body =
-                  List.fold_left block.body ~init:[] ~f:(fun acc i ->
-                      match i, acc with
-                      | Event _, Event _ :: prev ->
-                          (* Avoid consecutive events (keep just the last one) *)
-                          i :: prev
-                      | _ ->
-                          if live_instr st i
-                          then filter_closure all_blocks st i :: acc
-                          else (
-                            st.deleted_instrs <- st.deleted_instrs + 1;
-                            acc))
-                  |> List.rev
-              ; branch = filter_live_last all_blocks st block.branch
-              }
+            let saved_instrs = st.deleted_instrs in
+            let saved_params = st.deleted_params in
+            let params_changed =
+              List.exists block.params ~f:(fun x -> st.live.(Var.idx x) = 0)
+            in
+            let params =
+              if params_changed
+              then List.filter block.params ~f:(fun x -> st.live.(Var.idx x) > 0)
+              else block.params
+            in
+            let body =
+              List.fold_left block.body ~init:[] ~f:(fun acc i ->
+                  match i, acc with
+                  | Event _, Event _ :: prev ->
+                      (* Avoid consecutive events (keep just the last one) *)
+                      i :: prev
+                  | _ ->
+                      if live_instr st i
+                      then filter_closure all_blocks st i :: acc
+                      else (
+                        st.deleted_instrs <- st.deleted_instrs + 1;
+                        acc))
+              |> List.rev
             in
-            Some (if Code.block_equal block block' then block else block'))
+            let branch = filter_live_last all_blocks st block.branch in
+            if (not params_changed)
+               && st.deleted_instrs = saved_instrs
+               && st.deleted_params = saved_params
+            then Some block
+            else Some { params; body; branch })
         blocks
     in
-    { p with blocks }
+    if st.deleted_instrs + st.deleted_blocks + st.deleted_params = 0
+    then p
+    else { p with blocks }
+  in
+  let p =
+    let p' = remove_empty_blocks st p in
+    if st.block_shortcut = 0 then p else p'
   in
-  let p = remove_empty_blocks st p in
   if times () then Format.eprintf "  dead code elim.: %a@." Timer.print t;
   if stats ()
   then (
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 95e06eec20..06fd834d12 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -829,14 +829,20 @@ let drop_exception_handler drop_count blocks =
 let eval update_count update_branch inline_constant ~target info blocks =
   Addr.Map.map
     (fun block ->
+      let saved_update = !update_count in
+      let saved_branch = !update_branch in
+      let saved_inline = !inline_constant in
       let body =
         List.concat_map
           block.body
           ~f:(eval_instr update_count inline_constant ~target info)
       in
       let branch = eval_branch update_branch info block.branch in
-      let block' = { block with Code.body; Code.branch } in
-      if Code.block_equal block block' then block else block')
+      if !update_count = saved_update
+         && !update_branch = saved_branch
+         && !inline_constant = saved_inline
+      then block
+      else { block with Code.body = body; Code.branch = branch })
     blocks
 
 let f info p =
@@ -857,7 +863,11 @@ let f info p =
       p.blocks
   in
   let blocks = drop_exception_handler drop_count blocks in
-  let p = { p with blocks } in
+  let p =
+    if !update_count + !update_branch + !inline_constant + !drop_count = 0
+    then p
+    else { p with blocks }
+  in
   if times () then Format.eprintf "  eval: %a@." Timer.print t;
   if stats ()
   then (
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index 34847ad66c..f56aa32edb 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -584,22 +584,27 @@ let f p =
     }
   in
   let s = build_subst info vars in
-  let need_stats = stats () || debug_stats () in
   let count_uniq = ref 0 in
-  let count_seen = BitSet.create' (if need_stats then Var.count () else 0) in
+  let count_seen = BitSet.create' (Var.count ()) in
   let subst v1 =
     let idx1 = Code.Var.idx v1 in
     let v2 = s.(idx1) in
     if Code.Var.equal v1 v2
     then v1
     else (
-      if need_stats && not (BitSet.mem count_seen idx1)
+      if not (BitSet.mem count_seen idx1)
       then (
         incr count_uniq;
         BitSet.set count_seen idx1);
       v2)
   in
-  let p = Subst.Excluding_Binders.program subst p in
+  let p =
+    if Array.length s = 0
+    then p
+    else
+      let p' = Subst.Excluding_Binders.program subst p in
+      if !count_uniq = 0 then p else p'
+  in
   if times () then Format.eprintf "    flow analysis 5: %a@." Timer.print t5;
   if times () then Format.eprintf "  flow analysis: %a@." Timer.print t;
   if stats ()
diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
index 5cf2957fb1..378167dec3 100644
--- a/compiler/lib/inline.ml
+++ b/compiler/lib/inline.ml
@@ -755,7 +755,10 @@ let f ~profile p live_vars =
   let dead_closure_count = ref 0 in
   Code.invariant p;
   let t = Timer.make () in
-  let p = inline ~profile ~inline_count ~dead_closure_count p ~live_vars in
+  let p =
+    let p' = inline ~profile ~inline_count ~dead_closure_count p ~live_vars in
+    if !inline_count + !dead_closure_count = 0 then p else p'
+  in
   if times () then Format.eprintf "  inlining: %a@." Timer.print t;
   if stats ()
   then (
diff --git a/compiler/lib/phisimpl.ml b/compiler/lib/phisimpl.ml
index 128bc34a69..507b92fa0b 100644
--- a/compiler/lib/phisimpl.ml
+++ b/compiler/lib/phisimpl.ml
@@ -165,22 +165,24 @@ let f p =
   if times () then Format.eprintf "    phi-simpl. 2: %a@." Timer.print t';
   Array.iteri subst ~f:(fun idx y ->
       if Var.idx y = idx then () else Code.Var.propagate_name (Var.of_idx idx) y);
-  let need_stats = stats () || debug_stats () in
   let count_uniq = ref 0 in
-  let count_seen = BitSet.create' (if need_stats then Var.count () else 0) in
+  let count_seen = BitSet.create' (Var.count ()) in
   let subst v1 =
     let idx1 = Code.Var.idx v1 in
     let v2 = subst.(idx1) in
     if Code.Var.equal v1 v2
     then v1
     else (
-      if need_stats && not (BitSet.mem count_seen idx1)
+      if not (BitSet.mem count_seen idx1)
       then (
         incr count_uniq;
         BitSet.set count_seen idx1);
       v2)
   in
-  let p = Subst.Excluding_Binders.program subst p in
+  let p =
+    let p' = Subst.Excluding_Binders.program subst p in
+    if !count_uniq = 0 then p else p'
+  in
   if times () then Format.eprintf "  phi-simpl.: %a@." Timer.print t;
   if stats ()
   then (
diff --git a/compiler/lib/specialize.ml b/compiler/lib/specialize.ml
index 54bc7dd526..610daabc26 100644
--- a/compiler/lib/specialize.ml
+++ b/compiler/lib/specialize.ml
@@ -119,7 +119,11 @@ let f ~shape ~update_def p =
   let t = Timer.make () in
   let opt_count = ref 0 in
   let p =
-    if Config.Flag.optcall () then specialize_instrs ~shape ~update_def opt_count p else p
+    if Config.Flag.optcall ()
+    then
+      let p' = specialize_instrs ~shape ~update_def opt_count p in
+      if !opt_count = 0 then p else p'
+    else p
   in
   if times () then Format.eprintf "  optcall: %a@." Timer.print t;
   if stats ()
@@ -293,69 +297,67 @@ let switches p =
   let previous_p = p in
   let t = Timer.make () in
   let opt_count = ref 0 in
-  let p =
-    { p with
-      blocks =
-        Addr.Map.fold
-          (fun pc block blocks ->
-            match block.branch with
-            | Switch (x, l) -> (
-                match find_outlier_index l with
-                | #switch_to_cond as opt ->
-                    incr opt_count;
-                    let block = optimize_switch_to_cond block x l opt in
-                    Addr.Map.add pc block blocks
-                | `Many_cases ->
-                    let t = SBT.create 0 in
-                    let rewrite = ref Addr.Set.empty in
-                    let l =
-                      Array.map l ~f:(fun ((pc, _) as cont) ->
-                          let block = Code.Addr.Map.find pc blocks in
-                          if List.compare_length_with block.body ~len:7 <= 0
-                          then (
-                            let sb = Simple_block.make block in
-                            match SBT.find_opt t sb with
-                            | Some cont' when not (equal cont' cont) ->
-                                rewrite := Addr.Set.add (fst cont') !rewrite;
-                                cont'
-                            | Some _ | None ->
-                                SBT.add t sb cont;
-                                cont)
-                          else cont)
-                    in
-                    if not (Addr.Set.is_empty !rewrite)
-                    then (
-                      incr opt_count;
-                      let blocks =
-                        Addr.Set.fold
-                          (fun pc blocks ->
-                            let block = Code.Addr.Map.find pc blocks in
-                            Addr.Map.add
-                              pc
-                              { block with
-                                body =
-                                  List.filter
-                                    ~f:(function
-                                      | Event _ -> false
-                                      | _ -> true)
-                                    block.body
-                              }
-                              blocks)
-                          !rewrite
-                          blocks
-                      in
-                      match find_outlier_index l with
-                      | #switch_to_cond as opt ->
-                          let block = optimize_switch_to_cond block x l opt in
-                          Addr.Map.add pc block blocks
-                      | `Many_cases ->
-                          Addr.Map.add pc { block with branch = Switch (x, l) } blocks)
-                    else blocks)
-            | _ -> blocks)
-          p.blocks
-          p.blocks
-    }
+  let blocks =
+    Addr.Map.fold
+      (fun pc block blocks ->
+        match block.branch with
+        | Switch (x, l) -> (
+            match find_outlier_index l with
+            | #switch_to_cond as opt ->
+                incr opt_count;
+                let block = optimize_switch_to_cond block x l opt in
+                Addr.Map.add pc block blocks
+            | `Many_cases ->
+                let t = SBT.create 0 in
+                let rewrite = ref Addr.Set.empty in
+                let l =
+                  Array.map l ~f:(fun ((pc, _) as cont) ->
+                      let block = Code.Addr.Map.find pc blocks in
+                      if List.compare_length_with block.body ~len:7 <= 0
+                      then (
+                        let sb = Simple_block.make block in
+                        match SBT.find_opt t sb with
+                        | Some cont' when not (equal cont' cont) ->
+                            rewrite := Addr.Set.add (fst cont') !rewrite;
+                            cont'
+                        | Some _ | None ->
+                            SBT.add t sb cont;
+                            cont)
+                      else cont)
+                in
+                if not (Addr.Set.is_empty !rewrite)
+                then (
+                  incr opt_count;
+                  let blocks =
+                    Addr.Set.fold
+                      (fun pc blocks ->
+                        let block = Code.Addr.Map.find pc blocks in
+                        Addr.Map.add
+                          pc
+                          { block with
+                            body =
+                              List.filter
+                                ~f:(function
+                                  | Event _ -> false
+                                  | _ -> true)
+                                block.body
+                          }
+                          blocks)
+                      !rewrite
+                      blocks
+                  in
+                  match find_outlier_index l with
+                  | #switch_to_cond as opt ->
+                      let block = optimize_switch_to_cond block x l opt in
+                      Addr.Map.add pc block blocks
+                  | `Many_cases ->
+                      Addr.Map.add pc { block with branch = Switch (x, l) } blocks)
+                else blocks)
+        | _ -> blocks)
+      p.blocks
+      p.blocks
   in
+  let p = if !opt_count = 0 then p else { p with blocks } in
   if times () then Format.eprintf "  switches: %a@." Timer.print t;
   if stats ()
   then (
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index c38fa5e4ef..be4b8e690d 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -401,17 +401,15 @@ let specialize_all_instrs ~target opt_count info p =
   let blocks =
     Addr.Map.map
       (fun block ->
-        let block' =
-          { block with
-            Code.body =
-              specialize_instrs
-                ~target
-                opt_count
-                info
-                (specialize_string_concat opt_count block.body)
-          }
+        let saved = !opt_count in
+        let body =
+          specialize_instrs
+            ~target
+            opt_count
+            info
+            (specialize_string_concat opt_count block.body)
         in
-        if Code.block_equal block block' then block else block')
+        if !opt_count = saved then block else { block with Code.body = body })
       p.blocks
   in
   { p with blocks }
@@ -423,7 +421,8 @@ let f info p =
   let previous_p = p in
   let t = Timer.make () in
   let opt_count = ref 0 in
-  let p = specialize_all_instrs ~target:(Config.target ()) opt_count info p in
+  let p' = specialize_all_instrs ~target:(Config.target ()) opt_count info p in
+  let p = if !opt_count = 0 then p else p' in
   if times () then Format.eprintf "  specialize_js: %a@." Timer.print t;
   if stats ()
   then (
diff --git a/compiler/lib/tailcall.ml b/compiler/lib/tailcall.ml
index 6881bdd90a..6339074aef 100644
--- a/compiler/lib/tailcall.ml
+++ b/compiler/lib/tailcall.ml
@@ -147,7 +147,9 @@ let f p =
       in
       if !rewrite_body then blocks := Addr.Map.add pc { block with body } !blocks)
     p.blocks;
-  let p = { p with blocks = !blocks; free_pc = !free_pc } in
+  let p =
+    if !update_count = 0 then p else { p with blocks = !blocks; free_pc = !free_pc }
+  in
   if times () then Format.eprintf "  tail calls: %a@." Timer.print t;
   if stats ()
   then (

From 9e25c81271cfbea7290010899fbc6a96b5e3008e Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 11 Feb 2026 17:34:02 +0100
Subject: [PATCH 07/17] improve sharing

---
 compiler/lib/subst.ml | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/compiler/lib/subst.ml b/compiler/lib/subst.ml
index fe866aec7b..2ec6d5c442 100644
--- a/compiler/lib/subst.ml
+++ b/compiler/lib/subst.ml
@@ -67,11 +67,18 @@ module Excluding_Binders = struct
     { params = block.params; body = instrs s block.body; branch = last s block.branch }
 
   let program s p =
+    let changed = ref false in
+    let s' x =
+      let y = s x in
+      if not (Code.Var.equal x y) then changed := true;
+      y
+    in
     let blocks =
       Addr.Map.map
         (fun b ->
-          let b' = block s b in
-          if Code.block_equal b b' then b else b')
+          changed := false;
+          let b' = block s' b in
+          if !changed then b' else b)
         p.blocks
     in
     { p with blocks }

From 2ef02c2f2fcab79ab3bf1a7133f949fbaf1ade30 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 11 Feb 2026 17:54:41 +0100
Subject: [PATCH 08/17] more debug:

---
 compiler/lib/code.ml          | 17 +++++++++++++++++
 compiler/lib/code.mli         |  4 ++++
 compiler/lib/deadcode.ml      | 14 +++++++++++---
 compiler/lib/eval.ml          |  8 ++++++--
 compiler/lib/flow.ml          |  6 +++++-
 compiler/lib/inline.ml        |  6 +++++-
 compiler/lib/phisimpl.ml      |  6 +++++-
 compiler/lib/specialize.ml    | 14 ++++++++++++--
 compiler/lib/specialize_js.ml | 14 ++++++++++++--
 compiler/lib/subst.ml         |  6 +++++-
 compiler/lib/tailcall.ml      |  6 +++++-
 11 files changed, 87 insertions(+), 14 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index 7715d8d41c..f2f0f4298b 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -954,6 +954,23 @@ let cont_compare (pc, args) (pc', args') =
 
 let with_invariant = Debug.find "invariant"
 
+let assert_block_equal ~name b_old b_new =
+  if with_invariant ()
+  then
+    if not (block_equal b_old b_new)
+    then (
+      Format.eprintf "ASSERT_BLOCK_EQUAL: %s: counter=0 but block differs.@." name;
+      assert false)
+
+let assert_program_equal ~name p_old p_new =
+  if with_invariant ()
+  then
+    if not (equal p_old p_new)
+    then (
+      Format.eprintf "ASSERT_PROGRAM_EQUAL: %s: counter=0 but program differs.@." name;
+      print_diff p_old p_new;
+      assert false)
+
 let do_compact { blocks; start; free_pc = _ } =
   let remap =
     let max = fst (Addr.Map.max_binding blocks) in
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index 46eeb5728c..ec405d693c 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -325,6 +325,10 @@ val print_block_sharing : name:string -> program -> program -> unit
 
 val invariant : program -> unit
 
+val assert_block_equal : name:string -> block -> block -> unit
+
+val assert_program_equal : name:string -> program -> program -> unit
+
 val cont_equal : cont -> cont -> bool
 
 val cont_compare : cont -> cont -> int
diff --git a/compiler/lib/deadcode.ml b/compiler/lib/deadcode.ml
index 4c11bbc323..b9938c64a3 100644
--- a/compiler/lib/deadcode.ml
+++ b/compiler/lib/deadcode.ml
@@ -514,17 +514,25 @@ let f pure_funs ({ blocks; _ } as p : Code.program) =
             if (not params_changed)
                && st.deleted_instrs = saved_instrs
                && st.deleted_params = saved_params
-            then Some block
+            then (
+              Code.assert_block_equal ~name:"deadcode" block { params; body; branch };
+              Some block)
             else Some { params; body; branch })
         blocks
     in
     if st.deleted_instrs + st.deleted_blocks + st.deleted_params = 0
-    then p
+    then (
+      Code.assert_program_equal ~name:"deadcode(filter)" p { p with blocks };
+      p)
     else { p with blocks }
   in
   let p =
     let p' = remove_empty_blocks st p in
-    if st.block_shortcut = 0 then p else p'
+    if st.block_shortcut = 0
+    then (
+      Code.assert_program_equal ~name:"deadcode(shortcut)" p p';
+      p)
+    else p'
   in
   if times () then Format.eprintf "  dead code elim.: %a@." Timer.print t;
   if stats ()
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 06fd834d12..529231ebdf 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -841,7 +841,9 @@ let eval update_count update_branch inline_constant ~target info blocks =
       if !update_count = saved_update
          && !update_branch = saved_branch
          && !inline_constant = saved_inline
-      then block
+      then (
+        Code.assert_block_equal ~name:"eval" block { block with Code.body = body; Code.branch = branch };
+        block)
       else { block with Code.body = body; Code.branch = branch })
     blocks
 
@@ -865,7 +867,9 @@ let f info p =
   let blocks = drop_exception_handler drop_count blocks in
   let p =
     if !update_count + !update_branch + !inline_constant + !drop_count = 0
-    then p
+    then (
+      Code.assert_program_equal ~name:"eval" p { p with blocks };
+      p)
     else { p with blocks }
   in
   if times () then Format.eprintf "  eval: %a@." Timer.print t;
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index f56aa32edb..a5141a6bf7 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -603,7 +603,11 @@ let f p =
     then p
     else
       let p' = Subst.Excluding_Binders.program subst p in
-      if !count_uniq = 0 then p else p'
+      if !count_uniq = 0
+      then (
+        Code.assert_program_equal ~name:"flow" p p';
+        p)
+      else p'
   in
   if times () then Format.eprintf "    flow analysis 5: %a@." Timer.print t5;
   if times () then Format.eprintf "  flow analysis: %a@." Timer.print t;
diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
index 378167dec3..c28b8004d8 100644
--- a/compiler/lib/inline.ml
+++ b/compiler/lib/inline.ml
@@ -757,7 +757,11 @@ let f ~profile p live_vars =
   let t = Timer.make () in
   let p =
     let p' = inline ~profile ~inline_count ~dead_closure_count p ~live_vars in
-    if !inline_count + !dead_closure_count = 0 then p else p'
+    if !inline_count + !dead_closure_count = 0
+    then (
+      Code.assert_program_equal ~name:"inline" p p';
+      p)
+    else p'
   in
   if times () then Format.eprintf "  inlining: %a@." Timer.print t;
   if stats ()
diff --git a/compiler/lib/phisimpl.ml b/compiler/lib/phisimpl.ml
index 507b92fa0b..1a042db7c5 100644
--- a/compiler/lib/phisimpl.ml
+++ b/compiler/lib/phisimpl.ml
@@ -181,7 +181,11 @@ let f p =
   in
   let p =
     let p' = Subst.Excluding_Binders.program subst p in
-    if !count_uniq = 0 then p else p'
+    if !count_uniq = 0
+    then (
+      Code.assert_program_equal ~name:"phi" p p';
+      p)
+    else p'
   in
   if times () then Format.eprintf "  phi-simpl.: %a@." Timer.print t;
   if stats ()
diff --git a/compiler/lib/specialize.ml b/compiler/lib/specialize.ml
index 610daabc26..80b3e969ab 100644
--- a/compiler/lib/specialize.ml
+++ b/compiler/lib/specialize.ml
@@ -122,7 +122,11 @@ let f ~shape ~update_def p =
     if Config.Flag.optcall ()
     then
       let p' = specialize_instrs ~shape ~update_def opt_count p in
-      if !opt_count = 0 then p else p'
+      if !opt_count = 0
+      then (
+        Code.assert_program_equal ~name:"optcall" p p';
+        p)
+      else p'
     else p
   in
   if times () then Format.eprintf "  optcall: %a@." Timer.print t;
@@ -357,7 +361,13 @@ let switches p =
       p.blocks
       p.blocks
   in
-  let p = if !opt_count = 0 then p else { p with blocks } in
+  let p =
+    if !opt_count = 0
+    then (
+      Code.assert_program_equal ~name:"switches" p { p with blocks };
+      p)
+    else { p with blocks }
+  in
   if times () then Format.eprintf "  switches: %a@." Timer.print t;
   if stats ()
   then (
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index be4b8e690d..c1b8d19a3f 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -409,7 +409,11 @@ let specialize_all_instrs ~target opt_count info p =
             info
             (specialize_string_concat opt_count block.body)
         in
-        if !opt_count = saved then block else { block with Code.body = body })
+        if !opt_count = saved
+        then (
+          Code.assert_block_equal ~name:"specialize_js" block { block with Code.body = body };
+          block)
+        else { block with Code.body = body })
       p.blocks
   in
   { p with blocks }
@@ -422,7 +426,13 @@ let f info p =
   let t = Timer.make () in
   let opt_count = ref 0 in
   let p' = specialize_all_instrs ~target:(Config.target ()) opt_count info p in
-  let p = if !opt_count = 0 then p else p' in
+  let p =
+    if !opt_count = 0
+    then (
+      Code.assert_program_equal ~name:"specialize_js" p p';
+      p)
+    else p'
+  in
   if times () then Format.eprintf "  specialize_js: %a@." Timer.print t;
   if stats ()
   then (
diff --git a/compiler/lib/subst.ml b/compiler/lib/subst.ml
index 2ec6d5c442..7d94e30b4d 100644
--- a/compiler/lib/subst.ml
+++ b/compiler/lib/subst.ml
@@ -78,7 +78,11 @@ module Excluding_Binders = struct
         (fun b ->
           changed := false;
           let b' = block s' b in
-          if !changed then b' else b)
+          if !changed
+          then b'
+          else (
+            Code.assert_block_equal ~name:"subst" b b';
+            b))
         p.blocks
     in
     { p with blocks }
diff --git a/compiler/lib/tailcall.ml b/compiler/lib/tailcall.ml
index 6339074aef..c2b16b6523 100644
--- a/compiler/lib/tailcall.ml
+++ b/compiler/lib/tailcall.ml
@@ -148,7 +148,11 @@ let f p =
       if !rewrite_body then blocks := Addr.Map.add pc { block with body } !blocks)
     p.blocks;
   let p =
-    if !update_count = 0 then p else { p with blocks = !blocks; free_pc = !free_pc }
+    if !update_count = 0
+    then (
+      Code.assert_program_equal ~name:"tailcall" p { p with blocks = !blocks; free_pc = !free_pc };
+      p)
+    else { p with blocks = !blocks; free_pc = !free_pc }
   in
   if times () then Format.eprintf "  tail calls: %a@." Timer.print t;
   if stats ()

From a9cf3b93520f04b2636840a947a0cfaf1fc8a493 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 11 Feb 2026 21:48:47 +0100
Subject: [PATCH 09/17] fix optim

---
 compiler/lib/flow.ml | 42 +++++++++++++++++++++++-------------------
 1 file changed, 23 insertions(+), 19 deletions(-)

diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index a5141a6bf7..68d3fd1102 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -525,6 +525,7 @@ let the_shape_of ~return_values ~pure info x =
 let build_subst (info : Info.t) vars =
   let nv = Var.count () in
   let subst = Array.init nv ~f:(fun i -> Var.of_idx i) in
+  let has_subst = ref false in
   Var.ISet.iter
     (fun x ->
       let x_idx = Var.idx x in
@@ -538,9 +539,13 @@ let build_subst (info : Info.t) vars =
          match direct_approx info x with
          | None -> ()
          | Some y -> subst.(x_idx) <- y);
-      if Var.equal subst.(x_idx) x then () else Var.propagate_name x subst.(x_idx))
+      if Var.equal subst.(x_idx) x
+      then ()
+      else (
+        has_subst := true;
+        Var.propagate_name x subst.(x_idx)))
     vars;
-  subst
+  if !has_subst then Some subst else None
 
 (****)
 
@@ -583,25 +588,24 @@ let f p =
     ; info_possibly_mutable = possibly_mutable
     }
   in
-  let s = build_subst info vars in
   let count_uniq = ref 0 in
-  let count_seen = BitSet.create' (Var.count ()) in
-  let subst v1 =
-    let idx1 = Code.Var.idx v1 in
-    let v2 = s.(idx1) in
-    if Code.Var.equal v1 v2
-    then v1
-    else (
-      if not (BitSet.mem count_seen idx1)
-      then (
-        incr count_uniq;
-        BitSet.set count_seen idx1);
-      v2)
-  in
   let p =
-    if Array.length s = 0
-    then p
-    else
+    match build_subst info vars with
+    | None -> p
+    | Some s ->
+      let count_seen = BitSet.create' (Var.count ()) in
+      let subst v1 =
+        let idx1 = Code.Var.idx v1 in
+        let v2 = s.(idx1) in
+        if Code.Var.equal v1 v2
+        then v1
+        else (
+          if not (BitSet.mem count_seen idx1)
+          then (
+            incr count_uniq;
+            BitSet.set count_seen idx1);
+          v2)
+      in
       let p' = Subst.Excluding_Binders.program subst p in
       if !count_uniq = 0
       then (

From b62429c94d902655c73b5f29284be83afd3166f9 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 11 Feb 2026 22:09:14 +0100
Subject: [PATCH 10/17] fix optim

---
 compiler/lib/phisimpl.ml | 64 +++++++++++++++++++++++-----------------
 1 file changed, 37 insertions(+), 27 deletions(-)

diff --git a/compiler/lib/phisimpl.ml b/compiler/lib/phisimpl.ml
index 1a042db7c5..ded844d35c 100644
--- a/compiler/lib/phisimpl.ml
+++ b/compiler/lib/phisimpl.ml
@@ -148,10 +148,16 @@ let solver1 vars deps defs =
     { G.domain = vars; G.iter_children = (fun f x -> Var.Set.iter f deps.(Var.idx x)) }
   in
   ignore (Solver1.f () g (propagate1 deps defs reprs));
-  Array.mapi reprs ~f:(fun idx y ->
-      match y with
-      | Some y -> repr reprs y
-      | None -> Var.of_idx idx)
+  let has_subst = ref false in
+  let subst =
+    Array.mapi reprs ~f:(fun idx y ->
+        match y with
+        | Some y ->
+          has_subst := true;
+          repr reprs y
+        | None -> Var.of_idx idx)
+  in
+  if !has_subst then Some subst else None
 
 let f p =
   let previous_p = p in
@@ -161,31 +167,35 @@ let f p =
   let vars, deps, defs = program_deps p in
   if times () then Format.eprintf "    phi-simpl. 1: %a@." Timer.print t';
   let t' = Timer.make () in
-  let subst = solver1 vars deps defs in
-  if times () then Format.eprintf "    phi-simpl. 2: %a@." Timer.print t';
-  Array.iteri subst ~f:(fun idx y ->
-      if Var.idx y = idx then () else Code.Var.propagate_name (Var.of_idx idx) y);
   let count_uniq = ref 0 in
-  let count_seen = BitSet.create' (Var.count ()) in
-  let subst v1 =
-    let idx1 = Code.Var.idx v1 in
-    let v2 = subst.(idx1) in
-    if Code.Var.equal v1 v2
-    then v1
-    else (
-      if not (BitSet.mem count_seen idx1)
-      then (
-        incr count_uniq;
-        BitSet.set count_seen idx1);
-      v2)
-  in
   let p =
-    let p' = Subst.Excluding_Binders.program subst p in
-    if !count_uniq = 0
-    then (
-      Code.assert_program_equal ~name:"phi" p p';
-      p)
-    else p'
+    match solver1 vars deps defs with
+    | None ->
+      if times () then Format.eprintf "    phi-simpl. 2: %a@." Timer.print t';
+      p
+    | Some subst ->
+      if times () then Format.eprintf "    phi-simpl. 2: %a@." Timer.print t';
+      Array.iteri subst ~f:(fun idx y ->
+          if Var.idx y = idx then () else Code.Var.propagate_name (Var.of_idx idx) y);
+      let count_seen = BitSet.create' (Var.count ()) in
+      let subst v1 =
+        let idx1 = Code.Var.idx v1 in
+        let v2 = subst.(idx1) in
+        if Code.Var.equal v1 v2
+        then v1
+        else (
+          if not (BitSet.mem count_seen idx1)
+          then (
+            incr count_uniq;
+            BitSet.set count_seen idx1);
+          v2)
+      in
+      let p' = Subst.Excluding_Binders.program subst p in
+      if !count_uniq = 0
+      then (
+        Code.assert_program_equal ~name:"phi" p p';
+        p)
+      else p'
   in
   if times () then Format.eprintf "  phi-simpl.: %a@." Timer.print t;
   if stats ()

From d0d85eaef2fc545fc53a195683f5ea5cdda714f4 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 11 Feb 2026 22:21:33 +0100
Subject: [PATCH 11/17] more optim

---
 compiler/lib/eval.ml          | 14 +++++++++-----
 compiler/lib/specialize_js.ml | 36 +++++++++++++++++++++++++++--------
 2 files changed, 37 insertions(+), 13 deletions(-)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 529231ebdf..c8d49e0915 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -827,8 +827,8 @@ let drop_exception_handler drop_count blocks =
     blocks
 
 let eval update_count update_branch inline_constant ~target info blocks =
-  Addr.Map.map
-    (fun block ->
+  Addr.Map.fold
+    (fun pc block blocks ->
       let saved_update = !update_count in
       let saved_branch = !update_branch in
       let saved_inline = !inline_constant in
@@ -842,9 +842,13 @@ let eval update_count update_branch inline_constant ~target info blocks =
          && !update_branch = saved_branch
          && !inline_constant = saved_inline
       then (
-        Code.assert_block_equal ~name:"eval" block { block with Code.body = body; Code.branch = branch };
-        block)
-      else { block with Code.body = body; Code.branch = branch })
+        Code.assert_block_equal
+          ~name:"eval"
+          block
+          { block with Code.body = body; Code.branch = branch };
+        blocks)
+      else Addr.Map.add pc { block with Code.body = body; Code.branch = branch } blocks)
+    blocks
     blocks
 
 let f info p =
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index c1b8d19a3f..f4cca5ad6d 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -399,8 +399,8 @@ let specialize_instrs ~target opt_count info l =
 
 let specialize_all_instrs ~target opt_count info p =
   let blocks =
-    Addr.Map.map
-      (fun block ->
+    Addr.Map.fold
+      (fun pc block blocks ->
         let saved = !opt_count in
         let body =
           specialize_instrs
@@ -412,8 +412,9 @@ let specialize_all_instrs ~target opt_count info p =
         if !opt_count = saved
         then (
           Code.assert_block_equal ~name:"specialize_js" block { block with Code.body = body };
-          block)
-        else { block with Code.body = body })
+          blocks)
+        else Addr.Map.add pc { block with Code.body = body } blocks)
+      p.blocks
       p.blocks
   in
   { p with blocks }
@@ -444,6 +445,7 @@ let f info p =
   p
 
 let f_once_before p =
+  let count = ref 0 in
   let rec loop acc l =
     match l with
     | [] -> List.rev acc
@@ -461,13 +463,22 @@ let f_once_before p =
                      | "caml_array_unsafe_set_float"
                      | "caml_floatarray_unsafe_set" )
                  , [ _; _; _ ] ) as p) ) ->
+            incr count;
             let x' = Code.Var.fork x in
             let acc = Let (x', p) :: Let (x, Constant (Int Targetint.zero)) :: acc in
             loop acc r
         | _ -> loop (i :: acc) r)
   in
   let blocks =
-    Addr.Map.map (fun block -> { block with Code.body = loop [] block.body }) p.blocks
+    Addr.Map.fold
+      (fun pc block blocks ->
+        let saved = !count in
+        let body = loop [] block.body in
+        if !count = saved
+        then blocks
+        else Addr.Map.add pc { block with Code.body = body } blocks)
+      p.blocks
+      p.blocks
   in
   let p = { p with blocks } in
   Code.invariant p;
@@ -486,6 +497,7 @@ let f_once_after p =
     | `JavaScript, (`Cps | `Double_translation) | `Wasm, _ -> false
     | `JavaScript, `Jspi -> assert false
   in
+  let count = ref 0 in
   let f = function
     | Let (x, Closure (l, (pc, []), _)) as i -> (
         let block = Addr.Map.find pc p.blocks in
@@ -502,7 +514,9 @@ let f_once_after p =
               Code.Var.compare y y' = 0
               && Primitive.has_arity prim len
               && args_equal l args
-            then Let (x, Special (Alias_prim prim))
+            then (
+              incr count;
+              Let (x, Special (Alias_prim prim)))
             else i
         | _ -> i)
     | i -> i
@@ -510,8 +524,14 @@ let f_once_after p =
   if first_class_primitives
   then (
     let blocks =
-      Addr.Map.map
-        (fun block -> { block with Code.body = List.map block.body ~f })
+      Addr.Map.fold
+        (fun pc block blocks ->
+          let saved = !count in
+          let body = List.map block.body ~f in
+          if !count = saved
+          then blocks
+          else Addr.Map.add pc { block with Code.body = body } blocks)
+        p.blocks
         p.blocks
     in
     let p = Deadcode.remove_unused_blocks { p with blocks } in

From 8ccb785d3ff6e033312968d2bffc406970b523d1 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 11 Feb 2026 22:30:08 +0100
Subject: [PATCH 12/17] fix global deadcode

---
 compiler/lib/global_deadcode.ml | 26 +++++++++++++++++++++++---
 compiler/lib/subst.ml           | 19 ++++++++++---------
 2 files changed, 33 insertions(+), 12 deletions(-)

diff --git a/compiler/lib/global_deadcode.ml b/compiler/lib/global_deadcode.ml
index 33b5e0843a..530801b374 100644
--- a/compiler/lib/global_deadcode.ml
+++ b/compiler/lib/global_deadcode.ml
@@ -441,6 +441,7 @@ let solver vars uses defs live_vars scoped_live_vars =
     + They are applied to a function.
  *)
 let zero prog pure_funs sentinel live_table =
+  let count = ref 0 in
   let compact_vars vars =
     let i = ref (Array.length vars - 1) in
     while !i >= 0 && Var.equal vars.(!i) sentinel do
@@ -453,7 +454,13 @@ let zero prog pure_funs sentinel live_table =
     | Domain.Dead -> false
     | Top | Live _ -> true
   in
-  let zero_var x = if is_live x then x else sentinel in
+  let zero_var x =
+    if is_live x
+    then x
+    else (
+      incr count;
+      sentinel)
+  in
   let zero_instr instr =
     match instr with
     | Let (x, e) -> (
@@ -463,7 +470,12 @@ let zero prog pure_funs sentinel live_table =
             | Live fields ->
                 let vars =
                   Array.mapi
-                    ~f:(fun i v -> if IntMap.mem i fields then v else sentinel)
+                    ~f:(fun i v ->
+                      if IntMap.mem i fields
+                      then v
+                      else (
+                        incr count;
+                        sentinel))
                     vars
                   |> compact_vars
                 in
@@ -509,7 +521,15 @@ let zero prog pure_funs sentinel live_table =
     in
     { block with body; branch }
   in
-  let blocks = prog.blocks |> Addr.Map.map zero_block in
+  let blocks =
+    Addr.Map.fold
+      (fun pc block blocks ->
+        let saved = !count in
+        let block' = zero_block block in
+        if !count = saved then blocks else Addr.Map.add pc block' blocks)
+      prog.blocks
+      prog.blocks
+  in
   { prog with blocks }
 
 module Print = struct
diff --git a/compiler/lib/subst.ml b/compiler/lib/subst.ml
index 7d94e30b4d..5f9d20a121 100644
--- a/compiler/lib/subst.ml
+++ b/compiler/lib/subst.ml
@@ -67,22 +67,23 @@ module Excluding_Binders = struct
     { params = block.params; body = instrs s block.body; branch = last s block.branch }
 
   let program s p =
-    let changed = ref false in
+    let count = ref 0 in
     let s' x =
       let y = s x in
-      if not (Code.Var.equal x y) then changed := true;
+      if not (Code.Var.equal x y) then incr count;
       y
     in
     let blocks =
-      Addr.Map.map
-        (fun b ->
-          changed := false;
+      Addr.Map.fold
+        (fun pc b blocks ->
+          let saved = !count in
           let b' = block s' b in
-          if !changed
-          then b'
-          else (
+          if !count = saved
+          then (
             Code.assert_block_equal ~name:"subst" b b';
-            b))
+            blocks)
+          else Addr.Map.add pc b' blocks)
+        p.blocks
         p.blocks
     in
     { p with blocks }

From 67dd82c74de1d0a2d0f52fac153969a672040cef Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Thu, 12 Feb 2026 08:53:34 +0100
Subject: [PATCH 13/17] phys_eq

---
 compiler/lib/code.ml | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index f2f0f4298b..c8051992ac 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -886,12 +886,13 @@ let return_values p =
 
 let block_equal b1 b2 =
   phys_equal b1 b2
-  || (List.equal ~eq:Var.equal b1.params b2.params
-      && Poly.equal b1.branch b2.branch
-      && List.equal ~eq:Poly.equal b1.body b2.body)
+  || List.equal ~eq:Var.equal b1.params b2.params
+     && Poly.equal b1.branch b2.branch
+     && List.equal ~eq:Poly.equal b1.body b2.body
 
 let equal p1 p2 =
-  p1.start = p2.start && Addr.Map.equal block_equal p1.blocks p2.blocks
+  p1.start = p2.start
+  && (phys_equal p1.blocks p2.blocks || Addr.Map.equal block_equal p1.blocks p2.blocks)
 
 let print_to_file p =
   let file = Filename.temp_file "jsoo" "prog" in

From 43392271843abf9805f3c4f7abefcf0e8885210e Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Thu, 12 Feb 2026 08:53:54 +0100
Subject: [PATCH 14/17] fmt

---
 compiler/lib/deadcode.ml      |  7 +++--
 compiler/lib/eval.ml          | 14 ++++------
 compiler/lib/flow.ml          | 38 ++++++++++++-------------
 compiler/lib/phisimpl.ml      | 52 +++++++++++++++++------------------
 compiler/lib/ref_unboxing.ml  |  3 +-
 compiler/lib/specialize_js.ml | 10 +++----
 compiler/lib/tailcall.ml      |  5 +++-
 7 files changed, 64 insertions(+), 65 deletions(-)

diff --git a/compiler/lib/deadcode.ml b/compiler/lib/deadcode.ml
index b9938c64a3..22b13e3f8c 100644
--- a/compiler/lib/deadcode.ml
+++ b/compiler/lib/deadcode.ml
@@ -511,9 +511,10 @@ let f pure_funs ({ blocks; _ } as p : Code.program) =
               |> List.rev
             in
             let branch = filter_live_last all_blocks st block.branch in
-            if (not params_changed)
-               && st.deleted_instrs = saved_instrs
-               && st.deleted_params = saved_params
+            if
+              (not params_changed)
+              && st.deleted_instrs = saved_instrs
+              && st.deleted_params = saved_params
             then (
               Code.assert_block_equal ~name:"deadcode" block { params; body; branch };
               Some block)
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index c8d49e0915..a5440f26b2 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -838,16 +838,14 @@ let eval update_count update_branch inline_constant ~target info blocks =
           ~f:(eval_instr update_count inline_constant ~target info)
       in
       let branch = eval_branch update_branch info block.branch in
-      if !update_count = saved_update
-         && !update_branch = saved_branch
-         && !inline_constant = saved_inline
+      if
+        !update_count = saved_update
+        && !update_branch = saved_branch
+        && !inline_constant = saved_inline
       then (
-        Code.assert_block_equal
-          ~name:"eval"
-          block
-          { block with Code.body = body; Code.branch = branch };
+        Code.assert_block_equal ~name:"eval" block { block with Code.body; Code.branch };
         blocks)
-      else Addr.Map.add pc { block with Code.body = body; Code.branch = branch } blocks)
+      else Addr.Map.add pc { block with Code.body; Code.branch } blocks)
     blocks
     blocks
 
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index 68d3fd1102..f840eb1ea3 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -593,25 +593,25 @@ let f p =
     match build_subst info vars with
     | None -> p
     | Some s ->
-      let count_seen = BitSet.create' (Var.count ()) in
-      let subst v1 =
-        let idx1 = Code.Var.idx v1 in
-        let v2 = s.(idx1) in
-        if Code.Var.equal v1 v2
-        then v1
-        else (
-          if not (BitSet.mem count_seen idx1)
-          then (
-            incr count_uniq;
-            BitSet.set count_seen idx1);
-          v2)
-      in
-      let p' = Subst.Excluding_Binders.program subst p in
-      if !count_uniq = 0
-      then (
-        Code.assert_program_equal ~name:"flow" p p';
-        p)
-      else p'
+        let count_seen = BitSet.create' (Var.count ()) in
+        let subst v1 =
+          let idx1 = Code.Var.idx v1 in
+          let v2 = s.(idx1) in
+          if Code.Var.equal v1 v2
+          then v1
+          else (
+            if not (BitSet.mem count_seen idx1)
+            then (
+              incr count_uniq;
+              BitSet.set count_seen idx1);
+            v2)
+        in
+        let p' = Subst.Excluding_Binders.program subst p in
+        if !count_uniq = 0
+        then (
+          Code.assert_program_equal ~name:"flow" p p';
+          p)
+        else p'
   in
   if times () then Format.eprintf "    flow analysis 5: %a@." Timer.print t5;
   if times () then Format.eprintf "  flow analysis: %a@." Timer.print t;
diff --git a/compiler/lib/phisimpl.ml b/compiler/lib/phisimpl.ml
index ded844d35c..006d6f1946 100644
--- a/compiler/lib/phisimpl.ml
+++ b/compiler/lib/phisimpl.ml
@@ -153,8 +153,8 @@ let solver1 vars deps defs =
     Array.mapi reprs ~f:(fun idx y ->
         match y with
         | Some y ->
-          has_subst := true;
-          repr reprs y
+            has_subst := true;
+            repr reprs y
         | None -> Var.of_idx idx)
   in
   if !has_subst then Some subst else None
@@ -171,31 +171,31 @@ let f p =
   let p =
     match solver1 vars deps defs with
     | None ->
-      if times () then Format.eprintf "    phi-simpl. 2: %a@." Timer.print t';
-      p
+        if times () then Format.eprintf "    phi-simpl. 2: %a@." Timer.print t';
+        p
     | Some subst ->
-      if times () then Format.eprintf "    phi-simpl. 2: %a@." Timer.print t';
-      Array.iteri subst ~f:(fun idx y ->
-          if Var.idx y = idx then () else Code.Var.propagate_name (Var.of_idx idx) y);
-      let count_seen = BitSet.create' (Var.count ()) in
-      let subst v1 =
-        let idx1 = Code.Var.idx v1 in
-        let v2 = subst.(idx1) in
-        if Code.Var.equal v1 v2
-        then v1
-        else (
-          if not (BitSet.mem count_seen idx1)
-          then (
-            incr count_uniq;
-            BitSet.set count_seen idx1);
-          v2)
-      in
-      let p' = Subst.Excluding_Binders.program subst p in
-      if !count_uniq = 0
-      then (
-        Code.assert_program_equal ~name:"phi" p p';
-        p)
-      else p'
+        if times () then Format.eprintf "    phi-simpl. 2: %a@." Timer.print t';
+        Array.iteri subst ~f:(fun idx y ->
+            if Var.idx y = idx then () else Code.Var.propagate_name (Var.of_idx idx) y);
+        let count_seen = BitSet.create' (Var.count ()) in
+        let subst v1 =
+          let idx1 = Code.Var.idx v1 in
+          let v2 = subst.(idx1) in
+          if Code.Var.equal v1 v2
+          then v1
+          else (
+            if not (BitSet.mem count_seen idx1)
+            then (
+              incr count_uniq;
+              BitSet.set count_seen idx1);
+            v2)
+        in
+        let p' = Subst.Excluding_Binders.program subst p in
+        if !count_uniq = 0
+        then (
+          Code.assert_program_equal ~name:"phi" p p';
+          p)
+        else p'
   in
   if times () then Format.eprintf "  phi-simpl.: %a@." Timer.print t;
   if stats ()
diff --git a/compiler/lib/ref_unboxing.ml b/compiler/lib/ref_unboxing.ml
index 2d21697298..5433b2ea71 100644
--- a/compiler/lib/ref_unboxing.ml
+++ b/compiler/lib/ref_unboxing.ml
@@ -233,6 +233,5 @@ let f p =
   then (
     Format.eprintf "Stats - reference unboxing: %d@." updates;
     Code.print_block_sharing ~name:"ref_unboxing" previous_p p);
-  if debug_stats ()
-  then Code.check_updates ~name:"ref_unboxing" previous_p p ~updates;
+  if debug_stats () then Code.check_updates ~name:"ref_unboxing" previous_p p ~updates;
   p
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index f4cca5ad6d..f101cd19e4 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -411,9 +411,9 @@ let specialize_all_instrs ~target opt_count info p =
         in
         if !opt_count = saved
         then (
-          Code.assert_block_equal ~name:"specialize_js" block { block with Code.body = body };
+          Code.assert_block_equal ~name:"specialize_js" block { block with Code.body };
           blocks)
-        else Addr.Map.add pc { block with Code.body = body } blocks)
+        else Addr.Map.add pc { block with Code.body } blocks)
       p.blocks
       p.blocks
   in
@@ -474,9 +474,7 @@ let f_once_before p =
       (fun pc block blocks ->
         let saved = !count in
         let body = loop [] block.body in
-        if !count = saved
-        then blocks
-        else Addr.Map.add pc { block with Code.body = body } blocks)
+        if !count = saved then blocks else Addr.Map.add pc { block with Code.body } blocks)
       p.blocks
       p.blocks
   in
@@ -530,7 +528,7 @@ let f_once_after p =
           let body = List.map block.body ~f in
           if !count = saved
           then blocks
-          else Addr.Map.add pc { block with Code.body = body } blocks)
+          else Addr.Map.add pc { block with Code.body } blocks)
         p.blocks
         p.blocks
     in
diff --git a/compiler/lib/tailcall.ml b/compiler/lib/tailcall.ml
index c2b16b6523..752c0cf32c 100644
--- a/compiler/lib/tailcall.ml
+++ b/compiler/lib/tailcall.ml
@@ -150,7 +150,10 @@ let f p =
   let p =
     if !update_count = 0
     then (
-      Code.assert_program_equal ~name:"tailcall" p { p with blocks = !blocks; free_pc = !free_pc };
+      Code.assert_program_equal
+        ~name:"tailcall"
+        p
+        { p with blocks = !blocks; free_pc = !free_pc };
       p)
     else { p with blocks = !blocks; free_pc = !free_pc }
   in

From 4dc91c2ab977994cd7081b7e9f235daf10da4063 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Thu, 12 Feb 2026 09:22:17 +0100
Subject: [PATCH 15/17] WIP

---
 compiler/lib/flow.ml     | 31 ++++++++++++++++++-------------
 compiler/lib/phisimpl.ml | 31 ++++++++++++++++++-------------
 2 files changed, 36 insertions(+), 26 deletions(-)

diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index f840eb1ea3..eca64849de 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -588,26 +588,31 @@ let f p =
     ; info_possibly_mutable = possibly_mutable
     }
   in
+  let stats_needed = stats () || debug_stats () in
   let count_uniq = ref 0 in
   let p =
     match build_subst info vars with
     | None -> p
     | Some s ->
-        let count_seen = BitSet.create' (Var.count ()) in
-        let subst v1 =
-          let idx1 = Code.Var.idx v1 in
-          let v2 = s.(idx1) in
-          if Code.Var.equal v1 v2
-          then v1
-          else (
-            if not (BitSet.mem count_seen idx1)
-            then (
-              incr count_uniq;
-              BitSet.set count_seen idx1);
-            v2)
+        let subst =
+          if stats_needed
+          then
+            let count_seen = BitSet.create' (Var.count ()) in
+            fun v1 ->
+              let idx1 = Code.Var.idx v1 in
+              let v2 = s.(idx1) in
+              if Code.Var.equal v1 v2
+              then v1
+              else (
+                if not (BitSet.mem count_seen idx1)
+                then (
+                  incr count_uniq;
+                  BitSet.set count_seen idx1);
+                v2)
+          else fun v1 -> s.(Code.Var.idx v1)
         in
         let p' = Subst.Excluding_Binders.program subst p in
-        if !count_uniq = 0
+        if phys_equal p.blocks p'.blocks
         then (
           Code.assert_program_equal ~name:"flow" p p';
           p)
diff --git a/compiler/lib/phisimpl.ml b/compiler/lib/phisimpl.ml
index 006d6f1946..b6d3f40771 100644
--- a/compiler/lib/phisimpl.ml
+++ b/compiler/lib/phisimpl.ml
@@ -167,6 +167,7 @@ let f p =
   let vars, deps, defs = program_deps p in
   if times () then Format.eprintf "    phi-simpl. 1: %a@." Timer.print t';
   let t' = Timer.make () in
+  let stats_needed = stats () || debug_stats () in
   let count_uniq = ref 0 in
   let p =
     match solver1 vars deps defs with
@@ -177,21 +178,25 @@ let f p =
         if times () then Format.eprintf "    phi-simpl. 2: %a@." Timer.print t';
         Array.iteri subst ~f:(fun idx y ->
             if Var.idx y = idx then () else Code.Var.propagate_name (Var.of_idx idx) y);
-        let count_seen = BitSet.create' (Var.count ()) in
-        let subst v1 =
-          let idx1 = Code.Var.idx v1 in
-          let v2 = subst.(idx1) in
-          if Code.Var.equal v1 v2
-          then v1
-          else (
-            if not (BitSet.mem count_seen idx1)
-            then (
-              incr count_uniq;
-              BitSet.set count_seen idx1);
-            v2)
+        let subst =
+          if stats_needed
+          then
+            let count_seen = BitSet.create' (Var.count ()) in
+            fun v1 ->
+              let idx1 = Code.Var.idx v1 in
+              let v2 = subst.(idx1) in
+              if Code.Var.equal v1 v2
+              then v1
+              else (
+                if not (BitSet.mem count_seen idx1)
+                then (
+                  incr count_uniq;
+                  BitSet.set count_seen idx1);
+                v2)
+          else fun v1 -> subst.(Code.Var.idx v1)
         in
         let p' = Subst.Excluding_Binders.program subst p in
-        if !count_uniq = 0
+        if phys_equal p.blocks p'.blocks
         then (
           Code.assert_program_equal ~name:"phi" p p';
           p)

From b02a8a3cb48dea6e8c904ff9e153c0570de25472 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Thu, 12 Feb 2026 09:43:47 +0100
Subject: [PATCH 16/17] stop as soon as possible

---
 compiler/lib/deadcode.ml |  2 +-
 compiler/lib/driver.ml   | 26 +++++++++++++++++++-------
 2 files changed, 20 insertions(+), 8 deletions(-)

diff --git a/compiler/lib/deadcode.ml b/compiler/lib/deadcode.ml
index 22b13e3f8c..0f06f93ee2 100644
--- a/compiler/lib/deadcode.ml
+++ b/compiler/lib/deadcode.ml
@@ -206,7 +206,7 @@ let remove_unused_blocks' p =
         b)
       p.blocks
   in
-  { p with blocks }, !count
+  if !count = 0 then p, 0 else { p with blocks }, !count
 
 let remove_unused_blocks p =
   let previous_p = p in
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index 0d3e86a519..033c3ade30 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -216,14 +216,26 @@ let rec loop max name round i (p : 'a) : 'a =
     if stats () then Code.print_block_sharing ~name:(Printf.sprintf "%s#%d" name i) p p';
     loop max name round (i + 1) p')
 
+let cached f =
+  let last = ref None in
+  fun p ->
+    match !last with
+    | Some (blocks, result) when phys_equal p.Code.blocks blocks -> result
+    | _ ->
+        let result = f p in
+        last := Some (p.blocks, result);
+        result
+
 let round profile : 'a -> 'a =
-  print
-  +> tailcall
-  +> Ref_unboxing.f
-  +> (flow +> specialize +> eval +> fst)
-  +> inline profile
-  +> phi
-  +> deadcode
+  let tailcall = cached tailcall in
+  let ref_unboxing = cached Ref_unboxing.f in
+  let flow_specialize_eval = cached (flow +> specialize +> eval +> fst) in
+  let inline = cached (inline profile) in
+  let phi = cached phi in
+  let deadcode = cached deadcode in
+  fun p ->
+    p |> print |> tailcall |> ref_unboxing |> flow_specialize_eval |> inline |> phi
+    |> deadcode
 
 (* o1 *)
 

From 7d672da8ab18d4ac55e89965abeff5d8fd131e02 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Thu, 12 Feb 2026 10:37:56 +0100
Subject: [PATCH 17/17] invalidate caches

---
 compiler/lib/driver.ml | 31 +++++++++++++++++++++----------
 1 file changed, 21 insertions(+), 10 deletions(-)

diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index 033c3ade30..4a2af6e366 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -216,17 +216,22 @@ let rec loop max name round i (p : 'a) : 'a =
     if stats () then Code.print_block_sharing ~name:(Printf.sprintf "%s#%d" name i) p p';
     loop max name round (i + 1) p')
 
-let cached f =
-  let last = ref None in
-  fun p ->
-    match !last with
-    | Some (blocks, result) when phys_equal p.Code.blocks blocks -> result
-    | _ ->
-        let result = f p in
-        last := Some (p.blocks, result);
-        result
+let cached () =
+  let all_cached = ref [] in
+  fun f ->
+    let last = ref None in
+    all_cached := last :: !all_cached;
+    fun p ->
+      match !last with
+      | Some (blocks, result) when phys_equal p.Code.blocks blocks -> result
+      | _ ->
+          let result = f p in
+          List.iter !all_cached ~f:(fun r -> r := None);
+          last := Some (p.blocks, result);
+          result
 
 let round profile : 'a -> 'a =
+  let cached = cached () in
   let tailcall = cached tailcall in
   let ref_unboxing = cached Ref_unboxing.f in
   let flow_specialize_eval = cached (flow +> specialize +> eval +> fst) in
@@ -234,7 +239,13 @@ let round profile : 'a -> 'a =
   let phi = cached phi in
   let deadcode = cached deadcode in
   fun p ->
-    p |> print |> tailcall |> ref_unboxing |> flow_specialize_eval |> inline |> phi
+    p
+    |> print
+    |> tailcall
+    |> ref_unboxing
+    |> flow_specialize_eval
+    |> inline
+    |> phi
     |> deadcode
 
 (* o1 *)