diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index ca966031..038a1edf 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -153,6 +153,19 @@ jobs:
         # superlinear on nested comprehensions (see `ci_test` / `debug_typecheck`).
         run: DEEP_TYPECHECK=1 ./ci.sh test
 
+      - name: Test (reversed refinement order)
+        if: steps.filter.outputs.code == 'true' && (success() || failure())
+        # A claim set is unordered by contract, but two classes of
+        # order-dependence survive a compile-clean rewrite and only running the
+        # suite both ways exercises them: a consumer that iterates the set and
+        # lets the order reach something observable, and a dedup that keeps the
+        # first-inserted of two `eq`-equal claims whose predicate terms carry
+        # different embedded type slots. Nothing in the type system catches
+        # either, so an unrun knob would rot exactly as an uncompiled feature
+        # does. The env var is read at *runtime*, so this reuses the binaries
+        # the step above already built.
+        run: CAMBRA_REFINEMENT_ORDER=reverse ./ci.sh test
+
         # 4. Success Signal for noops
       - name: No-op for docs
         if: steps.filter.outputs.code == 'false'
diff --git a/ci.sh b/ci.sh
index c08feb69..09ed6c0f 100755
--- a/ci.sh
+++ b/ci.sh
@@ -39,6 +39,14 @@ ci_clippy_lib() { cargo clippy --lib -- -D warnings; }
 # `deep-typecheck` feature). The GitHub workflow sets it so automated runs keep
 # exercising that check; it stays off for a bare local `./ci.sh` because it is
 # superlinear on nested comprehensions (that cost is why it is gated).
+#
+# `CAMBRA_REFINEMENT_ORDER=reverse` (read at runtime, debug builds only) flips
+# the physical order of every refinement claim set. The workflow runs the suite
+# both ways: set semantics makes that order meaningless by contract, but a
+# consumer that lets it become observable — or a dedup keeping the
+# first-inserted of two `eq`-equal claims — compiles clean either way. Same
+# argument as `ci_clippy_serde`: a configuration nothing runs is a
+# configuration that rots.
 ci_test() { cargo test -q ${DEEP_TYPECHECK:+--features deep-typecheck}; }
 ci_doc() {
   RUSTDOCFLAGS="-A warnings -D rustdoc::broken_intra_doc_links" \
diff --git a/formal/.gitignore b/formal/.gitignore
new file mode 100644
index 00000000..bfb30ec8
--- /dev/null
+++ b/formal/.gitignore
@@ -0,0 +1 @@
+/.lake
diff --git a/formal/CclFormal.lean b/formal/CclFormal.lean
new file mode 100644
index 00000000..17ff9fd8
--- /dev/null
+++ b/formal/CclFormal.lean
@@ -0,0 +1,10 @@
+import CclFormal.Ty
+import CclFormal.Merge
+import CclFormal.Term
+import CclFormal.Safety
+import CclFormal.Sub
+import CclFormal.Decide
+import CclFormal.Json
+import CclFormal.Props
+import CclFormal.Equiv
+import CclFormal.Transitivity
diff --git a/formal/CclFormal/Decide.lean b/formal/CclFormal/Decide.lean
new file mode 100644
index 00000000..71fb17bf
--- /dev/null
+++ b/formal/CclFormal/Decide.lean
@@ -0,0 +1,206 @@
+import CclFormal.Sub
+
+/-!
+# The executable ground subtype checker
+
+`subCheck` is the Bool-valued decision procedure for `Sub` — the mirror of
+`constrain_go`'s ground control flow, and the executable half of the M1
+differential oracle (`subCheck` vs `constrain_subtype` on ground pairs).
+Soundness and completeness against `Sub` are proved in
+`CclFormal/Equiv.lean`, so the relation is decidable and every `#guard`
+below is a fact about `Sub` itself.
+-/
+
+namespace CclFormal
+
+/-- Bool form of `kindOk`. -/
+def kindOkB : FunKind → FunKind → Bool
+  | .compute, .data => false
+  | _, _ => true
+
+mutual
+
+/-- Decide `Sub ρl ρr lhs rhs`, arm for arm with `constrain_go`'s ground
+fragment. -/
+def subCheck (ρl ρr : Ren) (lhs rhs : Ty) : Bool :=
+  match lhs, rhs with
+  | .base a, .base b => a == b
+  | .uintRange a, .uintRange b => a == b
+  | .dataSource a, .dataSource b => a == b
+  | .txn, .txn => true
+  | .fn n0 k0 d0 c0, .fn n1 k1 d1 c1 =>
+      kindOkB k0 k1 &&
+      (if k0 == .data && k1 == .data then
+        subCheck ρr ρl d1 d0 && subCheck ρl ρr d0 d1
+      else
+        subCheck ρr ρl d1 d0) &&
+      subCheck (codRen n0 n1 ρl) ρr c0 c1
+  | .tuple a, .tuple b => subSeq ρl ρr a b
+  | .record a, .record b => subFields ρl ρr a b
+  | .variant a, .variant b => subTags ρl ρr b a
+  | lhs, rhs =>
+      -- The refinement arm doubles as the mismatch catch-all: with no
+      -- refinement layer on either side this is `constrain_go`'s final
+      -- `Mismatch`.
+      if _h : lhs.peel.2 = [] ∧ rhs.peel.2 = [] then false
+      else
+        (deficit ρl ρr lhs.peel.2 rhs.peel.2).isEmpty &&
+        subCheck ρl ρr lhs.peel.1 rhs.peel.1
+termination_by sizeOf lhs + sizeOf rhs
+decreasing_by
+  all_goals simp_wf
+  all_goals first
+    | omega
+    | exact Ty.peel_sum_lt _ _ _h
+
+/-- Tuple positions, in demand (rhs) order. -/
+def subSeq (ρl ρr : Ren) (a b : List Ty) : Bool :=
+  match a, b with
+  | _, [] => true
+  | [], _ :: _ => false
+  | t0 :: a', t1 :: b' => subCheck ρl ρr t0 t1 && subSeq ρl ρr a' b'
+termination_by sizeOf a + sizeOf b
+decreasing_by all_goals (simp_wf; omega)
+
+/-- Record fields the rhs demands, looked up find-first in the lhs. -/
+def subFields (ρl ρr : Ren) (a b : List (String × Ty)) : Bool :=
+  match b with
+  | [] => true
+  | (n, t1) :: rest =>
+      (match _h : lookupBy a n with
+        | some t0 => subCheck ρl ρr t0 t1
+        | none => false) &&
+      subFields ρl ρr a rest
+termination_by sizeOf a + sizeOf b
+decreasing_by
+  all_goals simp_wf
+  · have := lookupBy_sizeOf _h
+    omega
+  · omega
+
+
+/-- Variant tags the lhs may produce, looked up find-first in the rhs. -/
+def subTags (ρl ρr : Ren) (b a : List (FieldKey × Ty)) : Bool :=
+  match a with
+  | [] => true
+  | (k, t0) :: rest =>
+      (match _h : lookupBy b k with
+        | some t1 => subCheck ρl ρr t0 t1
+        | none => false) &&
+      subTags ρl ρr b rest
+termination_by sizeOf b + sizeOf a
+decreasing_by
+  all_goals simp_wf
+  · have := lookupBy_sizeOf _h
+    omega
+  · omega
+
+end
+
+/-!
+## Executable spec examples
+
+One `#guard` per adjudicated behavior (see `formal/design.md`, "M0 status
+and adjudicated decisions") — the checker refusing to build is the cheapest
+regression net for the rules' shape.
+-/
+
+/- `{Int | p} <: Int` — dropping a refinement is subsumption. -/
+#guard subCheck .id .id (.refined (.base .int) [.elem]) (.base .int) = true
+
+/- `Int ⊀ {Int | p}` — a refinement cannot be conjured (that is `Restrict`). -/
+#guard subCheck .id .id (.base .int) (.refined (.base .int) [.elem]) = false
+
+/- `{T | p} <: {U | p}` iff `T <: U` — the refined base is covariant:
+`{{a, b} | p} <: {{a} | p}` by record width under the shared predicate. -/
+#guard subCheck .id .id
+  (.refined (.record [("a", .base .int), ("b", .base .bool)]) [.elem])
+  (.refined (.record [("a", .base .int)]) [.elem]) = true
+
+/- `UIntRange` is equality-only: `[0,3) ⊀ [0,4)` despite the inclusion. -/
+#guard subCheck .id .id (.uintRange 3) (.uintRange 4) = false
+#guard subCheck .id .id (.uintRange 3) (.uintRange 3) = true
+
+/- Record width: more fields flow to fewer, never the reverse. -/
+#guard subCheck .id .id
+  (.record [("a", .base .int), ("b", .base .bool)])
+  (.record [("a", .base .int)]) = true
+#guard subCheck .id .id
+  (.record [("a", .base .int)])
+  (.record [("a", .base .int), ("b", .base .bool)]) = false
+
+/- Variant width is the dual: fewer tags flow to more. -/
+#guard subCheck .id .id
+  (.variant [(.name "some", .base .int)])
+  (.variant [(.name "some", .base .int), (.name "none", .base .unit)]) = true
+
+/- The kind lattice `data ⊑ compute`: a collection satisfies a capability
+demand, a capability never satisfies a collection demand. -/
+#guard subCheck .id .id
+  (.fn none .data (.uintRange 2) (.base .int))
+  (.fn none .compute (.uintRange 2) (.base .int)) = true
+#guard subCheck .id .id
+  (.fn none .compute (.uintRange 2) (.base .int))
+  (.fn none .data (.uintRange 2) (.base .int)) = false
+
+/- Compute domains are contravariant; **data-data domains are invariant**
+(the domain *is* the data), so the same domain widening data-to-data fails. -/
+#guard subCheck .id .id
+  (.fn none .compute (.record [("a", .base .int)]) (.base .int))
+  (.fn none .compute (.record [("a", .base .int), ("b", .base .bool)])
+    (.base .int)) = true
+#guard subCheck .id .id
+  (.fn none .data (.record [("a", .base .int)]) (.base .int))
+  (.fn none .data (.record [("a", .base .int), ("b", .base .bool)])
+    (.base .int)) = false
+
+/- The Pi-binder correspondence: a dependent codomain refinement matches its
+α-renamed twin (`(x: [0,3)) ⤇ {Int | __elem == x}` vs the same under `y`). -/
+#guard subCheck .id .id
+  (.fn (some "x") .data (.uintRange 3)
+    (.refined (.base .int) [(.binop "eq" .elem (.var "x"))]))
+  (.fn (some "y") .data (.uintRange 3)
+    (.refined (.base .int) [(.binop "eq" .elem (.var "y"))])) = true
+
+/- ...and a genuinely different binder reference does not match. -/
+#guard subCheck .id .id
+  (.fn (some "x") .data (.uintRange 3)
+    (.refined (.base .int) [(.binop "eq" .elem (.var "x"))]))
+  (.fn (some "y") .data (.uintRange 3)
+    (.refined (.base .int) [(.binop "eq" .elem (.var "z"))])) = false
+
+/- No partition collapse: a `Variant` domain is below only a `Variant`
+domain, so a fan-out-shaped supplier does not satisfy a plain-domain demand.
+The fan-out never presents this pair — it is a `DisjointJoin` over the one
+domain its arms share — so the relation needs no arm for it. -/
+#guard subCheck .id .id
+  (.fn none .data
+    (.variant [(.idx 0, .refined (.uintRange 3) [(.litInt 0)]),
+               (.idx 1, .refined (.uintRange 3) [(.litInt 1)])])
+    (.base .int))
+  (.fn none .data (.uintRange 3) (.base .int)) = false
+
+/- α-equivalent dependent codomains reconcile through the Pi correspondence
+the function arm mints, at every domain shape. -/
+#guard subCheck .id .id
+  (.fn (some "x") .data (.uintRange 3)
+    (.refined (.base .int) [(.binop "eq" .elem (.var "x"))]))
+  (.fn (some "y") .data (.uintRange 3)
+    (.refined (.base .int) [(.binop "eq" .elem (.var "y"))])) = true
+
+/- A chain whose two hops use different rules — the kind lattice at the
+first, contravariant record width at the second — composes: the executable
+face of `sub_trans_id`. -/
+#guard subCheck .id .id
+  (.fn none .data (.record [("a", .base .int)]) (.base .int))
+  (.fn none .compute (.record [("a", .base .int)]) (.base .int)) = true
+#guard subCheck .id .id
+  (.fn none .compute (.record [("a", .base .int)]) (.base .int))
+  (.fn none .compute (.record [("a", .base .int), ("b", .base .bool)])
+    (.base .int)) = true
+#guard subCheck .id .id
+  (.fn none .data (.record [("a", .base .int)]) (.base .int))
+  (.fn none .compute (.record [("a", .base .int), ("b", .base .bool)])
+    (.base .int)) = true
+
+end CclFormal
diff --git a/formal/CclFormal/Equiv.lean b/formal/CclFormal/Equiv.lean
new file mode 100644
index 00000000..8d09afcc
--- /dev/null
+++ b/formal/CclFormal/Equiv.lean
@@ -0,0 +1,286 @@
+import CclFormal.Decide
+
+/-!
+# Checker ↔ relation: soundness, completeness, decidability
+
+`subCheck_iff_sub` proves the executable checker decides exactly the
+declarative relation, giving `Decidable (Sub ρl ρr lhs rhs)` — the ground
+subtype relation is decidable, and every `#guard` in `Decide.lean` is
+therefore a fact about `Sub` itself, not just about the checker.
+-/
+
+namespace CclFormal
+
+theorem kindOkB_iff {k0 k1 : FunKind} : kindOkB k0 k1 = true ↔ kindOk k0 k1 := by
+  cases k0 <;> cases k1 <;> simp [kindOkB, kindOk]
+
+theorem subSeq_iff (ρl ρr : Ren) :
+    ∀ a b, subSeq ρl ρr a b = true ↔
+      (b.length ≤ a.length ∧
+        ∀ (i : Nat) t0 t1, a[i]? = some t0 → b[i]? = some t1 →
+          subCheck ρl ρr t0 t1 = true)
+  | a, [] => by simp [subSeq]
+  | [], _ :: _ => by simp [subSeq]
+  | t0 :: a, t1 :: b => by
+      simp only [subSeq, Bool.and_eq_true, subSeq_iff ρl ρr a b,
+        List.length_cons]
+      constructor
+      · rintro ⟨h0, hlen, hrest⟩
+        refine ⟨Nat.succ_le_succ hlen, ?_⟩
+        intro i u0 u1 hu0 hu1
+        match i with
+        | 0 =>
+            simp at hu0 hu1
+            subst hu0; subst hu1
+            exact h0
+        | j + 1 =>
+            simp at hu0 hu1
+            exact hrest j u0 u1 hu0 hu1
+      · intro ⟨hlen, hall⟩
+        refine ⟨hall 0 t0 t1 (by simp) (by simp),
+          Nat.le_of_succ_le_succ hlen, ?_⟩
+        intro j u0 u1 h0 h1
+        exact hall (j + 1) u0 u1 (by simpa using h0) (by simpa using h1)
+
+theorem subFields_iff (ρl ρr : Ren) (a : List (String × Ty)) :
+    ∀ b, subFields ρl ρr a b = true ↔
+      ((∀ n t1, (n, t1) ∈ b → (lookupBy a n).isSome) ∧
+        ∀ n t0 t1, (n, t1) ∈ b → lookupBy a n = some t0 →
+          subCheck ρl ρr t0 t1 = true)
+  | [] => by simp [subFields]
+  | (n1, t1) :: rest => by
+      simp only [subFields, Bool.and_eq_true, subFields_iff ρl ρr a rest]
+      cases hlk : lookupBy a n1 with
+      | none =>
+          simp only [Bool.false_eq_true, false_and]
+          constructor
+          · exact fun h => h.elim
+          · rintro ⟨hsome, _⟩
+            have := hsome n1 t1 (List.mem_cons_self ..)
+            rw [hlk] at this
+            exact absurd this (by simp)
+      | some t0 =>
+          constructor
+          · rintro ⟨h0, hsome, hsub⟩
+            constructor
+            · intro n u hm
+              rcases List.mem_cons.mp hm with heq | hmem
+              · injection heq with h1 h2
+                subst h1
+                rw [hlk]; rfl
+              · exact hsome n u hmem
+            · intro n u0 u1 hm hl
+              rcases List.mem_cons.mp hm with heq | hmem
+              · injection heq with h1 h2
+                subst h1; subst h2
+                rw [hlk] at hl
+                injection hl with h
+                subst h
+                exact h0
+              · exact hsub n u0 u1 hmem hl
+          · rintro ⟨hsome, hsub⟩
+            exact ⟨hsub n1 t0 t1 (List.mem_cons_self ..) hlk,
+              fun n u hm => hsome n u (List.mem_cons_of_mem _ hm),
+              fun n u0 u1 hm hl => hsub n u0 u1 (List.mem_cons_of_mem _ hm) hl⟩
+
+theorem subTags_iff (ρl ρr : Ren) (b : List (FieldKey × Ty)) :
+    ∀ a, subTags ρl ρr b a = true ↔
+      ((∀ k t0, (k, t0) ∈ a → (lookupBy b k).isSome) ∧
+        ∀ k t0 t1, (k, t0) ∈ a → lookupBy b k = some t1 →
+          subCheck ρl ρr t0 t1 = true)
+  | [] => by simp [subTags]
+  | (k0, t0) :: rest => by
+      simp only [subTags, Bool.and_eq_true, subTags_iff ρl ρr b rest]
+      cases hlk : lookupBy b k0 with
+      | none =>
+          simp only [Bool.false_eq_true, false_and]
+          constructor
+          · exact fun h => h.elim
+          · rintro ⟨hsome, _⟩
+            have := hsome k0 t0 (List.mem_cons_self ..)
+            rw [hlk] at this
+            exact absurd this (by simp)
+      | some t1 =>
+          constructor
+          · rintro ⟨h0, hsome, hsub⟩
+            constructor
+            · intro k u hm
+              rcases List.mem_cons.mp hm with heq | hmem
+              · injection heq with h1 h2
+                subst h1
+                rw [hlk]; rfl
+              · exact hsome k u hmem
+            · intro k u0 u1 hm hl
+              rcases List.mem_cons.mp hm with heq | hmem
+              · injection heq with h1 h2
+                subst h1; subst h2
+                rw [hlk] at hl
+                injection hl with h
+                subst h
+                exact h0
+              · exact hsub k u0 u1 hmem hl
+          · rintro ⟨hsome, hsub⟩
+            exact ⟨hsub k0 t0 t1 (List.mem_cons_self ..) hlk,
+              fun k u hm => hsome k u (List.mem_cons_of_mem _ hm),
+              fun k u0 u1 hm hl => hsub k u0 u1 (List.mem_cons_of_mem _ hm) hl⟩
+
+/-- **Soundness**: an accepting run of the checker is a derivation. -/
+theorem sub_of_subCheck :
+    ∀ (lhs rhs : Ty) (ρl ρr : Ren),
+      subCheck ρl ρr lhs rhs = true → Sub ρl ρr lhs rhs
+  | lhs, rhs, ρl, ρr, h => by
+    rw [subCheck.eq_def] at h
+    split at h
+    -- Leaves.
+    · exact eq_of_beq h ▸ Sub.base _
+    · exact eq_of_beq h ▸ Sub.uintRange _
+    · exact eq_of_beq h ▸ Sub.dataSource _
+    · exact Sub.txn
+    -- Function edge.
+    · rename_i n0 k0 d0 c0 n1 k1 d1 c1
+      rw [Bool.and_eq_true, Bool.and_eq_true] at h
+      obtain ⟨⟨hok, hdom⟩, hcod⟩ := h
+      have hcodS := sub_of_subCheck c0 c1 (codRen n0 n1 ρl) ρr hcod
+      split at hdom
+      · -- data-data: invariant domains.
+        rename_i hdd
+        rw [Bool.and_eq_true] at hdd
+        have hk0 : k0 = .data := by simpa using hdd.1
+        have hk1 : k1 = .data := by simpa using hdd.2
+        subst hk0; subst hk1
+        rw [Bool.and_eq_true] at hdom
+        exact Sub.fnData
+          (sub_of_subCheck d1 d0 ρr ρl hdom.1)
+          (sub_of_subCheck d0 d1 ρl ρr hdom.2) hcodS
+      · rename_i hdd
+        have hnd : ¬(k0 = .data ∧ k1 = .data) := by
+          rintro ⟨rfl, rfl⟩
+          exact hdd (by simp)
+        exact Sub.fnCompute (kindOkB_iff.mp hok) hnd
+          (sub_of_subCheck d1 d0 ρr ρl hdom) hcodS
+    -- Tuple.
+    · rename_i a b
+      obtain ⟨hlen, hpt⟩ := (subSeq_iff ρl ρr a b).mp h
+      refine Sub.tuple hlen fun i t0 t1 h0 h1 => ?_
+      have hm0 := List.mem_of_getElem? h0
+      have hm1 := List.mem_of_getElem? h1
+      have hs0 := List.sizeOf_lt_of_mem hm0
+      have hs1 := List.sizeOf_lt_of_mem hm1
+      exact sub_of_subCheck t0 t1 ρl ρr (hpt i t0 t1 h0 h1)
+    -- Record.
+    · rename_i a b
+      obtain ⟨hsome, hsub⟩ := (subFields_iff ρl ρr a b).mp h
+      refine Sub.record hsome fun n t0 t1 hm hlk => ?_
+      have hs0 := lookupBy_sizeOf hlk
+      have hs1 : sizeOf t1 < sizeOf b := by
+        have h' := List.sizeOf_lt_of_mem hm
+        rw [Prod.mk.sizeOf_spec] at h'
+        omega
+      exact sub_of_subCheck t0 t1 ρl ρr (hsub n t0 t1 hm hlk)
+    -- Variant.
+    · rename_i a b
+      obtain ⟨hsome, hsub⟩ := (subTags_iff ρl ρr b a).mp h
+      refine Sub.variant hsome fun k t0 t1 hm hlk => ?_
+      have hs1 := lookupBy_sizeOf hlk
+      have hs0 : sizeOf t0 < sizeOf a := by
+        have h' := List.sizeOf_lt_of_mem hm
+        rw [Prod.mk.sizeOf_spec] at h'
+        omega
+      exact sub_of_subCheck t0 t1 ρl ρr (hsub k t0 t1 hm hlk)
+    -- Refinement arm / mismatch catch-all. `lhs`/`rhs` stay un-substituted
+    -- here (the catch-all pins no constructors), which is exactly what
+    -- `Sub.refined`'s generic conclusion wants.
+    · split at h
+      · exact absurd h (by simp)
+      · rename_i hne
+        rw [Bool.and_eq_true] at h
+        obtain ⟨hdef, hbase⟩ := h
+        have hlt := Ty.peel_sum_lt lhs rhs hne
+        refine Sub.refined rfl rfl ?_ ?_
+          (sub_of_subCheck lhs.peel.1 rhs.peel.1 ρl ρr hbase)
+        · cases hl : lhs.peel.2 with
+          | nil =>
+              cases hr : rhs.peel.2 with
+              | nil => exact absurd ⟨hl, hr⟩ hne
+              | cons _ _ => exact .inr (by simp)
+          | cons _ _ => exact .inl (by simp)
+        · simpa using hdef
+termination_by lhs rhs _ _ _ => sizeOf lhs + sizeOf rhs
+decreasing_by
+  all_goals try subst_vars
+  all_goals simp_wf
+  all_goals first
+    | omega
+    | (simp at hsz; omega)
+
+/-- **Completeness**: a derivation makes the checker accept. -/
+theorem subCheck_of_sub {ρl ρr : Ren} {lhs rhs : Ty}
+    (h : Sub ρl ρr lhs rhs) : subCheck ρl ρr lhs rhs = true := by
+  induction h with
+  | base b => simp [subCheck]
+  | uintRange n => simp [subCheck]
+  | dataSource s => simp [subCheck]
+  | txn => simp [subCheck]
+  | @fnCompute ρl ρr n0 n1 k0 k1 d0 c0 d1 c1 hok hnd hdom hcod ihdom ihcod =>
+      have hdd : (k0 == FunKind.data && k1 == FunKind.data) = false := by
+        rw [Bool.and_eq_false_iff]
+        by_cases hk : k0 = .data
+        · subst hk
+          refine .inr ?_
+          rw [Bool.eq_false_iff]
+          intro hp
+          exact hnd ⟨rfl, by simpa using hp⟩
+        · exact .inl (by simpa using hk)
+      simp only [subCheck]
+      simp [hdd, kindOkB_iff.mpr hok, ihdom, ihcod]
+  | @fnData ρl ρr n0 n1 d0 c0 d1 c1 hdom1 hdom2 hcod ih1 ih2 ihcod =>
+      simp only [subCheck]
+      simp [kindOkB, ih1, ih2, ihcod]
+  | tuple hlen hpt ihpt =>
+      simp only [subCheck]
+      exact (subSeq_iff _ _ _ _).mpr ⟨hlen, ihpt⟩
+  | record hsome hsub ihsub =>
+      simp only [subCheck]
+      exact (subFields_iff _ _ _ _).mpr ⟨hsome, ihsub⟩
+  | variant hsome hsub ihsub =>
+      simp only [subCheck]
+      exact (subTags_iff _ _ _ _).mpr ⟨hsome, ihsub⟩
+  | @refined ρl ρr lhs rhs lb lrefs rb rrefs hpl hpr hguard hdef hbase ihbase =>
+      -- The conclusion's sides are generic; every non-catch-all checker arm
+      -- has both sides peeling to `(·, [])`, refuting the guard, and the
+      -- catch-all's else-branch is supplied by the premises.
+      rw [subCheck.eq_def]
+      split
+      all_goals try
+        (simp only [Ty.peel, Prod.mk.injEq] at hpl hpr
+         obtain ⟨-, hl2⟩ := hpl
+         obtain ⟨-, hr2⟩ := hpr
+         subst hl2; subst hr2
+         rcases hguard with hg | hg <;> exact absurd rfl hg)
+      -- The catch-all: the dite's condition is false by the guard.
+      rw [dif_neg]
+      · simp only [Bool.and_eq_true]
+        refine ⟨?_, ?_⟩
+        · rw [hpl, hpr]
+          simpa using hdef
+        · have hb : lhs.peel.1 = lb := by rw [hpl]
+          have hb' : rhs.peel.1 = rb := by rw [hpr]
+          rw [hb, hb']
+          exact ihbase
+      · rintro ⟨hl, hr⟩
+        rw [hpl] at hl
+        rw [hpr] at hr
+        simp at hl hr
+        subst hl; subst hr
+        rcases hguard with hg | hg <;> exact absurd rfl hg
+
+/-- The checker decides exactly the relation. -/
+theorem subCheck_iff_sub (ρl ρr : Ren) (lhs rhs : Ty) :
+    subCheck ρl ρr lhs rhs = true ↔ Sub ρl ρr lhs rhs :=
+  ⟨sub_of_subCheck lhs rhs ρl ρr, subCheck_of_sub⟩
+
+/-- **The ground subtype relation is decidable.** -/
+instance (ρl ρr : Ren) (lhs rhs : Ty) : Decidable (Sub ρl ρr lhs rhs) :=
+  decidable_of_iff _ (subCheck_iff_sub ρl ρr lhs rhs)
+
+end CclFormal
diff --git a/formal/CclFormal/Json.lean b/formal/CclFormal/Json.lean
new file mode 100644
index 00000000..1da405fb
--- /dev/null
+++ b/formal/CclFormal/Json.lean
@@ -0,0 +1,176 @@
+import Lean.Data.Json
+import CclFormal.Ty
+
+/-!
+# The wire codec
+
+Hand-written (not derived) so the schema is an explicit, stable contract the
+M1 Rust emitter serializes to with plain `serde_json`, rather than whatever
+shape a deriving handler happens to produce. Every object carries a `"k"`
+discriminant; pairs are 2-arrays.
+
+The parser is `partial` (recursion over `Lean.Json` has no useful structural
+measure); it is harness plumbing, not part of the model — nothing is proved
+about it, and the smoke `#guard`s below plus the M1 round-trip fuzz are its
+gate.
+-/
+
+namespace CclFormal
+
+open Lean (Json ToJson FromJson toJson fromJson?)
+
+def BaseTy.toWire : BaseTy → String
+  | .int => "Int"
+  | .uint => "UInt"
+  | .string => "String"
+  | .bool => "Bool"
+  | .unit => "Unit"
+
+def BaseTy.fromWire : String → Except String BaseTy
+  | "Int" => .ok .int
+  | "UInt" => .ok .uint
+  | "String" => .ok .string
+  | "Bool" => .ok .bool
+  | "Unit" => .ok .unit
+  | s => .error s!"unknown BaseType: {s}"
+
+def FunKind.toWire : FunKind → String
+  | .compute => "compute"
+  | .data => "data"
+
+def FunKind.fromWire : String → Except String FunKind
+  | "compute" => .ok .compute
+  | "data" => .ok .data
+  | s => .error s!"unknown FunKind: {s}"
+
+instance : ToJson FieldKey where
+  toJson
+    | .idx n => Json.mkObj [("k", "idx"), ("n", toJson n)]
+    | .name s => Json.mkObj [("k", "name"), ("s", toJson s)]
+
+instance : FromJson FieldKey where
+  fromJson? j := do
+    match (← j.getObjVal? "k").getStr? with
+    | .ok "idx" => return .idx (← fromJson? (← j.getObjVal? "n"))
+    | .ok "name" => return .name (← fromJson? (← j.getObjVal? "s"))
+    | _ => throw s!"unknown FieldKey: {j.compress}"
+
+partial def Pred.toJson : Pred → Json
+  | .elem => Json.mkObj [("k", "elem")]
+  | .var x => Json.mkObj [("k", "var"), ("x", Lean.toJson x)]
+  | .litInt n => Json.mkObj [("k", "litInt"), ("n", Lean.toJson n)]
+  | .litBool b => Json.mkObj [("k", "litBool"), ("b", Lean.toJson b)]
+  | .litStr s => Json.mkObj [("k", "litStr"), ("s", Lean.toJson s)]
+  | .litUnit => Json.mkObj [("k", "litUnit")]
+  | .unop op a => Json.mkObj [("k", "unop"), ("op", Lean.toJson op), ("a", a.toJson)]
+  | .binop op a b =>
+      Json.mkObj [("k", "binop"), ("op", Lean.toJson op), ("a", a.toJson), ("b", b.toJson)]
+  | .proj a key => Json.mkObj [("k", "proj"), ("a", a.toJson), ("key", Lean.toJson key)]
+  | .app f a => Json.mkObj [("k", "app"), ("f", f.toJson), ("a", a.toJson)]
+
+partial def Pred.fromJson? (j : Json) : Except String Pred := do
+  match (← j.getObjVal? "k").getStr? with
+  | .ok "elem" => return .elem
+  | .ok "var" => return .var (← Lean.fromJson? (← j.getObjVal? "x"))
+  | .ok "litInt" => return .litInt (← Lean.fromJson? (← j.getObjVal? "n"))
+  | .ok "litBool" => return .litBool (← Lean.fromJson? (← j.getObjVal? "b"))
+  | .ok "litStr" => return .litStr (← Lean.fromJson? (← j.getObjVal? "s"))
+  | .ok "litUnit" => return .litUnit
+  | .ok "unop" =>
+      return .unop (← Lean.fromJson? (← j.getObjVal? "op"))
+        (← Pred.fromJson? (← j.getObjVal? "a"))
+  | .ok "binop" =>
+      return .binop (← Lean.fromJson? (← j.getObjVal? "op"))
+        (← Pred.fromJson? (← j.getObjVal? "a"))
+        (← Pred.fromJson? (← j.getObjVal? "b"))
+  | .ok "proj" =>
+      return .proj (← Pred.fromJson? (← j.getObjVal? "a"))
+        (← Lean.fromJson? (← j.getObjVal? "key"))
+  | .ok "app" =>
+      return .app (← Pred.fromJson? (← j.getObjVal? "f"))
+        (← Pred.fromJson? (← j.getObjVal? "a"))
+  | _ => throw s!"unknown Pred: {j.compress}"
+
+instance : ToJson Pred := ⟨Pred.toJson⟩
+instance : FromJson Pred := ⟨Pred.fromJson?⟩
+
+partial def Ty.toJson : Ty → Json
+  | .base b => Json.mkObj [("k", "base"), ("base", Lean.toJson b.toWire)]
+  | .uintRange n => Json.mkObj [("k", "uintRange"), ("n", Lean.toJson n)]
+  | .dataSource s => Json.mkObj [("k", "dataSource"), ("name", Lean.toJson s)]
+  | .txn => Json.mkObj [("k", "txn")]
+  | .fn n k d c =>
+      Json.mkObj [("k", "fn"),
+        ("binder", match n with | some s => Lean.toJson s | none => Json.null),
+        ("kind", Lean.toJson k.toWire), ("dom", d.toJson), ("cod", c.toJson)]
+  | .tuple ts => Json.mkObj [("k", "tuple"), ("ts", Json.arr (ts.map Ty.toJson).toArray)]
+  | .record fs =>
+      Json.mkObj [("k", "record"),
+        ("fields", Json.arr (fs.map fun (n, t) =>
+          Json.arr #[Lean.toJson n, t.toJson]).toArray)]
+  | .variant tags =>
+      Json.mkObj [("k", "variant"),
+        ("tags", Json.arr (tags.map fun (key, t) =>
+          Json.arr #[Lean.toJson key, t.toJson]).toArray)]
+  | .refined b ps =>
+      Json.mkObj [("k", "refined"), ("base", b.toJson),
+        ("claims", Json.arr (ps.map Lean.toJson).toArray)]
+
+mutual
+
+partial def Ty.fromJson? (j : Json) : Except String Ty := do
+  match (← j.getObjVal? "k").getStr? with
+  | .ok "base" => return .base (← BaseTy.fromWire (← (← j.getObjVal? "base").getStr?))
+  | .ok "uintRange" => return .uintRange (← Lean.fromJson? (← j.getObjVal? "n"))
+  | .ok "dataSource" => return .dataSource (← Lean.fromJson? (← j.getObjVal? "name"))
+  | .ok "txn" => return .txn
+  | .ok "fn" =>
+      let binder ← match ← j.getObjVal? "binder" with
+        | Json.null => pure none
+        | b => some <$> Lean.fromJson? b
+      return .fn binder (← FunKind.fromWire (← (← j.getObjVal? "kind").getStr?))
+        (← Ty.fromJson? (← j.getObjVal? "dom")) (← Ty.fromJson? (← j.getObjVal? "cod"))
+  | .ok "tuple" =>
+      let ts ← (← (← j.getObjVal? "ts").getArr?).toList.mapM Ty.fromJson?
+      return .tuple ts
+  | .ok "record" =>
+      let fs ← (← (← j.getObjVal? "fields").getArr?).toList.mapM
+        (pairFromJson? Lean.fromJson?)
+      return .record fs
+  | .ok "variant" =>
+      let tags ← (← (← j.getObjVal? "tags").getArr?).toList.mapM
+        (pairFromJson? Lean.fromJson?)
+      return .variant tags
+  | .ok "refined" =>
+      return .refined (← Ty.fromJson? (← j.getObjVal? "base"))
+        (← Lean.fromJson? (← j.getObjVal? "claims"))
+  | _ => throw s!"unknown Ty: {j.compress}"
+
+/-- A `[key, ty]` 2-array pair (record field / variant tag). -/
+partial def pairFromJson? (f : Json → Except String α) (e : Json) :
+    Except String (α × Ty) := do
+  match ← e.getArr? with
+  | #[k, t] => return (← f k, ← Ty.fromJson? t)
+  | _ => throw s!"expected a 2-array pair: {e.compress}"
+
+end
+
+instance : ToJson Ty := ⟨Ty.toJson⟩
+instance : FromJson Ty := ⟨Ty.fromJson?⟩
+
+/-- Round-trip smoke checks (`BEq`-compared; `beq ↔ eq` is a later step). -/
+private def roundTrips (t : Ty) : Bool :=
+  match (Lean.fromJson? (Lean.toJson t) : Except String Ty) with
+  | .ok t' => t == t'
+  | .error _ => false
+
+#guard roundTrips (.base .int)
+#guard roundTrips (.fn (some "x") .data (.uintRange 3)
+  (.refined (.base .int) [.binop "eq" .elem (.var "x")]))
+-- A multi-claim position round-trips too: the wire carries the whole set.
+#guard roundTrips (.refined (.base .int)
+  [.binop "eq" .elem (.var "x"), .binop "eq" .elem (.var "y")])
+#guard roundTrips (.record [("a", .base .bool), ("b", .tuple [.txn, .dataSource "s"])])
+#guard roundTrips (.variant [(.idx 0, .base .unit), (.name "tag", .base .string)])
+
+end CclFormal
diff --git a/formal/CclFormal/Merge.lean b/formal/CclFormal/Merge.lean
new file mode 100644
index 00000000..30bf394c
--- /dev/null
+++ b/formal/CclFormal/Merge.lean
@@ -0,0 +1,2149 @@
+import CclFormal.Ty
+
+/-!
+# The solver's polar merge and its algebra
+
+The Lean mirror of `src/ccl/infer/solver/compact.rs`'s bound-merging — the
+operation `coalesce` folds over a variable's bounds (`CompactType::merge`,
+`CompactFun::merge`, `merge_refinements`, `merge_records`, `merge_variants`) —
+and the theorems that make the solver's order-independence claim a proof
+obligation instead of a fuzz observation:
+
+- `eqv` is an equivalence relation (`eqv_refl`, `eqv_symm`, `eqv_trans`);
+- `merge` is commutative (`merge_comm`), idempotent (`merge_idem`), and a
+  congruence for `eqv` (`merge_congr_left`/`_right`);
+- `merge` is associative on the kind-uniform fragments
+  (`merge_assoc_of_computeFree`) — and **not in general**: mixing `data` and
+  `compute` function bounds over distinct domains makes the outcome depend on
+  association (`merge_not_assoc`), which means arrival order can decide
+  accept-vs-reject. See `formal/design.md`, "M4b — the merge algebra".
+- The fold `coalesce` performs is invariant under permutation and duplication
+  of the bound list on the associative fragment (`fold_perm`, `fold_dup`).
+
+## What the model is a mirror of, and what it drops
+
+`CTy` is the ground fragment of `CompactType`: atoms, the optional
+record/variant maps, the optional function slot, the refinement claim set,
+and an error flag. Deliberately dropped, with the reasoning:
+
+- **Inference variables** (`vars`) — the ground algebra doesn't read them;
+  they union like atoms and would only pad every proof.
+- **History slots** — transients erased before the strict wall, exactly as
+  `Ty` excludes `History` (same-polarity componentwise merge; nothing new).
+- **The Pi binder** (`CompactFun::name`, merged `a.name.or(b.name)`) —
+  first-wins is order-dependent as written, but `Subst::canonical_pi_binder`
+  renames both sides to the same depth-indexed `__pi{n}` during compaction,
+  so by merge time the slots agree; the asymmetry is unobservable.
+- **`reduce_error`'s payload** (`lhs.or(rhs)`, first-wins) — *which* error is
+  diagnostic; the flag (`err`) is what the algebra observes.
+- **Domain-alternative payloads beyond one** — `union_domains` keeps a `Vec`
+  in arrival order, but every path that could read a second alternative ends
+  in a coalesce error (`DomainJoinConflict`; a `Data` function materializes
+  only when exactly one domain survives), so the tail of the list is
+  diagnostic. `fn`'s domain slot is therefore `Option CTy`: `some d` for a
+  single domain, `none` for "two or more distinct alternatives" (and for a
+  conflicted slot's payload). If the Σ collections work ever materializes a
+  multi-domain join, the alternatives become semantic and this adjudication
+  must be revisited.
+
+## The equivalence is the code's own equality
+
+`eqv` mirrors `CompactType`'s `PartialEq`: set-semantic on atoms and claims
+(mirroring `BTreeSet` and `RefinementSet`), key-set + payload on the maps
+(mirroring `BTreeMap`), componentwise on the function slot. The merge's one
+internal comparison — `union_domains` deduplicating two `Data` domains — uses
+that same equality, which is what makes every theorem quotient-compatible:
+the gate cannot distinguish two `eqv`-equal inputs.
+
+There is **no identity element**, by design: `compact_go` folds a variable's
+bounds from the *first bound*, never from `CompactType::default()`, because
+an empty claim set is absorbing (not neutral) under the positive intersect —
+the fold theorems are stated over nonempty lists accordingly.
+-/
+
+namespace CclFormal
+
+/-- Mirror of `compact.rs :: AtomKey` (ground fragment — `ChanDom` excluded,
+the same adjudication as `Ty`'s exclusion of pipeline transients). -/
+inductive Atom where
+  | prim (b : BaseTy)
+  | uintRange (n : Nat)
+  | source (s : String)
+  | txn
+deriving Repr, DecidableEq
+
+/-- Mirror of `compact.rs :: KindMerge`: the two ground kinds plus the
+`conflict` absorbing state a bad kind meeting leaves behind (coalesce turns it
+into an error; it never materializes). -/
+inductive KindM where
+  | data | compute | conflict
+deriving Repr, DecidableEq
+
+/-- Mirror of the ground fragment of `compact.rs :: CompactType`.
+
+The function slot is `(kind, domain, codomain)` with `domain : Option CTy` —
+`some d` is a single domain alternative, `none` is "two or more distinct
+alternatives" (see the module docs for why the tail of `union_domains`' list
+is diagnostic-only). `recF`/`varT` mirror the `Option<BTreeMap<..>>` fields:
+`none` is the merge identity ("no component here"), `some []` the absorbing
+empty shape — the distinction `compact.rs` documents as load-bearing. -/
+inductive CTy where
+  | mk (atoms : List Atom)
+       (recF : Option (List (FieldKey × CTy)))
+       (varT : Option (List (FieldKey × CTy)))
+       (fn : Option (KindM × Option CTy × CTy))
+       (claims : List Pred)
+       (err : Bool)
+deriving Repr
+
+namespace CTy
+
+/-- `sizeOf` of a looked-up payload is below the map's. -/
+theorem lookup_sizeOf {m : List (FieldKey × CTy)} {k : FieldKey} {w : CTy}
+    (h : m.lookup k = some w) : sizeOf w < sizeOf m := by
+  induction m with
+  | nil => simp [List.lookup] at h
+  | cons hd tl ih =>
+    rw [List.lookup] at h
+    split at h
+    · cases h
+      cases hd
+      simp
+      omega
+    · have := ih h
+      cases hd
+      simp
+      omega
+
+/-! ## The equivalence (`CompactType`'s `PartialEq`) -/
+
+mutual
+
+/-- Set-semantic equality, mirroring `CompactType`'s `PartialEq` (see module
+docs). Defined *before* `merge` because the merge's domain-dedup gate uses it,
+exactly as `union_domains` uses `PartialEq`. -/
+def eqv : CTy → CTy → Bool
+  | .mk a1 r1 v1 f1 c1 e1, .mk a2 r2 v2 f2 c2 e2 =>
+    a1.all (a2.contains ·) && a2.all (a1.contains ·)
+      && (match r1, r2 with
+          | none, none => true
+          | some m1, some m2 =>
+            subKeys m1 m2 (m1.map Prod.fst) && subKeys m2 m1 (m2.map Prod.fst)
+          | _, _ => false)
+      && (match v1, v2 with
+          | none, none => true
+          | some m1, some m2 =>
+            subKeys m1 m2 (m1.map Prod.fst) && subKeys m2 m1 (m2.map Prod.fst)
+          | _, _ => false)
+      && (match f1, f2 with
+          | none, none => true
+          | some (k1, d1, c1), some (k2, d2, c2) =>
+            k1 == k2
+              && (match d1, d2 with
+                  | none, none => true
+                  | some x, some y => eqv x y
+                  | _, _ => false)
+              && eqv c1 c2
+          | _, _ => false)
+      && c1.all (c2.contains ·) && c2.all (c1.contains ·)
+      && e1 == e2
+termination_by a b => (sizeOf a + sizeOf b, 0)
+
+/-- Keyed containment over a key worklist: every key in `ks` resolves in both
+maps to `eqv` payloads. Driven by `lookup` on **both** sides (not the peeled
+entry), so a shadowed duplicate binding is unobservable — mirroring
+`BTreeMap`, which cannot hold one. `eqv` calls it with `ks = m1.map Prod.fst`
+in both directions. -/
+def subKeys (m1 m2 : List (FieldKey × CTy)) : List FieldKey → Bool
+  | [] => true
+  | k :: ks =>
+    (match h1 : m1.lookup k, h2 : m2.lookup k with
+     | some v, some w => eqv v w
+     | _, _ => false)
+      && subKeys m1 m2 ks
+termination_by ks => (sizeOf m1 + sizeOf m2, ks.length)
+decreasing_by
+  · have hv := lookup_sizeOf h1
+    have hw := lookup_sizeOf h2
+    apply Prod.Lex.left
+    omega
+  · apply Prod.Lex.right
+    simp
+
+end
+
+/-! ## The merge -/
+
+mutual
+
+/-- Mirror of `CompactType::merge` (ground fragment). `pol` is the polarity:
+positive merges are joins (types union, claims/record-keys intersect, variant
+tags union), negative merges are meets (the duals). -/
+def merge (pol : Bool) : CTy → CTy → CTy
+  | .mk a1 r1 v1 f1 c1 e1, .mk a2 r2 v2 f2 c2 e2 =>
+    .mk (a1 ++ a2)
+        (match r1, r2 with
+         | none, r | r, none => r
+         | some m1, some m2 =>
+           some
+             (if pol then interMap pol m1 m2
+              else unionMapGo pol m1 m2 ++ m2.filter (fun kw => (m1.lookup kw.1).isNone)))
+        (match v1, v2 with
+         | none, v | v, none => v
+         | some m1, some m2 =>
+           some
+             (if pol then unionMapGo pol m1 m2 ++ m2.filter (fun kw => (m1.lookup kw.1).isNone)
+              else interMap pol m1 m2))
+        (match f1, f2 with
+         | none, f | f, none => f
+         | some s1, some s2 => some (mergeFun pol s1 s2))
+        (if pol then c1.filter (c2.contains ·) else c1 ++ c2)
+        (e1 || e2)
+termination_by a b => sizeOf a + sizeOf b
+
+/-- Keyed merge, intersecting keys (records at positive polarity, variants at
+negative): keep only keys present on both sides, payloads merged at the outer
+polarity (covariant depth — `merge_keyed` with `intersect_keys = true`). -/
+def interMap (pol : Bool) :
+    List (FieldKey × CTy) → List (FieldKey × CTy) → List (FieldKey × CTy)
+  | [], _ => []
+  | (k, v) :: rest, m2 =>
+    match h : m2.lookup k with
+    | some w => (k, merge pol v w) :: interMap pol rest m2
+    | none => interMap pol rest m2
+termination_by a b => sizeOf a + sizeOf b
+decreasing_by
+  · have := lookup_sizeOf h
+    simp
+    omega
+  · simp
+    omega
+  · simp
+    omega
+
+/-- The `m1`-side of the key-uniting merge (records at negative polarity,
+variants at positive — `merge_keyed` with `intersect_keys = false`): every key
+of `m1`, merged with `m2`'s payload when present. The full union appends
+`m2`'s leftover keys: `unionMapGo pol m1 m2 ++ m2.filter (·.1 ∉ keys m1)` —
+see [`unionMap`]. -/
+def unionMapGo (pol : Bool) :
+    List (FieldKey × CTy) → List (FieldKey × CTy) → List (FieldKey × CTy)
+  | [], _ => []
+  | (k, v) :: rest, m2 =>
+    (k,
+      match h : m2.lookup k with
+      | some w => merge pol v w
+      | none => v)
+      :: unionMapGo pol rest m2
+termination_by a b => sizeOf a + sizeOf b
+decreasing_by
+  · have := lookup_sizeOf h
+    simp
+    omega
+  · simp
+    omega
+
+/-- Mirror of `CompactFun::merge` (see module docs for the `Option CTy`
+domain encoding and the dropped binder/diagnostic payloads).
+
+The domain-dedup gate in the positive `data ⊔ data` arm is `eqv` — the same
+equality `union_domains`' `contains` uses — which is what keeps the whole
+algebra quotient-compatible. -/
+def mergeFun (pol : Bool) :
+    KindM × Option CTy × CTy → KindM × Option CTy × CTy → KindM × Option CTy × CTy
+  | (k1, d1, c1), (k2, d2, c2) =>
+    let cod := merge pol c1 c2
+    if k1 == .conflict || k2 == .conflict then
+      (.conflict, none, cod)
+    else if pol then
+      match k1, k2, d1, d2 with
+      -- Data ⊔ Data: the union of the alternatives. Two alternatives that
+      -- compare equal are one domain; otherwise the join has no lossless
+      -- single-domain answer and coalesce will error (`none` = "many").
+      | .data, .data, some x, some y =>
+        (.data, if eqv x y then some x else none, cod)
+      | .data, .data, _, _ => (.data, none, cod)
+      -- Compute ⊔ Compute: the contravariant domain meet.
+      | .compute, .compute, some x, some y =>
+        (.compute, some (merge (!pol) x y), cod)
+      -- Data ⊔ Compute: an honest upcast to a callable iff the data side is a
+      -- single domain; collapsing several alternatives to a meet would drop
+      -- domains.
+      | _, _, some x, some y => (.compute, some (merge (!pol) x y), cod)
+      | _, _, _, _ => (.conflict, none, cod)
+    else
+      -- Negative (meet): the stronger contract wins (`data` if either is).
+      let k := if k1 == .data || k2 == .data then KindM.data else KindM.compute
+      match d1, d2 with
+      | some x, some y => (k, some (merge (!pol) x y), cod)
+      | _, _ => (.conflict, none, cod)
+termination_by a b => sizeOf a + sizeOf b
+decreasing_by all_goals (simp; omega)
+
+end
+
+/-- Keyed merge, uniting keys: keys of either side, payloads merged where both
+are present. (Defined outside the mutual block — it makes no recursive call of
+its own, and the well-founded measure cannot see through a same-size wrapper;
+`merge` inlines this same expression.) -/
+def unionMap (pol : Bool) (m1 m2 : List (FieldKey × CTy)) :
+    List (FieldKey × CTy) :=
+  unionMapGo pol m1 m2 ++ m2.filter (fun kw => (m1.lookup kw.1).isNone)
+
+/-! ## Pointwise readings
+
+Everything below reasons about maps through `lookup` — the merged maps are
+characterized pointwise (`interMap_lookup`, `unionMap_lookup`), and `subKeys`
+unfolds to a per-key statement (`subKeys_iff`), so the set-level proofs never
+touch the association-list representation again. -/
+
+/-- A `lookup` hit means the key occurs in the key list. -/
+theorem mem_keys_of_lookup {m : List (FieldKey × CTy)} {k : FieldKey} {v : CTy}
+    (h : m.lookup k = some v) : k ∈ m.map Prod.fst := by
+  induction m with
+  | nil => simp [List.lookup] at h
+  | cons hd tl ih =>
+    rw [List.lookup] at h
+    split at h
+    · rename_i heq
+      simp at heq
+      simp [heq]
+    · simp only [List.map_cons, List.mem_cons]
+      exact Or.inr (ih h)
+
+/-- A key in the key list has a `lookup` hit. -/
+theorem lookup_of_mem_keys {m : List (FieldKey × CTy)} {k : FieldKey}
+    (h : k ∈ m.map Prod.fst) : (m.lookup k).isSome := by
+  induction m with
+  | nil => simp at h
+  | cons hd tl ih =>
+    rw [List.lookup]
+    split
+    · simp
+    · rename_i hne
+      simp at hne
+      simp only [List.map_cons, List.mem_cons] at h
+      rcases h with h | h
+      · exact absurd h hne
+      · exact ih h
+
+/-- `subKeys`, read per key. -/
+theorem subKeys_iff {m1 m2 : List (FieldKey × CTy)} {ks : List FieldKey} :
+    subKeys m1 m2 ks = true ↔
+      ∀ k ∈ ks, ∃ v w, m1.lookup k = some v ∧ m2.lookup k = some w ∧ eqv v w = true := by
+  induction ks with
+  | nil => simp [subKeys]
+  | cons k ks ih =>
+    rw [subKeys, Bool.and_eq_true, ih]
+    constructor
+    · intro ⟨hhead, htail⟩ k' hk'
+      rcases List.mem_cons.mp hk' with h | h
+      · subst h
+        split at hhead
+        · rename_i v w h1 h2
+          exact ⟨v, w, h1, h2, hhead⟩
+        · exact absurd hhead (by simp)
+      · exact htail k' h
+    · intro h
+      obtain ⟨v, w, h1, h2, hvw⟩ := h k (by simp)
+      refine ⟨?_, fun k' hk' => h k' (by simp [hk'])⟩
+      split
+      · rename_i v' w' h1' h2'
+        rw [h1] at h1'
+        rw [h2] at h2'
+        cases h1'
+        cases h2'
+        exact hvw
+      · rename_i hno
+        exact (hno v w (by rw [h1]) (by rw [h2])).elim
+
+/-! ## `eqv` is an equivalence relation -/
+
+theorem eqv_refl : (t : CTy) → eqv t t = true
+  | .mk a r v f c e => by
+    have hmap : ∀ (m : List (FieldKey × CTy)), sizeOf m < sizeOf (CTy.mk a r v f c e) →
+        subKeys m m (m.map Prod.fst) = true := by
+      intro m hm
+      rw [subKeys_iff]
+      intro k hk
+      obtain ⟨w, hw⟩ := Option.isSome_iff_exists.mp (lookup_of_mem_keys hk)
+      have hsz : sizeOf w < sizeOf (CTy.mk a r v f c e) :=
+        Nat.lt_trans (lookup_sizeOf hw) hm
+      exact ⟨w, w, hw, hw, eqv_refl w⟩
+    rw [eqv.eq_def]
+    simp only [Bool.and_eq_true]
+    refine ⟨⟨⟨⟨⟨⟨⟨?_, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩
+    · simp [List.all_eq_true]
+    · simp [List.all_eq_true]
+    · rcases r with _ | m
+      · rfl
+      · have hm : sizeOf m < sizeOf (CTy.mk a (some m) v f c e) := by
+          simp
+          omega
+        simp [hmap m hm]
+    · rcases v with _ | m
+      · rfl
+      · have hm : sizeOf m < sizeOf (CTy.mk a r (some m) f c e) := by
+          simp
+          omega
+        simp [hmap m hm]
+    · rcases f with _ | ⟨k, d, cod⟩
+      · rfl
+      · have hszc : sizeOf cod < sizeOf (CTy.mk a r v (some (k, d, cod)) c e) := by
+          simp
+          omega
+        rcases d with _ | d
+        · simp [eqv_refl cod]
+        · have hszd : sizeOf d < sizeOf (CTy.mk a r v (some (k, some d, cod)) c e) := by
+            simp
+            omega
+          simp [eqv_refl d, eqv_refl cod]
+    · simp [List.all_eq_true]
+    · simp [List.all_eq_true]
+    · simp
+termination_by t => sizeOf t
+decreasing_by all_goals omega
+
+/-- Unfolded, pointwise reading of the map clause both `eqv` map slots use. -/
+theorem mapClause_iff {m1 m2 : List (FieldKey × CTy)} :
+    (subKeys m1 m2 (m1.map Prod.fst) && subKeys m2 m1 (m2.map Prod.fst)) = true ↔
+      (∀ k, (m1.lookup k).isSome ↔ (m2.lookup k).isSome) ∧
+        (∀ k v w, m1.lookup k = some v → m2.lookup k = some w → eqv v w = true)
+          ∧ ∀ k v w, m1.lookup k = some v → m2.lookup k = some w → eqv w v = true := by
+  rw [Bool.and_eq_true, subKeys_iff, subKeys_iff]
+  constructor
+  · intro ⟨h12, h21⟩
+    refine ⟨fun k => ?_, fun k v w hv hw => ?_, fun k v w hv hw => ?_⟩
+    · constructor
+      · intro h1
+        obtain ⟨v, hv⟩ := Option.isSome_iff_exists.mp h1
+        obtain ⟨_, w, _, hw, _⟩ := h12 k (mem_keys_of_lookup hv)
+        simp [hw]
+      · intro h2
+        obtain ⟨w, hw⟩ := Option.isSome_iff_exists.mp h2
+        obtain ⟨_, v, _, hv, _⟩ := h21 k (mem_keys_of_lookup hw)
+        simp [hv]
+    · obtain ⟨v', w', hv', hw', hvw⟩ := h12 k (mem_keys_of_lookup hv)
+      rw [hv] at hv'
+      rw [hw] at hw'
+      cases hv'
+      cases hw'
+      exact hvw
+    · obtain ⟨w', v', hw', hv', hwv⟩ := h21 k (mem_keys_of_lookup hw)
+      rw [hv] at hv'
+      rw [hw] at hw'
+      cases hv'
+      cases hw'
+      exact hwv
+  · intro ⟨hdom, hfwd, hbwd⟩
+    constructor
+    · intro k hk
+      obtain ⟨v, hv⟩ := Option.isSome_iff_exists.mp (lookup_of_mem_keys hk)
+      obtain ⟨w, hw⟩ := Option.isSome_iff_exists.mp ((hdom k).mp (by simp [hv]))
+      exact ⟨v, w, hv, hw, hfwd k v w hv hw⟩
+    · intro k hk
+      obtain ⟨w, hw⟩ := Option.isSome_iff_exists.mp (lookup_of_mem_keys hk)
+      obtain ⟨v, hv⟩ := Option.isSome_iff_exists.mp ((hdom k).mpr (by simp [hw]))
+      exact ⟨w, v, hw, hv, hbwd k v w hv hw⟩
+
+theorem eqv_symm : (a b : CTy) → eqv a b = true → eqv b a = true
+  | .mk a1 r1 v1 f1 c1 e1, .mk a2 r2 v2 f2 c2 e2 => by
+    intro h
+    rw [eqv.eq_def] at h
+    simp only [Bool.and_eq_true] at h
+    obtain ⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, hr⟩, hv⟩, hf⟩, hc1⟩, hc2⟩, he⟩ := h
+    rw [eqv.eq_def]
+    simp only [Bool.and_eq_true]
+    refine ⟨⟨⟨⟨⟨⟨⟨h2, h1⟩, ?_⟩, ?_⟩, ?_⟩, hc2⟩, hc1⟩, ?_⟩
+    · rcases r1 with _ | m1 <;> rcases r2 with _ | m2 <;> simp_all
+    · rcases v1 with _ | m1 <;> rcases v2 with _ | m2 <;> simp_all
+    · rcases f1 with _ | ⟨k1, d1, cod1⟩ <;> rcases f2 with _ | ⟨k2, d2, cod2⟩
+      · rfl
+      · simp at hf
+      · simp at hf
+      · simp only [Bool.and_eq_true] at hf
+        obtain ⟨⟨hk, hd⟩, hcod⟩ := hf
+        simp only [Bool.and_eq_true]
+        have hszc : sizeOf cod2 + sizeOf cod1 <
+            sizeOf (CTy.mk a2 r2 v2 (some (k2, d2, cod2)) c2 e2) +
+              sizeOf (CTy.mk a1 r1 v1 (some (k1, d1, cod1)) c1 e1) := by
+          simp
+          omega
+        refine ⟨⟨?_, ?_⟩, eqv_symm cod1 cod2 hcod⟩
+        · simp at hk
+          simp [hk]
+        · rcases d1 with _ | x <;> rcases d2 with _ | y
+          · rfl
+          · simp at hd
+          · simp at hd
+          · have hszd : sizeOf y + sizeOf x <
+                sizeOf (CTy.mk a2 r2 v2 (some (k2, some y, cod2)) c2 e2) +
+                  sizeOf (CTy.mk a1 r1 v1 (some (k1, some x, cod1)) c1 e1) := by
+              simp
+              omega
+            exact eqv_symm x y hd
+    · simp at he
+      simp [he]
+termination_by a b => sizeOf a + sizeOf b
+decreasing_by all_goals omega
+
+theorem eqv_trans : (a b c : CTy) → eqv a b = true → eqv b c = true → eqv a c = true
+  | .mk a1 r1 v1 f1 c1 e1, .mk a2 r2 v2 f2 c2 e2, .mk a3 r3 v3 f3 c3 e3 => by
+    intro hab hbc
+    rw [eqv.eq_def] at hab hbc
+    simp only [Bool.and_eq_true] at hab hbc
+    obtain ⟨⟨⟨⟨⟨⟨⟨hab1, hab2⟩, habr⟩, habv⟩, habf⟩, habc1⟩, habc2⟩, habe⟩ := hab
+    obtain ⟨⟨⟨⟨⟨⟨⟨hbc1, hbc2⟩, hbcr⟩, hbcv⟩, hbcf⟩, hbcc1⟩, hbcc2⟩, hbce⟩ := hbc
+    rw [eqv.eq_def]
+    simp only [Bool.and_eq_true]
+    have hsub : ∀ {α : Type} [inst : DecidableEq α] (x y z : List α),
+        (x.all (y.contains ·)) = true → (y.all (z.contains ·)) = true →
+          (x.all (z.contains ·)) = true := by
+      intro α _ x y z hxy hyz
+      simp only [List.all_eq_true] at *
+      intro p hp
+      have h1 := hxy p hp
+      simp only [List.contains_iff_mem] at h1 ⊢
+      have h2 := hyz _ h1
+      simpa using h2
+    have hmapTrans : ∀ (m1 m2 m3 : List (FieldKey × CTy)),
+        sizeOf m1 < sizeOf (CTy.mk a1 r1 v1 f1 c1 e1) →
+        sizeOf m3 < sizeOf (CTy.mk a3 r3 v3 f3 c3 e3) →
+        (subKeys m1 m2 (m1.map Prod.fst) && subKeys m2 m1 (m2.map Prod.fst)) = true →
+        (subKeys m2 m3 (m2.map Prod.fst) && subKeys m3 m2 (m3.map Prod.fst)) = true →
+        (subKeys m1 m3 (m1.map Prod.fst) && subKeys m3 m1 (m3.map Prod.fst)) = true := by
+      intro m1 m2 m3 hs1 hs3 h12 h23
+      rw [mapClause_iff] at h12 h23 ⊢
+      obtain ⟨hdom12, hfwd12, hbwd12⟩ := h12
+      obtain ⟨hdom23, hfwd23, hbwd23⟩ := h23
+      refine ⟨fun k => (hdom12 k).trans (hdom23 k), fun k x z hx hz => ?_, fun k x z hx hz => ?_⟩
+      · obtain ⟨y, hy⟩ := Option.isSome_iff_exists.mp ((hdom12 k).mp (by simp [hx]))
+        have hxy := hfwd12 k x y hx hy
+        have hyz := hfwd23 k y z hy hz
+        have hszx : sizeOf x < sizeOf (CTy.mk a1 r1 v1 f1 c1 e1) :=
+          Nat.lt_trans (lookup_sizeOf hx) hs1
+        have hszz : sizeOf z < sizeOf (CTy.mk a3 r3 v3 f3 c3 e3) :=
+          Nat.lt_trans (lookup_sizeOf hz) hs3
+        exact eqv_trans x y z hxy hyz
+      · obtain ⟨y, hy⟩ := Option.isSome_iff_exists.mp ((hdom12 k).mp (by simp [hx]))
+        have hzy := hbwd23 k y z hy hz
+        have hyx := hbwd12 k x y hx hy
+        have hszx : sizeOf x < sizeOf (CTy.mk a1 r1 v1 f1 c1 e1) :=
+          Nat.lt_trans (lookup_sizeOf hx) hs1
+        have hszz : sizeOf z < sizeOf (CTy.mk a3 r3 v3 f3 c3 e3) :=
+          Nat.lt_trans (lookup_sizeOf hz) hs3
+        exact eqv_trans z y x hzy hyx
+    refine ⟨⟨⟨⟨⟨⟨⟨hsub a1 a2 a3 hab1 hbc1, hsub a3 a2 a1 hbc2 hab2⟩, ?_⟩, ?_⟩, ?_⟩,
+      hsub c1 c2 c3 habc1 hbcc1⟩, hsub c3 c2 c1 hbcc2 habc2⟩, ?_⟩
+    · rcases r1 with _ | m1 <;> rcases r2 with _ | m2 <;> rcases r3 with _ | m3 <;>
+        first
+        | rfl
+        | (simp at habr; done)
+        | (simp at hbcr; done)
+        | (exact hmapTrans m1 m2 m3 (by simp; omega) (by simp; omega) habr hbcr)
+    · rcases v1 with _ | m1 <;> rcases v2 with _ | m2 <;> rcases v3 with _ | m3 <;>
+        first
+        | rfl
+        | (simp at habv; done)
+        | (simp at hbcv; done)
+        | (exact hmapTrans m1 m2 m3 (by simp; omega) (by simp; omega) habv hbcv)
+    · rcases f1 with _ | ⟨k1, d1, cod1⟩ <;> rcases f2 with _ | ⟨k2, d2, cod2⟩ <;>
+        rcases f3 with _ | ⟨k3, d3, cod3⟩ <;>
+        first
+        | rfl
+        | (simp at habf; done)
+        | (simp at hbcf; done)
+        | skip
+      simp only [Bool.and_eq_true] at habf hbcf
+      obtain ⟨⟨habk, habd⟩, habcod⟩ := habf
+      obtain ⟨⟨hbck, hbcd⟩, hbccod⟩ := hbcf
+      simp only [Bool.and_eq_true]
+      have hszc : sizeOf cod1 + sizeOf cod3 <
+          sizeOf (CTy.mk a1 r1 v1 (some (k1, d1, cod1)) c1 e1) +
+            sizeOf (CTy.mk a3 r3 v3 (some (k3, d3, cod3)) c3 e3) := by
+        simp
+        omega
+      refine ⟨⟨?_, ?_⟩, eqv_trans cod1 cod2 cod3 habcod hbccod⟩
+      · simp at habk hbck
+        simp [habk, hbck]
+      · rcases d1 with _ | x <;> rcases d2 with _ | y <;> rcases d3 with _ | z <;>
+          first
+          | rfl
+          | (simp at habd; done)
+          | (simp at hbcd; done)
+          | skip
+        have hszd : sizeOf x + sizeOf z <
+            sizeOf (CTy.mk a1 r1 v1 (some (k1, some x, cod1)) c1 e1) +
+              sizeOf (CTy.mk a3 r3 v3 (some (k3, some z, cod3)) c3 e3) := by
+          simp
+          omega
+        exact eqv_trans x y z habd hbcd
+    · simp at habe hbce
+      simp [habe, hbce]
+termination_by a _ c => sizeOf a + sizeOf c
+decreasing_by all_goals omega
+
+/-! ## Pointwise readings of the merged maps -/
+
+/-- `interMap`, read through `lookup`: defined exactly when both sides have
+the key, payload the merge of the two firsts. -/
+theorem interMap_lookup {pol : Bool} {m1 m2 : List (FieldKey × CTy)} {k : FieldKey} :
+    (interMap pol m1 m2).lookup k =
+      match m1.lookup k, m2.lookup k with
+      | some v, some w => some (merge pol v w)
+      | _, _ => none := by
+  induction m1 with
+  | nil => simp [interMap, List.lookup]
+  | cons hd tl ih =>
+    obtain ⟨k', v'⟩ := hd
+    rw [interMap]
+    rcases h2 : m2.lookup k' with _ | w'
+    · rcases hk : k == k' with _ | _
+      · rw [List.lookup_cons]
+        simp only [hk, ih]
+      · have : k = k' := by simpa using hk
+        subst this
+        rw [ih, List.lookup_cons]
+        simp [h2]
+    · rcases hk : k == k' with _ | _
+      · rw [List.lookup_cons, List.lookup_cons]
+        simp only [hk, ih]
+      · have : k = k' := by simpa using hk
+        subst this
+        rw [List.lookup_cons, List.lookup_cons]
+        simp [h2]
+
+/-- `unionMapGo`, read through `lookup`: defined exactly on `m1`'s keys,
+payload merged with `m2`'s when present. -/
+theorem unionMapGo_lookup {pol : Bool} {m1 m2 : List (FieldKey × CTy)} {k : FieldKey} :
+    (unionMapGo pol m1 m2).lookup k =
+      match m1.lookup k, m2.lookup k with
+      | some v, some w => some (merge pol v w)
+      | some v, none => some v
+      | none, _ => none := by
+  induction m1 with
+  | nil => simp [unionMapGo, List.lookup]
+  | cons hd tl ih =>
+    obtain ⟨k', v'⟩ := hd
+    rw [unionMapGo, List.lookup_cons, List.lookup_cons]
+    rcases hk : k == k' with _ | _
+    · simp only [hk, ih]
+    · have : k = k' := by simpa using hk
+      subst this
+      rcases h2 : m2.lookup k with _ | w' <;> simp [h2]
+
+/-- Looking up in the `m2` leftovers (keys absent from `m1`): the filter
+predicate depends only on the key, so the first `k`-entry survives exactly
+when `m1` lacks `k`. -/
+theorem lookup_filter_leftover {m1 m2 : List (FieldKey × CTy)} {k : FieldKey} :
+    (m2.filter (fun kw => (m1.lookup kw.1).isNone)).lookup k =
+      if (m1.lookup k).isNone then m2.lookup k else none := by
+  induction m2 with
+  | nil => simp [List.lookup]
+  | cons hd tl ih =>
+    obtain ⟨k', w'⟩ := hd
+    rw [List.filter_cons]
+    rcases h1 : (m1.lookup k').isNone with _ | _
+    · simp only [h1, Bool.false_eq_true, if_false, ih]
+      rcases hk : k == k' with _ | _
+      · rw [List.lookup_cons]
+        simp [hk]
+      · have : k = k' := by simpa using hk
+        subst this
+        rw [List.lookup_cons]
+        simp [h1]
+    · simp only [h1, if_true]
+      rw [List.lookup_cons, List.lookup_cons]
+      rcases hk : k == k' with _ | _
+      · simp only [hk, ih]
+      · have : k = k' := by simpa using hk
+        subst this
+        simp [h1, ih]
+
+/-- `unionMap`, read through `lookup`. -/
+theorem unionMap_lookup {pol : Bool} {m1 m2 : List (FieldKey × CTy)} {k : FieldKey} :
+    (unionMap pol m1 m2).lookup k =
+      match m1.lookup k, m2.lookup k with
+      | some v, some w => some (merge pol v w)
+      | some v, none => some v
+      | none, some w => some w
+      | none, none => none := by
+  rw [unionMap, List.lookup_append, unionMapGo_lookup, lookup_filter_leftover]
+  rcases h1 : m1.lookup k with _ | v <;> rcases h2 : m2.lookup k with _ | w <;> simp [h1, h2]
+
+/-! ## The merge algebra: commutativity -/
+
+/-- The dedup gate is symmetric as a *Bool*: `eqv x y = eqv y x`. -/
+theorem eqv_comm_bool (x y : CTy) : eqv x y = eqv y x := by
+  rcases h : eqv y x with _ | _
+  · rcases h' : eqv x y with _ | _
+    · rfl
+    · rw [eqv_symm x y h'] at h
+      exact h
+  · exact eqv_symm y x h
+
+/-- `subKeys` is reflexive on any map (shadowed duplicates are unobservable). -/
+theorem subKeys_self (m : List (FieldKey × CTy)) : subKeys m m (m.map Prod.fst) = true := by
+  rw [subKeys_iff]
+  intro k hk
+  obtain ⟨v, hv⟩ := Option.isSome_iff_exists.mp (lookup_of_mem_keys hk)
+  exact ⟨v, v, hv, hv, eqv_refl v⟩
+
+/-- The function-slot equivalence, as a `Prop` (the shape `eqv`'s fn clause
+checks, lifted off the Bool so case analyses stay readable). -/
+def FunEqv : KindM × Option CTy × CTy → KindM × Option CTy × CTy → Prop
+  | (k1, d1, c1), (k2, d2, c2) =>
+    k1 = k2
+      ∧ (match d1, d2 with
+         | none, none => True
+         | some x, some y => eqv x y = true
+         | _, _ => False)
+      ∧ eqv c1 c2 = true
+
+/-- `FunEqv` is exactly `eqv`'s fn clause. -/
+theorem funClause_of_funEqv {s1 s2 : KindM × Option CTy × CTy} (h : FunEqv s1 s2) :
+    (s1.1 == s2.1
+      && (match s1.2.1, s2.2.1 with
+          | none, none => true
+          | some x, some y => eqv x y
+          | _, _ => false)
+      && eqv s1.2.2 s2.2.2) = true := by
+  obtain ⟨k1, d1, c1⟩ := s1
+  obtain ⟨k2, d2, c2⟩ := s2
+  obtain ⟨hk, hd, hc⟩ := h
+  subst hk
+  simp only [Bool.and_eq_true]
+  refine ⟨⟨by simp, ?_⟩, hc⟩
+  rcases d1 with _ | x <;> rcases d2 with _ | y <;> simp_all
+
+mutual
+
+theorem merge_comm (pol : Bool) : (a b : CTy) → eqv (merge pol a b) (merge pol b a) = true
+  | .mk a1 r1 v1 f1 c1 e1, .mk a2 r2 v2 f2 c2 e2 => by
+    -- Pointwise commutativity of the two keyed merges, packaged with the size
+    -- bounds the recursive calls need.
+    have hinter : ∀ (p : Bool) (m1 m2 : List (FieldKey × CTy)),
+        (∀ x y k, m1.lookup k = some x → m2.lookup k = some y →
+          eqv (merge p x y) (merge p y x) = true) →
+        (subKeys (interMap p m1 m2) (interMap p m2 m1)
+            ((interMap p m1 m2).map Prod.fst) &&
+          subKeys (interMap p m2 m1) (interMap p m1 m2)
+            ((interMap p m2 m1).map Prod.fst)) = true := by
+      intro p m1 m2 hcomm
+      rw [mapClause_iff]
+      refine ⟨fun k => ?_, fun k x y hx hy => ?_, fun k x y hx hy => ?_⟩
+      · rw [interMap_lookup, interMap_lookup]
+        rcases m1.lookup k with _ | v <;> rcases m2.lookup k with _ | w <;> simp
+      · rw [interMap_lookup] at hx hy
+        rcases h1 : m1.lookup k with _ | v <;> rcases h2 : m2.lookup k with _ | w <;>
+            rw [h1, h2] at hx hy <;> dsimp only at hx hy
+        · exact absurd hx (by simp)
+        · exact absurd hx (by simp)
+        · exact absurd hx (by simp)
+        · cases hx
+          cases hy
+          exact hcomm v w k h1 h2
+      · rw [interMap_lookup] at hx hy
+        rcases h1 : m1.lookup k with _ | v <;> rcases h2 : m2.lookup k with _ | w <;>
+            rw [h1, h2] at hx hy <;> dsimp only at hx hy
+        · exact absurd hx (by simp)
+        · exact absurd hx (by simp)
+        · exact absurd hx (by simp)
+        · cases hx
+          cases hy
+          exact eqv_symm _ _ (hcomm v w k h1 h2)
+    have hunion : ∀ (p : Bool) (m1 m2 : List (FieldKey × CTy)),
+        (∀ x y k, m1.lookup k = some x → m2.lookup k = some y →
+          eqv (merge p x y) (merge p y x) = true) →
+        (subKeys (unionMap p m1 m2) (unionMap p m2 m1)
+            ((unionMap p m1 m2).map Prod.fst) &&
+          subKeys (unionMap p m2 m1) (unionMap p m1 m2)
+            ((unionMap p m2 m1).map Prod.fst)) = true := by
+      intro p m1 m2 hcomm
+      rw [mapClause_iff]
+      refine ⟨fun k => ?_, fun k x y hx hy => ?_, fun k x y hx hy => ?_⟩
+      · rw [unionMap_lookup, unionMap_lookup]
+        rcases m1.lookup k with _ | v <;> rcases m2.lookup k with _ | w <;> simp
+      · rw [unionMap_lookup] at hx hy
+        rcases h1 : m1.lookup k with _ | v <;> rcases h2 : m2.lookup k with _ | w <;>
+            rw [h1, h2] at hx hy <;> dsimp only at hx hy
+        · exact absurd hx (by simp)
+        · cases hx
+          cases hy
+          exact eqv_refl _
+        · cases hx
+          cases hy
+          exact eqv_refl _
+        · cases hx
+          cases hy
+          exact hcomm v w k h1 h2
+      · rw [unionMap_lookup] at hx hy
+        rcases h1 : m1.lookup k with _ | v <;> rcases h2 : m2.lookup k with _ | w <;>
+            rw [h1, h2] at hx hy <;> dsimp only at hx hy
+        · exact absurd hx (by simp)
+        · cases hx
+          cases hy
+          exact eqv_refl _
+        · cases hx
+          cases hy
+          exact eqv_refl _
+        · cases hx
+          cases hy
+          exact eqv_symm _ _ (hcomm v w k h1 h2)
+    rw [merge.eq_def, merge.eq_def, eqv.eq_def]
+    simp only [Bool.and_eq_true]
+    refine ⟨⟨⟨⟨⟨⟨⟨?_, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩
+    · simp only [List.all_eq_true, List.contains_iff_mem, List.mem_append]
+      intro x hx
+      exact hx.symm
+    · simp only [List.all_eq_true, List.contains_iff_mem, List.mem_append]
+      intro x hx
+      exact hx.symm
+    · rcases r1 with _ | m1 <;> rcases r2 with _ | m2
+      · rfl
+      · simp [subKeys_self]
+      · simp [subKeys_self]
+      · have hpay : ∀ x y k, m1.lookup k = some x → m2.lookup k = some y →
+            eqv (merge pol x y) (merge pol y x) = true := by
+          intro x y k hx hy
+          have hszx := lookup_sizeOf hx
+          have hszy := lookup_sizeOf hy
+          exact merge_comm pol x y
+        cases pol
+        · simpa [unionMap] using hunion false m1 m2 hpay
+        · simpa [unionMap] using hinter true m1 m2 hpay
+    · rcases v1 with _ | m1 <;> rcases v2 with _ | m2
+      · rfl
+      · simp [subKeys_self]
+      · simp [subKeys_self]
+      · have hpay : ∀ x y k, m1.lookup k = some x → m2.lookup k = some y →
+            eqv (merge pol x y) (merge pol y x) = true := by
+          intro x y k hx hy
+          have hszx := lookup_sizeOf hx
+          have hszy := lookup_sizeOf hy
+          exact merge_comm pol x y
+        cases pol
+        · simpa [unionMap] using hinter false m1 m2 hpay
+        · simpa [unionMap] using hunion true m1 m2 hpay
+    · rcases f1 with _ | ⟨k1, d1, cod1⟩ <;> rcases f2 with _ | ⟨k2, d2, cod2⟩
+      · rfl
+      · simpa using funClause_of_funEqv (s1 := (k2, d2, cod2)) (s2 := (k2, d2, cod2))
+          ⟨rfl, by rcases d2 with _ | x <;> simp [eqv_refl], eqv_refl cod2⟩
+      · simpa using funClause_of_funEqv (s1 := (k1, d1, cod1)) (s2 := (k1, d1, cod1))
+          ⟨rfl, by rcases d1 with _ | x <;> simp [eqv_refl], eqv_refl cod1⟩
+      · have hsz : sizeOf (k1, d1, cod1) + sizeOf (k2, d2, cod2) <
+            sizeOf (CTy.mk a1 r1 v1 (some (k1, d1, cod1)) c1 e1) +
+              sizeOf (CTy.mk a2 r2 v2 (some (k2, d2, cod2)) c2 e2) := by
+          simp
+          omega
+        simpa using funClause_of_funEqv (mergeFun_comm pol (k1, d1, cod1) (k2, d2, cod2))
+    · cases pol
+      · simp only [Bool.false_eq_true, reduceIte, List.all_eq_true, List.contains_iff_mem,
+          List.mem_append]
+        exact fun x hx => hx.symm
+      · simp only [reduceIte, List.all_eq_true, List.contains_iff_mem, List.mem_filter]
+        exact fun x hx => ⟨hx.2, hx.1⟩
+    · cases pol
+      · simp only [Bool.false_eq_true, reduceIte, List.all_eq_true, List.contains_iff_mem,
+          List.mem_append]
+        exact fun x hx => hx.symm
+      · simp only [reduceIte, List.all_eq_true, List.contains_iff_mem, List.mem_filter]
+        exact fun x hx => ⟨hx.2, hx.1⟩
+    · simp [Bool.or_comm]
+termination_by a b => (sizeOf a + sizeOf b, 1)
+decreasing_by all_goals
+  first
+  | (apply Prod.Lex.left; simp; omega)
+  | (apply Prod.Lex.right; simp; omega)
+
+theorem mergeFun_comm (pol : Bool) : (s1 s2 : KindM × Option CTy × CTy) →
+    FunEqv (mergeFun pol s1 s2) (mergeFun pol s2 s1)
+  | (k1, d1, c1), (k2, d2, c2) => by
+    have hszc : sizeOf c1 + sizeOf c2 < sizeOf (k1, d1, c1) + sizeOf (k2, d2, c2) := by
+      simp
+      omega
+    have hcod : eqv (merge pol c1 c2) (merge pol c2 c1) = true := merge_comm pol c1 c2
+    rw [mergeFun.eq_def, mergeFun.eq_def]
+    simp only
+    rcases hc1 : k1 == KindM.conflict with _ | _ <;>
+      rcases hc2 : k2 == KindM.conflict with _ | _ <;>
+      simp only [hc1, hc2, Bool.true_or, Bool.or_true, Bool.false_or, if_true]
+    case true.true | true.false | false.true => exact ⟨rfl, trivial, hcod⟩
+    -- Neither side conflicted.
+    simp only [Bool.or_false, if_false, Bool.false_eq_true]
+    cases pol
+    · -- Negative: the meet.
+      simp only [if_false, Bool.false_eq_true]
+      have hk : (if k1 == KindM.data || k2 == KindM.data then KindM.data else KindM.compute) =
+          (if k2 == KindM.data || k1 == KindM.data then KindM.data else KindM.compute) := by
+        rw [Bool.or_comm]
+      rcases d1 with _ | x <;> rcases d2 with _ | y
+      · exact ⟨rfl, trivial, hcod⟩
+      · exact ⟨rfl, trivial, hcod⟩
+      · exact ⟨rfl, trivial, hcod⟩
+      · have hszd : sizeOf x + sizeOf y < sizeOf (k1, some x, c1) + sizeOf (k2, some y, c2) := by
+          simp
+          omega
+        exact ⟨hk, merge_comm true x y, hcod⟩
+    · -- Positive: the join.
+      simp only [if_true]
+      rcases k1 with _ | _ | _ <;> rcases k2 with _ | _ | _ <;> simp_all
+      -- data ⊔ data
+      · rcases d1 with _ | x <;> rcases d2 with _ | y
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · dsimp only
+          rw [eqv_comm_bool y x]
+          rcases hg : eqv x y with _ | _ <;> simp only [hg, Bool.false_eq_true, reduceIte]
+          · exact ⟨rfl, trivial, hcod⟩
+          · exact ⟨rfl, hg, hcod⟩
+      -- data ⊔ compute
+      · rcases d1 with _ | x <;> rcases d2 with _ | y
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · have hszd : sizeOf x + sizeOf y <
+              sizeOf (KindM.data, some x, c1) + sizeOf (KindM.compute, some y, c2) := by
+            simp
+            omega
+          exact ⟨rfl, merge_comm false x y, hcod⟩
+      -- compute ⊔ data
+      · rcases d1 with _ | x <;> rcases d2 with _ | y
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · have hszd : sizeOf x + sizeOf y <
+              sizeOf (KindM.compute, some x, c1) + sizeOf (KindM.data, some y, c2) := by
+            simp
+            omega
+          exact ⟨rfl, merge_comm false x y, hcod⟩
+      -- compute ⊔ compute
+      · rcases d1 with _ | x <;> rcases d2 with _ | y
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · have hszd : sizeOf x + sizeOf y <
+              sizeOf (KindM.compute, some x, c1) + sizeOf (KindM.compute, some y, c2) := by
+            simp
+            omega
+          exact ⟨rfl, merge_comm false x y, hcod⟩
+termination_by s1 s2 => (sizeOf s1 + sizeOf s2, 0)
+decreasing_by all_goals
+  first
+  | (apply Prod.Lex.left; simp; omega)
+  | (apply Prod.Lex.right; simp; omega)
+
+end
+
+/-! ## Well-formedness of input bounds
+
+`compact_go` builds every bound's `CTy` from a `Type`: a function contributes
+exactly one domain and a ground kind (`AtomKey::from_type` / the `Type::Fun`
+arm), so an *input* bound never carries a `conflict` kind or a multi-domain
+slot — those states are only ever *produced* by merging. Idempotence (and the
+fold's duplicate-invariance) is stated under this invariant: a conflicted or
+domain-less slot is an error state the solver never feeds back in, and
+`eqv`-idempotence genuinely fails there (the model's conflict arm canonicalizes
+the diagnostic payload away). -/
+
+mutual
+
+/-- The input-bound invariant (see the section header). -/
+def wf : CTy → Bool
+  | .mk _ r v f _ _ =>
+    (match r with
+     | none => true
+     | some m => wfKeys m (m.map Prod.fst))
+      && (match v with
+          | none => true
+          | some m => wfKeys m (m.map Prod.fst))
+      && (match f with
+          | none => true
+          | some (k, d, cod) =>
+            (k != .conflict)
+              && (match d with
+                  | some x => wf x
+                  | none => false)
+              && wf cod)
+termination_by t => (sizeOf t, 0)
+
+/-- All payloads of a map are `wf` (worklist form, like `subKeys`). -/
+def wfKeys (m : List (FieldKey × CTy)) : List FieldKey → Bool
+  | [] => true
+  | k :: ks =>
+    (match h : m.lookup k with
+     | some v => wf v
+     | none => true)
+      && wfKeys m ks
+termination_by ks => (sizeOf m, ks.length)
+decreasing_by
+  · have := lookup_sizeOf h
+    apply Prod.Lex.left
+    omega
+  · apply Prod.Lex.right
+    simp
+
+end
+
+/-- Pointwise reading of `wfKeys`. -/
+theorem wfKeys_iff {m : List (FieldKey × CTy)} {ks : List FieldKey} :
+    wfKeys m ks = true ↔ ∀ k ∈ ks, ∀ v, m.lookup k = some v → wf v = true := by
+  induction ks with
+  | nil => simp [wfKeys]
+  | cons k ks ih =>
+    rw [wfKeys, Bool.and_eq_true, ih]
+    constructor
+    · intro ⟨hhead, htail⟩ k' hk'
+      rcases List.mem_cons.mp hk' with h | h
+      · subst h
+        intro v hv
+        rw [hv] at hhead
+        exact hhead
+      · exact htail k' h
+    · intro h
+      refine ⟨?_, fun k' hk' => h k' (by simp [hk'])⟩
+      rcases hv : m.lookup k with _ | v
+      · rfl
+      · exact h k (by simp) v hv
+
+/-! ## Idempotence -/
+
+theorem merge_idem (pol : Bool) : (a : CTy) → wf a = true → eqv (merge pol a a) a = true
+  | .mk a1 r1 v1 f1 c1 e1 => by
+    intro hwf
+    rw [wf.eq_def] at hwf
+    simp only [Bool.and_eq_true] at hwf
+    obtain ⟨⟨hwr, hwv⟩, hwfn⟩ := hwf
+    -- Both keyed self-merges are pointwise `merge pol v v`, closed by the
+    -- recursive call on the (wf) payload.
+    have hmap : ∀ (p : Bool) (m : List (FieldKey × CTy)),
+        (∀ x k, m.lookup k = some x → eqv (merge p x x) x = true) →
+        ∀ (mm : List (FieldKey × CTy)),
+          (∀ k, mm.lookup k =
+            match m.lookup k, m.lookup k with
+            | some v, some w => some (merge p v w)
+            | some v, none => some v
+            | none, some _ => none
+            | none, none => none) →
+        (subKeys mm m (mm.map Prod.fst) && subKeys m mm (m.map Prod.fst)) = true := by
+      intro p m hidem mm hmm
+      rw [mapClause_iff]
+      refine ⟨fun k => ?_, fun k x y hx hy => ?_, fun k x y hx hy => ?_⟩
+      · rw [hmm k]
+        rcases m.lookup k with _ | v <;> simp
+      · rw [hmm k] at hx
+        cases h1 : m.lookup k with
+        | none =>
+          rw [h1] at hx
+          exact absurd hx (by simp)
+        | some v =>
+          rw [h1] at hx
+          dsimp only at hx
+          cases hx
+          rw [h1] at hy
+          cases hy
+          exact hidem _ k h1
+      · rw [hmm k] at hx
+        cases h1 : m.lookup k with
+        | none =>
+          rw [h1] at hx
+          exact absurd hx (by simp)
+        | some v =>
+          rw [h1] at hx
+          dsimp only at hx
+          cases hx
+          rw [h1] at hy
+          cases hy
+          exact eqv_symm _ _ (hidem _ k h1)
+    rw [merge.eq_def, eqv.eq_def]
+    simp only [Bool.and_eq_true]
+    refine ⟨⟨⟨⟨⟨⟨⟨?_, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩
+    · simp only [List.all_eq_true, List.contains_iff_mem, List.mem_append]
+      exact fun x hx => hx.elim id id
+    · simp only [List.all_eq_true, List.contains_iff_mem, List.mem_append]
+      exact fun x hx => Or.inl hx
+    · rcases r1 with _ | m
+      · rfl
+      · have hpay : ∀ x k, m.lookup k = some x → eqv (merge pol x x) x = true := by
+          intro x k hx
+          have hszx := lookup_sizeOf hx
+          have hwx : wf x = true := (wfKeys_iff.mp (by simpa using hwr)) k
+            (mem_keys_of_lookup hx) x hx
+          exact merge_idem pol x hwx
+        cases pol
+        · simpa [unionMap] using hmap false m hpay (unionMap false m m)
+            (fun k => by
+              rw [unionMap_lookup]
+              rcases m.lookup k with _ | v <;> rfl)
+        · simpa using hmap true m hpay (interMap true m m)
+            (fun k => by
+              rw [interMap_lookup]
+              rcases m.lookup k with _ | v <;> rfl)
+    · rcases v1 with _ | m
+      · rfl
+      · have hpay : ∀ x k, m.lookup k = some x → eqv (merge pol x x) x = true := by
+          intro x k hx
+          have hszx := lookup_sizeOf hx
+          have hwx : wf x = true := (wfKeys_iff.mp (by simpa using hwv)) k
+            (mem_keys_of_lookup hx) x hx
+          exact merge_idem pol x hwx
+        cases pol
+        · simpa using hmap false m hpay (interMap false m m)
+            (fun k => by
+              rw [interMap_lookup]
+              rcases m.lookup k with _ | v <;> rfl)
+        · simpa [unionMap] using hmap true m hpay (unionMap true m m)
+            (fun k => by
+              rw [unionMap_lookup]
+              rcases m.lookup k with _ | v <;> rfl)
+    · rcases f1 with _ | ⟨k1, d1, cod1⟩
+      · rfl
+      · simp only [Option.isSome] at hwfn
+        rcases d1 with _ | x
+        · simp at hwfn
+        · simp only [Bool.and_eq_true, bne_iff_ne, ne_eq] at hwfn
+          obtain ⟨⟨hk1, hwx⟩, hwcod⟩ := hwfn
+          have hszx : sizeOf x < sizeOf (CTy.mk a1 r1 v1 (some (k1, some x, cod1)) c1 e1) := by
+            simp
+            omega
+          have hszc : sizeOf cod1 <
+              sizeOf (CTy.mk a1 r1 v1 (some (k1, some x, cod1)) c1 e1) := by
+            simp
+            omega
+          have hx : eqv (merge (!pol) x x) x = true := merge_idem (!pol) x hwx
+          have hxp : eqv (merge pol x x) x = true := merge_idem pol x hwx
+          have hcod : eqv (merge pol cod1 cod1) cod1 = true := merge_idem pol cod1 hwcod
+          dsimp only
+          rw [mergeFun.eq_def]
+          have hk1' : (k1 == KindM.conflict) = false := by
+            rcases k1 with _ | _ | _ <;> simp_all
+          simp only [hk1', Bool.or_self, Bool.false_eq_true, reduceIte]
+          cases pol
+          · simp only [Bool.false_eq_true, reduceIte]
+            rcases k1 with _ | _ | _
+            · simpa using funClause_of_funEqv
+                (s1 := (KindM.data, some (merge true x x), merge false cod1 cod1))
+                (s2 := (KindM.data, some x, cod1)) ⟨by simp, by simpa using hx, hcod⟩
+            · simpa using funClause_of_funEqv
+                (s1 := (KindM.compute, some (merge true x x), merge false cod1 cod1))
+                (s2 := (KindM.compute, some x, cod1)) ⟨by simp, by simpa using hx, hcod⟩
+            · simp at hk1
+          · simp only [reduceIte]
+            rcases k1 with _ | _ | _
+            · simp [eqv_refl x, hcod]
+            · simpa using funClause_of_funEqv
+                (s1 := (KindM.compute, some (merge false x x), merge true cod1 cod1))
+                (s2 := (KindM.compute, some x, cod1)) ⟨rfl, by simpa using hx, hcod⟩
+            · simp at hk1
+    · cases pol
+      · simp only [Bool.false_eq_true, reduceIte, List.all_eq_true, List.contains_iff_mem,
+          List.mem_append]
+        exact fun x hx => hx.elim id id
+      · simp only [reduceIte, List.all_eq_true, List.contains_iff_mem, List.mem_filter]
+        exact fun x hx => hx.1
+    · cases pol
+      · simp only [Bool.false_eq_true, reduceIte, List.all_eq_true, List.contains_iff_mem,
+          List.mem_append]
+        exact fun x hx => Or.inl hx
+      · simp only [reduceIte, List.all_eq_true, List.contains_iff_mem, List.mem_filter]
+        exact fun x hx => ⟨hx, by simpa using hx⟩
+    · simp
+termination_by a => sizeOf a
+decreasing_by all_goals (simp; omega)
+
+/-! ## Congruence: `merge` respects `eqv`
+
+The one gate inside `merge` — the positive `data ⊔ data` domain dedup — is
+`eqv` itself, so it cannot distinguish `eqv`-equal inputs (`eqv_congr_bool`).
+That is the whole reason congruence holds; a gate keyed on anything finer
+(e.g. structural equality, with `eqv` coarser than it) would break it. -/
+
+/-- Replacing one side of the gate by an `eqv`-equal value leaves the gate's
+verdict unchanged. -/
+theorem eqv_congr_bool {x x' : CTy} (h : eqv x x' = true) (y : CTy) :
+    eqv x y = eqv x' y := by
+  rcases hg : eqv x' y with _ | _
+  · rcases hg' : eqv x y with _ | _
+    · rfl
+    · rw [eqv_trans x' x y (eqv_symm x x' h) hg'] at hg
+      exact hg
+  · exact eqv_trans x x' y h hg
+
+/-- `FunEqv` is reflexive. -/
+theorem funEqv_refl (s : KindM × Option CTy × CTy) : FunEqv s s := by
+  obtain ⟨k, d, c⟩ := s
+  refine ⟨rfl, ?_, eqv_refl c⟩
+  rcases d with _ | x
+  · trivial
+  · exact eqv_refl x
+
+mutual
+
+theorem merge_congr_left (pol : Bool) :
+    (a a' b : CTy) → eqv a a' = true → eqv (merge pol a b) (merge pol a' b) = true
+  | .mk a1 r1 v1 f1 c1 e1, .mk a1' r1' v1' f1' c1' e1', .mk b1 rb vb fb cb eb => by
+    intro h
+    rw [eqv.eq_def] at h
+    simp only [Bool.and_eq_true] at h
+    obtain ⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, hr⟩, hv⟩, hf⟩, hc1'⟩, hc2'⟩, he⟩ := h
+    -- Pointwise congruence for the two keyed merges.
+    have hinterC : ∀ (p : Bool) (m1 m1' m2 : List (FieldKey × CTy)),
+        (subKeys m1 m1' (m1.map Prod.fst) && subKeys m1' m1 (m1'.map Prod.fst)) = true →
+        (∀ x x' y k, m1.lookup k = some x → m1'.lookup k = some x' → m2.lookup k = some y →
+          eqv (merge p x y) (merge p x' y) = true) →
+        (subKeys (interMap p m1 m2) (interMap p m1' m2)
+            ((interMap p m1 m2).map Prod.fst) &&
+          subKeys (interMap p m1' m2) (interMap p m1 m2)
+            ((interMap p m1' m2).map Prod.fst)) = true := by
+      intro p m1 m1' m2 hcl hcong
+      rw [mapClause_iff] at hcl ⊢
+      obtain ⟨hdom, hfwd, hbwd⟩ := hcl
+      refine ⟨fun k => ?_, fun k x y hx hy => ?_, fun k x y hx hy => ?_⟩
+      · rw [interMap_lookup, interMap_lookup]
+        rcases hl1 : m1.lookup k with _ | v <;> rcases hl2 : m2.lookup k with _ | w <;>
+          rcases hl1' : m1'.lookup k with _ | v' <;>
+          first
+          | (simp; done)
+          | (have hcontra := hdom k; simp [hl1, hl1'] at hcontra)
+      · rw [interMap_lookup] at hx hy
+        cases hl1 : m1.lookup k with
+        | none =>
+          rw [hl1] at hx
+          exact absurd hx (by simp)
+        | some v =>
+          rw [hl1] at hx
+          cases hl2 : m2.lookup k with
+          | none =>
+            rw [hl2] at hx
+            exact absurd hx (by simp)
+          | some w =>
+            rw [hl2] at hx
+            dsimp only at hx
+            obtain ⟨v', hv'⟩ := Option.isSome_iff_exists.mp ((hdom k).mp (by simp [hl1]))
+            rw [hv', hl2] at hy
+            dsimp only at hy
+            cases hx
+            cases hy
+            exact hcong _ _ _ k hl1 hv' hl2
+      · rw [interMap_lookup] at hx hy
+        cases hl1' : m1'.lookup k with
+        | none =>
+          rw [hl1'] at hy
+          exact absurd hy (by simp)
+        | some v' =>
+          rw [hl1'] at hy
+          cases hl2 : m2.lookup k with
+          | none =>
+            rw [hl2] at hy
+            exact absurd hy (by simp)
+          | some w =>
+            rw [hl2] at hy
+            dsimp only at hy
+            obtain ⟨v, hv⟩ := Option.isSome_iff_exists.mp ((hdom k).mpr (by simp [hl1']))
+            rw [hv, hl2] at hx
+            dsimp only at hx
+            cases hx
+            cases hy
+            exact eqv_symm _ _ (hcong _ _ _ k hv hl1' hl2)
+    have hunionC : ∀ (p : Bool) (m1 m1' m2 : List (FieldKey × CTy)),
+        (subKeys m1 m1' (m1.map Prod.fst) && subKeys m1' m1 (m1'.map Prod.fst)) = true →
+        (∀ x x' y k, m1.lookup k = some x → m1'.lookup k = some x' → m2.lookup k = some y →
+          eqv (merge p x y) (merge p x' y) = true) →
+        (subKeys (unionMap p m1 m2) (unionMap p m1' m2)
+            ((unionMap p m1 m2).map Prod.fst) &&
+          subKeys (unionMap p m1' m2) (unionMap p m1 m2)
+            ((unionMap p m1' m2).map Prod.fst)) = true := by
+      intro p m1 m1' m2 hcl hcong
+      have hpay : ∀ x x' k, m1.lookup k = some x → m1'.lookup k = some x' →
+          eqv x x' = true := (mapClause_iff.mp hcl).2.1 |> fun hh => fun x x' k hx hx' =>
+            hh k x x' hx hx'
+      rw [mapClause_iff] at hcl ⊢
+      obtain ⟨hdom, hfwd, hbwd⟩ := hcl
+      refine ⟨fun k => ?_, fun k x y hx hy => ?_, fun k x y hx hy => ?_⟩
+      · rw [unionMap_lookup, unionMap_lookup]
+        rcases hl1 : m1.lookup k with _ | v <;> rcases hl2 : m2.lookup k with _ | w <;>
+          rcases hl1' : m1'.lookup k with _ | v' <;>
+          first
+          | (simp; done)
+          | (have hcontra := hdom k; simp [hl1, hl1'] at hcontra)
+      · rw [unionMap_lookup] at hx hy
+        cases hl1 : m1.lookup k with
+        | none =>
+          rw [hl1] at hx
+          cases hl2 : m2.lookup k with
+          | none =>
+            rw [hl2] at hx
+            exact absurd hx (by simp)
+          | some w =>
+            rw [hl2] at hx
+            dsimp only at hx
+            have hno : m1'.lookup k = none := by
+              rcases hl1' : m1'.lookup k with _ | v'
+              · rfl
+              · exact absurd ((hdom k).mpr (by simp [hl1'])) (by simp [hl1])
+            rw [hno, hl2] at hy
+            dsimp only at hy
+            cases hx
+            cases hy
+            exact eqv_refl _
+        | some v =>
+          rw [hl1] at hx
+          obtain ⟨v', hv'⟩ := Option.isSome_iff_exists.mp ((hdom k).mp (by simp [hl1]))
+          rw [hv'] at hy
+          cases hl2 : m2.lookup k with
+          | none =>
+            rw [hl2] at hx hy
+            dsimp only at hx hy
+            cases hx
+            cases hy
+            exact hpay _ _ k hl1 hv'
+          | some w =>
+            rw [hl2] at hx hy
+            dsimp only at hx hy
+            cases hx
+            cases hy
+            exact hcong _ _ _ k hl1 hv' hl2
+      · rw [unionMap_lookup] at hx hy
+        cases hl1' : m1'.lookup k with
+        | none =>
+          rw [hl1'] at hy
+          cases hl2 : m2.lookup k with
+          | none =>
+            rw [hl2] at hy
+            exact absurd hy (by simp)
+          | some w =>
+            rw [hl2] at hy
+            dsimp only at hy
+            have hno : m1.lookup k = none := by
+              rcases hl1 : m1.lookup k with _ | v
+              · rfl
+              · exact absurd ((hdom k).mp (by simp [hl1])) (by simp [hl1'])
+            rw [hno, hl2] at hx
+            dsimp only at hx
+            cases hx
+            cases hy
+            exact eqv_refl _
+        | some v' =>
+          rw [hl1'] at hy
+          obtain ⟨v, hv⟩ := Option.isSome_iff_exists.mp ((hdom k).mpr (by simp [hl1']))
+          rw [hv] at hx
+          cases hl2 : m2.lookup k with
+          | none =>
+            rw [hl2] at hx hy
+            dsimp only at hx hy
+            cases hx
+            cases hy
+            exact eqv_symm _ _ (hpay _ _ k hv hl1')
+          | some w =>
+            rw [hl2] at hx hy
+            dsimp only at hx hy
+            cases hx
+            cases hy
+            exact eqv_symm _ _ (hcong _ _ _ k hv hl1' hl2)
+    rw [merge.eq_def, merge.eq_def, eqv.eq_def]
+    simp only [Bool.and_eq_true]
+    simp only [List.all_eq_true, List.contains_iff_mem] at h1 h2
+    refine ⟨⟨⟨⟨⟨⟨⟨?_, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩
+    · simp only [List.all_eq_true, List.contains_iff_mem, List.mem_append]
+      exact fun x hx => hx.imp (fun hm => by simpa using h1 x hm) id
+    · simp only [List.all_eq_true, List.contains_iff_mem, List.mem_append]
+      exact fun x hx => hx.imp (fun hm => by simpa using h2 x hm) id
+    · rcases r1 with _ | m1 <;> rcases r1' with _ | m1' <;>
+        first
+        | (simp at hr; done)
+        | skip
+      · rcases rb with _ | mb
+        · rfl
+        · simp [subKeys_self]
+      · rcases rb with _ | mb
+        · simpa using hr
+        · have hcong : ∀ x x' y k, m1.lookup k = some x → m1'.lookup k = some x' →
+              mb.lookup k = some y → eqv (merge pol x y) (merge pol x' y) = true := by
+            intro x x' y k hx hx' hy
+            have hszx := lookup_sizeOf hx
+            have hszx' := lookup_sizeOf hx'
+            have hszy := lookup_sizeOf hy
+            have hxx' : eqv x x' = true :=
+              (mapClause_iff.mp (by simpa using hr)).2.1 k x x' hx hx'
+            exact merge_congr_left pol x x' y hxx'
+          cases pol
+          · simpa [unionMap] using hunionC false m1 m1' mb (by simpa using hr) hcong
+          · simpa using hinterC true m1 m1' mb (by simpa using hr) hcong
+    · rcases v1 with _ | m1 <;> rcases v1' with _ | m1' <;>
+        first
+        | (simp at hv; done)
+        | skip
+      · rcases vb with _ | mb
+        · rfl
+        · simp [subKeys_self]
+      · rcases vb with _ | mb
+        · simpa using hv
+        · have hcong : ∀ x x' y k, m1.lookup k = some x → m1'.lookup k = some x' →
+              mb.lookup k = some y → eqv (merge pol x y) (merge pol x' y) = true := by
+            intro x x' y k hx hx' hy
+            have hszx := lookup_sizeOf hx
+            have hszx' := lookup_sizeOf hx'
+            have hszy := lookup_sizeOf hy
+            have hxx' : eqv x x' = true :=
+              (mapClause_iff.mp (by simpa using hv)).2.1 k x x' hx hx'
+            exact merge_congr_left pol x x' y hxx'
+          cases pol
+          · simpa using hinterC false m1 m1' mb (by simpa using hv) hcong
+          · simpa [unionMap] using hunionC true m1 m1' mb (by simpa using hv) hcong
+    · rcases f1 with _ | s1 <;> rcases f1' with _ | s1' <;>
+        first
+        | (simp at hf; done)
+        | skip
+      · rcases fb with _ | sb
+        · rfl
+        · simpa using funClause_of_funEqv (funEqv_refl sb)
+      · rcases fb with _ | sb
+        · simpa using hf
+        · obtain ⟨k1, d1, cod1⟩ := s1
+          obtain ⟨k1', d1', cod1'⟩ := s1'
+          simp only [Bool.and_eq_true] at hf
+          obtain ⟨⟨hk, hd⟩, hcod⟩ := hf
+          have hk' : k1 = k1' := by simpa using hk
+          have hsz : sizeOf (k1, d1, cod1) + sizeOf (k1', d1', cod1') + sizeOf sb <
+              sizeOf (CTy.mk a1 r1 v1 (some (k1, d1, cod1)) c1 e1) +
+                sizeOf (CTy.mk a1' r1' v1' (some (k1', d1', cod1')) c1' e1') +
+                sizeOf (CTy.mk b1 rb vb (some sb) cb eb) := by
+            simp
+            omega
+          have hde : FunEqv (k1, d1, cod1) (k1', d1', cod1') := by
+            refine ⟨hk', ?_, hcod⟩
+            rcases d1 with _ | x <;> rcases d1' with _ | x' <;> simp_all
+          simpa using funClause_of_funEqv
+            (mergeFun_congr_left pol (k1, d1, cod1) (k1', d1', cod1') sb hde)
+    · cases pol
+      · simp only [Bool.false_eq_true, reduceIte, List.all_eq_true, List.contains_iff_mem,
+          List.mem_append]
+        simp only [List.all_eq_true, List.contains_iff_mem] at hc1'
+        exact fun x hx => hx.imp (fun hm => by simpa using hc1' x hm) id
+      · simp only [reduceIte, List.all_eq_true, List.contains_iff_mem, List.mem_filter]
+        simp only [List.all_eq_true, List.contains_iff_mem] at hc1'
+        exact fun x hx => ⟨by simpa using hc1' x hx.1, hx.2⟩
+    · cases pol
+      · simp only [Bool.false_eq_true, reduceIte, List.all_eq_true, List.contains_iff_mem,
+          List.mem_append]
+        simp only [List.all_eq_true, List.contains_iff_mem] at hc2'
+        exact fun x hx => hx.imp (fun hm => by simpa using hc2' x hm) id
+      · simp only [reduceIte, List.all_eq_true, List.contains_iff_mem, List.mem_filter]
+        simp only [List.all_eq_true, List.contains_iff_mem] at hc2'
+        exact fun x hx => ⟨by simpa using hc2' x hx.1, hx.2⟩
+    · simp at he
+      simp [he]
+termination_by a a' b => (sizeOf a + sizeOf a' + sizeOf b, 1)
+decreasing_by all_goals
+  first
+  | (apply Prod.Lex.left; omega)
+  | (apply Prod.Lex.left; simp; omega)
+  | (apply Prod.Lex.right; simp; omega)
+
+theorem mergeFun_congr_left (pol : Bool) :
+    (s1 s1' sb : KindM × Option CTy × CTy) → FunEqv s1 s1' →
+      FunEqv (mergeFun pol s1 sb) (mergeFun pol s1' sb)
+  | (k1, d1, c1), (k1', d1', c1'), (kb, db, cb) => by
+    intro ⟨hk, hd, hc⟩
+    subst hk
+    have hszc : sizeOf c1 + sizeOf c1' + sizeOf cb <
+        sizeOf (k1, d1, c1) + sizeOf (k1, d1', c1') + sizeOf (kb, db, cb) := by
+      simp
+      omega
+    have hcod : eqv (merge pol c1 cb) (merge pol c1' cb) = true :=
+      merge_congr_left pol c1 c1' cb hc
+    rw [mergeFun.eq_def, mergeFun.eq_def]
+    simp only
+    rcases hcf1 : k1 == KindM.conflict with _ | _ <;>
+      rcases hcf2 : kb == KindM.conflict with _ | _ <;>
+      simp only [hcf1, hcf2, Bool.true_or, Bool.or_true, Bool.false_or, if_true]
+    case true.true | true.false | false.true => exact ⟨rfl, trivial, hcod⟩
+    simp only [Bool.or_false, if_false, Bool.false_eq_true]
+    cases pol
+    · simp only [if_false, Bool.false_eq_true]
+      rcases d1 with _ | x <;> rcases d1' with _ | x' <;>
+        first
+        | (simp at hd; done)
+        | skip
+        <;> rcases db with _ | y
+      · exact ⟨rfl, trivial, hcod⟩
+      · exact ⟨rfl, trivial, hcod⟩
+      · exact ⟨rfl, trivial, hcod⟩
+      · simp only at hd
+        have hszd : sizeOf x + sizeOf x' + sizeOf y <
+            sizeOf (k1, some x, c1) + sizeOf (k1, some x', c1') + sizeOf (kb, some y, cb) := by
+          simp
+          omega
+        exact ⟨rfl, merge_congr_left true x x' y hd, hcod⟩
+    · simp only [if_true]
+      rcases k1 with _ | _ | _ <;> rcases kb with _ | _ | _ <;> simp_all
+      -- data ⊔ data
+      · rcases d1 with _ | x <;> rcases d1' with _ | x' <;>
+          first
+          | (simp at hd; done)
+          | skip
+          <;> rcases db with _ | y
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · simp only at hd
+          dsimp only
+          rw [eqv_congr_bool hd y]
+          rcases hg : eqv x' y with _ | _ <;> simp only [hg, Bool.false_eq_true, reduceIte]
+          · exact ⟨rfl, trivial, hcod⟩
+          · exact ⟨rfl, hd, hcod⟩
+      -- data ⊔ compute
+      · rcases d1 with _ | x <;> rcases d1' with _ | x' <;>
+          first
+          | (simp at hd; done)
+          | skip
+          <;> rcases db with _ | y
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · simp only at hd
+          have hszd : sizeOf x + sizeOf x' + sizeOf y <
+              sizeOf (KindM.data, some x, c1) + sizeOf (KindM.data, some x', c1') +
+                sizeOf (KindM.compute, some y, cb) := by
+            simp
+            omega
+          exact ⟨rfl, merge_congr_left false x x' y hd, hcod⟩
+      -- compute ⊔ data
+      · rcases d1 with _ | x <;> rcases d1' with _ | x' <;>
+          first
+          | (simp at hd; done)
+          | skip
+          <;> rcases db with _ | y
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · simp only at hd
+          have hszd : sizeOf x + sizeOf x' + sizeOf y <
+              sizeOf (KindM.compute, some x, c1) + sizeOf (KindM.compute, some x', c1') +
+                sizeOf (KindM.data, some y, cb) := by
+            simp
+            omega
+          exact ⟨rfl, merge_congr_left false x x' y hd, hcod⟩
+      -- compute ⊔ compute
+      · rcases d1 with _ | x <;> rcases d1' with _ | x' <;>
+          first
+          | (simp at hd; done)
+          | skip
+          <;> rcases db with _ | y
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · exact ⟨rfl, trivial, hcod⟩
+        · simp only at hd
+          have hszd : sizeOf x + sizeOf x' + sizeOf y <
+              sizeOf (KindM.compute, some x, c1) + sizeOf (KindM.compute, some x', c1') +
+                sizeOf (KindM.compute, some y, cb) := by
+            simp
+            omega
+          exact ⟨rfl, merge_congr_left false x x' y hd, hcod⟩
+termination_by s1 s1' sb => (sizeOf s1 + sizeOf s1' + sizeOf sb, 0)
+decreasing_by all_goals
+  first
+  | (apply Prod.Lex.left; omega)
+  | (apply Prod.Lex.left; simp; omega)
+  | (apply Prod.Lex.right; simp; omega)
+
+end
+
+/-- Congruence in the right argument (via commutativity). -/
+theorem merge_congr_right (pol : Bool) (a b b' : CTy) (h : eqv b b' = true) :
+    eqv (merge pol a b) (merge pol a b') = true :=
+  eqv_trans _ _ _ (merge_comm pol a b)
+    (eqv_trans _ _ _ (merge_congr_left pol b b' a h) (merge_comm pol b' a))
+
+/-- Full congruence. -/
+theorem merge_congr (pol : Bool) {a a' b b' : CTy}
+    (ha : eqv a a' = true) (hb : eqv b b' = true) :
+    eqv (merge pol a b) (merge pol a' b') = true :=
+  eqv_trans _ _ _ (merge_congr_left pol a a' b ha) (merge_congr_right pol a' b b' hb)
+
+/-! ## Associativity fails in general: the mixed-kind counterexample
+
+Three function bounds at one position — two `data` collections over *distinct*
+domains and one `compute` capability — merge to different outcomes depending
+on association:
+
+- `(D{Int} ⊔ D{Str}) ⊔ C{Int}`: the data join accumulates two alternatives,
+  and a multi-domain data side meeting a compute side has no honest upcast —
+  **conflict** (coalesce rejects the program).
+- `(D{Int} ⊔ C{Int}) ⊔ D{Str}` (any association that pairs a single-domain
+  data side with the compute side first): each step is the honest upcast —
+  **compute** (accepted).
+
+`compact_go` folds a variable's bounds left-to-right in arrival order, so this
+is arrival order deciding accept-vs-reject. The fuzz's generated vocabulary
+has not covered this shape (`confluence.rs` reports clean runs); whether a
+real program can place these three bounds on one variable is a Rust-side
+question this model can only pose. Until it is answered, associativity — and
+therefore fold-order invariance — is proved on the compute-free fragment
+(`merge_assoc_of_computeFree`), where the mixed arm cannot fire. -/
+
+/-- The empty position (no contribution). -/
+private def cxTop : CTy := .mk [] none none none [] false
+
+/-- An atom position. -/
+private def cxAtom (b : BaseTy) : CTy := .mk [.prim b] none none none [] false
+
+/-- A single-domain function bound of the given kind. -/
+private def cxFun (k : KindM) (d : CTy) : CTy :=
+  .mk [] none none (some (k, some d, cxTop)) [] false
+
+/-- The kind of a position's function slot. -/
+private def fnKind : CTy → Option KindM
+  | .mk _ _ _ f _ _ => f.map (·.1)
+
+/-- One association conflicts (coalesce rejects)… -/
+theorem merge_mixed_left_conflicts :
+    fnKind (merge true (merge true (cxFun .data (cxAtom .int)) (cxFun .data (cxAtom .string)))
+        (cxFun .compute (cxAtom .int))) = some .conflict := by
+  simp [cxFun, cxTop, cxAtom, merge, mergeFun, fnKind, eqv]
+
+/-- …while the other association is an accepted compute function: association
+(hence bound arrival order) decides accept-vs-reject. -/
+theorem merge_mixed_right_accepts :
+    fnKind (merge true (cxFun .data (cxAtom .int)) (merge true (cxFun .data (cxAtom .string))
+        (cxFun .compute (cxAtom .int)))) = some .compute := by
+  simp [cxFun, cxTop, cxAtom, merge, mergeFun, fnKind, eqv]
+
+/-- The headline: `merge` is **not** associative up to `eqv`. -/
+theorem merge_not_assoc :
+    ∃ (pol : Bool) (a b c : CTy),
+      eqv (merge pol (merge pol a b) c) (merge pol a (merge pol b c)) = false := by
+  refine ⟨true, cxFun .data (cxAtom .int), cxFun .data (cxAtom .string),
+    cxFun .compute (cxAtom .int), ?_⟩
+  simp [cxFun, cxTop, cxAtom, merge, mergeFun, eqv, subKeys]
+
+/-! ## The compute-free fragment: associativity
+
+On bounds whose function slots are all `data` — collections, the common case —
+the mixed-kind arm cannot fire and the merge is associative. (`compute`-only
+inputs are symmetric but meet through the contravariant domain, whose `none`
+states conflict; the all-`data` fragment is the one the fold theorems need.) -/
+
+mutual
+
+/-- Every function slot reachable from this position is a `data` slot. -/
+def computeFree : CTy → Bool
+  | .mk _ r v f _ _ =>
+    (match r with
+     | none => true
+     | some m => cfKeys m (m.map Prod.fst))
+      && (match v with
+          | none => true
+          | some m => cfKeys m (m.map Prod.fst))
+      && (match f with
+          | none => true
+          | some (k, d, cod) =>
+            (k == .data)
+              && (match d with
+                  | some x => computeFree x
+                  | none => true)
+              && computeFree cod)
+termination_by t => (sizeOf t, 0)
+
+/-- All payloads of a map are `computeFree` (worklist form). -/
+def cfKeys (m : List (FieldKey × CTy)) : List FieldKey → Bool
+  | [] => true
+  | k :: ks =>
+    (match h : m.lookup k with
+     | some v => computeFree v
+     | none => true)
+      && cfKeys m ks
+termination_by ks => (sizeOf m, ks.length)
+decreasing_by
+  · have := lookup_sizeOf h
+    apply Prod.Lex.left
+    omega
+  · apply Prod.Lex.right
+    simp
+
+end
+
+/-- Pointwise reading of `cfKeys`. -/
+theorem cfKeys_iff {m : List (FieldKey × CTy)} {ks : List FieldKey} :
+    cfKeys m ks = true ↔ ∀ k ∈ ks, ∀ v, m.lookup k = some v → computeFree v = true := by
+  induction ks with
+  | nil => simp [cfKeys]
+  | cons k ks ih =>
+    rw [cfKeys, Bool.and_eq_true, ih]
+    constructor
+    · intro ⟨hhead, htail⟩ k' hk'
+      rcases List.mem_cons.mp hk' with h | h
+      · subst h
+        intro v hv
+        rw [hv] at hhead
+        exact hhead
+      · exact htail k' h
+    · intro h
+      refine ⟨?_, fun k' hk' => h k' (by simp [hk'])⟩
+      rcases hv : m.lookup k with _ | v
+      · rfl
+      · exact h k (by simp) v hv
+
+mutual
+
+theorem merge_assoc_cf (pol : Bool) :
+    (a b c : CTy) → computeFree a = true → computeFree b = true → computeFree c = true →
+      eqv (merge pol (merge pol a b) c) (merge pol a (merge pol b c)) = true
+  | .mk a1 r1 v1 f1 c1 e1, .mk a2 r2 v2 f2 c2 e2, .mk a3 r3 v3 f3 c3 e3 => by
+    intro ha hb hc
+    rw [computeFree.eq_def] at ha hb hc
+    simp only [Bool.and_eq_true] at ha hb hc
+    obtain ⟨⟨har, hav⟩, haf⟩ := ha
+    obtain ⟨⟨hbr, hbv⟩, hbf⟩ := hb
+    obtain ⟨⟨hcr, hcv⟩, hcf⟩ := hc
+    -- Pointwise associativity for the two keyed merges.
+    have hinterA : ∀ (p : Bool) (m1 m2 m3 : List (FieldKey × CTy)),
+        (∀ x y z k, m1.lookup k = some x → m2.lookup k = some y → m3.lookup k = some z →
+          eqv (merge p (merge p x y) z) (merge p x (merge p y z)) = true) →
+        (subKeys (interMap p (interMap p m1 m2) m3) (interMap p m1 (interMap p m2 m3))
+            ((interMap p (interMap p m1 m2) m3).map Prod.fst) &&
+          subKeys (interMap p m1 (interMap p m2 m3)) (interMap p (interMap p m1 m2) m3)
+            ((interMap p m1 (interMap p m2 m3)).map Prod.fst)) = true := by
+      intro p m1 m2 m3 hassoc
+      rw [mapClause_iff]
+      refine ⟨fun k => ?_, fun k x y hx hy => ?_, fun k x y hx hy => ?_⟩
+      · rw [interMap_lookup, interMap_lookup, interMap_lookup, interMap_lookup]
+        rcases m1.lookup k with _ | v <;> rcases m2.lookup k with _ | w <;>
+          rcases m3.lookup k with _ | u <;> simp
+      · rw [interMap_lookup, interMap_lookup] at hx
+        rw [interMap_lookup, interMap_lookup] at hy
+        rcases h1 : m1.lookup k with _ | v <;> rw [h1] at hx hy <;>
+          rcases h2 : m2.lookup k with _ | w <;> rw [h2] at hx hy <;>
+          rcases h3 : m3.lookup k with _ | u <;> rw [h3] at hx hy <;>
+          dsimp only at hx hy <;>
+          first
+          | (simp only [reduceCtorEq] at hx)
+          | (cases hx; cases hy; exact hassoc _ _ _ k h1 h2 h3)
+      · rw [interMap_lookup, interMap_lookup] at hx
+        rw [interMap_lookup, interMap_lookup] at hy
+        rcases h1 : m1.lookup k with _ | v <;> rw [h1] at hx hy <;>
+          rcases h2 : m2.lookup k with _ | w <;> rw [h2] at hx hy <;>
+          rcases h3 : m3.lookup k with _ | u <;> rw [h3] at hx hy <;>
+          dsimp only at hx hy <;>
+          first
+          | (simp only [reduceCtorEq] at hx)
+          | (cases hx; cases hy; exact eqv_symm _ _ (hassoc _ _ _ k h1 h2 h3))
+    have hunionA : ∀ (p : Bool) (m1 m2 m3 : List (FieldKey × CTy)),
+        (∀ x y z k, m1.lookup k = some x → m2.lookup k = some y → m3.lookup k = some z →
+          eqv (merge p (merge p x y) z) (merge p x (merge p y z)) = true) →
+        (subKeys (unionMap p (unionMap p m1 m2) m3) (unionMap p m1 (unionMap p m2 m3))
+            ((unionMap p (unionMap p m1 m2) m3).map Prod.fst) &&
+          subKeys (unionMap p m1 (unionMap p m2 m3)) (unionMap p (unionMap p m1 m2) m3)
+            ((unionMap p m1 (unionMap p m2 m3)).map Prod.fst)) = true := by
+      intro p m1 m2 m3 hassoc
+      rw [mapClause_iff]
+      refine ⟨fun k => ?_, fun k x y hx hy => ?_, fun k x y hx hy => ?_⟩
+      · rw [unionMap_lookup, unionMap_lookup, unionMap_lookup, unionMap_lookup]
+        rcases m1.lookup k with _ | v <;> rcases m2.lookup k with _ | w <;>
+          rcases m3.lookup k with _ | u <;> simp
+      · rw [unionMap_lookup, unionMap_lookup] at hx
+        rw [unionMap_lookup, unionMap_lookup] at hy
+        rcases h1 : m1.lookup k with _ | v <;> rw [h1] at hx hy <;>
+          rcases h2 : m2.lookup k with _ | w <;> rw [h2] at hx hy <;>
+          rcases h3 : m3.lookup k with _ | u <;> rw [h3] at hx hy <;>
+          dsimp only at hx hy <;>
+          first
+          | (simp only [reduceCtorEq] at hx)
+          | (cases hx; cases hy;
+             first
+             | exact eqv_refl _
+             | exact hassoc _ _ _ k h1 h2 h3)
+      · rw [unionMap_lookup, unionMap_lookup] at hx
+        rw [unionMap_lookup, unionMap_lookup] at hy
+        rcases h1 : m1.lookup k with _ | v <;> rw [h1] at hx hy <;>
+          rcases h2 : m2.lookup k with _ | w <;> rw [h2] at hx hy <;>
+          rcases h3 : m3.lookup k with _ | u <;> rw [h3] at hx hy <;>
+          dsimp only at hx hy <;>
+          first
+          | (simp only [reduceCtorEq] at hx)
+          | (cases hx; cases hy;
+             first
+             | exact eqv_refl _
+             | exact eqv_symm _ _ (hassoc _ _ _ k h1 h2 h3))
+    rw [merge.eq_def, merge.eq_def, merge.eq_def, merge.eq_def, eqv.eq_def]
+    dsimp only
+    simp only [Bool.and_eq_true]
+    refine ⟨⟨⟨⟨⟨⟨⟨?_, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩, ?_⟩
+    · simp only [List.all_eq_true, List.contains_iff_mem, List.mem_append]
+      exact fun x hx => by simpa [or_assoc] using hx
+    · simp only [List.all_eq_true, List.contains_iff_mem, List.mem_append]
+      exact fun x hx => by simpa [or_assoc] using hx
+    · rcases r1 with _ | m1 <;> rcases r2 with _ | m2 <;> rcases r3 with _ | m3 <;>
+        first
+        | rfl
+        | (simp [subKeys_self]; done)
+        | skip
+      have hassoc : ∀ x y z k, m1.lookup k = some x → m2.lookup k = some y →
+          m3.lookup k = some z →
+          eqv (merge pol (merge pol x y) z) (merge pol x (merge pol y z)) = true := by
+        intro x y z k hx hy hz
+        have hszx := lookup_sizeOf hx
+        have hszy := lookup_sizeOf hy
+        have hszz := lookup_sizeOf hz
+        exact merge_assoc_cf pol x y z
+          ((cfKeys_iff.mp (by simpa using har)) k (mem_keys_of_lookup hx) x hx)
+          ((cfKeys_iff.mp (by simpa using hbr)) k (mem_keys_of_lookup hy) y hy)
+          ((cfKeys_iff.mp (by simpa using hcr)) k (mem_keys_of_lookup hz) z hz)
+      cases pol
+      · simpa [unionMap] using hunionA false m1 m2 m3 hassoc
+      · simpa using hinterA true m1 m2 m3 hassoc
+    · rcases v1 with _ | m1 <;> rcases v2 with _ | m2 <;> rcases v3 with _ | m3 <;>
+        first
+        | rfl
+        | (simp [subKeys_self]; done)
+        | skip
+      have hassoc : ∀ x y z k, m1.lookup k = some x → m2.lookup k = some y →
+          m3.lookup k = some z →
+          eqv (merge pol (merge pol x y) z) (merge pol x (merge pol y z)) = true := by
+        intro x y z k hx hy hz
+        have hszx := lookup_sizeOf hx
+        have hszy := lookup_sizeOf hy
+        have hszz := lookup_sizeOf hz
+        exact merge_assoc_cf pol x y z
+          ((cfKeys_iff.mp (by simpa using hav)) k (mem_keys_of_lookup hx) x hx)
+          ((cfKeys_iff.mp (by simpa using hbv)) k (mem_keys_of_lookup hy) y hy)
+          ((cfKeys_iff.mp (by simpa using hcv)) k (mem_keys_of_lookup hz) z hz)
+      cases pol
+      · simpa using hinterA false m1 m2 m3 hassoc
+      · simpa [unionMap] using hunionA true m1 m2 m3 hassoc
+    · rcases f1 with _ | s1 <;> rcases f2 with _ | s2 <;> rcases f3 with _ | s3 <;>
+        first
+        | rfl
+        | (simpa using funClause_of_funEqv (funEqv_refl _))
+        | skip
+      obtain ⟨k1, d1, cod1⟩ := s1
+      obtain ⟨k2, d2, cod2⟩ := s2
+      obtain ⟨k3, d3, cod3⟩ := s3
+      simp only [Bool.and_eq_true] at haf hbf hcf
+      have hsz : sizeOf (k1, d1, cod1) + sizeOf (k2, d2, cod2) + sizeOf (k3, d3, cod3) <
+          sizeOf (CTy.mk a1 r1 v1 (some (k1, d1, cod1)) c1 e1) +
+            sizeOf (CTy.mk a2 r2 v2 (some (k2, d2, cod2)) c2 e2) +
+            sizeOf (CTy.mk a3 r3 v3 (some (k3, d3, cod3)) c3 e3) := by
+        simp
+        omega
+      simpa using funClause_of_funEqv
+        (mergeFun_assoc_cf pol (k1, d1, cod1) (k2, d2, cod2) (k3, d3, cod3)
+          (by simpa using haf.1.1) (by simpa using hbf.1.1) (by simpa using hcf.1.1)
+          (by
+            rcases d1 with _ | x
+            · intro x hx
+              cases hx
+            · intro x' hx'
+              cases hx'
+              simpa using haf.1.2)
+          (by
+            rcases d2 with _ | x
+            · intro x hx
+              cases hx
+            · intro x' hx'
+              cases hx'
+              simpa using hbf.1.2)
+          (by
+            rcases d3 with _ | x
+            · intro x hx
+              cases hx
+            · intro x' hx'
+              cases hx'
+              simpa using hcf.1.2)
+          haf.2 hbf.2 hcf.2)
+    · cases pol
+      · simp only [Bool.false_eq_true, reduceIte, List.all_eq_true, List.contains_iff_mem,
+          List.mem_append]
+        exact fun x hx => by simpa [or_assoc] using hx
+      · simp only [reduceIte, List.all_eq_true, List.contains_iff_mem, List.mem_filter]
+        exact fun x hx => by simpa [and_assoc] using hx
+    · cases pol
+      · simp only [Bool.false_eq_true, reduceIte, List.all_eq_true, List.contains_iff_mem,
+          List.mem_append]
+        exact fun x hx => by simpa [or_assoc] using hx
+      · simp only [reduceIte, List.all_eq_true, List.contains_iff_mem, List.mem_filter]
+        exact fun x hx => by simpa [and_assoc] using hx
+    · simp [Bool.or_assoc]
+termination_by a b c => (sizeOf a + sizeOf b + sizeOf c, 1)
+decreasing_by all_goals
+  first
+  | (apply Prod.Lex.left; omega)
+  | (apply Prod.Lex.left; simp; omega)
+  | (apply Prod.Lex.right; simp; omega)
+
+theorem mergeFun_assoc_cf (pol : Bool) :
+    (s1 s2 s3 : KindM × Option CTy × CTy) →
+      s1.1 = .data → s2.1 = .data → s3.1 = .data →
+      (∀ x, s1.2.1 = some x → computeFree x = true) →
+      (∀ x, s2.2.1 = some x → computeFree x = true) →
+      (∀ x, s3.2.1 = some x → computeFree x = true) →
+      computeFree s1.2.2 = true → computeFree s2.2.2 = true → computeFree s3.2.2 = true →
+      FunEqv (mergeFun pol (mergeFun pol s1 s2) s3) (mergeFun pol s1 (mergeFun pol s2 s3))
+  | (k1, d1, c1), (k2, d2, c2), (k3, d3, c3) => by
+    intro hk1 hk2 hk3 hd1 hd2 hd3 hc1 hc2 hc3
+    subst hk1
+    subst hk2
+    subst hk3
+    simp only at hd1 hd2 hd3 hc1 hc2 hc3
+    have hszc : sizeOf c1 + sizeOf c2 + sizeOf c3 <
+        sizeOf (KindM.data, d1, c1) + sizeOf (KindM.data, d2, c2) +
+          sizeOf (KindM.data, d3, c3) := by
+      simp
+      omega
+    have hcod : eqv (merge pol (merge pol c1 c2) c3) (merge pol c1 (merge pol c2 c3)) = true :=
+      merge_assoc_cf pol c1 c2 c3 hc1 hc2 hc3
+    have hgdc : (KindM.data == KindM.conflict) = false := rfl
+    have hgdd : (KindM.data == KindM.data) = true := rfl
+    have hgcc : (KindM.conflict == KindM.conflict) = true := rfl
+    cases pol
+    · -- Negative: kinds stay data; a missing domain conflicts on both sides.
+      rcases d1 with _ | x <;> rcases d2 with _ | y <;> rcases d3 with _ | z <;>
+        simp only [mergeFun.eq_def, hgdc, hgdd, hgcc, Bool.or_self, Bool.or_false,
+          Bool.false_or, Bool.true_or, Bool.or_true, Bool.false_eq_true, reduceIte] <;>
+        first
+        | exact ⟨rfl, trivial, hcod⟩
+        | (have hszd : sizeOf x + sizeOf y + sizeOf z <
+              sizeOf (KindM.data, some x, c1) + sizeOf (KindM.data, some y, c2) +
+                sizeOf (KindM.data, some z, c3) := by
+            simp
+            omega
+           exact ⟨rfl, merge_assoc_cf true x y z (hd1 x rfl) (hd2 y rfl) (hd3 z rfl), hcod⟩)
+    · -- Positive: the gate algebra.
+      rcases d1 with _ | x <;> rcases d2 with _ | y <;> rcases d3 with _ | z <;>
+        simp only [mergeFun.eq_def, hgdc, hgdd, hgcc, Bool.or_self, Bool.or_false,
+          Bool.false_or, Bool.true_or, Bool.or_true, Bool.false_eq_true, reduceIte] <;>
+        first
+        | exact ⟨rfl, trivial, hcod⟩
+        | (rcases hxy : eqv x y with _ | _ <;>
+             simp only [hxy, Bool.false_eq_true, reduceIte] <;>
+             exact ⟨rfl, trivial, hcod⟩)
+        | (rcases hyz : eqv y z with _ | _ <;>
+             simp only [hyz, Bool.false_eq_true, reduceIte] <;>
+             exact ⟨rfl, trivial, hcod⟩)
+        | (rcases hxy : eqv x y with _ | _
+           · simp only [hxy, Bool.false_eq_true, reduceIte]
+             rcases hyz : eqv y z with _ | _ <;>
+               simp only [hyz, hxy, Bool.false_eq_true, reduceIte] <;>
+               exact ⟨rfl, trivial, hcod⟩
+           · simp only [hxy, reduceIte]
+             have hxz : eqv x z = eqv y z := eqv_congr_bool hxy z
+             rcases hyz : eqv y z with _ | _
+             · rw [hxz, hyz]
+               simp only [Bool.false_eq_true, reduceIte]
+               exact ⟨rfl, trivial, hcod⟩
+             · rw [hxz, hyz]
+               simp only [hxy, reduceIte]
+               exact ⟨rfl, eqv_refl x, hcod⟩)
+termination_by s1 s2 s3 => (sizeOf s1 + sizeOf s2 + sizeOf s3, 0)
+decreasing_by all_goals
+  first
+  | (apply Prod.Lex.left; omega)
+  | (apply Prod.Lex.left; simp; omega)
+  | (apply Prod.Lex.right; simp; omega)
+
+end
+
+/-! ## The fold: coalescing a bound list is order- and duplicate-invariant
+
+`compact_go` folds a variable's bounds through `merge` from the first bound
+(no identity element exists — see the module docs). On the compute-free
+fragment the outcome is a function of the bound *set*: permutations
+(`foldMerge_perm`) and duplicates (`foldMerge_dup`) cannot change it. This is
+the algebraic statement behind the confluence fuzz's \"outcomes agree under
+permuted constraint orders\". -/
+
+/-- Positive merges stay compute-free (the join of two `data` slots is a
+`data` slot). The *negative* direction genuinely does not preserve the
+fragment — a multi-alternative domain meeting anything conflicts — which is
+why the fold theorems are stated at positive polarity. -/
+theorem computeFree_merge_pos : (a b : CTy) → computeFree a = true → computeFree b = true →
+    computeFree (merge true a b) = true
+  | .mk a1 r1 v1 f1 c1 e1, .mk a2 r2 v2 f2 c2 e2 => by
+    intro ha hb
+    rw [computeFree.eq_def] at ha hb
+    simp only [Bool.and_eq_true] at ha hb
+    obtain ⟨⟨har, hav⟩, haf⟩ := ha
+    obtain ⟨⟨hbr, hbv⟩, hbf⟩ := hb
+    have hmapI : ∀ (m1 m2 : List (FieldKey × CTy)),
+        (∀ x k, m1.lookup k = some x → computeFree x = true) →
+        (∀ x k, m2.lookup k = some x → computeFree x = true) →
+        (∀ x y k, m1.lookup k = some x → m2.lookup k = some y →
+          computeFree (merge true x y) = true) →
+        cfKeys (interMap true m1 m2) ((interMap true m1 m2).map Prod.fst) = true := by
+      intro m1 m2 _ _ hrec
+      rw [cfKeys_iff]
+      intro k _ v hv
+      rw [interMap_lookup] at hv
+      cases h1 : m1.lookup k with
+      | none =>
+        rw [h1] at hv
+        exact absurd hv (by simp)
+      | some x =>
+        rw [h1] at hv
+        cases h2 : m2.lookup k with
+        | none =>
+          rw [h2] at hv
+          exact absurd hv (by simp)
+        | some y =>
+          rw [h2] at hv
+          dsimp only at hv
+          cases hv
+          exact hrec _ _ k h1 h2
+    have hmapU : ∀ (m1 m2 : List (FieldKey × CTy)),
+        (∀ x k, m1.lookup k = some x → computeFree x = true) →
+        (∀ x k, m2.lookup k = some x → computeFree x = true) →
+        (∀ x y k, m1.lookup k = some x → m2.lookup k = some y →
+          computeFree (merge true x y) = true) →
+        cfKeys (unionMap true m1 m2) ((unionMap true m1 m2).map Prod.fst) = true := by
+      intro m1 m2 hm1 hm2 hrec
+      rw [cfKeys_iff]
+      intro k _ v hv
+      rw [unionMap_lookup] at hv
+      cases h1 : m1.lookup k with
+      | none =>
+        rw [h1] at hv
+        cases h2 : m2.lookup k with
+        | none =>
+          rw [h2] at hv
+          exact absurd hv (by simp)
+        | some y =>
+          rw [h2] at hv
+          dsimp only at hv
+          cases hv
+          exact hm2 _ k h2
+      | some x =>
+        rw [h1] at hv
+        cases h2 : m2.lookup k with
+        | none =>
+          rw [h2] at hv
+          dsimp only at hv
+          cases hv
+          exact hm1 _ k h1
+        | some y =>
+          rw [h2] at hv
+          dsimp only at hv
+          cases hv
+          exact hrec _ _ k h1 h2
+    rw [merge.eq_def, computeFree.eq_def]
+    simp only [Bool.and_eq_true]
+    refine ⟨⟨?_, ?_⟩, ?_⟩
+    · rcases r1 with _ | m1 <;> rcases r2 with _ | m2
+      · rfl
+      · simpa using hbr
+      · simpa using har
+      · have hrec : ∀ x y k, m1.lookup k = some x → m2.lookup k = some y →
+            computeFree (merge true x y) = true := by
+          intro x y k hx hy
+          have hszx := lookup_sizeOf hx
+          have hszy := lookup_sizeOf hy
+          exact computeFree_merge_pos x y
+            ((cfKeys_iff.mp (by simpa using har)) k (mem_keys_of_lookup hx) x hx)
+            ((cfKeys_iff.mp (by simpa using hbr)) k (mem_keys_of_lookup hy) y hy)
+        simpa using hmapI m1 m2
+          (fun x k hx => (cfKeys_iff.mp (by simpa using har)) k (mem_keys_of_lookup hx) x hx)
+          (fun x k hx => (cfKeys_iff.mp (by simpa using hbr)) k (mem_keys_of_lookup hx) x hx)
+          hrec
+    · rcases v1 with _ | m1 <;> rcases v2 with _ | m2
+      · rfl
+      · simpa using hbv
+      · simpa using hav
+      · have hrec : ∀ x y k, m1.lookup k = some x → m2.lookup k = some y →
+            computeFree (merge true x y) = true := by
+          intro x y k hx hy
+          have hszx := lookup_sizeOf hx
+          have hszy := lookup_sizeOf hy
+          exact computeFree_merge_pos x y
+            ((cfKeys_iff.mp (by simpa using hav)) k (mem_keys_of_lookup hx) x hx)
+            ((cfKeys_iff.mp (by simpa using hbv)) k (mem_keys_of_lookup hy) y hy)
+        simpa [unionMap] using hmapU m1 m2
+          (fun x k hx => (cfKeys_iff.mp (by simpa using hav)) k (mem_keys_of_lookup hx) x hx)
+          (fun x k hx => (cfKeys_iff.mp (by simpa using hbv)) k (mem_keys_of_lookup hx) x hx)
+          hrec
+    · rcases f1 with _ | ⟨k1, d1, cod1⟩ <;> rcases f2 with _ | ⟨k2, d2, cod2⟩
+      · rfl
+      · simpa using hbf
+      · simpa using haf
+      · simp only [Bool.and_eq_true] at haf hbf
+        have hk1 : k1 = .data := by
+          have := haf.1.1
+          rcases k1 with _ | _ | _ <;> simp_all
+        have hk2 : k2 = .data := by
+          have := hbf.1.1
+          rcases k2 with _ | _ | _ <;> simp_all
+        subst hk1
+        subst hk2
+        have hszc : sizeOf cod1 + sizeOf cod2 <
+            sizeOf (CTy.mk a1 r1 v1 (some (KindM.data, d1, cod1)) c1 e1) +
+              sizeOf (CTy.mk a2 r2 v2 (some (KindM.data, d2, cod2)) c2 e2) := by
+          simp
+          omega
+        have hcod : computeFree (merge true cod1 cod2) = true :=
+          computeFree_merge_pos cod1 cod2 haf.2 hbf.2
+        dsimp only
+        rw [mergeFun.eq_def]
+        simp only [show (KindM.data == KindM.conflict) = false from rfl, Bool.or_self,
+          Bool.false_eq_true, reduceIte]
+        rcases d1 with _ | x <;> rcases d2 with _ | y <;>
+          first
+          | (simp [hcod]; done)
+          | skip
+        have hcfx : computeFree x = true := by simpa using haf.1.2
+        rcases hg : eqv x y with _ | _ <;> simp [hg, hcod, hcfx]
+termination_by a b => sizeOf a + sizeOf b
+decreasing_by all_goals (simp; omega)
+
+/-- The fold `compact_go` performs over a variable's bound list, seeded at the
+first bound. -/
+def foldMerge (pol : Bool) (t : CTy) (ts : List CTy) : CTy :=
+  ts.foldl (merge pol) t
+
+/-- The fold respects `eqv` in its seed (any polarity). -/
+theorem foldMerge_congr (pol : Bool) {t t' : CTy} (ts : List CTy) (h : eqv t t' = true) :
+    eqv (foldMerge pol t ts) (foldMerge pol t' ts) = true := by
+  induction ts generalizing t t' with
+  | nil => exact h
+  | cons x ts ih => exact ih (merge_congr_left pol t t' x h)
+
+/-- **Order-invariance**: on compute-free bounds, permuting the bound list
+cannot change the coalesced outcome (up to `eqv`). -/
+theorem foldMerge_perm {l1 l2 : List CTy} (h : l1.Perm l2) :
+    ∀ (t : CTy), computeFree t = true → (∀ x ∈ l1, computeFree x = true) →
+      eqv (foldMerge true t l1) (foldMerge true t l2) = true := by
+  induction h with
+  | nil => exact fun t _ _ => eqv_refl _
+  | @cons x l1 l2 hp ih =>
+    intro t ht hl
+    exact ih (merge true t x) (computeFree_merge_pos t x ht (hl x (by simp)))
+      (fun u hu => hl u (by simp [hu]))
+  | @swap x y l =>
+    intro t ht hl
+    have hx : computeFree x = true := hl x (by simp)
+    have hy : computeFree y = true := hl y (by simp)
+    -- merge (merge t y) x ~ merge t (merge y x) ~ merge t (merge x y)
+    --   ~ merge (merge t x) y
+    have hseed : eqv (merge true (merge true t y) x) (merge true (merge true t x) y) = true :=
+      eqv_trans _ _ _ (merge_assoc_cf true t y x ht hy hx)
+        (eqv_trans _ _ _ (merge_congr_right true t _ _ (merge_comm true y x))
+          (eqv_symm _ _ (merge_assoc_cf true t x y ht hx hy)))
+    simpa [foldMerge, List.foldl_cons] using foldMerge_congr true l hseed
+  | @trans l1 l2 l3 h12 h23 ih1 ih2 =>
+    intro t ht hl
+    exact eqv_trans _ _ _ (ih1 t ht hl)
+      (ih2 t ht (fun u hu => hl u (h12.mem_iff.mpr hu)))
+
+/-- **Duplicate-invariance**: a bound occurring twice contributes once — the
+other half of \"the outcome is a function of the bound set\". Needs `wf` for
+the duplicated bound (idempotence does). -/
+theorem foldMerge_dup {t x : CTy} (l : List CTy)
+    (ht : computeFree t = true) (hx : computeFree x = true) (hwx : wf x = true) :
+    eqv (foldMerge true t (x :: x :: l)) (foldMerge true t (x :: l)) = true := by
+  -- merge (merge t x) x ~ merge t (merge x x) ~ merge t x
+  have hseed : eqv (merge true (merge true t x) x) (merge true t x) = true :=
+    eqv_trans _ _ _ (merge_assoc_cf true t x x ht hx hx)
+      (merge_congr_right true t _ _ (merge_idem true x hwx))
+  simpa [foldMerge, List.foldl_cons] using foldMerge_congr true l hseed
+
+end CTy
+
+end CclFormal
diff --git a/formal/CclFormal/Props.lean b/formal/CclFormal/Props.lean
new file mode 100644
index 00000000..682a1859
--- /dev/null
+++ b/formal/CclFormal/Props.lean
@@ -0,0 +1,171 @@
+import CclFormal.Sub
+
+/-!
+# First metatheory: reflexivity
+
+`constrain_go` opens with a trivial-equality short-circuit (`lhs == rhs`
+under identity morphisms → `Ok`). The model deliberately has no such rule;
+`Sub.refl` proves it *derivable* — which is the faithfulness condition for
+omitting it. The proof goes through only for `Ty.WF` (uniquely-keyed) types:
+on a duplicate-keyed record the short-circuit and the find-first record arm
+genuinely disagree, so the hypothesis is the model naming a builder
+invariant the Rust leaves implicit.
+-/
+
+namespace CclFormal
+
+theorem Ren.isId_id : Ren.IsId Ren.id := fun _ => rfl
+
+theorem Ren.IsId.extend_diag {ρ : Ren} (h : ρ.IsId) (k : String) :
+    (ρ.extend k k).IsId := by
+  intro x
+  by_cases hk : k = x
+  · subst hk
+    simp [Ren.apply, Ren.extend]
+  · have hb : ((k, k).1 == x) = false := by simpa using hk
+    have := h x
+    simp [Ren.apply, Ren.extend, hb] at this ⊢
+    exact this
+
+/-- The codomain morphism of a reflexive function edge still acts as the
+identity: a Pi binder corresponds to itself. -/
+theorem codRen_diag_isId (n : Option String) {ρ : Ren} (h : ρ.IsId) :
+    (codRen n n ρ).IsId := by
+  cases n with
+  | none => exact h
+  | some k => exact h.extend_diag k
+
+theorem Pred.rename_isId {ρ : Ren} (h : ρ.IsId) : (p : Pred) → p.rename ρ = p
+  | .elem | .litInt _ | .litBool _ | .litStr _ | .litUnit => rfl
+  | .var x => by simp [Pred.rename, h x]
+  | .unop op a => by simp [Pred.rename, rename_isId h a]
+  | .binop op a b => by simp [Pred.rename, rename_isId h a, rename_isId h b]
+  | .proj a k => by simp [Pred.rename, rename_isId h a]
+  | .app f a => by simp [Pred.rename, rename_isId h f, rename_isId h a]
+
+/-- Identical refinement sets have no deficit (under identity-acting
+morphisms). -/
+theorem deficit_self {ρl ρr : Ren} (hl : ρl.IsId) (hr : ρr.IsId)
+    (S : List Pred) : deficit ρl ρr S S = [] := by
+  unfold deficit
+  have hmap : S.map (Pred.rename ρl) = S := by
+    simpa using List.map_congr_left (fun p _ => Pred.rename_isId hl p)
+  rw [hmap]
+  apply List.filter_eq_nil_iff.mpr
+  intro r hm
+  rw [Pred.rename_isId hr r]
+  simpa using hm
+
+/-- Find-first lookup returns the member itself when keys are unique. -/
+theorem lookupBy_of_mem_nodup [BEq α] [LawfulBEq α] {l : List (α × Ty)}
+    {k : α} {t : Ty} (hnd : (l.map (·.1)).Nodup) (hm : (k, t) ∈ l) :
+    lookupBy l k = some t := by
+  induction l with
+  | nil => cases hm
+  | cons e rest ih =>
+      obtain ⟨a, u⟩ := e
+      have hnd' : (∀ (x : Ty), (a, x) ∉ rest) ∧
+          (List.map (fun x => x.fst) rest).Nodup := by simpa using hnd
+      rcases List.mem_cons.mp hm with heq | hmem
+      · injection heq with h1 h2
+        subst h1; subst h2
+        simp [lookupBy]
+      · have hak : (a == k) = false := by
+          cases hab : a == k with
+          | false => rfl
+          | true =>
+              have ha : a = k := eq_of_beq hab
+              subst ha
+              exact absurd hmem (hnd'.1 t)
+        have hfind : ((a, u) :: rest).find? (fun e => e.1 == k) =
+            rest.find? (fun e => e.1 == k) := by
+          rw [List.find?_cons_of_neg]
+          simpa using hak
+        have := ih hnd'.2 hmem
+        unfold lookupBy at this ⊢
+        rw [hfind]
+        exact this
+
+/-- The refined case's termination shape: peeling the base stays under the
+refined node's size, whatever the predicate contributes. -/
+theorem Ty.peel_fst_lt_one_add (b : Ty) (n : Nat) :
+    sizeOf b.peel.1 < 1 + sizeOf b + n := by
+  have := Ty.peel_fst_sizeOf_le b
+  omega
+
+/-- Peeling preserves well-formedness. -/
+theorem Ty.WF.peel_fst : {t : Ty} → t.WF → t.peel.1.WF
+  | .base _, h | .uintRange _, h | .dataSource _, h | .txn, h
+  | .fn .., h | .tuple _, h | .record _, h | .variant _, h => by
+      simpa [Ty.peel] using h
+  | .refined _ _, .refined _ _ hb => by
+      simpa [Ty.peel] using hb.peel_fst
+
+/-- **Reflexivity is derivable** (for uniquely-keyed types, under
+identity-acting morphisms): the model needs no analog of `constrain_go`'s
+trivial-equality short-circuit. -/
+theorem Sub.refl : (t : Ty) → t.WF → (ρl ρr : Ren) → ρl.IsId → ρr.IsId →
+    Sub ρl ρr t t
+  | .base b, _, _, _, _, _ => .base b
+  | .uintRange n, _, _, _, _, _ => .uintRange n
+  | .dataSource s, _, _, _, _, _ => .dataSource s
+  | .txn, _, _, _, _, _ => .txn
+  | .fn n k d c, hwf, ρl, ρr, hl, hr => by
+      cases hwf with
+      | fn hd hc =>
+        have hcod :=
+          Sub.refl c hc (codRen n n ρl) ρr (codRen_diag_isId n hl) hr
+        cases k with
+        | data =>
+            exact .fnData (Sub.refl d hd ρr ρl hr hl)
+              (Sub.refl d hd ρl ρr hl hr) hcod
+        | compute =>
+            exact .fnCompute trivial (fun h => nomatch h.1)
+              (Sub.refl d hd ρr ρl hr hl) hcod
+  | .tuple ts, hwf, ρl, ρr, hl, hr => by
+      cases hwf with
+      | tuple hts =>
+        refine .tuple (Nat.le_refl _) fun i t0 t1 h0 h1 => ?_
+        rw [h0] at h1
+        injection h1 with h
+        subst h
+        have hm : t0 ∈ ts := List.mem_of_getElem? h0
+        have hsz : sizeOf t0 < sizeOf ts := List.sizeOf_lt_of_mem hm
+        exact Sub.refl t0 (hts t0 hm) ρl ρr hl hr
+  | .record fs, hwf, ρl, ρr, hl, hr => by
+      cases hwf with
+      | record hnd hf =>
+        refine .record (fun n t1 hm => ?_) (fun n t0 t1 hm hlk => ?_)
+        · rw [lookupBy_of_mem_nodup hnd hm]; rfl
+        · rw [lookupBy_of_mem_nodup hnd hm] at hlk
+          injection hlk with h
+          subst h
+          exact Sub.refl t1 (hf (n, t1) hm) ρl ρr hl hr
+  | .variant tags, hwf, ρl, ρr, hl, hr => by
+      cases hwf with
+      | variant hnd ht =>
+        refine .variant (fun k t0 hm => ?_) (fun k t0 t1 hm hlk => ?_)
+        · rw [lookupBy_of_mem_nodup hnd hm]; rfl
+        · rw [lookupBy_of_mem_nodup hnd hm] at hlk
+          injection hlk with h
+          subst h
+          exact Sub.refl t0 (ht (k, t0) hm) ρl ρr hl hr
+  | .refined b ps, hwf, ρl, ρr, hl, hr => by
+      cases hwf with
+      | refined hne _ hb =>
+        refine .refined rfl rfl
+          (.inl (by simp; exact fun hc => absurd hc hne))
+          (deficit_self hl hr _) ?_
+        show Sub ρl ρr b.peel.1 b.peel.1
+        exact Sub.refl b.peel.1 (Ty.WF.peel_fst hb) ρl ρr hl hr
+termination_by t _ _ _ _ _ => sizeOf t
+decreasing_by
+  all_goals simp_wf
+  all_goals try simp
+  all_goals first
+    | omega
+    | (have := List.sizeOf_lt_of_mem ‹_ ∈ _›; try simp at this; omega)
+    | apply Ty.peel_fst_lt_one_add
+    | (simp at hsz; omega)
+
+end CclFormal
diff --git a/formal/CclFormal/Safety.lean b/formal/CclFormal/Safety.lean
new file mode 100644
index 00000000..2b95c462
--- /dev/null
+++ b/formal/CclFormal/Safety.lean
@@ -0,0 +1,1240 @@
+import CclFormal.Term
+
+/-!
+# M2 — Safety: progress, preservation, and refinement soundness
+
+The proof battery over `Term.lean`'s judgment: weakening and the
+substitution lemma (the de Bruijn payoff), `Sub` inversion and canonical
+forms modulo refinement peeling, progress (a well-typed closed term is a
+value, steps, or is filter-blocked at a cast), preservation, and the two
+corollaries — refinement soundness and case-binder soundness.
+
+Two structural choices keep the proofs out of transitivity's territory:
+
+- **`Sub` inversions are case analyses, not inductions.** Every `Sub`
+  constructor pins both sides' head constructors, and the `refined` arm
+  recurses on fully-peeled bases — so `Sub.to_peel` (peel both sides) plus
+  one non-recursive `cases` per head is all the inversion there is.
+- **Typing inversions absorb subsumption chains with typing transport, not
+  `Sub` composition.** Inverting a derivation that ends in `sub` would
+  otherwise need transitivity of `Sub` (M3b's open problem). Instead
+  `HasTy.lam_inv` returns implications of the form "whatever is typed at
+  `X` is typed at `Y`" — reflexive without `Sub.refl`'s `WF` side
+  condition, and composable across a chain link-by-link, each link entering
+  the typing via `HasTy.sub` (renames brought back to identity by
+  `Sub.rename_invariant`, which is where the fragment earns its keep).
+-/
+
+namespace CclFormal
+
+/-! ## Renames fix the non-dependent fragment
+
+`Pred.rename` moves only `Pred.var` nodes, and the fragment has none — so
+renames are invisible to it, which is what lets every `Sub` link a typing
+inversion produces be brought back to the identity morphisms `HasTy.sub`
+demands. -/
+
+theorem Pred.elemOnly_rename (ρ : Ren) (p : Pred) :
+    (p.rename ρ).elemOnly = p.elemOnly := by
+  induction p <;> simp [Pred.rename, Pred.elemOnly, *]
+
+theorem Pred.rename_of_elemOnly {p : Pred} (h : p.elemOnly = true) (ρ : Ren) :
+    p.rename ρ = p := by
+  induction p <;> simp_all [Pred.rename, Pred.elemOnly]
+
+@[simp] theorem Ren.apply_nil (x : String) : Ren.apply [] x = x := rfl
+
+theorem Pred.rename_nil (p : Pred) : p.rename [] = p := by
+  induction p <;> simp [Pred.rename, *]
+
+/-- For an `elemOnly` predicate, membership in a renamed claim list is
+membership in the original: renames neither create nor destroy the match
+(they preserve `elemOnly`-ness, and fix `elemOnly` predicates outright). -/
+theorem Pred.mem_map_rename_iff {p : Pred} (hp : p.elemOnly = true)
+    {l : List Pred} (ρ : Ren) : p ∈ l.map (Pred.rename ρ) ↔ p ∈ l := by
+  constructor
+  · intro h
+    obtain ⟨q, hq, hqe⟩ := List.mem_map.mp h
+    have hqo : q.elemOnly = true := by
+      rw [← Pred.elemOnly_rename ρ q, hqe]; exact hp
+    rw [Pred.rename_of_elemOnly hqo] at hqe
+    exact hqe ▸ hq
+  · intro h
+    have hfix := Pred.rename_of_elemOnly hp ρ
+    exact hfix ▸ List.mem_map_of_mem h
+
+/-! ## Peeling -/
+
+theorem Ty.peel_of_not_refined {t : Ty} (h : t.isRefined = false) :
+    t.peel = (t, []) := by
+  cases t <;> simp_all [Ty.peel, Ty.isRefined]
+
+theorem Ty.peel_fst_not_refined : (t : Ty) → t.peel.1.isRefined = false
+  | .refined b _ => by simpa [Ty.peel] using Ty.peel_fst_not_refined b
+  | .base _ | .uintRange _ | .dataSource _ | .txn
+  | .fn .. | .tuple _ | .record _ | .variant _ => by simp [Ty.peel, Ty.isRefined]
+
+theorem Ty.TermFrag.peel_fst : {t : Ty} → t.TermFrag → t.peel.1.TermFrag
+  | .refined _ _, .refined _ hb => by simpa [Ty.peel] using hb.peel_fst
+  | .base _, h | .uintRange _, h | .dataSource _, h | .txn, h
+  | .fn .., h | .tuple _, h | .record _, h | .variant _, h => by
+      simpa [Ty.peel] using h
+
+theorem Ty.TermFrag.peel_claims : {t : Ty} → t.TermFrag →
+    ∀ p ∈ t.peel.2, p.elemOnly = true
+  | .refined _ _, .refined hps hb => by
+      intro p hp
+      simp [Ty.peel] at hp
+      rcases hp with hp | hp
+      · exact hps p hp
+      · exact hb.peel_claims p hp
+  | .base _, h | .uintRange _, h | .dataSource _, h | .txn, h
+  | .fn .., h | .tuple _, h | .record _, h | .variant _, h => by
+      simp [Ty.peel]
+
+/-! ## The deficit under identity and under the fragment -/
+
+/-- At identity morphisms an empty deficit is claim containment. -/
+theorem deficit_nil_mono {l r : List Pred} (h : deficit [] [] l r = []) :
+    ∀ p ∈ r, p ∈ l := by
+  have hmap : l.map (Pred.rename []) = l := List.map_id'' Pred.rename_nil l
+  intro p hp
+  unfold deficit at h
+  rw [List.filter_eq_nil_iff] at h
+  have hc := h p hp
+  rw [Pred.rename_nil, hmap] at hc
+  simpa [List.contains_iff_mem] using hc
+
+/-- In the fragment the deficit cannot see the morphisms at all. -/
+theorem deficit_invariant {lrefs rrefs : List Pred}
+    (hr : ∀ p ∈ rrefs, p.elemOnly = true) (ρl ρr ρl' ρr' : Ren) :
+    deficit ρl ρr lrefs rrefs = deficit ρl' ρr' lrefs rrefs := by
+  unfold deficit
+  apply List.filter_congr
+  intro p hp
+  have hpo := hr p hp
+  rw [Pred.rename_of_elemOnly hpo, Pred.rename_of_elemOnly hpo]
+  congr 1
+  rw [Bool.eq_iff_iff]
+  simp only [List.contains_iff_mem]
+  rw [Pred.mem_map_rename_iff hpo, Pred.mem_map_rename_iff hpo]
+
+/-! ## Keyed lookup bridges
+
+The typing rules use `List.lookup`, the relation's arms use `lookupBy` —
+both are find-first by key, and the proofs cross between them. -/
+
+theorem lookupBy_eq_lookup {α} [BEq α] [LawfulBEq α]
+    (l : List (α × Ty)) (k : α) : lookupBy l k = l.lookup k := by
+  induction l with
+  | nil => rfl
+  | cons a t ih =>
+      obtain ⟨x, y⟩ := a
+      by_cases hx : x = k
+      · subst hx; simp [lookupBy, List.lookup, List.find?]
+      · have h1 : (x == k) = false := by simpa using hx
+        have h2 : (k == x) = false := by simpa using (Ne.symm hx)
+        simp [lookupBy, List.lookup, List.find?, h1, h2] at ih ⊢
+        exact ih
+
+theorem lookupBy_mem {α} [BEq α] [LawfulBEq α] {l : List (α × Ty)} {k : α}
+    {t : Ty} (h : lookupBy l k = some t) : (k, t) ∈ l := by
+  unfold lookupBy at h
+  cases hf : l.find? (fun e => e.1 == k) with
+  | none => simp [hf] at h
+  | some e =>
+      have hm := List.mem_of_find?_eq_some hf
+      have hk := List.find?_some hf
+      obtain ⟨a, b⟩ := e
+      simp [hf] at h
+      simp at hk
+      subst hk h
+      exact hm
+
+/-! ## `Sub` inversion: peel, then one `cases` per head -/
+
+/-- Peel both sides of a subtyping: the `refined` arm *is* this move, and
+every other arm pins two unrefined heads that peel to themselves. -/
+theorem Sub.to_peel {ρl ρr : Ren} {S W : Ty} (h : Sub ρl ρr S W) :
+    Sub ρl ρr S.peel.1 W.peel.1 := by
+  cases h with
+  | refined hl hr _ _ hbase => rw [hl, hr]; exact hbase
+  | base b => simpa [Ty.peel] using Sub.base b
+  | uintRange n => simpa [Ty.peel] using Sub.uintRange n
+  | dataSource s => simpa [Ty.peel] using Sub.dataSource s
+  | txn => simpa [Ty.peel] using Sub.txn
+  | fnCompute h1 h2 h3 h4 =>
+      simpa [Ty.peel] using Sub.fnCompute h1 h2 h3 h4
+  | fnData h1 h2 h3 => simpa [Ty.peel] using Sub.fnData h1 h2 h3
+  | tuple h1 h2 => simpa [Ty.peel] using Sub.tuple h1 h2
+  | record h1 h2 => simpa [Ty.peel] using Sub.record h1 h2
+  | variant h1 h2 => simpa [Ty.peel] using Sub.variant h1 h2
+
+/-- Claim containment at identity morphisms: everything the supertype
+claims (across all its peeled layers), the subtype already claimed. -/
+theorem Sub.claims_mono {S W : Ty} (h : Sub [] [] S W) :
+    ∀ p ∈ W.peel.2, p ∈ S.peel.2 := by
+  cases h with
+  | refined hl hr _ hdef _ =>
+      rw [hl, hr]
+      exact deficit_nil_mono hdef
+  | base b => simp [Ty.peel]
+  | uintRange n => simp [Ty.peel]
+  | dataSource s => simp [Ty.peel]
+  | txn => simp [Ty.peel]
+  | fnCompute h1 h2 h3 h4 => simp [Ty.peel]
+  | fnData h1 h2 h3 => simp [Ty.peel]
+  | tuple h1 h2 => simp [Ty.peel]
+  | record h1 h2 => simp [Ty.peel]
+  | variant h1 h2 => simp [Ty.peel]
+
+/-- An unrefined subtype of a function type is a function type. (The
+`refined` arm cannot apply: both sides peel trivially, starving its
+at-least-one-layer guard.) -/
+theorem Sub.fn_src {ρl ρr : Ren} {S : Ty} {n k d c}
+    (h : Sub ρl ρr S (.fn n k d c)) (hS : S.isRefined = false) :
+    ∃ n' k' d' c', S = .fn n' k' d' c' := by
+  cases h with
+  | fnCompute _ _ _ _ => exact ⟨_, _, _, _, rfl⟩
+  | fnData _ _ _ => exact ⟨_, _, _, _, rfl⟩
+  | refined hl hr hne _ _ =>
+      rw [Ty.peel_of_not_refined hS] at hl
+      simp [Ty.peel] at hl hr
+      obtain ⟨-, hl2⟩ := hl
+      obtain ⟨-, hr2⟩ := hr
+      simp [hl2, hr2] at hne
+
+/-- Function edge inversion: exactly the contravariant domain and the
+codomain edge (with its Pi correspondence on the lhs morphism). -/
+theorem Sub.fn_inv {ρl ρr : Ren} {n0 n1 : Option String} {k0 k1 : FunKind}
+    {d0 d1 c0 c1 : Ty}
+    (h : Sub ρl ρr (.fn n0 k0 d0 c0) (.fn n1 k1 d1 c1)) :
+    Sub ρr ρl d1 d0 ∧ Sub (codRen n0 n1 ρl) ρr c0 c1 := by
+  cases h with
+  | fnCompute _ _ hdom hcod => exact ⟨hdom, hcod⟩
+  | fnData hd1 _ hcod => exact ⟨hd1, hcod⟩
+  | refined hl hr hne _ _ =>
+      simp [Ty.peel] at hl hr
+      obtain ⟨-, hl2⟩ := hl
+      obtain ⟨-, hr2⟩ := hr
+      simp [hl2, hr2] at hne
+
+/-- An unrefined subtype of a tuple type is a tuple type, at least as wide,
+elementwise below it. -/
+theorem Sub.tuple_inv {ρl ρr : Ren} {S : Ty} {Ts : List Ty}
+    (h : Sub ρl ρr S (.tuple Ts)) (hS : S.isRefined = false) :
+    ∃ Ss, S = .tuple Ss ∧ Ts.length ≤ Ss.length ∧
+      ∀ (i : Nat) t0 t1, Ss[i]? = some t0 → Ts[i]? = some t1 →
+        Sub ρl ρr t0 t1 := by
+  cases h with
+  | tuple hlen helem => exact ⟨_, rfl, hlen, helem⟩
+  | refined hl hr hne _ _ =>
+      rw [Ty.peel_of_not_refined hS] at hl
+      simp [Ty.peel] at hl hr
+      obtain ⟨-, hl2⟩ := hl
+      obtain ⟨-, hr2⟩ := hr
+      simp [hl2, hr2] at hne
+
+/-- An unrefined subtype of a variant type is a variant type, every tag it
+may produce accepted (find-first) with its payload below the acceptor's. -/
+theorem Sub.variant_inv {ρl ρr : Ren} {S : Ty} {tagsW : List (FieldKey × Ty)}
+    (h : Sub ρl ρr S (.variant tagsW)) (hS : S.isRefined = false) :
+    ∃ tagsS, S = .variant tagsS ∧
+      ∀ tg t0, (tg, t0) ∈ tagsS →
+        ∃ t1, lookupBy tagsW tg = some t1 ∧ Sub ρl ρr t0 t1 := by
+  cases h with
+  | variant hcov hpay =>
+      refine ⟨_, rfl, fun tg t0 hmem => ?_⟩
+      obtain ⟨t1, ht1⟩ := Option.isSome_iff_exists.mp (hcov tg t0 hmem)
+      exact ⟨t1, ht1, hpay tg t0 t1 hmem ht1⟩
+  | refined hl hr hne _ _ =>
+      rw [Ty.peel_of_not_refined hS] at hl
+      simp [Ty.peel] at hl hr
+      obtain ⟨-, hl2⟩ := hl
+      obtain ⟨-, hr2⟩ := hr
+      simp [hl2, hr2] at hne
+
+/-! ## Rename invariance on the fragment
+
+The morphisms exist to transport Pi-binder references, and the fragment has
+none — so a fragment subtyping holds at *every* pair of morphisms if it
+holds at one. This is what re-admits the codomain edge's `codRen`-extended
+links into `HasTy.sub`'s identity-morphism subsumption. -/
+
+theorem Sub.rename_invariant {ρl ρr : Ren} {T U : Ty} (h : Sub ρl ρr T U) :
+    T.TermFrag → U.TermFrag → ∀ ρl' ρr' : Ren, Sub ρl' ρr' T U := by
+  induction h with
+  | base b => exact fun _ _ _ _ => .base b
+  | uintRange n => exact fun _ _ _ _ => .uintRange n
+  | dataSource s => exact fun _ _ _ _ => .dataSource s
+  | txn => exact fun _ _ _ _ => .txn
+  | fnCompute hk hnd _ _ ihdom ihcod =>
+      intro hT hU ρl' ρr'
+      cases hT with | fn hd0 hc0 =>
+      cases hU with | fn hd1 hc1 =>
+      exact .fnCompute hk hnd (ihdom hd1 hd0 _ _) (ihcod hc0 hc1 _ _)
+  | fnData _ _ _ ihd1 ihd2 ihcod =>
+      intro hT hU ρl' ρr'
+      cases hT with | fn hd0 hc0 =>
+      cases hU with | fn hd1 hc1 =>
+      exact .fnData (ihd1 hd1 hd0 _ _) (ihd2 hd0 hd1 _ _)
+        (ihcod hc0 hc1 _ _)
+  | tuple hlen _ ih =>
+      intro hT hU ρl' ρr'
+      cases hT with | tuple ha =>
+      cases hU with | tuple hb =>
+      exact .tuple hlen fun i t0 t1 h0 h1 =>
+        ih i t0 t1 h0 h1 (ha _ (List.mem_of_getElem? h0))
+          (hb _ (List.mem_of_getElem? h1)) _ _
+  | record hcov _ ih =>
+      intro hT hU ρl' ρr'
+      cases hT with | record ha =>
+      cases hU with | record hb =>
+      exact .record hcov fun n t0 t1 hmem hlk =>
+        ih n t0 t1 hmem hlk (ha _ (lookupBy_mem hlk)) (hb _ hmem) _ _
+  | variant hcov _ ih =>
+      intro hT hU ρl' ρr'
+      cases hT with | variant ha =>
+      cases hU with | variant hb =>
+      exact .variant hcov fun k t0 t1 hmem hlk =>
+        ih k t0 t1 hmem hlk (ha _ hmem) (hb _ (lookupBy_mem hlk)) _ _
+  | refined hl hr hne hdef _ ihbase =>
+      intro hT hU ρl' ρr'
+      have hlb := hT.peel_fst
+      have hrb := hU.peel_fst
+      have hrc := hU.peel_claims
+      rw [hl] at hlb
+      rw [hr] at hrb hrc
+      exact .refined hl hr hne
+        ((deficit_invariant hrc _ _ _ _).symm.trans hdef)
+        (ihbase hlb hrb _ _)
+
+/-! ## The fragment is a derivation invariant -/
+
+/-- Under a fragment context, every derivable type is in the fragment: the
+free-choice premises on `lam`/`variant`/`caseE`/`sub` are exactly what
+closes the loop. -/
+theorem hasTy_frag {Γ : List Ty} {e : Tm} {T : Ty} (h : HasTy Γ e T) :
+    (∀ X ∈ Γ, X.TermFrag) → T.TermFrag := by
+  induction h with
+  | lit l => exact fun _ => by cases l <;> exact .base _
+  | var hn => exact fun hΓ => hΓ _ (List.mem_of_getElem? hn)
+  | lam hfrag _ ih =>
+      intro hΓ
+      refine .fn hfrag (ih fun X hX => ?_)
+      rcases List.mem_cons.mp hX with rfl | hX
+      · exact hfrag
+      · exact hΓ _ hX
+  | app _ _ ihf _ =>
+      intro hΓ
+      cases ihf hΓ with | fn _ hc => exact hc
+  | letE _ _ ihb ihbody =>
+      intro hΓ
+      refine ihbody fun X hX => ?_
+      rcases List.mem_cons.mp hX with rfl | hX
+      · exact ihb hΓ
+      · exact hΓ _ hX
+  | @tuple Γ es Ts hlen _ ih =>
+      intro hΓ
+      refine .tuple fun t ht => ?_
+      obtain ⟨i, hi⟩ := List.getElem?_of_mem ht
+      have hilt : i < Ts.length := (List.getElem?_eq_some_iff.mp hi).1
+      have hes : es[i]? = some es[i] :=
+        List.getElem?_eq_getElem (by omega)
+      exact ih i es[i] t hes hi hΓ
+  | proj _ hi ih =>
+      intro hΓ
+      cases ih hΓ with | tuple ha => exact ha _ (List.mem_of_getElem? hi)
+  | variant hfrag _ _ _ => exact fun _ => hfrag
+  | caseE hU _ _ _ _ _ => exact fun _ => hU
+  | cast _ _ hclaims _ ih => exact fun hΓ => .refined hclaims (ih hΓ)
+  | refineV _ _ _ _ hclaims _ ih => exact fun hΓ => .refined hclaims (ih hΓ)
+  | sub _ _ hfrag _ => exact fun _ => hfrag
+
+/-! ## Shift and substitution, constructor-wise
+
+`shift`/`subst` recurse through lists via `attach` (their termination
+device); these unfoldings restate them as plain `map`s so the typing
+proofs never see a subtype. -/
+
+namespace Tm
+
+@[simp] theorem shift_lit {c : Nat} {l : Lit} :
+    (Tm.lit l).shift c = .lit l := by simp [Tm.shift]
+
+@[simp] theorem shift_var {c n : Nat} :
+    (Tm.var n).shift c = if n < c then .var n else .var (n + 1) := by
+  simp [Tm.shift]
+
+@[simp] theorem shift_lam {c : Nat} {dom : Ty} {body : Tm} :
+    (Tm.lam dom body).shift c = .lam dom (body.shift (c + 1)) := by
+  simp [Tm.shift]
+
+@[simp] theorem shift_app {c : Nat} {f a : Tm} :
+    (Tm.app f a).shift c = .app (f.shift c) (a.shift c) := by
+  simp [Tm.shift]
+
+@[simp] theorem shift_letE {c : Nat} {bound body : Tm} :
+    (Tm.letE bound body).shift c = .letE (bound.shift c) (body.shift (c + 1)) := by
+  simp [Tm.shift]
+
+@[simp] theorem shift_tuple {c : Nat} {es : List Tm} :
+    (Tm.tuple es).shift c = .tuple (es.map (Tm.shift c)) := by
+  rw [Tm.shift]
+  congr 1
+  exact List.attach_map_val
+
+@[simp] theorem shift_proj {c : Nat} {e : Tm} {i : Nat} :
+    (Tm.proj e i).shift c = .proj (e.shift c) i := by
+  simp [Tm.shift]
+
+@[simp] theorem shift_variant {c : Nat} {tag : FieldKey} {e : Tm} :
+    (Tm.variant tag e).shift c = .variant tag (e.shift c) := by
+  simp [Tm.shift]
+
+@[simp] theorem shift_caseE {c : Nat} {scrut : Tm} {arms : List (FieldKey × Tm)} :
+    (Tm.caseE scrut arms).shift c =
+      .caseE (scrut.shift c) (arms.map fun a => (a.1, a.2.shift (c + 1))) := by
+  rw [Tm.shift]
+  congr 1
+  show arms.attach.map (fun x => (x.1.1, Tm.shift (c + 1) x.1.2)) = _
+  rw [List.map_attach_eq_pmap]
+  show arms.pmap (fun a _ => (a.1, Tm.shift (c + 1) a.2)) _ = _
+  exact List.pmap_eq_map _
+
+@[simp] theorem shift_cast {c : Nat} {claims : List Pred} {e : Tm} :
+    (Tm.cast claims e).shift c = .cast claims (e.shift c) := by
+  simp [Tm.shift]
+
+@[simp] theorem subst_lit {k : Nat} {v : Tm} {l : Lit} :
+    Tm.subst k v (.lit l) = .lit l := by rw [Tm.subst.eq_def]
+
+@[simp] theorem subst_var {k : Nat} {v : Tm} {n : Nat} :
+    Tm.subst k v (.var n) =
+      if n = k then v else if n < k then .var n else .var (n - 1) := by
+  rw [Tm.subst.eq_def]
+
+@[simp] theorem subst_lam {k : Nat} {v : Tm} {dom : Ty} {body : Tm} :
+    Tm.subst k v (.lam dom body) =
+      .lam dom (Tm.subst (k + 1) (v.shift 0) body) := by
+  rw [Tm.subst.eq_def]
+
+@[simp] theorem subst_app {k : Nat} {v f a : Tm} :
+    Tm.subst k v (.app f a) = .app (Tm.subst k v f) (Tm.subst k v a) := by
+  rw [Tm.subst.eq_def]
+
+@[simp] theorem subst_letE {k : Nat} {v bound body : Tm} :
+    Tm.subst k v (.letE bound body) =
+      .letE (Tm.subst k v bound) (Tm.subst (k + 1) (v.shift 0) body) := by
+  rw [Tm.subst.eq_def]
+
+@[simp] theorem subst_tuple {k : Nat} {v : Tm} {es : List Tm} :
+    Tm.subst k v (.tuple es) = .tuple (es.map (Tm.subst k v)) := by
+  rw [Tm.subst.eq_def]
+  show Tm.tuple (es.attach.map fun x => Tm.subst k v x.1) = _
+  congr 1
+  exact List.attach_map_val
+
+@[simp] theorem subst_proj {k : Nat} {v e : Tm} {i : Nat} :
+    Tm.subst k v (.proj e i) = .proj (Tm.subst k v e) i := by
+  rw [Tm.subst.eq_def]
+
+@[simp] theorem subst_variant {k : Nat} {v : Tm} {tag : FieldKey} {e : Tm} :
+    Tm.subst k v (.variant tag e) = .variant tag (Tm.subst k v e) := by
+  rw [Tm.subst.eq_def]
+
+@[simp] theorem subst_caseE {k : Nat} {v scrut : Tm}
+    {arms : List (FieldKey × Tm)} :
+    Tm.subst k v (.caseE scrut arms) =
+      .caseE (Tm.subst k v scrut)
+        (arms.map fun a => (a.1, Tm.subst (k + 1) (v.shift 0) a.2)) := by
+  rw [Tm.subst.eq_def]
+  show Tm.caseE (Tm.subst k v scrut)
+      (arms.attach.map fun x => (x.1.1, Tm.subst (k + 1) (Tm.shift 0 v) x.1.2)) = _
+  congr 1
+  rw [List.map_attach_eq_pmap]
+  show arms.pmap (fun a _ => (a.1, Tm.subst (k + 1) (Tm.shift 0 v) a.2)) _ = _
+  exact List.pmap_eq_map _
+
+@[simp] theorem subst_cast {k : Nat} {v : Tm} {claims : List Pred} {e : Tm} :
+    Tm.subst k v (.cast claims e) = .cast claims (Tm.subst k v e) := by
+  rw [Tm.subst.eq_def]
+
+/-! ## Values, claims, and the two term transports -/
+
+theorem IsVal.shift {v : Tm} (hv : v.IsVal) (c : Nat) : (v.shift c).IsVal := by
+  induction hv generalizing c with
+  | lit l => simpa using .lit l
+  | lam dom body => simpa using .lam dom (body.shift (c + 1))
+  | tuple _ ih =>
+      rw [shift_tuple]
+      refine .tuple fun e he => ?_
+      obtain ⟨x, hx, rfl⟩ := List.mem_map.mp he
+      exact ih x hx c
+  | variant tag hv ih =>
+      rw [shift_variant]
+      exact .variant tag (ih c)
+
+theorem IsVal.subst {v : Tm} (hv : v.IsVal) (k : Nat) (u : Tm) :
+    (Tm.subst k u v).IsVal := by
+  induction hv generalizing k u with
+  | lit l => simpa using .lit l
+  | lam dom body => simpa using .lam dom (Tm.subst (k + 1) (u.shift 0) body)
+  | tuple _ ih =>
+      rw [subst_tuple]
+      refine .tuple fun e he => ?_
+      obtain ⟨x, hx, rfl⟩ := List.mem_map.mp he
+      exact ih x hx k u
+  | variant tag hv ih =>
+      rw [subst_variant]
+      exact .variant tag (ih k u)
+
+/-- Predicate evaluation reads a value only through its literal shape, and
+shifting never changes that shape. -/
+theorem eval_shift {v : Tm} (c : Nat) (p : Pred) :
+    Pred.eval (v.shift c) p = Pred.eval v p := by
+  induction p with
+  | elem =>
+      cases v with
+      | var n => by_cases h : n < c <;> simp [h, Pred.eval]
+      | lit l => simp [Pred.eval]
+      | lam dom body => simp [Pred.eval]
+      | app f a => simp [Pred.eval]
+      | letE b body => simp [Pred.eval]
+      | tuple es => simp [Pred.eval]
+      | proj e i => simp [Pred.eval]
+      | variant tag e => simp [Pred.eval]
+      | caseE sc arms => simp [Pred.eval]
+      | cast cl e => simp [Pred.eval]
+  | unop op a iha => simp [Pred.eval, iha]
+  | binop op a b iha ihb => simp [Pred.eval, iha, ihb]
+  | proj a k iha => simp [Pred.eval]
+  | app f a _ _ => simp [Pred.eval]
+  | _ => simp [Pred.eval]
+
+/-- Same for substitution into a *value*: values have no free variables at
+their literal-observable surface. -/
+theorem eval_subst {v : Tm} (hv : v.IsVal) (k : Nat) (u : Tm) (p : Pred) :
+    Pred.eval (Tm.subst k u v) p = Pred.eval v p := by
+  induction p with
+  | elem => cases hv <;> simp [Pred.eval]
+  | unop op a iha => simp [Pred.eval, iha]
+  | binop op a b iha ihb => simp [Pred.eval, iha, ihb]
+  | proj a k iha => simp [Pred.eval]
+  | app f a _ _ => simp [Pred.eval]
+  | _ => simp [Pred.eval]
+
+theorem claimsHold_shift {v : Tm} {claims : List Pred} (c : Nat) :
+    Tm.claimsHold claims (v.shift c) = Tm.claimsHold claims v := by
+  unfold Tm.claimsHold
+  congr 1
+  funext p
+  rw [eval_shift]
+
+theorem claimsHold_subst {v : Tm} (hv : v.IsVal) {claims : List Pred}
+    (k : Nat) (u : Tm) :
+    Tm.claimsHold claims (Tm.subst k u v) = Tm.claimsHold claims v := by
+  unfold Tm.claimsHold
+  congr 1
+  funext p
+  rw [eval_subst hv]
+
+end Tm
+
+/-- `List.lookup` through a second-component map. -/
+theorem lookup_map_snd {α β γ : Type} [BEq α] {l : List (α × β)} {f : β → γ}
+    {k : α} :
+    (l.map fun a => (a.1, f a.2)).lookup k = (l.lookup k).map f := by
+  induction l with
+  | nil => rfl
+  | cons a t ih =>
+      obtain ⟨x, y⟩ := a
+      simp only [List.map_cons, List.lookup]
+      split <;> simp [ih]
+
+/-! ## Weakening -/
+
+/-- Inserting `U` at cut `Γ₁.length` retypes the shifted term. -/
+theorem HasTy.weaken {Γ : List Ty} {e : Tm} {W : Ty} (h : HasTy Γ e W) :
+    ∀ (Γ₁ Γ₂ : List Ty) (U : Ty), Γ = Γ₁ ++ Γ₂ →
+      HasTy (Γ₁ ++ U :: Γ₂) (e.shift Γ₁.length) W := by
+  induction h with
+  | lit l =>
+      intro Γ₁ Γ₂ U hΓ
+      rw [Tm.shift_lit]; exact .lit l
+  | @var Γ n T hn =>
+      intro Γ₁ Γ₂ U hΓ
+      subst hΓ
+      rw [Tm.shift_var]
+      by_cases hc : n < Γ₁.length
+      · rw [if_pos hc]
+        refine .var ?_
+        rw [List.getElem?_append_left hc] at hn ⊢
+        exact hn
+      · rw [if_neg hc]
+        replace hc := Nat.le_of_not_lt hc
+        refine .var ?_
+        rw [List.getElem?_append_right hc] at hn
+        rw [List.getElem?_append_right (by omega : Γ₁.length ≤ n + 1)]
+        have hidx : n + 1 - Γ₁.length = (n - Γ₁.length) + 1 := by omega
+        rw [hidx, List.getElem?_cons_succ]
+        exact hn
+  | @lam Γ dom body cod hfrag _ ih =>
+      intro Γ₁ Γ₂ U hΓ
+      subst hΓ
+      rw [Tm.shift_lam]
+      exact .lam hfrag (by simpa using ih (dom :: Γ₁) Γ₂ U rfl)
+  | app _ _ ihf iha =>
+      intro Γ₁ Γ₂ U hΓ
+      rw [Tm.shift_app]
+      exact .app (ihf Γ₁ Γ₂ U hΓ) (iha Γ₁ Γ₂ U hΓ)
+  | @letE Γ bound body T' U' _ _ ihb ihbody =>
+      intro Γ₁ Γ₂ U hΓ
+      subst hΓ
+      rw [Tm.shift_letE]
+      exact .letE (ihb Γ₁ Γ₂ U rfl) (by simpa using ihbody (T' :: Γ₁) Γ₂ U rfl)
+  | @tuple Γ es Ts hlen _ ih =>
+      intro Γ₁ Γ₂ U hΓ
+      rw [Tm.shift_tuple]
+      refine .tuple (by simpa using hlen) ?_
+      intro i e T h1 h2
+      rw [List.getElem?_map] at h1
+      cases hes : es[i]? with
+      | none => rw [hes] at h1; simp at h1
+      | some e0 =>
+          rw [hes] at h1
+          simp at h1
+          subst h1
+          exact ih i e0 T hes h2 Γ₁ Γ₂ U hΓ
+  | proj _ hi ih =>
+      intro Γ₁ Γ₂ U hΓ
+      rw [Tm.shift_proj]
+      exact .proj (ih Γ₁ Γ₂ U hΓ) hi
+  | variant hfrag _ hlk ih =>
+      intro Γ₁ Γ₂ U hΓ
+      rw [Tm.shift_variant]
+      exact .variant hfrag (ih Γ₁ Γ₂ U hΓ) hlk
+  | @caseE Γ scrut arms U' tags hU _ hcov _ ihscrut iharms =>
+      intro Γ₁ Γ₂ U hΓ
+      subst hΓ
+      rw [Tm.shift_caseE]
+      refine .caseE hU (ihscrut Γ₁ Γ₂ U rfl) ?_ ?_
+      · intro tag T hlk
+        rw [lookup_map_snd]
+        simpa using hcov tag T hlk
+      · intro tag T body' hlk harm
+        rw [lookup_map_snd] at harm
+        cases harms0 : arms.lookup tag with
+        | none => rw [harms0] at harm; simp at harm
+        | some body0 =>
+            rw [harms0] at harm
+            simp at harm
+            subst harm
+            exact (by simpa using iharms tag T body0 hlk harms0 (T :: Γ₁) Γ₂ U rfl)
+  | cast _ hne hcl hbase ih =>
+      intro Γ₁ Γ₂ U hΓ
+      rw [Tm.shift_cast]
+      exact .cast (ih Γ₁ Γ₂ U hΓ) hne hcl hbase
+  | refineV _ hval hch hne hcl hbase ih =>
+      intro Γ₁ Γ₂ U hΓ
+      exact .refineV (ih Γ₁ Γ₂ U hΓ) (hval.shift _)
+        (by rw [Tm.claimsHold_shift]; exact hch) hne hcl hbase
+  | sub _ hsub hfrag ih =>
+      intro Γ₁ Γ₂ U hΓ
+      exact .sub (ih Γ₁ Γ₂ U hΓ) hsub hfrag
+
+/-! ## The substitution lemma
+
+No value restriction and no fragment hypothesis: the fragment premises ride
+the rules untouched (types contain no terms in this fragment), and the
+substituend only needs the type the cut assumed. -/
+
+theorem HasTy.subst_preserves {Γ : List Ty} {e : Tm} {W : Ty}
+    (h : HasTy Γ e W) :
+    ∀ (Γ₁ Γ₂ : List Ty) (T : Ty) (v : Tm), Γ = Γ₁ ++ T :: Γ₂ →
+      HasTy (Γ₁ ++ Γ₂) v T →
+      HasTy (Γ₁ ++ Γ₂) (Tm.subst Γ₁.length v e) W := by
+  induction h with
+  | lit l =>
+      intro Γ₁ Γ₂ T v hΓ hv
+      rw [Tm.subst_lit]; exact .lit l
+  | @var Γ n T' hn =>
+      intro Γ₁ Γ₂ T v hΓ hv
+      subst hΓ
+      rw [Tm.subst_var]
+      by_cases he : n = Γ₁.length
+      · subst he
+        rw [if_pos rfl]
+        rw [List.getElem?_append_right (Nat.le_refl _)] at hn
+        simp at hn
+        subst hn
+        exact hv
+      · rw [if_neg he]
+        by_cases hlt : n < Γ₁.length
+        · rw [if_pos hlt]
+          refine .var ?_
+          rw [List.getElem?_append_left hlt] at hn ⊢
+          exact hn
+        · rw [if_neg hlt]
+          replace hlt := Nat.le_of_not_lt hlt
+          refine .var ?_
+          rw [List.getElem?_append_right hlt] at hn
+          have h1 : n - Γ₁.length = (n - Γ₁.length - 1) + 1 := by omega
+          rw [h1, List.getElem?_cons_succ] at hn
+          rw [List.getElem?_append_right (by omega : Γ₁.length ≤ n - 1)]
+          have h2 : n - 1 - Γ₁.length = n - Γ₁.length - 1 := by omega
+          rw [h2]
+          exact hn
+  | @lam Γ dom body cod hfrag _ ih =>
+      intro Γ₁ Γ₂ T v hΓ hv
+      subst hΓ
+      rw [Tm.subst_lam]
+      refine .lam hfrag ?_
+      have hv' : HasTy (dom :: (Γ₁ ++ Γ₂)) (v.shift 0) T := by
+        simpa using hv.weaken [] (Γ₁ ++ Γ₂) dom rfl
+      exact (by simpa using ih (dom :: Γ₁) Γ₂ T (v.shift 0) rfl hv')
+  | app _ _ ihf iha =>
+      intro Γ₁ Γ₂ T v hΓ hv
+      rw [Tm.subst_app]
+      exact .app (ihf Γ₁ Γ₂ T v hΓ hv) (iha Γ₁ Γ₂ T v hΓ hv)
+  | @letE Γ bound body T' U' _ _ ihb ihbody =>
+      intro Γ₁ Γ₂ T v hΓ hv
+      subst hΓ
+      rw [Tm.subst_letE]
+      refine .letE (ihb Γ₁ Γ₂ T v rfl hv) ?_
+      have hv' : HasTy (T' :: (Γ₁ ++ Γ₂)) (v.shift 0) T := by
+        simpa using hv.weaken [] (Γ₁ ++ Γ₂) T' rfl
+      exact (by simpa using ihbody (T' :: Γ₁) Γ₂ T (v.shift 0) rfl hv')
+  | @tuple Γ es Ts hlen _ ih =>
+      intro Γ₁ Γ₂ T v hΓ hv
+      rw [Tm.subst_tuple]
+      refine .tuple (by simpa using hlen) ?_
+      intro i e T' h1 h2
+      rw [List.getElem?_map] at h1
+      cases hes : es[i]? with
+      | none => rw [hes] at h1; simp at h1
+      | some e0 =>
+          rw [hes] at h1
+          simp at h1
+          subst h1
+          exact ih i e0 T' hes h2 Γ₁ Γ₂ T v hΓ hv
+  | proj _ hi ih =>
+      intro Γ₁ Γ₂ T v hΓ hv
+      rw [Tm.subst_proj]
+      exact .proj (ih Γ₁ Γ₂ T v hΓ hv) hi
+  | variant hfrag _ hlk ih =>
+      intro Γ₁ Γ₂ T v hΓ hv
+      rw [Tm.subst_variant]
+      exact .variant hfrag (ih Γ₁ Γ₂ T v hΓ hv) hlk
+  | @caseE Γ scrut arms U' tags hU _ hcov _ ihscrut iharms =>
+      intro Γ₁ Γ₂ T v hΓ hv
+      subst hΓ
+      rw [Tm.subst_caseE]
+      refine .caseE hU (ihscrut Γ₁ Γ₂ T v rfl hv) ?_ ?_
+      · intro tag T' hlk
+        rw [lookup_map_snd]
+        simpa using hcov tag T' hlk
+      · intro tag T' body' hlk harm
+        rw [lookup_map_snd] at harm
+        cases harms0 : arms.lookup tag with
+        | none => rw [harms0] at harm; simp at harm
+        | some body0 =>
+            rw [harms0] at harm
+            simp at harm
+            subst harm
+            have hv' : HasTy (T' :: (Γ₁ ++ Γ₂)) (v.shift 0) T := by
+              simpa using hv.weaken [] (Γ₁ ++ Γ₂) T' rfl
+            have harm' := iharms tag T' body0 hlk harms0 (T' :: Γ₁) Γ₂ T
+              (v.shift 0) rfl hv'
+            simpa using harm'
+  | cast _ hne hcl hbase ih =>
+      intro Γ₁ Γ₂ T v hΓ hv
+      rw [Tm.subst_cast]
+      exact .cast (ih Γ₁ Γ₂ T v hΓ hv) hne hcl hbase
+  | refineV _ hval hch hne hcl hbase ih =>
+      intro Γ₁ Γ₂ T v hΓ hv
+      exact .refineV (ih Γ₁ Γ₂ T v hΓ hv) (hval.subst _ _)
+        (by rw [Tm.claimsHold_subst hval]; exact hch) hne hcl hbase
+  | sub _ hsub hfrag ih =>
+      intro Γ₁ Γ₂ T v hΓ hv
+      exact .sub (ih Γ₁ Γ₂ T v hΓ hv) hsub hfrag
+
+/-- The working corollary: substituting a term of the binder's type under
+one binder. -/
+theorem HasTy.subst_one {Γ : List Ty} {body v : Tm} {T U : Ty}
+    (hbody : HasTy (T :: Γ) body U) (hv : HasTy Γ v T) :
+    HasTy Γ (Tm.subst 0 v body) U := by
+  simpa using hbody.subst_preserves [] Γ T v rfl (by simpa using hv)
+
+/-! ## Canonical forms (modulo refinement peeling)
+
+Each is an induction over the typing derivation: the head rule supplies the
+shape, `refineV` peels a layer, and `sub` crosses one relation link via
+`Sub.to_peel` plus the head inversion. `IsVal` dismisses every non-value
+rule. -/
+
+theorem HasTy.canonical_fn {Γ : List Ty} {v : Tm} {W : Ty}
+    (h : HasTy Γ v W) :
+    v.IsVal → ∀ n k d c, W.peel.1 = .fn n k d c →
+      ∃ dom body, v = .lam dom body := by
+  induction h with
+  | lit l =>
+      intro _ n k d c hW
+      cases l <;> simp [Lit.ty, Ty.peel] at hW
+  | lam _ _ _ => exact fun _ n k d c _ => ⟨_, _, rfl⟩
+  | var _ => intro hv; cases hv
+  | app _ _ _ _ => intro hv; cases hv
+  | letE _ _ _ _ => intro hv; cases hv
+  | tuple _ _ _ =>
+      intro _ n k d c hW
+      simp [Ty.peel] at hW
+  | proj _ _ _ => intro hv; cases hv
+  | variant _ _ _ _ =>
+      intro _ n k d c hW
+      simp [Ty.peel] at hW
+  | caseE _ _ _ _ _ _ => intro hv; cases hv
+  | cast _ _ _ _ _ => intro hv; cases hv
+  | refineV _ _ _ _ _ _ ih =>
+      intro hv n k d c hW
+      simp only [Ty.peel] at hW
+      exact ih hv n k d c hW
+  | @sub Γ' e S W' _ hsub hfrag ih =>
+      intro hv n k d c hW
+      have hpeel := hsub.to_peel
+      rw [hW] at hpeel
+      obtain ⟨n', k', d', c', hS⟩ := hpeel.fn_src (Ty.peel_fst_not_refined _)
+      exact ih hv n' k' d' c' hS
+
+theorem HasTy.canonical_tuple {Γ : List Ty} {v : Tm} {W : Ty}
+    (h : HasTy Γ v W) :
+    v.IsVal → ∀ Ts, W.peel.1 = .tuple Ts →
+      ∃ es, v = .tuple es ∧ Ts.length ≤ es.length ∧
+        (∀ (i : Nat) e T, es[i]? = some e → Ts[i]? = some T → HasTy Γ e T) := by
+  induction h with
+  | lit l =>
+      intro _ Ts hW
+      cases l <;> simp [Lit.ty, Ty.peel] at hW
+  | lam _ _ _ =>
+      intro _ Ts hW
+      simp [Ty.peel] at hW
+  | var _ => intro hv; cases hv
+  | app _ _ _ _ => intro hv; cases hv
+  | letE _ _ _ _ => intro hv; cases hv
+  | @tuple Γ' es Ts' hlen helem _ =>
+      intro _ Ts hW
+      rw [Ty.peel_of_not_refined (by simp [Ty.isRefined])] at hW
+      injection hW with hTs
+      subst hTs
+      exact ⟨es, rfl, Nat.le_of_eq hlen.symm, helem⟩
+  | proj _ _ _ => intro hv; cases hv
+  | variant _ _ _ _ =>
+      intro _ Ts hW
+      simp [Ty.peel] at hW
+  | caseE _ _ _ _ _ _ => intro hv; cases hv
+  | cast _ _ _ _ _ => intro hv; cases hv
+  | refineV _ _ _ _ _ _ ih =>
+      intro hv Ts hW
+      simp only [Ty.peel] at hW
+      exact ih hv Ts hW
+  | @sub Γ' e S W' _ hsub hfrag ih =>
+      intro hv Ts hW
+      have hpeel := hsub.to_peel
+      rw [hW] at hpeel
+      obtain ⟨Ss, hS, hwidth, hsubel⟩ :=
+        hpeel.tuple_inv (Ty.peel_fst_not_refined _)
+      obtain ⟨es, hes, hlen', hty⟩ := ih hv Ss hS
+      have hWp : (Ty.tuple Ts).TermFrag := hW ▸ hfrag.peel_fst
+      refine ⟨es, hes, Nat.le_trans hwidth hlen', ?_⟩
+      intro i e T h1 h2
+      have hiS : i < Ss.length := by
+        have := (List.getElem?_eq_some_iff.mp h2).1
+        omega
+      have hSs : Ss[i]? = some Ss[i] := List.getElem?_eq_getElem hiS
+      have hTfrag : T.TermFrag := by
+        cases hWp with | tuple ha => exact ha _ (List.mem_of_getElem? h2)
+      exact (hty i e Ss[i] h1 hSs).sub (hsubel i Ss[i] T hSs h2) hTfrag
+
+theorem HasTy.canonical_variant {Γ : List Ty} {v : Tm} {W : Ty}
+    (h : HasTy Γ v W) :
+    v.IsVal → ∀ tags, W.peel.1 = .variant tags →
+      ∃ tag w T, v = .variant tag w ∧ lookupBy tags tag = some T ∧
+        HasTy Γ w T := by
+  induction h with
+  | lit l =>
+      intro _ tags hW
+      cases l <;> simp [Lit.ty, Ty.peel] at hW
+  | lam _ _ _ =>
+      intro _ tags hW
+      simp [Ty.peel] at hW
+  | var _ => intro hv; cases hv
+  | app _ _ _ _ => intro hv; cases hv
+  | letE _ _ _ _ => intro hv; cases hv
+  | tuple _ _ _ =>
+      intro _ tags hW
+      simp [Ty.peel] at hW
+  | proj _ _ _ => intro hv; cases hv
+  | @variant Γ' e tag T tags' hfrag hty hlk =>
+      intro _ tags hW
+      rw [Ty.peel_of_not_refined (by simp [Ty.isRefined])] at hW
+      injection hW with htags
+      subst htags
+      exact ⟨tag, e, T, rfl, by rw [lookupBy_eq_lookup]; exact hlk, hty⟩
+  | caseE _ _ _ _ _ _ => intro hv; cases hv
+  | cast _ _ _ _ _ => intro hv; cases hv
+  | refineV _ _ _ _ _ _ ih =>
+      intro hv tags hW
+      simp only [Ty.peel] at hW
+      exact ih hv tags hW
+  | @sub Γ' e S W' _ hsub hfrag ih =>
+      intro hv tags hW
+      have hpeel := hsub.to_peel
+      rw [hW] at hpeel
+      obtain ⟨tagsS, hS, hpay⟩ :=
+        hpeel.variant_inv (Ty.peel_fst_not_refined _)
+      obtain ⟨tag, w, T', hw, hlkS, hty⟩ := ih hv tagsS hS
+      obtain ⟨T, hlkW, hsubT⟩ := hpay tag T' (lookupBy_mem hlkS)
+      have hWp : (Ty.variant tags).TermFrag := hW ▸ hfrag.peel_fst
+      have hTfrag : T.TermFrag := by
+        cases hWp with | variant ha => exact ha _ (lookupBy_mem hlkW)
+      exact ⟨tag, w, T, hw, hlkW, hty.sub hsubT hTfrag⟩
+
+/-! ## Lambda inversion by typing transport -/
+
+/-- Typing transport: whatever is typed at `X` (in any context) is typed at
+`Y`. The inversion's slack — reflexive without `Sub.refl`'s `WF` side
+condition, and composable across a subsumption chain without transitivity
+of `Sub`. -/
+def TyImp (X Y : Ty) : Prop := ∀ (Δ : List Ty) (a : Tm), HasTy Δ a X → HasTy Δ a Y
+
+theorem HasTy.lam_inv {Γ : List Ty} {L : Tm} {W : Ty} (h : HasTy Γ L W) :
+    ∀ {d body}, L = .lam d body → (∀ X ∈ Γ, X.TermFrag) →
+      ∀ n k dom cod, W.peel.1 = .fn n k dom cod →
+        ∃ c₀, HasTy (d :: Γ) body c₀ ∧ TyImp dom d ∧ TyImp c₀ cod := by
+  induction h with
+  | lit l => intro d body hL; simp at hL
+  | var _ => intro d body hL; simp at hL
+  | @lam Γ' dom' body' cod' hfrag hbody =>
+      intro d body hL hΓ n k dom cod hW
+      injection hL with h1 h2
+      subst h1; subst h2
+      rw [Ty.peel_of_not_refined (by simp [Ty.isRefined])] at hW
+      injection hW with hn hk hdom hcod
+      subst hdom; subst hcod
+      exact ⟨_, hbody, fun Δ a ha => ha, fun Δ a ha => ha⟩
+  | app _ _ _ _ => intro d body hL; simp at hL
+  | letE _ _ _ _ => intro d body hL; simp at hL
+  | tuple _ _ _ => intro d body hL; simp at hL
+  | proj _ _ _ => intro d body hL; simp at hL
+  | variant _ _ _ _ => intro d body hL; simp at hL
+  | caseE _ _ _ _ _ _ => intro d body hL; simp at hL
+  | cast _ _ _ _ _ => intro d body hL; simp at hL
+  | refineV _ _ _ _ _ _ ih =>
+      intro d body hL hΓ n k dom cod hW
+      simp only [Ty.peel] at hW
+      exact ih hL hΓ n k dom cod hW
+  | @sub Γ' e S W' hty hsub hfrag ih =>
+      intro d body hL hΓ n k dom cod hW
+      subst hL
+      have hpeel := hsub.to_peel
+      rw [hW] at hpeel
+      obtain ⟨n', k', d', c', hS⟩ := hpeel.fn_src (Ty.peel_fst_not_refined _)
+      rw [hS] at hpeel
+      have hSfrag : S.TermFrag := hasTy_frag hty hΓ
+      have hSp : (Ty.fn n' k' d' c').TermFrag := hS ▸ hSfrag.peel_fst
+      have hWp : (Ty.fn n k dom cod).TermFrag := hW ▸ hfrag.peel_fst
+      cases hSp with | fn hd' hc' =>
+      cases hWp with | fn hdW hcW =>
+      obtain ⟨hdom_sub, hcod_sub⟩ := hpeel.fn_inv
+      have hcod_id : Sub [] [] c' cod :=
+        hcod_sub.rename_invariant hc' hcW [] []
+      obtain ⟨c₀, hbody, himp_dom, himp_cod⟩ := ih rfl hΓ n' k' d' c' hS
+      refine ⟨c₀, hbody, ?_, ?_⟩
+      · exact fun Δ a ha => himp_dom Δ a (ha.sub hdom_sub hd')
+      · exact fun Δ a ha => (himp_cod Δ a ha).sub hcod_id hcW
+
+/-! ## Progress -/
+
+/-- Per-element progress split: a list of progressing terms is all values,
+or has a first non-value element that steps or blocks. -/
+theorem progress_split {es : List Tm}
+    (h : ∀ e ∈ es, e.IsVal ∨ (∃ e', Tm.Step e e') ∨ Tm.Blocked e) :
+    (∀ e ∈ es, e.IsVal) ∨
+      ∃ pre e post, es = pre ++ e :: post ∧ (∀ x ∈ pre, x.IsVal) ∧
+        ((∃ e', Tm.Step e e') ∨ Tm.Blocked e) := by
+  induction es with
+  | nil => exact .inl (by simp)
+  | cons a t ih =>
+      rcases h a (by simp) with hva | hst
+      · rcases ih (fun e he => h e (by simp [he])) with hall | hsplit
+        · refine .inl fun e he => ?_
+          rcases List.mem_cons.mp he with rfl | he
+          · exact hva
+          · exact hall e he
+        · obtain ⟨pre, e0, post, heq, hpre, hact⟩ := hsplit
+          refine .inr ⟨a :: pre, e0, post, by rw [heq]; rfl, ?_, hact⟩
+          intro x hx
+          rcases List.mem_cons.mp hx with rfl | hx
+          · exact hva
+          · exact hpre x hx
+      · exact .inr ⟨[], a, t, rfl, by simp, hst⟩
+
+theorem progress_aux {Γ : List Ty} {e : Tm} {T : Ty} (h : HasTy Γ e T) :
+    Γ = [] → e.IsVal ∨ (∃ e', Tm.Step e e') ∨ Tm.Blocked e := by
+  induction h with
+  | lit l => exact fun _ => .inl (.lit l)
+  | var hn => intro hΓ; subst hΓ; simp at hn
+  | lam _ _ _ => exact fun _ => .inl (.lam _ _)
+  | @app Γ' f a n k dom cod hf ha ihf iha =>
+      intro hΓ; subst hΓ
+      rcases ihf rfl with hvf | hstf
+      · rcases iha rfl with hva | hsta
+        · obtain ⟨domL, body, rfl⟩ :=
+            hf.canonical_fn hvf n k dom cod (by simp [Ty.peel])
+          exact .inr (.inl ⟨_, .beta hva⟩)
+        · rcases hsta with ⟨a', hsa⟩ | hba
+          · exact .inr (.inl ⟨_, .appR hvf hsa⟩)
+          · exact .inr (.inr (.appR hvf hba))
+      · rcases hstf with ⟨f', hsf⟩ | hbf
+        · exact .inr (.inl ⟨_, .appL hsf⟩)
+        · exact .inr (.inr (.appL hbf))
+  | letE _ _ ihb _ =>
+      intro hΓ; subst hΓ
+      rcases ihb rfl with hvb | hstb
+      · exact .inr (.inl ⟨_, .letV hvb⟩)
+      · rcases hstb with ⟨b', hsb⟩ | hbb
+        · exact .inr (.inl ⟨_, .letL hsb⟩)
+        · exact .inr (.inr (.letL hbb))
+  | @tuple Γ' es Ts hlen _ ih =>
+      intro hΓ; subst hΓ
+      have hprog : ∀ e ∈ es, e.IsVal ∨ (∃ e', Tm.Step e e') ∨ Tm.Blocked e := by
+        intro e he
+        obtain ⟨i, hi⟩ := List.getElem?_of_mem he
+        have hilt : i < es.length := (List.getElem?_eq_some_iff.mp hi).1
+        have hTs : Ts[i]? = some Ts[i] := List.getElem?_eq_getElem (by omega)
+        exact ih i e Ts[i] hi hTs rfl
+      rcases progress_split hprog with hall | hsplit
+      · exact .inl (.tuple hall)
+      · obtain ⟨pre, e0, post, rfl, hpre, hact⟩ := hsplit
+        rcases hact with ⟨e', hs⟩ | hb
+        · exact .inr (.inl ⟨_, .tupleAt hpre hs⟩)
+        · exact .inr (.inr (.tupleAt hpre hb))
+  | @proj Γ' e0 i Ts T he hi ih =>
+      intro hΓ; subst hΓ
+      rcases ih rfl with hve | hste
+      · obtain ⟨es, rfl, hwidth, _⟩ :=
+          he.canonical_tuple hve Ts (by simp [Ty.peel])
+        have hilt : i < es.length := by
+          have := (List.getElem?_eq_some_iff.mp hi).1
+          omega
+        have hes : es[i]? = some es[i] := List.getElem?_eq_getElem hilt
+        cases hve with
+        | tuple hall => exact .inr (.inl ⟨_, .projV hall hes⟩)
+      · rcases hste with ⟨e', hs⟩ | hb
+        · exact .inr (.inl ⟨_, .projE hs⟩)
+        · exact .inr (.inr (.projE hb))
+  | variant _ _ _ ih =>
+      intro hΓ; subst hΓ
+      rcases ih rfl with hve | hste
+      · exact .inl (.variant _ hve)
+      · rcases hste with ⟨e', hs⟩ | hb
+        · exact .inr (.inl ⟨_, .variantE hs⟩)
+        · exact .inr (.inr (.variantE hb))
+  | @caseE Γ' scrut arms U tags hU hscrut hcov _ ihscrut _ =>
+      intro hΓ; subst hΓ
+      rcases ihscrut rfl with hvs | hsts
+      · obtain ⟨tag, w, T', rfl, hlk, _⟩ :=
+          hscrut.canonical_variant hvs tags (by simp [Ty.peel])
+        rw [lookupBy_eq_lookup] at hlk
+        obtain ⟨body, hbody⟩ := Option.isSome_iff_exists.mp (hcov tag T' hlk)
+        have hw : w.IsVal := by cases hvs with | variant _ hw => exact hw
+        exact .inr (.inl ⟨_, .caseV hw hbody⟩)
+      · rcases hsts with ⟨s', hs⟩ | hb
+        · exact .inr (.inl ⟨_, .caseS hs⟩)
+        · exact .inr (.inr (.caseS hb))
+  | @cast Γ' e0 T0 claims _ _ _ _ ih =>
+      intro hΓ; subst hΓ
+      rcases ih rfl with hve | hste
+      · cases hch : Tm.claimsHold claims e0 with
+        | true => exact .inr (.inl ⟨_, .castV hve hch⟩)
+        | false => exact .inr (.inr (.castV hve hch))
+      · rcases hste with ⟨e', hs⟩ | hb
+        · exact .inr (.inl ⟨_, .castE hs⟩)
+        · exact .inr (.inr (.castE hb))
+  | refineV _ hval _ _ _ _ _ => exact fun _ => .inl hval
+  | sub _ _ _ ih => exact ih
+
+/-- **Progress**, modulo filtering: a well-typed closed term is a value,
+steps, or is filter-blocked at a cast (the scalar face of a `Restrict`
+dropping the element). -/
+theorem progress {e : Tm} {T : Ty} (h : HasTy [] e T) :
+    e.IsVal ∨ (∃ e', Tm.Step e e') ∨ Tm.Blocked e :=
+  progress_aux h rfl
+
+/-! ## Preservation -/
+
+theorem preservation_aux {Γ : List Ty} {e : Tm} {T : Ty} (h : HasTy Γ e T) :
+    ∀ e', Tm.Step e e' → (∀ X ∈ Γ, X.TermFrag) → HasTy Γ e' T := by
+  induction h with
+  | lit l => intro e' hs; cases hs
+  | var _ => intro e' hs; cases hs
+  | lam _ _ _ => intro e' hs; cases hs
+  | @app Γ' f a n k dom cod hf ha ihf iha =>
+      intro e' hs hΓ
+      cases hs with
+      | appL hsf => exact .app (ihf _ hsf hΓ) ha
+      | appR hvf hsa => exact .app hf (iha _ hsa hΓ)
+      | beta hva =>
+          obtain ⟨c₀, hbody, himp_dom, himp_cod⟩ :=
+            hf.lam_inv rfl hΓ n k dom cod (by simp [Ty.peel])
+          exact himp_cod _ _ (hbody.subst_one (himp_dom _ _ ha))
+  | @letE Γ' bound body T' U' hb hbody ihb _ =>
+      intro e' hs hΓ
+      cases hs with
+      | letL hsb => exact .letE (ihb _ hsb hΓ) hbody
+      | letV hvb => exact hbody.subst_one hb
+  | @tuple Γ' es Ts hlen helem ih =>
+      intro e' hs hΓ
+      cases hs with
+      | @tupleAt pre e0 e0' post hpre hstep =>
+          refine .tuple (by simpa using hlen) ?_
+          intro i e T h1 h2
+          by_cases hip : i = pre.length
+          · subst hip
+            rw [List.getElem?_append_right (Nat.le_refl _)] at h1
+            simp at h1
+            subst h1
+            have h0 : (pre ++ e0 :: post)[pre.length]? = some e0 := by
+              rw [List.getElem?_append_right (Nat.le_refl _)]; simp
+            exact ih _ e0 T h0 h2 _ hstep hΓ
+          · have hsame : (pre ++ e0' :: post)[i]? = (pre ++ e0 :: post)[i]? := by
+              by_cases hlt : i < pre.length
+              · rw [List.getElem?_append_left hlt, List.getElem?_append_left hlt]
+              · have hge : pre.length ≤ i := Nat.le_of_not_lt hlt
+                rw [List.getElem?_append_right hge,
+                  List.getElem?_append_right hge]
+                have hi1 : i - pre.length = (i - pre.length - 1) + 1 := by omega
+                rw [hi1, List.getElem?_cons_succ, List.getElem?_cons_succ]
+            rw [hsame] at h1
+            exact helem i e T h1 h2
+  | @proj Γ' e0 i Ts T he hi ih =>
+      intro e' hs hΓ
+      cases hs with
+      | projE hse => exact .proj (ih _ hse hΓ) hi
+      | projV hall hes =>
+          obtain ⟨es', heq, _, hty⟩ :=
+            he.canonical_tuple (.tuple hall) Ts (by simp [Ty.peel])
+          injection heq with heq
+          subst heq
+          exact hty i _ T hes hi
+  | variant hfrag _ hlk ih =>
+      intro e' hs hΓ
+      cases hs with
+      | variantE hse => exact .variant hfrag (ih _ hse hΓ) hlk
+  | @caseE Γ' scrut arms U tags hU hscrut hcov harms ihs _ =>
+      intro e' hs hΓ
+      cases hs with
+      | caseS hss => exact .caseE hU (ihs _ hss hΓ) hcov harms
+      | caseV hw hbody =>
+          obtain ⟨tag', w', T', heq, hlk, hwty⟩ :=
+            hscrut.canonical_variant (.variant _ hw) tags (by simp [Ty.peel])
+          injection heq with heq1 heq2
+          subst heq1
+          subst heq2
+          rw [lookupBy_eq_lookup] at hlk
+          exact (harms _ T' _ hlk hbody).subst_one hwty
+  | cast hty hne hcl hbase ih =>
+      intro e' hs hΓ
+      cases hs with
+      | castE hse => exact .cast (ih _ hse hΓ) hne hcl hbase
+      | castV hve hch => exact .refineV hty hve hch hne hcl hbase
+  | refineV _ hval _ _ _ _ _ =>
+      intro e' hs
+      exact absurd hs hval.not_step
+  | sub _ hsub hfrag ih =>
+      intro e' hs hΓ
+      exact .sub (ih _ hs hΓ) hsub hfrag
+
+/-- **Preservation**: one step keeps the type, under a fragment context. -/
+theorem preservation {Γ : List Ty} {e e' : Tm} {T : Ty}
+    (hΓ : ∀ X ∈ Γ, X.TermFrag) (h : HasTy Γ e T) (hs : Tm.Step e e') :
+    HasTy Γ e' T :=
+  preservation_aux h e' hs hΓ
+
+/-! ## Multi-step evaluation and refinement soundness -/
+
+/-- Reflexive-transitive closure of `Step`. -/
+inductive Tm.Steps : Tm → Tm → Prop
+  | refl (e : Tm) : Tm.Steps e e
+  | head {e e' e''} : Tm.Step e e' → Tm.Steps e' e'' → Tm.Steps e e''
+
+theorem preservation_star {Γ : List Ty} {e e' : Tm}
+    (hs : Tm.Steps e e') (hΓ : ∀ X ∈ Γ, X.TermFrag) :
+    ∀ {T : Ty}, HasTy Γ e T → HasTy Γ e' T := by
+  induction hs with
+  | refl _ => exact fun h => h
+  | head hstep _ ih => exact fun h => ih (preservation hΓ h hstep)
+
+/-- A value's ascribed claims all evaluate true on it: `refineV` supplies
+them checked, `sub` only ever shrinks them (`Sub.claims_mono`), and no
+other rule types a value at a refined type. -/
+theorem HasTy.value_claims {Γ : List Ty} {v : Tm} {W : Ty}
+    (h : HasTy Γ v W) :
+    v.IsVal → ∀ p ∈ W.peel.2, Pred.eval v p = some (.bool true) := by
+  induction h with
+  | lit l => intro _ p hp; cases l <;> simp [Lit.ty, Ty.peel] at hp
+  | lam _ _ _ => intro _ p hp; simp [Ty.peel] at hp
+  | var _ => intro hv; cases hv
+  | app _ _ _ _ => intro hv; cases hv
+  | letE _ _ _ _ => intro hv; cases hv
+  | tuple _ _ _ => intro _ p hp; simp [Ty.peel] at hp
+  | proj _ _ _ => intro hv; cases hv
+  | variant _ _ _ _ => intro _ p hp; simp [Ty.peel] at hp
+  | caseE _ _ _ _ _ _ => intro hv; cases hv
+  | cast _ _ _ _ _ => intro hv; cases hv
+  | refineV _ _ hch _ _ _ ih =>
+      intro hv p hp
+      simp only [Ty.peel, List.mem_append] at hp
+      rcases hp with hp | hp
+      · exact eq_of_beq (List.all_eq_true.mp hch p hp)
+      · exact ih hv p hp
+  | sub _ hsub _ ih =>
+      intro hv p hp
+      exact ih hv p (hsub.claims_mono p hp)
+
+/-- **Refinement soundness**: a closed term of refined type that evaluates
+to a value satisfies every claim — the cast is the only door, and the
+`castV` step checks exactly this set. -/
+theorem refinement_soundness {e v : Tm} {T : Ty} {claims : List Pred}
+    (h : HasTy [] e (.refined T claims)) (hs : Tm.Steps e v)
+    (hv : v.IsVal) : Tm.claimsHold claims v = true := by
+  have hty := preservation_star hs (by simp) h
+  have hcl := hty.value_claims hv
+  unfold Tm.claimsHold
+  rw [List.all_eq_true]
+  intro p hp
+  have := hcl p (by simp [Ty.peel]; exact .inl hp)
+  rw [this]
+  rfl
+
+/-! ## Case-binder soundness -/
+
+/-- The naive case-binder statement, for tag arms: the payload of a
+well-typed variant value really has the type the scrutinee's tag table
+assigns — so `caseV`'s substitution feeds each arm's binder a value of the
+bound it was typed under. The Rust's `case _:` payload-binder defect lives
+in *wildcard* arms, which this model does not yet have; refuting the naive
+statement there needs that extension (recorded in `Term.lean`'s module
+docs as a later increment). -/
+theorem case_binder_sound {Γ : List Ty} {v : Tm} {tag : FieldKey}
+    {tags : List (FieldKey × Ty)}
+    (h : HasTy Γ (.variant tag v) (.variant tags))
+    (hv : (Tm.variant tag v).IsVal) :
+    ∃ T, lookupBy tags tag = some T ∧ HasTy Γ v T := by
+  obtain ⟨tag', w, T, heq, hlk, hty⟩ :=
+    h.canonical_variant hv tags (by simp [Ty.peel])
+  injection heq with h1 h2
+  subst h1
+  subst h2
+  exact ⟨T, hlk, hty⟩
+
+end CclFormal
diff --git a/formal/CclFormal/Sub.lean b/formal/CclFormal/Sub.lean
new file mode 100644
index 00000000..277d3307
--- /dev/null
+++ b/formal/CclFormal/Sub.lean
@@ -0,0 +1,237 @@
+import CclFormal.Ty
+
+/-!
+# The declarative ground subtype relation
+
+`Sub ρl ρr lhs rhs` is the Lean statement of the relation
+`src/ccl/infer/solver/constrain.rs :: constrain_go` *implements* on ground
+types (no `Infer` on either side) — stated declaratively for the first time;
+the Rust operationalizes subsumption inside `constrain` and never writes the
+relation down.
+
+The two `Ren` arguments are the ground shadow of the solver's side morphisms
+`sl`/`sr`: on ground types the only morphisms in flight are the Pi-binder
+renames the `Fun`-vs-`Fun` codomain edge mints (`sl.extended_rename(k, x)`),
+so each side carries a rename environment, they swap at every contravariant
+edge, and refinement predicates are transported through them before
+comparison (the ground residue of `Subst::force_refinement`).
+
+## Deliberate departures from `constrain_go` (each is a tracked decision)
+
+- **No trivial-equality short-circuit.** `constrain_go` starts with
+  `lhs == rhs → Ok` (under identity morphisms). Here reflexivity is a
+  *theorem* (`Sub.refl`), not a rule — provable only for well-formed
+  (uniquely-keyed) types, which surfaces that the short-circuit and the
+  find-first record/variant arms disagree on duplicate-keyed products. See
+  `Ty.WF`.
+
+- **No partition-collapse arm.** A value-`Case` fan-out is a
+  `DisjointJoin` over the arms' one shared domain, so no comparison ever
+  meets a `Variant` of gated legs in domain position against a plain-domain
+  demand (`src/ccl/design/ir.md`, "`Copair` and `DisjointJoin` — two
+  collection-combining operations, not one"). The relation therefore relates
+  a `Variant` domain only to a `Variant` domain.
+-/
+
+namespace CclFormal
+
+/-- The ground shadow of the solver's `Subst`: a Pi-binder rename
+environment. `extend` prepends, so a re-bound name shadows — matching one
+`extended_rename` on top of an existing morphism. (The exact shadowing
+semantics of `Subst::extended_rename` is an M1 differential-fuzz target;
+see `formal/design.md`.) -/
+abbrev Ren := List (String × String)
+
+namespace Ren
+
+/-- The identity morphism (`Subst::id()`). -/
+def id : Ren := []
+
+/-- Apply to one name: first matching entry wins, absent names are fixed. -/
+def apply (ρ : Ren) (x : String) : String :=
+  match ρ.find? (fun e => e.1 == x) with
+  | some e => e.2
+  | none => x
+
+/-- `Subst::extended_rename(k, x)`: the codomain edge's binder
+correspondence `k ↦ x`. -/
+def extend (ρ : Ren) (k x : String) : Ren := (k, x) :: ρ
+
+/-- Acting as the identity — the property `Sub.refl` needs of the ambient
+morphisms (satisfied by `Ren.id`, preserved by diagonal extension). -/
+def IsId (ρ : Ren) : Prop := ∀ x, ρ.apply x = x
+
+end Ren
+
+/-- Transport a predicate through a rename: Pi-binder references move, the
+reserved `elem` binder never does (`REFINEMENT_BINDER` is disjoint from
+user identifiers by construction). Ground residue of
+`Subst::force_refinement`. -/
+def Pred.rename (ρ : Ren) : Pred → Pred
+  | .elem => .elem
+  | .var x => .var (ρ.apply x)
+  | .litInt n => .litInt n
+  | .litBool b => .litBool b
+  | .litStr s => .litStr s
+  | .litUnit => .litUnit
+  | .unop op a => .unop op (a.rename ρ)
+  | .binop op a b => .binop op (a.rename ρ) (b.rename ρ)
+  | .proj a k => .proj (a.rename ρ) k
+  | .app f a => .app (f.rename ρ) (a.rename ρ)
+
+/-- Peel all outer refinement layers: mirror of
+`constrain.rs :: peel_refinements` (outermost predicate first). -/
+def Ty.peel : Ty → Ty × List Pred
+  | .refined b ps => (b.peel.1, ps ++ b.peel.2)
+  | t => (t, [])
+
+/-- Peeling never grows a type. -/
+theorem Ty.peel_fst_sizeOf_le : (t : Ty) → sizeOf t.peel.1 ≤ sizeOf t
+  | .base _ | .uintRange _ | .dataSource _ | .txn
+  | .fn .. | .tuple _ | .record _ | .variant _ => by simp [Ty.peel]
+  | .refined b p => by
+      have ih := peel_fst_sizeOf_le b
+      simp [Ty.peel]
+      omega
+
+/-- Peeling a genuinely refined type strictly shrinks it. -/
+theorem Ty.peel_fst_sizeOf_lt : (t : Ty) → t.peel.2 ≠ [] → sizeOf t.peel.1 < sizeOf t
+  | .base _, h | .uintRange _, h | .dataSource _, h | .txn, h
+  | .fn .., h | .tuple _, h | .record _, h | .variant _, h => by
+      simp [Ty.peel] at h
+  | .refined b p, _ => by
+      have ih := Ty.peel_fst_sizeOf_le b
+      simp [Ty.peel]
+      omega
+
+/-- Combined form of the two peel lemmas: if either side is genuinely
+refined, peeling both shrinks the pair — the decrease of the checker's
+refinement arm. -/
+theorem Ty.peel_sum_lt (lhs rhs : Ty)
+    (h : ¬(lhs.peel.2 = [] ∧ rhs.peel.2 = [])) :
+    sizeOf lhs.peel.1 + sizeOf rhs.peel.1 < sizeOf lhs + sizeOf rhs := by
+  cases hl : lhs.peel.2 with
+  | nil =>
+      cases hr : rhs.peel.2 with
+      | nil => exact absurd ⟨hl, hr⟩ h
+      | cons _ _ =>
+          have h1 := Ty.peel_fst_sizeOf_le lhs
+          have h2 := Ty.peel_fst_sizeOf_lt rhs (by simp [hr])
+          omega
+  | cons _ _ =>
+      have h1 := Ty.peel_fst_sizeOf_lt lhs (by simp [hl])
+      have h2 := Ty.peel_fst_sizeOf_le rhs
+      omega
+
+/-- Find-first keyed lookup, shared by the record and variant arms (the
+Rust arms use `iter().find(..)`). -/
+def lookupBy [BEq α] (l : List (α × Ty)) (k : α) : Option Ty :=
+  (l.find? (fun e => e.1 == k)).map (·.2)
+
+/-- A found value is smaller than the list it was found in. (The `SizeOf α`
+binder matters: without it the statement elaborates with the default
+trivial instance and stops matching use sites' real one.) -/
+theorem lookupBy_sizeOf [BEq α] [SizeOf α] {l : List (α × Ty)} {k : α} {t : Ty}
+    (h : lookupBy l k = some t) : sizeOf t < sizeOf l := by
+  unfold lookupBy at h
+  cases hf : l.find? (fun e => e.1 == k) with
+  | none => simp [hf] at h
+  | some e =>
+      have hm := List.sizeOf_lt_of_mem (List.mem_of_find?_eq_some hf)
+      obtain ⟨a, u⟩ := e
+      simp [hf] at h
+      subst h
+      simp at hm
+      omega
+
+/-- The kind edge over the ground two-point lattice `data ⊑ compute`
+(`constrain.rs :: constrain_kind`): the sole rejection is a capability
+supplied where a collection is demanded. -/
+def kindOk : FunKind → FunKind → Prop
+  | .compute, .data => False
+  | _, _ => True
+
+/-- The codomain edge's morphism: Pi-vs-Pi extends the **lhs** side with the
+binder correspondence; any other binder shape leaves it unchanged
+(`constrain_go`'s `cod_sl`). -/
+def codRen (n0 n1 : Option String) (ρl : Ren) : Ren :=
+  match n0, n1 with
+  | some k, some x => ρl.extend k x
+  | _, _ => ρl
+
+/-- The refinements `rrefs` demands that no transported layer of `lrefs`
+supplies — each side forced through its own morphism first, matched by
+structural predicate equality (never implication), exactly the deficit of
+`constrain_go`'s refinement arm. -/
+def deficit (ρl ρr : Ren) (lrefs rrefs : List Pred) : List Pred :=
+  let lifted := lrefs.map (Pred.rename ρl)
+  rrefs.filter (fun r => !(lifted.contains (r.rename ρr)))
+
+/-- The declarative ground subtype relation. One constructor per
+`constrain_go` arm (ground fragment); rule order in the Rust `match` is
+irrelevant here because the conclusions are syntactically disjoint —
+every constructor pins both sides' head constructors, and `refined`
+requires a refinement layer on at least one side. -/
+inductive Sub : Ren → Ren → Ty → Ty → Prop where
+  /-- Leaves match by equality — `(Base(a), Base(b)) if a == b`. -/
+  | base {ρl ρr} (b : BaseTy) : Sub ρl ρr (.base b) (.base b)
+  /-- `UIntRange` is **equality-only**: it is a data domain (a loop bound),
+  and range inclusion is deliberately not subsumption. -/
+  | uintRange {ρl ρr} (n : Nat) : Sub ρl ρr (.uintRange n) (.uintRange n)
+  | dataSource {ρl ρr} (s : String) : Sub ρl ρr (.dataSource s) (.dataSource s)
+  | txn {ρl ρr} : Sub ρl ρr .txn .txn
+  /-- Function edge, non-`data`-`data` kinds: the kind lattice admits the
+  pair, the domain is contravariant (sides — and their morphisms — swap),
+  and the codomain edge carries the Pi correspondence on the lhs morphism. -/
+  | fnCompute {ρl ρr n0 n1 k0 k1 d0 c0 d1 c1} :
+      kindOk k0 k1 →
+      ¬(k0 = .data ∧ k1 = .data) →
+      Sub ρr ρl d1 d0 →
+      Sub (codRen n0 n1 ρl) ρr c0 c1 →
+      Sub ρl ρr (.fn n0 k0 d0 c0) (.fn n1 k1 d1 c1)
+  /-- Function edge, `data`-`data`: the domain *is* the data, so it is
+  **invariant** — both directions, spelled the only order-independent way
+  (`constrain_go`: "Data domains are invariant"). -/
+  | fnData {ρl ρr n0 n1 d0 c0 d1 c1} :
+      Sub ρr ρl d1 d0 →
+      Sub ρl ρr d0 d1 →
+      Sub (codRen n0 n1 ρl) ρr c0 c1 →
+      Sub ρl ρr (.fn n0 .data d0 c0) (.fn n1 .data d1 c1)
+  /-- Positional width: every position the rhs demands exists in the lhs
+  and is covariantly below it. -/
+  | tuple {ρl ρr a b} :
+      b.length ≤ a.length →
+      (∀ (i : Nat) t0 t1, a[i]? = some t0 → b[i]? = some t1 → Sub ρl ρr t0 t1) →
+      Sub ρl ρr (.tuple a) (.tuple b)
+  /-- Named width: every field the rhs demands is present (find-first) in
+  the lhs and covariantly below it. -/
+  | record {ρl ρr a b} :
+      (∀ n t1, (n, t1) ∈ b → (lookupBy a n).isSome) →
+      (∀ n t0 t1, (n, t1) ∈ b → lookupBy a n = some t0 → Sub ρl ρr t0 t1) →
+      Sub ρl ρr (.record a) (.record b)
+  /-- Variant width is the dual: every tag the lhs may produce is accepted
+  (find-first) by the rhs, payloads covariant. -/
+  | variant {ρl ρr a b} :
+      (∀ k t0, (k, t0) ∈ a → (lookupBy b k).isSome) →
+      (∀ k t0 t1, (k, t0) ∈ a → lookupBy b k = some t1 → Sub ρl ρr t0 t1) →
+      Sub ρl ρr (.variant a) (.variant b)
+  /-- Refinement arm: peel both sides fully; the lhs must supply (after
+  transport through the side morphisms) every refinement the rhs demands —
+  set containment by structural equality, never implication — and the bases
+  compare under the same morphisms. Covers refinement dropping
+  (`{T | p} <: T`), forbids refinement conjuring (`T ⊀ {T | p}`), and makes
+  the base **covariant** (`{T | p} <: {U | p}` iff `T <: U`).
+
+  The guard (a refinement layer on at least one side) keeps the rule
+  disjoint from the head-constructor rules, exactly as the Rust arm's
+  position after them does. The ground fragment has no variable-base
+  deficit-flow sub-case (that is an `Infer` arm). -/
+  | refined {ρl ρr lhs rhs lb lrefs rb rrefs} :
+      lhs.peel = (lb, lrefs) →
+      rhs.peel = (rb, rrefs) →
+      (lrefs ≠ [] ∨ rrefs ≠ []) →
+      deficit ρl ρr lrefs rrefs = [] →
+      Sub ρl ρr lb rb →
+      Sub ρl ρr lhs rhs
+
+end CclFormal
diff --git a/formal/CclFormal/Term.lean b/formal/CclFormal/Term.lean
new file mode 100644
index 00000000..596a1039
--- /dev/null
+++ b/formal/CclFormal/Term.lean
@@ -0,0 +1,365 @@
+import CclFormal.Ty
+import CclFormal.Sub
+
+/-!
+# M2 — Terms, typing, and the small-step semantics (definitional core)
+
+The pure-core term language, its values, capture-free substitution, the
+call-by-value small-step relation, and the declarative typing judgment
+`HasTy Γ e T`. Progress/preservation and the two corollaries (refinement
+soundness, case-binder preservation) live in `Safety.lean`.
+
+## Adjudications (deviations-on-contact, in the M0 tradition)
+
+- **Terms are de Bruijn; types keep their named Pi binders.** The subtype
+  relation never moves a binder, so names-with-renames mirrored the Rust
+  one-to-one there. Reduction *duplicates and re-scopes* binders, where named
+  representations buy α-conversion obligations and nothing else — and the
+  Rust's term binders are uniquified (`uniquify`), so they are α-irrelevant
+  identifiers, not semantic content. The M3 bridge maps uniquified names to
+  indices mechanically.
+- **The non-dependent fragment first**: every refinement predicate is over
+  the reserved `__elem` only (`Pred.elemOnly`) — no predicate references an
+  enclosing term binder. Types are therefore **closed under term
+  substitution**, exactly the fragment the transitivity proof covers
+  (`NoPi`); the dependent extension rides with the Pi-binder thread.
+- **`cast` checks its claims at runtime, and progress is stated modulo
+  filtering.** In CCL a cast is the refinement introduction (lowering's
+  filter); at runtime the corresponding `Restrict` *drops* elements. A
+  scalar small-step mirrors that as: `cast` steps through when every claim
+  evaluates to `true` on the value and is **blocked** otherwise. "Well-typed
+  terms don't get stuck" becomes "a well-typed term is a value, steps, or is
+  filter-blocked at a cast" — and refinement soundness (`⊢ e : {T | p}` and
+  `e ⇓ v` implies `p(v) = true`) holds because the cast is the only door.
+- **The fragment is enforced *in the judgment*** (`Ty.TermFrag` premises on
+  the rules that choose types freely: `lam`'s domain, `variant`'s tags,
+  `sub`'s target), not assumed of the theorem statements. Hypothesizing it
+  only at the boundary would not confine a derivation's *internal* types —
+  `sub` can detour through arbitrary types — and two preservation
+  counterexamples live on such detours; see `Ty.TermFrag`.
+- **`refineV` — checked values inhabit the refinement.** `cast` is the only
+  refinement *door* a program can write, but preservation forces a second,
+  value-level introduction: `cast p v` (claims holding) steps to `v`, and
+  `v`'s refined typing must come from somewhere — `Sub` deliberately forbids
+  refinement conjuring. `refineV` says a claim that *evaluates true on a
+  value* types that value: the term-model face of literal-singleton typing
+  (a refinement is a fact about a value). Runtime-checked (`claimsHold`),
+  value-only, so it is exactly the knowledge the `castV` step validates.
+
+Left for later increments, recorded not dropped: `compose` (the point-free
+core — the source-shaped lambda fragment is what M3's oracle checks first),
+records (keyed tuples; nothing new algebraically), the dependent fragment,
+and wildcard `case` arms (needed before the case-binder calibration lemma —
+the Rust's `case _:` payload-binder defect — can be *stated*).
+-/
+
+namespace CclFormal
+
+/-- Term-level literals (the ground fragment of `ccl::Lit`). -/
+inductive Lit where
+  | int (n : Int)
+  | bool (b : Bool)
+  | str (s : String)
+  | unit
+deriving Repr, DecidableEq
+
+/-- The type of a literal. -/
+def Lit.ty : Lit → Ty
+  | .int _ => .base .int
+  | .bool _ => .base .bool
+  | .str _ => .base .string
+  | .unit => .base .unit
+
+/-- The pure-core term language (de Bruijn indices; see the module docs).
+
+`case` arms pair a variant tag with a body whose index 0 is the payload
+binder — the scrutinee-derived bound the calibration lemma is about. `cast`
+carries the claim set it asserts; it is the only refinement introduction,
+mirroring CCL (a filter's lowering). -/
+inductive Tm where
+  | lit (l : Lit)
+  | var (n : Nat)
+  | lam (dom : Ty) (body : Tm)
+  | app (f a : Tm)
+  | letE (bound body : Tm)
+  | tuple (es : List Tm)
+  | proj (e : Tm) (i : Nat)
+  | variant (tag : FieldKey) (e : Tm)
+  | caseE (scrut : Tm) (arms : List (FieldKey × Tm))
+  | cast (claims : List Pred) (e : Tm)
+deriving Repr
+
+namespace Tm
+
+/-- Values: literals, lambdas, tuples of values, variants of values. -/
+inductive IsVal : Tm → Prop
+  | lit (l : Lit) : IsVal (.lit l)
+  | lam (dom : Ty) (body : Tm) : IsVal (.lam dom body)
+  | tuple {es : List Tm} : (∀ e ∈ es, IsVal e) → IsVal (.tuple es)
+  | variant {e : Tm} (tag : FieldKey) : IsVal e → IsVal (.variant tag e)
+
+/-- Shift free indices `≥ c` by one (the standard de Bruijn lift). -/
+def shift (c : Nat) : Tm → Tm
+  | .lit l => .lit l
+  | .var n => if n < c then .var n else .var (n + 1)
+  | .lam dom body => .lam dom (shift (c + 1) body)
+  | .app f a => .app (shift c f) (shift c a)
+  | .letE bound body => .letE (shift c bound) (shift (c + 1) body)
+  | .tuple es => .tuple (es.attach.map fun ⟨e, _⟩ => shift c e)
+  | .proj e i => .proj (shift c e) i
+  | .variant tag e => .variant tag (shift c e)
+  | .caseE scrut arms =>
+      .caseE (shift c scrut) (arms.attach.map fun ⟨(tag, body), _⟩ => (tag, shift (c + 1) body))
+  | .cast claims e => .cast claims (shift c e)
+termination_by e => sizeOf e
+decreasing_by all_goals
+  first
+  | (simp; omega)
+  | (rename_i h _; have := List.sizeOf_lt_of_mem h; simp at this ⊢; omega)
+  | (rename_i h; have := List.sizeOf_lt_of_mem h; simp at this ⊢; omega)
+
+/-- Substitute `v` for index `k` (types are closed in this fragment, so no
+type substitution exists to perform). -/
+def subst (k : Nat) (v : Tm) : Tm → Tm
+  | .lit l => .lit l
+  | .var n => if n = k then v else if n < k then .var n else .var (n - 1)
+  | .lam dom body => .lam dom (subst (k + 1) (shift 0 v) body)
+  | .app f a => .app (subst k v f) (subst k v a)
+  | .letE bound body => .letE (subst k v bound) (subst (k + 1) (shift 0 v) body)
+  | .tuple es => .tuple (es.attach.map fun ⟨e, _⟩ => subst k v e)
+  | .proj e i => .proj (subst k v e) i
+  | .variant tag e => .variant tag (subst k v e)
+  | .caseE scrut arms =>
+      .caseE (subst k v scrut)
+        (arms.attach.map fun ⟨(tag, body), _⟩ => (tag, subst (k + 1) (shift 0 v) body))
+  | .cast claims e => .cast claims (subst k v e)
+termination_by e => sizeOf e
+decreasing_by all_goals
+  first
+  | (simp; omega)
+  | (rename_i h _; have := List.sizeOf_lt_of_mem h; simp at this ⊢; omega)
+  | (rename_i h; have := List.sizeOf_lt_of_mem h; simp at this ⊢; omega)
+
+end Tm
+
+/-! ## Predicate evaluation
+
+A refinement predicate is a `Pred` over the reserved element binder; its
+truth on a value is what `cast` checks and what refinement soundness is
+about. Evaluation is partial — an op outside the interpreted vocabulary, or
+a shape mismatch, yields `none` — mirroring that the wire emitter maps only
+a fixed `BinOpKind` vocabulary. -/
+
+/-- Evaluate a predicate against the value bound to `__elem`. Returns the
+literal result, or `none` where the fragment does not interpret. -/
+def Pred.eval (v : Tm) : Pred → Option Lit
+  | .elem =>
+      match v with
+      | .lit l => some l
+      | _ => none
+  | .var _ => none
+  | .litInt n => some (.int n)
+  | .litBool b => some (.bool b)
+  | .litStr s => some (.str s)
+  | .litUnit => some .unit
+  | .unop op a =>
+      match op, Pred.eval v a with
+      | "not", some (.bool b) => some (.bool !b)
+      | "neg", some (.int n) => some (.int (-n))
+      | _, _ => none
+  | .binop op a b =>
+      match op, Pred.eval v a, Pred.eval v b with
+      | "eq", some x, some y => some (.bool (x = y))
+      | "ne", some x, some y => some (.bool (x ≠ y))
+      | "lt", some (.int x), some (.int y) => some (.bool (x < y))
+      | "le", some (.int x), some (.int y) => some (.bool (x ≤ y))
+      | "gt", some (.int x), some (.int y) => some (.bool (x > y))
+      | "ge", some (.int x), some (.int y) => some (.bool (x ≥ y))
+      | "add", some (.int x), some (.int y) => some (.int (x + y))
+      | "sub", some (.int x), some (.int y) => some (.int (x - y))
+      | "mul", some (.int x), some (.int y) => some (.int (x * y))
+      | "and", some (.bool x), some (.bool y) => some (.bool (x && y))
+      | "or", some (.bool x), some (.bool y) => some (.bool (x || y))
+      | _, _, _ => none
+  | .proj a k =>
+      match Pred.eval v a with
+      | _ => none  -- literal results carry no fields; projection needs the
+                   -- structured-value extension
+  | .app _ _ => none
+
+/-- Every claim of a set holds on `v`. -/
+def Tm.claimsHold (claims : List Pred) (v : Tm) : Bool :=
+  claims.all fun p => Pred.eval v p == some (.bool true)
+
+/-! ## The call-by-value small-step relation -/
+
+namespace Tm
+
+/-- One step. `cast` is the door refinements guard: it steps through exactly
+when every claim holds on the value (a blocked cast is a *filtered* element,
+not a stuck term — see the module docs). -/
+inductive Step : Tm → Tm → Prop
+  | appL {f f' a} : Step f f' → Step (.app f a) (.app f' a)
+  | appR {f a a'} : IsVal f → Step a a' → Step (.app f a) (.app f a')
+  | beta {dom body a} : IsVal a → Step (.app (.lam dom body) a) (subst 0 a body)
+  | letL {bound bound' body} : Step bound bound' → Step (.letE bound body) (.letE bound' body)
+  | letV {bound body} : IsVal bound → Step (.letE bound body) (subst 0 bound body)
+  | tupleAt {pre : List Tm} {e e' : Tm} {post : List Tm} :
+      (∀ x ∈ pre, IsVal x) → Step e e' →
+      Step (.tuple (pre ++ e :: post)) (.tuple (pre ++ e' :: post))
+  | projE {e e' i} : Step e e' → Step (.proj e i) (.proj e' i)
+  | projV {es : List Tm} {i : Nat} {e : Tm} :
+      (∀ x ∈ es, IsVal x) → es[i]? = some e → Step (.proj (.tuple es) i) e
+  | variantE {tag e e'} : Step e e' → Step (.variant tag e) (.variant tag e')
+  | caseS {scrut scrut' arms} : Step scrut scrut' → Step (.caseE scrut arms) (.caseE scrut' arms)
+  | caseV {tag v arms body} :
+      IsVal v → arms.lookup tag = some body →
+      Step (.caseE (.variant tag v) arms) (subst 0 v body)
+  | castE {claims e e'} : Step e e' → Step (.cast claims e) (.cast claims e')
+  | castV {claims v} :
+      IsVal v → claimsHold claims v = true → Step (.cast claims v) v
+
+/-- A term is *filter-blocked* when its next redex is a cast whose claims do
+not all hold on the value — the scalar face of a `Restrict` dropping a row.
+Progress is stated modulo this outcome. -/
+inductive Blocked : Tm → Prop
+  | castV {claims v} : IsVal v → claimsHold claims v = false → Blocked (.cast claims v)
+  | appL {f a} : Blocked f → Blocked (.app f a)
+  | appR {f a} : IsVal f → Blocked a → Blocked (.app f a)
+  | letL {bound body} : Blocked bound → Blocked (.letE bound body)
+  | tupleAt {pre : List Tm} {e : Tm} {post : List Tm} :
+      (∀ x ∈ pre, IsVal x) → Blocked e → Blocked (.tuple (pre ++ e :: post))
+  | projE {e i} : Blocked e → Blocked (.proj e i)
+  | variantE {tag e} : Blocked e → Blocked (.variant tag e)
+  | caseS {scrut arms} : Blocked scrut → Blocked (.caseE scrut arms)
+  | castE {claims e} : Blocked e → Blocked (.cast claims e)
+
+end Tm
+
+/-! ## The declarative typing judgment -/
+
+/-- Predicates of the non-dependent fragment: over `__elem` only, no
+references to enclosing binders. -/
+def Pred.elemOnly : Pred → Bool
+  | .elem | .litInt _ | .litBool _ | .litStr _ | .litUnit => true
+  | .var _ => false
+  | .unop _ a => a.elemOnly
+  | .binop _ a b => a.elemOnly && b.elemOnly
+  | .proj a _ => a.elemOnly
+  | .app f a => f.elemOnly && a.elemOnly
+
+/-- The types the term fragment covers, hereditarily: **every refinement
+predicate is `Pred.elemOnly`**, the non-dependent fragment. Off it, the
+codomain edge's Pi correspondence (`codRen`) can α-move a *dangling*
+`Pred.var` reference, producing subtype links whose typing transport is
+underivable — a modeling artifact, since the model does not scope predicate
+variables, and one concrete preservation counterexample (spelled out in
+`formal/design.md`).
+
+The shape follows `Ty.WF`: an inductive with one constructor per head, so
+`cases` is the inversion. -/
+inductive Ty.TermFrag : Ty → Prop
+  | base (b) : Ty.TermFrag (.base b)
+  | uintRange (n) : Ty.TermFrag (.uintRange n)
+  | dataSource (s) : Ty.TermFrag (.dataSource s)
+  | txn : Ty.TermFrag .txn
+  | fn {n k d c} : Ty.TermFrag d → Ty.TermFrag c →
+      Ty.TermFrag (.fn n k d c)
+  | tuple {ts} : (∀ t ∈ ts, Ty.TermFrag t) → Ty.TermFrag (.tuple ts)
+  | record {fs} : (∀ f ∈ fs, Ty.TermFrag f.2) → Ty.TermFrag (.record fs)
+  | variant {tags} : (∀ t ∈ tags, Ty.TermFrag t.2) → Ty.TermFrag (.variant tags)
+  | refined {b ps} : (∀ p ∈ ps, p.elemOnly = true) → Ty.TermFrag b →
+      Ty.TermFrag (.refined b ps)
+
+/-- `Γ ⊢ e : T` for the pure core. Contexts are de Bruijn (index 0 is the
+innermost binder). Subsumption is the M0 relation at empty rename
+environments — the non-dependent fragment never transports a Pi binder.
+
+`cast` is the refinement introduction a *program* writes: it asserts its
+claims on top of the value's type, and the small-step checks them — the
+pairing refinement soundness rests on. `refineV` is the value-level
+introduction preservation forces (see the module docs): claims that
+evaluate true on a value type that value. `caseE` types every arm's body
+under the payload type the scrutinee's variant assigns to its tag: the
+scrutinee-derived bound of the calibration lemma.
+
+The rules that choose a type freely — `lam`'s domain annotation,
+`variant`'s tag table, `sub`'s target, and `caseE`'s result (free only in
+the degenerate empty-tags elimination, where every arm premise is vacuous
+and `U` is otherwise unconstrained) — require it in the term fragment
+(`Ty.TermFrag`); everything else inherits fragment membership from its
+premises (`hasTy_frag` in `Safety.lean` is that invariant, stated). -/
+inductive HasTy : List Ty → Tm → Ty → Prop
+  | lit {Γ} (l : Lit) : HasTy Γ (.lit l) l.ty
+  | var {Γ n T} : Γ[n]? = some T → HasTy Γ (.var n) T
+  | lam {Γ dom body cod} :
+      dom.TermFrag →
+      HasTy (dom :: Γ) body cod →
+      HasTy Γ (.lam dom body) (.fn none .compute dom cod)
+  | app {Γ f a name kind dom cod} :
+      HasTy Γ f (.fn name kind dom cod) → HasTy Γ a dom →
+      HasTy Γ (.app f a) cod
+  | letE {Γ bound body T U} :
+      HasTy Γ bound T → HasTy (T :: Γ) body U →
+      HasTy Γ (.letE bound body) U
+  | tuple {Γ} {es : List Tm} {Ts : List Ty} :
+      es.length = Ts.length →
+      (∀ (i : Nat) e T, es[i]? = some e → Ts[i]? = some T → HasTy Γ e T) →
+      HasTy Γ (.tuple es) (.tuple Ts)
+  | proj {Γ e i} {Ts : List Ty} {T : Ty} :
+      HasTy Γ e (.tuple Ts) → Ts[i]? = some T →
+      HasTy Γ (.proj e i) T
+  | variant {Γ e tag T} {tags : List (FieldKey × Ty)} :
+      Ty.TermFrag (.variant tags) →
+      HasTy Γ e T → tags.lookup tag = some T →
+      HasTy Γ (.variant tag e) (.variant tags)
+  | caseE {Γ scrut arms U} {tags : List (FieldKey × Ty)} :
+      U.TermFrag →
+      HasTy Γ scrut (.variant tags) →
+      (∀ tag T, tags.lookup tag = some T → (arms.lookup tag).isSome) →
+      (∀ tag T body, tags.lookup tag = some T → arms.lookup tag = some body →
+        HasTy (T :: Γ) body U) →
+      HasTy Γ (.caseE scrut arms) U
+  | cast {Γ e T} {claims : List Pred} :
+      HasTy Γ e T →
+      claims ≠ [] → (∀ p ∈ claims, p.elemOnly = true) →
+      T.isRefined = false →
+      HasTy Γ (.cast claims e) (.refined T claims)
+  | refineV {Γ v T} {claims : List Pred} :
+      HasTy Γ v T → v.IsVal →
+      Tm.claimsHold claims v = true →
+      claims ≠ [] → (∀ p ∈ claims, p.elemOnly = true) →
+      T.isRefined = false →
+      HasTy Γ v (.refined T claims)
+  | sub {Γ e T U} :
+      HasTy Γ e T → Sub [] [] T U → U.TermFrag →
+      HasTy Γ e U
+
+/-! ## First sanity facts -/
+
+/-- Values do not step. -/
+theorem Tm.IsVal.not_step {v v' : Tm} (hv : v.IsVal) : ¬ Tm.Step v v' := by
+  intro hs
+  induction hs with
+  | tupleAt hpre _ ih =>
+    cases hv with
+    | tuple hall =>
+      exact ih (hall _ (by simp))
+  | variantE _ ih =>
+    cases hv with
+    | variant _ he => exact ih he
+  | _ => cases hv <;> simp_all
+
+/-- Values are not blocked. -/
+theorem Tm.IsVal.not_blocked {v : Tm} (hv : v.IsVal) : ¬ Tm.Blocked v := by
+  intro hb
+  induction hb with
+  | tupleAt hpre _ ih =>
+    cases hv with
+    | tuple hall => exact ih (hall _ (by simp))
+  | variantE _ ih =>
+    cases hv with
+    | variant _ he => exact ih he
+  | _ => cases hv <;> simp_all
+
+end CclFormal
diff --git a/formal/CclFormal/Transitivity.lean b/formal/CclFormal/Transitivity.lean
new file mode 100644
index 00000000..fe1153f2
--- /dev/null
+++ b/formal/CclFormal/Transitivity.lean
@@ -0,0 +1,624 @@
+import CclFormal.Equiv
+import CclFormal.Props
+
+/-!
+# Transitivity of the ground subtype relation
+
+`Sub` is transitive on the canonical fragment. The statement first covered
+the binder-free fragment (`NoPi`); the obstruction past it was the **σ-gap**,
+where chaining dependent codomains produces premises that view the middle
+type under different renames, composing only through a reconciliation
+morphism — the model analogue of `constrain.rs :: bridge_holder_gap`.
+
+Canonical Pi binders dissolve the gap. The solver now names every arrow's
+binder by its depth (`__pi0`, `__pi1`, … — `ReservedName::Pi`, the
+`REFINEMENT_BINDER` move applied to arrows), so any two types compared at
+the same position carry the *same* binder when both carry one. Every binder
+correspondence a canonical chain mints is therefore **diagonal**
+(`__piK ↦ __piK`), and diagonal extensions act as the identity on rename
+environments. This file proves transitivity for that fragment (`Canon`),
+with the environments generalized to six independent identity-acting ones —
+which is what makes the diagonal observation compositional. Pure
+transitivity at the identity environment (`sub_trans_id` at the bottom)
+covers every type the solver emits; the former `NoPi` fragment is the
+special case where every binder is `none`.
+-/
+
+namespace CclFormal
+
+/-- The canonical spelling of the Pi binder at `depth` — mirror of
+`ReservedName::Pi` (`names.rs`). -/
+def piName (d : Nat) : String := "__pi" ++ toString d
+
+/-- The **canonical fragment**, mirroring what `compact_go` emits: at depth
+`d` every arrow's binder is absent or the reserved `piName d`; codomains
+live one deeper, everything else at the same depth (exactly the walk
+`compact.rs` performs). Two `Canon` types compared at one position
+therefore carry the *same* binder whenever both carry one. -/
+def Canon : Nat → Ty → Prop
+  | d, .fn n _ dom cod =>
+      (n = none ∨ n = some (piName d)) ∧ Canon d dom ∧ Canon (d + 1) cod
+  | d, .tuple ts => ∀ t ∈ ts, Canon d t
+  | d, .record fs => ∀ e ∈ fs, Canon d e.2
+  | d, .variant tags => ∀ e ∈ tags, Canon d e.2
+  -- Claims are non-empty, mirroring `Type::refined`'s invariant: an empty
+  -- claim set is not a refinement, it is the base, and the solver's flattening
+  -- layer never emits one.
+  | d, .refined b ps => ps ≠ [] ∧ Canon d b
+  | _, .base _ | _, .uintRange _ | _, .dataSource _ | _, .txn => True
+termination_by _ t => sizeOf t
+decreasing_by
+  all_goals simp_wf
+  all_goals
+    first
+      | omega
+      | (have := List.sizeOf_lt_of_mem ‹_ ∈ _›; omega)
+      | (rename_i h
+         obtain ⟨a, b⟩ := e
+         have := List.sizeOf_lt_of_mem h
+         try simp at this
+         try simp
+         omega)
+
+/-- De Morgan for a decidable conjunction (no Mathlib in this development). -/
+theorem not_and_or' {a b : Prop} [Decidable a] (h : ¬(a ∧ b)) : ¬a ∨ ¬b := by
+  by_cases ha : a
+  · exact Or.inr fun hb => h ⟨ha, hb⟩
+  · exact Or.inl ha
+
+theorem one_le_sizeOf (t : Ty) : 1 ≤ sizeOf t := by
+  cases t <;> simp <;> omega
+
+/-- A type with no top-level refinement layer is its own peel. Canonical
+because a `refined` node whose claim set is empty would peel to nothing while
+remaining a distinct term — a shape `Canon` excludes exactly as
+`Type::refined` does. -/
+theorem peel_nil_self {d : Nat} : {t : Ty} → Canon d t → t.peel.2 = [] → t.peel.1 = t
+  | .base _, _, _ | .uintRange _, _, _ | .dataSource _, _, _ | .txn, _, _
+  | .fn .., _, _ | .tuple _, _, _ | .record _, _, _ | .variant _, _, _ => rfl
+  | .refined b p, hc, h => by
+      rw [Canon] at hc
+      simp [Ty.peel] at h
+      exact absurd h.1 hc.1
+
+theorem canon_peel_fst : (d : Nat) → (t : Ty) → Canon d t → Canon d t.peel.1
+  | _, .base _, h => h
+  | _, .uintRange _, h => h
+  | _, .dataSource _, h => h
+  | _, .txn, h => h
+  | _, .fn .., h => h
+  | _, .tuple _, h => h
+  | _, .record _, h => h
+  | _, .variant _, h => h
+  | d, .refined b _, h => by
+      have hb : Canon d b := by rw [Canon] at h; exact h.2
+      simpa [Ty.peel] using canon_peel_fst d b hb
+termination_by _ t => sizeOf t
+decreasing_by simp_wf; omega
+
+theorem canon_fn_binder {d n k dom c} (h : Canon d (.fn n k dom c)) :
+    n = none ∨ n = some (piName d) := by
+  rw [Canon] at h; exact h.1
+
+theorem canon_fn_dom {d n k dom c} (h : Canon d (.fn n k dom c)) :
+    Canon d dom := by
+  rw [Canon] at h; exact h.2.1
+
+theorem canon_fn_cod {d n k dom c} (h : Canon d (.fn n k dom c)) :
+    Canon (d + 1) c := by
+  rw [Canon] at h; exact h.2.2
+
+/-- The codomain correspondence a **canonical** edge mints acts as the
+identity: both binders (when present) are the same reserved name, so the
+extension is diagonal. This is the whole reason the σ-gap dissolves. -/
+theorem codRen_canon_isId {d : Nat} {n0 n1 : Option String} {ρ : Ren}
+    (h0 : n0 = none ∨ n0 = some (piName d))
+    (h1 : n1 = none ∨ n1 = some (piName d)) (hρ : ρ.IsId) :
+    (codRen n0 n1 ρ).IsId := by
+  rcases h0 with rfl | rfl <;> rcases h1 with rfl | rfl <;>
+    first
+      | exact hρ
+      | exact hρ.extend_diag _
+
+theorem deficit_eq_nil_iff {ρl ρr : Ren} {l r : List Pred} :
+    deficit ρl ρr l r = [] ↔
+      ∀ p ∈ r, ∃ q ∈ l, q.rename ρl = p.rename ρr := by
+  unfold deficit
+  rw [List.filter_eq_nil_iff]
+  constructor
+  · intro h p hp
+    have := h p hp
+    simp only [Bool.not_eq_true', Bool.not_eq_false] at this
+    have hmem := List.mem_of_elem_eq_true this
+    obtain ⟨q, hq, hqe⟩ := List.mem_map.mp hmem
+    exact ⟨q, hq, hqe⟩
+  · intro h p hp
+    obtain ⟨q, hq, hqe⟩ := h p hp
+    simp only [Bool.not_eq_true', Bool.not_eq_false]
+    exact List.elem_eq_true_of_mem (List.mem_map.mpr ⟨q, hq, hqe⟩)
+
+/-- Under identity-acting environments the deficit is plain set
+containment — so any two identity-acting environment pairs agree on it. -/
+theorem deficit_isId_nil_iff {ρl ρr : Ren} (hl : ρl.IsId) (hr : ρr.IsId)
+    {S T : List Pred} : deficit ρl ρr S T = [] ↔ ∀ p ∈ T, p ∈ S := by
+  rw [deficit_eq_nil_iff]
+  constructor
+  · intro h p hp
+    obtain ⟨q, hq, hqe⟩ := h p hp
+    rw [Pred.rename_isId hl q, Pred.rename_isId hr p] at hqe
+    exact hqe ▸ hq
+  · intro h p hp
+    exact ⟨p, h p hp, by rw [Pred.rename_isId hl p, Pred.rename_isId hr p]⟩
+
+/-- Universal peel inversion: **every** rule leaves the peeled bases related
+and the peeled refinement sets contained. For the head-constructor rules
+both peels are `(t, [])`, so this is the derivation itself; for the
+refinement rule it is exactly its premises. -/
+theorem sub_peel_inv {ρl ρr : Ren} {x y : Ty} (h : Sub ρl ρr x y) :
+    deficit ρl ρr x.peel.2 y.peel.2 = [] ∧ Sub ρl ρr x.peel.1 y.peel.1 := by
+  cases h with
+  | base b => exact ⟨rfl, .base b⟩
+  | uintRange n => exact ⟨rfl, .uintRange n⟩
+  | dataSource s => exact ⟨rfl, .dataSource s⟩
+  | txn => exact ⟨rfl, .txn⟩
+  | fnCompute h1 h2 h3 h4 => exact ⟨rfl, .fnCompute h1 h2 h3 h4⟩
+  | fnData h1 h2 h3 => exact ⟨rfl, .fnData h1 h2 h3⟩
+  | tuple h1 h2 => exact ⟨rfl, .tuple h1 h2⟩
+  | record h1 h2 => exact ⟨rfl, .record h1 h2⟩
+  | variant h1 h2 => exact ⟨rfl, .variant h1 h2⟩
+  | refined hpl hpr _ hdef hbase =>
+      rw [hpl, hpr]
+      exact ⟨hdef, hbase⟩
+
+theorem kindOk_trans {k0 km k1 : FunKind}
+    (h1 : kindOk k0 km) (h2 : kindOk km k1) : kindOk k0 k1 := by
+  cases k0 <;> cases km <;> cases k1 <;> simp_all [kindOk]
+
+theorem lookupBy_mem [BEq α] [LawfulBEq α] {l : List (α × Ty)} {k : α} {t : Ty}
+    (h : lookupBy l k = some t) : (k, t) ∈ l := by
+  unfold lookupBy at h
+  cases hf : l.find? (fun e => e.1 == k) with
+  | none => rw [hf] at h; exact absurd h (by simp)
+  | some e =>
+      obtain ⟨a, b⟩ := e
+      rw [hf] at h
+      simp only [Option.map_some] at h
+      injection h with hb
+      subst hb
+      have hmem := List.mem_of_find?_eq_some hf
+      have hkey : a = k := by
+        have := List.find?_some hf
+        simpa using eq_of_beq (by simpa using this)
+      subst hkey
+      exact hmem
+
+/-- Shape inversion: a bare type below a function type is a function type. -/
+theorem sub_fn_rhs_shape {ρl ρr : Ren} {x : Ty} {nm km dm cm}
+    (h : Sub ρl ρr x (.fn nm km dm cm)) (hx : x.peel.2 = []) :
+    ∃ n0 k0 d0 c0, x = .fn n0 k0 d0 c0 := by
+  cases h with
+  | fnCompute _ _ _ _ => exact ⟨_, _, _, _, rfl⟩
+  | fnData _ _ _ => exact ⟨_, _, _, _, rfl⟩
+  | refined hpl hpr hg _ _ =>
+      rw [hpl] at hx
+      simp only [Ty.peel, Prod.mk.injEq] at hpr hx
+      obtain ⟨-, hr⟩ := hpr
+      subst hr
+      rcases hg with hg | hg
+      · exact absurd hx hg
+      · exact absurd rfl hg
+
+/-- Shape inversion: a bare type above a function type is a function type. -/
+theorem sub_fn_lhs_shape {ρl ρr : Ren} {z : Ty} {nm km dm cm}
+    (h : Sub ρl ρr (.fn nm km dm cm) z) (hz : z.peel.2 = []) :
+    ∃ n1 k1 d1 c1, z = .fn n1 k1 d1 c1 := by
+  cases h with
+  | fnCompute _ _ _ _ => exact ⟨_, _, _, _, rfl⟩
+  | fnData _ _ _ => exact ⟨_, _, _, _, rfl⟩
+  | refined hpl hpr hg _ _ =>
+      rw [hpr] at hz
+      simp only [Ty.peel, Prod.mk.injEq] at hpl hz
+      obtain ⟨-, hl⟩ := hpl
+      subst hl
+      rcases hg with hg | hg
+      · exact absurd rfl hg
+      · exact absurd hz hg
+
+/-- Bundled induction hypothesis: transitivity for anything smaller, with
+all six environments free (each identity-acting). The freedom is the point:
+a chain's premises arrive under *their* environments and the conclusion is
+wanted under a third pair, and for canonical types all of them act as the
+identity, so no reconciliation morphism (σ) is ever needed. -/
+def TransIH (n : Nat) : Prop :=
+  ∀ (d : Nat) (a b c : Ty), sizeOf a + sizeOf b + sizeOf c ≤ n →
+    Canon d a → Canon d b → Canon d c →
+    ∀ {ρ1l ρ1r ρ2l ρ2r ρl ρr : Ren},
+      ρ1l.IsId → ρ1r.IsId → ρ2l.IsId → ρ2r.IsId → ρl.IsId → ρr.IsId →
+      Sub ρ1l ρ1r a b → Sub ρ2l ρ2r b c → Sub ρl ρr a c
+
+/-- The function case, factored out so the three ways of concluding a
+function edge are handled once. -/
+theorem sub_trans_fn {n d : Nat} {n0 k0 d0 c0 nm km dm cm : _} {z : Ty}
+    {ρ1l ρ1r ρ2l ρ2r ρl ρr : Ren}
+    (IH : TransIH n)
+    (hbound : sizeOf (Ty.fn n0 k0 d0 c0) + sizeOf (Ty.fn nm km dm cm)
+      + sizeOf z ≤ n + 1)
+    (hx : Canon d (.fn n0 k0 d0 c0)) (hy : Canon d (.fn nm km dm cm))
+    (hz : Canon d z) (hzb : z.peel.2 = [])
+    (h1l : ρ1l.IsId) (h1r : ρ1r.IsId) (h2l : ρ2l.IsId) (h2r : ρ2r.IsId)
+    (hρl : ρl.IsId) (hρr : ρr.IsId)
+    (h1 : Sub ρ1l ρ1r (.fn n0 k0 d0 c0) (.fn nm km dm cm))
+    (h2 : Sub ρ2l ρ2r (.fn nm km dm cm) z) :
+    Sub ρl ρr (.fn n0 k0 d0 c0) z := by
+  obtain ⟨n1, k1, d1, c1, rfl⟩ := sub_fn_lhs_shape h2 hzb
+  have hdom_sz : sizeOf d1 + sizeOf dm + sizeOf d0 ≤ n := by
+    simp only [Ty.fn.sizeOf_spec] at hbound
+    omega
+  have hcod_sz : sizeOf c0 + sizeOf cm + sizeOf c1 ≤ n := by
+    simp only [Ty.fn.sizeOf_spec] at hbound
+    omega
+  -- Canonical binder facts feed the diagonal-correspondence lemma:
+  -- every codomain environment in sight is identity-acting.
+  have hb0 := canon_fn_binder hx
+  have hbm := canon_fn_binder hy
+  have hb1 := canon_fn_binder hz
+  have hcod1_id : (codRen n0 nm ρ1l).IsId := codRen_canon_isId hb0 hbm h1l
+  have hcod2_id : (codRen nm n1 ρ2l).IsId := codRen_canon_isId hbm hb1 h2l
+  have hcodC_id : (codRen n0 n1 ρl).IsId := codRen_canon_isId hb0 hb1 hρl
+  cases h1 with
+  | refined hpl hpr hg _ _ =>
+      simp only [Ty.peel, Prod.mk.injEq] at hpl hpr
+      obtain ⟨-, hl⟩ := hpl
+      obtain ⟨-, hr⟩ := hpr
+      subst hl; subst hr
+      rcases hg with hg | hg <;> exact absurd rfl hg
+  | fnCompute hok1 hnd1 hdom1 hcod1 =>
+      cases h2 with
+      | refined hpl hpr hg _ _ =>
+          simp only [Ty.peel, Prod.mk.injEq] at hpl hpr
+          obtain ⟨-, hl⟩ := hpl
+          obtain ⟨-, hr⟩ := hpr
+          subst hl; subst hr
+          rcases hg with hg | hg <;> exact absurd rfl hg
+      | fnCompute hok2 hnd2 hdom2 hcod2 =>
+          have hdom := IH d d1 dm d0 hdom_sz (canon_fn_dom hz)
+            (canon_fn_dom hy) (canon_fn_dom hx)
+            h2r h2l h1r h1l hρr hρl hdom2 hdom1
+          have hcod := IH (d + 1) c0 cm c1 hcod_sz (canon_fn_cod hx)
+            (canon_fn_cod hy) (canon_fn_cod hz)
+            hcod1_id h1r hcod2_id h2r hcodC_id hρr hcod1 hcod2
+          refine Sub.fnCompute (kindOk_trans hok1 hok2) ?_ hdom hcod
+          rintro ⟨rfl, rfl⟩
+          have hkm : km ≠ FunKind.data := fun h => hnd1 ⟨rfl, h⟩
+          cases km with
+          | data => exact hkm rfl
+          | compute => exact hok2
+      | fnData _ _ _ =>
+          have hk0 : k0 ≠ FunKind.data := fun h => hnd1 ⟨h, rfl⟩
+          cases k0 with
+          | data => exact absurd rfl hk0
+          | compute => exact absurd hok1 (by simp [kindOk])
+  | fnData hdom1a hdom1b hcod1 =>
+      cases h2 with
+      | refined hpl hpr hg _ _ =>
+          simp only [Ty.peel, Prod.mk.injEq] at hpl hpr
+          obtain ⟨-, hl⟩ := hpl
+          obtain ⟨-, hr⟩ := hpr
+          subst hl; subst hr
+          rcases hg with hg | hg <;> exact absurd rfl hg
+      | fnCompute hok2 hnd2 hdom2 hcod2 =>
+          have hdom := IH d d1 dm d0 hdom_sz (canon_fn_dom hz)
+            (canon_fn_dom hy) (canon_fn_dom hx)
+            h2r h2l h1r h1l hρr hρl hdom2 hdom1a
+          have hcod := IH (d + 1) c0 cm c1 hcod_sz (canon_fn_cod hx)
+            (canon_fn_cod hy) (canon_fn_cod hz)
+            hcod1_id h1r hcod2_id h2r hcodC_id hρr hcod1 hcod2
+          refine Sub.fnCompute hok2 ?_ hdom hcod
+          rintro ⟨-, rfl⟩
+          exact hnd2 ⟨rfl, rfl⟩
+      | fnData hdom2a hdom2b hcod2 =>
+          have hdomA := IH d d1 dm d0 hdom_sz (canon_fn_dom hz)
+            (canon_fn_dom hy) (canon_fn_dom hx)
+            h2r h2l h1r h1l hρr hρl hdom2a hdom1a
+          have hdomB := IH d d0 dm d1 (by omega) (canon_fn_dom hx)
+            (canon_fn_dom hy) (canon_fn_dom hz)
+            h1l h1r h2l h2r hρl hρr hdom1b hdom2b
+          have hcod := IH (d + 1) c0 cm c1 hcod_sz (canon_fn_cod hx)
+            (canon_fn_cod hy) (canon_fn_cod hz)
+            hcod1_id h1r hcod2_id h2r hcodC_id hρr hcod1 hcod2
+          exact Sub.fnData hdomA hdomB hcod
+
+/-- Fuel-bounded transitivity for the canonical fragment. -/
+theorem sub_trans_aux : (n : Nat) → TransIH n
+  | 0 => by
+      intro d x y z hn _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
+      have := one_le_sizeOf x
+      have := one_le_sizeOf y
+      have := one_le_sizeOf z
+      omega
+  | n + 1 => by
+    intro d x y z hn hx hy hz ρ1l ρ1r ρ2l ρ2r ρl ρr h1l h1r h2l h2r hρl hρr
+      h1 h2
+    have IH : TransIH n := sub_trans_aux n
+    by_cases hbare : x.peel.2 = [] ∧ y.peel.2 = [] ∧ z.peel.2 = []
+    · obtain ⟨hxb, hyb, hzb⟩ := hbare
+      cases h1 with
+      | base b =>
+          cases h2 with
+          | base _ => exact .base b
+          | refined hpl hpr hg _ _ =>
+              rw [hpr] at hzb
+              simp only [Ty.peel, Prod.mk.injEq] at hpl hzb
+              obtain ⟨-, hl⟩ := hpl
+              subst hl
+              rcases hg with hg | hg
+              · exact absurd rfl hg
+              · exact absurd hzb hg
+      | uintRange m =>
+          cases h2 with
+          | uintRange _ => exact .uintRange m
+          | refined hpl hpr hg _ _ =>
+              rw [hpr] at hzb
+              simp only [Ty.peel, Prod.mk.injEq] at hpl hzb
+              obtain ⟨-, hl⟩ := hpl
+              subst hl
+              rcases hg with hg | hg
+              · exact absurd rfl hg
+              · exact absurd hzb hg
+      | dataSource s =>
+          cases h2 with
+          | dataSource _ => exact .dataSource s
+          | refined hpl hpr hg _ _ =>
+              rw [hpr] at hzb
+              simp only [Ty.peel, Prod.mk.injEq] at hpl hzb
+              obtain ⟨-, hl⟩ := hpl
+              subst hl
+              rcases hg with hg | hg
+              · exact absurd rfl hg
+              · exact absurd hzb hg
+      | txn =>
+          cases h2 with
+          | txn => exact .txn
+          | refined hpl hpr hg _ _ =>
+              rw [hpr] at hzb
+              simp only [Ty.peel, Prod.mk.injEq] at hpl hzb
+              obtain ⟨-, hl⟩ := hpl
+              subst hl
+              rcases hg with hg | hg
+              · exact absurd rfl hg
+              · exact absurd hzb hg
+      | fnCompute a b c d' =>
+          exact sub_trans_fn IH (by omega) hx hy hz hzb
+            h1l h1r h2l h2r hρl hρr (.fnCompute a b c d') h2
+      | fnData a b c =>
+          exact sub_trans_fn IH (by omega) hx hy hz hzb
+            h1l h1r h2l h2r hρl hρr (.fnData a b c) h2
+      | tuple hlen1 hpt1 =>
+          cases h2 with
+          | tuple hlen2 hpt2 =>
+              refine Sub.tuple (Nat.le_trans hlen2 hlen1) ?_
+              intro i t0 t1 h0 h1'
+              rename_i as bs cs
+              have hi1 : i < cs.length := by
+                obtain ⟨hlt, -⟩ := List.getElem?_eq_some_iff.mp h1'
+                exact hlt
+              have hi2 : i < bs.length := Nat.lt_of_lt_of_le hi1 hlen2
+              have hb : bs[i]? = some bs[i] := List.getElem?_eq_getElem hi2
+              have hm0 : t0 ∈ as := List.mem_of_getElem? h0
+              have hmm : bs[i] ∈ bs := List.getElem_mem hi2
+              have hm1 : t1 ∈ cs := List.mem_of_getElem? h1'
+              have s0 := List.sizeOf_lt_of_mem hm0
+              have sm := List.sizeOf_lt_of_mem hmm
+              have s1 := List.sizeOf_lt_of_mem hm1
+              refine IH d t0 bs[i] t1 ?_ ?_ ?_ ?_
+                h1l h1r h2l h2r hρl hρr (hpt1 i t0 bs[i] h0 hb)
+                (hpt2 i bs[i] t1 hb h1')
+              · simp only [Ty.tuple.sizeOf_spec] at hn
+                omega
+              · rw [Canon] at hx; exact hx t0 hm0
+              · rw [Canon] at hy; exact hy bs[i] hmm
+              · rw [Canon] at hz; exact hz t1 hm1
+          | refined hpl hpr hg _ _ =>
+              rw [hpr] at hzb
+              simp only [Ty.peel, Prod.mk.injEq] at hpl hzb
+              obtain ⟨-, hl⟩ := hpl
+              subst hl
+              rcases hg with hg | hg
+              · exact absurd rfl hg
+              · exact absurd hzb hg
+      | record hsome1 hsub1 =>
+          cases h2 with
+          | record hsome2 hsub2 =>
+              rename_i as bs cs
+              refine Sub.record (fun nkey t1 hm => ?_) (fun nkey t0 t1 hm hlk => ?_)
+              · have h2s := hsome2 nkey t1 hm
+                obtain ⟨tm, htm⟩ := Option.isSome_iff_exists.mp h2s
+                exact hsome1 nkey tm (lookupBy_mem htm)
+              · have h2s := hsome2 nkey t1 hm
+                obtain ⟨tm, htm⟩ := Option.isSome_iff_exists.mp h2s
+                have hmm : (nkey, tm) ∈ bs := lookupBy_mem htm
+                have hm0 : (nkey, t0) ∈ as := lookupBy_mem hlk
+                have s0 := List.sizeOf_lt_of_mem hm0
+                have sm := List.sizeOf_lt_of_mem hmm
+                have s1 := List.sizeOf_lt_of_mem hm
+                refine IH d t0 tm t1 ?_ ?_ ?_ ?_
+                  h1l h1r h2l h2r hρl hρr (hsub1 nkey t0 tm hmm hlk)
+                  (hsub2 nkey tm t1 hm htm)
+                · simp only [Ty.record.sizeOf_spec] at hn
+                  simp only [Prod.mk.sizeOf_spec] at s0 sm s1
+                  omega
+                · rw [Canon] at hx; exact hx (nkey, t0) hm0
+                · rw [Canon] at hy; exact hy (nkey, tm) hmm
+                · rw [Canon] at hz; exact hz (nkey, t1) hm
+          | refined hpl hpr hg _ _ =>
+              rw [hpr] at hzb
+              simp only [Ty.peel, Prod.mk.injEq] at hpl hzb
+              obtain ⟨-, hl⟩ := hpl
+              subst hl
+              rcases hg with hg | hg
+              · exact absurd rfl hg
+              · exact absurd hzb hg
+      | variant hsome1 hsub1 =>
+          cases h2 with
+          | variant hsome2 hsub2 =>
+              rename_i as bs cs
+              refine Sub.variant (fun key t0 hm => ?_) (fun key t0 t1 hm hlk => ?_)
+              · have h1s := hsome1 key t0 hm
+                obtain ⟨tm, htm⟩ := Option.isSome_iff_exists.mp h1s
+                exact hsome2 key tm (lookupBy_mem htm)
+              · have h1s := hsome1 key t0 hm
+                obtain ⟨tm, htm⟩ := Option.isSome_iff_exists.mp h1s
+                have hmm : (key, tm) ∈ bs := lookupBy_mem htm
+                have hm1 : (key, t1) ∈ cs := lookupBy_mem hlk
+                have s0 := List.sizeOf_lt_of_mem hm
+                have sm := List.sizeOf_lt_of_mem hmm
+                have s1 := List.sizeOf_lt_of_mem hm1
+                refine IH d t0 tm t1 ?_ ?_ ?_ ?_
+                  h1l h1r h2l h2r hρl hρr (hsub1 key t0 tm hm htm)
+                  (hsub2 key tm t1 hmm hlk)
+                · simp only [Ty.variant.sizeOf_spec] at hn
+                  simp only [Prod.mk.sizeOf_spec] at s0 sm s1
+                  omega
+                · rw [Canon] at hx; exact hx (key, t0) hm
+                · rw [Canon] at hy; exact hy (key, tm) hmm
+                · rw [Canon] at hz; exact hz (key, t1) hm1
+          | refined hpl hpr hg _ _ =>
+              rw [hpr] at hzb
+              simp only [Ty.peel, Prod.mk.injEq] at hpl hzb
+              obtain ⟨-, hl⟩ := hpl
+              subst hl
+              rcases hg with hg | hg
+              · exact absurd rfl hg
+              · exact absurd hzb hg
+      | refined hpl hpr hg _ _ =>
+          rw [hpl] at hxb
+          rw [hpr] at hyb
+          simp at hxb hyb
+          rcases hg with hg | hg
+          · exact absurd hxb hg
+          · exact absurd hyb hg
+    · -- Some side carries a refinement layer: peel all three, compose the
+      -- set containments, recurse on the bases, re-wrap.
+      obtain ⟨hd1, hs1⟩ := sub_peel_inv h1
+      obtain ⟨hd2, hs2⟩ := sub_peel_inv h2
+      have hc1 := (deficit_isId_nil_iff h1l h1r).mp hd1
+      have hc2 := (deficit_isId_nil_iff h2l h2r).mp hd2
+      have hlt : sizeOf x.peel.1 + sizeOf y.peel.1 + sizeOf z.peel.1
+          < sizeOf x + sizeOf y + sizeOf z := by
+        have hax := Ty.peel_fst_sizeOf_le x
+        have hay := Ty.peel_fst_sizeOf_le y
+        have haz := Ty.peel_fst_sizeOf_le z
+        rcases not_and_or' hbare with h' | h'
+        · have := Ty.peel_fst_sizeOf_lt x h'; omega
+        · rcases not_and_or' h' with h'' | h''
+          · have := Ty.peel_fst_sizeOf_lt y h''; omega
+          · have := Ty.peel_fst_sizeOf_lt z h''; omega
+      have hbase := IH d x.peel.1 y.peel.1 z.peel.1 (by omega)
+        (canon_peel_fst d x hx) (canon_peel_fst d y hy) (canon_peel_fst d z hz)
+        h1l h1r h2l h2r hρl hρr hs1 hs2
+      have hdef : deficit ρl ρr x.peel.2 z.peel.2 = [] :=
+        (deficit_isId_nil_iff hρl hρr).mpr fun p hp => hc1 p (hc2 p hp)
+      by_cases hxz : x.peel.2 = [] ∧ z.peel.2 = []
+      · rw [peel_nil_self hx hxz.1, peel_nil_self hz hxz.2] at hbase
+        exact hbase
+      · exact Sub.refined rfl rfl (not_and_or' hxz) hdef hbase
+
+/-- **Transitivity for the canonical fragment**, environments free: any
+chain composes under any identity-acting environments — no `NoPi`
+restriction, no σ-side condition. Canonical binders are what every type
+leaving the solver carries (`compact.rs` / `spec_key.rs`), so this is
+transitivity for the system's actual types. -/
+theorem sub_trans {d : Nat} {x y z : Ty}
+    (hx : Canon d x) (hy : Canon d y) (hz : Canon d z)
+    {ρ1l ρ1r ρ2l ρ2r ρl ρr : Ren}
+    (h1l : ρ1l.IsId) (h1r : ρ1r.IsId) (h2l : ρ2l.IsId) (h2r : ρ2r.IsId)
+    (hρl : ρl.IsId) (hρr : ρr.IsId)
+    (h1 : Sub ρ1l ρ1r x y) (h2 : Sub ρ2l ρ2r y z) : Sub ρl ρr x z :=
+  sub_trans_aux (sizeOf x + sizeOf y + sizeOf z) d x y z (Nat.le_refl _)
+    hx hy hz h1l h1r h2l h2r hρl hρr h1 h2
+
+/-- **Pure transitivity** at the identity environment — the form the ground
+oracle exercises. -/
+theorem sub_trans_id {d : Nat} {x y z : Ty}
+    (hx : Canon d x) (hy : Canon d y) (hz : Canon d z)
+    (h1 : Sub .id .id x y) (h2 : Sub .id .id y z) : Sub .id .id x z :=
+  sub_trans hx hy hz Ren.isId_id Ren.isId_id Ren.isId_id Ren.isId_id
+    Ren.isId_id Ren.isId_id h1 h2
+
+/-! ## Claim order is not observable
+
+`Type::Refinement` carries a `RefinementSet` — unordered and deduplicated —
+while the model *represents* the claims as a `List Pred` so that `Ty.beq` stays
+propositional equality. The two agree only if the relation genuinely cannot
+see the list structure, which is what this section proves rather than asserts.
+
+The statements are in terms of **containment**, not permutation, because that
+is what `deficit` actually uses: it asks whether each demanded claim has *some*
+supplier, so a supplier list may be reordered, duplicated, or widened freely.
+Permutation and dedup-invariance are corollaries (`sub_claims_perm`), which is
+exactly the latitude the Rust representation takes.
+-/
+
+/-- Widening (hence reordering or duplicating) the **supplied** claims
+preserves the relation. -/
+theorem sub_claims_left {ρl ρr : Ren} {b z : Ty} {ps qs : List Pred}
+    (hne : qs ≠ []) (hsupp : ∀ p ∈ ps, p ∈ qs)
+    (h : Sub ρl ρr (.refined b ps) z) : Sub ρl ρr (.refined b qs) z := by
+  obtain ⟨hdef, hbase⟩ := sub_peel_inv h
+  refine Sub.refined rfl rfl (.inl ?_) ?_ hbase
+  · simp
+    exact fun hc => absurd hc hne
+  · rw [deficit_eq_nil_iff] at hdef ⊢
+    intro p hp
+    obtain ⟨q, hq, hqe⟩ := hdef p hp
+    refine ⟨q, ?_, hqe⟩
+    simp [Ty.peel] at hq ⊢
+    rcases hq with hq | hq
+    · exact Or.inl (hsupp q hq)
+    · exact Or.inr hq
+
+/-- Narrowing (hence reordering or deduplicating) the **demanded** claims
+preserves the relation. -/
+theorem sub_claims_right {ρl ρr : Ren} {x b : Ty} {ps qs : List Pred}
+    (hne : qs ≠ []) (hdem : ∀ p ∈ qs, p ∈ ps)
+    (h : Sub ρl ρr x (.refined b ps)) : Sub ρl ρr x (.refined b qs) := by
+  obtain ⟨hdef, hbase⟩ := sub_peel_inv h
+  refine Sub.refined rfl rfl (.inr ?_) ?_ hbase
+  · simp
+    exact fun hc => absurd hc hne
+  · rw [deficit_eq_nil_iff] at hdef ⊢
+    intro p hp
+    simp at hp
+    refine hdef p ?_
+    simp [Ty.peel]
+    rcases hp with hp | hp
+    · exact Or.inl (hdem p hp)
+    · exact Or.inr hp
+
+/-- **Claim order is not observable**: two claim lists with the same members
+are interchangeable on either side of the relation. This is the model's
+statement of what `RefinementSet` guarantees — that making the representation
+unordered changed no verdict, so the arrival order two bounds happened to meet
+in cannot reach typing. -/
+theorem sub_claims_perm {ρl ρr : Ren} {b z : Ty} {ps qs : List Pred}
+    (hne : qs ≠ []) (hmem : ∀ p, p ∈ ps ↔ p ∈ qs) :
+    Sub ρl ρr (.refined b ps) z ↔ Sub ρl ρr (.refined b qs) z := by
+  have hqne : ps ≠ [] := by
+    intro hc
+    obtain ⟨q, hq⟩ := List.exists_mem_of_ne_nil qs hne
+    exact absurd ((hmem q).mpr hq) (by simp [hc])
+  exact ⟨sub_claims_left hne (fun p hp => (hmem p).mp hp),
+         sub_claims_left hqne (fun p hp => (hmem p).mpr hp)⟩
+
+/-- The same, in demand position. -/
+theorem sub_claims_perm_right {ρl ρr : Ren} {x b : Ty} {ps qs : List Pred}
+    (hne : qs ≠ []) (hmem : ∀ p, p ∈ ps ↔ p ∈ qs) :
+    Sub ρl ρr x (.refined b ps) ↔ Sub ρl ρr x (.refined b qs) := by
+  have hqne : ps ≠ [] := by
+    intro hc
+    obtain ⟨q, hq⟩ := List.exists_mem_of_ne_nil qs hne
+    exact absurd ((hmem q).mpr hq) (by simp [hc])
+  exact ⟨sub_claims_right hne (fun p hp => (hmem p).mpr hp),
+         sub_claims_right hqne (fun p hp => (hmem p).mp hp)⟩
+
+end CclFormal
diff --git a/formal/CclFormal/Ty.lean b/formal/CclFormal/Ty.lean
new file mode 100644
index 00000000..6e35c14c
--- /dev/null
+++ b/formal/CclFormal/Ty.lean
@@ -0,0 +1,238 @@
+/-!
+# The ground `Type` grammar
+
+The Lean mirror of the **ground fragment** of `src/ccl/ty.rs :: Type` — every
+variant a fully-inferred type can contain. Excluded, deliberately:
+
+- `Infer` and `SharedHole` — inference unknowns; the ground relation has no
+  variable arms (they enter at the solver-model milestone).
+- `History` and `ChanDom` — transients erased before the strict wall; they are
+  pipeline artifacts, not types a checked program exhibits.
+- `App` and `Below` — type-function applications reduce during inference and
+  `Below` lives only in annotation position; both are transient in the same
+  sense as `Infer`.
+- `FunKind::Var` — kind unknowns resolve at coalesce; ground kinds are the
+  two-point lattice.
+-/
+
+namespace CclFormal
+
+/-- Mirror of `ccl::ops::BaseType`. -/
+inductive BaseTy where
+  | int | uint | string | bool | unit
+deriving Repr, DecidableEq
+
+/-- Mirror of `ccl::ty::FieldKey`: a record/tuple field or variant tag. -/
+inductive FieldKey where
+  | idx (n : Nat)
+  | name (s : String)
+deriving Repr, DecidableEq
+
+/-- Mirror of the ground part of `ccl::ty::FunKind` (`Var` excluded): the
+two-point kind lattice with `data ⊑ compute`. -/
+inductive FunKind where
+  | compute | data
+deriving Repr, DecidableEq
+
+/-- A refinement predicate term.
+
+Mirrors the fragment of `TypedExpr` that refinement predicates use, and only
+up to what subtyping observes: `Refinement`'s `PartialEq` is **type-blind
+structural equality** of the predicate term (`src/ccl/ty.rs`), so the model
+carries no type slots and `op` names are opaque strings. `elem` is the single
+reserved refinement binder (`REFINEMENT_BINDER`, `__elem`); `var` references
+an enclosing `Fun` Pi binder by name. The Rust→JSON emitter (M1) must map
+`TypedExpr` predicates into exactly this fragment and refuse anything outside
+it, so a vocabulary gap fails loudly instead of comparing wrongly. -/
+inductive Pred where
+  | elem
+  | var (x : String)
+  | litInt (n : Int)
+  | litBool (b : Bool)
+  | litStr (s : String)
+  | litUnit
+  | unop (op : String) (a : Pred)
+  | binop (op : String) (a b : Pred)
+  | proj (a : Pred) (k : FieldKey)
+  | app (f a : Pred)
+deriving Repr, DecidableEq
+
+/-- Mirror of the ground fragment of `ccl::ty::Type`.
+
+`refined` carries a **claim set**, exactly like
+`Type::Refinement(base, RefinementSet)`: a base narrowed by the conjunction of
+its claims, with `Ty.WF` requiring the same two invariants `Type::refined`
+establishes — the claims are non-empty, and the base is not itself refined, so
+layers never nest.
+
+The claims are *represented* as a `List Pred` and `Ty.beq` compares them
+positionally, which keeps `beq` propositional equality (`Ty.beq_iff`) and so
+keeps `DecidableEq`. The **relation** is what treats them as a set: `deficit`
+is containment, never list equality, so `Sub` cannot observe claim order —
+stated and proved as `sub_claims_perm` rather than left as a reading of the
+rules.
+
+Equality is hand-written (`Ty.beq` — the `BEq`/`DecidableEq` deriving
+handlers do not support this nested inductive) and bridged to propositional
+equality by `Ty.beq_iff`, yielding lawful `BEq` and `DecidableEq`
+instances. -/
+inductive Ty where
+  | base (b : BaseTy)
+  | uintRange (n : Nat)
+  | dataSource (name : String)
+  | txn
+  | fn (binder : Option String) (kind : FunKind) (dom cod : Ty)
+  | tuple (ts : List Ty)
+  | record (fields : List (String × Ty))
+  | variant (tags : List (FieldKey × Ty))
+  | refined (base : Ty) (claims : List Pred)
+deriving Repr
+
+mutual
+
+/-- Structural equality. -/
+def Ty.beq : Ty → Ty → Bool
+  | .base a, .base b => a == b
+  | .uintRange a, .uintRange b => a == b
+  | .dataSource a, .dataSource b => a == b
+  | .txn, .txn => true
+  | .fn n0 k0 d0 c0, .fn n1 k1 d1 c1 =>
+      n0 == n1 && k0 == k1 && Ty.beq d0 d1 && Ty.beq c0 c1
+  | .tuple a, .tuple b => Ty.beqSeq a b
+  | .record a, .record b => Ty.beqFields a b
+  | .variant a, .variant b => Ty.beqTags a b
+  | .refined b0 p0, .refined b1 p1 => Ty.beq b0 b1 && p0 == p1
+  | _, _ => false
+termination_by a b => sizeOf a + sizeOf b
+decreasing_by all_goals (simp_wf; omega)
+
+def Ty.beqSeq : List Ty → List Ty → Bool
+  | [], [] => true
+  | t0 :: a, t1 :: b => Ty.beq t0 t1 && Ty.beqSeq a b
+  | _, _ => false
+termination_by a b => sizeOf a + sizeOf b
+decreasing_by all_goals (simp_wf; omega)
+
+def Ty.beqFields : List (String × Ty) → List (String × Ty) → Bool
+  | [], [] => true
+  | (n0, t0) :: a, (n1, t1) :: b => n0 == n1 && Ty.beq t0 t1 && Ty.beqFields a b
+  | _, _ => false
+termination_by a b => sizeOf a + sizeOf b
+decreasing_by all_goals (simp_wf; omega)
+
+def Ty.beqTags : List (FieldKey × Ty) → List (FieldKey × Ty) → Bool
+  | [], [] => true
+  | (k0, t0) :: a, (k1, t1) :: b => k0 == k1 && Ty.beq t0 t1 && Ty.beqTags a b
+  | _, _ => false
+termination_by a b => sizeOf a + sizeOf b
+decreasing_by all_goals (simp_wf; omega)
+
+end
+
+instance : BEq Ty := ⟨Ty.beq⟩
+
+mutual
+
+theorem Ty.beq_iff : (a b : Ty) → (Ty.beq a b = true ↔ a = b)
+  | .base _, b => by cases b <;> simp [Ty.beq]
+  | .uintRange _, b => by cases b <;> simp [Ty.beq]
+  | .dataSource _, b => by cases b <;> simp [Ty.beq]
+  | .txn, b => by cases b <;> simp [Ty.beq]
+  | .fn n0 k0 d0 c0, b => by
+      cases b <;> simp [Ty.beq]
+      case fn n1 k1 d1 c1 =>
+        simp [Ty.beq_iff d0 d1, Ty.beq_iff c0 c1, and_assoc]
+  | .tuple ts, b => by
+      cases b <;> simp [Ty.beq]
+      case tuple bs => exact Ty.beqSeq_iff ts bs
+  | .record fs, b => by
+      cases b <;> simp [Ty.beq]
+      case record bs => exact Ty.beqFields_iff fs bs
+  | .variant tags, b => by
+      cases b <;> simp [Ty.beq]
+      case variant bs => exact Ty.beqTags_iff tags bs
+  | .refined b0 p0, b => by
+      cases b <;> simp [Ty.beq]
+      case refined b1 p1 => simp [Ty.beq_iff b0 b1]
+termination_by a b => sizeOf a + sizeOf b
+decreasing_by all_goals (simp_wf; omega)
+
+theorem Ty.beqSeq_iff : (a b : List Ty) → (Ty.beqSeq a b = true ↔ a = b)
+  | [], [] => by simp [Ty.beqSeq]
+  | [], _ :: _ => by simp [Ty.beqSeq]
+  | _ :: _, [] => by simp [Ty.beqSeq]
+  | t0 :: a, t1 :: b => by
+      simp [Ty.beqSeq, Ty.beq_iff t0 t1, Ty.beqSeq_iff a b]
+termination_by a b => sizeOf a + sizeOf b
+decreasing_by all_goals (simp_wf; omega)
+
+theorem Ty.beqFields_iff :
+    (a b : List (String × Ty)) → (Ty.beqFields a b = true ↔ a = b)
+  | [], [] => by simp [Ty.beqFields]
+  | [], _ :: _ => by simp [Ty.beqFields]
+  | _ :: _, [] => by simp [Ty.beqFields]
+  | (n0, t0) :: a, (n1, t1) :: b => by
+      simp [Ty.beqFields, Ty.beq_iff t0 t1, Ty.beqFields_iff a b]
+termination_by a b => sizeOf a + sizeOf b
+decreasing_by all_goals (simp_wf; omega)
+
+theorem Ty.beqTags_iff :
+    (a b : List (FieldKey × Ty)) → (Ty.beqTags a b = true ↔ a = b)
+  | [], [] => by simp [Ty.beqTags]
+  | [], _ :: _ => by simp [Ty.beqTags]
+  | _ :: _, [] => by simp [Ty.beqTags]
+  | (k0, t0) :: a, (k1, t1) :: b => by
+      simp [Ty.beqTags, Ty.beq_iff t0 t1, Ty.beqTags_iff a b]
+termination_by a b => sizeOf a + sizeOf b
+decreasing_by all_goals (simp_wf; omega)
+
+end
+
+instance : LawfulBEq Ty where
+  eq_of_beq h := (Ty.beq_iff _ _).mp h
+  rfl := (Ty.beq_iff _ _).mpr rfl
+
+/-- Propositional equality of ground types is decidable. -/
+instance : DecidableEq Ty := fun a b => decidable_of_iff _ (Ty.beq_iff a b)
+
+/-- Whether `t` is a refinement node. The flattening invariant forbids one
+directly under another, so this is what `Ty.WF` checks of a base. -/
+def Ty.isRefined : Ty → Bool
+  | .refined _ _ => true
+  | _ => false
+
+/-- Mirror of `Type::refined`: `base` narrowed by `claims`, establishing both
+invariants. No claims is no refinement, and a base that is already refined has
+`claims` merged into its set rather than stacked on top. -/
+def Ty.mkRefined (base : Ty) (claims : List Pred) : Ty :=
+  match claims with
+  | [] => base
+  | _ =>
+    match base with
+    | .refined b ps => .refined b (ps ++ claims.filter (· ∉ ps))
+    | bare => .refined bare claims
+
+/-- Well-formedness the Rust builders maintain but the `Type` representation
+does not enforce: record fields and variant tags are keyed **uniquely**.
+
+The solver's find-first lookup makes this load-bearing: on a duplicate-keyed
+record, `constrain`'s trivial-equality short-circuit would accept `t <: t`
+while the record arm's find-first lookup would demand cross-subtyping between
+the duplicates — reflexivity-as-a-theorem (`Sub.refl`) is provable exactly
+under this invariant, which is the model naming an invariant the Rust leaves
+implicit. -/
+inductive Ty.WF : Ty → Prop where
+  | base (b) : Ty.WF (.base b)
+  | uintRange (n) : Ty.WF (.uintRange n)
+  | dataSource (s) : Ty.WF (.dataSource s)
+  | txn : Ty.WF .txn
+  | fn {n k d c} : Ty.WF d → Ty.WF c → Ty.WF (.fn n k d c)
+  | tuple {ts} : (∀ t ∈ ts, Ty.WF t) → Ty.WF (.tuple ts)
+  | record {fs} : (fs.map (·.1)).Nodup → (∀ f ∈ fs, Ty.WF f.2) →
+      Ty.WF (.record fs)
+  | variant {tags} : (tags.map (·.1)).Nodup → (∀ t ∈ tags, Ty.WF t.2) →
+      Ty.WF (.variant tags)
+  | refined {b ps} : ps ≠ [] → b.isRefined = false → Ty.WF b →
+      Ty.WF (.refined b ps)
+
+end CclFormal
diff --git a/formal/Main.lean b/formal/Main.lean
new file mode 100644
index 00000000..4b37e5db
--- /dev/null
+++ b/formal/Main.lean
@@ -0,0 +1,39 @@
+import CclFormal
+
+/-!
+# The M1 ground-subtype oracle
+
+Reads JSONL from stdin — one `{"lhs": <Ty>, "rhs": <Ty>}` object per line —
+and answers one verdict line per case: `true` / `false` (the model's
+`subCheck` under identity morphisms), or `error: …` when a line does not
+decode as a ground pair. An empty line (or EOF) terminates.
+
+The Rust half lives in `src/ccl/infer/solver/differential.rs`, which
+generates biased ground pairs, computes `constrain_subtype`'s verdict, and
+diffs against this oracle.
+-/
+
+open CclFormal
+
+def verdict (line : String) : String :=
+  match Lean.Json.parse line with
+  | .error e => s!"error: parse: {e}"
+  | .ok j =>
+      let checked : Except String Bool := do
+        let lhs ← Ty.fromJson? (← j.getObjVal? "lhs")
+        let rhs ← Ty.fromJson? (← j.getObjVal? "rhs")
+        pure (subCheck Ren.id Ren.id lhs rhs)
+      match checked with
+      | .error e => s!"error: decode: {e}"
+      | .ok b => toString b
+
+def main : IO Unit := do
+  let stdin ← IO.getStdin
+  let stdout ← IO.getStdout
+  while true do
+    let raw ← stdin.getLine
+    let line := raw.trimAscii.toString
+    if line.isEmpty then
+      break
+    stdout.putStrLn (verdict line)
+    stdout.flush
diff --git a/formal/README.md b/formal/README.md
new file mode 100644
index 00000000..93ab5e03
--- /dev/null
+++ b/formal/README.md
@@ -0,0 +1,20 @@
+# formal/
+
+The Lean 4 model of the CCL type system. Plan, milestones, and adjudicated
+decisions: [design.md](design.md).
+
+```bash
+cd formal
+lake build          # library (theorems + #guard spec examples) + the oracle
+```
+
+The toolchain is pinned by `lean-toolchain`; `elan` fetches it on first build.
+
+`lake build` also produces `.lake/build/bin/subverdict`, the M1 differential
+oracle. The Rust half is an ordinary unit test that skips (loudly) when the
+binary is absent:
+
+```bash
+cargo test differential_ground_subtype
+CAMBRA_DIFF_N=20000 CAMBRA_DIFF_SEED=7 cargo test differential_ground_subtype -- --nocapture
+```
diff --git a/formal/design.md b/formal/design.md
new file mode 100644
index 00000000..6c6b68b8
--- /dev/null
+++ b/formal/design.md
@@ -0,0 +1,223 @@
+# Formalizing the CCL type system in Lean
+
+This document is the plan of record for `formal/`: a Lean 4 model of the CCL type system, grown milestone by milestone, whose purpose is **catching real bugs** in the Rust implementation. Confidence in the metatheory and bug-catching are treated as the same goal: every layer of the model gets an executable form and a differential oracle against the Rust from day one. Proofs pin down the model; the oracle pins the model to reality.
+
+The implementation being modeled is the algebraic-subtyping engine described in [type-inference.md](../src/ccl/design/type-inference.md#1-algorithm-overview); the semantic model targeted by the final milestone is described in [mutability.md](../src/ccl/design/mutability.md#the-model-histories-and-causal-recursion).
+
+## The oracle stance: the model checks, it does not reproduce
+
+The central architectural decision. Monomorphization, simplification, and coalesce ordering make the Rust's inferred types non-canonical — demanding that a Lean model reproduce inference output bit-for-bit would drown the project in incidental divergence. Instead:
+
+- **Lean infers nothing; Lean checks.** The differential property is *admissibility*: whatever type the Rust inferred for a term, the Lean declarative system accepts that term at that type. This is exactly the soundness direction, it is robust to the solver choosing any of several valid types, and a failure is almost always a real finding — either a solver bug or a spec gap, both of which are the point.
+- The one place exact agreement is demanded is the **ground subtype relation** (no `Infer` variables on either side): `constrain(𝑇, 𝑈)` on ground types succeeds iff the Lean checker decides `𝑇 <: 𝑈`. A crisp boolean oracle, and it exercises the nastiest comparison code — `without_pi_names` α-handling, `Variant` width subtyping, refinement equality, `UIntRange`.
+
+Mechanically:
+
+- a `test-helpers`-gated Rust binary speaking a JSON encoding of `Type` / `TypedExpr` over stdin, answering subtype and typing queries;
+- a Lean executable (`lake` builds real binaries) as the checker;
+- case generation on the Rust side with `proptest`, so the generators can be biased toward the corners we already know are nasty (refinement predicates closing over Pi binders, shared sources, `case` payload binders);
+- the whole harness wired as an ordinary `cargo test`, so it rides `./ci.sh` like everything else.
+
+## Milestones
+
+Each milestone produces (a) Lean definitions and theorems, and (b) where marked, a differential oracle. Later milestones depend on earlier ones except where noted.
+
+### M0 — Types and the declarative subtype relation
+
+Grammar: `Base`, `UIntRange`, `Fun` (carrying the optional Pi binder), `Tuple`, `Record`, `Variant`, `Refinement` with syntactic-equality predicates. `FunKind` is included **in the grammar from the start** as a static two-point flag (`⇒` vs `⤇`) — kind *inference* waits for M5, but `⇒`/`⤇` distinctness affects type equality and subtyping now, and retrofitting a grammar field into a Lean development touches every proof while an unused constructor argument costs nothing.
+
+Deliverables:
+
+- the declarative relation `𝑇 <: 𝑈` — which does not exist in any standalone form today; the Rust operationalizes subsumption inside `constrain` without ever stating the relation it implements;
+- reflexivity and transitivity;
+- an executable checker with soundness and completeness against the relation (i.e. decidability);
+- the JSON codec matching the Rust `Type`.
+
+Merely stating the rules will force decisions the implementation currently makes implicitly. The questions raised at planning time are adjudicated below.
+
+Binder representation: **named binders with explicit rename environments**, not de Bruijn. This was revised on contact with the Rust: `Refinement` fixes the single reserved binder `__elem` (so refinement equality is bare structural equality, no α-renaming), and `constrain_go` compares dependent refinements after transporting them through the Pi-binder rename the codomain edge mints (`extended_rename`). A pair of rename environments that swap at contravariant edges mirrors that mechanism one-to-one; de Bruijn would be farther from the thing being modeled.
+
+#### M0 status and adjudicated decisions
+
+Landed: the lake project (toolchain pinned to v4.32.2), the ground grammar `Ty` + the `WF` (uniquely-keyed) invariant, the declarative relation `Sub`, the executable checker `subCheck` (termination proved), the hand-written JSON codec with round-trip guards, executable spec examples (one `#guard` per decision below), and `Sub.refl`.
+
+**Decidability is proved** (`CclFormal/Equiv.lean`): hand-written structural equality bridged to propositional equality (`Ty.beq_iff`, giving lawful `BEq`/`DecidableEq`), then checker soundness (`sub_of_subCheck`) and completeness (`subCheck_of_sub`), so `subCheck` decides exactly `Sub` and `Decidable (Sub ρl ρr lhs rhs)` is an instance. Every `#guard` in `Decide.lean` is thereby a fact about the relation, not merely about the checker.
+
+**Transitivity** is proved — `CclFormal/Transitivity.lean :: sub_trans`. The first statement covered the `NoPi` fragment (no function type carries a Pi binder) under a single ambient rename environment; the canonical generalization below subsumes it. Proof shape: fuel-bounded strong induction on the summed size, split into a *peel route* (some side carries a refinement layer → peel all three, recurse, re-wrap, with refinement-set containment composing by a membership chase) and a *head-constructor route*. The two ways to conclude a function edge are factored into one helper (`sub_trans_fn`) that takes the induction hypothesis explicitly, so `fnCompute` and `fnData` are handled once. `sub_peel_inv` carries the load: universal peel inversion — every rule leaves the peeled bases related and the peeled sets contained. `Decide.lean` pins one composed chain executably, whose two hops use different rules (the kind lattice, then contravariant record width).
+
+**Finding: α-variant dependent types split identity sites — the Pi binder is the last non-canonical identity.** Probed after the transitivity proof isolated Pi binders as the sole remaining obstruction. Two independently-derived, semantically-identical dependent types — `(𝑥: 𝐷) ⤇ {Int | __elem == 𝑥}` at one call site, the same under `𝑦` at another — are reconciled by the *relation* (both subtype directions hold, α-aware) but not by the *identities*:
+
+- **`SpecKey` splits** (`spec_key_splits_on_alpha_variant_dependent_types`). The key deliberately excludes the binder name, but the name survives through predicates that reference it, which the key compares structurally — so uses that should share a specialization get one clone each (over-splitting: wasted clones, not a miscompile, per `spec_key.rs`'s own taxonomy). Notably the key's stated rationale for excluding the name — per-site fresh solver binders "would split every use into its own key" — is re-imported through exactly this leak whenever such a binder is referenced by a keyed predicate.
+- **Bound merge is order-dependent and dangles** (`alpha_variant_bound_merge_is_order_dependent`). Two α-variant upper bounds meeting at a variable merge into a fun shape keeping the *first arrival's* binder (`compact.rs`: `a.name.or_else(|| b.name)`) while the refinement sets union — coalescing to `(𝑥: 𝐷) ⤇ {{Int | __elem == 𝑥} | __elem == 𝑦}`: arrival-order-dependent *and* carrying a predicate that references a binder the type no longer binds. The two predicates are α-copies of one constraint that structural dedup cannot collapse.
+
+This was the third member of the non-canonical-identity family (with the trivial-equality/find-first duplicate-key disagreement and refinement-layer order), and it is **repaired at the solver's flattening layer**: `compact_go` and `spec_key::key_go` now canonicalize every Pi binder to the reserved depth-indexed `Name::pi(depth)` (`__pi0`, `__pi1`, …) as types flatten, rewriting predicate references through the same substitution machinery that discharges dependent applications — `REFINEMENT_BINDER`'s move applied to arrows. Both pinned tests flipped to assert the repaired behavior (`spec_key_shares_alpha_variant_dependent_types`, `alpha_variant_bound_merge_is_canonical` — one binder, α-copies deduped to one layer, nothing dangling), and `Type::alpha_normalized` exposes the same form as a pure function for the recorded-vs-rebuilt asserts in `lambda_elim` (composed with `without_pi_names`, which retains its original `Some`-vs-`None` job). What this stratum deliberately does **not** change: `constrain` still α-reconciles source-named types mid-inference (emit still mints source binders), so the rename machinery there — and the model's `Ren` — remain faithful; retiring them was expected to need only a "minting-level stratum" (`emit_lambda` producing canonical binders), which **does not work** — see the footnote below.
+
+**Transitivity is now proved for the canonical fragment — pure at the identity environment** (`CclFormal/Transitivity.lean :: sub_trans` / `sub_trans_id`). The `NoPi` restriction is gone, subsumed as the all-binders-`none` special case of `Canon d` (the depth-indexed mirror of what `compact_go` emits: every arrow's binder absent or `__pi{d}`, codomains one deeper). The proof generalizes the induction to **six independent identity-acting environments** — a chain's premises arrive under their own environments and the conclusion is wanted under a third pair — and the σ-gap dissolves because a canonical chain only ever mints *diagonal* correspondences (`__piK ↦ __piK`), which preserve `IsId` (`codRen_canon_isId`); under identity-acting environments the refinement deficit is plain set containment (`deficit_isId_nil_iff`), so all six environments are interchangeable where it matters. No σ reconciliation morphism appears anywhere. The σ-generalization remains the honest statement for *non-canonical* (pre-coalesce, source-named) types, and stays, per the footnote below.
+
+**What the dependent case needs — the σ-gap.** Transitivity for Pi-bearing non-canonical types is not proved, and the obstruction is precise. Chaining two function edges gives codomain premises under `codRen 𝑛₀ 𝑛ₘ ρl`/`ρm` and `codRen 𝑛ₘ 𝑛₁ ρm`/`ρr`, while the conclusion needs `codRen 𝑛₀ 𝑛₁ ρl`/`ρr`: the premises disagree about the **middle view** of `𝑦`'s codomain (`ρm` vs `ρm.extend 𝑛ₘ 𝑛₁`). They compose only through the rename `σ = [𝑛ₘ ↦ 𝑛₁]` relating those views, giving the generalized statement `Sub ρl ρm 𝑥 𝑦 → Sub (σ ∘ ρm) ρr 𝑦 𝑧 → Sub (σ ∘ ρl) ρr 𝑥 𝑧` — which is exactly the reconciliation `constrain.rs :: bridge_holder_gap` performs when two bounds recorded under different morphisms meet at one variable. The implementation already invented this step; the metatheory needs the same one, plus the freshness discipline the Rust gets for free from globally-uniquified `Name`s (Barendregt) and never states.
+
+**The grammar carries a claim set, and claim order is proved unobservable.** `refined` holds a `List Pred`, mirroring `Type::Refinement(base, RefinementSet)`, with `Ty.WF` naming the same two invariants `Type::refined` establishes: the claims are non-empty, and the base is not itself refined, so layers never nest. `Canon` carries the non-emptiness too — an empty claim set is not a refinement but its base, and the flattening layer never emits one; without that, a degenerate `refined 𝑏 []` would peel to nothing while remaining a distinct term and `peel_nil_self` is simply false.
+
+The claims are *represented* as a list and `Ty.beq` compares them positionally, which is what keeps `beq` propositional equality and so keeps `DecidableEq` — the bridge every proof here rests on. What makes that faithful to an unordered `RefinementSet` is that the **relation** cannot see the list structure, and that is now a theorem rather than a reading of the rules: `sub_claims_left` / `sub_claims_right` (widening the supplied claims, narrowing the demanded ones) and their corollaries `sub_claims_perm` / `sub_claims_perm_right`. They are stated as *containment* rather than permutation because containment is what `deficit` actually uses — a supplier list may be reordered, duplicated, or widened freely — so reorder- and dedup-invariance both fall out, which is exactly the latitude the Rust representation takes.
+
+All prior results are re-established sorry-free over the new grammar: `Sub.refl`, `subCheck` soundness/completeness and `Decidable (Sub …)`, and `sub_trans` / `sub_trans_id` for the canonical fragment.
+
+**Base of record.** The model mirrors `constrain_go` as of the stack this branch sits on: `main` plus canonical Pi binders at the flattening layer, the claim-set refinement representation, and canonical cast discharge. The differential harness is what holds that correspondence, so a divergence is a test failure rather than a doc claim.
+
+**Grammar exclusions.** `Infer`, `SharedHole`, `History`, `ChanDom`, `App`, `Below`, and `FunKind::Var` are all inference-time transients or unknowns — outside the ground fragment by the same criterion that keeps them out of a fully-inferred program's types.
+
+**Adjudications** (each is a `Sub` rule with a matching `#guard` in `CclFormal/Decide.lean`):
+
+- **`UIntRange` is equality-only.** No range inclusion, no `UIntRange <: Int` — a range is a data domain (a loop bound), and the solver treats it nominally. `[0,3) ⊀ [0,4)`.
+- **Refinements** (`𝑆ᵢ` a claim *set*, per `RefinementSet`): `{𝑏₁ | 𝑆₁} <: {𝑏₂ | 𝑆₂}` iff `𝑆₂ ⊆ 𝑆₁` (structural, type-blind predicate equality, after transport through each side's rename — never implication) and `𝑏₁ <: 𝑏₂`. So dropping refinements is subsumption, conjuring one is not (that is an explicit `Restrict`), and the **base is covariant**.
+- **Refinements do not distribute over `Variant`** (or anything else): they are compared layer-wise where they sit; the peel is only of *outer* layers on both sides.
+- **Function kinds form the lattice `data ⊑ compute`**: a data function satisfies a compute demand, never the reverse. Kind subtyping, not kind equality.
+- **Domains**: contravariant, except **data-data pairs are invariant** (both directions — the domain *is* the data). Codomains covariant, under the Pi-binder correspondence extended onto the **lhs** rename.
+- **Products/sums**: tuple positional width; record named width with **find-first** lookup; variant is the dual (lhs tags looked up find-first in rhs). Payload depth covariant throughout.
+- **Reflexivity is a theorem, not a rule** (`Sub.refl`) — the model omits `constrain_go`'s trivial-equality short-circuit and proves it derivable. The proof requires `Ty.WF` (unique record/variant keys): on a duplicate-keyed product the short-circuit and the find-first arms genuinely disagree, so the model names a builder invariant the Rust leaves implicit.
+
+- **A `Variant` domain relates only to a `Variant` domain.** No rule collapses a `Variant` of refined legs to the domain they share, because no comparison presents that pair: a value-`Case` fan-out is a `DisjointJoin` over the one domain its arms share ([ir.md](../src/ccl/design/ir.md#copair-and-disjointjoin--two-collection-combining-operations-not-one)). The rule that used to exist, and the two defects it carried, are the closed finding below.
+
+**Footnote — canonicalization cannot move earlier than flattening.** The rule and the alternatives measured against it are recorded in the Rust design doc: [type-inference.md](../src/ccl/design/type-inference.md#canonicalizing-a-pi-binder-needs-a-position-so-it-happens-at-flattening), "Canonicalizing a Pi binder needs a position, so it happens at flattening". Two consequences for this model. `constrain`'s binder correspondence keeps doing real work, so the model keeps `Ren`. And `Type` equality is not α-invariant before coalesce, so a site comparing types as *identities* across that boundary normalizes both sides explicitly (`lambda_elim` does; forgetting is silent — the same family as the refinement-layer-order bug).
+
+An earlier revision of this footnote proposed indexing binders from the inside out, so that an index is fixed within a binder's own subtree and survives wrapping, and claimed that would let emit mint canonical binders and collapse the Fun/Fun arm's `extended_rename` to the identity. That is refuted: wrapping is not the obstruction. A dependent refinement rides a bound edge, and the variable holding it need not sit under the binder its predicate references — every group-by produces that shape — so there is no index to write under either direction of counting. The unpositioned edge is the obstruction, and flattening is where it ends.
+
+**Finding (closed): ground subtyping was not transitive while a rule related a partitioned domain to a plain one.** The chain `⧺{𝐷|π} ⤇ 𝑊 <: 𝐷 ⤇ 𝑊 <: 𝐷′ ⇒ 𝑊`, with `𝐷′ <: 𝐷` strictly by record width, held hop-by-hop while the direct edge failed: the rule demanded the stripped legs equal the stripped *target* structurally, so widening the target turned it off and no general arm relates a `Record` domain to a `Variant` one. Whether a partition satisfied a demand therefore depended on whether an intermediate plain binding sat in between — typing that can depend on constraint order. Evidence in three forms: a machine-checked counterexample, a pinned Rust test, and the chain fuzz (~100k accepted chains, ~285 violations, every one that shape). The same rule recursed its codomain edge under the unchanged lhs morphism, so α-equivalent dependent codomains reconciled through the general function arm and failed through this one — the verdict turned on domain shape alone.
+
+Splitting `CollectionUnion` into `Copair` and `DisjointJoin` closed both defects by deleting the rule. The fan-out was its sole producer, and a `DisjointJoin` carries the arms' shared domain directly, so the pair the rule existed to relate no longer reaches a comparison. The model states the absence as a departure (`Sub`'s module doc), pins the verdict in `Decide.lean`, and the differential harness holds it: 90k pairs across three seeds agree with `constrain` after the removal, and the chain fuzz reports zero violations over 90k chains.
+
+**Tracked divergences and observations:**
+
+- **`Subst::extended_rename` shadowing** is modeled as prepend-with-first-match-wins; confirming that against the Rust's composition semantics is an M1 fuzz target.
+- `formal/` is not yet wired into `./ci.sh` — that adds a Lean toolchain dependency to everyone's gate, so it is a deliberate pending decision, not an oversight.
+
+### M1 — Ground-subtype differential fuzz *(oracle)*
+
+The M0 checker vs `constrain` on ground type pairs. The cheapest real-bug detector in the whole plan.
+
+#### M1 status
+
+Landed and running. The pieces:
+
+- **Oracle**: `lake build` produces `subverdict` (`formal/Main.lean`), which answers `true`/`false` per JSONL `{"lhs", "rhs"}` line using the model's `subCheck` under identity morphisms.
+- **Harness**: `src/ccl/infer/solver/differential.rs`, an ordinary solver unit test (unit tests see `constrain_subtype` directly — no public-API churn). It skips loudly when the oracle binary is absent, so machines and CI without a Lean toolchain stay green. Knobs: `CAMBRA_DIFF_SEED` / `CAMBRA_DIFF_N`.
+- **Generation**: a hand-rolled seeded xorshift generator — deterministic and dependency-free (`proptest` was planned; a new dev-dependency wasn't warranted for this). Three pair modes: identical pairs (exercises the claim that reflexivity is derivable), top-level directed edits (width/refinement near-misses), and **correlated pairs** — both sides built together, usually identical, occasionally diverging in exactly one nested aspect (a leaf, a kind flag, a binder name, a predicate target, a width). Deep near-misses are where subtle rule divergence hides. Dependent refinements are generated referencing each side's *own* Pi binder, so the α-correspondence (`extended_rename` vs the model's `Ren`) is exercised at every nesting depth, shadowing included.
+- **Emitter**: `Type` → the wire schema of `formal/CclFormal/Json.lean`, total on the ground fragment, refusing (not mis-serializing) anything outside it or outside the `Pred` vocabulary.
+
+Results at the time of writing: **~800k cases across nine seeds, zero verdict mismatches**, plus **140k across five seeds after the claim-set grammar landed** (the wire schema's `refined` node now carries a `claims` array, and the generator's nested refinements flatten into multi-claim positions, so the new shape is exercised throughout), plus **90k across three seeds after the partition-collapse rule was retired from both sides**. Verdict mix is roughly 42–44% accept, so both classes are exercised. Harness sensitivity is tested rather than assumed: the duplicate-keyed-record reflexivity case — the one known deliberate divergence, outside `Ty.WF` — flags as a mismatch when fed through the pipe by hand, and `constrain_go` now **asserts** the uniquely-keyed invariant in debug builds, before its trivial-equality short-circuit — the only placement that covers `𝑡 <: 𝑡`, the case the short-circuit and the find-first arms answer differently — so the type they disagree on can no longer reach the comparison unnoticed (`dup_key_record_trips_the_uniquely_keyed_invariant` pins that the assert fires). The `extended_rename` prepend-shadow assumption listed above is now empirically backed by the fuzz (within the generated vocabulary: two binder names, arbitrary nesting, deliberate misaims).
+
+The generator's one exclusion is duplicate record/variant keys (outside `WF`) — a documented gap, not a silent one.
+
+### M2 — Terms, typing, and safety
+
+Declarative typing `Γ ⊢ 𝑒 : 𝑇` for the pure core — λ, apply, compose, let, literals, tuples/records, variants, `case`, refinements — plus a small-step semantics, and **progress + preservation**. Two corollaries earn their keep against known bug classes:
+
+- **Refinement soundness**: `⊢ 𝑒 : {𝑇 | 𝑝}` and `𝑒 ⇓ 𝑣` implies `𝑝(𝑣) ⇓ true`. The theorem form of "a refinement is a fact about a value", and the property the literal-singleton-types work leans on.
+- **Case-binder preservation**: the `case` payload binder retains its scrutinee-derived bound through reduction. A previously-observed defect — the wildcard `case _:` arm's payload binder losing its scrutinee bound — is precisely a counterexample to a lemma of this shape; retroactively rediscovering that known bug is the calibration test for the whole model.
+
+#### M2 status and adjudicated decisions
+
+Landed: the definitional core (`CclFormal/Term.lean`) — the pure-core term grammar `Tm` (lit, var, λ, apply, let, tuples, projection, variants, `case`, `cast`), values, capture-free substitution, partial predicate evaluation (`Pred.eval`, the interpreted `BinOpKind` vocabulary), the call-by-value small-step `Step`, the *filter-blocked* judgment `Blocked`, and the declarative typing `HasTy Γ e T` with subsumption via the M0 `Sub` relation. Sanity theorems: values neither step nor block. Adjudications, on contact:
+
+- **Terms are de Bruijn; types keep named Pi binders.** Subtyping never moves a binder (names-with-renames mirrored the Rust exactly); reduction duplicates and re-scopes binders, where names buy only α-obligations — and the Rust's term binders are uniquified, hence α-irrelevant. The M3 bridge maps uniquified names to indices mechanically.
+- **Non-dependent fragment first** (`Pred.elemOnly`): predicates over `__elem` only, so types are closed under term substitution — the same fragment the transitivity proof covers (`NoPi`); the dependent extension rides with the Pi-binder thread.
+- **`cast` checks its claims; progress is modulo filtering.** A cast is CCL's refinement introduction (a filter's lowering), and its runtime face (`Restrict`) *drops* elements. The small-step mirrors this: `cast` passes a value through exactly when every claim evaluates true, else the term is `Blocked` — the scalar face of a dropped row. Progress will read "value, steps, or filter-blocked"; refinement soundness holds because the cast is the only door into a refined type.
+
+Landed second (`CclFormal/Safety.lean`, sorry-free): the full safety battery — weakening and the substitution lemma (the de Bruijn payoff: no value restriction, no fragment hypothesis, types untouched by term substitution), canonical forms modulo refinement peeling (`canonical_fn`/`canonical_tuple`/`canonical_variant`), **progress** (`HasTy [] e T` → value ∨ steps ∨ filter-blocked), **preservation**, multi-step preservation, **refinement soundness** (`⊢ e : {T | claims}` ∧ `e ⇓ v` → every claim evaluates true on `v`), and `case_binder_sound` (the tag-arm case-binder statement). Structural choices and further adjudications, on contact:
+
+- **`Sub` inversions are case analyses, not inductions.** Every `Sub` constructor pins both sides' head constructors and the `refined` arm recurses on fully-peeled bases, so `Sub.to_peel` plus one non-recursive `cases` per head (`fn_src`/`fn_inv`/`tuple_inv`/`variant_inv`) is the whole inversion story — none of transitivity's machinery.
+- **Typing inversions absorb subsumption chains by *typing transport*, not `Sub` composition.** Inverting a derivation ending in `sub` would otherwise need transitivity of `Sub` (M3b's open problem). `HasTy.lam_inv` instead returns implications "whatever is typed at `X` is typed at `Y`" (`TyImp`) — reflexive without `Sub.refl`'s `WF` side condition, composable link-by-link, each link entering typing via `HasTy.sub` after `Sub.rename_invariant` brings its morphisms back to identity.
+- **The fragment is enforced in the judgment** (`Ty.TermFrag` premises on the rules that choose types freely: `lam`'s domain, `variant`'s tags, `sub`'s target, `caseE`'s result — the last free only in the degenerate empty-tags elimination). Hypothesizing the fragment only at the theorem boundary cannot confine a derivation's *internal* types, since `sub` detours through arbitrary types, and one preservation counterexample lives on such a detour: the codomain edge's `codRen` α-moves a dangling `Pred.var`, a modeling artifact since the model does not scope predicate variables, and `elemOnly` excludes it. `hasTy_frag` is the invariant, stated: under a fragment context every derivable type is in the fragment.
+- **`refineV` — checked values inhabit the refinement.** Preservation forces a value-level refinement introduction: `cast p v` (claims holding) steps to `v`, and `Sub` deliberately forbids refinement conjuring, so without a new rule `v` loses its refined typing and preservation is false at `castV` for every cast. `refineV` types a value at `{T | claims}` when `claimsHold claims v = true` — the term-model face of "a refinement is a fact about a value" (the literal-singleton-types thread), and exactly the knowledge the `castV` step validates at runtime.
+- **Case-binder calibration deferred with the wildcard extension.** `case_binder_sound` is the *naive tag-arm* statement, and it is a theorem — as it should be: the Rust's `case _:` payload-binder defect lives in wildcard arms, which `Tm.caseE` does not yet have. The calibration (the defect refuting the naive wildcard statement) needs that modeling extension, recorded in `Term.lean`'s module docs as a later increment.
+
+**Finding (closed): partition collapse fired at compute kind, where it broke preservation under the tagged-value reading of `Variant`.** The collapse applied at any kind, which is sound when the variant `⧺ᵢ({𝐷 | π̂ᵢ})` in domain position describes untagged pieces of a collection. A `variant` type in the term calculus means tagged values, and under that reading the collapse licensed a preservation violation at beta: `λ 𝑥 : 𝑃 → …` typed at `𝑃 ⇒ 𝑐` (`𝑃` a single-leg partition of `Int`) retyped via the collapse to `Int ⇒ 𝑐`, so `5` flowed in and substituted a bare literal where the body expects a variant, and `lit 5` has no typing at `𝑃`. Rust-side soundness rested on an invariant nothing stated: index-contiguous same-base variants are fan-out descriptors, never value-variant types a `case` or variant construct produces — `Variant` was two concepts told apart by a tag convention. Deleting the collapse resolves both halves: the fan-out builds a `DisjointJoin` over its arms' shared domain and never puts a partition-shaped variant in domain position, so `Variant` carries only the tagged-value reading and `Ty.TermFrag` needs no condition excluding partitioned `fn` domains.
+
+Remaining under M2, recorded: `compose`, records, wildcard `case` arms (the calibration), and the dependent-fragment safety extension (waits for the discharge machinery; see M3b's note).
+
+### M3 — Typing oracle *(oracle)*
+
+The Rust dumps the typed AST for generated small programs; Lean checks admissibility of the root typing. This is where the model starts catching *inference* bugs rather than comparison bugs.
+
+### M3b — Dependent-fragment transitivity: canonical first, α-aware as a bug hunt
+
+The transitivity proof covers the `NoPi` fragment; a Pi binder makes predicate identity *relative*, and extending the proof through it splits into two pushes with different purposes:
+
+- **Canonical-fragment transitivity** *(the near-term step, in progress)*: state transitivity for types whose Pi binders are canonical (`__pi{n}` by depth — `Subst::canonical_pi_binder`'s output). At a fixed comparison position all three types share depth context, so the position-relativity that refuted *minting-level* canonicalization is harmless: canonical binders are equal, the rename environments are identity, and predicates compare structurally — the proof is the `NoPi` development plus a `CanonPi` invariant carried through peel and normalization. This validates the discipline the Rust actually relies on: every comparison that *chains* (compaction onward) happens post-canonicalization.
+
+- **α-aware transitivity** *(this milestone's main body — deliberately framed as a bug hunt)*: the full statement, with rename-environment composition through the middle type. The load-bearing pieces: a composition lemma for the rename pairs (which forces stating the injectivity/freshness invariants the environments actually need), claim-set containment *modulo rename* threaded through the peel route's membership chase (`sub_peel_inv`, `sub_claims_left/right` generalize from structural equality to equality-under-ρ), and the fn-route helper gaining the binder-extension case. This is a multi-session push and the route most likely to find real defects: the `NoPi` transitivity attempt found the partition-collapse defect this way, and the known α-smells (first-arrival binder in bound merges, predicates referencing a binder the type no longer binds; both recorded under M0) live where this proof has to tread. A failure to prove is a finding, not a setback.
+
+Sequencing: after M3, because the typing oracle gives the α-machinery a second consumer (admissibility checks exercise `without_pi_names` / `extended_rename` against real trees), and any rule gap the proof exposes then has an executable reproduction path. The M2 *safety* extension to dependent types (type-level substitution — the §6.2 discharge, proposal O8) is a separate lift that waits for the discharge machinery to be modeled; it is tracked under M2, not here.
+
+### M4 — The solver model
+
+`constrain` / coalesce modeled as a state monad over a store of variables with bound lists, fuel-based at first. Two theorems:
+
+- **Soundness**: every bound the solver records is derivable in the declarative `<:` — and the coalesced output type is admissible for the term (connecting M4 back to M2).
+- **Termination**: replace fuel with a well-founded measure. Prioritized because it is the property with live field bugs (a hanging build in this repo is, as a working rule, solver non-termination). The measure has to account for the seen-cache *and* for `extrude` minting fresh variables; being forced to articulate it will either yield a proof or expose that termination is currently contingent on something unstated.
+
+Levels and extrusion enter the model here (scope-escape soundness is a natural third theorem, but is subordinate to the two above).
+
+#### M4 preview: solver order-independence (confluence) fuzz
+
+Landed early, Rust-side only (`src/ccl/infer/solver/confluence.rs`), because it targets confluence claims the code makes without tests: `KindMerge`'s "forces propagate transitively along links as they arrive, so ordering does not matter", and the one-sided var-var bound propagation recorded as an open question in [type-inference.md](../src/ccl/design/type-inference.md#1-algorithm-overview). The harness applies the same constraint *set* (ground bounds, var-var edges, kind-variable functions) in permuted orders against fresh variables, coalesces every variable, and asserts outcomes agree — where an outcome is acceptance (through coalesce) plus the canonicalized per-variable types. *Which* constraint trips the rejection of an unsatisfiable set is intrinsically order-relative under record-then-sweep and deliberately not part of the outcome.
+
+**Finding (repaired): refinement layers stacked in constraint arrival order — the representation served three incompatible views.** Two refined upper bounds meeting at one variable coalesced to `{{𝑇 | 𝑞} | 𝑝}` or `{{𝑇 | 𝑝} | 𝑞}` depending on which arrived first (≈1 in 10k generated sets). Subtyping was indifferent — the deficit machinery compares layers as a set — but `Type`'s derived `PartialEq` was order-sensitive, and structural equality is load-bearing where types are *identities*: the trivial-equality short-circuit, cache keys, and recorded-vs-recomputed walls. One `Vec` served a *set* to subtyping, a *stack* to planning (the outermost layer drove which restrict it materialized), and an *identity* to `SpecKey`/caches.
+
+**The repair is the representation, not a canonical order.** `Type::Refinement` now carries a `RefinementSet` — an unordered, deduplicated set with set-semantic `Eq`/`Hash` — and `Type::refined` flattens, so nested `{{𝑇 | 𝑝} | 𝑞}` is *unrepresentable* and "which layer is outermost" cannot be asked. Canonically sorting the `Vec` was tried twice and rejected: it pins the ambiguity instead of deleting it, it costs a total order over predicate terms whose only job is layout, and it denies planning the freedom to apply filters in whatever order a cost model prefers.
+
+One thing the change forced into the open, previously implicit:
+
+- **Materializing claims is a pipeline, and a pipeline is ordered.** Planning emits one `restrict` per claim, and stage 𝑘 reads elements already narrowed by stages 1..𝑘-1 — so a claim's predicate is typed against the base *narrowed so far*, not the bare base. The set is unordered as a fact; planning *chooses* an application order. Which order is free; choosing differently in two places is not, so `ccl::application_order` is the single place the choice is made and both `wrap_with_iterate` and `compile_predicates_in_type` walk it.
+**Finding (closed): claim dedup was order-sensitive because passes made a cast's claims route-dependent.** The mechanism, found by structural diff of the surviving twins: `coalesce_node` **overwrote a `Cast`'s `target` wholesale with the occurrence's coalesced view** (`expr.ty`) — and *which* claims an occurrence's variable accumulates depends on the route bounds took through the graph, so two copies of one embedded cast (a comprehension source cloned into a filter predicate) could end up carrying different claim sets: one bare, one decorated with a sibling layer's filter. Refinement equality — deliberately cast-target-aware — then refused to dedup them. The repair is **canonical discharge as a term-determined rule** (`canonical_cast_ty`): a cast's *target* keeps exactly its **born claims** (the assertion, fixed when the cast was written — inference resolves its bases, never rewrites its claims), and the node's *type* is the value's own domain claims joined with them (what the assertion yields on this value; the walk is bottom-up, so the value's type is already canonical by induction). The two must stay distinct: the post-inference check recomputes a cast's type as value-claims ∪ target-claims, so a target that also carried the value's claims would double-book them. Planning's claim-application order was made content-determined in the same stroke (`application_order` sorts by rendered predicate), so the built pipeline no longer leaks the set's physical order.
+
+The residue that outlived the coalesce fix had the **same overwrite surviving in the rebuild passes**: `sync_cast_targets` (at the tails of `lambda_elim::run`, `planning::run`, and inlining) stamped each cast's rebuilt `expr.ty` over its `target`. The rebuilt type is derived from surrounding term structure — and where inference leaves route-dependent types in *eq-blind* slots (a lambda param annotation inside a still-pointful predicate, say), that re-derivation is route-dependent too, so the sync promoted a benign divergence into the one slot refinement equality compares. Chain of custody for the last reversed failure: `simplify`'s collapse-a-chain-to-its-single-element rule stamped the chain's (route-dependent) interface type onto a surviving cast → `sync_cast_targets` copied it into the target → planning's per-claim compile embedded the now-divergent cast into two copies of one claim → the post-planning wall's value ∪ target union met twins that would not dedup. Repairs, all instances of the same rule (a rebuild pass resolves bases, never decides claims): the collapse rule restores the canonical cast type at construction; `sync_cast_targets` is retired in favour of `canonicalize_cast_types` (target = born claims on the rebuilt view's bases; type = value-claims ∪ born; a chain headed by a cast follows its head's domain when they differ only in claims); a cast target's claims compile against the **value's domain** (the assertion base — matching the checker, which types target predicates with `__elem` bound at the value's domain), not the target's bare base. With these, the full suite is green under `CAMBRA_REFINEMENT_ORDER=reverse` — the first fully order-independent state — and the sweep diagnostic (collect every claim tree-wide, group by render, compare eq-classes) reports zero divergent render groups at every stage.
+
+**Finding (superseded by the above): claim dedup is order-sensitive, because refinement equality distinguishes vintages that rendering does not.** The representation change removes order from the *type*; it does not reach predicate *identity*. `eq_refinement_predicate` deliberately compares a cast's target predicate, so the vintages a dependent-application discharge mints — `𝑝(xs)`, `𝑝(cast(xs))`, … — are unequal and do not dedup, while rendering identically. Running the suite under `CAMBRA_REFINEMENT_ORDER=reverse` (the order-stress knob shipped with the set) exhibits it: a claim set grows a second copy of one restriction and a recorded type disagrees with its recomputation while printing the same. Pinned as `vintage_claims_render_alike_but_do_not_dedup`. This is the **canonical discharge** question below — are two vintages the same refinement? — now with a reproducible exhibit rather than an inferred risk.
+
+So the blocker was a **predicate-identity question**, not an ordering mechanism: are two vintages of one refinement the same refinement? Vintage-blind equality (peel embedded casts before comparing) is non-transitive as stated (`xs ≡ cast{𝑎}(xs)` and `xs ≡ cast{𝑏}(xs)` but `cast{𝑎}(xs) ≢ cast{𝑏}(xs)`) and was implicitly rejected by the pinned test `refinement_eq_distinguishes_cast_target_predicates`; full transparency (ignore casts *and* their targets) is transitive but conflates semantically distinct embedded collections. The **ruling that landed is canonical discharge by term-determination** (the closed finding above): equality keeps distinguishing genuinely different cast targets — that behaviour is correct and stays pinned (`vintage_claims_render_alike_but_do_not_dedup` remains as the exhibit of *why* the slot is semantic) — and the pipeline no longer *manufactures* divergent vintages of one claim, because no pass may decide a cast's claims from route-dependent context.
+
+With the representation change the quarantine is gone — the fuzz compares coalesced outcomes directly, no layer-order normalization in front of it: **100k constraint sets × 8 permutations across seeds, zero violations** — acceptance, coalesced structure, and kind-var resolution are confluent within the generated vocabulary.
+
+#### M4b — the merge algebra *(landed early, proofs)*
+
+`CclFormal/Merge.lean` models the ground fragment of `compact.rs`'s bound-merging — `CTy` mirrors `CompactType` (atoms, the optional keyed maps with the load-bearing `None` vs `Some(empty)` distinction, the function slot, the claim set, an error flag), `merge` mirrors the polar `CompactType::merge`/`CompactFun::merge`, and `eqv` mirrors `CompactType`'s `PartialEq` (set-semantic at every layer). The dedup gate in the positive `Data ⊔ Data` arm is `eqv` itself, exactly as `union_domains` dedups with `PartialEq` — which is what makes the whole algebra quotient-compatible. Adjudications (recorded in the module docs): inference variables, history slots, the Pi binder (canonicalized to agreement by `canonical_pi_binder` before any merge sees it), and error payloads are dropped; domain alternatives beyond one are `none` ("many"), sound because every path that could read a second alternative ends in a coalesce error — **if Σ ever materializes multi-domain joins this adjudication must be revisited**. There is deliberately no identity element: `compact_go` folds from the first bound because an empty claim set is absorbing under the positive intersect.
+
+Proved, sorry-free:
+
+- **`eqv` is an equivalence relation** (`eqv_refl`/`eqv_symm`/`eqv_trans`), with maps read pointwise through `lookup` so shadowed duplicate bindings are unobservable (mirroring `BTreeMap`).
+- **Commutativity** (`merge_comm`) — unconditional, both polarities.
+- **Idempotence** (`merge_idem`) — under `wf`, the input-bound invariant (no `conflict` kinds, one domain per function slot), which is what `compact_go` builds from any `Type`. It genuinely fails off the invariant.
+- **Congruence** (`merge_congr_left`/`_right`/`merge_congr`) — merging respects `eqv`; holds *because* the gate is the same equality.
+- **Associativity on the compute-free fragment** (`merge_assoc_cf`) — all function bounds `Data`.
+- **Fold invariance** (`foldMerge_perm`, `foldMerge_dup`): on compute-free bounds the positive fold is invariant under permutation and duplication of the bound list — the algebraic statement behind the confluence fuzz's "outcomes agree under permuted constraint orders", proved rather than sampled.
+
+**Finding (open, needs Rust-side validation): associativity fails in general — the mixed-kind arm makes arrival order decide accept-vs-reject.** `merge_not_assoc` (with the readable exhibits `merge_mixed_left_conflicts` / `merge_mixed_right_accepts`): at one position, two `Data` function bounds over structurally distinct domains and one `Compute` bound merge to `Conflict` in one association — the multi-domain data side meeting a compute side has no honest upcast — and to an accepted `Compute` meet in another, where each step pairs a single-domain data side with the compute side. `compact_go` folds bounds in arrival order, so if a real program can place these three bounds on one variable, which *order* the constraints arrived in decides whether coalesce errors. The confluence fuzz has not covered this shape (its generator's vocabulary does not mix function kinds over distinct domains at one var); extending it — and determining whether `constrain_go`'s kind links already prevent the state — is the Rust-side follow-up. Until then the fold theorems are stated on the compute-free fragment, where the arm cannot fire.
+
+### M5 — Σ types and `FunKind` inference
+
+The recent machinery, added to the M0–M4 model: kind variables resolved at coalesce ([type-inference.md, "4.6 Data vs compute functions"](../src/ccl/design/type-inference.md#46-data-vs-compute-functions)), Σ formation over candidate domains, and the witness discipline — **one value = one witness**, arms α-converted onto the value's witness (adopt if unanimous, mint on disagreement, sticky), with the join deferred to compaction. That invariant was established only after a constraint-time-join defect was root-caused at some expense; it is exactly the kind of subtle, recently-hand-verified argument worth freezing as a theorem before the next refactor disturbs it.
+
+### M6 — Histories: the mutability semantic model
+
+Independent of M4/M5; can start any time after M2 if the mutability workstream heats up first. This is a *semantics* model, not a typing model — the transient variants (`History`, `ChanDom`, `Hole`, `Infer`) are pipeline artifacts and deliberately stay **out** of the typing calculus.
+
+Model histories as functions `𝐷 ⇒ 𝑉` per [mutability.md, "The model: histories and causal recursion"](../src/ccl/design/mutability.md#the-model-histories-and-causal-recursion):
+
+- `Overwrite` = last-write-wins merge with carry-forward at off-path positions;
+- `Append` = the append law, no carry-forward;
+- `Txn` reads are arbitrary as-of reads — there is deliberately no terminal/"final value" read in the model, matching [mutability.md, "Semantics"](../src/ccl/design/mutability.md#semantics).
+
+Headline theorem: the `letrec`/`transact` realization emitted by `mut_elim` / `plan_loops` denotes the same function as a direct imperative semantics of the surface program.
+
+## Non-goals
+
+- **Principality.** Dolan-style principality proofs are thesis-scale, and monomorphization means principal types are not shipped anyway.
+- **Verifying the Rust directly.** Rust→Lean translation (Aeneas) handles interior mutability and shared graphs worst of all fragments, and the solver core is `Rc<RefCell<InferVar>>`. Not planned around.
+- **Reproducing inference output.** Per the oracle stance above: admissibility, not identity (ground subtyping excepted).
+
+## Keeping the model honest
+
+- `formal/` lives in-repo as a `lake` project with a pinned `lean-toolchain`; CI runs `lake build` plus the differential suite.
+- The contract: **a semantic change to `constrain` / coalesce either updates `formal/` in the same change or documents the divergence in the PR.** Solver code implementing a modeled rule cites the Lean declaration by name; the doc-refs discipline extends to these citations.
+- The differential harness is the enforcement mechanism of last resort: even when proofs lag behind, the executable model diverging from the Rust fails CI.
diff --git a/formal/lake-manifest.json b/formal/lake-manifest.json
new file mode 100644
index 00000000..82c84d22
--- /dev/null
+++ b/formal/lake-manifest.json
@@ -0,0 +1,6 @@
+{"version": "1.2.0",
+ "packagesDir": ".lake/packages",
+ "packages": [],
+ "name": "CclFormal",
+ "lakeDir": ".lake",
+ "fixedToolchain": false}
diff --git a/formal/lakefile.toml b/formal/lakefile.toml
new file mode 100644
index 00000000..fbcc8fd7
--- /dev/null
+++ b/formal/lakefile.toml
@@ -0,0 +1,12 @@
+name = "CclFormal"
+defaultTargets = ["CclFormal", "subverdict"]
+
+[[lean_lib]]
+name = "CclFormal"
+
+# The M1 differential oracle (see Main.lean). `lake build` produces
+# .lake/build/bin/subverdict, which the Rust harness
+# (src/ccl/infer/solver/differential.rs) spawns.
+[[lean_exe]]
+name = "subverdict"
+root = "Main"
diff --git a/formal/lean-toolchain b/formal/lean-toolchain
new file mode 100644
index 00000000..0ec5999c
--- /dev/null
+++ b/formal/lean-toolchain
@@ -0,0 +1 @@
+leanprover/lean4:v4.32.2
diff --git a/src/ccl/ccl_utils.rs b/src/ccl/ccl_utils.rs
index 4f2e13f7..aff8f8bf 100644
--- a/src/ccl/ccl_utils.rs
+++ b/src/ccl/ccl_utils.rs
@@ -7,7 +7,8 @@ use std::rc::Rc;
 use crate::ccl::scope::{ScopedItem, for_each_scoped_item};
 use crate::ccl::{
     BaseType, BinOpKind, Branch, Builtin, Expr, F_FIRE_SUFFIX, F_WRITES, FieldKey, Lit, LogicKind,
-    Name, PredicateId, Refinement, Type, TypedExprNode, UnaryOpKind, V_ABORT, V_COMMIT,
+    Name, PredicateId, Refinement, RefinementSet, Type, TypedExprNode, UnaryOpKind, V_ABORT,
+    V_COMMIT,
 };
 
 /// The `commit` selector field of the **intermediate** decision record the two
@@ -285,12 +286,14 @@ pub(crate) fn debug_assert_no_iteration_markers_in_type(ty: &Type) {
             || e.fold_children(false, |acc, c| acc || expr_has_marker(c))
     }
     fn go(ty: &Type) {
-        if let Type::Refinement(_, r) = ty {
-            debug_assert!(
-                !expr_has_marker(&r.predicate),
-                "iteration/restrict marker leaked into a refinement predicate: {}",
-                crate::ccl::symbolic::symbolic(&r.predicate)
-            );
+        if let Type::Refinement(_, claims) = ty {
+            for r in claims {
+                debug_assert!(
+                    !expr_has_marker(&r.predicate),
+                    "iteration/restrict marker leaked into a refinement predicate: {}",
+                    crate::ccl::symbolic::symbolic(&r.predicate)
+                );
+            }
         }
         ty.walk_children(go);
     }
@@ -543,10 +546,7 @@ pub fn refine_codomain(morphism: Expr, bare_predicate: &Expr) -> Expr {
     // is stored directly — *not* via `refine_with`, which wraps a predicate
     // *function*. Storing the identical bare term keeps the producer codomain
     // structurally equal to the cast demand.
-    let refined = Type::Refinement(
-        Box::new(codomain),
-        Refinement::born(Rc::new(bare_predicate.clone())),
-    );
+    let refined = Type::refined_one(codomain, Refinement::born(Rc::new(bare_predicate.clone())));
     set_codomain(morphism, refined)
 }
 
@@ -634,16 +634,21 @@ pub fn make_cast(value: Expr, target_ty: Type) -> Expr {
 /// [`TypedExprNode::Cast`]'s `target` to reattach the refinement to the
 /// reconstructed `groupby` lambda.  (Inference does not need it: it types the
 /// cast as the upcast `value_ty <: target` and lets the solver carry the
-/// refinement.) The returned `Refinement` shares the predicate's `Rc<Expr>` with
+/// refinement.) The returned claims share their predicates' `Rc<Expr>`s with
 /// `target`.
-pub fn cast_target_refinement(target: &Type) -> Option<Refinement> {
+///
+/// The whole [`RefinementSet`] is returned rather than a single claim: a target
+/// is *built* carrying one predicate ([`refined_data_fun`]), but the domain it
+/// unifies against may contribute more, and a caller reattaching "the cast's
+/// refinement" wants all of what the target demands.
+pub fn cast_target_refinement(target: &Type) -> Option<RefinementSet> {
     let Type::Fun { domain, .. } = target else {
         return None;
     };
-    let Type::Refinement(_, refinement) = domain.as_ref() else {
+    let Type::Refinement(_, claims) = domain.as_ref() else {
         return None;
     };
-    Some(refinement.clone())
+    Some(claims.clone())
 }
 
 /// Build a function type whose domain is `base_domain` wrapped in a fresh
@@ -659,7 +664,7 @@ pub fn cast_target_refinement(target: &Type) -> Option<Refinement> {
 /// inference fills them in by unifying against the value being cast.
 pub fn refined_data_fun(base_domain: Type, predicate: Expr, codomain: Type) -> Type {
     Type::data_fun(
-        Type::Refinement(Box::new(base_domain), Refinement::born(Rc::new(predicate))),
+        Type::refined_one(base_domain, Refinement::born(Rc::new(predicate))),
         codomain,
     )
 }
@@ -740,23 +745,125 @@ pub fn bare_predicate_of_fn(base: &Type, predicate: Expr) -> Expr {
     Expr::apply(elem, predicate).with_ty(Type::Base(BaseType::Bool))
 }
 
-/// Re-point every [`TypedExprNode::Cast`]'s `target` type slot at the cast
-/// node's own `expr.ty`. A cast's recorded type *is* its target type, so the
-/// two are equal by construction — but the `target` carries its **own**
-/// immutable refinement-predicate `Rc`, and a predicate-rewriting pass
-/// (inlining's beta step, lambda elimination, planning's point-free
-/// compilation) rebuilds the predicate on `expr.ty` without touching `target`,
-/// so they drift apart. The post-pass `typecheck` reconstructs a cast from its
-/// `target` ([`cast_target_refinement`]) and compares against the recorded
-/// `expr.ty`; re-syncing after each such pass keeps that match exact.
-pub fn sync_cast_targets(expr: &mut Expr) {
-    if matches!(expr.node, TypedExprNode::Cast { .. }) {
-        let ty = expr.ty.clone();
-        if let TypedExprNode::Cast { target, .. } = &mut expr.node {
-            *target = ty;
+/// Restore every [`TypedExprNode::Cast`]'s canonical type split after a
+/// rebuild pass: the `target` keeps its **born** claims on the rebuilt view's
+/// shape and bases; the node type carries the value's domain claims ∪ born
+/// ([`canonical_cast_ty`] — the same rule coalesce applies). Bottom-up, so a
+/// cast value that is itself a cast presents its canonical type to its parent.
+///
+/// A pass that rebuilds node types wholesale (lambda elimination's composition
+/// typing, `simplify`'s rule rewrites, planning's point-free compilation)
+/// re-derives `expr.ty` from surrounding term structure — and where inference
+/// left route-dependent types in eq-blind slots (a lambda param annotation,
+/// say), that re-derivation is route-dependent too. Installing the rebuilt
+/// view wholesale into `target` (the previous behaviour) therefore made a
+/// cast's *claims* route-dependent — the defect the coalesce-time
+/// canonicalization retired — while dropping the view's claims from `expr.ty`
+/// left the recorded type disagreeing with the post-pass typecheck's
+/// reconstruction (value-claims ∪ target-claims). Deriving both slots from
+/// the term repairs both at once.
+pub fn canonicalize_cast_types(expr: &mut Expr) {
+    expr.walk_children_mut(canonicalize_cast_types);
+    match &expr.node {
+        TypedExprNode::Cast { .. } => {
+            let view = expr.ty.clone();
+            if let TypedExprNode::Cast { value, target } = &mut expr.node {
+                let born = std::mem::replace(target, Type::Hole);
+                *target = canonical_cast_ty(&born, None, view.clone());
+                expr.ty = canonical_cast_ty(&born, Some(&value.ty), view);
+            }
         }
+        // A chain's type is derived from its ends (`emit_compose`): the domain
+        // comes from the head, the codomain from the tail. A head cast whose
+        // domain was just canonicalized owes the chain its domain — the
+        // post-pass typecheck's reconcile is exact on domain claims (a
+        // recorded domain may be neither wider nor narrower than the derived
+        // one, by contravariance meeting the covariant reconcile), so the
+        // recorded chain type must follow.
+        //
+        // Follow only where the difference is *claims on the same base* — the
+        // one thing cast canonicalization moves — and only on the domain. A
+        // structurally different recorded end, or a codomain refined beyond
+        // the tail's (a conditional leg's realization pin, planning's
+        // `refine_codomain`), is a deliberate statement this pass has no
+        // license to rewrite; overwriting one miscompiles (observed: a
+        // comprehension over a conditional summing the unfiltered extent).
+        // The kind and Pi name stay recorded for the same reason (`Data`
+        // pins, dependent binders).
+        TypedExprNode::Compose(elts) => {
+            if let Some(head) = elts.first()
+                && matches!(head.node, TypedExprNode::Cast { .. })
+                && let Some(head_dom) = head.ty.domain()
+                && let Type::Fun { domain, .. } = &mut expr.ty
+                && **domain != head_dom
+                && domain.peel_refinements() == head_dom.peel_refinements()
+            {
+                **domain = head_dom;
+            }
+        }
+        _ => {}
     }
-    expr.walk_children_mut(sync_cast_targets);
+}
+
+/// The canonical type of a `Cast` node: the `view`'s shape and bases (the
+/// coalesced view at inference time; the rebuilt type after a rebuild pass),
+/// carrying the claims the **term** determines — the value's own domain claims
+/// plus the `born` target's claim set. Inference and the rebuild passes
+/// resolve a cast's bases; they do not decide its claims.
+///
+/// A cast is an *assertion*: `cast(value, {𝐷 | 𝑝} ⇒ 𝑉)` claims exactly `𝑝` on
+/// top of whatever its value already established, and both parts are fixed by
+/// the term — the born claims when the cast was written (lowering's filter, a
+/// group-by's key equation), the value's claims by the value's own type, which
+/// is already canonical by induction (both callers walk bottom-up). The graph
+/// view of the same position accumulates the same union on the ordinary route
+/// — the upcast `value <: target` is how the value's claims flow in — but
+/// *which* claims an occurrence's variable accumulates depends on the route
+/// bounds took through the graph: an embedded copy of a cast (a comprehension
+/// source cloned into a filter predicate) has its own variable, and under an
+/// adversarial bound order it coalesces bare, or decorated with a sibling
+/// layer's filter. Installing the view wholesale (the previous behaviour)
+/// therefore made a cast's *identity* route-dependent — which refinement
+/// equality, deliberately cast-target-aware, then refused to dedup. Deriving
+/// the claims from the term instead is route-independent and agrees with the
+/// view on every deterministic route.
+///
+/// When the view's claims already equal the term-derived set, the view is
+/// installed wholesale — preserving the predicate-`Rc` sharing between the
+/// target and the node type that planning's compile-once relies on.
+/// `value_ty: None` computes the canonical *target* (born claims alone);
+/// `Some` computes the canonical node *type* (value's domain claims ∪ born).
+pub(crate) fn canonical_cast_ty(born: &Type, value_ty: Option<&Type>, view: Type) -> Type {
+    let born_claims = match born.domain() {
+        Some(d) => d.claims().to_vec(),
+        None => return view,
+    };
+    let Some(view_dom) = view.domain() else {
+        return view;
+    };
+    // The term-determined claim set: value's domain claims (type position
+    // only) ∪ born claims.
+    let mut canon_claims: RefinementSet = value_ty
+        .and_then(|t| t.domain())
+        .map(|d| d.claims().to_vec())
+        .unwrap_or_default()
+        .into_iter()
+        .collect();
+    canon_claims.extend(born_claims);
+    let view_claims = view_dom.claims();
+    let same = canon_claims.len() == view_claims.len()
+        && view_claims.iter().all(|r| canon_claims.contains(r));
+    if same {
+        return view;
+    }
+    let cod = view
+        .codomain()
+        .expect("a type with a domain has a codomain");
+    Type::fun_like(
+        &view,
+        Type::refined(view_dom.peel_refinements().clone(), canon_claims),
+        cod,
+    )
 }
 
 /// Wrap `base` in a fresh `Type::Refinement` whose bare predicate filters the
@@ -768,7 +875,7 @@ pub(crate) fn refine_with(base: Type, predicate: &Expr) -> Type {
         return base;
     }
     let bare = bare_predicate_of_fn(&base, predicate.clone());
-    Type::Refinement(Box::new(base), Refinement::born(Rc::new(bare)))
+    Type::refined_one(base, Refinement::born(Rc::new(bare)))
 }
 
 /// Count free occurrences of `name` in `expr`, including occurrences in
@@ -962,10 +1069,12 @@ pub fn walk_refined_predicates<F>(ty: &Type, visited: &mut HashSet<PredicateId>,
 where
     F: FnMut(&Expr, &mut HashSet<PredicateId>),
 {
-    if let Type::Refinement(_, refinement) = ty
-        && visited.insert(refinement.predicate_id())
-    {
-        f(&refinement.predicate, visited);
+    if let Type::Refinement(_, claims) = ty {
+        for refinement in claims {
+            if visited.insert(refinement.predicate_id()) {
+                f(&refinement.predicate, visited);
+            }
+        }
     }
     ty.walk_children(|child| walk_refined_predicates(child, visited, f));
 }
@@ -1229,12 +1338,14 @@ impl TermMemo {
 /// refinement, i.e. whether sharing was split (see `tests/predicate_sharing.rs`).
 pub fn reachable_refinements(expr: &Expr) -> Vec<Refinement> {
     fn in_type(ty: &Type, out: &mut Vec<Refinement>, seen: &mut HashSet<PredicateId>) {
-        if let Type::Refinement(_, r) = ty
-            && seen.insert(r.predicate_id())
-        {
-            out.push(r.clone());
-            // A predicate's own subexpressions carry further refinements.
-            in_expr(&r.predicate, out, seen);
+        if let Type::Refinement(_, claims) = ty {
+            for r in claims {
+                if seen.insert(r.predicate_id()) {
+                    out.push(r.clone());
+                    // A predicate's own subexpressions carry further refinements.
+                    in_expr(&r.predicate, out, seen);
+                }
+            }
         }
         ty.walk_children(|c| in_type(c, out, seen));
     }
@@ -1291,8 +1402,10 @@ where
     F: FnMut(&mut Expr, &PredMemo<C>) -> bool,
 {
     let mut changed = false;
-    if let Type::Refinement(_, refinement) = ty {
-        changed |= memo.rebuild(refinement, context, |pred| f(pred, memo));
+    if let Type::Refinement(_, claims) = ty {
+        for refinement in claims.iter_mut() {
+            changed |= memo.rebuild(refinement, context, |pred| f(pred, memo));
+        }
     }
     ty.walk_children_mut(|child| changed |= walk_refined_predicates_mut(child, memo, context, f));
     changed
diff --git a/src/ccl/channelize.rs b/src/ccl/channelize.rs
index 48f61fd1..824050b0 100644
--- a/src/ccl/channelize.rs
+++ b/src/ccl/channelize.rs
@@ -833,7 +833,7 @@ fn refine_source_domain(source: &mut Expr, refinement: Refinement) {
         domain, codomain, ..
     } = &source.ty
     {
-        let refined_domain = Type::Refinement(domain.clone(), refinement);
+        let refined_domain = Type::refined_one((**domain).clone(), refinement);
         let codomain = (**codomain).clone();
         source.ty = Type::fun_like(&source.ty, refined_domain, codomain);
         return;
@@ -1659,10 +1659,10 @@ fn collect_free_vars(expr: &Expr, out: &mut HashSet<Name>) {
 /// as "no references"; callers run between passes when no predicate
 /// is being walked elsewhere, so the under-count is safe in practice.
 fn collect_free_vars_in_type(ty: &Type, out: &mut HashSet<Name>) {
-    if let Type::Refinement(_, refinement) = ty {
-        // Refinement predicates are themselves CCL expressions; recurse into
-        // them through `collect_free_vars` so their own type-position
-        // predicates and shadowing are handled consistently.
+    // Refinement predicates are themselves CCL expressions; recurse into them
+    // through `collect_free_vars` so their own type-position predicates and
+    // shadowing are handled consistently.
+    for refinement in ty.claims() {
         collect_free_vars(&refinement.predicate, out);
     }
     ty.walk_children(|child| collect_free_vars_in_type(child, out));
@@ -1898,31 +1898,14 @@ fn copair_type(feeds: &[Expr]) -> Type {
 /// `PartialEq`), and the skeletons must already agree — the caller's
 /// `debug_assert` states that invariant.
 fn join_refinements(a: &Type, b: &Type) -> Type {
-    let mut layers: Vec<Refinement> = Vec::new();
-    let mut cur = a;
-    while let Type::Refinement(inner, r) = cur {
-        if type_carries_refinement(b, r) {
-            layers.push(r.clone());
-        }
-        cur = inner;
-    }
-    // Innermost-first, so the outermost layer of `a` ends up outermost again.
-    layers
-        .into_iter()
-        .rev()
-        .fold(cur.clone(), |acc, r| Type::Refinement(Box::new(acc), r))
-}
-
-/// Whether `ty`'s own refinement layers include `refinement`.
-fn type_carries_refinement(ty: &Type, refinement: &Refinement) -> bool {
-    let mut cur = ty;
-    while let Type::Refinement(inner, r) = cur {
-        if r == refinement {
-            return true;
-        }
-        cur = inner;
-    }
-    false
+    Type::refined(
+        a.peel_refinements().clone(),
+        a.claims()
+            .iter()
+            .filter(|r| b.claims().contains(r))
+            .cloned()
+            .collect(),
+    )
 }
 
 /// Peel outer `Refinement` wrappers off a type, returning the underlying type.
@@ -2587,12 +2570,7 @@ fn extract_for_defer_impl(
                     let refined = if matches!(&pred.node, TypedExprNode::Lit(Lit::Bool(true))) {
                         unit_ty.clone()
                     } else {
-                        Type::Refinement(
-                            Box::new(unit_ty.clone()),
-                            Refinement {
-                                predicate: Rc::new(pred),
-                            },
-                        )
+                        Type::refined_one(unit_ty.clone(), Refinement::born(Rc::new(pred)))
                     };
                     for v in branch_feeds {
                         feeds.push(Expr::lambda("__unused", refined.clone(), v.clone()));
@@ -2899,7 +2877,7 @@ mod tests {
         let pred = var("outer_n");
         let refinement = Refinement::born(Rc::new(pred));
         let annotated = Expr::var(Name::raw("__chan")).with_user_annotation(Type::fun(
-            Type::Refinement(Box::new(Type::Hole), refinement),
+            Type::refined_one(Type::Hole, refinement),
             Type::Hole,
         ));
 
@@ -2925,7 +2903,7 @@ mod tests {
         let typed = Expr::lit(Lit::Unit).with_ty(Type::Fun {
             name: None,
             kind: crate::ccl::ty::FunKind::Compute,
-            domain: Box::new(Type::Refinement(Box::new(Type::Hole), refinement)),
+            domain: Box::new(Type::refined_one(Type::Hole, refinement)),
             codomain: Box::new(Type::Hole),
         });
         let mut free: HashSet<Name> = HashSet::new();
diff --git a/src/ccl/design/type-inference.md b/src/ccl/design/type-inference.md
index 21558ad9..73370c48 100644
--- a/src/ccl/design/type-inference.md
+++ b/src/ccl/design/type-inference.md
@@ -499,10 +499,15 @@ place. A pass that processes a predicate at one occurrence must therefore reach
 threads a memo keyed on the original predicate's identity so occurrences that
 shared one term are re-pointed at the same rebuild (the immutable replacement
 for "mutate the shared cell, every alias observes it"). One consequence worth
-naming: a `Cast`'s `target` type slot is the cast's recorded type, so passes
-that rebuild a predicate on `expr.ty` re-sync the `target` to it
-(`ccl_utils::sync_cast_targets`) — the post-inference check reconstructs a cast
-from its `target`.
+naming: a `Cast`'s `target` slot carries the cast's **born** claims (the
+assertion), never a copy of the recorded type — a pass that rebuilds node types
+restores the canonical split afterwards (`ccl_utils::canonicalize_cast_types`:
+`target` = born claims on the rebuilt view's bases, `expr.ty` = value-claims ∪
+born) rather than overwriting `target` with `expr.ty`. The post-inference check
+reconstructs a cast as value-claims ∪ target-claims, and a wholesale overwrite
+satisfied that check only by making the cast's claim *identity* track whatever
+route-dependent type the rebuild derived — the arrival-order defect the
+canonical split retires (see the coalesce-time rule at `canonical_cast_ty`).
 
 #### Sharing is an invariant, not an optimization detail
 
@@ -709,10 +714,27 @@ Singletons are *not* erased after inference. They are ordinary refinements and r
 
 A **refined type** `{T | p}` carries a *set* of [`Refinement`]s, and the lattice treats each as a black box: it accumulates them and matches them by identity, never reasoning about what they imply (the predicate's logical content is real and used by the runtime, just opaque *here*). It is a fourth structural dimension on `CompactType`, width-subtyped exactly like records: **`{b₁ | S₁} <: {b₂ | S₂}` iff `b₁ <: b₂` and `S₂ ⊆ S₁ ∪ refinements(b₁)`** — more refinements ⇒ subtype. So `{T | p, q} <: {T | p}` and `{T | p} <: T`, but `{T | q} ⊀ {T | p}`. Refinements match by **type-blind structural equality of their predicate terms** (`Refinement`'s `PartialEq` / `eq_refinement_predicate`) — *not* by predicate implication (`{T | x > 0} ⊀ {T | x > -1}`). Structural matching makes refinement identity agnostic to *where* a predicate was constructed (join planning re-mints `{D | p}` at every marker it emits — `make_iterate` / `make_restrict` / `refine_with` — and must match the structurally-identical contract recorded elsewhere on the tree) and to in-place type resolution (copies of one predicate along a monomorphization descent line differ only in their inferred-type slots); a pointer-equal predicate `Rc` short-circuits as the fast path, since a refinement that merely flows around shares its `Rc`. The refinement set merges with the *same polarity rule as `rec`* (positive ⇒ intersect, negative ⇒ union) and is carried verbatim through simplification (refinements are positional, never folded into a variable's identity, so co-occurrence merging can't move or drop them).
 
+##### The set is the representation, not just the reading
+
+`Type::Refinement` carries a `RefinementSet` — unordered, deduplicated, with set-semantic `Eq`/`Hash` — and `Type::refined` is the sole constructor, establishing two invariants: the set is non-empty, and the base is never itself a refinement. Nested layers flatten, so `{{𝑇 | 𝑝} | 𝑞}` is *unrepresentable* and "which layer is outermost" cannot be asked.
+
+That question previously had an answer, and the answer was constraint **arrival order**: two refined upper bounds meeting at one variable produced `{{𝑇 | 𝑞} | 𝑝}` or `{{𝑇 | 𝑝} | 𝑞}` depending on which arrived first. Subtyping never cared — the deficit machinery above already compares layers as a set — but `Type`'s derived equality did, and structural equality is load-bearing wherever a type is an **identity**: the trivial-equality short-circuit in `constrain_go`, cache keys, `SpecKey`, and the recorded-vs-recomputed walls. One `Vec` was serving three incompatible readings — a set to subtyping, a stack to planning, an identity to the walls.
+
+Flattening is sound because every claim at a position restricts the same underlying element: a refinement narrows *which* values inhabit a type, it does not change them, so an outer claim's `__elem` ranges over exactly the values an inner one does. Canonically *sorting* the `Vec` was tried and rejected: it pins the ambiguity rather than deleting it, and it denies planning the freedom to apply claims in whatever order it likes.
+
+##### Materializing a claim set is a pipeline, and a pipeline is ordered
+
+The set is unordered as a *fact about a value*. Materializing it is not: planning emits one `restrict` per claim, and stage 𝑘 reads elements already narrowed by stages 1..𝑘-1, so its element type is the base narrowed by the claims applied before it — not the bare base. Planning therefore **chooses** an order.
+
+Which order is free (any of them yields a well-typed pipeline for the same final domain, and a cost model could pick the cheapest filter first); choosing *differently in two places* is not, since the types along the pipeline and the predicates compiled for it must agree. `ccl::application_order` is the single place that choice is made, and it keys on the claims' **content** — their rendered predicates — never on the set's physical order, so the built term is reproducible however the claims happened to accumulate.
+
+The chosen order is a **permutation** of the physical one, and that is the trap: a site rewriting claims *in place* walks them physically, and zipping the application order's types onto that walk pairs claims with the wrong element type — silently, since the two sequences have equal length. `application_elem_types` does the permutation explicitly and is what such a site uses.
+
+Two classes of order-dependence survive a compile-clean rewrite of this kind: a consumer that *iterates* the set and lets the order reach something observable, and a dedup that keeps the first-inserted of two `eq`-equal members whose type-blind-equal predicate terms carry different embedded type slots. `CAMBRA_REFINEMENT_ORDER=reverse` (debug builds only) flips the set's physical order globally, and CI runs the suite both ways — an unrun knob rots exactly as an uncompiled feature does. The variable is read at runtime, so the reversed pass reuses the binaries the ordinary one built.
 
 **A refinement never changes a type's shape.** It is a claim about the value at a position, not part of the structure carrying it, so `{(𝐷 ⇒ 𝑉) | 𝑝}` *is* a function and `{Mut(𝑉, 𝐷) | 𝑝}` *is* a mutable variable. Every rule that dispatches on or destructures a shape therefore looks *through* the outer layers first — `Type::peel_refinements`, and the handle accessors `Type::mut_value_type` / `as_feed` / `is_handle` built on it, which are what the typing rules and the second-class `Mut` discipline both ask "is this a mutable variable?" with. It is the same claim-versus-structure distinction a trait obligation draws when it reads a base off an operand ([Refinements are transparent](#refinements-are-transparent)): what narrowing consumes is the structure, and the refinement rides along untouched.
 
-A refinement is **required**, so `constrain_subtype` is strict for *concrete* bases: an unrefined concrete value does **not** flow into a refined position (`T ⊀ {T | p}`), and `{T | q} ⊀ {T | p}`. The one subtlety is the `S₂ ⊆ S₁ ∪ refinements(b₁)` clause: when the subtype side's base `b₁` is an **inference variable**, it can still acquire the deficit `S₂ \ S₁`, so the solver flows `b₁ <: {b₂ | S₂ \ S₁}` onto the variable rather than rejecting (the refinement analog of how the record/function arms thread structure through a variable base; it fails later iff the variable resolves to a concrete base lacking those refinements). This is what lets a value that is *already* refined be cast to acquire a further refinement — `{D | p} ⇒ V <: {?a | q} ⇒ V` records `?a <: {D | p}`, stacking `q` over `p` (nested list-comprehension filters). Acquiring a refinement on a *concrete* value is still an *explicit* operation, not subsumption: the explicit `Cast` node from [PR #218](https://github.com/cambra-dev/Cambra/pull/218) (an upcast — `value <: target` — written `cast({D | r} ⇒ V, value)`) makes refinement-acquisition explicit, and the interpreter compiles a refinement on a **collection domain** to a runtime `Restrict`/`Filter` at the iteration boundary (the `Iterate`/`Restrict` arms of `operator_conversion`, where `extent_of` strips the domain refinement into a `Restrict`). The predicate `Expr` of each refinement is inferred/coalesced like any other sub-tree (annotation-borne predicates via `emit_annotation_predicates` / `coalesce_type_predicates`).
+A refinement is **required**, so `constrain_subtype` is strict for *concrete* bases: an unrefined concrete value does **not** flow into a refined position (`T ⊀ {T | p}`), and `{T | q} ⊀ {T | p}`. The one subtlety is the `S₂ ⊆ S₁ ∪ refinements(b₁)` clause: when the subtype side's base `b₁` is an **inference variable**, it can still acquire the deficit `S₂ \ S₁`, so the solver flows `b₁ <: {b₂ | S₂ \ S₁}` onto the variable rather than rejecting (the refinement analog of how the record/function arms thread structure through a variable base; it fails later iff the variable resolves to a concrete base lacking those refinements). This is what lets a value that is *already* refined be cast to acquire a further refinement — `{D | p} ⇒ V <: {?a | q} ⇒ V` records `?a <: {D | p}`, so the position claims both `p` and `q` (nested list-comprehension filters). Acquiring a refinement on a *concrete* value is still an *explicit* operation, not subsumption: the explicit `Cast` node from [PR #218](https://github.com/cambra-dev/Cambra/pull/218) (an upcast — `value <: target` — written `cast({D | r} ⇒ V, value)`) makes refinement-acquisition explicit, and the interpreter compiles a refinement on a **collection domain** to a runtime `Restrict`/`Filter` at the iteration boundary (the `Iterate`/`Restrict` arms of `operator_conversion`, where `extent_of` strips the domain refinement into a `Restrict`). The predicate `Expr` of each refinement is inferred/coalesced like any other sub-tree (annotation-borne predicates via `emit_annotation_predicates` / `coalesce_type_predicates`).
 
 **Refinements in the post-inference check.** The post-inference structural check (`infer::check`, reimplemented on the same structural rules as emission via the `Typing` trait — see §2, *The post-inference check*) is **strict and refinement-aware throughout** — it does not strip refinements before its width-subtyping checks. It runs `constrain_subtype` in two places, both fully refinement-aware:
 
@@ -912,6 +934,40 @@ The expected binder is **always globally fresh** (proposal §5.2 verbatim; the 
 
 The pipeline passes downstream of inference treat function types structurally and compare modulo the Pi binder (`Type::without_pi_names`). **Refinement-predicate compilation is deferred out of lambda-elim** (proposal §6.3): predicates ride through inference and lambda-elim in their bare pointful form (a bare boolean over the implicit `REFINEMENT_BINDER`), and **planning** compiles them. Order matters: the group-by / hash-join recognizers run *first*, on the bare form — compiling first would destroy the pointful shapes they match (see the pointful-join-recognizers plan) — and `planning::compile_refinement_predicates` then runs the lambda-elim → simplify sub-pipeline on each remaining predicate (keyed by predicate `Rc` identity) before the generic `iterate`/`restrict` lowering consumes it. This is what lets a refined collection — including a group-by over a *filtered* source (`[sum(x) for x in groupby([y+10 for y in xs if y<6], key)]`) — compile to a runtime `Restrict`/`Filter` rather than reaching op-conversion as an un-compiled predicate. Single-key dependent lookups (`sum(groupby(xs, key)(k))`) and the nested filtered-source group-by both run end-to-end with correct values.
 
+### Canonicalizing a Pi binder needs a position, so it happens at flattening
+
+`compact_go` and `spec_key::key_go` rewrite every arrow's binder to `Name::pi(depth)` as they flatten a type, and no earlier stage does; `Subst::canonical_pi_binder` owns the rule. The depth counts enclosing codomain arrows, so the canonical binder is a *position*, and flattening is the first point in the pipeline where a Pi reference has one.
+
+Before flattening it has none. A dependent refinement is recorded on an inference variable as an ordinary bound, and the variable holding it need not sit under the binder the predicate references. Lowering a group-by produces the shape `lower/exprs.rs`'s tests pin:
+
+```
+λ __gb_k → cast(({_ | __elem ▷ xs ▷ key_fn == __gb_k} ⤇ _), λ __gb_i → __gb_i ▷ xs)
+```
+
+`emit_lambda` types the outer lambda as `(__gb_k: 𝐾) ⇒ …`, and the refinement mentioning `__gb_k` reaches the solver as a bound on the cast's own variable — a position with no enclosing arrow at all. What relates that bound to its binder is the suspended discharge riding the edge, not containment. The two-sided storage above is what makes that work when `fn_ty` is still a variable at the apply site and its concrete Pi arrives later (the opaque/higher-order case, O3).
+
+So the scheme has to satisfy two facts at once. α-variant dependent types must compare equal, or `SpecKey` splits uses that should share a specialization and merged bounds keep a dangling twin — the behaviours `spec_key_shares_alpha_variant_dependent_types` and `alpha_variant_bound_merge_is_canonical` pin. And a reference is unpositioned for as long as it lives on an edge. Flattening is where those meet: it walks the graph and emits a type whose Pi references sit under their binders (`coalesce_compact_go` keeps a binder exactly when the codomain references it), and `check_scope_valid` then holds every coalesced node's type to its lexical scope.
+
+`ReservedName::Pi` holds a `u8`, so what lands in the flattened form is an index; `__pi0` is its `Display`. Naming a reference while it is unpositioned and indexing it once it is not is the locally-nameless discipline, with the abstraction step at the only place that can host it.
+
+#### Alternatives, and what each one breaks on
+
+Each of these removes the rewrite, and each is recorded because it does not work.
+
+- **Mint canonical binders at emission**, so nothing renormalizes. The index counts enclosing *codomain* arrows, making it a property of a binder's position in a finished type rather than of the binder. `emit_lambda` types an inner lambda before knowing what will wrap it, and placing a type in a codomain shifts every Pi binder inside it: `\s -> groupby([1,2,3,4], \x -> x // 2)` infers with the group-by's binder at `__pi1`, where the same term standing alone puts it at `__pi0`.
+
+- **Count from the inside out** — from the reference to its binder rather than from the root — so the encoding survives wrapping and emission can mint it. Wrapping is not the obstruction; the unpositioned edge is. A reference on a bound whose binder is not an ancestor has no number to carry under either direction of counting, and that is the common case rather than a corner: it is what every group-by produces.
+
+- **Give `Type` an α-invariant `PartialEq`/`Hash`** and leave the names alone. The comparison needing α-insensitivity is a `RefinementSet` dedup — `RefinementSet::insert` in `compact_go`'s refinement arm, and `merge_refinements` where two bounds meet — and the binder sits on the enclosing `CompactFun`, one frame above the values being compared. `Eq` and `Hash` take no context parameter, and `ConstrainCache` keys a `HashMap` on `(Type, Type)`, so `Hash` must be a function of the value alone.
+
+- **Rename at merge rather than at flattening**: have `CompactFun::merge` rewrite the incoming side's references onto the incumbent's binder. This one works, and moves the rewrite somewhere worse — once per merge in a fold over a variable's bounds instead of once per flatten — while the surviving binder is the first arrival's again, which is the arrival-order dependence the canonical form exists to remove.
+
+The invariant: a Pi reference is a `Name` while it rides an edge and an index once flattened. What the three walks that flatten owe each other differs, and neither obligation follows from sharing the rule.
+
+`compact_go` and `Type::alpha_normalized` must assign the *same* index, because `lambda_elim` compares a solver-produced type — canonical already, through the first — against an independently rebuilt one by normalizing both through the second (`compacting_is_a_fixpoint_of_alpha_normalization`).
+
+`spec_key::key_go` owes only **injectivity** over enclosing binders. A key is compared with other keys and carries no binder name (`SpecKey::fun`), so a consistent relabelling is invisible there; conflating two binders under one index is not, because it makes two uses share a specialization whose interior was resolved against the other's argument. Injectivity is what each walk is tested for — `canonical_binders_keep_distinct_binders_distinct` and `spec_key_keeps_distinct_binders_distinct` — and it is the property `Subst::canonical_pi_binder` cannot establish by itself: a walk that entered a codomain at the arrow's own depth would name every binder `__pi0`, which is internally consistent and idempotent, so comparing a type against its own canonical form does not detect it.
+
 ## 4.6 Data vs compute functions
 
 > **Status: implemented, minus Σ.** The `FunKind` marker, kind inference,
diff --git a/src/ccl/infer/api.rs b/src/ccl/infer/api.rs
index 70f91031..445d37d7 100644
--- a/src/ccl/infer/api.rs
+++ b/src/ccl/infer/api.rs
@@ -1252,7 +1252,7 @@ fn collect_type_errors(
             collect_type_errors(value, context_sym, strictness, errors, seen_refinements);
             collect_type_errors(domain, context_sym, strictness, errors, seen_refinements);
         }
-        Type::Refinement(inner, refinement) => {
+        Type::Refinement(inner, claims) => {
             // Walk each predicate term only once: a predicate term shared by
             // `Rc` across occurrences (its own type slots can carry the same
             // refinement) is a DAG, so this dedups it. (Immutable predicates
@@ -1264,8 +1264,15 @@ fn collect_type_errors(
             // [`crate::ccl::ccl_utils::walk_refined_predicates`]). This site
             // doesn't share the helper because it mixes per-node error checks
             // with the refinement walk.
-            if seen_refinements.insert(refinement.predicate_id()) {
-                collect_expr_errors(&refinement.predicate, strictness, errors, seen_refinements);
+            for refinement in claims {
+                if seen_refinements.insert(refinement.predicate_id()) {
+                    collect_expr_errors(
+                        &refinement.predicate,
+                        strictness,
+                        errors,
+                        seen_refinements,
+                    );
+                }
             }
             collect_type_errors(inner, context_sym, strictness, errors, seen_refinements);
         }
diff --git a/src/ccl/infer/context.rs b/src/ccl/infer/context.rs
index dd4d35d2..ef42164c 100644
--- a/src/ccl/infer/context.rs
+++ b/src/ccl/infer/context.rs
@@ -217,7 +217,7 @@ impl InferCtx {
             // inner (so a `Refinement(Hole, r)` source annotation becomes
             // `Refinement(?fresh, r)` rather than losing the refinement).
             Type::Refinement(inner, r) => {
-                Type::Refinement(Box::new(self.normalize_annotation(inner)), r.clone())
+                Type::refined(self.normalize_annotation(inner), r.clone())
             }
             // Structural types are already solver-ready; recurse to
             // normalize any nested holes/refinements.
@@ -281,7 +281,7 @@ impl InferCtx {
             // `unit`: a singleton adds nothing to a one-inhabitant base.
             return base;
         };
-        Type::Refinement(Box::new(base), Refinement::sharing(&predicate))
+        Type::refined_one(base, Refinement::sharing(&predicate))
     }
 }
 
diff --git a/src/ccl/infer/emit.rs b/src/ccl/infer/emit.rs
index 320816d0..331d49ba 100644
--- a/src/ccl/infer/emit.rs
+++ b/src/ccl/infer/emit.rs
@@ -322,11 +322,13 @@ fn emit_annotation_predicates(ty: &mut Type, ctx: &mut InferCtx) -> Result<(), L
         // `BoundedHole` here: recurse into the bound, or a predicate written inside one
         // (`x <: {Int | p}`) never gets typed.
         Type::BoundedHole(bound) => emit_annotation_predicates(bound, ctx),
-        Type::Refinement(inner, r) => {
-            // The annotation's refinement is bare over REFINEMENT_BINDER, just
+        Type::Refinement(inner, claims) => {
+            // The annotation's refinements are bare over REFINEMENT_BINDER, just
             // like a cast target's — bind the element over the refined base and
             // check `Bool`.
-            emit_bare_predicate(r, inner, ctx)?;
+            for r in claims.iter_mut() {
+                emit_bare_predicate(r, inner, ctx)?;
+            }
             emit_annotation_predicates(inner, ctx)
         }
         Type::Fun {
@@ -500,9 +502,9 @@ fn complete_annotation(ann: &Type, inferred: &Type) -> Type {
         // refinement itself is the user's claim and is kept. `peel_refinements`
         // on the inferred side because its own refinements describe the *value*,
         // and this is filling in a *shape*.
-        (Type::Refinement(base, r), _) => Type::Refinement(
-            Box::new(complete_annotation(base, inferred.peel_refinements())),
-            r.clone(),
+        (Type::Refinement(base, claims), _) => Type::refined(
+            complete_annotation(base, inferred.peel_refinements()),
+            claims.clone(),
         ),
         // The arrow's binder and kind come from the *annotation*, per the rule
         // above: a kind is something an annotation can state (`List(T)` is a data
@@ -672,13 +674,14 @@ pub(super) fn emit_cast<C: Typing>(
     // it on the `target` slot is what carries the typed predicate onto the
     // syntactic node; the result domain below then clones the typed refinement.
     if let Type::Fun { domain, .. } = target
-        && let Type::Refinement(_, r) = domain.as_mut()
+        && let Type::Refinement(_, claims) = domain.as_mut()
     {
-        emit_bare_predicate(r, &d, ctx)?;
+        for r in claims.iter_mut() {
+            emit_bare_predicate(r, &d, ctx)?;
+        }
     }
-    let refinement = cast_target_refinement(target);
-    let domain = match refinement {
-        Some(r) => Type::Refinement(Box::new(d), r),
+    let domain = match cast_target_refinement(target) {
+        Some(claims) => Type::refined(d, claims),
         None => d,
     };
     // A cast re-views the value *at* `target`, so the result carries `target`'s
diff --git a/src/ccl/infer/mod.rs b/src/ccl/infer/mod.rs
index 9256bdce..60a13f9a 100644
--- a/src/ccl/infer/mod.rs
+++ b/src/ccl/infer/mod.rs
@@ -383,7 +383,7 @@ pub(super) fn lit_base(lit: &Lit) -> Type {
 /// literal takes [`lit_base`] — refining *it* too would not terminate.
 pub fn lit_singleton(lit: &Lit) -> Type {
     match singleton_predicate(lit) {
-        Some(predicate) => Type::Refinement(Box::new(lit_base(lit)), Refinement::born(predicate)),
+        Some(predicate) => Type::refined_one(lit_base(lit), Refinement::born(predicate)),
         None => lit_base(lit),
     }
 }
@@ -602,10 +602,7 @@ pub(crate) mod test_helpers {
             BinOpKind::Compare(CompareKind::Greater),
             rhs,
         );
-        Type::Refinement(
-            Box::new(Type::Base(BaseType::Int)),
-            Refinement::born(Rc::new(pred)),
-        )
+        Type::refined_one(Type::Base(BaseType::Int), Refinement::born(Rc::new(pred)))
     }
 
     /// Walk `expr`, counting `Let` bindings minted by specialization (their
diff --git a/src/ccl/infer/solve.rs b/src/ccl/infer/solve.rs
index 9ab2bd94..98464f26 100644
--- a/src/ccl/infer/solve.rs
+++ b/src/ccl/infer/solve.rs
@@ -19,7 +19,7 @@
 // (`coalesce_node` ↔ `specialize_use`) over one shared [`CoalesceCtx`], so they
 // live in a single module.
 
-use crate::ccl::ccl_utils::PredMemo;
+use crate::ccl::ccl_utils::{PredMemo, canonical_cast_ty};
 use crate::ccl::infer::InferError;
 use crate::ccl::infer::emit::read_through;
 use crate::ccl::infer::solver::{
@@ -1399,19 +1399,26 @@ fn coalesce_node_inner(expr: &mut Expr, level: Level, ctx: &mut CoalesceCtx) {
     // (`specialize_lambda_domain`).
     refresh_lambda_param_slot(expr);
 
-    // A `Cast`'s `target` is the inferred cast type — exactly `expr.ty`. Point
-    // it at the fully-resolved `expr.ty` (sharing the resolved refinement `Rc`),
-    // so the cast's domain refinement carries a concrete base (lowering left it
-    // a `Hole`) and shares one predicate term with the result. Planning then
-    // compiles that one predicate once and the post-inference check reconstructs
-    // the cast from a `target` that matches what the producer supplies. (The
-    // pre-materialization `coalesce_type_predicates(target)` in the `Cast` arm
-    // resolved the predicate in scope — e.g. a generalized use inside it — but
-    // against the lowered `Hole` base; this overwrite installs the concrete one.)
+    // A `Cast`'s `target` and its `expr.ty` converge on the **canonical cast
+    // type**: the coalesced view's *shape and bases*, carrying the claims the
+    // *term* determines — the value's own domain claims plus the target's born
+    // claims (see `canonical_cast_ty`). Both slots share one `Type`, so
+    // planning compiles one predicate term and the post-inference check
+    // reconstructs the cast from a `target` that matches the recorded type.
     if matches!(expr.node, TypedExprNode::Cast { .. }) {
-        let cast_ty = expr.ty.clone();
-        if let TypedExprNode::Cast { target, .. } = &mut expr.node {
-            *target = cast_ty;
+        let view = expr.ty.clone();
+        if let TypedExprNode::Cast { value, target } = &mut expr.node {
+            // The *target* keeps exactly its born claims (the assertion); the
+            // node *type* is the value's claims joined with them (what the
+            // assertion yields on this value). Keeping the two distinct is
+            // load-bearing for the post-inference check, which recomputes the
+            // type as value-claims ∪ target-claims: a target that also carried
+            // the value's claims would double-book them, and any divergence
+            // between the value's copy and the target's copy of one claim
+            // would surface as a duplicated claim in the recomputation.
+            let born = std::mem::replace(target, Type::Hole);
+            *target = canonical_cast_ty(&born, None, view.clone());
+            expr.ty = canonical_cast_ty(&born, Some(&value.ty), view);
         }
     }
 }
@@ -1459,15 +1466,17 @@ fn coalesce_type_predicates(ty: &mut Type, level: Level, ctx: &mut CoalesceCtx)
                 "Type::BoundedHole reached the solver; `normalize_annotation` must erase it"
             )
         }
-        Type::Refinement(inner, r) => {
+        Type::Refinement(inner, claims) => {
             // A handle clone, so `ctx` stays freely borrowable for the rebuild —
             // which re-enters this same memo through `coalesce_node` →
             // `coalesce_type_predicates`.
             let memo = ctx.pred_memo.clone();
-            memo.rebuild(r, &(), |pred| {
-                coalesce_node(pred, level, ctx);
-                true
-            });
+            for r in claims.iter_mut() {
+                memo.rebuild(r, &(), |pred| {
+                    coalesce_node(pred, level, ctx);
+                    true
+                });
+            }
             coalesce_type_predicates(inner, level, ctx);
         }
         Type::Fun {
@@ -2053,9 +2062,7 @@ pub(super) fn specialize_lambda_domain(lambda: &mut Expr, input: &Type) {
         .into_iter()
         .rev()
         .filter(|r| !input_refinements.contains(&r))
-        .fold(recovered_input(&base, input), |acc, r| {
-            Type::Refinement(Box::new(acc), r)
-        });
+        .fold(recovered_input(&base, input), Type::refined);
     lambda.ty = fn_layers.into_iter().rev().fold(
         // Preserve the Pi binder: specialization rewrites only the domain
         // *shape*; a dependent codomain still refers to the same binder.
@@ -2065,7 +2072,7 @@ pub(super) fn specialize_lambda_domain(lambda: &mut Expr, input: &Type) {
             domain: Box::new(new_dom),
             codomain: cod,
         },
-        |acc, r| Type::Refinement(Box::new(acc), r),
+        Type::refined,
     );
     // The param slot was derived from the pre-specialization domain during the
     // lambda's own `coalesce_node`; re-derive it from the rewritten one.
@@ -2118,9 +2125,9 @@ mod tests {
         // Refinements are built here rather than via `refined_int`, which is
         // `debug_assertions`-only: the rule under test is not.
         let refined = |inner: Type| {
-            Type::Refinement(
-                Box::new(inner),
-                Refinement::born(std::rc::Rc::new(TypedExpr::lit(Lit::Bool(true)))),
+            Type::refined(
+                inner,
+                Refinement::born(std::rc::Rc::new(TypedExpr::lit(Lit::Bool(true)))).into(),
             )
         };
         let int = Type::Base(BaseType::Int);
@@ -2199,8 +2206,7 @@ mod tests {
             kind: HistoryKind::Overwrite,
         };
         let claim = Refinement::born(std::rc::Rc::new(TypedExpr::lit(Lit::Bool(true))));
-        let on_the_handle =
-            |t: Type| Type::Refinement(Box::new(t), Refinement::sharing(&claim.predicate));
+        let on_the_handle = |t: Type| Type::refined_one(t, Refinement::sharing(&claim.predicate));
 
         for (read, now) in [
             // handle vs its read view: the refined value sits one layer deeper.
diff --git a/src/ccl/infer/solver/coalesce.rs b/src/ccl/infer/solver/coalesce.rs
index 92017ccd..caabcaa3 100644
--- a/src/ccl/infer/solver/coalesce.rs
+++ b/src/ccl/infer/solver/coalesce.rs
@@ -277,15 +277,8 @@ fn coalesce_compact_go(ct: &CompactType, polarity: bool) -> Result<Type, Coalesc
         }
     };
 
-    // Re-wrap the refinements carried at this position. `extent_of`
-    // strips refinements at every depth and composes the resulting
-    // `Restrict`s, so the wrap order is semantically irrelevant;
-    // first-insertion order in the `Vec` makes it stable.
-    let out = ct
-        .refinements
-        .iter()
-        .fold(inner, |acc, r| Type::Refinement(Box::new(acc), r.clone()));
-    Ok(out)
+    // Re-attach the claims carried at this position.
+    Ok(Type::refined(inner, ct.refinements.clone()))
 }
 
 /// Dissolve a position's feed `history_slot` into its other contributions when
diff --git a/src/ccl/infer/solver/compact.rs b/src/ccl/infer/solver/compact.rs
index 80bdaefe..0fac46c9 100644
--- a/src/ccl/infer/solver/compact.rs
+++ b/src/ccl/infer/solver/compact.rs
@@ -12,7 +12,9 @@ use std::rc::Rc;
 use smol_str::SmolStr;
 
 use crate::ccl::subst::Subst;
-use crate::ccl::{BaseType, HistoryKind, InferVarId, Name, Refinement, Type, fresh_infer_var_id};
+use crate::ccl::{
+    BaseType, HistoryKind, InferVarId, Name, RefinementSet, Type, fresh_infer_var_id,
+};
 
 use crate::ccl::FieldKey;
 
@@ -276,15 +278,14 @@ pub struct CompactType {
     /// `Data ⊔ Data` join accumulated alternatives via [`union_domains`]), and the
     /// codomain. Recursively merged with polarity flip on the domain.
     pub fun: Option<CompactFun>,
-    /// Refinement contributions at this position. A set with `==`
-    /// membership (deduplicated by [`Refinement`]'s structural `PartialEq`),
-    /// stored as a `Vec` in first-insertion order. A refinement-set is
-    /// width-subtyped exactly like `rec`: more refinements ⇒ subtype
-    /// (`{T | p, q} <: {T | p}`), so at positive polarity the sets are
-    /// *intersected* and at negative *unioned* (see
-    /// [`CompactType::merge`]). The stored [`Refinement`] is the payload
-    /// carried to coalesce.
-    pub refinements: Vec<Refinement>,
+    /// Refinement contributions at this position — the same
+    /// [`RefinementSet`](crate::ccl::RefinementSet) the materialized `Type`
+    /// carries, so flattening and coalescing agree on what a claim set *is*
+    /// rather than each keeping its own bag. A claim set is width-subtyped
+    /// exactly like `rec`: more claims ⇒ subtype (`{T | p, q} <: {T | p}`), so
+    /// at positive polarity the sets are *intersected* and at negative
+    /// *unioned* (see [`CompactType::merge`]).
+    pub refinements: RefinementSet,
     /// History-handle `(value, domain, kind)`, if a [`Type::History`]
     /// contributed here — a mutable variable (`kind: Overwrite`) or a feed channel
     /// (`kind: Feed`).
@@ -366,19 +367,13 @@ impl CompactType {
     /// position the value reliably carries only the refinements *both*
     /// sides guarantee; at a negative position a consumer that may
     /// impose either set imposes their union.
-    fn merge_refinements(pol: bool, lhs: Vec<Refinement>, rhs: Vec<Refinement>) -> Vec<Refinement> {
+    fn merge_refinements(pol: bool, lhs: RefinementSet, rhs: RefinementSet) -> RefinementSet {
         if pol {
             // The types are being unioned, so the refinements should be intersected.
-            lhs.into_iter().filter(|r| rhs.contains(r)).collect()
+            lhs.intersect(&rhs)
         } else {
             // The types are being intersected, so the refinements should be unioned.
-            let mut out = lhs;
-            for r in rhs {
-                if !out.contains(&r) {
-                    out.push(r);
-                }
-            }
-            out
+            lhs.union(&rhs)
         }
     }
 
@@ -508,7 +503,7 @@ pub fn compact_type(ty: &Type) -> CompactGraph {
         recursive: HashMap::new(),
         rec_vars: BTreeMap::new(),
     };
-    let term = compact_go(ty, true, &Subst::id(), None, &mut st);
+    let term = compact_go(ty, true, &Subst::id(), None, &mut st, 0);
     CompactGraph {
         term,
         rec_vars: st.rec_vars,
@@ -572,8 +567,10 @@ struct CompactState {
 /// (`src/ccl/infer/solver/spec_key.rs`) traverses `Type` in lockstep with this
 /// function: the same polarity flip on a `Fun` domain, the same no-flip on
 /// `History` children, the same `then(edge_subst, subst_acc)` composition at a
-/// bound edge, the same binder shadowing for a Pi codomain, the same
-/// `(uid, pol)` cycle guard. That agreement *is* the soundness argument for a
+/// bound edge, the same `(uid, pol)` cycle guard. (The Pi-binder
+/// canonicalization they also share is not duplicated — both call
+/// [`Subst::canonical_pi_binder`], which owns that rule.) That agreement *is*
+/// the soundness argument for a
 /// specialization key: a bound the key cannot see is one the clone's own
 /// resolution cannot see either, because the clone resolves through this walk
 /// over the same edges from the same side. Nothing enforces it, so a new `Type`
@@ -587,6 +584,7 @@ fn compact_go(
     subst_acc: &Subst,
     parents: Option<&ParentPath<'_>>,
     st: &mut CompactState,
+    pi_depth: u8,
 ) -> CompactType {
     match ty {
         // Not a type — an annotation-position obligation, erased by
@@ -612,11 +610,10 @@ fn compact_go(
         // application's argument) before the refinement lands in the position.
         // The predicate is an immutable term, so a non-vacuous force builds a
         // fresh predicate from the (freshened) bound's content directly.
-        Type::Refinement(inner, r) => {
-            let mut ct = compact_go(inner, pol, subst_acc, parents, st);
-            let r = subst_acc.force_refinement(r);
-            if !ct.refinements.contains(&r) {
-                ct.refinements.push(r);
+        Type::Refinement(inner, claims) => {
+            let mut ct = compact_go(inner, pol, subst_acc, parents, st, pi_depth);
+            for r in claims {
+                ct.refinements.insert(subst_acc.force_refinement(r));
             }
             ct
         }
@@ -633,17 +630,16 @@ fn compact_go(
             // per child mirrors Scala's `Set.empty` argument — cycles
             // span only one variable's bound chain, not across
             // function boundaries.
-            let dom = compact_go(d, !pol, subst_acc, None, st);
-            // A Pi binder shadows the accumulated substitution inside the
-            // codomain (it binds the name locally), so restrict it there.
-            let cod_acc = match name {
-                Some(b) => subst_acc.shadow(b),
-                None => subst_acc.clone(),
-            };
-            let cod = compact_go(c, pol, &cod_acc, None, st);
+            let dom = compact_go(d, !pol, subst_acc, None, st, pi_depth);
+            // Canonical Pi binders (`Subst::canonical_pi_binder`, which states
+            // the rule and why the three walks applying it must agree). The
+            // rename also shadows any outer mapping of the source binder, which
+            // is what the previous `shadow(b)` was for.
+            let cod_scope = subst_acc.canonical_pi_binder(name, pi_depth);
+            let cod = compact_go(c, pol, &cod_scope.subst, None, st, cod_scope.depth);
             CompactType {
                 fun: Some(CompactFun {
-                    name: name.clone(),
+                    name: cod_scope.binder,
                     kind: KindMerge::of(kind),
                     domains: vec![dom],
                     codomain: Box::new(cod),
@@ -656,7 +652,10 @@ fn compact_go(
         Type::Tuple(ts) => {
             let mut compacted = BTreeMap::new();
             for (i, v) in ts.iter().enumerate() {
-                compacted.insert(FieldKey::Index(i), compact_go(v, pol, subst_acc, None, st));
+                compacted.insert(
+                    FieldKey::Index(i),
+                    compact_go(v, pol, subst_acc, None, st, pi_depth),
+                );
             }
             CompactType {
                 rec: Some(compacted),
@@ -668,7 +667,7 @@ fn compact_go(
             for (n, v) in fs {
                 compacted.insert(
                     FieldKey::Name(SmolStr::from(n.as_str())),
-                    compact_go(v, pol, subst_acc, None, st),
+                    compact_go(v, pol, subst_acc, None, st, pi_depth),
                 );
             }
             CompactType {
@@ -683,7 +682,7 @@ fn compact_go(
             // payload depth is unaffected.
             let mut compacted = BTreeMap::new();
             for (k, v) in tags {
-                compacted.insert(k.clone(), compact_go(v, pol, subst_acc, None, st));
+                compacted.insert(k.clone(), compact_go(v, pol, subst_acc, None, st, pi_depth));
             }
             CompactType {
                 var: Some(compacted),
@@ -700,8 +699,8 @@ fn compact_go(
             domain,
             kind,
         } => {
-            let value = compact_go(value, pol, subst_acc, None, st);
-            let domain = compact_go(domain, pol, subst_acc, None, st);
+            let value = compact_go(value, pol, subst_acc, None, st, pi_depth);
+            let domain = compact_go(domain, pol, subst_acc, None, st, pi_depth);
             CompactType {
                 history_slot: Some((Box::new(value), Box::new(domain), *kind)),
                 ..Default::default()
@@ -798,7 +797,7 @@ fn compact_go(
                 // arrives with every edge's morphism composed (design §3.6).
                 // Identity edges leave `subst_acc` unchanged (the common case).
                 let inner_acc = Subst::then(&b.render_subst(), subst_acc);
-                let bc = compact_go(&b.ty, pol, &inner_acc, Some(&new_parents), st);
+                let bc = compact_go(&b.ty, pol, &inner_acc, Some(&new_parents), st, pi_depth);
                 bound = Some(match bound {
                     None => bc,
                     Some(acc) => CompactType::merge(pol, acc, bc),
@@ -820,7 +819,7 @@ fn compact_go(
             if no_concrete {
                 for b in opposite_bounds.iter() {
                     let inner_acc = Subst::then(&b.render_subst(), subst_acc);
-                    let bc = compact_go(&b.ty, !pol, &inner_acc, Some(&new_parents), st);
+                    let bc = compact_go(&b.ty, !pol, &inner_acc, Some(&new_parents), st, pi_depth);
                     bound = Some(match bound {
                         None => bc,
                         Some(acc) => CompactType::merge(!pol, acc, bc),
@@ -849,6 +848,141 @@ fn compact_go(
 mod tests {
     use super::*;
 
+    /// **Finding, repaired: merging α-variant dependent bounds is canonical.**
+    /// Before canonical Pi binders, the merged fun shape kept the *first
+    /// arrival's* binder while the refinement sets unioned both α-copies of one
+    /// constraint, coalescing to the order-dependent — and dangling —
+    /// `(𝑥: 𝐷) ⤇ {{Int | __elem == 𝑥} | __elem == 𝑦}`. With `compact_go`
+    /// renaming binders and references to `Name::pi(depth)` as bounds flatten,
+    /// α-variants compact identically: the copies dedup, the binder is
+    /// arrival-independent, and nothing dangles.
+    #[test]
+    fn alpha_variant_bound_merge_is_canonical() {
+        use crate::ccl::infer::solver::test_helpers::dep_pred;
+        use crate::ccl::infer::solver::{
+            ConstrainCache, coalesce_compact, compact_type, constrain_subtype, fresh_var,
+            simplify_type,
+        };
+        use crate::ccl::{FunKind, Name, Refinement};
+
+        let dep_fun = |binder: &str| Type::Fun {
+            name: Some(Name::raw(binder)),
+            kind: FunKind::Data,
+            domain: Box::new(Type::UIntRange(3)),
+            codomain: Box::new(Type::refined_one(
+                Type::Base(BaseType::Int),
+                Refinement::born(dep_pred(binder)),
+            )),
+        };
+        let coalesce_with_order = |first: &Type, second: &Type| {
+            let v = fresh_var(0);
+            constrain_subtype(&v, first, &mut ConstrainCache::new()).unwrap();
+            constrain_subtype(&v, second, &mut ConstrainCache::new()).unwrap();
+            coalesce_compact(&simplify_type(compact_type(&v))).unwrap()
+        };
+        let (fx, fy) = (dep_fun("x"), dep_fun("y"));
+        let a = coalesce_with_order(&fx, &fy);
+        let b = coalesce_with_order(&fy, &fx);
+        assert_eq!(
+            a, b,
+            "α-variant bound merge must be arrival-order-independent"
+        );
+        // The α-copies collapsed: one binder, one predicate, nothing dangling.
+        let Type::Fun { name, codomain, .. } = &a else {
+            panic!("expected a function, got {a}");
+        };
+        assert_eq!(*name, Some(Name::pi(0)));
+        let Type::Refinement(base, _) = &**codomain else {
+            panic!("expected exactly one refinement layer, got {codomain}");
+        };
+        assert!(
+            !matches!(&**base, Type::Refinement(..)),
+            "the two α-copies of one constraint must dedup to one layer, got {codomain}"
+        );
+    }
+
+    /// The canonical rename must keep distinct enclosing binders distinct: a
+    /// predicate referencing the *inner* binder denotes a different type from one
+    /// referencing the *outer*, and the two must not flatten alike.
+    ///
+    /// This is the defect a shared rule cannot rule out on its own. A walk that
+    /// entered the codomain at the arrow's own depth would name both binders
+    /// `__pi0`, conflate the two predicates, and still be internally consistent —
+    /// idempotent, even, so comparing a type against its own canonical form would
+    /// not notice. Injectivity is what has to be asserted.
+    #[test]
+    fn canonical_binders_keep_distinct_binders_distinct() {
+        use crate::ccl::infer::solver::compact_type;
+        use crate::ccl::infer::solver::test_helpers::dep_pred;
+        use crate::ccl::{FunKind, Name, Refinement};
+
+        // `(x: [0,3]) ⤇ ((y: [0,4]) ⤇ {Int | __elem == 𝑏})`, for 𝑏 the inner
+        // binder in one case and the outer in the other.
+        let nested = |referenced: &str| Type::Fun {
+            name: Some(Name::raw("x")),
+            kind: FunKind::Data,
+            domain: Box::new(Type::UIntRange(3)),
+            codomain: Box::new(Type::Fun {
+                name: Some(Name::raw("y")),
+                kind: FunKind::Data,
+                domain: Box::new(Type::UIntRange(4)),
+                codomain: Box::new(Type::refined_one(
+                    Type::Base(BaseType::Int),
+                    Refinement::born(dep_pred(referenced)),
+                )),
+            }),
+        };
+        assert_ne!(
+            compact_type(&nested("y")).term,
+            compact_type(&nested("x")).term,
+            "canonicalization must not conflate the inner and outer Pi binders"
+        );
+    }
+
+    /// `compact_go` and [`Type::alpha_normalized`] must agree on the assignment,
+    /// because `lambda_elim` compares a solver-produced type (canonical already,
+    /// through this walk) against an independently rebuilt one by normalizing
+    /// both. Flattening the normal form is therefore a fixpoint.
+    #[test]
+    fn compacting_is_a_fixpoint_of_alpha_normalization() {
+        use crate::ccl::infer::solver::compact_type;
+        use crate::ccl::infer::solver::test_helpers::dep_pred;
+        use crate::ccl::{FunKind, Name, Refinement};
+
+        let dep =
+            |binder: &str, base: Type| Type::refined_one(base, Refinement::born(dep_pred(binder)));
+        let fun = |binder: Option<&str>, domain: Type, codomain: Type| Type::Fun {
+            name: binder.map(Name::raw),
+            kind: FunKind::Data,
+            domain: Box::new(domain),
+            codomain: Box::new(codomain),
+        };
+        // A binder sits in a *domain* (which keeps the arrow's own depth) and an
+        // unnamed arrow nests a scope, so every clause of the rule is exercised.
+        let ty = fun(
+            Some("x"),
+            fun(
+                Some("a"),
+                Type::UIntRange(3),
+                dep("a", Type::Base(BaseType::Int)),
+            ),
+            fun(
+                None,
+                Type::UIntRange(4),
+                fun(
+                    Some("y"),
+                    Type::UIntRange(5),
+                    dep("y", dep("x", Type::Base(BaseType::Int))),
+                ),
+            ),
+        );
+        assert_eq!(
+            compact_type(&ty).term,
+            compact_type(&ty.alpha_normalized()).term,
+            "compact_go must assign the same canonical binders as `alpha_normalized`"
+        );
+    }
+
     /// Compact merge at positive polarity unions tags.
     #[test]
     fn compact_merge_variants_positive_unions() {
diff --git a/src/ccl/infer/solver/confluence.rs b/src/ccl/infer/solver/confluence.rs
new file mode 100644
index 00000000..624e5878
--- /dev/null
+++ b/src/ccl/infer/solver/confluence.rs
@@ -0,0 +1,330 @@
+//! Order-independence (confluence) fuzz for the bound graph.
+//!
+//! The solver's design leans on arrival order not mattering: bounds are
+//! recorded and swept pairwise as constraints arrive, `KindMerge` forces
+//! "propagate transitively along links as they arrive, so ordering does not
+//! matter", and the one-sided var-var propagation is an explicitly open
+//! question (`design/type-inference.md`, "1. Algorithm Overview"). None of
+//! that is tested as a property. This harness does: apply the same
+//! constraint **set** in permuted orders, coalesce every variable, and
+//! assert the outcomes agree — where an outcome is the per-variable
+//! coalesced type (canonicalized: inference/kind variable ids renamed in
+//! first-occurrence order) or the fact of rejection.
+//!
+//! A violation is typing that depends on constraint arrival order: the same
+//! defect class as a non-transitive subtype relation, one level up.
+
+use super::constrain::{ConstrainCache, constrain_subtype};
+use super::differential::{Rng, gen_ty};
+use super::{coalesce_compact, compact_type, fresh_var, simplify_type};
+use crate::ccl::Type;
+use crate::ccl::ty::{FunKind, FunKindVar};
+
+/// One constraint in a generated set, phrased over variable *indices* so the
+/// same set can be replayed against freshly-minted variables per run.
+#[derive(Clone, Debug)]
+enum Spec {
+    /// `ground <: vᵢ` — a lower bound arrives.
+    Low(usize, Type),
+    /// `vᵢ <: ground` — an upper bound arrives.
+    Up(usize, Type),
+    /// `vᵢ <: vⱼ` — a var-var edge; the one-sided propagation target.
+    VarVar(usize, usize),
+}
+
+/// Replay `specs` in `order` against fresh variables.
+///
+/// The outcome is **acceptance** (no constraint rejected, every variable
+/// coalesces) plus, when accepted, the per-variable coalesced types. *Which*
+/// constraint trips the rejection of an unsatisfiable set is intrinsically
+/// order-relative under record-then-sweep (the last edge to arrive meets
+/// the already-recorded bounds) and emission order is fixed by the AST walk
+/// in the real pipeline — so error identity is deliberately not part of the
+/// outcome, but a set flipping between accepted and rejected across orders
+/// is a hard violation. Every constraint gets a fresh cache, as real
+/// emission does.
+fn run(nvars: usize, specs: &[Spec], order: &[usize]) -> String {
+    let vars: Vec<Type> = (0..nvars).map(|_| fresh_var(0)).collect();
+    let mut rejected = false;
+    for &i in order {
+        let result = match &specs[i] {
+            Spec::Low(v, t) => constrain_subtype(t, &vars[*v], &mut ConstrainCache::new()),
+            Spec::Up(v, t) => constrain_subtype(&vars[*v], t, &mut ConstrainCache::new()),
+            Spec::VarVar(a, b) => {
+                constrain_subtype(&vars[*a], &vars[*b], &mut ConstrainCache::new())
+            }
+        };
+        rejected |= result.is_err();
+    }
+    let mut coalesced = Vec::with_capacity(nvars);
+    for v in &vars {
+        match coalesce_compact(&simplify_type(compact_type(v))) {
+            Ok(t) => coalesced.push(format!("{t}")),
+            Err(_) => rejected = true,
+        }
+    }
+    if rejected {
+        "rejected".to_string()
+    } else {
+        canonicalize(&format!("{coalesced:?}"))
+    }
+}
+
+/// Rename `?N` (inference vars) and `κN` (kind vars) in first-occurrence
+/// order, so globally-fresh uids across runs compare equal.
+fn canonicalize(s: &str) -> String {
+    let mut out = String::with_capacity(s.len());
+    let mut seen: Vec<String> = Vec::new();
+    let mut chars = s.chars().peekable();
+    while let Some(c) = chars.next() {
+        if c == '?' || c == 'κ' {
+            let mut num = String::new();
+            while let Some(d) = chars.peek() {
+                if d.is_ascii_digit() {
+                    num.push(*d);
+                    chars.next();
+                } else {
+                    break;
+                }
+            }
+            if num.is_empty() {
+                out.push(c);
+                continue;
+            }
+            let key = format!("{c}{num}");
+            let idx = match seen.iter().position(|k| *k == key) {
+                Some(i) => i,
+                None => {
+                    seen.push(key);
+                    seen.len() - 1
+                }
+            };
+            out.push(c);
+            out.push_str(&format!("#{idx}"));
+        } else {
+            out.push(c);
+        }
+    }
+    out
+}
+
+/// Replace a function's concrete kind with a fresh kind *variable*
+/// (sometimes, top-level only) — the `KindMerge` force/link machinery only
+/// runs when kind vars exist, and its "ordering does not matter" claim is a
+/// prime target. Kind vars are stateful (`Rc`, forces accumulate), which is
+/// why `gen_specs` is re-run per permutation rather than the specs being
+/// cloned.
+fn maybe_kind_var(rng: &mut Rng, t: Type) -> Type {
+    match t {
+        Type::Fun {
+            name,
+            kind: _,
+            domain,
+            codomain,
+        } if rng.chance(1, 2) => Type::Fun {
+            name,
+            kind: FunKind::Var(FunKindVar::fresh()),
+            domain,
+            codomain,
+        },
+        other => other,
+    }
+}
+
+fn gen_specs(rng: &mut Rng, nvars: usize) -> Vec<Spec> {
+    let count = 2 + rng.below(5) as usize;
+    let mut specs = Vec::with_capacity(count);
+    for _ in 0..count {
+        let v = rng.below(nvars as u64) as usize;
+        match rng.below(4) {
+            0 => {
+                let t = gen_ty(rng, 2);
+                let t = maybe_kind_var(rng, t);
+                specs.push(Spec::Low(v, t));
+            }
+            1 => {
+                let t = gen_ty(rng, 2);
+                let t = maybe_kind_var(rng, t);
+                specs.push(Spec::Up(v, t));
+            }
+            2 if nvars > 1 => {
+                let mut w = rng.below(nvars as u64) as usize;
+                if w == v {
+                    w = (v + 1) % nvars;
+                }
+                specs.push(Spec::VarVar(v, w));
+            }
+            _ => {
+                // Correlated bounds — the same ground type arriving on both
+                // sides is where joins actually meet.
+                let t = gen_ty(rng, 2);
+                let t = maybe_kind_var(rng, t);
+                specs.push(if rng.chance(1, 2) {
+                    Spec::Low(v, t)
+                } else {
+                    Spec::Up(v, t)
+                });
+            }
+        }
+    }
+    specs
+}
+
+fn shuffle(rng: &mut Rng, n: usize) -> Vec<usize> {
+    let mut order: Vec<usize> = (0..n).collect();
+    for i in (1..n).rev() {
+        let j = rng.below((i + 1) as u64) as usize;
+        order.swap(i, j);
+    }
+    order
+}
+
+/// **Finding, repaired: a coalesced type's refinement claims are
+/// arrival-order-independent.** Two refined upper bounds meeting at one
+/// variable used to stack as `{{𝑇 | 𝑞} | 𝑝}` or `{{𝑇 | 𝑝} | 𝑞}` depending on
+/// which arrived first. Subtyping was always indifferent (the deficit
+/// machinery compares claims as a set), but `Type`'s equality was not, and
+/// structural equality is load-bearing where types are *identities*: the
+/// trivial-equality short-circuit, cache keys, and the recorded-vs-recomputed
+/// walls.
+///
+/// With [`RefinementSet`](crate::ccl::RefinementSet) the layers are one
+/// unordered set, so the two orders build the *same* type rather than two
+/// types a canonical sort could reconcile — which is why this asserts plain
+/// equality and the fuzz above needs no normalization.
+#[test]
+fn refinement_claims_are_arrival_order_independent() {
+    use crate::ccl::{Lit, Refinement, TypedExpr};
+    use std::rc::Rc;
+
+    let refined = |marker: i64| {
+        Type::refined_one(
+            Type::Base(crate::ccl::BaseType::Int),
+            Refinement::born(Rc::new(TypedExpr::lit(Lit::Int(marker)))),
+        )
+    };
+    let coalesce_with_order = |first: &Type, second: &Type| {
+        let v = fresh_var(0);
+        constrain_subtype(&v, first, &mut ConstrainCache::new()).unwrap();
+        constrain_subtype(&v, second, &mut ConstrainCache::new()).unwrap();
+        coalesce_compact(&simplify_type(compact_type(&v))).unwrap()
+    };
+    let (p, q) = (refined(1), refined(2));
+    let a = coalesce_with_order(&p, &q);
+    let b = coalesce_with_order(&q, &p);
+    assert_eq!(a, b, "refinement claims must not depend on arrival order");
+    // Both claims survived — the meet of two refined upper bounds carries each
+    // side's restriction, so this is a two-member set, not one order winning.
+    assert_eq!(a.claims().len(), 2, "expected both claims, got {a}");
+    // Rendering is order-stable too, so a diagnostic cannot leak the order.
+    assert_eq!(format!("{a}"), format!("{b}"));
+}
+
+/// **Exhibit (behaviour retained by design): refinement equality
+/// distinguishes cast-target vintages that rendering does not.**
+///
+/// Two claims can be `eq`-**unequal** while rendering identically, because
+/// `eq_refinement_predicate` deliberately compares a cast's target predicate —
+/// a semantic filter, not inference metadata (pinned by
+/// `refinement_eq_distinguishes_cast_target_predicates`). Conflating two casts
+/// whose targets carry different filters would let refinement-deficit matching
+/// accept an unsatisfied demand, so dedup must not collapse them.
+///
+/// This used to be the order-sensitivity residue: passes *manufactured*
+/// divergent vintages of one claim (wholesale `target := expr.ty` overwrites
+/// promoted route-dependent rebuilt types into the compared slot), and dedup
+/// correctly refused to collapse them — surfacing as duplicated claims under
+/// `CAMBRA_REFINEMENT_ORDER=reverse`. The canonical-discharge ruling closed
+/// that at the source (a cast's claims are term-determined; see
+/// `canonical_cast_ty` / `canonicalize_cast_types`, and `formal/design.md`),
+/// so the pipeline no longer produces render-alike unequal twins. This test
+/// keeps the equality's semantics pinned from the other side: when targets
+/// *genuinely* differ, rendering alike must not make them one claim.
+#[test]
+fn vintage_claims_render_alike_but_do_not_dedup() {
+    use crate::ccl::{BaseType, Refinement, Type, TypedExpr, ccl_utils::make_cast};
+    use std::rc::Rc;
+
+    // Two casts of one value, differing *only* in their targets' domain
+    // refinement — the shape a discharge mints at two comprehension depths.
+    let vintage = |marker: i64| {
+        let target = crate::ccl::ccl_utils::refined_data_fun(
+            Type::Base(BaseType::Int),
+            TypedExpr::lit(crate::ccl::Lit::Int(marker)),
+            Type::Base(BaseType::Int),
+        );
+        // A resolved `ty` is what makes the rendering elide the target — the
+        // post-inference form, where the two vintages become indistinguishable.
+        Refinement::born(Rc::new(
+            make_cast(TypedExpr::lit(crate::ccl::Lit::Int(0)), target)
+                .with_ty(Type::Base(BaseType::Int)),
+        ))
+    };
+    let (a, b) = (vintage(1), vintage(2));
+    assert_eq!(
+        crate::ccl::symbolic::symbolic(&a.predicate),
+        crate::ccl::symbolic::symbolic(&b.predicate),
+        "the two vintages must be indistinguishable in the rendering"
+    );
+    assert_ne!(a, b, "cast-target predicates distinguish the two vintages");
+
+    // So a set holds both, and which one an equal-rendering position ends up
+    // carrying depends on arrival — the residue the representation change does
+    // not reach.
+    let mut set = crate::ccl::RefinementSet::new();
+    set.insert(a.clone());
+    set.insert(b.clone());
+    assert_eq!(set.len(), 2, "vintages do not dedup: {set:?}");
+}
+
+#[test]
+fn bound_order_permutation_fuzz() {
+    let seed: u64 = std::env::var("CAMBRA_DIFF_SEED")
+        .ok()
+        .and_then(|s| s.parse().ok())
+        .unwrap_or(0xD1CE);
+    let n: usize = std::env::var("CAMBRA_DIFF_N")
+        .ok()
+        .and_then(|s| s.parse().ok())
+        .unwrap_or(2000);
+
+    let mut rng = Rng::new(seed);
+    let mut mismatches = Vec::new();
+    for case in 0..n {
+        // Specs are regenerated from the same sub-seed per permutation run:
+        // kind variables carry mutable force/link state in an `Rc`, so a
+        // cloned spec would leak one run's resolution into the next.
+        let case_seed = rng.next();
+        let build = || {
+            let mut r = Rng::new(case_seed);
+            let nvars = 1 + r.below(3) as usize;
+            let specs = gen_specs(&mut r, nvars);
+            (nvars, specs)
+        };
+        let (nvars, specs) = build();
+        let baseline = run(nvars, &specs, &(0..specs.len()).collect::<Vec<_>>());
+        for _ in 0..8 {
+            let (nvars, specs) = build();
+            let order = shuffle(&mut rng, specs.len());
+            let outcome = run(nvars, &specs, &order);
+            if outcome != baseline {
+                mismatches.push(format!(
+                    "case {case}: order {order:?} diverges\n  specs = {specs:?}\n  \
+                     baseline = {baseline}\n  permuted = {outcome}"
+                ));
+                break;
+            }
+        }
+    }
+    eprintln!(
+        "confluence: {n} constraint sets (seed {seed}), 8 permutations each, \
+         {} order-dependent",
+        mismatches.len()
+    );
+    assert!(
+        mismatches.is_empty(),
+        "{} order-dependent outcomes (first 3):\n{}",
+        mismatches.len(),
+        mismatches[..mismatches.len().min(3)].join("\n\n")
+    );
+}
diff --git a/src/ccl/infer/solver/constrain.rs b/src/ccl/infer/solver/constrain.rs
index 8747aa13..3fb1f913 100644
--- a/src/ccl/infer/solver/constrain.rs
+++ b/src/ccl/infer/solver/constrain.rs
@@ -21,7 +21,9 @@ use smol_str::SmolStr;
 
 use crate::ccl::subst::Subst;
 use crate::ccl::ty::{FunKind, FunKindVar};
-use crate::ccl::{BaseType, Bound, HistoryKind, InferVar, InferVarId, Level, Refinement, Type};
+use crate::ccl::{
+    BaseType, Bound, HistoryKind, InferVar, InferVarId, Level, Refinement, RefinementSet, Type,
+};
 
 use super::traits::{Trait, link_watches, notify_lower};
 use super::type_level;
@@ -886,8 +888,8 @@ fn constrain_go_impl(
         // refinement on a concrete value is an explicit `Restrict`, not
         // subsumption.
         (Type::Refinement(..), _) | (_, Type::Refinement(..)) => {
-            let (lbase, lrefs) = peel_refinements(lhs);
-            let (rbase, rrefs) = peel_refinements(rhs);
+            let (lbase, lrefs) = (lhs.peel_refinements(), lhs.claims());
+            let (rbase, rrefs) = (rhs.peel_refinements(), rhs.claims());
             // The refinements rhs requires that no transported lhs layer
             // matches (by `Refinement`'s structural `PartialEq`). Each side's
             // refinements are forced through its own morphism into the ambient frame
@@ -896,10 +898,10 @@ fn constrain_go_impl(
             // carries `sr` for them.
             let lrefs_in_ambient: Vec<Refinement> =
                 lrefs.iter().map(|l| sl.force_refinement(l)).collect();
-            let deficit: Vec<&Refinement> = rrefs
+            let deficit: RefinementSet = rrefs
                 .iter()
-                .copied()
                 .filter(|r| !lrefs_in_ambient.contains(&sr.force_refinement(r)))
+                .cloned()
                 .collect();
             if deficit.is_empty() {
                 // lhs's explicit layers already supply every refinement rhs requires.
@@ -908,7 +910,7 @@ fn constrain_go_impl(
                 // Variable base: flow the deficit onto it (`b₁ <: {b₂ | deficit}`)
                 // rather than rejecting; it fails later iff the variable
                 // resolves to a concrete base lacking those refinements.
-                let demanded = wrap_refinements(rbase, &deficit);
+                let demanded = Type::refined(rbase.clone(), deficit);
                 constrain_go(lbase, &demanded, sl, sr, cache)
             } else {
                 Err(ConstrainError::Mismatch {
@@ -925,30 +927,6 @@ fn constrain_go_impl(
     }
 }
 
-/// Peel all outer [`Type::Refinement`] layers, returning the bare base type
-/// and the refinements carried by the peeled layers (outermost first).
-fn peel_refinements(ty: &Type) -> (&Type, Vec<&Refinement>) {
-    let mut refs = Vec::new();
-    let mut cur = ty;
-    while let Type::Refinement(inner, r) = cur {
-        refs.push(r);
-        cur = inner;
-    }
-    (cur, refs)
-}
-
-/// Re-wrap `base` in the given [`Type::Refinement`] layers (passed
-/// outermost-first), preserving their order.
-///
-/// Used by [`constrain_subtype`]'s refinement arm to rebuild the deficit
-/// refinement `{rbase | S₂ \ S₁}` from the rhs's own layers, so the kept refinements
-/// retain their real [`crate::ccl::Refinement`] payloads (predicate `Rc`s).
-fn wrap_refinements(base: &Type, refs: &[&Refinement]) -> Type {
-    refs.iter().rev().fold(base.clone(), |acc, r| {
-        Type::Refinement(Box::new(acc), (*r).clone())
-    })
-}
-
 /// Give an extrusion proxy the same trait obligations as the variable it
 /// approximates.
 ///
@@ -1028,10 +1006,9 @@ pub fn extrude(ty: &Type, pol: bool, target_level: Level, cache: &mut ExtrudeCac
                 .map(|(k, t)| (k.clone(), extrude(t, pol, target_level, cache)))
                 .collect(),
         ),
-        Type::Refinement(inner, r) => Type::Refinement(
-            Box::new(extrude(inner, pol, target_level, cache)),
-            r.clone(),
-        ),
+        Type::Refinement(inner, r) => {
+            Type::refined(extrude(inner, pol, target_level, cache), r.clone())
+        }
         // Invariant payload: polarity is meaningless under invariance, so
         // both children are extruded with two-way proxies (a history is read
         // *and* written) instead of the polar one-way approximation below.
@@ -1291,8 +1268,8 @@ mod tests {
         // (`Refinement: PartialEq`).
         use crate::ccl::{Lit, TypedExpr};
         let mk = || {
-            Type::Refinement(
-                Box::new(prim(BaseType::Int)),
+            Type::refined_one(
+                prim(BaseType::Int),
                 Refinement::born(Rc::new(TypedExpr::lit(Lit::Bool(true)))),
             )
         };
@@ -1311,8 +1288,8 @@ mod tests {
         // not one of them.
         use crate::ccl::{Lit, TypedExpr};
         let refined_dom = || {
-            Type::Refinement(
-                Box::new(Type::UIntRange(3)),
+            Type::refined_one(
+                Type::UIntRange(3),
                 Refinement {
                     predicate: Rc::new(TypedExpr::lit(Lit::Bool(true))),
                 },
@@ -1397,8 +1374,8 @@ mod tests {
         use std::collections::hash_map::DefaultHasher;
         use std::hash::{Hash, Hasher};
         let mk = || {
-            Type::Refinement(
-                Box::new(prim(BaseType::Int)),
+            Type::refined_one(
+                prim(BaseType::Int),
                 Refinement::born(Rc::new(TypedExpr::lit(Lit::Bool(true)))),
             )
         };
@@ -1425,8 +1402,8 @@ mod tests {
         );
 
         // A structurally *different* predicate must not collapse into it.
-        let c = Type::Refinement(
-            Box::new(prim(BaseType::Int)),
+        let c = Type::refined_one(
+            prim(BaseType::Int),
             Refinement::born(Rc::new(TypedExpr::lit(Lit::Bool(false)))),
         );
         assert_ne!(a, c, "distinct predicates must stay distinct");
@@ -2004,8 +1981,8 @@ mod tests {
         let Type::Fun { domain, .. } = ty else {
             panic!("expected fun, got {ty}");
         };
-        let Type::Refinement(_, r) = domain.as_ref() else {
-            panic!("expected refined domain, got {domain}");
+        let [r] = domain.claims() else {
+            panic!("expected a singly-refined domain, got {domain}");
         };
         crate::ccl::symbolic::symbolic(&r.predicate)
     }
@@ -2024,10 +2001,7 @@ mod tests {
             "k",
             prim(BaseType::Int),
             Type::fun(
-                Type::Refinement(
-                    Box::new(prim(BaseType::Int)),
-                    gt_refinement(TypedExpr::var("k")),
-                ),
+                Type::refined_one(prim(BaseType::Int), gt_refinement(TypedExpr::var("k"))),
                 prim(BaseType::Int),
             ),
         );
@@ -2058,10 +2032,7 @@ mod tests {
             "k",
             prim(BaseType::Int),
             Type::fun(
-                Type::Refinement(
-                    Box::new(prim(BaseType::Int)),
-                    gt_refinement(TypedExpr::var("k")),
-                ),
+                Type::refined_one(prim(BaseType::Int), gt_refinement(TypedExpr::var("k"))),
                 prim(BaseType::Int),
             ),
         );
@@ -2098,10 +2069,7 @@ mod tests {
             "k",
             prim(BaseType::Int),
             Type::fun(
-                Type::Refinement(
-                    Box::new(prim(BaseType::Int)),
-                    gt_refinement(TypedExpr::var("k")),
-                ),
+                Type::refined_one(prim(BaseType::Int), gt_refinement(TypedExpr::var("k"))),
                 prim(BaseType::Int),
             ),
         )
diff --git a/src/ccl/infer/solver/differential.rs b/src/ccl/infer/solver/differential.rs
new file mode 100644
index 00000000..58913166
--- /dev/null
+++ b/src/ccl/infer/solver/differential.rs
@@ -0,0 +1,613 @@
+//! M1 differential oracle: `constrain_subtype`'s verdict on **ground** type
+//! pairs (no `Infer` on either side) diffed against the Lean model's
+//! `subCheck` (`formal/CclFormal/Decide.lean`; plan and adjudications in
+//! `formal/design.md`).
+//!
+//! The test generates biased ground pairs with a seeded PRNG, serializes
+//! them to the wire schema the Lean codec defines (`formal/CclFormal/Json.lean`),
+//! streams them through the `subverdict` oracle binary, and asserts the two
+//! verdicts agree case by case. It **skips loudly** when the oracle is not
+//! built (`cd formal && lake build`) so the suite stays green on machines
+//! without a Lean toolchain.
+//!
+//! Deliberately not generated: duplicate record/variant keys — outside
+//! `Ty.WF`, where the Rust's trivial-equality short-circuit and its
+//! find-first arms genuinely disagree (pinned below as
+//! `dup_key_record_trips_the_uniquely_keyed_invariant`). Everything else in
+//! the ground fragment is fair game.
+
+use std::io::{BufRead, BufReader, Write};
+use std::process::{Command, Stdio};
+use std::rc::Rc;
+
+use smol_str::SmolStr;
+
+use super::constrain::{ConstrainCache, constrain_subtype};
+use crate::ccl::ty::FunKind;
+use crate::ccl::{
+    BaseType, BinOpKind, CompareKind, FieldKey, Lit, Name, Refinement, Type, TypedExpr,
+    TypedExprNode,
+};
+
+/// xorshift64* — deterministic, dependency-free.
+pub(super) struct Rng(pub(super) u64);
+
+impl Rng {
+    pub(super) fn new(seed: u64) -> Self {
+        Rng(seed | 1)
+    }
+    pub(super) fn next(&mut self) -> u64 {
+        let mut x = self.0;
+        x ^= x >> 12;
+        x ^= x << 25;
+        x ^= x >> 27;
+        self.0 = x;
+        x.wrapping_mul(0x2545_F491_4F6C_DD1D)
+    }
+    pub(super) fn below(&mut self, n: u64) -> u64 {
+        self.next() % n
+    }
+    pub(super) fn chance(&mut self, num: u64, den: u64) -> bool {
+        self.below(den) < num
+    }
+}
+
+/// A predicate from the model's `Pred` vocabulary: `__elem`, literals, a
+/// binder reference, or `__elem == <binder>` (the dependent-refinement
+/// shape). Structural equality is all subtyping observes, so a small closed
+/// set that can collide and differ is enough.
+fn gen_pred(rng: &mut Rng) -> Rc<TypedExpr> {
+    match rng.below(6) {
+        0 => Rc::new(TypedExpr::var(Name::elem())),
+        1 => Rc::new(TypedExpr::lit(Lit::Bool(true))),
+        2 => Rc::new(TypedExpr::lit(Lit::Int(rng.below(3) as i64))),
+        _ => {
+            let x = if rng.chance(1, 2) { "x" } else { "y" };
+            Rc::new(TypedExpr::binop(
+                TypedExpr::var(Name::elem()),
+                BinOpKind::Compare(CompareKind::Equals),
+                TypedExpr::var(Name::raw(x)),
+            ))
+        }
+    }
+}
+
+fn gen_leaf(rng: &mut Rng) -> Type {
+    match rng.below(6) {
+        0 => Type::Base(BaseType::Int),
+        1 => Type::Base(BaseType::Bool),
+        2 => Type::Base(BaseType::String),
+        3 => Type::UIntRange(2 + rng.below(3) as usize),
+        4 => Type::DataSource(if rng.chance(1, 2) { "s" } else { "t" }.into()),
+        _ => Type::Txn,
+    }
+}
+
+pub(super) fn gen_ty(rng: &mut Rng, depth: u32) -> Type {
+    if depth == 0 || rng.chance(1, 3) {
+        return gen_leaf(rng);
+    }
+    match rng.below(5) {
+        0 => {
+            let kind = if rng.chance(1, 2) {
+                FunKind::Data
+            } else {
+                FunKind::Compute
+            };
+            let domain = gen_ty(rng, depth - 1);
+            let name = match rng.below(3) {
+                0 => None,
+                1 => Some(Name::raw("x")),
+                _ => Some(Name::raw("y")),
+            };
+            // With a Pi binder present, bias the codomain toward a dependent
+            // refinement so the binder correspondence actually fires.
+            let codomain = if name.is_some() && rng.chance(1, 2) {
+                Type::refined_one(gen_ty(rng, depth - 1), Refinement::born(gen_pred(rng)))
+            } else {
+                gen_ty(rng, depth - 1)
+            };
+            Type::Fun {
+                name,
+                kind,
+                domain: Box::new(domain),
+                codomain: Box::new(codomain),
+            }
+        }
+        1 => Type::Tuple((0..rng.below(3)).map(|_| gen_ty(rng, depth - 1)).collect()),
+        2 => {
+            let mut fields = Vec::new();
+            for key in ["a", "b", "c"] {
+                if rng.chance(1, 2) {
+                    fields.push((key.to_string(), gen_ty(rng, depth - 1)));
+                }
+            }
+            Type::Record(fields)
+        }
+        3 => {
+            let mut tags = Vec::new();
+            if rng.chance(1, 2) {
+                for key in ["t0", "t1"] {
+                    if rng.chance(2, 3) {
+                        tags.push((FieldKey::Name(SmolStr::from(key)), gen_ty(rng, depth - 1)));
+                    }
+                }
+            } else {
+                for i in 0..rng.below(3) {
+                    tags.push((FieldKey::Index(i as usize), gen_ty(rng, depth - 1)));
+                }
+            }
+            Type::Variant(tags)
+        }
+        _ => Type::refined_one(gen_ty(rng, depth - 1), Refinement::born(gen_pred(rng))),
+    }
+}
+
+/// A small directed edit of `t` — targets the width/refinement rules, where
+/// near-miss pairs have the interesting verdicts.
+fn edit(rng: &mut Rng, t: &Type) -> Type {
+    match rng.below(4) {
+        // Add a refinement layer (rhs gains a demand / lhs gains a supply).
+        0 => Type::refined_one(t.clone(), Refinement::born(gen_pred(rng))),
+        // Peel a refinement layer if there is one.
+        1 => match t {
+            Type::Refinement(base, _) => (**base).clone(),
+            _ => Type::Base(BaseType::Int),
+        },
+        // Narrow a product / widen a sum by one entry.
+        2 => match t {
+            Type::Record(fields) if !fields.is_empty() => {
+                Type::Record(fields[..fields.len() - 1].to_vec())
+            }
+            Type::Variant(tags) => {
+                let mut tags = tags.clone();
+                tags.push((FieldKey::Name(SmolStr::from("extra")), Type::Txn));
+                Type::Variant(tags)
+            }
+            Type::Tuple(ts) => {
+                let mut ts = ts.clone();
+                ts.push(Type::Base(BaseType::Bool));
+                Type::Tuple(ts)
+            }
+            _ => gen_ty(rng, 2),
+        },
+        _ => gen_ty(rng, 3),
+    }
+}
+
+/// `__elem == <name>` — the dependent-refinement predicate shape, aimed at
+/// a specific Pi binder.
+pub(super) fn dep_pred(name: &str) -> Rc<TypedExpr> {
+    Rc::new(TypedExpr::binop(
+        TypedExpr::var(Name::elem()),
+        BinOpKind::Compare(CompareKind::Equals),
+        TypedExpr::var(Name::raw(name)),
+    ))
+}
+
+/// Generate a **correlated** pair: both sides are built together, usually
+/// emitting identical nodes and occasionally diverging in exactly one aspect
+/// (a leaf, a kind, a binder name, a predicate, a width). Deep near-misses
+/// are where subtle rule divergence hides — top-level edits never reach a
+/// nested Pi correspondence or a refinement two constructors down.
+fn gen_pair(rng: &mut Rng, depth: u32) -> (Type, Type) {
+    if rng.chance(1, 8) {
+        return (gen_ty(rng, depth), gen_ty(rng, depth));
+    }
+    if depth == 0 || rng.chance(1, 3) {
+        let l = gen_leaf(rng);
+        let r = if rng.chance(1, 4) {
+            gen_leaf(rng)
+        } else {
+            l.clone()
+        };
+        return (l, r);
+    }
+    match rng.below(5) {
+        0 => {
+            let kl = if rng.chance(1, 2) {
+                FunKind::Data
+            } else {
+                FunKind::Compute
+            };
+            let kr = if rng.chance(1, 6) {
+                match kl {
+                    FunKind::Data => FunKind::Compute,
+                    _ => FunKind::Data,
+                }
+            } else {
+                kl.clone()
+            };
+            let (dl, dr) = gen_pair(rng, depth - 1);
+            let binder = |rng: &mut Rng| match rng.below(3) {
+                0 => None,
+                1 => Some("x"),
+                _ => Some("y"),
+            };
+            let nl = binder(rng);
+            let nr = if rng.chance(1, 4) { binder(rng) } else { nl };
+            let (mut cl, mut cr) = gen_pair(rng, depth - 1);
+            // Dependent refinements referencing each side's *own* binder:
+            // structurally α-equivalent, so they must match through the
+            // rename correspondence — unless we deliberately misaim one.
+            if rng.chance(1, 2) {
+                if let Some(bl) = nl {
+                    cl = Type::refined_one(cl, Refinement::born(dep_pred(bl)));
+                }
+                if let Some(br) = nr {
+                    let target = if rng.chance(1, 5) { "z" } else { br };
+                    cr = Type::refined_one(cr, Refinement::born(dep_pred(target)));
+                }
+            }
+            let fun = |n: Option<&str>, k: FunKind, d: Type, c: Type| Type::Fun {
+                name: n.map(Name::raw),
+                kind: k,
+                domain: Box::new(d),
+                codomain: Box::new(c),
+            };
+            (fun(nl, kl, dl, cl), fun(nr, kr, dr, cr))
+        }
+        1 => {
+            let len_l = rng.below(3) as usize;
+            let len_r = if rng.chance(1, 4) {
+                rng.below(3) as usize
+            } else {
+                len_l
+            };
+            let mut ls = Vec::new();
+            let mut rs = Vec::new();
+            for i in 0..len_l.max(len_r) {
+                let (l, r) = gen_pair(rng, depth - 1);
+                if i < len_l {
+                    ls.push(l);
+                }
+                if i < len_r {
+                    rs.push(r);
+                }
+            }
+            (Type::Tuple(ls), Type::Tuple(rs))
+        }
+        2 => {
+            let mut ls = Vec::new();
+            let mut rs = Vec::new();
+            for key in ["a", "b", "c"] {
+                let in_l = rng.chance(1, 2);
+                let in_r = if rng.chance(1, 6) { !in_l } else { in_l };
+                let (l, r) = gen_pair(rng, depth - 1);
+                if in_l {
+                    ls.push((key.to_string(), l));
+                }
+                if in_r {
+                    rs.push((key.to_string(), r));
+                }
+            }
+            (Type::Record(ls), Type::Record(rs))
+        }
+        3 => {
+            let mut ls = Vec::new();
+            let mut rs = Vec::new();
+            for key in ["t0", "t1"] {
+                let in_l = rng.chance(1, 2);
+                let in_r = if rng.chance(1, 6) { !in_l } else { in_l };
+                let (l, r) = gen_pair(rng, depth - 1);
+                if in_l {
+                    ls.push((FieldKey::Name(SmolStr::from(key)), l));
+                }
+                if in_r {
+                    rs.push((FieldKey::Name(SmolStr::from(key)), r));
+                }
+            }
+            (Type::Variant(ls), Type::Variant(rs))
+        }
+        _ => {
+            let (bl, br) = gen_pair(rng, depth - 1);
+            let pl = gen_pred(rng);
+            let pr = if rng.chance(1, 4) {
+                gen_pred(rng)
+            } else {
+                Rc::clone(&pl)
+            };
+            let mut l = Type::refined_one(bl, Refinement::born(pl));
+            let mut r = Type::refined_one(br, Refinement::born(pr));
+            // Occasionally give one side an extra layer — width on the
+            // refinement *set*.
+            if rng.chance(1, 4) {
+                l = Type::refined_one(l, Refinement::born(gen_pred(rng)));
+            }
+            if rng.chance(1, 6) {
+                r = Type::refined_one(r, Refinement::born(gen_pred(rng)));
+            }
+            (l, r)
+        }
+    }
+}
+
+/// A plausible subtype-partner for `t`, biased toward *accepted* edges so
+/// transitivity chains form at a workable rate: clones, directed edits, and
+/// domain/codomain-level edits that exercise contravariance.
+fn partner(rng: &mut Rng, t: &Type) -> Type {
+    match rng.below(8) {
+        0 | 1 => t.clone(),
+        2 | 3 => edit(rng, t),
+        4..=6 => match t {
+            // Edit *inside* a function: domain/codomain near-misses probe the
+            // contravariant edge and the codomain correspondence.
+            Type::Fun {
+                name,
+                kind,
+                domain,
+                codomain,
+            } => {
+                let flip_kind = rng.chance(1, 4);
+                Type::Fun {
+                    name: name.clone(),
+                    kind: if flip_kind {
+                        match kind {
+                            FunKind::Data => FunKind::Compute,
+                            _ => FunKind::Data,
+                        }
+                    } else {
+                        kind.clone()
+                    },
+                    domain: Box::new(if rng.chance(1, 2) {
+                        edit(rng, domain)
+                    } else {
+                        (**domain).clone()
+                    }),
+                    codomain: Box::new(if rng.chance(1, 2) {
+                        edit(rng, codomain)
+                    } else {
+                        (**codomain).clone()
+                    }),
+                }
+            }
+            _ => edit(rng, t),
+        },
+        _ => gen_ty(rng, 3),
+    }
+}
+
+/// Serialize a predicate into the model's `Pred` wire schema. `None` means
+/// "outside the modeled vocabulary" — the case is refused rather than
+/// serialized wrongly (the generator never produces such a predicate, so a
+/// `None` here is a harness bug).
+fn pred_json(e: &TypedExpr) -> Option<String> {
+    match &e.node {
+        TypedExprNode::Var(n) if *n == Name::elem() => Some(r#"{"k":"elem"}"#.to_string()),
+        TypedExprNode::Var(Name::Raw(s)) => Some(format!(r#"{{"k":"var","x":"{s}"}}"#)),
+        TypedExprNode::Lit(Lit::Int(n)) => Some(format!(r#"{{"k":"litInt","n":{n}}}"#)),
+        TypedExprNode::Lit(Lit::Bool(b)) => Some(format!(r#"{{"k":"litBool","b":{b}}}"#)),
+        TypedExprNode::BinOp { left, op, right } => Some(format!(
+            r#"{{"k":"binop","op":"{op:?}","a":{},"b":{}}}"#,
+            pred_json(left)?,
+            pred_json(right)?
+        )),
+        _ => None,
+    }
+}
+
+fn base_json(b: &BaseType) -> &'static str {
+    b.keyword()
+}
+
+fn key_json(k: &FieldKey) -> String {
+    match k {
+        FieldKey::Index(n) => format!(r#"{{"k":"idx","n":{n}}}"#),
+        FieldKey::Name(s) => format!(r#"{{"k":"name","s":"{s}"}}"#),
+    }
+}
+
+/// Serialize a ground `Type` into the model's `Ty` wire schema; `None` for
+/// anything outside the ground fragment.
+fn ty_json(t: &Type) -> Option<String> {
+    Some(match t {
+        Type::Base(b) => format!(r#"{{"k":"base","base":"{}"}}"#, base_json(b)),
+        Type::UIntRange(n) => format!(r#"{{"k":"uintRange","n":{n}}}"#),
+        Type::DataSource(s) => format!(r#"{{"k":"dataSource","name":"{s}"}}"#),
+        Type::Txn => r#"{"k":"txn"}"#.to_string(),
+        Type::Fun {
+            name,
+            kind,
+            domain,
+            codomain,
+        } => {
+            let binder = match name {
+                None => "null".to_string(),
+                Some(Name::Raw(s)) => format!(r#""{s}""#),
+                Some(_) => return None,
+            };
+            let kind = match kind {
+                FunKind::Compute => "compute",
+                FunKind::Data => "data",
+                FunKind::Var(_) => return None,
+            };
+            format!(
+                r#"{{"k":"fn","binder":{binder},"kind":"{kind}","dom":{},"cod":{}}}"#,
+                ty_json(domain)?,
+                ty_json(codomain)?
+            )
+        }
+        Type::Tuple(ts) => {
+            let ts: Option<Vec<_>> = ts.iter().map(ty_json).collect();
+            format!(r#"{{"k":"tuple","ts":[{}]}}"#, ts?.join(","))
+        }
+        Type::Record(fields) => {
+            let fs: Option<Vec<_>> = fields
+                .iter()
+                .map(|(n, t)| Some(format!(r#"["{n}",{}]"#, ty_json(t)?)))
+                .collect();
+            format!(r#"{{"k":"record","fields":[{}]}}"#, fs?.join(","))
+        }
+        Type::Variant(tags) => {
+            let ts: Option<Vec<_>> = tags
+                .iter()
+                .map(|(k, t)| Some(format!(r#"[{},{}]"#, key_json(k), ty_json(t)?)))
+                .collect();
+            format!(r#"{{"k":"variant","tags":[{}]}}"#, ts?.join(","))
+        }
+        // The model's `refined` node carries the whole claim set, matching
+        // `RefinementSet` — so a multi-claim position serializes as one node
+        // with a `claims` array rather than as nested single-predicate layers.
+        Type::Refinement(base, claims) => {
+            let preds: Option<Vec<String>> =
+                claims.iter().map(|r| pred_json(&r.predicate)).collect();
+            format!(
+                r#"{{"k":"refined","base":{},"claims":[{}]}}"#,
+                ty_json(base)?,
+                preds?.join(",")
+            )
+        }
+        _ => return None,
+    })
+}
+
+/// Transitivity chain fuzz: build chains `a <: b <: c` that `constrain`
+/// accepts and check the direct edge. No violations are tolerated — a hit is
+/// a finding, and fails the test with the triple printed.
+#[test]
+fn transitivity_chain_fuzz() {
+    let seed: u64 = std::env::var("CAMBRA_DIFF_SEED")
+        .ok()
+        .and_then(|s| s.parse().ok())
+        .unwrap_or(0xBEEF);
+    let n: usize = std::env::var("CAMBRA_DIFF_N")
+        .ok()
+        .and_then(|s| s.parse().ok())
+        .unwrap_or(4000);
+
+    let ok = |x: &Type, y: &Type| {
+        let mut cache = ConstrainCache::new();
+        constrain_subtype(x, y, &mut cache).is_ok()
+    };
+    let mut rng = Rng::new(seed);
+    let mut chains = 0usize;
+    let mut attempts = 0usize;
+    let mut violations: Vec<(Type, Type, Type)> = Vec::new();
+    while chains < n && attempts < n * 100 {
+        attempts += 1;
+        let b = gen_ty(&mut rng, 3);
+        let a = partner(&mut rng, &b);
+        let c = partner(&mut rng, &b);
+        if !(ok(&a, &b) && ok(&b, &c)) {
+            continue;
+        }
+        chains += 1;
+        if !ok(&a, &c) {
+            violations.push((a, b, c));
+        }
+    }
+
+    eprintln!(
+        "transitivity: {chains} chains (seed {seed}, {attempts} attempts), {} violations",
+        violations.len()
+    );
+    let render = |t: &Type| ty_json(t).unwrap_or_else(|| format!("{t:?}"));
+    assert!(
+        violations.is_empty(),
+        "transitivity violations (first 5):\n{}",
+        violations
+            .iter()
+            .take(5)
+            .map(|(a, b, c)| format!("a={}\nb={}\nc={}\n", render(a), render(b), render(c)))
+            .collect::<Vec<_>>()
+            .join("\n")
+    );
+}
+
+#[test]
+fn differential_ground_subtype_vs_lean_model() {
+    let oracle = concat!(
+        env!("CARGO_MANIFEST_DIR"),
+        "/formal/.lake/build/bin/subverdict"
+    );
+    if !std::path::Path::new(oracle).exists() {
+        eprintln!(
+            "SKIPPED differential_ground_subtype_vs_lean_model: Lean oracle not built \
+             (cd formal && lake build)"
+        );
+        return;
+    }
+    let seed: u64 = std::env::var("CAMBRA_DIFF_SEED")
+        .ok()
+        .and_then(|s| s.parse().ok())
+        .unwrap_or(0xC0FFEE);
+    let n: usize = std::env::var("CAMBRA_DIFF_N")
+        .ok()
+        .and_then(|s| s.parse().ok())
+        .unwrap_or(4000);
+
+    let mut rng = Rng::new(seed);
+    let mut cases = Vec::with_capacity(n);
+    while cases.len() < n {
+        let (lhs, rhs) = match rng.below(8) {
+            0 => {
+                let t = gen_ty(&mut rng, 3);
+                (t.clone(), t)
+            }
+            1 | 2 => {
+                let t = gen_ty(&mut rng, 3);
+                let e = edit(&mut rng, &t);
+                (t, e)
+            }
+            _ => gen_pair(&mut rng, 3),
+        };
+        let (Some(lj), Some(rj)) = (ty_json(&lhs), ty_json(&rhs)) else {
+            panic!("generator produced a type outside the ground wire schema: {lhs:?} / {rhs:?}");
+        };
+        let mut cache = ConstrainCache::new();
+        let rust = constrain_subtype(&lhs, &rhs, &mut cache).is_ok();
+        cases.push((format!(r#"{{"lhs":{lj},"rhs":{rj}}}"#), rust));
+    }
+
+    let mut child = Command::new(oracle)
+        .stdin(Stdio::piped())
+        .stdout(Stdio::piped())
+        .spawn()
+        .expect("spawn the subverdict oracle");
+    let mut stdin = child.stdin.take().unwrap();
+    let input: String = cases.iter().map(|(line, _)| format!("{line}\n")).collect();
+    let writer = std::thread::spawn(move || stdin.write_all(input.as_bytes()));
+
+    let mut verdicts = 0usize;
+    let mut mismatches = Vec::new();
+    for (i, line) in BufReader::new(child.stdout.take().unwrap())
+        .lines()
+        .enumerate()
+    {
+        let line = line.expect("read oracle verdict");
+        if i >= cases.len() {
+            break;
+        }
+        verdicts += 1;
+        let (case, rust) = &cases[i];
+        match line.as_str() {
+            "true" if *rust => {}
+            "false" if !*rust => {}
+            "true" | "false" => {
+                mismatches.push(format!("case {i}: rust={rust} lean={line}\n  {case}"))
+            }
+            other => mismatches.push(format!("case {i}: oracle said {other:?}\n  {case}")),
+        }
+    }
+    writer.join().unwrap().expect("write cases to oracle");
+    let _ = child.wait();
+
+    let accepted = cases.iter().filter(|(_, rust)| *rust).count();
+    eprintln!(
+        "differential: {} cases (seed {seed}), rust accepted {accepted}, rejected {}",
+        cases.len(),
+        cases.len() - accepted
+    );
+    assert_eq!(
+        verdicts,
+        cases.len(),
+        "oracle answered {verdicts}/{} cases",
+        cases.len()
+    );
+    assert!(
+        mismatches.is_empty(),
+        "{} verdict mismatches (seed {seed}, n {n}); first 10:\n{}",
+        mismatches.len(),
+        mismatches[..mismatches.len().min(10)].join("\n")
+    );
+}
diff --git a/src/ccl/infer/solver/mod.rs b/src/ccl/infer/solver/mod.rs
index 5a11a6f1..a55d94f4 100644
--- a/src/ccl/infer/solver/mod.rs
+++ b/src/ccl/infer/solver/mod.rs
@@ -42,7 +42,11 @@ use crate::ccl::{BaseType, InferVar, Level, Type};
 
 pub mod coalesce;
 pub mod compact;
+#[cfg(test)]
+mod confluence;
 pub mod constrain;
+#[cfg(test)]
+mod differential;
 pub mod scheme;
 pub mod simplify_type;
 pub mod spec_key;
@@ -135,6 +139,18 @@ pub(crate) mod test_helpers {
 
     use crate::ccl::{FieldKey, Refinement, Type};
 
+    /// `__elem == <name>` — the dependent-refinement predicate shape, aimed at a
+    /// specific Pi binder. Shared because a dependent codomain is the shape every
+    /// α-identity test needs, across `compact` and `spec_key`.
+    pub(crate) fn dep_pred(name: &str) -> Rc<crate::ccl::TypedExpr> {
+        use crate::ccl::{BinOpKind, CompareKind, Name, TypedExpr};
+        Rc::new(TypedExpr::binop(
+            TypedExpr::var(Name::elem()),
+            BinOpKind::Compare(CompareKind::Equals),
+            TypedExpr::var(Name::raw(name)),
+        ))
+    }
+
     /// Build a `Type` from `FieldKey`-keyed fields: all-`Name` → `Record`,
     /// otherwise a dense `Tuple` (the only product shapes `ccl::Type` has).
     /// Sparse-`Index` inputs have no `Type` form — tests that need them
@@ -168,7 +184,7 @@ pub(crate) mod test_helpers {
     pub(crate) fn refined(base: Type, marker: i64) -> Type {
         use crate::ccl::{Lit, TypedExpr};
         let r = Refinement::born(Rc::new(TypedExpr::lit(Lit::Int(marker))));
-        Type::Refinement(Box::new(base), r)
+        Type::refined_one(base, r)
     }
 
     /// Helper: build a `Type::Variant({tag: payload, ...})` with named
diff --git a/src/ccl/infer/solver/scheme.rs b/src/ccl/infer/solver/scheme.rs
index 9db56a63..7d741fae 100644
--- a/src/ccl/infer/solver/scheme.rs
+++ b/src/ccl/infer/solver/scheme.rs
@@ -211,7 +211,7 @@ fn freshen_level(ty: &Type) -> Level {
         Type::Infer(v) => v.level,
         _ => 0,
     };
-    if let Type::Refinement(_, r) = ty {
+    for r in ty.claims() {
         lvl = lvl.max(predicate_level(&r.predicate));
     }
     ty.walk_children(|c| lvl = lvl.max(freshen_level(c)));
@@ -313,15 +313,18 @@ pub fn freshen_above(
             domain: Box::new(freshen_above(lim, domain, target, cache)),
             kind: *kind,
         },
-        Type::Refinement(inner, r) => Type::Refinement(
-            Box::new(freshen_above(lim, inner, target, cache)),
+        Type::Refinement(inner, claims) => Type::refined(
+            freshen_above(lim, inner, target, cache),
             // Faithfully freshen the predicate's own type slots through the same
             // `cache`, so a specialization's predicate is a proper freshen
             // instance — its slots are the clone's fresh variables, driven
             // concrete by the use's pin — rather than sharing the definition's
             // unresolved ones. Immutable predicate terms are acyclic, so this
             // cannot loop.
-            freshen_refinement_predicate(lim, r, target, cache),
+            claims
+                .iter()
+                .map(|r| freshen_refinement_predicate(lim, r, target, cache))
+                .collect(),
         ),
         Type::Infer(tv) => {
             if let Some(existing) = cache.vars.get(&tv.uid) {
@@ -718,8 +721,8 @@ mod tests {
             TypedExpr::lit(crate::ccl::Lit::Bool(true))
                 .with_ty(Type::Infer(Rc::clone(&quantified))),
         );
-        let refined_domain = Type::Refinement(
-            Box::new(Type::UIntRange(3)), // ground base: hides the predicate's level
+        let refined_domain = Type::refined_one(
+            Type::UIntRange(3), // ground base: hides the predicate's level
             Refinement::sharing(&predicate),
         );
         let ty = Type::Fun {
@@ -740,7 +743,7 @@ mod tests {
         let Type::Fun { domain, .. } = &fresh else {
             panic!("expected a function type");
         };
-        let Type::Refinement(_, r) = &**domain else {
+        let [r] = domain.claims() else {
             panic!("expected the refinement to survive freshening");
         };
         let Type::Infer(v) = &r.predicate.ty else {
diff --git a/src/ccl/infer/solver/spec_key.rs b/src/ccl/infer/solver/spec_key.rs
index b0de6417..d510d0c0 100644
--- a/src/ccl/infer/solver/spec_key.rs
+++ b/src/ccl/infer/solver/spec_key.rs
@@ -336,12 +336,12 @@ pub fn spec_key(ty: &Type) -> SpecKey {
     // One walk-wide `ctx` for both reads: its memo is keyed by polarity, so the
     // two reads share it without contaminating each other.
     SpecKey {
-        positive: key_go(ty, true, &Subst::id(), &mut ctx),
-        negative: key_go(ty, false, &Subst::id(), &mut ctx),
+        positive: key_go(ty, true, &Subst::id(), &mut ctx, 0),
+        negative: key_go(ty, false, &Subst::id(), &mut ctx, 0),
     }
 }
 
-fn key_go(ty: &Type, pol: bool, subst_acc: &Subst, ctx: &mut KeyCtx) -> KeyView {
+fn key_go(ty: &Type, pol: bool, subst_acc: &Subst, ctx: &mut KeyCtx, pi_depth: u8) -> KeyView {
     match ty {
         // `BoundedHole` is a *pre-inference* annotation marker: `normalize_annotation`
         // erases it into a bounded variable before any constraint is emitted, so
@@ -372,11 +372,13 @@ fn key_go(ty: &Type, pol: bool, subst_acc: &Subst, ctx: &mut KeyCtx) -> KeyView
         // dependent-application discharge lands in the key as the predicate the
         // clone will actually carry — that is use-specific information, and two
         // uses discharging different arguments *should* key apart.
-        Type::Refinement(inner, r) => {
-            let mut k = key_go(inner, pol, subst_acc, ctx);
-            let r = subst_acc.force_refinement(r);
-            if !k.refinements.contains(&r) {
-                k.refinements.push(r);
+        Type::Refinement(inner, claims) => {
+            let mut k = key_go(inner, pol, subst_acc, ctx, pi_depth);
+            for r in claims {
+                let r = subst_acc.force_refinement(r);
+                if !k.refinements.contains(&r) {
+                    k.refinements.push(r);
+                }
             }
             k
         }
@@ -388,15 +390,15 @@ fn key_go(ty: &Type, pol: bool, subst_acc: &Subst, ctx: &mut KeyCtx) -> KeyView
         } => {
             // The domain is contravariant — the flip that makes the dual read
             // follow an argument's *lower* bounds.
-            let dom = key_go(domain, !pol, subst_acc, ctx);
-            // A Pi binder shadows the accumulated substitution inside the
-            // codomain, as in `compact_go`. The binder *name* itself is not part
-            // of the key — see `SpecKey::fun`.
-            let cod_acc = match name {
-                Some(b) => subst_acc.shadow(b),
-                None => subst_acc.clone(),
-            };
-            let cod = key_go(codomain, pol, &cod_acc, ctx);
+            let dom = key_go(domain, !pol, subst_acc, ctx, pi_depth);
+            // Canonical Pi binders (`Subst::canonical_pi_binder`), so a keyed
+            // predicate referencing the binder does so α-insensitively: two uses
+            // whose instantiation types differ only in source binder names key
+            // together. The canonical *name* is discarded — it is not part of
+            // the key (see `SpecKey::fun`); what matters is that the
+            // *references* were rewritten.
+            let cod_scope = subst_acc.canonical_pi_binder(name, pi_depth);
+            let cod = key_go(codomain, pol, &cod_scope.subst, ctx, cod_scope.depth);
             // Resolved through `KindMerge::of`, not off the `FunKind` itself: an
             // inferred kind is a variable whose identity is fresh per instantiation,
             // so keying on it would split every use; its *bounds* are the answer, and
@@ -410,7 +412,7 @@ fn key_go(ty: &Type, pol: bool, subst_acc: &Subst, ctx: &mut KeyCtx) -> KeyView
             rec: ts
                 .iter()
                 .enumerate()
-                .map(|(i, t)| (FieldKey::Index(i), key_go(t, pol, subst_acc, ctx)))
+                .map(|(i, t)| (FieldKey::Index(i), key_go(t, pol, subst_acc, ctx, pi_depth)))
                 .collect(),
             ..Default::default()
         },
@@ -420,7 +422,7 @@ fn key_go(ty: &Type, pol: bool, subst_acc: &Subst, ctx: &mut KeyCtx) -> KeyView
                 .map(|(n, t)| {
                     (
                         FieldKey::Name(SmolStr::from(n.as_str())),
-                        key_go(t, pol, subst_acc, ctx),
+                        key_go(t, pol, subst_acc, ctx, pi_depth),
                     )
                 })
                 .collect(),
@@ -429,7 +431,7 @@ fn key_go(ty: &Type, pol: bool, subst_acc: &Subst, ctx: &mut KeyCtx) -> KeyView
         Type::Variant(tags) => KeyView {
             var: tags
                 .iter()
-                .map(|(k, t)| (k.clone(), key_go(t, pol, subst_acc, ctx)))
+                .map(|(k, t)| (k.clone(), key_go(t, pol, subst_acc, ctx, pi_depth)))
                 .collect(),
             ..Default::default()
         },
@@ -440,8 +442,8 @@ fn key_go(ty: &Type, pol: bool, subst_acc: &Subst, ctx: &mut KeyCtx) -> KeyView
             domain,
             kind,
         } => {
-            let value = key_go(value, pol, subst_acc, ctx);
-            let domain = key_go(domain, pol, subst_acc, ctx);
+            let value = key_go(value, pol, subst_acc, ctx, pi_depth);
+            let domain = key_go(domain, pol, subst_acc, ctx, pi_depth);
             KeyView {
                 history: BTreeMap::from([(*kind, (Box::new(value), Box::new(domain)))]),
                 ..Default::default()
@@ -477,7 +479,7 @@ fn key_go(ty: &Type, pol: bool, subst_acc: &Subst, ctx: &mut KeyCtx) -> KeyView
                 // does: a bound reached transitively arrives with every edge's
                 // substitution composed.
                 let inner_acc = Subst::then(&b.render_subst(), subst_acc);
-                acc.union(key_go(&b.ty, pol, &inner_acc, ctx));
+                acc.union(key_go(&b.ty, pol, &inner_acc, ctx, pi_depth));
             }
             ctx.visiting.remove(&memo_key);
             if memoizable && ctx.truncations == truncations_before {
@@ -502,6 +504,78 @@ mod tests {
     use crate::ccl::infer_var::Bound;
     use crate::ccl::{BaseType, Lit, TypedExpr};
 
+    /// **Finding, repaired: α-variant dependent types key together.** Before
+    /// canonical Pi binders (`key_go` renaming references to `Name::pi(depth)`
+    /// as it walks), the binder name — deliberately excluded from the key —
+    /// leaked back in through the *predicates* that reference it, so
+    /// `(𝑥: 𝐷) ⤇ {Int | __elem == 𝑥}` at one call site and its `𝑦`-twin at
+    /// another keyed apart and split a specialization that should be shared.
+    #[test]
+    fn spec_key_shares_alpha_variant_dependent_types() {
+        use super::spec_key;
+        use crate::ccl::infer::solver::test_helpers::dep_pred;
+        use crate::ccl::{FunKind, Name, Refinement};
+
+        let dep_fun = |binder: &str| Type::Fun {
+            name: Some(Name::raw(binder)),
+            kind: FunKind::Data,
+            domain: Box::new(Type::UIntRange(3)),
+            codomain: Box::new(Type::refined_one(
+                Type::Base(BaseType::Int),
+                Refinement::born(dep_pred(binder)),
+            )),
+        };
+        let fx = dep_fun("x");
+        let fy = dep_fun("y");
+
+        // The relation reconciles the α-variants both ways…
+        let mut c = ConstrainCache::new();
+        assert!(constrain_subtype(&fx, &fy, &mut c).is_ok());
+        let mut c = ConstrainCache::new();
+        assert!(constrain_subtype(&fy, &fx, &mut c).is_ok());
+        // …and the specialization key now agrees.
+        assert_eq!(
+            spec_key(&fx),
+            spec_key(&fy),
+            "α-variant dependent instantiation types must share a specialization"
+        );
+    }
+
+    /// The key's canonical rename must stay **injective** over enclosing binders.
+    /// The key does not carry the binder name (see [`SpecKey::fun`]), so what
+    /// records which binder a predicate referenced is the rewritten reference
+    /// itself — and two keys that should differ collapse together if the rename
+    /// gives the inner and outer binders one name. A collapse here is an
+    /// *under*-split: two uses share a specialization whose interior was
+    /// resolved against the other's argument, which is the silent failure
+    /// `Subst::canonical_pi_binder` warns about.
+    #[test]
+    fn spec_key_keeps_distinct_binders_distinct() {
+        use super::spec_key;
+        use crate::ccl::infer::solver::test_helpers::dep_pred;
+        use crate::ccl::{FunKind, Name, Refinement};
+
+        let nested = |referenced: &str| Type::Fun {
+            name: Some(Name::raw("x")),
+            kind: FunKind::Data,
+            domain: Box::new(Type::UIntRange(3)),
+            codomain: Box::new(Type::Fun {
+                name: Some(Name::raw("y")),
+                kind: FunKind::Data,
+                domain: Box::new(Type::UIntRange(4)),
+                codomain: Box::new(Type::refined_one(
+                    Type::Base(BaseType::Int),
+                    Refinement::born(dep_pred(referenced)),
+                )),
+            }),
+        };
+        assert_ne!(
+            spec_key(&nested("y")),
+            spec_key(&nested("x")),
+            "keying must not conflate the inner and outer Pi binders"
+        );
+    }
+
     fn int() -> Type {
         Type::Base(BaseType::Int)
     }
@@ -541,14 +615,8 @@ mod tests {
 
     #[test]
     fn refinement_sets_compare_order_insensitively() {
-        let a = Type::Refinement(
-            Box::new(Type::Refinement(Box::new(int()), refined(1))),
-            refined(2),
-        );
-        let b = Type::Refinement(
-            Box::new(Type::Refinement(Box::new(int()), refined(2))),
-            refined(1),
-        );
+        let a = Type::refined_one(Type::refined_one(int(), refined(1)), refined(2));
+        let b = Type::refined_one(Type::refined_one(int(), refined(2)), refined(1));
         assert_eq!(spec_key(&a), spec_key(&b));
     }
 
@@ -733,12 +801,14 @@ mod tests {
             true,
             &Subst::id(),
             &mut fresh_ctx(),
+            0,
         );
         merged.union(key_go(
             &Type::data_fun(int(), int()),
             true,
             &Subst::id(),
             &mut fresh_ctx(),
+            0,
         ));
         assert_eq!(
             merged.fun.len(),
@@ -771,12 +841,14 @@ mod tests {
             true,
             &Subst::id(),
             &mut fresh_ctx(),
+            0,
         );
         merged.union(key_go(
             &history(HistoryKind::Append),
             true,
             &Subst::id(),
             &mut fresh_ctx(),
+            0,
         ));
         assert_eq!(
             merged.history.len(),
diff --git a/src/ccl/infer/solver/traits.rs b/src/ccl/infer/solver/traits.rs
index c08119c5..ec5940cf 100644
--- a/src/ccl/infer/solver/traits.rs
+++ b/src/ccl/infer/solver/traits.rs
@@ -1508,8 +1508,8 @@ mod tests {
     /// emission an operand is usually still a variable with nothing to strip.
     #[test]
     fn a_refinement_narrows_as_its_base() {
-        let refined = Type::Refinement(
-            Box::new(Type::Base(BaseType::String)),
+        let refined = Type::refined_one(
+            Type::Base(BaseType::String),
             crate::ccl::Refinement::born(Rc::new(crate::ccl::TypedExpr::lit(
                 crate::ccl::Lit::Bool(true),
             ))),
diff --git a/src/ccl/inline.rs b/src/ccl/inline.rs
index 653820e0..b62fdade 100644
--- a/src/ccl/inline.rs
+++ b/src/ccl/inline.rs
@@ -90,11 +90,7 @@ use crate::ccl::{
 /// are *not* folded here — `crate::ccl::simplify` handles that rewrite as a
 /// general rule so it fires consistently throughout the tree.
 pub fn inline_non_iterable_lambdas(expr: Expr) -> Expr {
-    let mut expr = inline_impl(expr);
-    // Beta-reduction rebuilds predicates on `expr.ty` (immutable terms); keep
-    // each `Cast`'s `target` slot in step so the post-pass typecheck matches.
-    crate::ccl::ccl_utils::sync_cast_targets(&mut expr);
-    expr
+    inline_impl(expr)
 }
 
 // ---------------------------------------------------------------------------
@@ -616,15 +612,7 @@ fn is_name_in_function_position(expr: &Expr, name: &Name) -> bool {
 /// equality. Anything subtler is exactly what should trip the assert and get a real
 /// `restrict` lift.
 fn refinement_discharged_by(arg_ty: &Type, param_ty: &Type) -> bool {
-    fn layers(mut ty: &Type) -> Vec<&Refinement> {
-        let mut out = Vec::new();
-        while let Type::Refinement(inner, r) = ty {
-            out.push(r);
-            ty = inner;
-        }
-        out
-    }
-    let demanded = layers(param_ty);
+    let demanded = param_ty.claims();
     if demanded.is_empty() {
         return true;
     }
@@ -636,11 +624,11 @@ fn refinement_discharged_by(arg_ty: &Type, param_ty: &Type) -> bool {
     // survive on the bare `Var` for the phase to find the read. Comparing the stamp
     // against the parameter would ask a handle to entail a fact about a value. See
     // `src/ccl/design/mutability.md`, "`Mut` is a CCL type".
-    let mut supplied = layers(arg_ty);
+    let mut supplied: Vec<&Refinement> = arg_ty.claims().iter().collect();
     if let Some(value) = arg_ty.mut_value_type() {
-        supplied.extend(layers(value));
+        supplied.extend(value.claims());
     }
-    demanded.iter().all(|d| supplied.contains(d))
+    demanded.iter().all(|d| supplied.contains(&d))
 }
 
 // ---------------------------------------------------------------------------
@@ -728,7 +716,7 @@ mod tests {
         use std::rc::Rc;
         let pred = Rc::new(TypedExpr::lit(Lit::Bool(true)));
         let refinement = Refinement::born(pred);
-        let ty = Type::Refinement(Box::new(Type::Base(BaseType::Int)), refinement);
+        let ty = Type::refined_one(Type::Base(BaseType::Int), refinement);
         assert!(!is_iterable_domain(&ty));
     }
 
@@ -738,7 +726,7 @@ mod tests {
         use std::rc::Rc;
         let pred = Rc::new(TypedExpr::lit(Lit::Bool(true)));
         let refinement = Refinement::born(pred);
-        let ty = Type::Refinement(Box::new(Type::UIntRange(3)), refinement);
+        let ty = Type::refined_one(Type::UIntRange(3), refinement);
         assert!(is_iterable_domain(&ty));
     }
 
@@ -807,7 +795,7 @@ mod tests {
             name: None,
             kind: crate::ccl::ty::FunKind::Compute,
             domain: Box::new(Type::Base(BaseType::Int)),
-            codomain: Box::new(Type::Refinement(Box::new(inner_fun), refinement)),
+            codomain: Box::new(Type::refined_one(inner_fun, refinement)),
         };
         assert!(should_inline(&ty));
     }
diff --git a/src/ccl/lambda_elim.rs b/src/ccl/lambda_elim.rs
index 6f796526..d2d7a3b1 100644
--- a/src/ccl/lambda_elim.rs
+++ b/src/ccl/lambda_elim.rs
@@ -91,11 +91,12 @@ pub fn run(expr: Expr) -> Result<Expr, LambdaElimError> {
     // → simplify (→ planning) sub-pipeline when a refined type is iterated
     // (`planning::compile_refinement_predicates`).
     let mut simplified = simplify(point_free);
-    // Predicate rewrites during elimination/simplification rebuild the
-    // immutable predicate on each node's `expr.ty`; re-sync every `Cast`'s
-    // `target` slot to its `expr.ty` so the post-pass typecheck's
-    // reconstruction matches the recorded type.
-    crate::ccl::ccl_utils::sync_cast_targets(&mut simplified);
+    // Elimination and simplification rebuild node types from surrounding term
+    // structure; restore each `Cast`'s canonical split (`target` = born
+    // claims, `expr.ty` = value-claims ∪ born on the rebuilt view) so the
+    // post-pass typecheck's reconstruction matches the recorded type without
+    // making the cast's claims route-dependent.
+    crate::ccl::ccl_utils::canonicalize_cast_types(&mut simplified);
     Ok(simplified)
 }
 
@@ -1259,13 +1260,16 @@ fn elim_lambdas_impl(ctx: &mut ElimContext, expr: Expr) -> Result<Expr, LambdaEl
             #[cfg(debug_assertions)]
             let original = symbolic(&Expr::lambda(&param.name, param.ty.clone(), *body.clone()));
             let result = elim_lambda(ctx, &param.name, &param.ty, *body)?;
-            // Compare modulo Pi binder *presence*: the point-free
-            // construction keeps a dependent morphism's own binder (same
-            // `Name`, uid-preserved) but rebuilds combinator arrows with
-            // `name: None`; see `Type::without_pi_names`.
+            // Compare modulo Pi binder *identity and presence*: the
+            // coalesced original carries canonical (`__pi{n}`) binders while
+            // the point-free construction rebuilds from the term's own
+            // binder names (and combinator arrows with `name: None`) — so
+            // α-normalize both sides first, then erase binder presence; see
+            // `Type::alpha_normalized` / `Type::without_pi_names`.
             #[cfg(debug_assertions)]
             assert!(
-                original_ty.without_pi_names() == result.ty.without_pi_names(),
+                original_ty.alpha_normalized().without_pi_names()
+                    == result.ty.alpha_normalized().without_pi_names(),
                 "{}\nto\n{}\nwith {} vs {}",
                 original,
                 symbolic(&result),
@@ -1314,7 +1318,7 @@ fn elim_lambdas_impl(ctx: &mut ElimContext, expr: Expr) -> Result<Expr, LambdaEl
             let source_domain = target_elim.ty.domain().unwrap();
             let source_codomain = target_elim.ty.codomain().unwrap();
             let refinement = Refinement::born(Rc::new(pred_on_source));
-            let refined_domain = Type::Refinement(Box::new(source_domain), refinement);
+            let refined_domain = Type::refined_one(source_domain, refinement);
             let refined_source = target_elim.with_ty(Type::fun(refined_domain, source_codomain));
             let body_elim = elim_lambda(ctx, &param.name, &param.ty, true_body)?;
             let result = typed_compose(vec![refined_source, elim_lambdas(ctx, body_elim)?]);
@@ -1423,7 +1427,8 @@ fn elim_lambdas_impl(ctx: &mut ElimContext, expr: Expr) -> Result<Expr, LambdaEl
         debug_typecheck(e);
         #[cfg(debug_assertions)]
         assert!(
-            original_ty.without_pi_names() == e.ty.without_pi_names(),
+            original_ty.alpha_normalized().without_pi_names()
+                == e.ty.alpha_normalized().without_pi_names(),
             "{} vs {}",
             original_ty,
             e.ty
@@ -1661,7 +1666,7 @@ mod tests {
         // a dedicated AST field. `substitute` must descend through the type
         // (via `substitute_in_type`) into the predicate body.
         let refinement = Refinement::born(Rc::new(refinement_pred));
-        let refined_param = Type::Refinement(Box::new(int_ty()), refinement);
+        let refined_param = Type::refined_one(int_ty(), refinement);
         let expr = Expr::lambda("x", int_ty(), Expr::var("x").with_ty(int_ty()))
             .with_ty(fun_ty(refined_param, int_ty()));
 
@@ -1672,9 +1677,9 @@ mod tests {
         // Extract the refinement predicate from the result's domain type to
         // verify substitution descended into it.
         let pred_after_subst = match &result.ty {
-            Type::Fun { domain, .. } => match domain.as_ref() {
-                Type::Refinement(_, r) => (*r.predicate).clone(),
-                other => panic!("expected refined domain, got {other}"),
+            Type::Fun { domain, .. } => match domain.claims() {
+                [r] => (*r.predicate).clone(),
+                _ => panic!("expected a singly-refined domain, got {domain}"),
             },
             other => panic!("expected function type, got {other}"),
         };
@@ -1793,7 +1798,7 @@ mod tests {
 
         // Uncorrelated refinement (a Bool constant predicate) on the param.
         let refinement = Refinement::born(Rc::new(Expr::lit(Lit::Bool(true)).with_ty(bool_ty)));
-        let refined_y_ty = Type::Refinement(Box::new(int_ty()), refinement);
+        let refined_y_ty = Type::refined_one(int_ty(), refinement);
         let body = var("y").with_ty(int_ty());
 
         // Eliminate λ y → y over the refined domain.
@@ -1848,10 +1853,7 @@ mod tests {
 
         // Tuple([Int, {Int | __elem > x}]): the predicate rides only the second
         // component, so `any`-vs-`all` is observable.
-        let tuple_ty = Type::Tuple(vec![
-            int_ty(),
-            Type::Refinement(Box::new(int_ty()), refinement),
-        ]);
+        let tuple_ty = Type::Tuple(vec![int_ty(), Type::refined_one(int_ty(), refinement)]);
 
         // Lit(42) typed with the tuple above — the expression node itself has no
         // free vars, so both answers come entirely from `is_free_in_type`.
diff --git a/src/ccl/names.rs b/src/ccl/names.rs
index 23777b12..72c45504 100644
--- a/src/ccl/names.rs
+++ b/src/ccl/names.rs
@@ -68,13 +68,31 @@ pub enum ReservedName {
     /// The refinement element binder, spelled `__elem`. One shared name across
     /// every refinement (see the module docs and [`crate::ccl::Refinement`]).
     Elem,
+    /// A **canonical Pi binder**, spelled `__pi{depth}` — `depth` counts the
+    /// enclosing Pi binders at the arrow's position. The solver canonicalizes
+    /// every arrow's binder to this name as it flattens types
+    /// (`compact.rs` / `spec_key.rs`), the same move [`ReservedName::Elem`] makes for
+    /// refinements: one shared name per position makes α-equivalence coincide
+    /// with structural equality, so α-variant types merge, dedup, and key
+    /// identically instead of splitting on which source binder they descended
+    /// from.
+    Pi(u8),
 }
 
+/// Spellings for [`ReservedName::Pi`], one per supported depth. Sixteen is
+/// far beyond any real Pi spine (the deepest today is three); the indexing
+/// panic on a deeper one is a loud tripwire, not a silent cap.
+const PI_SPELLINGS: [&str; 16] = [
+    "__pi0", "__pi1", "__pi2", "__pi3", "__pi4", "__pi5", "__pi6", "__pi7", "__pi8", "__pi9",
+    "__pi10", "__pi11", "__pi12", "__pi13", "__pi14", "__pi15",
+];
+
 impl ReservedName {
     /// The canonical source-disjoint spelling.
     pub fn spelling(self) -> &'static str {
         match self {
             ReservedName::Elem => "__elem",
+            ReservedName::Pi(depth) => PI_SPELLINGS[depth as usize],
         }
     }
 }
@@ -171,6 +189,11 @@ impl Name {
         Name::Reserved(ReservedName::Elem)
     }
 
+    /// The canonical Pi binder at `depth` (see [`ReservedName::Pi`]).
+    pub fn pi(depth: u8) -> Self {
+        Name::Reserved(ReservedName::Pi(depth))
+    }
+
     /// Mint a compiler-introduced binder of `kind` with a globally fresh
     /// `uid`. The named wrappers below are the call-site vocabulary.
     fn synthetic(kind: SyntheticKind) -> Self {
diff --git a/src/ccl/planning/groupby.rs b/src/ccl/planning/groupby.rs
index 9a59cfb0..e5bed4e0 100644
--- a/src/ccl/planning/groupby.rs
+++ b/src/ccl/planning/groupby.rs
@@ -101,29 +101,19 @@ fn convert_groupby_pointful(expr: &Expr) -> Option<Expr> {
     else {
         return None;
     };
-    let Type::Refinement(idx_ty, refinement) = refined_dom.as_ref() else {
-        return None;
-    };
-    // The bare predicate binds the implicit REFINEMENT_BINDER as the element:
-    //   pred = (__elem ▷ c ▷ key) == <key binder>
-    let pred = &*refinement.predicate;
-    let TypedExprNode::BinOp {
-        left,
-        op: BinOpKind::Compare(CompareKind::Equals),
-        right,
-    } = &pred.node
-    else {
-        return None;
-    };
-    // Identify which side is the element-extraction `__elem ▷ c ▷ key` and which
-    // is the free key binder (a `Var` not bound by the element).
-    let extract = if side_extracts_element(left) && is_free_var(right) {
-        left
-    } else if side_extracts_element(right) && is_free_var(left) {
-        right
-    } else {
+    let Type::Refinement(idx_ty, claims) = refined_dom.as_ref() else {
         return None;
     };
+    // Find the claim that *is* the grouping equation, by its shape. The domain
+    // may carry other claims (an ordinary filter on the grouped collection);
+    // they are not this rewrite's to consume, so they ride along on the index
+    // type below. Nothing distinguishes the grouping claim positionally — the
+    // set is unordered — which is exactly why the recognizer asks what a claim
+    // *says* rather than where it sits.
+    let (gate, extract) = claims
+        .iter()
+        .enumerate()
+        .find_map(|(i, r)| groupby_key_extraction(r).map(|e| (i, e)))?;
     // extract = r ▷ c ▷ key = Apply { argument: Apply { argument: Var(r), .. }, function: key }
     let TypedExprNode::Apply {
         function: key_expr,
@@ -149,7 +139,17 @@ fn convert_groupby_pointful(expr: &Expr) -> Option<Expr> {
     // Compile the pointful key function to a point-free morphism V ⇒ K, then
     // build `keys = c ≫ key : I ⇒ K` and `values = c : I ⇒ V`.
     let key_pf = lambda_elim::run((**key_expr).clone()).ok()?;
-    let value_idx_ty = (**idx_ty).clone();
+    // Every claim except the consumed grouping equation stays on the index
+    // domain — dropping them here would silently discard a filter.
+    let value_idx_ty = Type::refined(
+        (**idx_ty).clone(),
+        claims
+            .iter()
+            .enumerate()
+            .filter(|(i, _)| *i != gate)
+            .map(|(_, r)| r.clone())
+            .collect(),
+    );
     let keys =
         compose((**c).clone(), key_pf).with_ty(Type::fun(value_idx_ty.clone(), (**key_ty).clone()));
     let grouped_values = emit_groupby(
@@ -165,6 +165,29 @@ fn convert_groupby_pointful(expr: &Expr) -> Option<Expr> {
     Some(typed_compose(new_elts).with_ty(expr.ty.clone()))
 }
 
+/// Read a claim as a group-by key equation, yielding its element-extraction
+/// side: the bare predicate binds the implicit `REFINEMENT_BINDER` as the
+/// element, so the grouping claim reads `(__elem ▷ c ▷ key) == <key binder>` —
+/// one side extracting from the element, the other a free key binder.
+fn groupby_key_extraction(r: &crate::ccl::Refinement) -> Option<&Expr> {
+    let TypedExprNode::BinOp {
+        left,
+        op: BinOpKind::Compare(CompareKind::Equals),
+        right,
+    } = &r.predicate.node
+    else {
+        return None;
+    };
+    let (left, right) = (left.as_ref(), right.as_ref());
+    if side_extracts_element(left) && is_free_var(right) {
+        Some(left)
+    } else if side_extracts_element(right) && is_free_var(left) {
+        Some(right)
+    } else {
+        None
+    }
+}
+
 /// Is `e` the element-extraction `__elem ▷ c ▷ key` — an application whose
 /// innermost argument is the refinement element binder?
 fn side_extracts_element(e: &Expr) -> bool {
diff --git a/src/ccl/planning/iterate.rs b/src/ccl/planning/iterate.rs
index 5a3d7cc5..1c078da6 100644
--- a/src/ccl/planning/iterate.rs
+++ b/src/ccl/planning/iterate.rs
@@ -367,30 +367,28 @@ pub(super) fn wrap_with_iterate(expr: &mut Expr) {
     // `restrict(p_inner)`, `restrict(p_next)`, … per refinement layer,
     // narrowing the domain layer by layer.  Unrefined sites get just
     // the iterate.
-    // Recover each layer's point-free predicate function from its bare
-    // `__elem ▷ p` form — that is what `make_restrict` filters with (the
-    // refinement type it then re-stamps stays bare).
-    let mut preds: Vec<Expr> = Vec::new();
-    let mut current = &domain_ty;
-    while let Type::Refinement(base, refinement) = current {
-        preds.push(fn_of_bare_predicate(base.as_ref(), &refinement.predicate));
-        current = base.as_ref();
-    }
-    preds.reverse();
+    let base = domain_ty.peel_refinements();
     let body = take(expr);
-    // Build the iteration source by applying one `restrict(p)` per
-    // refinement layer (innermost first) to a chain-head `iterate(true)`
-    // over the unrefined base.  Each `restrict` is a function transformer
-    // *applied* to its upstream (not composed): `make_restrict` narrows
-    // the domain layer by layer while preserving the codomain, so `source`
-    // ends with type `{{…{D | p_inner} …} | p_outer} ⇒ D` — the full
-    // refinement on the domain.  The value-producing `body` is then
+    // Build the iteration source by applying one `restrict(p)` per claim to a
+    // chain-head `iterate(true)` over the unrefined base.  Each `restrict` is a
+    // function transformer *applied* to its upstream (not composed):
+    // `make_restrict` narrows the domain by one claim while preserving the
+    // codomain, so `source` ends with type `{D | p₁, …, pₙ} ⇒ D` — the site's
+    // full claim set on the domain.  The value-producing `body` is then
     // composed onto that source as a genuine CCC morphism.
+    //
+    // Each claim's predicate function is recovered from its bare `__elem ▷ p`
+    // form against the element type that stage of the pipeline actually sees —
+    // the base narrowed by the claims applied before it (`application_order`,
+    // which `compile_predicates_in_type` walks identically so the compiled
+    // predicates match these stages). Any order of the claims yields a
+    // well-typed pipeline for the same final domain; the order is planning's to
+    // choose, which is what lets the claim set itself stay unordered.
     let site_ty = body.ty.clone();
-    let source = preds.into_iter().fold(
-        make_iterate(trivially_true_predicate(current.clone())),
-        |upstream, pred| make_restrict(pred, upstream),
-    );
+    let mut source = make_iterate(trivially_true_predicate(base.clone()));
+    for (r, elem_ty) in crate::ccl::application_order(domain_ty.claims(), base) {
+        source = make_restrict(fn_of_bare_predicate(&elem_ty, &r.predicate), source);
+    }
     // An iteration source produces the refined extent it iterates, so its
     // codomain is the *site's* refined domain `{D | p}`, mirroring
     // `make_iterate`'s `{D | p} ⇒ {D | p}` symmetry. Surfacing the refinement
diff --git a/src/ccl/planning/join.rs b/src/ccl/planning/join.rs
index a258347e..5278c403 100644
--- a/src/ccl/planning/join.rs
+++ b/src/ccl/planning/join.rs
@@ -718,20 +718,13 @@ fn join_plan_to_expr(plan: &JoinPlan, types: &[Type]) -> Expr {
         JoinPlan::Loop { arms, predicate } => {
             let base_iteration = (|| {
                 if arms.len() == 1 {
-                    if let Type::Refinement(base_ty, refinement) = &types[arms[0]] {
-                        // `convert_loop_join` only reads the predicate (it
-                        // builds a new expr), so borrow the immutable term
-                        // rather than clone it.
-                        let pred = &*refinement.predicate;
-                        trace!("Attempting loop join conversion inside iteration");
-                        if let Some(transformed) = convert_loop_join(base_ty, pred) {
-                            trace!(
-                                "Converted iteration to {} : {}",
-                                symbolic(&transformed),
-                                transformed.ty
-                            );
-                            return transformed;
-                        }
+                    if let Some(transformed) = convert_claim_to_join(&types[arms[0]]) {
+                        trace!(
+                            "Converted iteration to {} : {}",
+                            symbolic(&transformed),
+                            transformed.ty
+                        );
+                        return transformed;
                     }
                     make_iterate(trivially_true_predicate(types[arms[0]].clone()))
                 } else {
@@ -1036,22 +1029,46 @@ fn convert_loop_join(base_ty: &Type, refinement: &Expr) -> Option<Expr> {
 /// `FinalOrDefault` streams, at `Loop` sources, at `Copair`
 /// operands, or as a let-bound function value.
 ///
+/// Compile **one** of a refined domain's claims into a join, leaving the others
+/// as ordinary restrictions on the domain the join reads.
+///
+/// Any claim may be the join condition — the set is unordered, so there is no
+/// "the" predicate to read — and the first that [`convert_loop_join`] accepts
+/// wins. That also gives planning latitude it could not have while claims were
+/// a chain: when several are joinable, which one becomes the join is a free
+/// choice a cost model may later make, and the rest remain filters either way.
+/// `None` for an unrefined domain or when no claim forms a join.
+fn convert_claim_to_join(domain_ty: &Type) -> Option<Expr> {
+    let Type::Refinement(base, claims) = domain_ty else {
+        return None;
+    };
+    trace!("Attempting loop join conversion inside iteration");
+    claims.iter().enumerate().find_map(|(i, r)| {
+        let rest = Type::refined(
+            (**base).clone(),
+            claims
+                .iter()
+                .enumerate()
+                .filter(|(j, _)| *j != i)
+                .map(|(_, c)| c.clone())
+                .collect(),
+        );
+        // `convert_loop_join` only reads the predicate (it builds a new expr),
+        // so borrow the immutable term rather than clone it.
+        convert_loop_join(&rest, &r.predicate)
+    })
+}
+
 /// Supports n-way joins (n ≥ 2) when all arms are connected via equality
 /// conditions that form a spanning tree.  Build/probe assignment follows
 /// the BFS order of that spanning tree.  For now, predicates must be
 /// expressed as conjunctions of single-arm equality conditions.
 pub(super) fn try_hash_join_rewrite(expr: &mut Expr, domain_ty: &Type) -> bool {
-    let Type::Refinement(base, refinement) = domain_ty else {
-        return false;
-    };
-    // `convert_loop_join` only reads the predicate (it builds a new expr), so
-    // borrow the immutable term rather than clone it.
-    let pred = &*refinement.predicate;
     trace!(
         "Attempting hash-join rewrite at iteration site: {}",
         symbolic(expr),
     );
-    let Some(transformed) = convert_loop_join(base, pred) else {
+    let Some(transformed) = convert_claim_to_join(domain_ty) else {
         trace!("Hash-join pattern did not match");
         return false;
     };
diff --git a/src/ccl/planning/mod.rs b/src/ccl/planning/mod.rs
index 06a89254..b95e73ea 100644
--- a/src/ccl/planning/mod.rs
+++ b/src/ccl/planning/mod.rs
@@ -115,11 +115,7 @@ pub fn run(mut expr: Expr) -> Expr {
     // the `Apply(_, Iterate)` / `Apply(_, Restrict)` markers just inserted,
     // so the only rules that fire here are the always-safe cleanups (plus
     // any reduction of a fully marker-free sub-tree, which is sound).
-    let mut expr = simplify(expr);
-    // Compilation rebuilt the immutable predicate on each node's `expr.ty`;
-    // re-sync every `Cast`'s `target` slot so the post-planning typecheck's
-    // reconstruction (which reads `target`) matches the compiled recorded type.
-    ccl_utils::sync_cast_targets(&mut expr);
+    let expr = simplify(expr);
     // Live cross-endpoint reads are recognized earlier, in
     // `transact_phase::rewrite_live_reads` (pre-lambda-elim), so by here every
     // such read is already an `as_of` join — nothing to do at planning time.
@@ -296,7 +292,7 @@ pub(crate) mod test_helpers {
     /// predicate.  The predicate must have type `base ⇒ Bool` so the
     /// refinement is well-formed.
     pub(crate) fn refined_ty(base: Type, predicate: Expr) -> Type {
-        Type::Refinement(Box::new(base), Refinement::born(Rc::new(predicate)))
+        Type::refined_one(base, Refinement::born(Rc::new(predicate)))
     }
 
     /// Build an `Apply { argument, function: <builtin> }` whose function
diff --git a/src/ccl/planning/predicates.rs b/src/ccl/planning/predicates.rs
index 6bcbff75..77ef7f3c 100644
--- a/src/ccl/planning/predicates.rs
+++ b/src/ccl/planning/predicates.rs
@@ -8,6 +8,7 @@
 //! op-conversion lowering consume.
 
 use super::*;
+use crate::ccl::RefinementSet;
 
 // Predicate compilation is a predicate-*rebuilding* pass like any other, so it
 // memoizes with the shared [`ccl_utils::PredMemo`] — including its keepalive
@@ -109,10 +110,47 @@ fn term_mentions_pair_binder(e: &Expr) -> bool {
 /// case the per-`Rc` memo keeps shared occurrences equal despite `lambda_elim`'s
 /// `__pair` minting (see [`PredMemo`]).
 pub(crate) fn compile_refinement_predicates(expr: &mut Expr, memo: &PredMemo<Type>) {
+    // A `Cast`'s target claims are assertions on the cast's *value*: the
+    // checker types them with `__elem` bound at the value's domain (see
+    // `emit_cast`), which carries the value's own claims. Compile them against
+    // that same base — a target holds only the cast's *born* claims, so
+    // deriving the element type from the target alone would stamp `__elem`
+    // bare and fail the checker's argument edge against a predicate function
+    // whose domain the value's claims narrow.
+    if let TypedExprNode::Cast { value, target } = &mut expr.node {
+        let value_dom = value.ty.domain();
+        compile_cast_target(target, value_dom, memo);
+        compile_predicates_in_type(&mut expr.ty, memo);
+        compile_refinement_predicates(value, memo);
+        return;
+    }
     expr.walk_type_slots_mut(|ty| compile_predicates_in_type(ty, memo));
     expr.walk_children_mut(|child| compile_refinement_predicates(child, memo));
 }
 
+/// Compile a cast target's domain claims against the value's domain (the
+/// assertion base — see [`compile_refinement_predicates`]), then the rest of
+/// the target generically. The top-level domain refinement must not be
+/// revisited by the generic walk: recompiling it against the target's bare
+/// base would re-stamp `__elem` with the narrower context lost.
+fn compile_cast_target(target: &mut Type, value_dom: Option<Type>, memo: &PredMemo<Type>) {
+    if let Type::Fun {
+        domain, codomain, ..
+    } = target
+    {
+        if let Type::Refinement(base, claims) = domain.as_mut() {
+            let assert_base = value_dom.unwrap_or_else(|| (**base).clone());
+            compile_claims(claims, &assert_base, memo);
+            compile_predicates_in_type(base, memo);
+        } else {
+            compile_predicates_in_type(domain, memo);
+        }
+        compile_predicates_in_type(codomain, memo);
+    } else {
+        compile_predicates_in_type(target, memo);
+    }
+}
+
 /// The point-free predicate function `p : base ⇒ Bool` underlying a refinement's
 /// bare predicate `__elem ▷ p` (the inverse of [`ccl_utils::bare_predicate_of_fn`]).
 /// Fast-pathed when the bare predicate is already that single application;
@@ -128,8 +166,27 @@ pub(crate) fn fn_of_bare_predicate(base: &Type, bare: &Expr) -> Expr {
 }
 
 fn compile_predicates_in_type(ty: &mut Type, memo: &PredMemo<Type>) {
-    if let Type::Refinement(base, refinement) = ty {
-        let base_ctx = (**base).clone();
+    if let Type::Refinement(base, claims) = ty {
+        let base = base.clone();
+        compile_claims(claims, &base, memo);
+    }
+    // Recurse into structural type children (refinement base, function
+    // domain/codomain, tuple/record/variant elements).
+    ty.walk_children_mut(|child| compile_predicates_in_type(child, memo));
+}
+
+/// Compile each claim of a set against the element type it sees in the restrict
+/// pipeline planning will build for this domain — `base` narrowed by the claims
+/// applied before it. `wrap_with_iterate` builds that pipeline from the same
+/// application order, so the compiled predicates and the pipeline's types
+/// agree. For a cast target's claims, `base` is the cast value's domain (the
+/// assertion base — see [`compile_refinement_predicates`]).
+fn compile_claims(claims: &mut RefinementSet, base: &Type, memo: &PredMemo<Type>) {
+    // Indexed by physical position (`application_elem_types`), because the
+    // rewrite below walks the set in place and the application order is a
+    // *permutation* of the physical one.
+    let elem_tys = crate::ccl::application_elem_types(claims.as_slice(), base);
+    for (refinement, base_ctx) in claims.iter_mut().zip(elem_tys) {
         memo.rebuild(refinement, &base_ctx, |bare| {
             // Normalize the bare predicate to `__elem ▷ p` with `p` point-free:
             // recover the predicate function and re-wrap it. This keeps the stored
@@ -164,7 +221,4 @@ fn compile_predicates_in_type(ty: &mut Type, memo: &PredMemo<Type>) {
             true
         });
     }
-    // Recurse into structural type children (refinement base, function
-    // domain/codomain, tuple/record/variant elements).
-    ty.walk_children_mut(|child| compile_predicates_in_type(child, memo));
 }
diff --git a/src/ccl/simplify.rs b/src/ccl/simplify.rs
index 9a0b7970..876e228e 100644
--- a/src/ccl/simplify.rs
+++ b/src/ccl/simplify.rs
@@ -452,6 +452,16 @@ fn try_pairwise_in_compose(
         Expr::compose(elts)
     };
     expr.ty = ty;
+    // A chain that collapsed to a single `Cast` must not inherit the chain's
+    // interface type wholesale: a cast's claims are term-determined (its type
+    // is the value's domain claims ∪ the target's born claims), while the
+    // chain's recorded type was derived from neighbour types — which can be
+    // route-dependent where inference left route-dependent slots. Keep the
+    // chain's shape and bases, restore the term-determined claims.
+    if let TypedExprNode::Cast { value, target } = &expr.node {
+        let view = expr.ty.clone();
+        expr.ty = crate::ccl::ccl_utils::canonical_cast_ty(target, Some(&value.ty), view);
+    }
     expr.user_annotation = user_annotation;
     true
 }
diff --git a/src/ccl/subst.rs b/src/ccl/subst.rs
index e023580f..464f3bc5 100644
--- a/src/ccl/subst.rs
+++ b/src/ccl/subst.rs
@@ -154,6 +154,32 @@ impl Mapping {
 #[derive(Clone, Debug, Default, PartialEq)]
 pub struct Subst(BTreeMap<Binder, Mapping>);
 
+/// Everything a `Fun`'s codomain must be walked under, produced by one call to
+/// [`Subst::canonical_pi_binder`].
+///
+/// The three fields travel together so that a walk cannot take the canonical
+/// binder and then derive the codomain's depth itself. Getting the name right
+/// and the depth wrong is what this type exists to prevent: entering a codomain
+/// at the arrow's own depth names every enclosing binder `__pi0`, which
+/// conflates the predicates that reference them while staying internally
+/// consistent — and idempotent, so comparing a type against its own canonical
+/// form does not detect it. What each walk owes the others, and the tests that
+/// pin it, are in `src/ccl/design/type-inference.md`, "Canonicalizing a Pi
+/// binder needs a position, so it happens at flattening".
+#[derive(Debug, Clone)]
+pub struct PiCodomain {
+    /// The canonical binder to record on the rebuilt arrow; `None` for a
+    /// non-dependent one.
+    pub binder: Option<Name>,
+    /// The substitution the codomain's predicate references resolve through —
+    /// this morphism with the binder's rename applied on top.
+    pub subst: Subst,
+    /// The codomain's own depth. Every arrow nests a binder's scope whether or
+    /// not it names one, so this is always one deeper than the arrow's; a
+    /// domain keeps the arrow's depth and is therefore walked without it.
+    pub depth: u8,
+}
+
 impl Subst {
     /// The identity substitution — a perfect no-op. `apply_*` on it returns the
     /// input structurally unchanged.
@@ -317,6 +343,54 @@ impl Subst {
         Subst(m)
     }
 
+    /// The **canonical Pi binder** rule, in one place.
+    ///
+    /// A function type's binder at codomain-depth `depth` is the reserved
+    /// [`Name::pi`] name for that depth, and the rename rides the accumulated
+    /// substitution so that every reference to the old binder inside the
+    /// codomain — a dependent refinement predicate, say — is rewritten as that
+    /// codomain is walked. Returns the canonical binder and the substitution to
+    /// walk the codomain under; the caller recurses at `depth + 1` (a domain
+    /// keeps `depth`, since only codomain arrows nest a binder's scope).
+    ///
+    /// The depth makes the binder a *position*, and flattening is the first
+    /// point in the pipeline where a Pi reference has one: while a dependent
+    /// refinement rides a bound edge, the variable holding it need not sit under
+    /// the binder its predicate references, so there is no index to write. That
+    /// is why the rewrite cannot move earlier, and why the alternatives that
+    /// look like they remove it do not — see `src/ccl/design/type-inference.md`,
+    /// "Canonicalizing a Pi binder needs a position, so it happens at flattening".
+    ///
+    /// One shared name per position is what makes α-variant types flatten to
+    /// identical shapes, so they merge, their refinement copies dedup rather
+    /// than accumulating a dangling twin, and every identity built on the
+    /// flattened form is α-insensitive.
+    ///
+    /// **Three walks apply it and must agree exactly**, which is why the rule
+    /// lives here rather than being spelled out in each: `compact_go` (the
+    /// flattened bound graph), `spec_key::key_go` (the specialization key), and
+    /// [`Type::alpha_normalized`](crate::ccl::Type::alpha_normalized) (the pure
+    /// function the recorded-vs-recomputed walls compare through). A divergence
+    /// between the first two is *silent* and yields a shared clone whose
+    /// interior was resolved against a different use's argument.
+    pub fn canonical_pi_binder(&self, name: &Option<Name>, depth: u8) -> PiCodomain {
+        match name {
+            Some(b) => {
+                let canon = Name::pi(depth);
+                PiCodomain {
+                    binder: Some(canon.clone()),
+                    subst: self.extended_rename(b.clone(), canon),
+                    depth: depth + 1,
+                }
+            }
+            None => PiCodomain {
+                binder: None,
+                subst: self.clone(),
+                depth: depth + 1,
+            },
+        }
+    }
+
     /// Extend this substitution with a fresh binder correspondence `k ↦ x`
     /// (the Pi-vs-Pi binder alignment derived in the codomain edge). `k` is a
     /// newly-scoped binder, so this is an insert, not a composition.
@@ -801,7 +875,7 @@ impl Subst {
                 restricted.rewrite_type_go(codomain, memo);
             }
 
-            Type::Refinement(base, r) => {
+            Type::Refinement(base, claims) => {
                 // The refinement implicitly binds REFINEMENT_BINDER in its bare
                 // predicate, so the substitution acts *under* that binder.
                 let restricted = self.shadow(&Name::elem());
@@ -811,26 +885,28 @@ impl Subst {
                 // served to an occurrence inside it (and a vacuous decision made
                 // inside is never served outside). That is what makes threading one
                 // memo across binder crossings correct — see `PredMemo`.
-                memo.rebuild(r, &restricted, |pred| {
-                    if !restricted.0.keys().any(|k| is_free(k, pred)) {
-                        // Vacuous: no substituted binder occurs free here, so report
-                        // no change and keep the origin `Rc` — a predicate this
-                        // substitution merely walks past stays shared with its other
-                        // occurrences (mirroring `force_refinement`'s transport
-                        // path). Memoizing the decision also makes this `is_free`
-                        // scan run once per distinct predicate, not per occurrence.
-                        return false;
-                    }
-                    restricted.rewrite_expr_go(pred, memo);
-                    // Keep the predicate marker-free: a substituted collection may
-                    // carry a term-tree `iterate` marker that must not leak into a
-                    // type (see `strip_iterate_markers` and the `force_refinement`
-                    // twin). Only the rewritten path needs it — a marker arrives
-                    // *through* the substitution, so the vacuous path above, which
-                    // rewrites nothing and keeps the origin `Rc`, has none to strip.
-                    *pred = strip_iterate_markers(pred);
-                    true
-                });
+                for r in claims.iter_mut() {
+                    memo.rebuild(r, &restricted, |pred| {
+                        if !restricted.0.keys().any(|k| is_free(k, pred)) {
+                            // Vacuous: no substituted binder occurs free here, so report
+                            // no change and keep the origin `Rc` — a predicate this
+                            // substitution merely walks past stays shared with its other
+                            // occurrences (mirroring `force_refinement`'s transport
+                            // path). Memoizing the decision also makes this `is_free`
+                            // scan run once per distinct predicate, not per occurrence.
+                            return false;
+                        }
+                        restricted.rewrite_expr_go(pred, memo);
+                        // Keep the predicate marker-free: a substituted collection may
+                        // carry a term-tree `iterate` marker that must not leak into a
+                        // type (see `strip_iterate_markers` and the `force_refinement`
+                        // twin). Only the rewritten path needs it — a marker arrives
+                        // *through* the substitution, so the vacuous path above, which
+                        // rewrites nothing and keeps the origin `Rc`, has none to strip.
+                        *pred = strip_iterate_markers(pred);
+                        true
+                    });
+                }
                 self.rewrite_type_go(base, memo);
             }
 
@@ -1012,12 +1088,15 @@ impl Subst {
                 }
             }
 
-            Type::Refinement(base, r) => {
+            Type::Refinement(base, claims) => {
                 // The refinement implicitly binds REFINEMENT_BINDER in its bare
                 // predicate; `force_refinement` shadows it before rewriting.
                 // Substituting the predicate changes its meaning, so it builds a
                 // fresh predicate `Rc` rather than sharing the original's.
-                Type::Refinement(Box::new(self.apply_type(base)), self.force_refinement(r))
+                Type::refined(
+                    self.apply_type(base),
+                    claims.iter().map(|r| self.force_refinement(r)).collect(),
+                )
             }
 
             Type::Tuple(ts) => Type::Tuple(ts.iter().map(|t| self.apply_type(t)).collect()),
@@ -1164,15 +1243,17 @@ fn collect_type_fv(
                 collect_type_fv(codomain, bnd, visited, out)
             });
         }
-        Type::Refinement(base, r) => {
+        Type::Refinement(base, claims) => {
             // Walk each predicate term at most once (a term shared by `Rc`
             // across occurrences is a DAG — dedup, not cycle-breaking). The
             // refinement binds the implicit REFINEMENT_BINDER over `base`, so it
             // is bound — not free — inside the predicate.
-            if visited.insert(r.predicate_id()) {
-                with_binders(bound, [Name::elem()], |bnd| {
-                    collect_expr_fv(&r.predicate, bnd, visited, out)
-                });
+            for r in claims {
+                if visited.insert(r.predicate_id()) {
+                    with_binders(bound, [Name::elem()], |bnd| {
+                        collect_expr_fv(&r.predicate, bnd, visited, out)
+                    });
+                }
             }
             collect_type_fv(base, bound, visited, out);
         }
@@ -1337,11 +1418,11 @@ mod tests {
         use std::rc::Rc;
         // y : {_ | k > 0} — `k` appears only in the type slot's predicate.
         let slot_ref = Refinement::born(Rc::new(gt(var("k"), int(0))));
-        let e = var("y").with_ty(Type::Refinement(Box::new(Type::Hole), slot_ref.clone()));
+        let e = var("y").with_ty(Type::refined_one(Type::Hole, slot_ref.clone()));
         let dis = Subst::discharge("k", int(5));
 
         let out = dis.apply_expr(&e);
-        let Type::Refinement(_, out_ref) = &out.ty else {
+        let [out_ref] = out.ty.claims() else {
             panic!("type slot preserved");
         };
         assert_eq!(
@@ -1361,7 +1442,7 @@ mod tests {
         let forced = dis.force_refinement(&outer);
         assert!(!Rc::ptr_eq(&forced.predicate, &outer.predicate));
         let forced_pred = &*forced.predicate;
-        let Type::Refinement(_, nested) = &forced_pred.ty else {
+        let [nested] = forced_pred.ty.claims() else {
             panic!("nested refinement preserved");
         };
         assert_eq!(*nested.predicate, gt(int(5), int(0)));
@@ -1397,7 +1478,7 @@ mod tests {
     #[test]
     fn scenario_f_context_check() {
         let pred = TypedExpr::lambda("y", Type::Hole, gt(var("y"), var("k")));
-        let bad = Type::Refinement(Box::new(Type::infer()), Refinement::born(Rc::new(pred)));
+        let bad = Type::refined_one(Type::infer(), Refinement::born(Rc::new(pred)));
         let only_x: BTreeSet<Binder> = [Name::raw("x")].into_iter().collect();
         let only_k: BTreeSet<Binder> = [Name::raw("k")].into_iter().collect();
         assert!(!well_formed(&bad, &only_x));
@@ -1441,12 +1522,12 @@ mod tests {
     #[test]
     fn apply_type_discharges_refinement_predicate() {
         let r = Refinement::born(Rc::new(gt(var("i"), var("k"))));
-        let ty = Type::fun(Type::Refinement(Box::new(Type::infer()), r), Type::infer());
+        let ty = Type::fun(Type::refined_one(Type::infer(), r), Type::infer());
         let out = Subst::discharge("k", int(5)).apply_type(&ty);
         let Type::Fun { domain, .. } = &out else {
             panic!("expected fun");
         };
-        let Type::Refinement(_, r2) = domain.as_ref() else {
+        let [r2] = domain.claims() else {
             panic!("expected refinement domain");
         };
         assert_eq!(*r2.predicate, gt(var("i"), int(5)));
@@ -1458,7 +1539,7 @@ mod tests {
     fn apply_type_shadows_pi_binder() {
         let r = Refinement::born(Rc::new(gt(var("i"), var("k"))));
         // (k: _) ⇒ {i | i > k} ⇒ _  — the inner k is bound by the Pi.
-        let inner = Type::fun(Type::Refinement(Box::new(Type::infer()), r), Type::infer());
+        let inner = Type::fun(Type::refined_one(Type::infer(), r), Type::infer());
         let ty = Type::pi("k", Type::infer(), inner);
         let out = Subst::discharge("k", int(5)).apply_type(&ty);
         // The Pi binder shadows the discharge: predicate is unchanged.
@@ -1468,9 +1549,7 @@ mod tests {
         let Type::Fun { domain, .. } = codomain.as_ref() else {
             panic!()
         };
-        let Type::Refinement(_, r2) = domain.as_ref() else {
-            panic!()
-        };
+        let [r2] = domain.claims() else { panic!() };
         assert_eq!(*r2.predicate, gt(var("i"), var("k")));
     }
 }
@@ -1501,8 +1580,8 @@ mod rewrite_tests {
         let shared = Rc::new(gt(var("k"), int(0)));
         // Two refinement occurrences sharing one predicate term, both inside a
         // single type (a function's domain and codomain).
-        let dom = Type::Refinement(Box::new(Type::Hole), Refinement::sharing(&shared));
-        let cod = Type::Refinement(Box::new(Type::Hole), Refinement::sharing(&shared));
+        let dom = Type::refined_one(Type::Hole, Refinement::sharing(&shared));
+        let cod = Type::refined_one(Type::Hole, Refinement::sharing(&shared));
         let mut e = var("y").with_ty(Type::fun(dom, cod));
 
         Subst::discharge("k", int(5)).rewrite_expr(&mut e);
@@ -1513,10 +1592,10 @@ mod rewrite_tests {
         else {
             panic!("function type preserved");
         };
-        let Type::Refinement(_, rd) = domain.as_ref() else {
+        let [rd] = domain.claims() else {
             panic!("domain refinement preserved");
         };
-        let Type::Refinement(_, rc) = codomain.as_ref() else {
+        let [rc] = codomain.claims() else {
             panic!("codomain refinement preserved");
         };
         assert_eq!(
diff --git a/src/ccl/symbolic.rs b/src/ccl/symbolic.rs
index febb5625..fca792bd 100644
--- a/src/ccl/symbolic.rs
+++ b/src/ccl/symbolic.rs
@@ -850,9 +850,9 @@ in x"
     #[case(
         Expr::lambda(
             "x",
-            Type::Refinement(
-                Box::new(Type::Base(BaseType::Int)),
-                Refinement::born(Rc::new(Expr::lit(Lit::Bool(true)))),
+            Type::refined_one(
+                Type::Base(BaseType::Int),
+                Refinement::born(Rc::new(Expr::lit(Lit::Bool(true))))
             ),
             Expr::var("x"),
         ),
diff --git a/src/ccl/ty.rs b/src/ccl/ty.rs
index 4cad77a2..c2e07e4e 100644
--- a/src/ccl/ty.rs
+++ b/src/ccl/ty.rs
@@ -544,8 +544,15 @@ pub enum Type {
     /// path, and one width-subtyping rule. `Vec` order is preserved for
     /// display.
     Variant(Vec<(FieldKey, Type)>),
-    /// A refinement of another type
-    Refinement(Box<Type>, Refinement),
+    /// A base type narrowed by the conjunction of a [`RefinementSet`]'s claims.
+    ///
+    /// **Invariants**, both established by [`Type::refined`] (which every
+    /// construction site should go through rather than building this variant
+    /// directly): the set is non-empty, and the base is not itself a
+    /// `Refinement` — nested layers flatten into one set, so `{{𝑇 | 𝑝} | 𝑞}` is
+    /// unrepresentable and the question "which layer is outermost" cannot be
+    /// asked. See [`RefinementSet`] for why that question had no good answer.
+    Refinement(Box<Type>, RefinementSet),
     /// Pre-inference placeholder stamped by lowering on every new node.
     ///
     /// Invariant: every `Hole` must be eliminated by the end of inference.
@@ -837,9 +844,21 @@ impl fmt::Display for Type {
             // `5`. That is the whole content of the type, and spelling it out puts a
             // predicate in front of the reader at every literal. Every other
             // refinement prints in the general form.
-            Type::Refinement(t, r) => match singleton_value(self) {
+            // Claims render comma-separated (`{Int | p, q}`) — a conjunction.
+            // Sorted, because the set is unordered: a rendering must not depend
+            // on which order claims happened to be inserted in, or a diagnostic
+            // (or a test comparing rendered types) would see a difference that
+            // the type system says is not there.
+            Type::Refinement(t, claims) => match singleton_value(self) {
                 Some(lit) => write!(f, "{}", symbolic::symbolic(lit)),
-                None => write!(f, "{{{t} | {}}}", symbolic::symbolic(&r.predicate)),
+                None => {
+                    let mut rendered: Vec<String> = claims
+                        .iter()
+                        .map(|r| symbolic::symbolic(&r.predicate))
+                        .collect();
+                    rendered.sort();
+                    write!(f, "{{{t} | {}}}", rendered.join(", "))
+                }
             },
             Type::Hole => write!(f, "_"),
             // A hole with an identity renders as one: `_#0` and `_#1` are distinct
@@ -871,13 +890,11 @@ impl fmt::Display for Type {
 /// rule that handles refinements handles this one unchanged — and this recognizes
 /// the shape just well enough to print it as what it means.
 fn singleton_value(ty: &Type) -> Option<&TypedExpr> {
-    let Type::Refinement(base, r) = ty else {
+    let Type::Refinement(_, claims) = ty else {
         return None;
     };
-    // Exactly one layer: a further-refined singleton is not one.
-    if matches!(base.as_ref(), Type::Refinement(..)) {
-        return None;
-    }
+    // Exactly one claim: a base carrying further restrictions is not a singleton.
+    let r = claims.sole()?;
     let TypedExprNode::BinOp {
         left,
         op: crate::ccl::BinOpKind::Compare(crate::ccl::CompareKind::Equals),
@@ -976,7 +993,43 @@ impl Type {
         }
     }
 
-    /// Look through every outer [`Type::Refinement`] layer, returning the bare
+    /// Build `base` narrowed by `claims` — **the** way to construct a
+    /// [`Type::Refinement`], establishing both of its invariants.
+    ///
+    /// Empty `claims` yields `base` unrefined (a position claiming nothing is
+    /// its base type), and a `base` that is already refined has its claims
+    /// merged in rather than stacked on top, so refinement sets never nest.
+    /// Flattening is sound because every claim at a position restricts the same
+    /// underlying element: a refinement narrows which values inhabit a type, it
+    /// does not change them, so an outer claim's [`REFINEMENT_BINDER`] ranges
+    /// over exactly the values the inner one does.
+    pub fn refined(base: Type, claims: RefinementSet) -> Type {
+        if claims.is_empty() {
+            return base;
+        }
+        match base {
+            Type::Refinement(inner, existing) => Type::Refinement(inner, existing.union(&claims)),
+            bare => Type::Refinement(Box::new(bare), claims),
+        }
+    }
+
+    /// [`Type::refined`] with a single claim — the common case at a site that
+    /// mints one predicate.
+    pub fn refined_one(base: Type, claim: Refinement) -> Type {
+        Type::refined(base, RefinementSet::one(claim))
+    }
+
+    /// The claims carried at this position — empty for an unrefined type, so a
+    /// caller can compare or filter what two positions demand without
+    /// case-splitting on whether either is refined.
+    pub fn claims(&self) -> &[Refinement] {
+        match self {
+            Type::Refinement(_, claims) => claims.as_slice(),
+            _ => &[],
+        }
+    }
+
+    /// Look through the [`Type::Refinement`] wrapper, returning the bare
     /// structural type underneath. Borrowing and non-allocating; refinements
     /// nested inside the structure are left in place.
     ///
@@ -990,11 +1043,12 @@ impl Type {
     /// is a different operation: it *drops* claims rather than looking past them,
     /// allocates, and is only meaningful on a resolved type.
     pub fn peel_refinements(&self) -> &Type {
-        let mut cur = self;
-        while let Type::Refinement(inner, _) = cur {
-            cur = inner;
+        match self {
+            // One layer suffices: `Type::refined` flattens, so a refinement's
+            // base is never itself refined.
+            Type::Refinement(inner, _) => inner,
+            other => other,
         }
-        cur
     }
 
     /// The value type of the mutable variable this denotes, or `None` if it is not
@@ -1088,6 +1142,12 @@ impl Type {
     /// the binder's presence — rebuilt combinator arrows (`fun_ty_or_hole`,
     /// [`Type::fun`]) are constructed with `name: None`. If those sites ever
     /// preserve binders on rebuilt arrows, this helper can retire.
+    ///
+    /// Blindness to binder *presence* is not blindness to binder *identity*.
+    /// Where the two sides can carry different binder names for the same
+    /// position — solver output is canonicalized to [`crate::ccl::Name::pi`]
+    /// while an independently-rebuilt type keeps the term's own names —
+    /// compose with [`Type::alpha_normalized`] first.
     pub fn without_pi_names(&self) -> Type {
         match self {
             Type::Fun {
@@ -1113,8 +1173,8 @@ impl Type {
                     .map(|(k, t)| (k.clone(), t.without_pi_names()))
                     .collect(),
             ),
-            Type::Refinement(base, r) => {
-                Type::Refinement(Box::new(base.without_pi_names()), r.clone())
+            Type::Refinement(base, claims) => {
+                Type::refined(base.without_pi_names(), claims.clone())
             }
             Type::History {
                 value,
@@ -1136,6 +1196,71 @@ impl Type {
         }
     }
 
+    /// The **α-normal form**: every Pi binder renamed to the reserved
+    /// depth-indexed name ([`crate::ccl::Name::pi`]) and every predicate
+    /// reference rewritten through the rename — the same scheme the solver
+    /// applies as it flattens types (`compact.rs`), exposed as a pure
+    /// function so comparisons between solver output (already canonical) and
+    /// independently-rebuilt types (source-named binders) can meet on one
+    /// form. Two α-equivalent types have equal α-normal forms.
+    pub fn alpha_normalized(&self) -> Type {
+        use crate::ccl::subst::Subst;
+        fn go(t: &Type, depth: u8, subst: &Subst) -> Type {
+            match t {
+                Type::Fun {
+                    name,
+                    kind,
+                    domain,
+                    codomain,
+                } => {
+                    let dom = go(domain, depth, subst);
+                    let cod_scope = subst.canonical_pi_binder(name, depth);
+                    let cod = go(codomain, cod_scope.depth, &cod_scope.subst);
+                    Type::Fun {
+                        name: cod_scope.binder,
+                        kind: kind.clone(),
+                        domain: Box::new(dom),
+                        codomain: Box::new(cod),
+                    }
+                }
+                Type::Refinement(base, claims) => Type::refined(
+                    go(base, depth, subst),
+                    claims.iter().map(|r| subst.force_refinement(r)).collect(),
+                ),
+                Type::Tuple(ts) => Type::Tuple(ts.iter().map(|t| go(t, depth, subst)).collect()),
+                Type::Record(fs) => Type::Record(
+                    fs.iter()
+                        .map(|(n, t)| (n.clone(), go(t, depth, subst)))
+                        .collect(),
+                ),
+                Type::Variant(tags) => Type::Variant(
+                    tags.iter()
+                        .map(|(k, t)| (k.clone(), go(t, depth, subst)))
+                        .collect(),
+                ),
+                Type::History {
+                    value,
+                    domain,
+                    kind,
+                } => Type::History {
+                    value: Box::new(go(value, depth, subst)),
+                    domain: Box::new(go(domain, depth, subst)),
+                    kind: *kind,
+                },
+                Type::BoundedHole(t) => Type::BoundedHole(Box::new(go(t, depth, subst))),
+                Type::Base(_)
+                | Type::UIntRange(_)
+                | Type::DataSource(_)
+                | Type::ChanDom(..)
+                | Type::Txn
+                | Type::Infer(_)
+                | Type::SharedHole(_)
+                | Type::Hole => t.clone(),
+            }
+        }
+        go(self, 0, &Subst::id())
+    }
+
     /// Create a fresh [`Type::Infer`] variable for use in tests.
     ///
     /// Use this only when constructing expressions in tests that will not be
@@ -1431,12 +1556,11 @@ fn eq_cast_target_predicates(t1: &Type, t2: &Type) -> bool {
         ccl_utils::cast_target_refinement(t2),
     ) {
         (None, None) => true,
-        (Some(r1), Some(r2)) => {
-            if Rc::ptr_eq(&r1.predicate, &r2.predicate) {
-                return true;
-            }
-            eq_refinement_predicate_go(&r1.predicate, &r2.predicate)
-        }
+        // Set equality, whose member comparison is `Refinement`'s own
+        // (`eq_refinement_predicate`, pointer short-circuit included). The
+        // mutual recursion terminates on tree shape: predicates are acyclic
+        // `Rc<TypedExpr>`s, so a cast target cannot contain the term comparing it.
+        (Some(s1), Some(s2)) => s1 == s2,
         _ => false,
     }
 }
@@ -1648,11 +1772,316 @@ impl std::hash::Hash for Refinement {
     }
 }
 
+/// The claims carried at one refined position: an **unordered set** of
+/// [`Refinement`]s, deduplicated by their structural [`PartialEq`].
+///
+/// A refined type narrows its base by the *conjunction* of these claims, and
+/// conjunction is commutative, idempotent, and associative — so a set is the
+/// honest carrier and a chain of nested `{{𝑇 | 𝑝} | 𝑞}` layers was not. That
+/// chain gave one representation three incompatible readings: a *set* to
+/// subtyping (the deficit machinery compares layers as a set), a *stack* to
+/// planning (whichever layer sat outermost drove which restrict it built), and
+/// an *identity* to `SpecKey` and the recorded-vs-recomputed walls (`Type`'s
+/// derived equality is position-sensitive). Layers accumulated in constraint
+/// *arrival* order, so the stack reading made typing depend on the order two
+/// bounds happened to meet at a variable. Set semantics deletes the degree of
+/// freedom rather than pinning it to a canonical order: there is no position to
+/// read, so planning is free to apply predicates in whatever order it likes
+/// (cheapest filter first, say) without changing an identity.
+///
+/// The invariant, maintained by [`insert`](Self::insert) and relied on by
+/// [`PartialEq`]: **no two members are equal**. Given that, mutual containment
+/// reduces to equal length plus one-way containment.
+#[derive(Debug, Clone, Default)]
+pub struct RefinementSet(Vec<Refinement>);
+
+/// Whether to build refinement sets in reversed physical order — the
+/// order-independence **stress knob**, driven by `CAMBRA_REFINEMENT_ORDER=reverse`.
+///
+/// Set semantics makes the backing `Vec`'s order meaningless by contract, but
+/// two classes of order-dependence survive a representation change that the
+/// type system cannot catch: a consumer that *iterates* the set and lets the
+/// order reach something observable, and a dedup that keeps the
+/// first-inserted of two `eq`-equal members whose (type-blind-equal) predicate
+/// terms carry different embedded type slots. Flipping the physical order
+/// globally and re-running the suite is the only way to exercise both. Reading
+/// it once into a `LazyLock` keeps the check to a cached bool, and it is
+/// `debug_assertions`-only so a release compiler cannot be perturbed by the
+/// environment.
+#[cfg(debug_assertions)]
+fn stress_reversed() -> bool {
+    static REVERSED: std::sync::LazyLock<bool> = std::sync::LazyLock::new(|| {
+        std::env::var("CAMBRA_REFINEMENT_ORDER").as_deref() == Ok("reverse")
+    });
+    *REVERSED
+}
+
+#[cfg(not(debug_assertions))]
+fn stress_reversed() -> bool {
+    false
+}
+
+impl RefinementSet {
+    /// The empty set — an unrefined position.
+    pub fn new() -> Self {
+        RefinementSet(Vec::new())
+    }
+
+    /// The singleton set carrying one claim.
+    pub fn one(r: Refinement) -> Self {
+        RefinementSet(vec![r])
+    }
+
+    /// Add a claim, keeping the set deduplicated. Returns whether it was new.
+    ///
+    /// A claim already present is dropped rather than replacing the incumbent:
+    /// the two are equal as *restrictions* ([`eq_refinement_predicate`]), and
+    /// keeping the incumbent preserves whatever predicate `Rc` sharing the
+    /// position already had.
+    pub fn insert(&mut self, r: Refinement) -> bool {
+        if self.0.contains(&r) {
+            return false;
+        }
+        if stress_reversed() {
+            self.0.insert(0, r);
+        } else {
+            self.0.push(r);
+        }
+        true
+    }
+
+    /// Add every claim of `other`.
+    pub fn extend(&mut self, other: impl IntoIterator<Item = Refinement>) {
+        for r in other {
+            self.insert(r);
+        }
+    }
+
+    /// The union of two sets — the position claims everything either claims.
+    /// This is the *meet* of the refined types (a narrower value satisfies
+    /// more), so it is what a negative-polarity merge performs.
+    pub fn union(mut self, other: &RefinementSet) -> Self {
+        self.extend(other.iter().cloned());
+        self
+    }
+
+    /// The intersection — only the claims *both* sides guarantee, which is
+    /// what a value known to be one of two things reliably carries (the
+    /// positive-polarity merge, and the *join* of the refined types).
+    pub fn intersect(&self, other: &RefinementSet) -> Self {
+        RefinementSet(
+            self.0
+                .iter()
+                .filter(|r| other.contains(r))
+                .cloned()
+                .collect(),
+        )
+    }
+
+    pub fn contains(&self, r: &Refinement) -> bool {
+        self.0.contains(r)
+    }
+
+    pub fn as_slice(&self) -> &[Refinement] {
+        &self.0
+    }
+
+    pub fn is_empty(&self) -> bool {
+        self.0.is_empty()
+    }
+
+    pub fn len(&self) -> usize {
+        self.0.len()
+    }
+
+    pub fn iter(&self) -> std::slice::Iter<'_, Refinement> {
+        self.0.iter()
+    }
+
+    /// Mutable access to each claim, for the passes that rewrite predicates in
+    /// place (substitution forcing, predicate compilation). Rewriting cannot
+    /// change *which* claims are present, so the dedup invariant is preserved
+    /// by construction — a rewrite that merged two claims into one would leave
+    /// a duplicate, which is why the rewriting passes re-`insert` instead.
+    pub fn iter_mut(&mut self) -> std::slice::IterMut<'_, Refinement> {
+        self.0.iter_mut()
+    }
+
+    /// The sole claim, or `None` if the set does not hold exactly one.
+    ///
+    /// For the positions built with exactly one predicate by construction — a
+    /// `cast` target's domain refinement, a literal singleton's pin — where
+    /// "the" refinement is a real notion rather than a position in a chain.
+    pub fn sole(&self) -> Option<&Refinement> {
+        match self.0.as_slice() {
+            [r] => Some(r),
+            _ => None,
+        }
+    }
+}
+
+/// Walk `claims` in **application order**: each claim paired with the type its
+/// element has at the point that claim applies — `base` narrowed by every claim
+/// applied before it.
+///
+/// A claim set is unordered as a *fact* about a value, but materializing it is a
+/// pipeline — planning emits one `restrict` per claim — and a pipeline is
+/// sequential: stage 𝑘 reads elements already narrowed by stages 1..𝑘-1, so its
+/// element type is not the bare base. Planning therefore *chooses* an order here.
+/// Which order is free (any of them yields a well-typed pipeline for the same
+/// final domain, and a cost model could pick the cheapest filter first); what is
+/// not free is choosing *differently* in two places, since the types along the
+/// pipeline and the predicates compiled for it must agree. Every site that
+/// lowers or types that pipeline goes through this function, so they agree by
+/// construction rather than by coincidence.
+pub fn application_order<'a>(
+    claims: &'a [Refinement],
+    base: &'a Type,
+) -> impl Iterator<Item = (&'a Refinement, Type)> + 'a {
+    // Planning's chosen order is a deterministic function of the claims'
+    // *content* — their rendered predicates — never of the set's physical
+    // (insertion) order, which carries no meaning. Any order yields a correct
+    // pipeline; choosing one that ignores insertion order keeps the built term
+    // reproducible however the claims happened to accumulate, and matches the
+    // order `Display` renders a claim set in. A cost model is free to replace
+    // this key (cheapest filter first) without touching identity.
+    let mut ordered: Vec<&Refinement> = claims.iter().collect();
+    ordered.sort_by_key(|r| symbolic::symbolic(&r.predicate));
+    let mut narrowed = RefinementSet::new();
+    ordered.into_iter().map(move |r| {
+        let elem_ty = Type::refined(base.clone(), narrowed.clone());
+        narrowed.insert(r.clone());
+        (r, elem_ty)
+    })
+}
+
+/// [`application_order`]'s element types, indexed by each claim's **physical**
+/// position in `claims`.
+///
+/// For the sites that rewrite claims *in place* and so must walk the set in its
+/// own order. The application order is a permutation of the physical one, so
+/// zipping [`application_order`]'s types straight onto a physical-order walk
+/// pairs claims with the wrong element type whenever the two orders differ —
+/// silently, since both sequences have the same length. This does the
+/// permutation explicitly.
+pub fn application_elem_types(claims: &[Refinement], base: &Type) -> Vec<Type> {
+    let mut out = vec![base.clone(); claims.len()];
+    for (r, elem_ty) in application_order(claims, base) {
+        // `application_order` borrows the very slice it was handed, so pointer
+        // identity locates the claim exactly — `PartialEq` would not, being
+        // type-blind and therefore able to match a sibling.
+        let idx = claims
+            .iter()
+            .position(|c| std::ptr::eq(c, r))
+            .expect("application_order yields borrows into `claims`");
+        out[idx] = elem_ty;
+    }
+    out
+}
+
+impl PartialEq for RefinementSet {
+    /// Set equality. Sound as stated because both sides are deduplicated
+    /// ([`insert`](RefinementSet::insert)), so equal cardinality plus one-way
+    /// containment is mutual containment.
+    fn eq(&self, other: &Self) -> bool {
+        self.0.len() == other.0.len() && self.0.iter().all(|r| other.0.contains(r))
+    }
+}
+
+impl Eq for RefinementSet {}
+
+impl std::hash::Hash for RefinementSet {
+    /// Order-insensitive, as [`PartialEq`] demands: each member's hash is
+    /// folded in with a commutative operation. `wrapping_add` rather than
+    /// `XOR` because XOR lets two hash-colliding members cancel to the empty
+    /// set's hash; the length is mixed in for the same reason.
+    fn hash<H: std::hash::Hasher>(&self, state: &mut H) {
+        let mut combined: u64 = 0;
+        for r in &self.0 {
+            let mut h = std::collections::hash_map::DefaultHasher::new();
+            std::hash::Hash::hash(r, &mut h);
+            combined = combined.wrapping_add(std::hash::Hasher::finish(&h));
+        }
+        std::hash::Hash::hash(&self.0.len(), state);
+        std::hash::Hash::hash(&combined, state);
+    }
+}
+
+impl FromIterator<Refinement> for RefinementSet {
+    fn from_iter<I: IntoIterator<Item = Refinement>>(iter: I) -> Self {
+        let mut out = RefinementSet::new();
+        out.extend(iter);
+        out
+    }
+}
+
+impl IntoIterator for RefinementSet {
+    type Item = Refinement;
+    type IntoIter = std::vec::IntoIter<Refinement>;
+    fn into_iter(self) -> Self::IntoIter {
+        self.0.into_iter()
+    }
+}
+
+impl<'a> IntoIterator for &'a RefinementSet {
+    type Item = &'a Refinement;
+    type IntoIter = std::slice::Iter<'a, Refinement>;
+    fn into_iter(self) -> Self::IntoIter {
+        self.0.iter()
+    }
+}
+
+impl From<Refinement> for RefinementSet {
+    fn from(r: Refinement) -> Self {
+        RefinementSet::one(r)
+    }
+}
+
 #[cfg(test)]
 mod tests {
     use super::*;
     use crate::ccl::{BinOpKind, CompareKind};
 
+    /// [`application_elem_types`] permutes, it does not zip.
+    ///
+    /// [`application_order`] walks claims in *content* order; a site that
+    /// rewrites claims in place walks them in *physical* order. Both sequences
+    /// have the same length, so zipping one onto the other pairs claims with
+    /// the wrong element type silently whenever the orders differ. Built here
+    /// with physical order deliberately the reverse of content order.
+    #[test]
+    fn application_elem_types_follow_the_claim_not_the_position() {
+        let claim = |name: &str| {
+            Refinement::born(Rc::new(TypedExpr::binop(
+                TypedExpr::var(name),
+                BinOpKind::Compare(CompareKind::Equals),
+                TypedExpr::lit(Lit::Int(1)),
+            )))
+        };
+        // Physical order [b, a]; content order sorts to [a, b].
+        let (a, b) = (claim("a"), claim("b"));
+        let claims = vec![b.clone(), a.clone()];
+        let base = Type::Base(BaseType::Int);
+
+        let by_position = application_elem_types(&claims, &base);
+        let by_content: Vec<Type> = application_order(&claims, &base).map(|(_, t)| t).collect();
+
+        // `a` applies first, so it sees the bare base; `b` sees the base
+        // narrowed by `a`. Indexed physically, that is [narrowed, bare].
+        assert_eq!(by_position[1], base, "`a` (physical index 1) applies first");
+        assert_eq!(
+            by_position[0],
+            Type::refined(base.clone(), RefinementSet::one(a)),
+            "`b` (physical index 0) applies second, under `a`"
+        );
+        // The naive zip would have handed `b` the bare base — the two
+        // sequences are genuinely different, so this test has teeth.
+        assert_ne!(
+            by_position, by_content,
+            "physical and content order must differ here, or this pins nothing"
+        );
+    }
+
     /// Two predicates that each contain a [`TypedExprNode::Cast`] and differ
     /// only in the *target's* domain-refinement predicate denote different
     /// refinements: the nested filter is semantic, not inference metadata, so
@@ -1698,7 +2127,7 @@ mod tests {
     #[test]
     fn handle_accessors_see_through_a_refinement() {
         let claim = Refinement::born(Rc::new(TypedExpr::lit(Lit::Bool(true))));
-        let refine = |t: Type| Type::Refinement(Box::new(t), claim.clone());
+        let refine = |t: Type| Type::refined_one(t, claim.clone());
         let int = Type::Base(BaseType::Int);
         let mut_var = Type::History {
             value: Box::new(int.clone()),
diff --git a/src/ccl/uniquify.rs b/src/ccl/uniquify.rs
index 4a647301..74ecee51 100644
--- a/src/ccl/uniquify.rs
+++ b/src/ccl/uniquify.rs
@@ -277,14 +277,16 @@ impl Uniquifier {
     /// (see module docs), with every occurrence re-pointed at the rebuilt `Rc`
     /// via `memo`.
     fn ty(&mut self, t: &mut Type) {
-        if let Type::Refinement(_, r) = t {
+        if let Type::Refinement(_, claims) = t {
             // A handle clone, so `self` stays freely borrowable for the rebuild —
             // which re-enters this same memo through `self.expr` → `self.ty`.
             let memo = self.memo.clone();
-            memo.rebuild(r, &(), |pred| {
-                self.expr(pred);
-                true
-            });
+            for r in claims.iter_mut() {
+                memo.rebuild(r, &(), |pred| {
+                    self.expr(pred);
+                    true
+                });
+            }
         }
         t.walk_children_mut(|c| self.ty(c));
     }
@@ -362,7 +364,7 @@ fn collect_node_ids(expr: &Expr) -> Vec<crate::ccl::provenance::NodeId> {
     use crate::ccl::provenance::NodeId;
 
     fn from_ty(t: &Type, out: &mut Vec<NodeId>) {
-        if let Type::Refinement(_, r) = t {
+        for r in t.claims() {
             from_expr(&r.predicate, out);
         }
         t.walk_children(|c| from_ty(c, out));
@@ -444,7 +446,7 @@ mod tests {
     /// inside other refinements' predicate expressions.
     fn collect_refinements(e: &Expr, out: &mut Vec<Refinement>) {
         fn from_ty(t: &Type, out: &mut Vec<Refinement>) {
-            if let Type::Refinement(_, r) = t {
+            for r in t.claims() {
                 out.push(r.clone());
                 collect_refinements(&r.predicate, out);
             }
diff --git a/tests/compilation_pipeline/joins_aggregates_groupby.rs b/tests/compilation_pipeline/joins_aggregates_groupby.rs
index 2c5861d9..940cd2c9 100644
--- a/tests/compilation_pipeline/joins_aggregates_groupby.rs
+++ b/tests/compilation_pipeline/joins_aggregates_groupby.rs
@@ -303,7 +303,7 @@ fn test_groupby(#[case] code: &str, #[case] expected: Tile) {
 )]
 #[case(
     "[x for x in [y for y in [1,2,3] if y < 3] if x < 2]",
-    "iterate ▷ (([1, 2, 3] ≫ (id, 3 ▷ const) ▷ zip ≫ lt) ▷ restrict) ▷ ((cast([1, 2, 3]) ≫ (id, 2 ▷ const) ▷ zip ≫ lt) ▷ restrict) ≫ cast(cast([1, 2, 3])):({{[0, 2] | __elem ▷ ([1, 2, 3] ≫ (id, 3 ▷ const) ▷ zip ≫ lt)} | __elem ▷ (cast([1, 2, 3]) ≫ (id, 2 ▷ const) ▷ zip ≫ lt)} ⤇ Int)",
+    "iterate ▷ (([1, 2, 3] ≫ (id, 3 ▷ const) ▷ zip ≫ lt) ▷ restrict) ▷ ((cast([1, 2, 3]) ≫ (id, 2 ▷ const) ▷ zip ≫ lt) ▷ restrict) ≫ cast(cast([1, 2, 3])):({[0, 2] | __elem ▷ ([1, 2, 3] ≫ (id, 3 ▷ const) ▷ zip ≫ lt), __elem ▷ (cast([1, 2, 3]) ≫ (id, 2 ▷ const) ▷ zip ≫ lt)} ⤇ Int)",
     make_int_list(&[1])
 )]
 #[case(
diff --git a/tests/predicate_sharing.rs b/tests/predicate_sharing.rs
index cc52f60b..ebb79b91 100644
--- a/tests/predicate_sharing.rs
+++ b/tests/predicate_sharing.rs
@@ -155,8 +155,8 @@ fn filtered_join_nesting_stays_shared() {
 
 /// `{Int | true}` over a fresh predicate `Rc`.
 fn refined_int() -> Type {
-    Type::Refinement(
-        Box::new(Type::Base(BaseType::Int)),
+    Type::refined_one(
+        Type::Base(BaseType::Int),
         Refinement::born(Rc::new(Expr::lit(Lit::Bool(true)))),
     )
 }
diff --git a/tests/predicate_sharing_review.rs b/tests/predicate_sharing_review.rs
index 7b2b7817..c34515cf 100644
--- a/tests/predicate_sharing_review.rs
+++ b/tests/predicate_sharing_review.rs
@@ -25,12 +25,12 @@ fn gt(l: TypedExpr, r: TypedExpr) -> TypedExpr {
 }
 /// `{_ | pred}`, a second occurrence of an existing predicate term.
 fn refined(pred: &Rc<TypedExpr>) -> Type {
-    Type::Refinement(Box::new(Type::Hole), Refinement::sharing(pred))
+    Type::refined_one(Type::Hole, Refinement::sharing(pred))
 }
 /// The predicate term of a `{_ | p}`.
 fn predicate_of(ty: &Type) -> &Rc<TypedExpr> {
-    let Type::Refinement(_, r) = ty else {
-        panic!("expected a refinement, got {ty}");
+    let [r] = ty.claims() else {
+        panic!("expected exactly one claim, got {ty}");
     };
     &r.predicate
 }
diff --git a/tests/type_check.rs b/tests/type_check.rs
index 09bdbc19..416c1d00 100644
--- a/tests/type_check.rs
+++ b/tests/type_check.rs
@@ -1659,8 +1659,8 @@ groups(0)
     let Type::Fun { domain: dom, .. } = &ty else {
         panic!("expected a partition function type, got {ty}");
     };
-    let Type::Refinement(_, r) = &**dom else {
-        panic!("expected a refined partition domain, got {ty}");
+    let [r] = dom.claims() else {
+        panic!("expected a singly-refined partition domain, got {ty}");
     };
     let pred = cambra::ccl::symbolic::symbolic(&r.predicate);
     assert!(
@@ -1699,8 +1699,8 @@ apply0(groups)
     let Type::Fun { domain: dom, .. } = &ty else {
         panic!("expected a partition function type, got {ty}");
     };
-    let Type::Refinement(_, r) = &**dom else {
-        panic!("expected a refined partition domain, got {ty}");
+    let [r] = dom.claims() else {
+        panic!("expected a singly-refined partition domain, got {ty}");
     };
     let pred = cambra::ccl::symbolic::symbolic(&r.predicate);
     assert!(