From c3a8e926bc6c79bfb8c410603f9154c5fe707a89 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fr=C3=A9d=C3=A9ric=20Bour?= Date: Wed, 5 Aug 2026 20:21:19 +0900 Subject: [PATCH 1/2] Fix block preallocation --- asmcomp/cmm_helpers.ml | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/asmcomp/cmm_helpers.ml b/asmcomp/cmm_helpers.ml index 34f86776eea0..066ece26fa42 100644 --- a/asmcomp/cmm_helpers.ml +++ b/asmcomp/cmm_helpers.ml @@ -2809,7 +2809,7 @@ let emit_gc_roots_table ~symbols cont = (* Build preallocated blocks (used for Flambda [Initialize_symbol] constructs, and Clambda global module) *) -let preallocate_block cont { Clambda.symbol; exported; tag; fields } = +let preallocate_block cont { Clambda.symbol; exported; tag; fields; block_desc } = let space = (* These words will be registered as roots and as such must contain valid values, in case we are in no-naked-pointers mode. Likewise @@ -2827,9 +2827,8 @@ let preallocate_block cont { Clambda.symbol; exported; tag; fields } = in let global = Cmmgen_state.(if exported then Global else Local) in let symb = (symbol, global) in - let data = - emit_block symb (block_header tag (List.length fields)) space - in + let header = block_header ~desc:block_desc tag (List.length fields) in + let data = emit_block symb header space in Cdata data :: cont let emit_preallocated_blocks preallocated_blocks cont = From ebf7ea93d6b7660b90a645f81558717b85da4323 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fr=C3=A9d=C3=A9ric=20Bour?= Date: Wed, 5 Aug 2026 20:21:58 +0900 Subject: [PATCH 2/2] Finer-grained approximation (might disable optimizations) Comment by @lthls: The code in Simple_value_approx was intentionally dropping block descriptions when encountering blocks with the same contents but different descriptions. This was meant to keep optimisations that share identical blocks (so that adding introspection would not degrade performance). But I think it was actually misguided: this code isn't involved in constant sharing, only when merging approximations coming from different branches (it should have been called join, not meet, but that's another story). I don't know if it matters in practice: I think that we can only get matching tags and sizes but mismatched descriptions when GADTs are involved, and in that case it's probably fine to lose the approximation. So I think we can keep your patch (at least when introspection is enabled). --- middle_end/flambda/simple_value_approx.ml | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/middle_end/flambda/simple_value_approx.ml b/middle_end/flambda/simple_value_approx.ml index 25380deb8446..dfd86043844e 100644 --- a/middle_end/flambda/simple_value_approx.ml +++ b/middle_end/flambda/simple_value_approx.ml @@ -679,14 +679,13 @@ let rec meet_descr ~really_import_approx d1 d2 = match d1, d2 with equal_boxed_int bi1 i1 bi2 i2 -> d1 | Value_block (tag1, a1, desc1), Value_block (tag2, a2, desc2) - when Tag.compare tag1 tag2 = 0 && Array.length a1 = Array.length a2 -> + when Tag.compare tag1 tag2 = 0 && Array.length a1 = Array.length a2 && + Block_desc.compare desc1 desc2 = 0 + -> let fields = Array.mapi (fun i v -> meet ~really_import_approx v a2.(i)) a1 in - let desc = - if Block_desc.compare desc1 desc2 = 0 then desc1 else Block_desc.empty - in - Value_block (tag1, fields, desc) + Value_block (tag1, fields, desc1) | _ -> Value_unknown Other and meet ~really_import_approx a1 a2 =