From 6c7b5692aecbea2ce53dcb2a71932b0275a4b78d Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 16 Sep 2026 15:19:14 +0200 Subject: [PATCH 1/5] perf(types): canonicalize acyclic type graphs bottom-up instead of by fixed point `ExpGraph.combine` finds the coarsest bisimulation by partition refinement, restarting from the one-class partition and re-splitting every node on each pass. A pass distinguishes one more level of structure, so a graph that is a chain of `n` distinct nodes needs `n` passes of O(n log n) work. `typ_hash` canonicalizes on every call, and codegen names each generated `@deserialize_go` / `@buffer_size` function by the hash of its type, so a type nested `n` deep is hashed once per level -- making compilation cubic in the nesting depth. On an acyclic graph bisimilarity is just structural equality, which can be read off bottom-up in a single pass: in topological order a node's class follows from its label and its children's already-final classes. Take that path when the graph has no cycle and keep the fixed point for recursive types, where it is still needed (`type A = ?[A]` and `type B = [?B]` denote the same regular tree without being structurally equal). `test/bench/typtbl.mo` nests arrays up to 1024 deep: depth before after 256 1.32s 0.76s 512 10.01s 0.55s 768 36.83s 0.97s 1024 94.53s 1.63s and the benchmark as a whole goes from 2m16s to 2.5s. Type checking was never implicated -- `moc --check` on that file takes 0.03s. Output is unaffected: `wasm2wat` of `typtbl.mo` before and after differs only in the embedded version string. Co-Authored-By: Claude Opus 5 (1M context) --- src/lang_utils/expGraph.ml | 52 +++++++++++++++++++++++++++++++++++++- 1 file changed, 51 insertions(+), 1 deletion(-) diff --git a/src/lang_utils/expGraph.ml b/src/lang_utils/expGraph.ml index 349a0b77dcb..f36aa212b7f 100644 --- a/src/lang_utils/expGraph.ml +++ b/src/lang_utils/expGraph.ml @@ -133,9 +133,54 @@ let equiv_classes (type b) (graph : (int * b) Seq.t) : (int IM.t * int) = m, size +(* Children-before-parents order, or None if the graph has a cycle *) +let topo_order (graph : 'a t) : int list option = + let state = ref IM.empty in (* false = on stack, true = finished *) + let order = ref [] in + let cyclic = ref false in + let rec go i = + if not !cyclic then + match IM.find_opt i !state with + | Some true -> () + | Some false -> cyclic := true + | None -> + state := IM.add i false !state; + let (_, args) = IM.find i graph in + List.iter go args; + state := IM.add i true !state; + order := i :: !order + in + go 0; + if !cyclic then None else Some (List.rev !order) + +(* On an acyclic graph bisimilarity coincides with structural equality, so the + coarsest classes can be read off bottom-up in one pass: a node's class is + determined by its label and its children's classes, which are already final. + This avoids the fixed-point iteration below, which needs one round per level + and so is quadratic on deep chains. *) +let combine_acyclic (type a) (graph : a t) (order : int list) : a t = + let module KM = Map.Make (struct type t = a * int list let compare = compare end) in + let cls = ref IM.empty in + let km = ref KM.empty in + let next = start_counting 0 in + List.iter (fun i -> + let (k, args) = IM.find i graph in + let key = (k, List.map (fun j -> IM.find j !cls) args) in + let c = match KM.find_opt key !km with + | Some c -> c + | None -> let c = next () in km := KM.add key c !km; c in + cls := IM.add i c !cls + ) order; + (* `renumber` starts from node 0, so the root's class must stay 0 *) + let root = IM.find 0 !cls in + let lookup i = + let c = IM.find i !cls in + if c = root then 0 else if c = 0 then root else c in + rename lookup graph + (* Finds a minimal graph by finding the smallest index mapping that is consistent *) (* Equivalently: The coarsest equivalence classes on the nodes *) -let combine graph = +let combine_cyclic graph = let m : int IM.t ref = ref IM.empty in let lookup i = IM.find i !m in (* map all nodes to the same initially *) @@ -178,6 +223,11 @@ let renumber graph = assert (lookup 0 = 0); rename lookup graph +let combine graph = + match topo_order graph with + | Some order -> combine_acyclic graph order + | None -> combine_cyclic graph + (* Find a canonical graph *) let canonicalize graph = renumber (combine graph) From 73cb49c2509fe4466f692b3f56389fe667466c5c Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 16 Sep 2026 15:41:41 +0200 Subject: [PATCH 2/5] review: drop parentheses on tuple let-bindings Co-Authored-By: Claude Opus 5 (1M context) --- src/lang_utils/expGraph.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lang_utils/expGraph.ml b/src/lang_utils/expGraph.ml index f36aa212b7f..c6a83074efd 100644 --- a/src/lang_utils/expGraph.ml +++ b/src/lang_utils/expGraph.ml @@ -145,7 +145,7 @@ let topo_order (graph : 'a t) : int list option = | Some false -> cyclic := true | None -> state := IM.add i false !state; - let (_, args) = IM.find i graph in + let _, args = IM.find i graph in List.iter go args; state := IM.add i true !state; order := i :: !order @@ -164,7 +164,7 @@ let combine_acyclic (type a) (graph : a t) (order : int list) : a t = let km = ref KM.empty in let next = start_counting 0 in List.iter (fun i -> - let (k, args) = IM.find i graph in + let k, args = IM.find i graph in let key = (k, List.map (fun j -> IM.find j !cls) args) in let c = match KM.find_opt key !km with | Some c -> c From b6da91863137c17e20eee54d1c55733648832f0f Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 16 Sep 2026 15:45:08 +0200 Subject: [PATCH 3/5] review: fold topo_order's three initialisations into one let Co-Authored-By: Claude Opus 5 (1M context) --- src/lang_utils/expGraph.ml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/lang_utils/expGraph.ml b/src/lang_utils/expGraph.ml index c6a83074efd..b6cf975e34c 100644 --- a/src/lang_utils/expGraph.ml +++ b/src/lang_utils/expGraph.ml @@ -135,9 +135,8 @@ let equiv_classes (type b) (graph : (int * b) Seq.t) : (int IM.t * int) = (* Children-before-parents order, or None if the graph has a cycle *) let topo_order (graph : 'a t) : int list option = - let state = ref IM.empty in (* false = on stack, true = finished *) - let order = ref [] in - let cyclic = ref false in + let order, cyclic, state = + ref [], ref false, ref IM.empty (* false = on stack, true = finished *) in let rec go i = if not !cyclic then match IM.find_opt i !state with From bd4f18ec2de0e49f0243c251c8fa5908de3410a1 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 16 Sep 2026 16:00:52 +0200 Subject: [PATCH 4/5] review: drop redundant parentheses around the tuple expression Co-Authored-By: Claude Opus 5 (1M context) --- src/lang_utils/expGraph.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lang_utils/expGraph.ml b/src/lang_utils/expGraph.ml index b6cf975e34c..29558608789 100644 --- a/src/lang_utils/expGraph.ml +++ b/src/lang_utils/expGraph.ml @@ -164,7 +164,7 @@ let combine_acyclic (type a) (graph : a t) (order : int list) : a t = let next = start_counting 0 in List.iter (fun i -> let k, args = IM.find i graph in - let key = (k, List.map (fun j -> IM.find j !cls) args) in + let key = k, List.map (fun j -> IM.find j !cls) args in let c = match KM.find_opt key !km with | Some c -> c | None -> let c = next () in km := KM.add key c !km; c in From f5836dcbd6b76eaa0dbe9caaccbb575b22adc2b1 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 16 Sep 2026 16:05:59 +0200 Subject: [PATCH 5/5] review: fold combine_acyclic's three initialisations into one let Co-Authored-By: Claude Opus 5 (1M context) --- src/lang_utils/expGraph.ml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/lang_utils/expGraph.ml b/src/lang_utils/expGraph.ml index 29558608789..63a2b2ba4ea 100644 --- a/src/lang_utils/expGraph.ml +++ b/src/lang_utils/expGraph.ml @@ -159,9 +159,7 @@ let topo_order (graph : 'a t) : int list option = and so is quadratic on deep chains. *) let combine_acyclic (type a) (graph : a t) (order : int list) : a t = let module KM = Map.Make (struct type t = a * int list let compare = compare end) in - let cls = ref IM.empty in - let km = ref KM.empty in - let next = start_counting 0 in + let cls, km, next = ref IM.empty, ref KM.empty, start_counting 0 in List.iter (fun i -> let k, args = IM.find i graph in let key = k, List.map (fun j -> IM.find j !cls) args in