import Mathlib.Data.List.Dedup
import Mathlib.Data.List.Induction
import Sal.MRDTs.RGA_Embed.RGA_Embed_ChainLex

/-!
# The run table: the certified representation layer of the embed RGA

Design + measurement: `whiteboard/run-table-note.md` (20.9–27.2 b/ch, 38x–141x
below fused chains); executable reference `whiteboard/litmus/run_table_measure.py`
(295k comparator checks, 150 PBT trials). This file is the pure order/
representation theory over the chain kernel; the instance-facing simulation and
the epoch composition live in
`Sal/ConditionedMRDTs/MRDT_Instances/EmbedRGA/EmbedRGA_RunTable.lean`.

The state, at kernel level, is the **list of live birth chains** (`List ℕ`
labels, the one-sided model, where the note's side condition 3 is vacuous).
The **kept tree** is the live chains plus their dead ancestors = the nonempty
prefixes of live chains (tombstone-freedom unchanged: everything else is
gone). An edge into `c` is **fusible** when `c` is the unique kept child of
its parent, its label is `1`, and it has its parent's liveness; a **run** is a
maximal fusible chain. No stability or honest-delivery hypothesis appears
anywhere in this file: every theorem is a state-level fact about a
representation change, the formal content of the measured **no-stability-gate**
finding (the settled-cut hypothesis appears exactly once, in T-epoch, in the
instance file).
-/

namespace Sal.EmbedRGA.RunTable

open Sal.EmbedRGA (keyLt keyLe key coordOf OrderedPrefixCode PosChain
  chainBefore)

/-! ## §0  The kept tree over a live chain list -/

/-- The nonempty prefixes of a chain, short to long. -/
def prefixesOf (l : List ℕ) : List (List ℕ) :=
  (List.range l.length).map (fun k => l.take (k + 1))

theorem mem_prefixesOf {l c : List ℕ} :
    c ∈ prefixesOf l ↔ c ≠ [] ∧ c <+: l := by
  simp only [prefixesOf, List.mem_map, List.mem_range]
  constructor
  · rintro ⟨k, hk, rfl⟩
    refine ⟨?_, List.take_prefix _ _⟩
    intro hnil
    rcases List.take_eq_nil_iff.mp hnil with h | h
    · omega
    · subst h; simp at hk
  · rintro ⟨hne, hpre⟩
    refine ⟨c.length - 1, ?_, ?_⟩
    · have h1 : 1 ≤ c.length := List.length_pos_iff.mpr hne
      have h2 : c.length ≤ l.length := hpre.length_le
      omega
    · have h1 : 1 ≤ c.length := List.length_pos_iff.mpr hne
      have : c.length - 1 + 1 = c.length := by omega
      rw [this]
      exact (List.prefix_iff_eq_take.mp hpre).symm

/-- The kept tree: live records plus their dead ancestors, i.e. the nonempty
prefixes of live chains, deduplicated. -/
def keptL (L : List (List ℕ)) : List (List ℕ) :=
  (L.flatMap prefixesOf).dedup

theorem mem_keptL {L : List (List ℕ)} {c : List ℕ} :
    c ∈ keptL L ↔ c ≠ [] ∧ ∃ l ∈ L, c <+: l := by
  simp only [keptL, List.mem_dedup, List.mem_flatMap]
  constructor
  · rintro ⟨l, hl, hc⟩
    obtain ⟨hne, hpre⟩ := mem_prefixesOf.mp hc
    exact ⟨hne, l, hl, hpre⟩
  · rintro ⟨hne, l, hl, hpre⟩
    exact ⟨l, hl, mem_prefixesOf.mpr ⟨hne, hpre⟩⟩

theorem nodup_keptL (L : List (List ℕ)) : (keptL L).Nodup :=
  List.nodup_dedup _

theorem kept_ne_nil {L : List (List ℕ)} {c : List ℕ} (hc : c ∈ keptL L) :
    c ≠ [] := (mem_keptL.mp hc).1

theorem kept_of_prefix {L : List (List ℕ)} {c p : List ℕ}
    (hc : c ∈ keptL L) (hp : p <+: c) (hne : p ≠ []) : p ∈ keptL L := by
  obtain ⟨-, l, hl, hpre⟩ := mem_keptL.mp hc
  exact mem_keptL.mpr ⟨hne, l, hl, hp.trans hpre⟩

theorem kept_of_live {L : List (List ℕ)} {c : List ℕ}
    (hc : c ∈ L) (hne : c ≠ []) : c ∈ keptL L :=
  mem_keptL.mpr ⟨hne, c, hc, List.prefix_refl c⟩

/-! ## §1  Fusible edges, heads, and the run-ancestor walk

The note §2: the edge from `p` to its child `c` is fusible when (1) `c` is the
unique kept child of `p`, (2) `delta(c) = 1`, (3) `side(c) = R`, vacuous
one-sided, and (4) `live(c) = live(p)`. Edges out of the root sentinel are
never fusible (the parent must itself be kept). -/

/-- Fusibility of the edge into `c` (from `c.dropLast`). -/
def fusible (L : List (List ℕ)) (c : List ℕ) : Bool :=
  decide (c ∈ keptL L) && decide (c.dropLast ∈ keptL L)
    && (c.getLastD 0 == 1)
    && decide (∀ c' ∈ keptL L, c'.dropLast = c.dropLast → c' = c)
    && (decide (c ∈ L) == decide (c.dropLast ∈ L))

theorem fusible_kept {L : List (List ℕ)} {c : List ℕ}
    (h : fusible L c = true) : c ∈ keptL L := by
  simp only [fusible, Bool.and_eq_true, decide_eq_true_eq] at h
  exact h.1.1.1.1

theorem fusible_parent_kept {L : List (List ℕ)} {c : List ℕ}
    (h : fusible L c = true) : c.dropLast ∈ keptL L := by
  simp only [fusible, Bool.and_eq_true, decide_eq_true_eq] at h
  exact h.1.1.1.2

theorem fusible_unique {L : List (List ℕ)} {c c' : List ℕ}
    (h : fusible L c = true) (hc' : c' ∈ keptL L)
    (hpar : c'.dropLast = c.dropLast) : c' = c := by
  simp only [fusible, Bool.and_eq_true, decide_eq_true_eq] at h
  exact h.1.2 c' hc' hpar

theorem fusible_live {L : List (List ℕ)} {c : List ℕ}
    (h : fusible L c = true) : (c ∈ L) ↔ (c.dropLast ∈ L) := by
  simp only [fusible, Bool.and_eq_true, beq_iff_eq] at h
  have := h.2
  constructor
  · intro hm
    have : decide (c ∈ L) = true := decide_eq_true hm
    rw [this] at h
    exact of_decide_eq_true h.2.symm
  · intro hm
    have hd : decide (c.dropLast ∈ L) = true := decide_eq_true hm
    rw [hd] at h
    exact of_decide_eq_true h.2

theorem fusible_ne_nil {L : List (List ℕ)} {c : List ℕ}
    (h : fusible L c = true) : c ≠ [] := kept_ne_nil (fusible_kept h)

/-- A fusible edge's chain ends in the label `1`. -/
theorem fusible_concat {L : List (List ℕ)} {c : List ℕ}
    (h : fusible L c = true) : c = c.dropLast ++ [1] := by
  rcases List.eq_nil_or_concat c with rfl | ⟨p, b, rfl⟩
  · exact absurd rfl (fusible_ne_nil h)
  · simp only [List.concat_eq_append] at h ⊢
    simp only [fusible, Bool.and_eq_true, beq_iff_eq, List.getLastD_concat] at h
    rw [List.dropLast_concat, h.1.1.2]

/-- A head: a kept node whose incoming edge is not fusible, the first member
of its run. -/
def isHead (L : List (List ℕ)) (c : List ℕ) : Bool :=
  decide (c ∈ keptL L) && !fusible L c

theorem isHead_kept {L : List (List ℕ)} {c : List ℕ}
    (h : isHead L c = true) : c ∈ keptL L := by
  simp only [isHead, Bool.and_eq_true, decide_eq_true_eq] at h
  exact h.1

theorem isHead_not_fusible {L : List (List ℕ)} {c : List ℕ}
    (h : isHead L c = true) : fusible L c = false := by
  simp only [isHead, Bool.and_eq_true, Bool.not_eq_true'] at h
  exact h.2

theorem isHead_of_kept_not_fusible {L : List (List ℕ)} {c : List ℕ}
    (hc : c ∈ keptL L) (hf : fusible L c = false) : isHead L c = true := by
  simp only [isHead, Bool.and_eq_true, Bool.not_eq_true', decide_eq_true_eq]
  exact ⟨hc, hf⟩

/-- The run-ancestor walk: climb fusible edges to the run's head. -/
def headOf (L : List (List ℕ)) (c : List ℕ) : List ℕ :=
  if h : fusible L c = true then headOf L c.dropLast else c
  termination_by c.length
  decreasing_by
    have hne : c ≠ [] := fusible_ne_nil h
    have : 0 < c.length := List.length_pos_iff.mpr hne
    simp only [List.length_dropLast]
    omega

theorem headOf_of_fusible {L : List (List ℕ)} {c : List ℕ}
    (h : fusible L c = true) : headOf L c = headOf L c.dropLast := by
  rw [headOf, dif_pos h]

theorem headOf_of_not_fusible {L : List (List ℕ)} {c : List ℕ}
    (h : fusible L c = false) : headOf L c = c := by
  rw [headOf, dif_neg (by simp [h])]

theorem headOf_prefix (L : List (List ℕ)) (c : List ℕ) : headOf L c <+: c := by
  fun_induction headOf L c with
  | case1 c hf ih =>
      exact ih.trans (List.dropLast_prefix c)
  | case2 c hf => exact List.prefix_refl c

theorem headOf_kept {L : List (List ℕ)} {c : List ℕ} (hc : c ∈ keptL L) :
    headOf L c ∈ keptL L := by
  fun_induction headOf L c with
  | case1 c hf ih => exact ih (fusible_parent_kept hf)
  | case2 c hf => exact hc

theorem headOf_isHead {L : List (List ℕ)} {c : List ℕ} (hc : c ∈ keptL L) :
    isHead L (headOf L c) = true := by
  fun_induction headOf L c with
  | case1 c hf ih => exact ih (fusible_parent_kept hf)
  | case2 c hf =>
      exact isHead_of_kept_not_fusible hc (Bool.eq_false_iff.mpr hf)

/-- Every node is its run head extended by a block of `1` labels. -/
theorem headOf_replicate (L : List (List ℕ)) (c : List ℕ) :
    ∃ k, c = headOf L c ++ List.replicate k 1 := by
  fun_induction headOf L c with
  | case1 c hf ih =>
      obtain ⟨k, hk⟩ := ih
      refine ⟨k + 1, ?_⟩
      conv_lhs => rw [fusible_concat hf, hk]
      rw [List.replicate_succ', ← List.append_assoc]
  | case2 c hf => exact ⟨0, by simp⟩

theorem headOf_eq_self_of_isHead {L : List (List ℕ)} {h : List ℕ}
    (hh : isHead L h = true) : headOf L h = h :=
  headOf_of_not_fusible (isHead_not_fusible hh)

/-- A strict prefix is a prefix of the `dropLast`. -/
theorem prefix_dropLast_of_ne {p c : List ℕ} (hp : p <+: c) (hne : p ≠ c) :
    p <+: c.dropLast := by
  have hl : p.length < c.length :=
    lt_of_le_of_ne hp.length_le (fun h => hne (hp.eq_of_length h))
  have hpc : p = c.take p.length := List.prefix_iff_eq_take.mp hp
  rw [List.dropLast_eq_take, hpc]
  have : c.take p.length = (c.take (c.length - 1)).take p.length := by
    rw [List.take_take]
    congr 1
    omega
  rw [this]
  exact List.take_prefix _ _

/-- Run contiguity: everything between a run's head and one of its members is
in the same run. -/
theorem headOf_within {L : List (List ℕ)} {c p h : List ℕ}
    (hc : headOf L c = h) (hp1 : h <+: p) (hp2 : p <+: c) :
    headOf L p = h := by
  fun_induction headOf L c with
  | case1 c hf ih =>
      by_cases hpc : p = c
      · subst hpc
        rw [headOf_of_fusible hf]
        exact hc
      · exact ih hc (prefix_dropLast_of_ne hp2 hpc)
  | case2 c hf =>
      subst hc
      have : p = c := hp2.eq_of_length
        (Nat.le_antisymm hp2.length_le hp1.length_le)
      subst this
      exact headOf_of_not_fusible (Bool.eq_false_iff.mpr hf)

/-! ## §2  T-tail: the tail-attachment lemma

The note §3, the load-bearing discovery: **in the canonical table, every entry
attaches at its parent entry's last member.** Kernel form: a head's parent
node has no fusible successor (its run stops there), because a fusible
successor would be its *unique* kept child while the head is *another* kept
child. Consumed by: the parent-offset derivability corollary
(`head_parent_is_tail`), the comparator's case-A soundness (`cmp` below: an
entry-chain prefix really is a node ancestor), and the walk's partition
argument. No honesty, no stability, no reachability hypothesis. -/

theorem tail_attachment {L : List (List ℕ)} {h : List ℕ}
    (hh : isHead L h = true) :
    fusible L (h.dropLast ++ [1]) = false := by
  cases hf : fusible L (h.dropLast ++ [1]) with
  | false => rfl
  | true =>
      exfalso
      have hd : (h.dropLast ++ [1]).dropLast = h.dropLast :=
        List.dropLast_concat
      have heq : h = h.dropLast ++ [1] :=
        fusible_unique hf (isHead_kept hh) (by rw [hd])
      rw [← heq] at hf
      rw [isHead_not_fusible hh] at hf
      exact Bool.noConfusion hf

/-! ## §3  Runs: members, length, tail -/

/-- The members of the run headed by `h` (empty unless `h` is a head). -/
def runMembers (L : List (List ℕ)) (h : List ℕ) : List (List ℕ) :=
  (keptL L).filter (fun c => headOf L c == h)

/-- The run's length (the header's `length` field). -/
def lenOf (L : List (List ℕ)) (h : List ℕ) : ℕ := (runMembers L h).length

/-- The run's last member, where every attachment sits (T-tail). -/
def tailOf (L : List (List ℕ)) (h : List ℕ) : List ℕ :=
  h ++ List.replicate (lenOf L h - 1) 1

theorem mem_runMembers {L : List (List ℕ)} {h c : List ℕ} :
    c ∈ runMembers L h ↔ c ∈ keptL L ∧ headOf L c = h := by
  simp [runMembers, List.mem_filter]

theorem head_mem_runMembers {L : List (List ℕ)} {h : List ℕ}
    (hh : isHead L h = true) : h ∈ runMembers L h :=
  mem_runMembers.mpr ⟨isHead_kept hh, headOf_eq_self_of_isHead hh⟩

/-- Every member is the head extended by its offset in `1`s. -/
theorem runMember_form {L : List (List ℕ)} {h c : List ℕ}
    (hc : c ∈ runMembers L h) :
    c = h ++ List.replicate (c.length - h.length) 1 := by
  obtain ⟨hk, hh⟩ := mem_runMembers.mp hc
  obtain ⟨k, hform⟩ := headOf_replicate L c
  rw [hh] at hform
  have : c.length - h.length = k := by
    rw [hform]; simp
  rw [this]
  exact hform

theorem replicate_offset_inj {h : List ℕ} {j k : ℕ}
    (heq : h ++ List.replicate j 1 = h ++ List.replicate k 1) : j = k := by
  have := congrArg List.length heq
  simp at this
  exact this

/-- Downward closure inside a run. -/
theorem runMember_down {L : List (List ℕ)} {h : List ℕ} {k : ℕ}
    (hk : h ++ List.replicate (k + 1) 1 ∈ runMembers L h) :
    h ++ List.replicate k 1 ∈ runMembers L h := by
  obtain ⟨hkept, hhead⟩ := mem_runMembers.mp hk
  have hpre : h ++ List.replicate k 1 <+: h ++ List.replicate (k + 1) 1 := by
    rw [List.replicate_succ', ← List.append_assoc]
    exact List.prefix_append _ _
  have hh' : h ∈ keptL L := hhead ▸ headOf_kept hkept
  have hne : h ++ List.replicate k 1 ≠ [] := by
    intro hnil
    cases h with
    | nil => exact kept_ne_nil hh' rfl
    | cons a as => simp at hnil
  refine mem_runMembers.mpr ⟨kept_of_prefix hkept hpre hne, ?_⟩
  exact headOf_within hhead (List.prefix_append _ _) hpre

theorem runMember_down_le {L : List (List ℕ)} {h : List ℕ} :
    ∀ k, h ++ List.replicate k 1 ∈ runMembers L h →
    ∀ j ≤ k, h ++ List.replicate j 1 ∈ runMembers L h := by
  intro k
  induction k with
  | zero =>
      intro hm j hj
      have : j = 0 := by omega
      subst this
      exact hm
  | succ k ih =>
      intro hm j hj
      rcases Nat.eq_or_lt_of_le hj with rfl | hlt
      · exact hm
      · exact ih (runMember_down hm) j (by omega)

/-- Non-head members' incoming edges are fusible. -/
theorem runMember_fusible {L : List (List ℕ)} {h : List ℕ} {k : ℕ}
    (hk : h ++ List.replicate (k + 1) 1 ∈ runMembers L h) :
    fusible L (h ++ List.replicate (k + 1) 1) = true := by
  obtain ⟨hkept, hhead⟩ := mem_runMembers.mp hk
  cases hf : fusible L (h ++ List.replicate (k + 1) 1) with
  | true => rfl
  | false =>
      exfalso
      have hself := headOf_of_not_fusible hf
      rw [hhead] at hself
      have hlen := congrArg List.length hself
      simp only [List.length_append, List.length_replicate] at hlen
      omega

/-- Offsets present in a run are below the run's length. -/
theorem runMember_offset_lt {L : List (List ℕ)} {h : List ℕ} {k : ℕ}
    (hk : h ++ List.replicate k 1 ∈ runMembers L h) : k < lenOf L h := by
  have hall : ∀ j ≤ k, h ++ List.replicate j 1 ∈ runMembers L h :=
    runMember_down_le k hk
  set ms : List (List ℕ) :=
    (List.range (k + 1)).map (fun j => h ++ List.replicate j 1) with hms
  have hnd : ms.Nodup := by
    refine List.Nodup.map_on ?_ (List.nodup_range)
    intro j₁ _ j₂ _ heq
    exact replicate_offset_inj heq
  have hsub : ms ⊆ runMembers L h := by
    intro c hc
    obtain ⟨j, hj, rfl⟩ := List.mem_map.mp hc
    exact hall j (by simp at hj; omega)
  have hcard : ms.length ≤ (runMembers L h).length :=
    (List.subperm_of_subset hnd hsub).length_le
  have : ms.length = k + 1 := by simp [hms]
  unfold lenOf
  omega

theorem lenOf_pos {L : List (List ℕ)} {h : List ℕ}
    (hh : isHead L h = true) : 0 < lenOf L h := by
  have := head_mem_runMembers hh
  unfold lenOf
  exact List.length_pos_iff.mpr (List.ne_nil_of_mem this)

/-- Offset completeness: every offset below the run length is a member. -/
theorem runMember_of_lt {L : List (List ℕ)} {h : List ℕ}
    (hh : isHead L h = true) {k : ℕ} (hk : k < lenOf L h) :
    h ++ List.replicate k 1 ∈ runMembers L h := by
  by_contra habs
  -- every member's offset lands in (range lenOf) minus {k}: pigeonhole
  have hform : ∀ c ∈ runMembers L h,
      c = h ++ List.replicate (c.length - h.length) 1 :=
    fun c hc => runMember_form hc
  set offs : List ℕ := (runMembers L h).map (fun c => c.length - h.length)
    with hoffs
  have hnd : offs.Nodup := by
    refine List.Nodup.map_on ?_ ((nodup_keptL L).filter _)
    intro c₁ h₁ c₂ h₂ heq
    rw [hform c₁ h₁, hform c₂ h₂, heq]
  have hsub : offs ⊆ (List.range (lenOf L h)).erase k := by
    intro j hj
    rw [hoffs, List.mem_map] at hj
    obtain ⟨c, hc, rfl⟩ := hj
    have hmem : h ++ List.replicate (c.length - h.length) 1 ∈ runMembers L h :=
      (hform c hc) ▸ hc
    have hne : c.length - h.length ≠ k := fun heq => habs (heq ▸ hmem)
    rw [List.mem_erase_of_ne hne]
    exact List.mem_range.mpr (runMember_offset_lt hmem)
  have hle := (List.subperm_of_subset hnd hsub).length_le
  rw [List.length_erase_of_mem (List.mem_range.mpr hk), List.length_range]
    at hle
  have hlen : offs.length = lenOf L h := by simp [hoffs, lenOf]
  have hpos : 0 < lenOf L h := lenOf_pos hh
  omega

/-- The run-membership characterization: exactly the offsets `0 … len − 1`. -/
theorem mem_runMembers_iff {L : List (List ℕ)} {h : List ℕ}
    (hh : isHead L h = true) {c : List ℕ} :
    c ∈ runMembers L h ↔ ∃ k < lenOf L h, c = h ++ List.replicate k 1 := by
  constructor
  · intro hc
    refine ⟨c.length - h.length, ?_, runMember_form hc⟩
    exact runMember_offset_lt ((runMember_form hc) ▸ hc)
  · rintro ⟨k, hk, rfl⟩
    exact runMember_of_lt hh hk

theorem tailOf_mem {L : List (List ℕ)} {h : List ℕ}
    (hh : isHead L h = true) : tailOf L h ∈ runMembers L h :=
  runMember_of_lt hh (by have := lenOf_pos hh; omega)

/-- The tail is where the run stops: its successor edge is never fusible. -/
theorem tail_succ_not_fusible {L : List (List ℕ)} {h : List ℕ}
    (hh : isHead L h = true) :
    fusible L (tailOf L h ++ [1]) = false := by
  cases hf : fusible L (tailOf L h ++ [1]) with
  | false => rfl
  | true =>
      exfalso
      have hform : tailOf L h ++ [1] = h ++ List.replicate (lenOf L h) 1 := by
        have hpos := lenOf_pos hh
        rw [tailOf, List.append_assoc, ← List.replicate_succ']
        congr 2
        omega
      have hmem : tailOf L h ++ [1] ∈ runMembers L h := by
        refine mem_runMembers.mpr ⟨fusible_kept hf, ?_⟩
        rw [headOf_of_fusible hf, List.dropLast_concat]
        exact (mem_runMembers.mp (tailOf_mem hh)).2
      rw [hform] at hmem
      exact absurd (runMember_offset_lt hmem) (by omega)

/-- **T-tail, consequence (a)**: a head's parent node is the *tail* of the
parent run, the `parent offset` header field is derivable (parent length − 1),
exactly the note §3's accounting remark. -/
theorem head_parent_is_tail {L : List (List ℕ)} {h : List ℕ}
    (hh : isHead L h = true) (hp : h.dropLast ∈ keptL L) :
    h.dropLast = tailOf L (headOf L h.dropLast) := by
  set g := headOf L h.dropLast with hg
  have hgh : isHead L g = true := headOf_isHead hp
  have hmem : h.dropLast ∈ runMembers L g := mem_runMembers.mpr ⟨hp, hg.symm⟩
  have hform := runMember_form hmem
  set k := h.dropLast.length - g.length with hk
  have hklt : k < lenOf L g := runMember_offset_lt (hform ▸ hmem)
  have hexact : k = lenOf L g - 1 := by
    by_contra hne
    have hklt' : k + 1 < lenOf L g := by omega
    have hsucc : g ++ List.replicate (k + 1) 1 ∈ runMembers L g :=
      runMember_of_lt hgh hklt'
    have hfus : fusible L (g ++ List.replicate (k + 1) 1) = true :=
      runMember_fusible hsucc
    have hta := tail_attachment hh
    rw [hform] at hta
    rw [List.append_assoc, ← List.replicate_succ'] at hta
    rw [hfus] at hta
    exact Bool.noConfusion hta
  rw [tailOf, ← hexact]
  exact hform

theorem run_liveness_uniform_aux {L : List (List ℕ)} {h : List ℕ} :
    ∀ k, h ++ List.replicate k 1 ∈ runMembers L h →
      ((h ++ List.replicate k 1 ∈ L) ↔ (h ∈ L))
  | 0, _ => by simp
  | k + 1, hm => by
      have hfus := runMember_fusible hm
      have hdrop : (h ++ List.replicate (k + 1) 1).dropLast
          = h ++ List.replicate k 1 := by
        rw [List.replicate_succ', ← List.append_assoc, List.dropLast_concat]
      rw [fusible_live hfus, hdrop]
      exact run_liveness_uniform_aux k (runMember_down hm)

/-- **Uniform liveness along a run** (fusibility condition 4, propagated). -/
theorem run_liveness_uniform {L : List (List ℕ)} {h c : List ℕ}
    (hc : c ∈ runMembers L h) : (c ∈ L) ↔ (h ∈ L) := by
  have hform := runMember_form hc
  rw [hform]
  exact run_liveness_uniform_aux _ (hform ▸ hc)

/-! ## §4  T-repr: the indexed run table and the representation iso

The honest representation: an entry stores the note §2's accounting header,
`(liveness, parent entry ref, offset in parent, head delta, length)`, and
NOT the chain. Chains are recovered by following parent refs. **Statement
hygiene** (note §10): the iso is over **labels and liveness only** (the side
channel is vacuous in the one-sided kernel), NOT timestamps, after one
re-coding epoch labels are rank ordinals that deliberately forget time, so
an iso claiming timestamps would be false post-epoch. -/

/-- A table entry. `par = none` for a root-attached run, else
`(parent entry index, attachment offset)`. Members after the head implicitly
carry label `1`; liveness is uniform along the run. -/
structure RTEntry where
  par   : Option (ℕ × ℕ)
  live  : Bool
  delta : ℕ
  len   : ℕ
deriving DecidableEq, Repr

/-- The run table: entries in the canonical (short-lex of heads) order. -/
abbrev Table := List RTEntry

/-- Canonical enumeration order on heads: shorter first, so parent entries
precede their children, and `keyLt`-lexicographic within a length. -/
def hLt (u v : List ℕ) : Bool :=
  decide (u.length < v.length)
    || (decide (u.length = v.length) && keyLt u v)

def hLe (u v : List ℕ) : Bool := !(hLt v u)

open Sal.EmbedRGA (keyLt_irrefl keyLt_asymm keyLt_trans keyLt_total) in
theorem hLt_irrefl (u : List ℕ) : hLt u u = false := by
  simp [hLt, keyLt_irrefl]

open Sal.EmbedRGA (keyLt_irrefl keyLt_asymm keyLt_trans keyLt_total) in
theorem hLt_asymm {u v : List ℕ} (h : hLt u v = true) : hLt v u = false := by
  simp only [hLt, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq] at h ⊢
  rcases h with h | ⟨hlen, hkey⟩
  · simp [Nat.not_lt.mpr (Nat.le_of_lt h), Nat.ne_of_gt h]
  · simp [hlen, keyLt_asymm hkey]

open Sal.EmbedRGA (keyLt_irrefl keyLt_asymm keyLt_trans keyLt_total) in
theorem hLt_trans {u v w : List ℕ} (h1 : hLt u v = true)
    (h2 : hLt v w = true) : hLt u w = true := by
  simp only [hLt, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq]
    at h1 h2 ⊢
  rcases h1 with h1 | ⟨hl1, hk1⟩ <;> rcases h2 with h2 | ⟨hl2, hk2⟩
  · exact Or.inl (by omega)
  · exact Or.inl (by omega)
  · exact Or.inl (by omega)
  · exact Or.inr ⟨by omega, keyLt_trans hk1 hk2⟩

open Sal.EmbedRGA (keyLt_irrefl keyLt_asymm keyLt_trans keyLt_total) in
theorem hLt_total {u v : List ℕ} (hne : u ≠ v) :
    hLt u v = true ∨ hLt v u = true := by
  simp only [hLt, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq]
  rcases Nat.lt_trichotomy u.length v.length with h | h | h
  · exact Or.inl (Or.inl h)
  · rcases keyLt_total hne with hk | hk
    · exact Or.inl (Or.inr ⟨h, hk⟩)
    · exact Or.inr (Or.inr ⟨h.symm, hk⟩)
  · exact Or.inr (Or.inl h)

theorem hLe_total (u v : List ℕ) : (hLe u v || hLe v u) = true := by
  simp only [hLe, Bool.or_eq_true, Bool.not_eq_true']
  by_cases h : hLt v u = true
  · exact Or.inr (hLt_asymm h)
  · exact Or.inl (Bool.eq_false_iff.mpr h)

theorem hLe_trans {u v w : List ℕ} (h1 : hLe u v = true)
    (h2 : hLe v w = true) : hLe u w = true := by
  simp only [hLe, Bool.not_eq_true'] at h1 h2 ⊢
  cases hwu : hLt w u with
  | false => rfl
  | true =>
      exfalso
      rcases eq_or_ne u v with rfl | hne
      · rw [h2] at hwu
        exact Bool.noConfusion hwu
      · rcases hLt_total hne with h | h
        · rw [hLt_trans hwu h] at h2
          exact Bool.noConfusion h2
        · rw [h] at h1
          exact Bool.noConfusion h1

/-- The canonical enumeration of runs: the heads, short-lex sorted. -/
def headsList (L : List (List ℕ)) : List (List ℕ) :=
  ((keptL L).filter (fun c => isHead L c)).mergeSort hLe

theorem mem_headsList {L : List (List ℕ)} {c : List ℕ} :
    c ∈ headsList L ↔ isHead L c = true := by
  rw [headsList, List.mem_mergeSort, List.mem_filter]
  constructor
  · exact fun h => h.2
  · exact fun h => ⟨isHead_kept h, h⟩

theorem nodup_headsList (L : List (List ℕ)) : (headsList L).Nodup := by
  rw [headsList]
  exact (List.mergeSort_perm _ _).nodup_iff.mpr ((nodup_keptL L).filter _)

theorem sorted_headsList (L : List (List ℕ)) :
    (headsList L).Pairwise (fun a b => hLt a b = true) := by
  have hle : (headsList L).Pairwise (fun a b => hLe a b = true) := by
    apply List.pairwise_mergeSort
    · intro a b c h1 h2
      exact hLe_trans h1 h2
    · intro a b
      exact hLe_total a b
  have hnd := nodup_headsList L
  refine (hle.and hnd).imp ?_
  rintro a b ⟨hab, hne⟩
  simp only [hLe, Bool.not_eq_true'] at hab
  rcases hLt_total hne with h | h
  · exact h
  · rw [h] at hab
    exact Bool.noConfusion hab

/-- The entry a head compiles to: the accounting header fields, nothing else.
The parent ref is the index of the parent node's run in the canonical
enumeration; the attachment offset is stored although T-tail makes it
derivable (`head_parent_is_tail`), mirroring the note §7's accounting. -/
def entryOfHead (L : List (List ℕ)) (h : List ℕ) : RTEntry :=
  { par := if h.dropLast ∈ keptL L
      then some ((headsList L).idxOf (headOf L h.dropLast),
                 h.dropLast.length - (headOf L h.dropLast).length)
      else none,
    live := decide (h ∈ L),
    delta := h.getLastD 0,
    len := lenOf L h }

/-- The canonical run table of a state. -/
def tableOf (L : List (List ℕ)) : Table :=
  (headsList L).map (entryOfHead L)

/-- Recover an entry's head chain from the already-recovered heads of the
entries before it (parent refs point strictly backward). -/
def entryHead (heads : List (List ℕ)) (e : RTEntry) : List ℕ :=
  match e.par with
  | none => [e.delta]
  | some (i, off) => (heads.getD i []) ++ List.replicate off 1 ++ [e.delta]

/-- All entry head chains, recovered left to right. -/
def headsOf (T : Table) : List (List ℕ) :=
  T.foldl (fun acc e => acc ++ [entryHead acc e]) []

/-- The abstraction: the live chains stored in the table, each live entry
contributes its members, head chain extended by the offset in `1`s. -/
def stateOf (T : Table) : List (List ℕ) :=
  ((headsOf T).zip T).flatMap (fun p =>
    if p.2.live
    then (List.range p.2.len).map (fun k => p.1 ++ List.replicate k 1)
    else [])

theorem headsOf_append (T : Table) (S : Table) :
    headsOf (T ++ S) = S.foldl (fun acc e => acc ++ [entryHead acc e])
      (headsOf T) := by
  rw [headsOf, List.foldl_append]
  rfl

theorem headsOf_snoc (T : Table) (e : RTEntry) :
    headsOf (T ++ [e]) = headsOf T ++ [entryHead (headsOf T) e] := by
  rw [headsOf_append]
  rfl

theorem headsOf_length (T : Table) : (headsOf T).length = T.length := by
  induction T using List.reverseRecOn with
  | nil => rfl
  | append_singleton T e ih => rw [headsOf_snoc]; simp [ih]

/-- Position of an element in a strictly sorted list is order-monotone. -/
theorem idxOf_lt_of_hLt {l : List (List ℕ)}
    (hsort : l.Pairwise (fun a b => hLt a b = true)) {a b : List ℕ}
    (ha : a ∈ l) (hb : b ∈ l) (hab : hLt a b = true) :
    l.idxOf a < l.idxOf b := by
  have hia : l.idxOf a < l.length := List.idxOf_lt_length_of_mem ha
  have hib : l.idxOf b < l.length := List.idxOf_lt_length_of_mem hb
  have hga : l[l.idxOf a] = a := List.getElem_idxOf hia
  have hgb : l[l.idxOf b] = b := List.getElem_idxOf hib
  rcases Nat.lt_trichotomy (l.idxOf a) (l.idxOf b) with h | h | h
  · exact h
  · exfalso
    have : a = b := (List.idxOf_inj ha).mp h
    subst this
    rw [hLt_irrefl] at hab
    exact Bool.noConfusion hab
  · exfalso
    have := List.pairwise_iff_getElem.mp hsort _ _ hib hia h
    rw [hga, hgb] at this
    rw [hLt_asymm this] at hab
    exact Bool.noConfusion hab

/-- In a Nodup list, `idxOf` inverts `getElem`. -/
theorem idxOf_getElem_nodup {l : List (List ℕ)} (hnd : l.Nodup)
    {i : ℕ} (hi : i < l.length) : l.idxOf l[i] = i := by
  have hm : l[i] ∈ l := List.getElem_mem hi
  have hlt : l.idxOf l[i] < l.length := List.idxOf_lt_length_of_mem hm
  have hg : l[l.idxOf l[i]] = l[i] := List.getElem_idxOf hlt
  exact (List.Nodup.getElem_inj_iff hnd).mp hg

/-- A head whose parent node is not kept sits at the root: length 1. -/
theorem head_root_singleton {L : List (List ℕ)} {h : List ℕ}
    (hh : isHead L h = true) (hp : h.dropLast ∉ keptL L) :
    ∃ d, h = [d] := by
  rcases List.eq_nil_or_concat h with rfl | ⟨p, b, rfl⟩
  · exact absurd rfl (kept_ne_nil (isHead_kept hh))
  · simp only [List.concat_eq_append] at *
    cases p with
    | nil => exact ⟨b, rfl⟩
    | cons a as =>
        exfalso
        apply hp
        rw [List.dropLast_concat]
        exact kept_of_prefix (isHead_kept hh) (List.prefix_append _ _)
          (by simp)

/-- **The recovery step**: compiling a head to its entry and recovering the
head from the previously recovered heads round-trips. This is where the
backward parent refs and the canonical order earn their keep. -/
theorem entryHead_entryOfHead {L : List (List ℕ)} {n : ℕ}
    (hn : n < (headsList L).length) :
    entryHead ((headsList L).take n) (entryOfHead L (headsList L)[n])
      = (headsList L)[n] := by
  set h := (headsList L)[n] with hh_def
  have hh : isHead L h = true :=
    mem_headsList.mp (List.getElem_mem hn)
  have hne : h ≠ [] := kept_ne_nil (isHead_kept hh)
  by_cases hp : h.dropLast ∈ keptL L
  · -- attached: recover through the parent entry
    set g := headOf L h.dropLast with hg_def
    have hgh : isHead L g = true := headOf_isHead hp
    have hgm : g ∈ headsList L := mem_headsList.mpr hgh
    have hglt : hLt g h = true := by
      have h1 : g.length ≤ h.dropLast.length := (headOf_prefix L _).length_le
      have h2 : h.dropLast.length < h.length := by
        rw [List.length_dropLast]
        have : 0 < h.length := List.length_pos_iff.mpr hne
        omega
      simp only [hLt, Bool.or_eq_true, decide_eq_true_eq]
      exact Or.inl (by omega)
    have hidx : (headsList L).idxOf g < n := by
      have := idxOf_lt_of_hLt (sorted_headsList L) hgm
        (List.getElem_mem hn) hglt
      rwa [← hh_def, idxOf_getElem_nodup (nodup_headsList L) hn] at this
    have hidxlen : (headsList L).idxOf g < (headsList L).length :=
      List.idxOf_lt_length_of_mem hgm
    have hgetD : ((headsList L).take n).getD ((headsList L).idxOf g) [] = g := by
      rw [List.getD_eq_getElem?_getD, List.getElem?_take_of_lt hidx,
        List.getElem?_eq_getElem hidxlen]
      simp [List.getElem_idxOf]
    have hpar_form : g ++ List.replicate (h.dropLast.length - g.length) 1
        = h.dropLast :=
      (runMember_form (mem_runMembers.mpr ⟨hp, hg_def.symm⟩)).symm
    have hentry : entryOfHead L h =
        { par := some ((headsList L).idxOf g,
                       h.dropLast.length - g.length),
          live := decide (h ∈ L), delta := h.getLastD 0,
          len := lenOf L h } := by
      rw [entryOfHead]
      simp only [if_pos hp, ← hg_def]
    rw [hentry]
    simp only [entryHead]
    rw [hgetD, hpar_form]
    obtain ⟨p, b, hpb⟩ : ∃ p b, h = p ++ [b] := by
      rcases List.eq_nil_or_concat h with hnil | ⟨p, b, hpb⟩
      · exact absurd hnil hne
      · exact ⟨p, b, by simpa using hpb⟩
    rw [hpb, List.dropLast_concat, List.getLastD_concat]
  · -- root: the head is its own delta
    obtain ⟨d, hd⟩ := head_root_singleton hh hp
    have hentry : entryOfHead L h =
        { par := none, live := decide (h ∈ L),
          delta := h.getLastD 0, len := lenOf L h } := by
      rw [entryOfHead]
      simp only [if_neg hp]
    rw [hentry]
    simp only [entryHead]
    rw [hd]
    rfl

/-- **Head recovery**: the fold over the canonical table recovers exactly the
canonical head enumeration. -/
theorem headsOf_tableOf (L : List (List ℕ)) :
    headsOf (tableOf L) = headsList L := by
  have hlen : (tableOf L).length = (headsList L).length := by simp [tableOf]
  suffices h : ∀ n, headsOf ((tableOf L).take n) = (headsList L).take n by
    have := h (tableOf L).length
    rwa [List.take_length, hlen, List.take_length] at this
  intro n
  induction n with
  | zero => rfl
  | succ n ih =>
      by_cases hlt : n < (headsList L).length
      · have hlt' : n < (tableOf L).length := by omega
        rw [List.take_succ, List.take_succ,
            List.getElem?_eq_getElem hlt', List.getElem?_eq_getElem hlt]
        simp only [Option.toList_some]
        rw [headsOf_snoc, ih]
        congr 1
        rw [show (tableOf L)[n] = entryOfHead L ((headsList L)[n]) from by
          simp [tableOf]]
        rw [entryHead_entryOfHead hlt]
      · rw [List.take_succ, List.take_succ,
            List.getElem?_eq_none (by omega),
            List.getElem?_eq_none (by omega)]
        simp [ih]

theorem stateOf_tableOf_eq (L : List (List ℕ)) :
    stateOf (tableOf L)
      = (headsList L).flatMap (fun h =>
          if decide (h ∈ L) = true
          then (List.range (lenOf L h)).map (fun k => h ++ List.replicate k 1)
          else []) := by
  have zip_map_self : ∀ {α β : Type} (f : α → β) (l : List α),
      l.zip (l.map f) = l.map (fun a => (a, f a)) := by
    intro α β f l
    induction l with
    | nil => rfl
    | cons a l ih => simp [ih]
  rw [stateOf, headsOf_tableOf, tableOf, zip_map_self, List.flatMap_map]
  simp [entryOfHead, Function.comp]

/-- Nodup of a flatMap over nodup blocks with pairwise-disjoint images. -/
theorem nodup_flatMap_of_disjoint {α β : Type} {l : List α} {f : α → List β}
    (hnd : l.Nodup) (hblock : ∀ a ∈ l, (f a).Nodup)
    (hdisj : ∀ a ∈ l, ∀ a' ∈ l, a ≠ a' → ∀ b ∈ f a, b ∉ f a') :
    (l.flatMap f).Nodup := by
  induction l with
  | nil => simp
  | cons a l ih =>
      rw [List.flatMap_cons, List.nodup_append]
      have hal := List.pairwise_cons.mp hnd
      refine ⟨hblock a List.mem_cons_self, ?_, ?_⟩
      · exact ih hal.2
          (fun a' ha' => hblock a' (List.mem_cons_of_mem _ ha'))
          (fun a' ha' a'' ha'' => hdisj a' (List.mem_cons_of_mem _ ha')
            a'' (List.mem_cons_of_mem _ ha''))
      · intro b hb b' hb' heq
        subst heq
        obtain ⟨a', ha', hba'⟩ := List.mem_flatMap.mp hb'
        exact hdisj a List.mem_cons_self a' (List.mem_cons_of_mem _ ha')
          (hal.1 a' ha') b hb hba'

/-- **T-repr, losslessness direction (`stateOf ∘ tableOf = id`)**: from the
table alone, parent refs, offsets, deltas, lengths, liveness flags; no
chains, no timestamps, the exact set of live label chains is recovered.
This is the note's zero-tolerance reconstruction gate as a theorem, and the
content of the iso: **labels and liveness** (the side channel is vacuously
`R` one-sided; timestamps are deliberately not claimed, since post-epoch
labels are rank ordinals). -/
theorem stateOf_tableOf (L : List (List ℕ)) (hnil : [] ∉ L) :
    (stateOf (tableOf L)).Nodup
      ∧ (∀ c, c ∈ stateOf (tableOf L) ↔ c ∈ L) := by
  rw [stateOf_tableOf_eq]
  constructor
  · refine nodup_flatMap_of_disjoint (nodup_headsList L) ?_ ?_
    · intro h hm
      by_cases hl : decide (h ∈ L) = true
      · rw [if_pos hl]
        refine List.Nodup.map_on ?_ List.nodup_range
        intro j₁ _ j₂ _ heq
        exact replicate_offset_inj heq
      · rw [if_neg hl]
        exact List.nodup_nil
    · intro h hm h' hm' hne b hb hb'
      by_cases hl : decide (h ∈ L) = true
      · by_cases hl' : decide (h' ∈ L) = true
        · rw [if_pos hl] at hb
          rw [if_pos hl'] at hb'
          obtain ⟨k, hk, rfl⟩ := List.mem_map.mp hb
          obtain ⟨k', hk', heq⟩ := List.mem_map.mp hb'
          rw [List.mem_range] at hk hk'
          have hmem : h ++ List.replicate k 1 ∈ runMembers L h :=
            runMember_of_lt (mem_headsList.mp hm) hk
          have hmem' : h' ++ List.replicate k' 1 ∈ runMembers L h' :=
            runMember_of_lt (mem_headsList.mp hm') hk'
          rw [heq] at hmem'
          exact hne ((mem_runMembers.mp hmem).2.symm.trans
            (mem_runMembers.mp hmem').2)
        · rw [if_neg hl'] at hb'
          simp at hb'
      · rw [if_neg hl] at hb
        simp at hb
  · intro c
    rw [List.mem_flatMap]
    constructor
    · rintro ⟨h, hm, hc⟩
      by_cases hl : decide (h ∈ L) = true
      · rw [if_pos hl] at hc
        obtain ⟨k, hk, rfl⟩ := List.mem_map.mp hc
        rw [List.mem_range] at hk
        have hmem : h ++ List.replicate k 1 ∈ runMembers L h :=
          runMember_of_lt (mem_headsList.mp hm) hk
        exact (run_liveness_uniform hmem).mpr (of_decide_eq_true hl)
      · rw [if_neg hl] at hc
        simp at hc
    · intro hc
      have hne : c ≠ [] := fun h => hnil (h ▸ hc)
      have hkept : c ∈ keptL L := kept_of_live hc hne
      have hmem : c ∈ runMembers L (headOf L c) :=
        mem_runMembers.mpr ⟨hkept, rfl⟩
      refine ⟨headOf L c, mem_headsList.mpr (headOf_isHead hkept), ?_⟩
      have hlive : headOf L c ∈ L := (run_liveness_uniform hmem).mp hc
      rw [if_pos (decide_eq_true hlive)]
      refine List.mem_map.mpr ⟨c.length - (headOf L c).length, ?_,
        (runMember_form hmem).symm⟩
      rw [List.mem_range]
      exact runMember_offset_lt ((runMember_form hmem) ▸ hmem)

/-! ### Canonicity: the other direction of the iso

`Canonical` is the note §10's characterization of the canonical table,
maximal fusible chains (`no_fuse`: a lone delta-1 same-liveness attachment
would have been coalesced; D4's forced inverse rule as a *hypothesis* the
theorem cannot do without), tail attachment (`par_tail`, as a field
equation), uniform liveness (built into the entry granularity), keptness
(`leaves_live`: a dead leaf run is not kept), well-formed sibling structure
(`sib_delta`), backward parent refs, and the canonical enumeration order. -/

structure Canonical (T : Table) : Prop where
  len_pos : ∀ e ∈ T, 1 ≤ e.len
  par_back : ∀ i (hi : i < T.length) p, T[i].par = some p → p.1 < i
  par_tail : ∀ i (hi : i < T.length) p, T[i].par = some p →
    ∀ (hj : p.1 < T.length), p.2 = T[p.1].len - 1
  no_fuse : ∀ i (hi : i < T.length) p, T[i].par = some p →
    ∀ (hj : p.1 < T.length), T[i].delta = 1 → T[i].live = T[p.1].live →
    ∃ i', ∃ (_ : i' < T.length), i' ≠ i ∧ T[i'].par = some p
  leaves_live : ∀ i (hi : i < T.length), T[i].live = false →
    ∃ i', ∃ (_ : i' < T.length), ∃ off, T[i'].par = some (i, off)
  sorted : (headsOf T).Pairwise (fun a b => hLt a b = true)

theorem headsOf_prefix_append (T S : Table) :
    headsOf T <+: headsOf (T ++ S) := by
  induction S using List.reverseRecOn with
  | nil => simp
  | append_singleton S e ih =>
      rw [← List.append_assoc, headsOf_snoc]
      exact ih.trans (List.prefix_append _ _)

theorem headsOf_take (T : Table) (n : ℕ) :
    headsOf (T.take n) = (headsOf T).take n := by
  have h1 : headsOf (T.take n) <+: headsOf T := by
    conv_rhs => rw [← List.take_append_drop n T]
    exact headsOf_prefix_append _ _
  have h2 : (headsOf T).take n <+: headsOf T := List.take_prefix _ _
  have hlen : (headsOf (T.take n)).length = ((headsOf T).take n).length := by
    rw [headsOf_length, List.length_take, List.length_take, headsOf_length]
  exact (List.prefix_of_prefix_length_le h1 h2 (le_of_eq hlen)).eq_of_length
    hlen

/-- The positional recovery formula. -/
theorem headsOf_getElem (T : Table) (i : ℕ) (hi : i < T.length) :
    (headsOf T)[i]'(by rw [headsOf_length]; exact hi)
      = entryHead ((headsOf T).take i) T[i] := by
  have htake : T.take (i + 1) = T.take i ++ [T[i]] := by
    rw [List.take_succ, List.getElem?_eq_getElem hi]
    rfl
  have h1 : (headsOf T).take (i + 1)
      = (headsOf T).take i ++ [entryHead ((headsOf T).take i) T[i]] := by
    rw [← headsOf_take, htake, headsOf_snoc, headsOf_take]
  have h2 : (headsOf T).take (i + 1)
      = (headsOf T).take i
        ++ [(headsOf T)[i]'(by rw [headsOf_length]; exact hi)] := by
    rw [List.take_succ, List.getElem?_eq_getElem]
    rfl
  have := h1.symm.trans h2
  have := List.append_cancel_left this
  injection this with h _
  exact h.symm

/-- Recovered head, attached form. -/
theorem headsOf_getElem_some {T : Table} {i : ℕ} (hi : i < T.length)
    {p : ℕ × ℕ} (hp : T[i].par = some p) (hlt : p.1 < i) :
    (headsOf T)[i]'(by rw [headsOf_length]; exact hi)
      = ((headsOf T)[p.1]'(by rw [headsOf_length]; omega))
        ++ List.replicate p.2 1 ++ [T[i].delta] := by
  obtain ⟨p1, p2⟩ := p
  rw [headsOf_getElem T i hi, entryHead, hp]
  simp only []
  have hp1 : p1 < (headsOf T).length := by rw [headsOf_length]; omega
  rw [List.getD_eq_getElem?_getD, List.getElem?_take_of_lt hlt,
    List.getElem?_eq_getElem hp1]
  rfl

/-- Recovered head, root form. -/
theorem headsOf_getElem_none {T : Table} {i : ℕ} (hi : i < T.length)
    (hp : T[i].par = none) :
    (headsOf T)[i]'(by rw [headsOf_length]; exact hi) = [T[i].delta] := by
  rw [headsOf_getElem T i hi, entryHead, hp]

/-- Recovered heads are nonempty. -/
theorem headsOf_getElem_ne_nil {T : Table} {i : ℕ} (hi : i < T.length)
    (hback : ∀ p, T[i].par = some p → p.1 < i) :
    (headsOf T)[i]'(by rw [headsOf_length]; exact hi) ≠ [] := by
  cases hp : T[i].par with
  | none => rw [headsOf_getElem_none hi hp]; simp
  | some p => rw [headsOf_getElem_some hi hp (hback p hp)]; simp

/-- Recovered head of entry `i`, total form (`[]` out of range). -/
def hsAt (T : Table) (i : ℕ) : List ℕ := (headsOf T).getD i []

theorem hsAt_eq_getElem {T : Table} {i : ℕ} (hi : i < T.length) :
    hsAt T i = (headsOf T)[i]'(by rw [headsOf_length]; exact hi) := by
  rw [hsAt, List.getD_eq_getElem?_getD,
    List.getElem?_eq_getElem (by rw [headsOf_length]; exact hi)]
  rfl

theorem hsAt_some {T : Table} {i : ℕ} (hi : i < T.length)
    {p : ℕ × ℕ} (hp : T[i].par = some p) (hlt : p.1 < i) :
    hsAt T i = hsAt T p.1 ++ List.replicate p.2 1 ++ [T[i].delta] := by
  rw [hsAt_eq_getElem hi, hsAt_eq_getElem (by omega : p.1 < T.length)]
  exact headsOf_getElem_some hi hp hlt

theorem hsAt_none {T : Table} {i : ℕ} (hi : i < T.length)
    (hp : T[i].par = none) : hsAt T i = [T[i].delta] := by
  rw [hsAt_eq_getElem hi]
  exact headsOf_getElem_none hi hp

theorem hsAt_ne_nil {T : Table} (hC : Canonical T) {i : ℕ}
    (hi : i < T.length) : hsAt T i ≠ [] := by
  rw [hsAt_eq_getElem hi]
  exact headsOf_getElem_ne_nil hi (fun p hp => hC.par_back i hi p hp)

theorem headsOf_nodup {T : Table} (hC : Canonical T) :
    (headsOf T).Nodup :=
  hC.sorted.imp (fun {a b} hab heq => by
    subst heq
    rw [hLt_irrefl] at hab
    exact Bool.noConfusion hab)

theorem hsAt_inj {T : Table} (hC : Canonical T) {i j : ℕ}
    (hi : i < T.length) (hj : j < T.length) (heq : hsAt T i = hsAt T j) :
    i = j := by
  rw [hsAt_eq_getElem hi, hsAt_eq_getElem hj] at heq
  exact (List.Nodup.getElem_inj_iff (headsOf_nodup hC)).mp heq

/-- Take out of a padded chain. -/
theorem take_append_replicate {h : List ℕ} {r k : ℕ} (hrk : r ≤ k) :
    (h ++ List.replicate k 1).take (h.length + r)
      = h ++ List.replicate r 1 := by
  rw [List.take_append, List.take_of_length_le (by omega)]
  congr 1
  rw [show h.length + r - h.length = r by omega, List.take_replicate]
  congr 1
  omega

/-- Dropping the last `1` of a padded chain. -/
theorem dropLast_append_replicate_succ {h : List ℕ} {r : ℕ} :
    (h ++ List.replicate (r + 1) 1).dropLast = h ++ List.replicate r 1 := by
  rw [List.replicate_succ', ← List.append_assoc, List.dropLast_concat]

theorem getLastD_append_replicate_succ {h : List ℕ} {r : ℕ} :
    (h ++ List.replicate (r + 1) 1).getLastD 0 = 1 := by
  rw [List.replicate_succ', ← List.append_assoc, List.getLastD_concat]

theorem getLastD_append_replicate_pos {h : List ℕ} {r : ℕ} (hr : 1 ≤ r) :
    (h ++ List.replicate r 1).getLastD 0 = 1 := by
  obtain ⟨r', rfl⟩ : ∃ r', r = r' + 1 := ⟨r - 1, by omega⟩
  exact getLastD_append_replicate_succ

theorem dropLast_append_replicate_pos {h : List ℕ} {r : ℕ} (hr : 1 ≤ r) :
    (h ++ List.replicate r 1).dropLast = h ++ List.replicate (r - 1) 1 := by
  obtain ⟨r', rfl⟩ : ∃ r', r = r' + 1 := ⟨r - 1, by omega⟩
  rw [dropLast_append_replicate_succ]
  simp

/-- **Member-chain uniqueness**: the engine of canonicity. A kept chain
decodes to a unique `(entry, offset)` address. The killing blow in the
overlap case is *tail attachment* (`par_tail`): a delta-1 child hangs at its
parent's tail, so a member sitting past the tail would exceed the parent's
length. -/
theorem memChain_inj {T : Table} (hC : Canonical T) :
    ∀ n (c : List ℕ), c.length ≤ n →
    ∀ i (_ : i < T.length) k (_ : k < T[i].len)
      (_ : c = hsAt T i ++ List.replicate k 1)
      j (_ : j < T.length) m (_ : m < T[j].len)
      (_ : c = hsAt T j ++ List.replicate m 1),
    i = j ∧ k = m := by
  intro n
  induction n with
  | zero =>
      intro c hc i hi k hk hci j hj m hm hcj
      exfalso
      apply hsAt_ne_nil hC hi
      have : c = [] := List.length_eq_zero_iff.mp (by omega)
      rw [this] at hci
      cases hs : hsAt T i with
      | nil => rfl
      | cons a as => rw [hs] at hci; simp at hci
  | succ n ih =>
      intro c hc i hi k hk hci j hj m hm hcj
      -- the asymmetric overlap case, factored
      have step : ∀ i' (_ : i' < T.length) k' (_ : k' < T[i'].len)
          (_ : c = hsAt T i' ++ List.replicate k' 1)
          j' (_ : j' < T.length) m' (_ : m' < T[j'].len)
          (_ : c = hsAt T j' ++ List.replicate m' 1),
          (hsAt T i').length < (hsAt T j').length → False := by
        intro i' hi' k' hk' hci' j' hj' m' hm' hcj' hlen
        set r := (hsAt T j').length - (hsAt T i').length with hr
        have hr1 : 1 ≤ r := by omega
        have hclen : c.length = (hsAt T i').length + k' := by
          rw [hci']; simp
        have hrk : r ≤ k' := by
          have : (hsAt T j').length ≤ c.length := by
            rw [hcj']; simp
          omega
        have hjform : hsAt T j' = hsAt T i' ++ List.replicate r 1 := by
          have h1 : hsAt T j' = c.take (hsAt T j').length := by
            rw [hcj', List.take_append,
              List.take_of_length_le (by omega),
              show (hsAt T j').length - (hsAt T j').length = 0 by omega]
            simp
          rw [h1, hci', show (hsAt T j').length = (hsAt T i').length + r
            by omega]
          exact take_append_replicate hrk
        cases hp : T[j'].par with
        | none =>
            have := hsAt_none hj' hp
            rw [this] at hjform
            have hlen1 := congrArg List.length hjform
            simp at hlen1
            have : hsAt T i' ≠ [] := hsAt_ne_nil hC hi'
            have : 1 ≤ (hsAt T i').length :=
              List.length_pos_iff.mpr this
            omega
        | some p =>
            have hpb : p.1 < j' := hC.par_back j' hj' p hp
            have hpl : p.1 < T.length := by omega
            have hjs : hsAt T j'
                = hsAt T p.1 ++ List.replicate p.2 1 ++ [T[j'].delta] :=
              hsAt_some hj' hp hpb
            -- the branch label is 1
            have hdelta : T[j'].delta = 1 := by
              have h1 : (hsAt T j').getLastD 0 = T[j'].delta := by
                rw [hjs, List.getLastD_concat]
              have h2 : (hsAt T j').getLastD 0 = 1 := by
                rw [hjform]
                exact getLastD_append_replicate_pos hr1
              omega
            -- the shared parent node, two ways
            have hq : hsAt T i' ++ List.replicate (r - 1) 1
                = hsAt T p.1 ++ List.replicate p.2 1 := by
              have h1 : (hsAt T j').dropLast
                  = hsAt T i' ++ List.replicate (r - 1) 1 := by
                rw [hjform]
                exact dropLast_append_replicate_pos hr1
              have h2 : (hsAt T j').dropLast
                  = hsAt T p.1 ++ List.replicate p.2 1 := by
                rw [hjs, List.dropLast_concat]
              rw [← h1, h2]
            have hp2 : p.2 = T[p.1].len - 1 := hC.par_tail j' hj' p hp hpl
            have hplen : 1 ≤ T[p.1].len :=
              hC.len_pos _ (List.getElem_mem hpl)
            have hqlen : (hsAt T i' ++ List.replicate (r - 1) 1).length ≤ n := by
              have : 1 ≤ (hsAt T i').length :=
                List.length_pos_iff.mpr (hsAt_ne_nil hC hi')
              simp only [List.length_append, List.length_replicate]
              omega
            have := ih (hsAt T i' ++ List.replicate (r - 1) 1) hqlen
              i' hi' (r - 1) (by omega) rfl
              p.1 hpl p.2 (by omega) hq
            obtain ⟨hip, hrp⟩ := this
            -- tail attachment: r = parent len, but r ≤ k' < parent len
            subst hip
            omega
      rcases Nat.lt_trichotomy (hsAt T i).length (hsAt T j).length
        with hlen | hlen | hlen
      · exact absurd (step i hi k hk hci j hj m hm hcj hlen) (fun h => h)
      · have hheads : hsAt T i = hsAt T j := by
          have h1 : hsAt T i = c.take (hsAt T i).length := by
            rw [hci, List.take_append,
              List.take_of_length_le (le_refl _)]
            simp
          have h2 : hsAt T j = c.take (hsAt T j).length := by
            rw [hcj, List.take_append,
              List.take_of_length_le (le_refl _)]
            simp
          rw [h1, h2, hlen]
        have hij : i = j := hsAt_inj hC hi hj hheads
        subst hij
        rw [hci, hheads] at hcj
        exact ⟨rfl, replicate_offset_inj hcj⟩
      · exact absurd (step j hj m hm hcj i hi k hk hci hlen) (fun h => h)

/-- Membership in `stateOf`: exactly the live entries' member chains. -/
theorem mem_stateOf {T : Table} {c : List ℕ} :
    c ∈ stateOf T ↔ ∃ i, ∃ (_ : i < T.length), ∃ k, k < T[i].len ∧
      T[i].live = true ∧ c = hsAt T i ++ List.replicate k 1 := by
  rw [stateOf, List.mem_flatMap]
  constructor
  · rintro ⟨⟨h, e⟩, hmem, hc⟩
    obtain ⟨i, hi, hpair⟩ := List.mem_iff_getElem.mp hmem
    have hilen : i < T.length := by
      have := hi
      simp only [List.length_zip, headsOf_length] at this
      omega
    rw [List.getElem_zip] at hpair
    injection hpair with hph hpe
    by_cases hl : e.live = true
    · rw [if_pos hl] at hc
      obtain ⟨k, hk, rfl⟩ := List.mem_map.mp hc
      rw [List.mem_range] at hk
      refine ⟨i, hilen, k, ?_, ?_, ?_⟩
      · rw [hpe]; exact hk
      · rw [hpe]; exact hl
      · rw [hsAt_eq_getElem hilen, ← hph]
    · rw [if_neg hl] at hc
      simp at hc
  · rintro ⟨i, hi, k, hk, hlive, rfl⟩
    refine ⟨((headsOf T)[i]'(by rw [headsOf_length]; exact hi), T[i]),
      ?_, ?_⟩
    · exact List.mem_iff_getElem.mpr ⟨i,
        by simp [List.length_zip, headsOf_length]; omega,
        by rw [List.getElem_zip]⟩
    · rw [if_pos hlive]
      refine List.mem_map.mpr ⟨k, List.mem_range.mpr hk, ?_⟩
      rw [hsAt_eq_getElem hi]

/-- Every member chain extends to a live chain of the state (`leaves_live`
descending). -/
theorem memChain_extends_live {T : Table} (hC : Canonical T) :
    ∀ d i (hi : i < T.length), T.length - i ≤ d →
    ∀ k, k < T[i].len →
    ∃ l ∈ stateOf T, hsAt T i ++ List.replicate k 1 <+: l := by
  intro d
  induction d with
  | zero => intro i hi hd; omega
  | succ d ih =>
      intro i hi hd k hk
      cases hlive : T[i].live with
      | true =>
          exact ⟨hsAt T i ++ List.replicate k 1,
            mem_stateOf.mpr ⟨i, hi, k, hk, hlive, rfl⟩, List.prefix_refl _⟩
      | false =>
          obtain ⟨i', hi', off, hpar⟩ := hC.leaves_live i hi hlive
          have hlt : i < i' := hC.par_back i' hi' (i, off) hpar
          have hoff : off = T[i].len - 1 := hC.par_tail i' hi' (i, off) hpar hi
          have hform : hsAt T i' = hsAt T i ++ List.replicate off 1
              ++ [T[i'].delta] := hsAt_some hi' hpar hlt
          obtain ⟨l, hl, hpre⟩ := ih i' hi' (by omega) 0
            (hC.len_pos _ (List.getElem_mem hi'))
          refine ⟨l, hl, ?_⟩
          have h1 : hsAt T i ++ List.replicate k 1
              <+: hsAt T i ++ List.replicate off 1 := by
            have : List.replicate off 1
                = List.replicate k 1 ++ List.replicate (off - k) 1 := by
              rw [← List.replicate_add]
              congr 1
              omega
            rw [this, ← List.append_assoc]
            exact List.prefix_append _ _
          have h2 : hsAt T i ++ List.replicate off 1 <+: hsAt T i' := by
            rw [hform]
            exact List.prefix_append _ _
          have h3 : hsAt T i' <+: hsAt T i' ++ List.replicate 0 1 := by simp
          exact ((h1.trans h2).trans h3).trans hpre

/-- Prefixes of member chains are member chains (ancestor closure). -/
theorem prefix_memChain {T : Table} (hC : Canonical T) :
    ∀ i (hi : i < T.length) k (hk : k < T[i].len) (c : List ℕ),
      c <+: hsAt T i ++ List.replicate k 1 → c ≠ [] →
      ∃ j, ∃ (_ : j < T.length), ∃ m, m < T[j].len ∧
        c = hsAt T j ++ List.replicate m 1 := by
  intro i
  induction i using Nat.strongRecOn with
  | ind i ih =>
      intro hi k hk c hpre hne
      rcases Nat.lt_trichotomy c.length (hsAt T i).length with hlen | hlen | hlen
      · -- strictly inside the head: descend to the parent entry
        have hpre' : c <+: hsAt T i := by
          refine List.prefix_of_prefix_length_le hpre (List.prefix_append _ _) ?_
          omega
        cases hp : T[i].par with
        | none =>
            exfalso
            have hform := hsAt_none hi hp
            rw [hform] at hlen
            simp only [List.length_cons, List.length_nil] at hlen
            have : 1 ≤ c.length := List.length_pos_iff.mpr hne
            omega
        | some p =>
            have hpb : p.1 < i := hC.par_back i hi p hp
            have hpl : p.1 < T.length := by omega
            have hform : hsAt T i
                = hsAt T p.1 ++ List.replicate p.2 1 ++ [T[i].delta] :=
              hsAt_some hi hp hpb
            have hp2 : p.2 = T[p.1].len - 1 := hC.par_tail i hi p hp hpl
            have hlenpos : 1 ≤ T[p.1].len :=
              hC.len_pos _ (List.getElem_mem hpl)
            have hcd : c <+: hsAt T p.1 ++ List.replicate p.2 1 := by
              have := prefix_dropLast_of_ne hpre'
                (fun heq => by rw [heq] at hlen; omega)
              rwa [hform, List.dropLast_concat] at this
            exact ih p.1 hpb hpl p.2 (by omega) c hcd hne
      · -- exactly the head
        have : c = hsAt T i :=
          (List.prefix_of_prefix_length_le hpre (List.prefix_append _ _)
            (by omega)).eq_of_length hlen
        exact ⟨i, hi, 0, by
          have := hC.len_pos _ (List.getElem_mem hi)
          omega, by simpa using this⟩
      · -- inside the run: a shallower member
        have hclen : c.length ≤ (hsAt T i).length + k := by
          have := hpre.length_le
          simpa using this
        set m := c.length - (hsAt T i).length with hm
        have hmk : m ≤ k := by omega
        have hcform : c = hsAt T i ++ List.replicate m 1 := by
          have h1 : c = (hsAt T i ++ List.replicate k 1).take c.length :=
            List.prefix_iff_eq_take.mp hpre
          rw [h1, show c.length = (hsAt T i).length + m by omega]
          exact take_append_replicate hmk
        exact ⟨i, hi, m, by omega, hcform⟩

/-- **Kept-tree characterization**: the kept chains of the recovered state
are exactly the member chains of the table. -/
theorem kept_stateOf_iff {T : Table} (hC : Canonical T) {c : List ℕ} :
    c ∈ keptL (stateOf T) ↔ ∃ i, ∃ (_ : i < T.length), ∃ k, k < T[i].len ∧
      c = hsAt T i ++ List.replicate k 1 := by
  constructor
  · intro hc
    obtain ⟨hne, l, hl, hpre⟩ := mem_keptL.mp hc
    obtain ⟨j, hj, m, hm, hlive, rfl⟩ := mem_stateOf.mp hl
    obtain ⟨j', hj', m', hm', hform⟩ := prefix_memChain hC j hj m hm c hpre hne
    exact ⟨j', hj', m', hm', hform⟩
  · rintro ⟨i, hi, k, hk, rfl⟩
    obtain ⟨l, hl, hpre⟩ := memChain_extends_live hC T.length i hi
      (by omega) k hk
    refine mem_keptL.mpr ⟨?_, l, hl, hpre⟩
    intro hnil
    exact hsAt_ne_nil hC hi (by
      cases hs : hsAt T i with
      | nil => rfl
      | cons a as => rw [hs] at hnil; simp at hnil)

/-- Uniqueness, packaged at the two-decompositions interface. -/
theorem memChain_inj' {T : Table} (hC : Canonical T) {i j k m : ℕ}
    (hi : i < T.length) (hk : k < T[i].len)
    (hj : j < T.length) (hm : m < T[j].len)
    (heq : hsAt T i ++ List.replicate k 1 = hsAt T j ++ List.replicate m 1) :
    i = j ∧ k = m :=
  memChain_inj hC (hsAt T i ++ List.replicate k 1).length _ (le_refl _)
    i hi k hk rfl j hj m hm heq

/-- A member chain is live in the recovered state iff its entry is live. -/
theorem memChain_live_iff {T : Table} (hC : Canonical T) {i k : ℕ}
    (hi : i < T.length) (hk : k < T[i].len) :
    (hsAt T i ++ List.replicate k 1 ∈ stateOf T) ↔ T[i].live = true := by
  constructor
  · intro hmem
    obtain ⟨j, hj, m, hm, hlive, heq⟩ := mem_stateOf.mp hmem
    obtain ⟨rfl, -⟩ := memChain_inj' hC hi hk hj hm heq
    exact hlive
  · intro hlive
    exact mem_stateOf.mpr ⟨i, hi, k, hk, hlive, rfl⟩

/-- Interior member edges of the recovered state are fusible. -/
theorem memChain_fusible {T : Table} (hC : Canonical T) {i k : ℕ}
    (hi : i < T.length) (hk1 : k + 1 < T[i].len) :
    fusible (stateOf T) (hsAt T i ++ List.replicate (k + 1) 1) = true := by
  have hdrop : (hsAt T i ++ List.replicate (k + 1) 1).dropLast
      = hsAt T i ++ List.replicate k 1 := dropLast_append_replicate_succ
  have hkept : hsAt T i ++ List.replicate (k + 1) 1 ∈ keptL (stateOf T) :=
    (kept_stateOf_iff hC).mpr ⟨i, hi, k + 1, hk1, rfl⟩
  have hdkept : hsAt T i ++ List.replicate k 1 ∈ keptL (stateOf T) :=
    (kept_stateOf_iff hC).mpr ⟨i, hi, k, by omega, rfl⟩
  have huniq : ∀ c' ∈ keptL (stateOf T),
      c'.dropLast = (hsAt T i ++ List.replicate (k + 1) 1).dropLast →
      c' = hsAt T i ++ List.replicate (k + 1) 1 := by
    intro c' hc' hd
    rw [hdrop] at hd
    obtain ⟨j, hj, m, hm, rfl⟩ := (kept_stateOf_iff hC).mp hc'
    cases m with
    | zero =>
        exfalso
        simp only [List.replicate_zero, List.append_nil] at hd ⊢
        cases hp : T[j].par with
        | none =>
            have := hsAt_none hj hp
            rw [this] at hd
            rw [show ([T[j].delta] : List ℕ).dropLast = [] from rfl] at hd
            exact hsAt_ne_nil hC hi (by
              cases hs : hsAt T i with
              | nil => rfl
              | cons a as =>
                  rw [hs] at hd
                  simp at hd)
        | some p =>
            have hpb : p.1 < j := hC.par_back j hj p hp
            have hpl : p.1 < T.length := by omega
            have hform := hsAt_some hj hp hpb
            rw [hform, List.dropLast_concat] at hd
            have hp2 : p.2 = T[p.1].len - 1 := hC.par_tail j hj p hp hpl
            have hlenpos : 1 ≤ T[p.1].len :=
              hC.len_pos _ (List.getElem_mem hpl)
            obtain ⟨hip, hkp⟩ := memChain_inj' hC hpl (by omega) hi
              (by omega) hd
            subst hip
            omega
    | succ m =>
        have hd' : hsAt T j ++ List.replicate m 1
            = hsAt T i ++ List.replicate k 1 := by
          rw [← dropLast_append_replicate_succ (h := hsAt T j) (r := m), hd]
        obtain ⟨rfl, rfl⟩ := memChain_inj' hC hj (by omega) hi (by omega) hd'
        rfl
  have hlive : (hsAt T i ++ List.replicate (k + 1) 1 ∈ stateOf T)
      ↔ ((hsAt T i ++ List.replicate (k + 1) 1).dropLast ∈ stateOf T) := by
    rw [hdrop, memChain_live_iff hC hi hk1, memChain_live_iff hC hi (by omega)]
  simp only [fusible, Bool.and_eq_true, decide_eq_true_eq, beq_iff_eq]
  refine ⟨⟨⟨⟨hkept, by rw [hdrop]; exact hdkept⟩,
    getLastD_append_replicate_succ⟩, huniq⟩, decide_eq_decide.mpr hlive⟩

/-- Recovered heads are not fusible in the recovered state. -/
theorem head_not_fusible_stateOf {T : Table} (hC : Canonical T) {i : ℕ}
    (hi : i < T.length) : fusible (stateOf T) (hsAt T i) = false := by
  cases hf : fusible (stateOf T) (hsAt T i) with
  | false => rfl
  | true =>
      exfalso
      cases hp : T[i].par with
      | none =>
          have hform := hsAt_none hi hp
          have := fusible_parent_kept hf
          rw [hform] at this
          rw [show ([T[i].delta] : List ℕ).dropLast = [] from rfl] at this
          exact kept_ne_nil this rfl
      | some p =>
          have hpb : p.1 < i := hC.par_back i hi p hp
          have hpl : p.1 < T.length := by omega
          have hform := hsAt_some hi hp hpb
          have hp2 : p.2 = T[p.1].len - 1 := hC.par_tail i hi p hp hpl
          have hlenpos : 1 ≤ T[p.1].len :=
            hC.len_pos _ (List.getElem_mem hpl)
          -- the branch label is 1
          have hdelta : T[i].delta = 1 := by
            have h1 := fusible_concat hf
            have h2 : (hsAt T i).getLastD 0 = T[i].delta := by
              rw [hform, List.getLastD_concat]
            rcases List.eq_nil_or_concat (hsAt T i) with hnil | ⟨q, b, hqb⟩
            · exact absurd hnil (hsAt_ne_nil hC hi)
            · simp only [List.concat_eq_append] at hqb
              rw [hqb, List.getLastD_concat] at h2
              rw [hqb, List.dropLast_concat] at h1
              have := List.append_cancel_left h1
              injection this with hb
              omega
          -- liveness matches across the edge
          have hlive : T[i].live = T[p.1].live := by
            have h1 := fusible_live hf
            have hd : (hsAt T i).dropLast
                = hsAt T p.1 ++ List.replicate p.2 1 := by
              rw [hform, List.dropLast_concat]
            rw [hd] at h1
            have h2 := memChain_live_iff hC hi
              (hC.len_pos _ (List.getElem_mem hi))
            simp only [List.replicate_zero, List.append_nil] at h2
            have h3 := memChain_live_iff hC hpl (by omega : p.2 < T[p.1].len)
            cases hl1 : T[i].live <;> cases hl2 : T[p.1].live
            · rfl
            · exfalso
              have := (h1.mpr (h3.mpr hl2))
              rw [h2, hl1] at this
              exact Bool.noConfusion this
            · exfalso
              have := h1.mp (h2.mpr hl1)
              rw [h3, hl2] at this
              exact Bool.noConfusion this
            · rfl
          -- no_fuse: another sibling attaches at the same tail
          obtain ⟨i', hi', hne, hpar'⟩ :=
            hC.no_fuse i hi p hp hpl hdelta hlive
          have hpb' : p.1 < i' := hC.par_back i' hi' p hpar'
          have hform' := hsAt_some hi' hpar' hpb'
          have hkept' : hsAt T i' ∈ keptL (stateOf T) := by
            refine (kept_stateOf_iff hC).mpr ⟨i', hi', 0, ?_, by simp⟩
            exact hC.len_pos _ (List.getElem_mem hi')
          have hdrop' : (hsAt T i').dropLast = (hsAt T i).dropLast := by
            rw [hform, hform', List.dropLast_concat, List.dropLast_concat]
          have := fusible_unique hf hkept' hdrop'
          exact hne (hsAt_inj hC hi' hi this)

/-- The run-ancestor walk of the recovered state lands on the entry head. -/
theorem headOf_memChain {T : Table} (hC : Canonical T) {i : ℕ}
    (hi : i < T.length) :
    ∀ k, k < T[i].len →
      headOf (stateOf T) (hsAt T i ++ List.replicate k 1) = hsAt T i := by
  intro k
  induction k with
  | zero =>
      intro _
      simp only [List.replicate_zero, List.append_nil]
      exact headOf_of_not_fusible (head_not_fusible_stateOf hC hi)
  | succ k ih =>
      intro hk
      rw [headOf_of_fusible (memChain_fusible hC hi hk),
        dropLast_append_replicate_succ]
      exact ih (by omega)

/-- The recovered state's heads are exactly the recovered entry heads. -/
theorem isHead_stateOf_iff {T : Table} (hC : Canonical T) {c : List ℕ} :
    isHead (stateOf T) c = true
      ↔ ∃ i, ∃ (_ : i < T.length), c = hsAt T i := by
  constructor
  · intro hh
    obtain ⟨i, hi, k, hk, rfl⟩ := (kept_stateOf_iff hC).mp (isHead_kept hh)
    cases k with
    | zero => exact ⟨i, hi, by simp⟩
    | succ k =>
        exfalso
        have := isHead_not_fusible hh
        rw [memChain_fusible hC hi hk] at this
        exact Bool.noConfusion this
  · rintro ⟨i, hi, rfl⟩
    refine isHead_of_kept_not_fusible ?_ (head_not_fusible_stateOf hC hi)
    exact (kept_stateOf_iff hC).mpr ⟨i, hi, 0,
      hC.len_pos _ (List.getElem_mem hi), by simp⟩

/-- The run length of a recovered head is the entry's `len` field. -/
theorem lenOf_stateOf {T : Table} (hC : Canonical T) {i : ℕ}
    (hi : i < T.length) : lenOf (stateOf T) (hsAt T i) = T[i].len := by
  have hperm : (runMembers (stateOf T) (hsAt T i)).Perm
      ((List.range T[i].len).map (fun k => hsAt T i ++ List.replicate k 1)) := by
    refine (List.perm_ext_iff_of_nodup ((nodup_keptL _).filter _) ?_).mpr ?_
    · refine List.Nodup.map_on ?_ List.nodup_range
      intro j₁ _ j₂ _ heq
      exact replicate_offset_inj heq
    intro c
    rw [List.mem_filter, List.mem_map]
    constructor
    · rintro ⟨hkept, hhead⟩
      rw [beq_iff_eq] at hhead
      obtain ⟨j, hj, m, hm, rfl⟩ := (kept_stateOf_iff hC).mp hkept
      rw [headOf_memChain hC hj m hm] at hhead
      obtain rfl := hsAt_inj hC hj hi hhead
      exact ⟨m, List.mem_range.mpr hm, rfl⟩
    · rintro ⟨k, hk, rfl⟩
      rw [List.mem_range] at hk
      exact ⟨(kept_stateOf_iff hC).mpr ⟨i, hi, k, hk, rfl⟩,
        by rw [beq_iff_eq]; exact headOf_memChain hC hi k hk⟩
  have := hperm.length_eq
  rw [lenOf, this]
  simp

/-- Strictly `hLt`-sorted lists with the same members are equal. -/
theorem hLt_sorted_ext : ∀ {l l' : List (List ℕ)},
    l.Pairwise (fun a b => hLt a b = true) →
    l'.Pairwise (fun a b => hLt a b = true) →
    (∀ c, c ∈ l ↔ c ∈ l') → l = l'
  | [], [], _, _, _ => rfl
  | [], y :: ys, _, _, hmem => by
      exact absurd ((hmem y).mpr List.mem_cons_self) (by simp)
  | x :: xs, [], _, _, hmem => by
      exact absurd ((hmem x).mp List.mem_cons_self) (by simp)
  | x :: xs, y :: ys, hs, hs', hmem => by
      rcases List.pairwise_cons.mp hs with ⟨hx, hxs⟩
      rcases List.pairwise_cons.mp hs' with ⟨hy, hys⟩
      have hxy : x = y := by
        rcases List.mem_cons.mp ((hmem x).mp List.mem_cons_self) with h | h
        · exact h
        · rcases List.mem_cons.mp ((hmem y).mpr List.mem_cons_self) with h' | h'
          · exact h'.symm
          · have h1 := hy x h
            have h2 := hx y h'
            rw [hLt_asymm h1] at h2
            exact Bool.noConfusion h2
      subst hxy
      have htails : ∀ z, z ∈ xs ↔ z ∈ ys := by
        intro z
        constructor
        · intro hz
          rcases List.mem_cons.mp ((hmem z).mp (List.mem_cons_of_mem _ hz))
            with rfl | h
          · exact absurd (hx z hz) (by rw [hLt_irrefl]; simp)
          · exact h
        · intro hz
          rcases List.mem_cons.mp ((hmem z).mpr (List.mem_cons_of_mem _ hz))
            with rfl | h
          · exact absurd (hy z hz) (by rw [hLt_irrefl]; simp)
          · exact h
      rw [hLt_sorted_ext hxs hys htails]

/-- The canonical head enumeration of the recovered state IS the table's
recovered head sequence, order included. -/
theorem headsList_stateOf {T : Table} (hC : Canonical T) :
    headsList (stateOf T) = headsOf T := by
  refine hLt_sorted_ext (sorted_headsList _) hC.sorted ?_
  intro c
  rw [mem_headsList, isHead_stateOf_iff hC]
  constructor
  · rintro ⟨i, hi, rfl⟩
    rw [hsAt_eq_getElem hi]
    exact List.getElem_mem _
  · intro hc
    obtain ⟨i, hi, hgi⟩ := List.mem_iff_getElem.mp hc
    have hi' : i < T.length := by rwa [headsOf_length] at hi
    exact ⟨i, hi', by rw [hsAt_eq_getElem hi', hgi]⟩

theorem RTEntry.ext' {e1 e2 : RTEntry} (h1 : e1.par = e2.par)
    (h2 : e1.live = e2.live) (h3 : e1.delta = e2.delta)
    (h4 : e1.len = e2.len) : e1 = e2 := by
  cases e1; cases e2; simp_all

/-- **T-repr, canonicity direction (`tableOf ∘ stateOf = id`)**: a canonical
table, maximal fusible chains (`no_fuse`), tail attachment (`par_tail`),
kept leaves live, canonical order, is recovered *exactly*, field for field,
from the state it denotes. Together with `stateOf_tableOf` this is the
representation iso of the note §10, over labels and liveness. Without
`no_fuse` the theorem is false: a run split in two re-canonicalizes to ONE
entry (directed case D4, the drift the coalesce rule exists to prevent);
the SPOT pins that concretely. -/
theorem tableOf_stateOf {T : Table} (hC : Canonical T) :
    tableOf (stateOf T) = T := by
  rw [tableOf, headsList_stateOf hC]
  refine List.ext_getElem (by simp [headsOf_length]) ?_
  intro i hi1 hi2
  rw [List.getElem_map]
  have hi : i < T.length := hi2
  have hgi : (headsOf T)[i]'(by rw [headsOf_length]; exact hi) = hsAt T i :=
    (hsAt_eq_getElem hi).symm
  rw [hgi]
  have hlen0 : 0 < T[i].len := hC.len_pos _ (List.getElem_mem hi)
  refine RTEntry.ext' ?_ ?_ ?_ ?_
  · -- par
    show (if (hsAt T i).dropLast ∈ keptL (stateOf T)
      then some ((headsList (stateOf T)).idxOf
                   (headOf (stateOf T) (hsAt T i).dropLast),
                 (hsAt T i).dropLast.length
                   - (headOf (stateOf T) (hsAt T i).dropLast).length)
      else none) = T[i].par
    cases hp : T[i].par with
    | none =>
        rw [if_neg]
        rw [hsAt_none hi hp]
        intro hmem
        exact kept_ne_nil hmem rfl
    | some p =>
        obtain ⟨p1, p2⟩ := p
        have hpb : p1 < i := hC.par_back i hi (p1, p2) hp
        have hpl : p1 < T.length := by omega
        have hp2 : p2 = T[p1].len - 1 := hC.par_tail i hi (p1, p2) hp hpl
        have hlenpos : 1 ≤ T[p1].len := hC.len_pos _ (List.getElem_mem hpl)
        have hdrop : (hsAt T i).dropLast
            = hsAt T p1 ++ List.replicate p2 1 := by
          rw [hsAt_some hi hp hpb, List.dropLast_concat]
        have hkept : (hsAt T i).dropLast ∈ keptL (stateOf T) := by
          rw [hdrop]
          exact (kept_stateOf_iff hC).mpr ⟨p1, hpl, p2, by omega, rfl⟩
        rw [if_pos hkept]
        have hhead : headOf (stateOf T) (hsAt T i).dropLast = hsAt T p1 := by
          rw [hdrop]
          exact headOf_memChain hC hpl p2 (by omega)
        rw [hhead]
        have hidx : (headsList (stateOf T)).idxOf (hsAt T p1) = p1 := by
          rw [headsList_stateOf hC, hsAt_eq_getElem hpl]
          exact idxOf_getElem_nodup (headsOf_nodup hC)
            (by rw [headsOf_length]; exact hpl)
        rw [hidx, hdrop]
        simp
  · -- live
    have hiff := memChain_live_iff hC hi hlen0
    simp only [List.replicate_zero, List.append_nil] at hiff
    show decide (hsAt T i ∈ stateOf T) = T[i].live
    cases hl : T[i].live with
    | true => exact decide_eq_true (hiff.mpr hl)
    | false =>
        apply decide_eq_false
        intro hmem
        have := hiff.mp hmem
        rw [hl] at this
        exact Bool.noConfusion this
  · -- delta
    show (hsAt T i).getLastD 0 = T[i].delta
    cases hp : T[i].par with
    | none => rw [hsAt_none hi hp]; rfl
    | some p =>
        rw [hsAt_some hi hp (hC.par_back i hi p hp), List.getLastD_concat]
  · -- len
    exact lenOf_stateOf hC hi

/-! ## §5  T-cmp: the two-case contracted comparator

The Python `make_cmp`, one-sided: walk the two entry chains to the first
difference. Same entry: offset order. One chain a prefix of the other:
ancestor entry first (sound because, by **T-tail**, the descendant exits the
ancestor's run at its tail, above every member, case A). Two branch entries
at one divergence node: larger label first (case B; the divergence node's
children are distinct kept children, so *neither* branch edge is fusible and
both branch heads sit in the chains, the two-case structure is total). The
`(ts, agent)` tie oracle of the Python rides in the labels: at kernel level
distinct siblings have distinct labels, exactly as the chain comparator
`chainBefore` consumes them. -/

theorem prefixesOf_concat (p : List ℕ) (b : ℕ) :
    prefixesOf (p ++ [b]) = prefixesOf p ++ [p ++ [b]] := by
  rw [prefixesOf, prefixesOf]
  rw [show (p ++ [b]).length = p.length + 1 by simp, List.range_succ,
    List.map_append]
  congr 1
  · apply List.map_congr_left
    intro k hk
    rw [List.mem_range] at hk
    rw [List.take_append_of_le_length (by omega)]
  · simp only [List.map_cons, List.map_nil]
    rw [show List.take (p.length + 1) (p ++ [b]) = p ++ [b] from
      List.take_of_length_le (by simp)]

theorem prefixesOf_prefix {x y : List ℕ} (hp : x <+: y) :
    prefixesOf x <+: prefixesOf y := by
  obtain ⟨ext, rfl⟩ := hp
  induction ext using List.reverseRecOn with
  | nil => simp
  | append_singleton ext b ih =>
      rw [← List.append_assoc, prefixesOf_concat]
      exact ih.trans (List.prefix_append _ _)

/-- The entry chain: run heads from the root entry to `c`'s entry. -/
def entryChainOf (L : List (List ℕ)) (c : List ℕ) : List (List ℕ) :=
  if h' : (headOf L c).length ≤ 1 then [headOf L c]
  else entryChainOf L (headOf L c).dropLast ++ [headOf L c]
  termination_by c.length
  decreasing_by
    have h1 := (headOf_prefix L c).length_le
    simp only [List.length_dropLast]
    omega

theorem entryChainOf_short {L : List (List ℕ)} {c : List ℕ}
    (h : (headOf L c).length ≤ 1) : entryChainOf L c = [headOf L c] := by
  rw [entryChainOf, dif_pos h]

theorem entryChainOf_long {L : List (List ℕ)} {c : List ℕ}
    (h : ¬ (headOf L c).length ≤ 1) :
    entryChainOf L c
      = entryChainOf L (headOf L c).dropLast ++ [headOf L c] := by
  rw [entryChainOf, dif_neg (by simpa using h)]

theorem isHead_eq_false_of_fusible {L : List (List ℕ)} {c : List ℕ}
    (h : fusible L c = true) : isHead L c = false := by
  simp [isHead, h]

/-- Non-head run members contribute nothing to the head-filtered prefixes. -/
theorem filter_prefixes_run {L : List (List ℕ)} {h : List ℕ} :
    ∀ k, h ++ List.replicate k 1 ∈ keptL L →
      headOf L (h ++ List.replicate k 1) = h →
      (prefixesOf (h ++ List.replicate k 1)).filter (fun p => isHead L p)
        = (prefixesOf h).filter (fun p => isHead L p)
  | 0, _, _ => by simp
  | k + 1, hkept, hhead => by
      have hform : h ++ List.replicate (k + 1) 1
          = (h ++ List.replicate k 1) ++ [1] := by
        rw [List.replicate_succ', List.append_assoc]
      have hfus : fusible L (h ++ List.replicate (k + 1) 1) = true := by
        cases hf : fusible L (h ++ List.replicate (k + 1) 1) with
        | true => rfl
        | false =>
            exfalso
            have := headOf_of_not_fusible hf
            rw [hhead] at this
            have := congrArg List.length this
            simp at this
      have hkept' : h ++ List.replicate k 1 ∈ keptL L := by
        refine kept_of_prefix hkept ?_ ?_
        · rw [hform]; exact List.prefix_append _ _
        · intro hnil
          have hh : h ∈ keptL L := hhead ▸ headOf_kept hkept
          cases h with
          | nil => exact kept_ne_nil hh rfl
          | cons a as => simp at hnil
      have hhead' : headOf L (h ++ List.replicate k 1) = h := by
        refine headOf_within hhead (List.prefix_append _ _) ?_
        rw [hform]; exact List.prefix_append _ _
      rw [hform, prefixesOf_concat, List.filter_append]
      rw [show ((h ++ List.replicate k 1) ++ [1] : List ℕ)
        = h ++ List.replicate (k + 1) 1 from hform.symm]
      rw [show (([h ++ List.replicate (k + 1) 1] : List (List ℕ)).filter
          (fun p => isHead L p)) = [] from by
        simp [List.filter, isHead_eq_false_of_fusible hfus]]
      rw [List.append_nil]
      exact filter_prefixes_run k hkept' hhead'

/-- **Entry-chain characterization**: the entry chain is exactly the list of
head prefixes of `c`, short to long. -/
theorem entryChainOf_eq_filter {L : List (List ℕ)} :
    ∀ n (c : List ℕ), c.length ≤ n → c ∈ keptL L →
    entryChainOf L c = (prefixesOf c).filter (fun p => isHead L p) := by
  intro n
  induction n with
  | zero =>
      intro c hc hkept
      exact absurd (List.length_pos_iff.mpr (kept_ne_nil hkept)) (by omega)
  | succ n ih =>
      intro c hc hkept
      have hh : isHead L (headOf L c) = true := headOf_isHead hkept
      have hhkept : headOf L c ∈ keptL L := headOf_kept hkept
      -- collapse the run suffix
      obtain ⟨k, hform⟩ := headOf_replicate L c
      have hrun : (prefixesOf c).filter (fun p => isHead L p)
          = (prefixesOf (headOf L c)).filter (fun p => isHead L p) := by
        conv_lhs => rw [hform]
        exact filter_prefixes_run k (hform ▸ hkept) (hform ▸ rfl)
      rw [hrun]
      by_cases hlen : (headOf L c).length ≤ 1
      · rw [entryChainOf_short hlen]
        obtain ⟨d, hd⟩ : ∃ d, headOf L c = [d] := by
          cases hhc : headOf L c with
          | nil => exact absurd hhc (kept_ne_nil hhkept)
          | cons a as =>
              rw [hhc] at hlen
              simp at hlen
              rw [hlen]
              exact ⟨a, rfl⟩
        rw [hd]
        rw [show prefixesOf [d] = [[d]] from rfl]
        rw [List.filter_cons]
        rw [hd] at hh
        simp [hh]
      · rw [entryChainOf_long hlen]
        obtain ⟨q, b, hqb⟩ : ∃ q b, headOf L c = q ++ [b] := by
          rcases List.eq_nil_or_concat (headOf L c) with hnil | ⟨q, b, hqb⟩
          · exact absurd hnil (kept_ne_nil hhkept)
          · exact ⟨q, b, by simpa using hqb⟩
        have hqkept : (headOf L c).dropLast ∈ keptL L := by
          refine kept_of_prefix hhkept (List.dropLast_prefix _) ?_
          rw [hqb, List.dropLast_concat]
          intro hnil
          rw [hnil] at hqb
          rw [hqb] at hlen
          simp at hlen
        have hqlen : (headOf L c).dropLast.length ≤ n := by
          have h1 := (headOf_prefix L c).length_le
          simp only [List.length_dropLast]
          omega
        rw [ih _ hqlen hqkept]
        rw [hqb, List.dropLast_concat, prefixesOf_concat, List.filter_append]
        congr 1
        have hhb : isHead L (q ++ [b]) = true := hqb ▸ hh
        simp [List.filter, hhb]

/-- First-difference walk over two entry chains, with same-entry offsets. -/
def cmpEC : List (List ℕ) → ℕ → List (List ℕ) → ℕ → Bool
  | [], jx, [], jy => decide (jx < jy)
  | [], _, _ :: _, _ => true
  | _ :: _, _, [], _ => false
  | gx :: tx, jx, gy :: ty, jy =>
      if gx = gy then cmpEC tx jx ty jy
      else decide (gy.getLastD 0 < gx.getLastD 0)

/-- The table comparator: consults entry chains and header data only. -/
def cmpTable (L : List (List ℕ)) (x y : List ℕ) : Bool :=
  cmpEC (entryChainOf L x) (x.length - (headOf L x).length)
        (entryChainOf L y) (y.length - (headOf L y).length)

theorem cmpEC_consume (w a : List (List ℕ)) (jx : ℕ)
    (b : List (List ℕ)) (jy : ℕ) :
    cmpEC (w ++ a) jx (w ++ b) jy = cmpEC a jx b jy := by
  induction w with
  | nil => rfl
  | cons g w ih => simpa [cmpEC] using ih

theorem entryChainOf_concat (L : List (List ℕ)) (c : List ℕ) :
    ∃ w, entryChainOf L c = w ++ [headOf L c] := by
  by_cases h : (headOf L c).length ≤ 1
  · exact ⟨[], by rw [entryChainOf_short h]; rfl⟩
  · exact ⟨_, entryChainOf_long h⟩

theorem posChain_of_kept {L : List (List ℕ)}
    (hpos : ∀ l ∈ L, PosChain l) {c : List ℕ} (hc : c ∈ keptL L) :
    PosChain c := by
  obtain ⟨-, l, hl, hpre⟩ := mem_keptL.mp hc
  intro d hd
  exact hpos l hl d (hpre.subset hd)

/-- Case A soundness: an ancestor's entry chain is a prefix of the
descendant's, and comparing there is offset order or ancestor-first. -/
theorem cmpTable_prefix {L : List (List ℕ)} {x y : List ℕ}
    (hx : x ∈ keptL L) (hy : y ∈ keptL L) (hp : x <+: y) (hne : x ≠ y) :
    cmpTable L x y = true ∧ cmpTable L y x = false := by
  have hECp : entryChainOf L x <+: entryChainOf L y := by
    rw [entryChainOf_eq_filter x.length x (le_refl _) hx,
        entryChainOf_eq_filter y.length y (le_refl _) hy]
    exact (prefixesOf_prefix hp).filter _
  obtain ⟨rest, hrest⟩ := hECp
  cases rest with
  | nil =>
      -- same entry: offset order decides
      rw [List.append_nil] at hrest
      have hheads : headOf L x = headOf L y := by
        obtain ⟨wx, hwx⟩ := entryChainOf_concat L x
        obtain ⟨wy, hwy⟩ := entryChainOf_concat L y
        have h1 : wx ++ [headOf L x] = wy ++ [headOf L y] := by
          rw [← hwx, ← hwy, hrest]
        have h2 := congrArg List.getLast? h1
        rw [List.getLast?_concat, List.getLast?_concat] at h2
        injection h2
      have hxlen : x.length < y.length :=
        lt_of_le_of_ne hp.length_le (fun h => hne (hp.eq_of_length h))
      have hhx := (headOf_prefix L x).length_le
      have hjlt : x.length - (headOf L x).length
          < y.length - (headOf L y).length := by
        rw [← hheads]
        have := (headOf_prefix L x).length_le
        omega
      constructor
      · rw [cmpTable, hrest, hheads]
        rw [show cmpEC (entryChainOf L y) (x.length - (headOf L y).length)
            (entryChainOf L y) (y.length - (headOf L y).length)
            = cmpEC [] (x.length - (headOf L y).length) []
                (y.length - (headOf L y).length) from by
          rw [← List.append_nil (entryChainOf L y)]
          exact cmpEC_consume _ _ _ _ _]
        rw [← hheads] at *
        simp [cmpEC]
        omega
      · rw [cmpTable, hrest, hheads]
        rw [show cmpEC (entryChainOf L y) (y.length - (headOf L y).length)
            (entryChainOf L y) (x.length - (headOf L y).length)
            = cmpEC [] (y.length - (headOf L y).length) []
                (x.length - (headOf L y).length) from by
          rw [← List.append_nil (entryChainOf L y)]
          exact cmpEC_consume _ _ _ _ _]
        rw [← hheads] at *
        simp [cmpEC]
        omega
  | cons r rs =>
      -- ancestor entry: x's chain is a strict prefix
      constructor
      · rw [cmpTable, ← hrest]
        have h := cmpEC_consume (entryChainOf L x) []
          (x.length - (headOf L x).length) (r :: rs)
          (y.length - (headOf L y).length)
        rw [List.append_nil] at h
        rw [h]
        rfl
      · rw [cmpTable, ← hrest]
        have h := cmpEC_consume (entryChainOf L x) (r :: rs)
          (y.length - (headOf L y).length) []
          (x.length - (headOf L x).length)
        rw [List.append_nil] at h
        rw [h]
        rfl

/-- Case B soundness: at a genuine divergence both branch heads are heads
(two kept children of one node cannot fuse), and the larger label wins. -/
theorem cmpTable_diverge {L : List (List ℕ)} {p : List ℕ} {dx dy : ℕ}
    {x y : List ℕ} (hx : x ∈ keptL L) (hy : y ∈ keptL L)
    (hpx : p ++ [dx] <+: x) (hpy : p ++ [dy] <+: y) (hne : dx ≠ dy) :
    cmpTable L x y = decide (dy < dx)
      ∧ cmpTable L y x = decide (dx < dy) := by
  have hqx : p ++ [dx] ∈ keptL L := kept_of_prefix hx hpx (by simp)
  have hqy : p ++ [dy] ∈ keptL L := kept_of_prefix hy hpy (by simp)
  have hqne : (p ++ [dx] : List ℕ) ≠ p ++ [dy] := by
    intro h
    have := List.append_cancel_left h
    injection this with h'
    exact hne h'
  have hhx : isHead L (p ++ [dx]) = true := by
    refine isHead_of_kept_not_fusible hqx ?_
    cases hf : fusible L (p ++ [dx]) with
    | false => rfl
    | true =>
        exfalso
        exact hqne ((fusible_unique hf hqy
          (by rw [List.dropLast_concat, List.dropLast_concat])).symm)
  have hhy : isHead L (p ++ [dy]) = true := by
    refine isHead_of_kept_not_fusible hqy ?_
    cases hf : fusible L (p ++ [dy]) with
    | false => rfl
    | true =>
        exfalso
        exact hqne (fusible_unique hf hqx
          (by rw [List.dropLast_concat, List.dropLast_concat]))
  -- entry chains decompose at the divergence
  have hdec : ∀ (z : List ℕ) (d : ℕ), z ∈ keptL L → p ++ [d] <+: z →
      isHead L (p ++ [d]) = true →
      ∃ rz, entryChainOf L z
        = (prefixesOf p).filter (fun q => isHead L q) ++ (p ++ [d]) :: rz := by
    intro z d hz hpz hhd
    have h1 : entryChainOf L (p ++ [d]) <+: entryChainOf L z := by
      rw [entryChainOf_eq_filter (p ++ [d]).length _ (le_refl _)
          (kept_of_prefix hz hpz (by simp)),
        entryChainOf_eq_filter z.length z (le_refl _) hz]
      exact (prefixesOf_prefix hpz).filter _
    have h2 : entryChainOf L (p ++ [d])
        = (prefixesOf p).filter (fun q => isHead L q) ++ [p ++ [d]] := by
      rw [entryChainOf_eq_filter (p ++ [d]).length _ (le_refl _)
          (kept_of_prefix hz hpz (by simp)),
        prefixesOf_concat, List.filter_append]
      congr 1
      simp [List.filter, hhd]
    obtain ⟨rz, hrz⟩ := h1
    exact ⟨rz, by rw [← hrz, h2, List.append_assoc]; rfl⟩
  obtain ⟨rx, hrx⟩ := hdec x dx hx hpx hhx
  obtain ⟨ry, hry⟩ := hdec y dy hy hpy hhy
  constructor
  · rw [cmpTable, hrx, hry, cmpEC_consume]
    simp only [cmpEC, if_neg hqne]
    rw [List.getLastD_concat, List.getLastD_concat]
  · rw [cmpTable, hrx, hry, cmpEC_consume]
    simp only [cmpEC, if_neg (Ne.symm hqne)]
    rw [List.getLastD_concat, List.getLastD_concat]

/-- Both `chainBefore` constructors, computed by the table comparator. -/
theorem cmpTable_of_chainBefore {L : List (List ℕ)} {x y : List ℕ}
    (hx : x ∈ keptL L) (hy : y ∈ keptL L) (hb : chainBefore x y) :
    cmpTable L x y = true ∧ cmpTable L y x = false := by
  cases hb with
  | ancestor ch ext hne' =>
      refine cmpTable_prefix hx hy (List.prefix_append _ _) ?_
      intro heq
      have := congrArg List.length heq
      simp at this
      exact hne' this
  | newer p d e ch1 ch2 hlt =>
      have hpx' : p ++ [d] <+: p ++ d :: ch1 :=
        ⟨ch1, by rw [List.append_assoc]; rfl⟩
      have hpy' : p ++ [e] <+: p ++ e :: ch2 :=
        ⟨ch2, by rw [List.append_assoc]; rfl⟩
      have hd := cmpTable_diverge (dx := d) (dy := e) hx hy hpx' hpy'
        (by omega)
      rw [hd.1, hd.2]
      constructor
      · simpa using hlt
      · simp
        omega

/-- **T-cmp, chain form**: the two-case contracted comparator IS the chain
display order. -/
theorem cmpTable_iff_chainBefore {L : List (List ℕ)} {x y : List ℕ}
    (hx : x ∈ keptL L) (hy : y ∈ keptL L) (hne : x ≠ y) :
    (cmpTable L x y = true ↔ chainBefore x y) := by
  constructor
  · intro hcmp
    rcases Sal.EmbedRGA.chainBefore_total hne with hb | hb
    · exact hb
    · rw [(cmpTable_of_chainBefore hy hx hb).2] at hcmp
      exact Bool.noConfusion hcmp
  · exact fun hb => (cmpTable_of_chainBefore hx hy hb).1

/-- **T-cmp**: the comparator over the contracted run tree equals the fold's
key order `keyLt` on the immutable coordinates, parametric in the ordered
prefix code, with the label order standing where the Python's `(ts, agent)`
tie oracle rides (neither representation encodes it; the labels carry it on
both sides identically). -/
theorem cmpTable_eq_keyLt (Γ : OrderedPrefixCode) {L : List (List ℕ)}
    (hpos : ∀ l ∈ L, PosChain l) {x y : List ℕ}
    (hx : x ∈ keptL L) (hy : y ∈ keptL L) (hne : x ≠ y) :
    cmpTable L x y = keyLt (key (coordOf Γ y)) (key (coordOf Γ x)) := by
  have hpx : PosChain x := posChain_of_kept hpos hx
  have hpy : PosChain y := posChain_of_kept hpos hy
  cases hcmp : cmpTable L x y with
  | true =>
      exact ((Sal.EmbedRGA.display_iff_chainBefore Γ hpx hpy hne).mpr
        ((cmpTable_iff_chainBefore hx hy hne).mp hcmp)).symm
  | false =>
      have hnb : ¬ chainBefore x y := fun hb => by
        rw [(cmpTable_of_chainBefore hx hy hb).1] at hcmp
        exact Bool.noConfusion hcmp
      rcases Sal.EmbedRGA.chainBefore_total hne with hb | hb
      · exact absurd hb hnb
      · have := (Sal.EmbedRGA.display_iff_chainBefore Γ hpy hpx
          (Ne.symm hne)).mpr hb
        rw [Sal.EmbedRGA.keyLt_asymm this]

/-! ## §6  T-walk: the structural walk is the display

One-sided walk (Python `table_walk`): an entry emits its live members in
offset order, then its attachment subtrees at the tail, newest (largest
label) first. The partition argument, everything below a run either sits in
the run or exits at its *tail*, is T-tail again. -/

theorem le_foldr_max : ∀ (l : List ℕ) (x : ℕ), x ∈ l → x ≤ l.foldr max 0
  | [], x, hx => absurd hx (List.not_mem_nil)
  | y :: ys, x, hx => by
      rcases List.mem_cons.mp hx with rfl | hx'
      · exact Nat.le_max_left _ _
      · exact le_trans (le_foldr_max ys x hx') (Nat.le_max_right _ _)

def maxLen (L : List (List ℕ)) : ℕ := ((keptL L).map List.length).foldr max 0

theorem length_le_maxLen {L : List (List ℕ)} {c : List ℕ}
    (hc : c ∈ keptL L) : c.length ≤ maxLen L :=
  le_foldr_max _ _ (List.mem_map.mpr ⟨c, hc, rfl⟩)

/-- The child entries attached at node `m`, newest label first. -/
def childHeads (L : List (List ℕ)) (m : List ℕ) : List (List ℕ) :=
  ((keptL L).filter (fun c => isHead L c && (c.dropLast == m))).mergeSort
    (fun a b => decide (b.getLastD 0 ≤ a.getLastD 0))

theorem mem_childHeads {L : List (List ℕ)} {m c : List ℕ} :
    c ∈ childHeads L m ↔ isHead L c = true ∧ c.dropLast = m := by
  rw [childHeads, List.mem_mergeSort, List.mem_filter]
  constructor
  · rintro ⟨-, h⟩
    simp only [Bool.and_eq_true, beq_iff_eq] at h
    exact h
  · rintro ⟨h1, h2⟩
    exact ⟨isHead_kept h1, by simp [h1, h2]⟩

theorem nodup_childHeads (L : List (List ℕ)) (m : List ℕ) :
    (childHeads L m).Nodup :=
  (List.mergeSort_perm _ _).nodup_iff.mpr ((nodup_keptL L).filter _)

theorem sorted_childHeads (L : List (List ℕ)) (m : List ℕ) :
    (childHeads L m).Pairwise
      (fun a b => b.getLastD 0 ≤ a.getLastD 0) := by
  have h := List.pairwise_mergeSort
    (le := fun a b : List ℕ => decide (b.getLastD 0 ≤ a.getLastD 0))
    (fun a b c h1 h2 => by
      rw [decide_eq_true_eq] at h1 h2 ⊢
      omega)
    (fun a b => by
      simp only [Bool.or_eq_true, decide_eq_true_eq]
      exact Nat.le_total (b.getLastD 0) (a.getLastD 0))
    ((keptL L).filter (fun c => isHead L c && (c.dropLast == m)))
  exact h.imp (fun hab => by
    simp only [decide_eq_true_eq] at hab
    exact hab)

/-- The walk below one entry. -/
def walkE (L : List (List ℕ)) : ℕ → List ℕ → List (List ℕ)
  | 0, _ => []
  | fuel + 1, h =>
      (if h ∈ L then (List.range (lenOf L h)).map
          (fun k => h ++ List.replicate k 1) else [])
      ++ (childHeads L (tailOf L h)).flatMap (walkE L fuel)

/-- The walk of the whole table. -/
def walk (L : List (List ℕ)) : List (List ℕ) :=
  (childHeads L []).flatMap (walkE L (maxLen L + 1))

/-- Next node on the path towards a strict extension. -/
theorem take_succ_of_prefix {m c : List ℕ} (h : m <+: c) (hne : m ≠ c) :
    ∃ d, m ++ [d] <+: c := by
  have hlt : m.length < c.length :=
    lt_of_le_of_ne h.length_le (fun hl => hne (h.eq_of_length hl))
  refine ⟨c[m.length], ?_⟩
  have h1 : c.take (m.length + 1) = c.take m.length ++ [c[m.length]] := by
    rw [List.take_succ, List.getElem?_eq_getElem hlt]
    rfl
  rw [← (List.prefix_iff_eq_take.mp h), ← h1] at *
  exact List.take_prefix _ _

/-- **The escape lemma** (T-tail in walk clothing): a kept chain below a head
that is not one of its run members exits the run at the tail, through a
child head. -/
theorem escape_run {L : List (List ℕ)} {h c : List ℕ}
    (hh : isHead L h = true) (hc : c ∈ keptL L) (hpre : h <+: c)
    (hnm : headOf L c ≠ h) :
    ∃ q, isHead L q = true ∧ q.dropLast = tailOf L h ∧ q <+: c := by
  -- climb the run: every member up to the tail is a prefix of c
  have hclimb : ∀ j, j ≤ lenOf L h - 1 → h ++ List.replicate j 1 <+: c := by
    intro j
    induction j with
    | zero => intro _; simpa using hpre
    | succ j ih =>
        intro hj
        have hmj : h ++ List.replicate j 1 <+: c := ih (by omega)
        have hne : h ++ List.replicate j 1 ≠ c := by
          intro heq
          apply hnm
          rw [← heq]
          exact (mem_runMembers.mp (runMember_of_lt hh (by
            have := lenOf_pos hh
            omega : j < lenOf L h))).2
        obtain ⟨d, hd⟩ := take_succ_of_prefix hmj hne
        have hdkept : (h ++ List.replicate j 1) ++ [d] ∈ keptL L :=
          kept_of_prefix hc hd (by simp)
        have hfus : fusible L (h ++ List.replicate (j + 1) 1) = true :=
          runMember_fusible (runMember_of_lt hh (by omega : j + 1 < lenOf L h))
        have huniq := fusible_unique hfus hdkept
          (by rw [List.dropLast_concat, dropLast_append_replicate_succ])
        rw [← huniq]
        exact hd
  have htail : tailOf L h <+: c := hclimb (lenOf L h - 1) (le_refl _)
  have htne : tailOf L h ≠ c := by
    intro heq
    apply hnm
    rw [← heq]
    exact (mem_runMembers.mp (tailOf_mem hh)).2
  obtain ⟨d, hd⟩ := take_succ_of_prefix htail htne
  have hdkept : tailOf L h ++ [d] ∈ keptL L :=
    kept_of_prefix hc hd (by simp)
  refine ⟨tailOf L h ++ [d], ?_, List.dropLast_concat, hd⟩
  refine isHead_of_kept_not_fusible hdkept ?_
  by_cases hd1 : d = 1
  · subst hd1
    exact tail_succ_not_fusible hh
  · cases hf : fusible L (tailOf L h ++ [d]) with
    | false => rfl
    | true =>
        exfalso
        have := fusible_concat hf
        rw [List.dropLast_concat] at this
        have := List.append_cancel_left this
        injection this with h'
        exact hd1 h'

/-- Walk soundness: everything emitted is live and sits below the entry. -/
theorem walkE_sound {L : List (List ℕ)} :
    ∀ fuel (h c : List ℕ), isHead L h = true → c ∈ walkE L fuel h →
      c ∈ L ∧ h <+: c := by
  intro fuel
  induction fuel with
  | zero => intro h c _ hc; simp [walkE] at hc
  | succ fuel ih =>
      intro h c hh hc
      rw [walkE, List.mem_append] at hc
      rcases hc with hc | hc
      · by_cases hl : h ∈ L
        · rw [if_pos hl] at hc
          obtain ⟨k, hk, rfl⟩ := List.mem_map.mp hc
          rw [List.mem_range] at hk
          exact ⟨(run_liveness_uniform (runMember_of_lt hh hk)).mpr hl,
            List.prefix_append _ _⟩
        · rw [if_neg hl] at hc
          simp at hc
      · obtain ⟨q, hq, hcq⟩ := List.mem_flatMap.mp hc
        obtain ⟨hqh, hqd⟩ := mem_childHeads.mp hq
        obtain ⟨hcl, hqc⟩ := ih q c hqh hcq
        refine ⟨hcl, ?_⟩
        have h1 : h <+: tailOf L h := List.prefix_append _ _
        have h2 : tailOf L h <+: q := by
          rw [← hqd]
          exact List.dropLast_prefix q
        exact (h1.trans h2).trans hqc

/-- Walk completeness: with enough fuel, every live chain below the entry is
emitted. -/
theorem walkE_complete {L : List (List ℕ)} :
    ∀ fuel (h c : List ℕ), isHead L h = true → c ∈ L → c ∈ keptL L →
      h <+: c → maxLen L + 1 - h.length ≤ fuel →
      c ∈ walkE L fuel h := by
  intro fuel
  induction fuel with
  | zero =>
      intro h c hh _ hc hpre hfuel
      have h1 := (hpre.trans (List.prefix_refl c)).length_le
      have h2 := length_le_maxLen hc
      have h3 := length_le_maxLen (isHead_kept hh)
      omega
  | succ fuel ih =>
      intro h c hh hcl hc hpre hfuel
      rw [walkE, List.mem_append]
      by_cases hm : headOf L c = h
      · left
        have hmem : c ∈ runMembers L h := mem_runMembers.mpr ⟨hc, hm⟩
        have hl : h ∈ L := (run_liveness_uniform hmem).mp hcl
        rw [if_pos hl]
        refine List.mem_map.mpr ⟨c.length - h.length, ?_, ?_⟩
        · exact List.mem_range.mpr
            (runMember_offset_lt ((runMember_form hmem) ▸ hmem))
        · exact (runMember_form hmem).symm
      · right
        obtain ⟨q, hqh, hqd, hqc⟩ := escape_run hh hc hpre hm
        refine List.mem_flatMap.mpr ⟨q, mem_childHeads.mpr ⟨hqh, hqd⟩, ?_⟩
        refine ih q c hqh hcl hc hqc ?_
        have h1 : q.length - 1 = (tailOf L h).length := by
          rw [← hqd, List.length_dropLast]
        have h2 : (tailOf L h).length = h.length + (lenOf L h - 1) := by
          rw [tailOf]; simp
        have h3 : 1 ≤ q.length :=
          List.length_pos_iff.mpr (kept_ne_nil (isHead_kept hqh))
        have h4 := lenOf_pos hh
        omega

theorem pairwise_flatMap {α β : Type} {R : β → β → Prop} {l : List α}
    {f : α → List β} (hblock : ∀ a ∈ l, (f a).Pairwise R)
    (hcross : l.Pairwise (fun a a' => ∀ b ∈ f a, ∀ b' ∈ f a', R b b')) :
    (l.flatMap f).Pairwise R := by
  induction l with
  | nil => simp
  | cons a l ih =>
      rw [List.flatMap_cons, List.pairwise_append]
      obtain ⟨hca, hcl⟩ := List.pairwise_cons.mp hcross
      refine ⟨hblock a List.mem_cons_self,
        ih (fun a' ha' => hblock a' (List.mem_cons_of_mem _ ha')) hcl, ?_⟩
      intro b hb b' hb'
      obtain ⟨a', ha', hba'⟩ := List.mem_flatMap.mp hb'
      exact hca a' ha' b hb b' hba'

theorem prefix_eq_of_length {p1 p2 c : List ℕ} (h1 : p1 <+: c)
    (h2 : p2 <+: c) (hl : p1.length = p2.length) : p1 = p2 :=
  (List.prefix_of_prefix_length_le h1 h2 (le_of_eq hl)).eq_of_length hl

theorem concat_getLastD {c : List ℕ} (h : c ≠ []) :
    c = c.dropLast ++ [c.getLastD 0] := by
  rcases List.eq_nil_or_concat c with rfl | ⟨q, b, rfl⟩
  · exact absurd rfl h
  · simp only [List.concat_eq_append]
    rw [List.dropLast_concat, List.getLastD_concat]

/-- Child heads' subtree chains: shape at the divergence. -/
theorem childHead_subtree_form {L : List (List ℕ)} {m q c : List ℕ}
    (hq : q ∈ childHeads L m) (hc : q <+: c) :
    ∃ rest, c = m ++ q.getLastD 0 :: rest := by
  obtain ⟨hqh, hqd⟩ := mem_childHeads.mp hq
  have hqne : q ≠ [] := kept_ne_nil (isHead_kept hqh)
  obtain ⟨ext, rfl⟩ := hc
  refine ⟨ext, ?_⟩
  conv_lhs => rw [concat_getLastD hqne, hqd]
  rw [List.append_assoc]
  rfl

theorem walkE_nodup {L : List (List ℕ)} :
    ∀ fuel (h : List ℕ), isHead L h = true → (walkE L fuel h).Nodup := by
  intro fuel
  induction fuel with
  | zero => intro h _; simp [walkE]
  | succ fuel ih =>
      intro h hh
      rw [walkE, List.nodup_append]
      refine ⟨?_, ?_, ?_⟩
      · by_cases hl : h ∈ L
        · rw [if_pos hl]
          refine List.Nodup.map_on ?_ List.nodup_range
          intro j₁ _ j₂ _ heq
          exact replicate_offset_inj heq
        · rw [if_neg hl]; exact List.nodup_nil
      · refine nodup_flatMap_of_disjoint (nodup_childHeads L _) ?_ ?_
        · intro q hq
          exact ih q (mem_childHeads.mp hq).1
        · intro q hq q' hq' hne c hc hc'
          have h1 := (walkE_sound fuel q c (mem_childHeads.mp hq).1 hc).2
          have h2 := (walkE_sound fuel q' c (mem_childHeads.mp hq').1 hc').2
          apply hne
          refine prefix_eq_of_length h1 h2 ?_
          have e1 : q.dropLast = tailOf L h := (mem_childHeads.mp hq).2
          have e2 : q'.dropLast = tailOf L h := (mem_childHeads.mp hq').2
          have l1 := congrArg List.length e1
          have l2 := congrArg List.length e2
          rw [List.length_dropLast] at l1 l2
          have n1 : 1 ≤ q.length := List.length_pos_iff.mpr
            (kept_ne_nil (isHead_kept (mem_childHeads.mp hq).1))
          have n2 : 1 ≤ q'.length := List.length_pos_iff.mpr
            (kept_ne_nil (isHead_kept (mem_childHeads.mp hq').1))
          omega
      · intro a ha b hb heq
        subst heq
        by_cases hl : h ∈ L
        · rw [if_pos hl] at ha
          obtain ⟨k, hk, rfl⟩ := List.mem_map.mp ha
          rw [List.mem_range] at hk
          obtain ⟨q, hq, hcq⟩ := List.mem_flatMap.mp hb
          have h1 := (walkE_sound fuel q _ (mem_childHeads.mp hq).1 hcq).2
          have e1 : q.dropLast = tailOf L h := (mem_childHeads.mp hq).2
          have hlen1 := h1.length_le
          rw [List.length_append, List.length_replicate] at hlen1
          have l1 := congrArg List.length e1
          rw [List.length_dropLast, tailOf, List.length_append,
            List.length_replicate] at l1
          have n1 : 1 ≤ q.length := List.length_pos_iff.mpr
            (kept_ne_nil (isHead_kept (mem_childHeads.mp hq).1))
          have h4 := lenOf_pos hh
          omega
        · rw [if_neg hl] at ha
          simp at ha

theorem walkE_pairwise {L : List (List ℕ)} :
    ∀ fuel (h : List ℕ), isHead L h = true →
      (walkE L fuel h).Pairwise chainBefore := by
  intro fuel
  induction fuel with
  | zero => intro h _; simp [walkE]
  | succ fuel ih =>
      intro h hh
      rw [walkE, List.pairwise_append]
      refine ⟨?_, ?_, ?_⟩
      · -- members in offset order: ancestor chain
        by_cases hl : h ∈ L
        · rw [if_pos hl]
          rw [List.pairwise_map]
          refine (List.pairwise_lt_range).imp ?_
          intro j k hjk
          rw [show h ++ List.replicate k 1
              = (h ++ List.replicate j 1) ++ List.replicate (k - j) 1 from by
            rw [List.append_assoc, ← List.replicate_add]
            congr 2
            omega]
          exact chainBefore.ancestor _ _ (by
            intro hnil
            have := congrArg List.length hnil
            simp at this
            omega)
        · rw [if_neg hl]; exact List.Pairwise.nil
      · -- across and within subtrees
        refine pairwise_flatMap (fun q hq => ih q (mem_childHeads.mp hq).1) ?_
        have hsorted := (sorted_childHeads L (tailOf L h)).and
          (List.nodup_iff_pairwise_ne.mp (nodup_childHeads L (tailOf L h)))
        refine hsorted.imp_of_mem ?_
        intro q q' hqm hqm' ⟨hle, hne⟩ c hc c' hc'
        have h1 := (walkE_sound fuel q c (mem_childHeads.mp hqm).1 hc).2
        have h2 := (walkE_sound fuel q' c' (mem_childHeads.mp hqm').1 hc').2
        obtain ⟨r1, hr1⟩ := childHead_subtree_form hqm h1
        obtain ⟨r2, hr2⟩ := childHead_subtree_form hqm' h2
        rw [hr1, hr2]
        refine chainBefore.newer _ _ _ _ _ ?_
        have hdne : q.getLastD 0 ≠ q'.getLastD 0 := by
          intro heq
          apply hne
          have e1 : q.dropLast = tailOf L h := (mem_childHeads.mp hqm).2
          have e2 : q'.dropLast = tailOf L h := (mem_childHeads.mp hqm').2
          conv_lhs => rw [concat_getLastD
            (kept_ne_nil (isHead_kept (mem_childHeads.mp hqm).1))]
          conv_rhs => rw [concat_getLastD
            (kept_ne_nil (isHead_kept (mem_childHeads.mp hqm').1))]
          rw [e1, e2, heq]
        omega
      · -- members before every subtree chain
        intro a ha b hb
        by_cases hl : h ∈ L
        · rw [if_pos hl] at ha
          obtain ⟨k, hk, rfl⟩ := List.mem_map.mp ha
          rw [List.mem_range] at hk
          obtain ⟨q, hq, hcq⟩ := List.mem_flatMap.mp hb
          have h1 := (walkE_sound fuel q b (mem_childHeads.mp hq).1 hcq).2
          have e1 : q.dropLast = tailOf L h := (mem_childHeads.mp hq).2
          have hmt : h ++ List.replicate k 1 <+: tailOf L h := by
            rw [tailOf, show List.replicate (lenOf L h - 1) 1
                = List.replicate k 1 ++ List.replicate (lenOf L h - 1 - k) 1
              from by rw [← List.replicate_add]; congr 1; omega,
              ← List.append_assoc]
            exact List.prefix_append _ _
          have htq : tailOf L h <+: q := by
            rw [← e1]; exact List.dropLast_prefix q
          obtain ⟨ext, hext⟩ := (hmt.trans htq).trans h1
          rw [← hext]
          refine chainBefore.ancestor _ _ ?_
          intro hnil
          subst hnil
          rw [List.append_nil] at hext
          have hlen := congrArg List.length hext
          have l1 := congrArg List.length e1
          have := h1.length_le
          rw [List.length_dropLast, tailOf] at l1
          have n1 : 1 ≤ q.length := List.length_pos_iff.mpr
            (kept_ne_nil (isHead_kept (mem_childHeads.mp hq).1))
          simp only [List.length_append, List.length_replicate] at *
          have h4 := lenOf_pos hh
          omega
        · rw [if_neg hl] at ha
          simp at ha

theorem childHead_root_length {L : List (List ℕ)} {q : List ℕ}
    (hq : q ∈ childHeads L []) : q.length = 1 := by
  obtain ⟨hqh, hqd⟩ := mem_childHeads.mp hq
  have := congrArg List.length hqd
  rw [List.length_dropLast] at this
  have n1 : 1 ≤ q.length := List.length_pos_iff.mpr
    (kept_ne_nil (isHead_kept hqh))
  simp at this
  omega

theorem walk_nodup (L : List (List ℕ)) : (walk L).Nodup := by
  rw [walk]
  refine nodup_flatMap_of_disjoint (nodup_childHeads L []) ?_ ?_
  · intro q hq
    exact walkE_nodup _ q (mem_childHeads.mp hq).1
  · intro q hq q' hq' hne c hc hc'
    have h1 := (walkE_sound _ q c (mem_childHeads.mp hq).1 hc).2
    have h2 := (walkE_sound _ q' c (mem_childHeads.mp hq').1 hc').2
    exact hne (prefix_eq_of_length h1 h2
      (by rw [childHead_root_length hq, childHead_root_length hq']))

/-- **T-walk, order half**: the walk is pairwise in display order. -/
theorem walk_pairwise (L : List (List ℕ)) :
    (walk L).Pairwise chainBefore := by
  rw [walk]
  refine pairwise_flatMap (fun q hq => walkE_pairwise _ q
    (mem_childHeads.mp hq).1) ?_
  have hsorted := (sorted_childHeads L []).and
    (List.nodup_iff_pairwise_ne.mp (nodup_childHeads L []))
  refine hsorted.imp_of_mem ?_
  intro q q' hqm hqm' ⟨hle, hne⟩ c hc c' hc'
  have h1 := (walkE_sound _ q c (mem_childHeads.mp hqm).1 hc).2
  have h2 := (walkE_sound _ q' c' (mem_childHeads.mp hqm').1 hc').2
  obtain ⟨r1, hr1⟩ := childHead_subtree_form hqm h1
  obtain ⟨r2, hr2⟩ := childHead_subtree_form hqm' h2
  rw [hr1, hr2]
  refine chainBefore.newer _ _ _ _ _ ?_
  have hdne : q.getLastD 0 ≠ q'.getLastD 0 := by
    intro heq
    apply hne
    have e1 := (mem_childHeads.mp hqm).2
    have e2 := (mem_childHeads.mp hqm').2
    conv_lhs => rw [concat_getLastD
      (kept_ne_nil (isHead_kept (mem_childHeads.mp hqm).1))]
    conv_rhs => rw [concat_getLastD
      (kept_ne_nil (isHead_kept (mem_childHeads.mp hqm').1))]
    rw [e1, e2, heq]
  omega

/-- **T-walk, membership half**: the walk emits exactly the live chains. -/
theorem mem_walk {L : List (List ℕ)} (hnil : [] ∉ L) {c : List ℕ} :
    c ∈ walk L ↔ c ∈ L := by
  constructor
  · intro hc
    obtain ⟨q, hq, hcq⟩ := List.mem_flatMap.mp hc
    exact (walkE_sound _ q c (mem_childHeads.mp hq).1 hcq).1
  · intro hc
    have hne : c ≠ [] := fun h => hnil (h ▸ hc)
    have hkept : c ∈ keptL L := kept_of_live hc hne
    obtain ⟨d, cs, rfl⟩ : ∃ d cs, c = d :: cs := by
      cases c with
      | nil => exact absurd rfl hne
      | cons d cs => exact ⟨d, cs, rfl⟩
    have hq0 : ([d] : List ℕ) ∈ keptL L :=
      kept_of_prefix hkept ⟨cs, rfl⟩ (by simp)
    have hq0h : isHead L [d] = true := by
      refine isHead_of_kept_not_fusible hq0 ?_
      cases hf : fusible L [d] with
      | false => rfl
      | true =>
          exfalso
          have := fusible_parent_kept hf
          exact kept_ne_nil this rfl
    rw [walk]
    refine List.mem_flatMap.mpr ⟨[d], mem_childHeads.mpr ⟨hq0h, rfl⟩, ?_⟩
    refine walkE_complete _ [d] _ hq0h hc hkept ⟨cs, rfl⟩ ?_
    simp

/-- **T-walk, packaged** (walk = query): the structural walk of the run
table is a duplicate-free enumeration of exactly the live chains, pairwise
in display (`chainBefore`) order, which pins it to THE display sequence,
strict orders having unique sorted enumerations. No stability hypothesis. -/
theorem walk_display (L : List (List ℕ)) (hnil : [] ∉ L) :
    (walk L).Nodup ∧ (∀ c, c ∈ walk L ↔ c ∈ L)
      ∧ (walk L).Pairwise chainBefore :=
  ⟨walk_nodup L, fun _ => mem_walk hnil, walk_pairwise L⟩

/-- **T-walk, key form**: the walk is descending in `keyLt` on the coded
coordinates, the exact sort order of the fold's document, for any ordered
prefix code. -/
theorem walk_pairwise_keyLt (Γ : OrderedPrefixCode) {L : List (List ℕ)}
    (hpos : ∀ l ∈ L, PosChain l) (hnil : [] ∉ L) :
    (walk L).Pairwise (fun c1 c2 =>
      keyLt (key (coordOf Γ c2)) (key (coordOf Γ c1)) = true) := by
  refine (walk_pairwise L).imp_of_mem ?_
  intro c1 c2 h1 h2 hb
  have hp1 : PosChain c1 := posChain_of_kept hpos
    (kept_of_live (mem_walk hnil |>.mp h1)
      (fun h => hnil (h ▸ (mem_walk hnil |>.mp h1))))
  have hp2 : PosChain c2 := posChain_of_kept hpos
    (kept_of_live (mem_walk hnil |>.mp h2)
      (fun h => hnil (h ▸ (mem_walk hnil |>.mp h2))))
  exact Sal.EmbedRGA.chainBefore_display Γ hp1 hp2 hb

/-! ## §7  T-mut: simulation of the mutation rules

The table is a **function of the live-chain set** (`tableOf_congr`): that is
the merge rule (a merge delivers the union of event sets, and the union's
table is the rebuild, no order or arrival dependence), and it is what makes
every other rule statable set-wise. The typing rule (`tableOf_insert_extend`)
is proved generically: extending a childless live node by a delta-1 child
bumps ONE `len` field, O(1) table work for a keystroke. The remaining rules
(mid-run split, the delete liveness split, coalesce as the forced
delete-inverse, vanished-anchor materialization) are pinned by the instance
SPOTs (D1–D5 shapes), their generic perturbation lemmas live in §7¼, and
their closed-form `tableOf` equations in §7⅜ (`tableOf_insert_split`,
`tableOf_delete_split`, `tableOf_coalesce`, `tableOf_materialize`). -/

theorem keptL_congr {L L' : List (List ℕ)} (hmem : ∀ c, c ∈ L ↔ c ∈ L') :
    ∀ x, x ∈ keptL L ↔ x ∈ keptL L' := by
  intro x
  rw [mem_keptL, mem_keptL]
  constructor
  · rintro ⟨hne, l, hl, hp⟩
    exact ⟨hne, l, (hmem l).mp hl, hp⟩
  · rintro ⟨hne, l, hl, hp⟩
    exact ⟨hne, l, (hmem l).mpr hl, hp⟩

theorem fusible_congr {L L' : List (List ℕ)}
    (hmem : ∀ c, c ∈ L ↔ c ∈ L') (c : List ℕ) :
    fusible L c = fusible L' c := by
  have hk := keptL_congr hmem
  simp only [fusible]
  rw [decide_eq_decide.mpr (hk c), decide_eq_decide.mpr (hk c.dropLast),
    decide_eq_decide.mpr (hmem c), decide_eq_decide.mpr (hmem c.dropLast),
    decide_eq_decide.mpr (show (∀ c' ∈ keptL L, c'.dropLast = c.dropLast
        → c' = c) ↔ (∀ c' ∈ keptL L', c'.dropLast = c.dropLast → c' = c) from
      ⟨fun h c' hc' => h c' ((hk c').mpr hc'),
       fun h c' hc' => h c' ((hk c').mp hc')⟩)]

theorem headOf_congr {L L' : List (List ℕ)}
    (hmem : ∀ c, c ∈ L ↔ c ∈ L') :
    ∀ n (c : List ℕ), c.length ≤ n → headOf L c = headOf L' c := by
  intro n
  induction n with
  | zero =>
      intro c hc
      have : c = [] := List.length_eq_zero_iff.mp (by omega)
      subst this
      rw [headOf_of_not_fusible, headOf_of_not_fusible]
      · cases hf : fusible L' [] with
        | false => rfl
        | true => exact absurd (fusible_ne_nil hf) (by simp)
      · cases hf : fusible L [] with
        | false => rfl
        | true => exact absurd (fusible_ne_nil hf) (by simp)
  | succ n ih =>
      intro c hc
      cases hf : fusible L c with
      | true =>
          have hf' : fusible L' c = true := by
            rw [← fusible_congr hmem]; exact hf
          rw [headOf_of_fusible hf, headOf_of_fusible hf']
          refine ih c.dropLast ?_
          have : c ≠ [] := fusible_ne_nil hf
          have : 0 < c.length := List.length_pos_iff.mpr this
          rw [List.length_dropLast]
          omega
      | false =>
          have hf' : fusible L' c = false := by
            rw [← fusible_congr hmem]; exact hf
          rw [headOf_of_not_fusible hf, headOf_of_not_fusible hf']

theorem isHead_congr {L L' : List (List ℕ)}
    (hmem : ∀ c, c ∈ L ↔ c ∈ L') (c : List ℕ) :
    isHead L c = isHead L' c := by
  simp only [isHead]
  rw [decide_eq_decide.mpr (keptL_congr hmem c), fusible_congr hmem]

theorem keptL_perm {L L' : List (List ℕ)}
    (hmem : ∀ c, c ∈ L ↔ c ∈ L') : (keptL L).Perm (keptL L') :=
  (List.perm_ext_iff_of_nodup (nodup_keptL L) (nodup_keptL L')).mpr
    (keptL_congr hmem)

theorem lenOf_congr {L L' : List (List ℕ)}
    (hmem : ∀ c, c ∈ L ↔ c ∈ L') (h : List ℕ) :
    lenOf L h = lenOf L' h := by
  rw [lenOf, lenOf, runMembers, runMembers]
  have h1 : (keptL L).filter (fun c => headOf L c == h)
      = (keptL L).filter (fun c => headOf L' c == h) := by
    refine List.filter_congr ?_
    intro c hc
    rw [headOf_congr hmem c.length c (le_refl _)]
  rw [h1]
  exact ((keptL_perm hmem).filter _).length_eq

theorem headsList_congr {L L' : List (List ℕ)}
    (hmem : ∀ c, c ∈ L ↔ c ∈ L') : headsList L = headsList L' := by
  refine hLt_sorted_ext (sorted_headsList L) (sorted_headsList L') ?_
  intro c
  rw [mem_headsList, mem_headsList, isHead_congr hmem]

/-- **T-mut (merge): the table is a function of the live-chain set.** Two
states with the same live chains, a merge's union of event sets however
delivered, in whatever order, compile to the *identical* canonical table.
This is the incremental-equals-canonical PBT gate, generically. -/
theorem tableOf_congr {L L' : List (List ℕ)}
    (hmem : ∀ c, c ∈ L ↔ c ∈ L') : tableOf L = tableOf L' := by
  rw [tableOf, tableOf, ← headsList_congr hmem]
  refine List.map_congr_left ?_
  intro h hh
  rw [entryOfHead, entryOfHead]
  have hk := keptL_congr hmem h.dropLast
  by_cases hp : h.dropLast ∈ keptL L
  · rw [if_pos hp, if_pos (hk.mp hp)]
    rw [← headsList_congr hmem,
      ← headOf_congr hmem h.dropLast.length h.dropLast (le_refl _),
      ← lenOf_congr hmem]
    have : decide (h ∈ L) = decide (h ∈ L') := decide_eq_decide.mpr (hmem h)
    rw [this]
  · rw [if_neg hp, if_neg (fun hx => hp (hk.mpr hx))]
    rw [← lenOf_congr hmem]
    have : decide (h ∈ L) = decide (h ∈ L') := decide_eq_decide.mpr (hmem h)
    rw [this]

/-! ### The typing rule: extend a run in O(1) table work -/

theorem fusible_eq_true_iff {L : List (List ℕ)} {c : List ℕ} :
    fusible L c = true ↔
    c ∈ keptL L ∧ c.dropLast ∈ keptL L ∧ c.getLastD 0 = 1
    ∧ (∀ c' ∈ keptL L, c'.dropLast = c.dropLast → c' = c)
    ∧ ((c ∈ L) ↔ (c.dropLast ∈ L)) := by
  simp only [fusible, Bool.and_eq_true, decide_eq_true_eq, beq_iff_eq]
  constructor
  · rintro ⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩
    exact ⟨h1, h2, h3, h4, decide_eq_decide.mp h5⟩
  · rintro ⟨h1, h2, h3, h4, h5⟩
    exact ⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, decide_eq_decide.mpr h5⟩

theorem child_of_parent_eq {x p : List ℕ} (hne : x ≠ [])
    (hd : x.dropLast = p) : x = p ++ [x.getLastD 0] := by
  conv_lhs => rw [concat_getLastD hne]
  rw [hd]

section InsertExtend

variable {L : List (List ℕ)} {a : List ℕ}
  (ha : a ∈ L) (hnil : ([] : List ℕ) ∉ L)
  (hchildless : ∀ d, (a ++ [d]) ∉ keptL L)

include ha hnil in
theorem extend_kept_iff (hchildless : ∀ d, (a ++ [d]) ∉ keptL L) :
    ∀ x, x ∈ keptL (L ++ [a ++ [1]]) ↔ x ∈ keptL L ∨ x = a ++ [1] := by
  intro x
  have hane : a ≠ [] := fun h => hnil (h ▸ ha)
  rw [mem_keptL]
  constructor
  · rintro ⟨hne, l, hl, hp⟩
    rcases List.mem_append.mp hl with hl | hl
    · exact Or.inl (mem_keptL.mpr ⟨hne, l, hl, hp⟩)
    · rw [List.mem_singleton] at hl
      subst hl
      by_cases hx : x = a ++ [1]
      · exact Or.inr hx
      · left
        have hpa : x <+: a := by
          have := prefix_dropLast_of_ne hp hx
          rwa [List.dropLast_concat] at this
        exact mem_keptL.mpr ⟨hne, a, ha, hpa⟩
  · rintro (hx | rfl)
    · obtain ⟨hne, l, hl, hp⟩ := mem_keptL.mp hx
      exact ⟨hne, l, List.mem_append_left _ hl, hp⟩
    · exact ⟨by simp, a ++ [1], List.mem_append_right _ (by simp),
        List.prefix_refl _⟩

include ha hnil hchildless in
theorem extend_new_not_kept : a ++ [1] ∉ keptL L := hchildless 1

include ha hnil hchildless in
theorem extend_fusible_old {x : List ℕ} (hx : x ∈ keptL L) :
    fusible (L ++ [a ++ [1]]) x = fusible L x := by
  have hane : a ≠ [] := fun h => hnil (h ▸ ha)
  have hkiff := extend_kept_iff ha hnil hchildless
  have hxc : x ≠ a ++ [1] := fun h => hchildless 1 (h ▸ hx)
  rw [Bool.eq_iff_iff, fusible_eq_true_iff, fusible_eq_true_iff]
  constructor
  · rintro ⟨h1, h2, h3, h4, h5⟩
    have hd : x.dropLast ∈ keptL L := by
      rcases (hkiff x.dropLast).mp h2 with h | h
      · exact h
      · exfalso
        apply hchildless 1
        rw [← h]
        exact kept_of_prefix hx (List.dropLast_prefix x)
          (by rw [h]; simp)
    have hdc : x.dropLast ≠ a ++ [1] := fun h =>
      hchildless 1 (h ▸ hd)
    refine ⟨hx, hd, h3, ?_, ?_⟩
    · intro c' hc' hpar
      exact h4 c' ((hkiff c').mpr (Or.inl hc')) hpar
    · rw [show (x ∈ L) ↔ (x ∈ L ++ [a ++ [1]]) from
        ⟨fun h => List.mem_append_left _ h,
         fun h => by
          rcases List.mem_append.mp h with h | h
          · exact h
          · rw [List.mem_singleton] at h; exact absurd h hxc⟩]
      rw [show (x.dropLast ∈ L) ↔ (x.dropLast ∈ L ++ [a ++ [1]]) from
        ⟨fun h => List.mem_append_left _ h,
         fun h => by
          rcases List.mem_append.mp h with h | h
          · exact h
          · rw [List.mem_singleton] at h; exact absurd h hdc⟩]
      exact h5
  · rintro ⟨h1, h2, h3, h4, h5⟩
    have hdc : x.dropLast ≠ a ++ [1] := fun h =>
      hchildless 1 (h ▸ h2)
    refine ⟨(hkiff x).mpr (Or.inl hx),
      (hkiff x.dropLast).mpr (Or.inl h2), h3, ?_, ?_⟩
    · intro c' hc' hpar
      rcases (hkiff c').mp hc' with hc' | rfl
      · exact h4 c' hc' hpar
      · exfalso
        rw [List.dropLast_concat] at hpar
        apply hchildless (x.getLastD 0)
        rw [← child_of_parent_eq (kept_ne_nil hx) hpar.symm]
        exact hx
    · rw [show (x ∈ L ++ [a ++ [1]]) ↔ (x ∈ L) from
        ⟨fun h => by
          rcases List.mem_append.mp h with h | h
          · exact h
          · rw [List.mem_singleton] at h; exact absurd h hxc,
         fun h => List.mem_append_left _ h⟩]
      rw [show (x.dropLast ∈ L ++ [a ++ [1]]) ↔ (x.dropLast ∈ L) from
        ⟨fun h => by
          rcases List.mem_append.mp h with h | h
          · exact h
          · rw [List.mem_singleton] at h; exact absurd h hdc,
         fun h => List.mem_append_left _ h⟩]
      exact h5

include ha hnil hchildless in
theorem extend_fusible_new :
    fusible (L ++ [a ++ [1]]) (a ++ [1]) = true := by
  have hane : a ≠ [] := fun h => hnil (h ▸ ha)
  have hkiff := extend_kept_iff ha hnil hchildless
  rw [fusible_eq_true_iff]
  refine ⟨(hkiff _).mpr (Or.inr rfl), ?_, ?_, ?_, ?_⟩
  · rw [List.dropLast_concat]
    exact (hkiff a).mpr (Or.inl (kept_of_live ha hane))
  · rw [List.getLastD_concat]
  · intro c' hc' hpar
    rw [List.dropLast_concat] at hpar
    rcases (hkiff c').mp hc' with hc' | rfl
    · exfalso
      apply hchildless (c'.getLastD 0)
      rw [← child_of_parent_eq (kept_ne_nil hc') hpar]
      exact hc'
    · rfl
  · rw [List.dropLast_concat]
    constructor
    · intro _
      exact List.mem_append_left _ ha
    · intro _
      exact List.mem_append_right _ (by simp)

include ha hnil hchildless in
theorem extend_isHead_old {x : List ℕ} (hx : x ∈ keptL L) :
    isHead (L ++ [a ++ [1]]) x = isHead L x := by
  simp only [isHead]
  rw [extend_fusible_old ha hnil hchildless hx,
    decide_eq_decide.mpr (show x ∈ keptL (L ++ [a ++ [1]]) ↔ x ∈ keptL L from
      ⟨fun _ => hx,
       fun _ => (extend_kept_iff ha hnil hchildless x).mpr (Or.inl hx)⟩)]

include ha hnil hchildless in
theorem extend_headOf_old :
    ∀ n (x : List ℕ), x.length ≤ n → x ∈ keptL L →
      headOf (L ++ [a ++ [1]]) x = headOf L x := by
  intro n
  induction n with
  | zero =>
      intro x hx hkx
      exact absurd (List.length_pos_iff.mpr (kept_ne_nil hkx)) (by omega)
  | succ n ih =>
      intro x hx hkx
      cases hf : fusible L x with
      | true =>
          rw [headOf_of_fusible ((extend_fusible_old ha hnil hchildless
            hkx).trans hf), headOf_of_fusible hf]
          refine ih x.dropLast ?_ (fusible_parent_kept hf)
          have : 0 < x.length := List.length_pos_iff.mpr (kept_ne_nil hkx)
          rw [List.length_dropLast]
          omega
      | false =>
          rw [headOf_of_not_fusible ((extend_fusible_old ha hnil hchildless
            hkx).trans hf), headOf_of_not_fusible hf]

include ha hnil hchildless in
theorem extend_headOf_new :
    headOf (L ++ [a ++ [1]]) (a ++ [1]) = headOf L a := by
  have hane : a ≠ [] := fun h => hnil (h ▸ ha)
  rw [headOf_of_fusible (extend_fusible_new ha hnil hchildless),
    List.dropLast_concat]
  exact extend_headOf_old ha hnil hchildless a.length a (le_refl _)
    (kept_of_live ha hane)

include ha hnil hchildless in
theorem extend_headsList : headsList (L ++ [a ++ [1]]) = headsList L := by
  refine hLt_sorted_ext (sorted_headsList _) (sorted_headsList _) ?_
  intro c
  rw [mem_headsList, mem_headsList]
  constructor
  · intro h
    rcases (extend_kept_iff ha hnil hchildless c).mp (isHead_kept h)
      with hold | rfl
    · rwa [extend_isHead_old ha hnil hchildless hold] at h
    · exfalso
      have h1 := isHead_not_fusible h
      rw [extend_fusible_new ha hnil hchildless] at h1
      exact Bool.noConfusion h1
  · intro h
    rw [extend_isHead_old ha hnil hchildless (isHead_kept h)]
    exact h

include ha hnil hchildless in
theorem extend_lenOf {h : List ℕ} (hh : isHead L h = true) :
    lenOf (L ++ [a ++ [1]]) h
      = lenOf L h + (if h = headOf L a then 1 else 0) := by
  have hperm : (runMembers (L ++ [a ++ [1]]) h).Perm
      (if h = headOf L a then (a ++ [1]) :: runMembers L h
       else runMembers L h) := by
    refine (List.perm_ext_iff_of_nodup ((nodup_keptL _).filter _) ?_).mpr ?_
    · by_cases hcase : h = headOf L a
      · rw [if_pos hcase]
        exact List.Pairwise.cons
          (fun y hy heq => hchildless 1
            (heq ▸ (mem_runMembers.mp hy).1))
          ((nodup_keptL L).filter _)
      · rw [if_neg hcase]
        exact (nodup_keptL L).filter _
    · intro x
      simp only [List.mem_filter, beq_iff_eq]
      constructor
      · rintro ⟨hxk, hxh⟩
        rcases (extend_kept_iff ha hnil hchildless x).mp hxk with hold | rfl
        · rw [extend_headOf_old ha hnil hchildless x.length x (le_refl _)
            hold] at hxh
          by_cases hcase : h = headOf L a
          · rw [if_pos hcase]
            exact List.mem_cons_of_mem _ (mem_runMembers.mpr ⟨hold, hxh⟩)
          · rw [if_neg hcase]
            exact mem_runMembers.mpr ⟨hold, hxh⟩
        · rw [extend_headOf_new ha hnil hchildless] at hxh
          rw [if_pos hxh.symm]
          exact List.mem_cons_self
      · intro hx
        by_cases hcase : h = headOf L a
        · rw [if_pos hcase] at hx
          rcases List.mem_cons.mp hx with rfl | hx
          · exact ⟨(extend_kept_iff ha hnil hchildless _).mpr (Or.inr rfl),
              by rw [extend_headOf_new ha hnil hchildless, hcase]⟩
          · obtain ⟨hxk, hxh⟩ := mem_runMembers.mp hx
            exact ⟨(extend_kept_iff ha hnil hchildless x).mpr (Or.inl hxk),
              by rw [extend_headOf_old ha hnil hchildless x.length x
                (le_refl _) hxk]; exact hxh⟩
        · rw [if_neg hcase] at hx
          obtain ⟨hxk, hxh⟩ := mem_runMembers.mp hx
          exact ⟨(extend_kept_iff ha hnil hchildless x).mpr (Or.inl hxk),
            by rw [extend_headOf_old ha hnil hchildless x.length x
              (le_refl _) hxk]; exact hxh⟩
  have hlen := hperm.length_eq
  by_cases hcase : h = headOf L a
  · rw [if_pos hcase] at hlen
    rw [if_pos hcase]
    rw [lenOf, lenOf, hlen]
    simp
  · rw [if_neg hcase] at hlen
    rw [if_neg hcase]
    rw [lenOf, lenOf, hlen]
    omega

include ha hnil hchildless in
/-- **T-mut (typing / insert extends a run)**: appending a delta-1 child to
a childless live node re-canonicalizes to the SAME table with ONE `len`
field bumped, the coalesce-after-attach path, O(1) table work per
keystroke. The other insert shape (anchor interior or label ≠ 1, the mid-run
split / new-entry rule) and the delete family are pinned concretely by the
instance SPOTs and closed generically in §7⅜ (D1 `tableOf_insert_split`,
D2 `tableOf_delete_split`, D4 `tableOf_coalesce`,
D5 `tableOf_materialize`). -/
theorem tableOf_insert_extend :
    tableOf (L ++ [a ++ [1]])
      = (headsList L).map (fun h =>
          if h = headOf L a
          then { entryOfHead L h with len := (entryOfHead L h).len + 1 }
          else entryOfHead L h) := by
  rw [tableOf, extend_headsList ha hnil hchildless]
  refine List.map_congr_left ?_
  intro h hh
  have hhead : isHead L h = true := mem_headsList.mp hh
  have hkept : h ∈ keptL L := isHead_kept hhead
  have hne_c : h ≠ a ++ [1] := fun heq => hchildless 1 (heq ▸ hkept)
  have hdne_c : h.dropLast ≠ a ++ [1] := by
    intro heq
    apply hchildless 1
    rw [← heq]
    exact kept_of_prefix hkept (List.dropLast_prefix h) (by rw [heq]; simp)
  have hcond : (h.dropLast ∈ keptL (L ++ [a ++ [1]]))
      ↔ (h.dropLast ∈ keptL L) := by
    rw [extend_kept_iff ha hnil hchildless]
    exact ⟨fun hor => hor.resolve_right (fun h' => absurd h' hdne_c),
      Or.inl⟩
  have hlive : (h ∈ L ++ [a ++ [1]]) ↔ (h ∈ L) := by
    constructor
    · intro hm
      rcases List.mem_append.mp hm with hm | hm
      · exact hm
      · rw [List.mem_singleton] at hm
        exact absurd hm hne_c
    · exact fun hm => List.mem_append_left _ hm
  have hfields : entryOfHead (L ++ [a ++ [1]]) h
      = { entryOfHead L h with
          len := lenOf L h + (if h = headOf L a then 1 else 0) } := by
    rw [entryOfHead, entryOfHead]
    by_cases hp : h.dropLast ∈ keptL L
    · rw [if_pos (hcond.mpr hp), if_pos hp]
      rw [extend_headsList ha hnil hchildless,
        extend_headOf_old ha hnil hchildless h.dropLast.length h.dropLast
          (le_refl _) hp,
        decide_eq_decide.mpr hlive,
        extend_lenOf ha hnil hchildless hhead]
    · rw [if_neg (fun hx => hp (hcond.mp hx)), if_neg hp]
      rw [decide_eq_decide.mpr hlive,
        extend_lenOf ha hnil hchildless hhead]
  rw [hfields]
  by_cases hcase : h = headOf L a
  · rw [if_pos hcase, if_pos hcase]
    rfl
  · rw [if_neg hcase, if_neg hcase]
    refine RTEntry.ext' rfl rfl rfl ?_
    show lenOf L h + 0 = (entryOfHead L h).len
    rw [Nat.add_zero]
    rfl

end InsertExtend

/-! ## §7¼  T-mut: the four remaining mutation rules, as generic perturbations

`tableOf_insert_extend` (§7) is the happy insert path (childless live anchor,
`delta = 1`: coalesce-after-attach, one `len` bump). The four rules that the
predecessor left SPOT-pinned are promoted here to **generic** state-level
theorems, each stated as the perturbation of `keptL`/`fusible`/`isHead` (hence
`headOf`, `lenOf`, `tableOf`) under the operation on the live-chain set.
These are exactly the structural facts the instance SPOTs D1/D2/D4/D5 pin
concretely. As everywhere in this file, no stability or honesty hypothesis
appears. -/

/-- **Insert-family `keptL` perturbation** (the shared root of D1/D5 and the
`tableOf_insert_extend` keptL side): adding a chain `w` to the live set adds
exactly `w`'s nonempty prefixes to the kept tree. -/
theorem mem_keptL_snoc {L : List (List ℕ)} {w x : List ℕ} :
    x ∈ keptL (L ++ [w]) ↔ x ∈ keptL L ∨ (x ≠ [] ∧ x <+: w) := by
  rw [mem_keptL, mem_keptL]
  constructor
  · rintro ⟨hne, l, hl, hp⟩
    rcases List.mem_append.mp hl with hl | hl
    · exact Or.inl ⟨hne, l, hl, hp⟩
    · rw [List.mem_singleton] at hl; subst hl; exact Or.inr ⟨hne, hp⟩
  · rintro (⟨hne, l, hl, hp⟩ | ⟨hne, hp⟩)
    · exact ⟨hne, l, List.mem_append_left _ hl, hp⟩
    · exact ⟨hne, w, List.mem_append_right _ (by simp), hp⟩

/-! ### D2: delete of a node with kept children: the liveness split

Deleting `x` (which still has a kept descendant) leaves the kept tree
untouched (`delete_keptL_eq`) but flips `x` dead, breaking fusibility on both
of `x`'s incident edges when the neighbours are live: the run carrying `x`
splits into the live prefix, the dead singleton `x`, and the live suffix
(SPOT `spot_d2_liveness_split`). -/

section DeleteLiveness

variable {L L' : List (List ℕ)} {x : List ℕ}
  (hxne : x ≠ [])
  (hchild : ∃ e, x ++ [e] ∈ keptL L)
  (hmem' : ∀ c, c ∈ L' ↔ (c ∈ L ∧ c ≠ x))

include hchild hmem' in
/-- **D2, keptL invariance**: a delete that keeps a descendant leaves the kept
tree pointwise unchanged (the dead node survives as a dead ancestor). -/
theorem delete_keptL_eq (c : List ℕ) : c ∈ keptL L' ↔ c ∈ keptL L := by
  rw [mem_keptL, mem_keptL]
  constructor
  · rintro ⟨hne, l, hl, hp⟩
    exact ⟨hne, l, ((hmem' l).mp hl).1, hp⟩
  · rintro ⟨hne, l, hl, hp⟩
    by_cases hlx : l = x
    · obtain ⟨e, he⟩ := hchild
      obtain ⟨-, l', hl', hp'⟩ := mem_keptL.mp he
      have hl'x : l' ≠ x := by
        intro heq
        have hle := hp'.length_le
        rw [heq] at hle
        simp only [List.length_append, List.length_cons, List.length_nil]
          at hle
        omega
      refine ⟨hne, l', (hmem' l').mpr ⟨hl', hl'x⟩, ?_⟩
      rw [hlx] at hp
      exact hp.trans ((List.prefix_append x [e]).trans hp')
    · exact ⟨hne, l, (hmem' l).mpr ⟨hl, hlx⟩, hp⟩

include hmem' in
theorem delete_x_dead : x ∉ L' := fun hm => ((hmem' x).mp hm).2 rfl

include hxne hmem' in
/-- **D2, the run breaks *before* `x`**: with `x` dead and its (live) parent
still live, `x`'s incoming edge is no longer fusible, `x` becomes a head. -/
theorem delete_fusible_x_false (hpar : x.dropLast ∈ L) :
    fusible L' x = false := by
  cases hf : fusible L' x with
  | false => rfl
  | true =>
      exfalso
      have hlv := fusible_live hf
      have hxL' : x ∉ L' := delete_x_dead hmem'
      have hdxne : x.dropLast ≠ x := by
        intro heq
        have hpos := List.length_pos_iff.mpr hxne
        have := congrArg List.length heq
        rw [List.length_dropLast] at this; omega
      exact hxL' (hlv.mpr ((hmem' x.dropLast).mpr ⟨hpar, hdxne⟩))

include hmem' in
/-- **D2, the run breaks *after* `x`**: `x`'s (live) run successor loses its
fusible edge into the now-dead `x`, a second head. -/
theorem delete_fusible_succ_false {e : ℕ} (hsucc : x ++ [e] ∈ L) :
    fusible L' (x ++ [e]) = false := by
  cases hf : fusible L' (x ++ [e]) with
  | false => rfl
  | true =>
      exfalso
      have hlv := fusible_live hf
      rw [List.dropLast_concat] at hlv
      have hxL' : x ∉ L' := delete_x_dead hmem'
      have hsne : x ++ [e] ≠ x := by
        intro heq; have := congrArg List.length heq; simp at this
      exact hxL' (hlv.mp ((hmem' (x ++ [e])).mpr ⟨hsucc, hsne⟩))

end DeleteLiveness

/-! ### D1: concurrent insert at an interior node: the mid-run split

Anchoring a second child `a ++ [d]` (`d ≠ 1`) at a node `a` that already has a
run successor `a ++ [1]` turns `a` into a branch point: **both** children
become heads, so the run carrying `a` splits into the `a`-prefix run, the
`a ++ [1]` suffix run, and the `a ++ [d]` singleton (SPOT `spot_d1_split`). -/

section MidRunSplit

variable {L : List (List ℕ)} {a : List ℕ} {d : ℕ}
  (hsucc : a ++ [1] ∈ keptL L) (hd : d ≠ 1)

theorem split_new_kept : a ++ [d] ∈ keptL (L ++ [a ++ [d]]) :=
  mem_keptL_snoc.mpr (Or.inr ⟨by simp, List.prefix_refl _⟩)

include hsucc in
theorem split_succ_kept : a ++ [1] ∈ keptL (L ++ [a ++ [d]]) :=
  mem_keptL_snoc.mpr (Or.inl hsucc)

include hd in
/-- **D1, the new child is a head**: `delta = d ≠ 1` fails fusibility. -/
theorem split_new_isHead : isHead (L ++ [a ++ [d]]) (a ++ [d]) = true := by
  refine isHead_of_kept_not_fusible split_new_kept ?_
  cases hf : fusible (L ++ [a ++ [d]]) (a ++ [d]) with
  | false => rfl
  | true =>
      exfalso
      have hg := (fusible_eq_true_iff.mp hf).2.2.1
      rw [List.getLastD_concat] at hg
      exact hd hg

include hsucc hd in
/-- **D1, the former run successor becomes a head**: `a` now has two kept
children, so `a ++ [1]` is no longer `a`'s unique kept child, the run splits
here. -/
theorem split_succ_isHead : isHead (L ++ [a ++ [d]]) (a ++ [1]) = true := by
  refine isHead_of_kept_not_fusible (split_succ_kept hsucc) ?_
  cases hf : fusible (L ++ [a ++ [d]]) (a ++ [1]) with
  | false => rfl
  | true =>
      exfalso
      have huniq := (fusible_eq_true_iff.mp hf).2.2.2.1
      have heq := huniq (a ++ [d]) split_new_kept
        (by rw [List.dropLast_concat, List.dropLast_concat])
      have := List.append_cancel_left heq
      injection this with h'
      exact hd h'

end MidRunSplit

/-! ### D5: delivery under a vanished anchor: materialization

An op delivered against an anchor `m` that vanished locally (deleted while
childless, so `m ∉ keptL L`) carries `m`'s coordinate. Attaching the op's
chain `m ++ [d]` re-materializes `m` as **dead** kept structure: `m` becomes
kept again (`materialize_kept`) yet is not live (`materialize_dead`), the
run-table cost of tombstone-freedom, paid with information the op carries
(SPOT `spot_d5_materialize`). -/

section Materialize

variable {L : List (List ℕ)} {m : List ℕ} {d : ℕ}
  (hmne : m ≠ []) (hvanished : m ∉ keptL L)

include hmne in
theorem materialize_kept : m ∈ keptL (L ++ [m ++ [d]]) :=
  mem_keptL_snoc.mpr (Or.inr ⟨hmne, List.prefix_append m [d]⟩)

include hmne hvanished in
theorem materialize_dead : m ∉ (L ++ [m ++ [d]]) := by
  intro hm
  rcases List.mem_append.mp hm with hm | hm
  · exact hvanished (kept_of_live hm hmne)
  · rw [List.mem_singleton] at hm
    have := congrArg List.length hm; simp at this

end Materialize

/-! ### D4: deleting the interloper re-coalesces: the FORCED delete-inverse

The inverse of D1, and the finding the note flags a paper proof would hand-wave
(§10): removing the childless interloper `a ++ [d]` makes `a ++ [1]` `a`'s
**unique** kept child again, so the edge re-fuses. Without this coalesce the
table stays split and drifts from canonical (SPOT `spot_d4_coalesce_necessity`).
`honly` records that in the pre-delete state `a`'s only kept children are the
run successor and the interloper. -/

section Coalesce

variable {L L' : List (List ℕ)} {a : List ℕ} {d : ℕ}
  (hane : a ≠ []) (hd : d ≠ 1)
  (hleaf : ∀ e, (a ++ [d]) ++ [e] ∉ keptL L)
  (hsucc : a ++ [1] ∈ keptL L)
  (hlv : (a ++ [1] ∈ L) ↔ (a ∈ L))
  (honly : ∀ c' ∈ keptL L, c'.dropLast = a → c' = a ++ [1] ∨ c' = a ++ [d])
  (hmem' : ∀ c, c ∈ L' ↔ (c ∈ L ∧ c ≠ a ++ [d]))

include hleaf hmem' in
/-- **D4, the interloper vanishes**: a childless leaf, once removed, leaves no
kept trace. -/
theorem coalesce_vanished : a ++ [d] ∉ keptL L' := by
  intro hk
  obtain ⟨-, l, hl, hp⟩ := mem_keptL.mp hk
  have hlne : l ≠ a ++ [d] := ((hmem' l).mp hl).2
  obtain ⟨e, he⟩ := take_succ_of_prefix hp (fun heq => hlne heq.symm)
  exact hleaf e (mem_keptL.mpr ⟨by simp, l, ((hmem' l).mp hl).1, he⟩)

include hd hleaf hsucc hmem' in
/-- **D4, keptL perturbation**: the kept tree loses exactly the interloper. -/
theorem coalesce_keptL (c : List ℕ) :
    c ∈ keptL L' ↔ (c ∈ keptL L ∧ c ≠ a ++ [d]) := by
  constructor
  · intro hk
    obtain ⟨hne, l, hl, hp⟩ := mem_keptL.mp hk
    exact ⟨mem_keptL.mpr ⟨hne, l, ((hmem' l).mp hl).1, hp⟩,
      fun hceq => (coalesce_vanished hleaf hmem') (hceq ▸ hk)⟩
  · rintro ⟨hk, hcne⟩
    obtain ⟨hne, l, hl, hp⟩ := mem_keptL.mp hk
    by_cases hlx : l = a ++ [d]
    · have hca : c <+: a := by
        rw [hlx] at hp
        have := prefix_dropLast_of_ne hp hcne
        rwa [List.dropLast_concat] at this
      obtain ⟨-, l₁, hl₁, hp₁⟩ := mem_keptL.mp hsucc
      have hl₁ne : l₁ ≠ a ++ [d] := by
        intro heq
        rw [heq] at hp₁
        have heqp := hp₁.eq_of_length (by simp)
        have := List.append_cancel_left heqp
        injection this with h'; exact hd h'.symm
      exact mem_keptL.mpr ⟨hne, l₁, (hmem' l₁).mpr ⟨hl₁, hl₁ne⟩,
        hca.trans ((List.prefix_append a [1]).trans hp₁)⟩
    · exact mem_keptL.mpr ⟨hne, l, (hmem' l).mpr ⟨hl, hlx⟩, hp⟩

include hane hd hleaf hsucc hlv honly hmem' in
/-- **D4, the edge re-fuses**: after the delete, `a ++ [1]`'s incoming edge is
fusible again, the coalesce. (In the pre-delete state it was split, D1.) -/
theorem coalesce_restored : fusible L' (a ++ [1]) = true := by
  have hkiff := coalesce_keptL (L := L) (L' := L') hd hleaf hsucc hmem'
  have hane_d : a ≠ a ++ [d] := fun heq => by
    have := congrArg List.length heq; simp at this
  have hsucc_d : a ++ [1] ≠ a ++ [d] := fun heq => by
    have := List.append_cancel_left heq; injection this with h'; exact hd h'.symm
  have hak : a ∈ keptL L := kept_of_prefix hsucc (List.prefix_append a [1]) hane
  rw [fusible_eq_true_iff]
  refine ⟨(hkiff (a ++ [1])).mpr ⟨hsucc, hsucc_d⟩, ?_, ?_, ?_, ?_⟩
  · rw [List.dropLast_concat]; exact (hkiff a).mpr ⟨hak, hane_d⟩
  · rw [List.getLastD_concat]
  · intro c' hc' hpar
    rw [List.dropLast_concat] at hpar
    have hc'p := (hkiff c').mp hc'
    rcases honly c' hc'p.1 hpar with h | h
    · exact h
    · exact absurd h hc'p.2
  · rw [List.dropLast_concat]
    constructor
    · intro hm
      exact (hmem' a).mpr ⟨hlv.mp ((hmem' (a ++ [1])).mp hm).1, hane_d⟩
    · intro hm
      exact (hmem' (a ++ [1])).mpr ⟨hlv.mpr ((hmem' a).mp hm).1, hsucc_d⟩

end Coalesce

/-! ## §7⅜  T-mut, closed equations: the four rules as explicit table rewrites

Each §7¼ rule is promoted here to a closed-form `tableOf` equation in the
style of `tableOf_insert_extend`: the table after the mutation as an explicit
function of pre-mutation data (`headsList L`, `entryOfHead L`, `headOf L`,
`lenOf L`). New heads enter by sorted insertion (`mergeSort hLe`), removed
heads leave by `filter`, old entries keep their fields except the announced
`par` rehoming and `len` split/merge, and parent references are re-indexed by
`idxOf` into the new enumeration, itself closed, being the equation's own
head list. No stability or honesty hypothesis anywhere. -/

/-- `mergeSort hLe` of a `Nodup` list is strictly `hLt`-sorted. -/
theorem mergeSort_hLt_sorted {l : List (List ℕ)} (hnd : l.Nodup) :
    (l.mergeSort hLe).Pairwise (fun a b => hLt a b = true) := by
  have hle : (l.mergeSort hLe).Pairwise (fun a b => hLe a b = true) := by
    apply List.pairwise_mergeSort
    · intro a b c h1 h2
      exact hLe_trans h1 h2
    · intro a b
      exact hLe_total a b
  have hnd' : (l.mergeSort hLe).Nodup :=
    (List.mergeSort_perm l hLe).nodup_iff.mpr hnd
  refine (hle.and hnd').imp ?_
  rintro a b ⟨hab, hne⟩
  simp only [hLe, Bool.not_eq_true'] at hab
  rcases hLt_total hne with h | h
  · exact h
  · rw [h] at hab
    exact Bool.noConfusion hab

/-- `headsList`, characterized: any strictly sorted enumeration of the heads
IS the canonical head list. -/
theorem headsList_eq_of_iff {L' M : List (List ℕ)}
    (hM : M.Pairwise (fun a b => hLt a b = true))
    (hiff : ∀ c, isHead L' c = true ↔ c ∈ M) : headsList L' = M :=
  hLt_sorted_ext (sorted_headsList _) hM
    (fun c => by rw [mem_headsList]; exact hiff c)

/-- Run length via an explicit offset enumeration of the members. -/
theorem lenOf_eq_of_iff {L' : List (List ℕ)} {h : List ℕ} {n : ℕ}
    (hiff : ∀ c, (c ∈ keptL L' ∧ headOf L' c = h)
      ↔ ∃ k < n, c = h ++ List.replicate k 1) :
    lenOf L' h = n := by
  have hperm : (runMembers L' h).Perm
      ((List.range n).map (fun k => h ++ List.replicate k 1)) := by
    refine (List.perm_ext_iff_of_nodup ((nodup_keptL _).filter _) ?_).mpr ?_
    · refine List.Nodup.map_on ?_ List.nodup_range
      intro j₁ _ j₂ _ heq
      exact replicate_offset_inj heq
    · intro c
      show c ∈ runMembers L' h ↔ _
      rw [mem_runMembers, hiff c, List.mem_map]
      constructor
      · rintro ⟨k, hk, rfl⟩
        exact ⟨k, List.mem_range.mpr hk, rfl⟩
      · rintro ⟨k, hk, rfl⟩
        exact ⟨k, List.mem_range.mp hk, rfl⟩
  have := hperm.length_eq
  rw [lenOf, this, List.length_map, List.length_range]

/-! ### D5, closed: the directed vanished-anchor materialization

The directed D5 shape (`spot_d5_materialize`): the anchor `m` vanished while
its parent `m.dropLast` is a live, childless kept node. Delivering `m ++ [d]`
re-materializes `m` as a DEAD singleton entry plus the live `m ++ [d]`
singleton below it; every old entry keeps its fields, parent references
re-indexed. (The general vanished-PATH shape, a whole dead spine
re-materializing, splitting at non-`1` labels, plus a possible mid-run split
at the re-attachment point, is a genuine cascade: it is exactly the
composite of this rule applied once per vanished label with D1-shaped splits,
and does not admit a single closed equation.) -/

section MaterializeClosed

variable {L : List (List ℕ)} {m : List ℕ} {d : ℕ}
  (hnil : ([] : List ℕ) ∉ L)
  (hpar : m.dropLast ∈ L)
  (hchildless : ∀ e, m.dropLast ++ [e] ∉ keptL L)

include hnil hpar in
theorem mat_mne : m ≠ [] := by
  intro h
  rw [h] at hpar
  exact hnil hpar

include hnil hpar in
theorem mat_pne : m.dropLast ≠ [] := fun h => hnil (h ▸ hpar)

include hnil hpar hchildless in
theorem mat_vanished : m ∉ keptL L := by
  intro hk
  have := hchildless (m.getLastD 0)
  rw [← concat_getLastD (mat_mne hnil hpar)] at this
  exact this hk

include hnil hpar hchildless in
theorem mat_new_not_kept : m ++ [d] ∉ keptL L := by
  intro hk
  exact mat_vanished hnil hpar hchildless
    (kept_of_prefix hk (List.prefix_append m [d]) (mat_mne hnil hpar))

include hnil hpar hchildless in
theorem mat_kept_iff (x : List ℕ) :
    x ∈ keptL (L ++ [m ++ [d]]) ↔ x ∈ keptL L ∨ x = m ∨ x = m ++ [d] := by
  rw [mem_keptL_snoc]
  constructor
  · rintro (hx | ⟨hne, hp⟩)
    · exact Or.inl hx
    · by_cases hxd : x = m ++ [d]
      · exact Or.inr (Or.inr hxd)
      · have hxm : x <+: m := by
          have := prefix_dropLast_of_ne hp hxd
          rwa [List.dropLast_concat] at this
        by_cases hxm' : x = m
        · exact Or.inr (Or.inl hxm')
        · exact Or.inl (kept_of_prefix
            (kept_of_live hpar (mat_pne hnil hpar))
            (prefix_dropLast_of_ne hxm hxm') hne)
  · rintro (hx | h1 | h1)
    · exact Or.inl hx
    · rw [h1]
      exact Or.inr ⟨mat_mne hnil hpar, List.prefix_append m [d]⟩
    · rw [h1]
      exact Or.inr ⟨by simp, List.prefix_refl _⟩

include hnil hpar hchildless in
theorem mat_m_not_live : m ∉ L ++ [m ++ [d]] := by
  intro hx
  rcases List.mem_append.mp hx with hx | hx
  · exact mat_vanished hnil hpar hchildless
      (kept_of_live hx (mat_mne hnil hpar))
  · rw [List.mem_singleton] at hx
    have := congrArg List.length hx
    simp at this

include hnil hpar hchildless in
theorem mat_fusible_old {x : List ℕ} (hx : x ∈ keptL L) :
    fusible (L ++ [m ++ [d]]) x = fusible L x := by
  have hxm : x ≠ m := fun h =>
    mat_vanished hnil hpar hchildless (h ▸ hx)
  have hxd : x ≠ m ++ [d] := fun h =>
    mat_new_not_kept hnil hpar hchildless (h ▸ hx)
  have hdm : x.dropLast ≠ m := by
    intro h
    apply mat_vanished hnil hpar hchildless
    rw [← h]
    exact kept_of_prefix hx (List.dropLast_prefix x)
      (by rw [h]; exact mat_mne hnil hpar)
  have hdd : x.dropLast ≠ m ++ [d] := by
    intro h
    apply mat_new_not_kept hnil hpar hchildless
    rw [← h]
    exact kept_of_prefix hx (List.dropLast_prefix x) (by rw [h]; simp)
  have hkiff := mat_kept_iff (d := d) hnil hpar hchildless
  have hmemx : (x ∈ L ++ [m ++ [d]]) ↔ (x ∈ L) := by
    rw [List.mem_append, List.mem_singleton]
    exact ⟨fun h => h.resolve_right (fun h' => absurd h' hxd), Or.inl⟩
  have hmemd : (x.dropLast ∈ L ++ [m ++ [d]]) ↔ (x.dropLast ∈ L) := by
    rw [List.mem_append, List.mem_singleton]
    exact ⟨fun h => h.resolve_right (fun h' => absurd h' hdd), Or.inl⟩
  rw [Bool.eq_iff_iff, fusible_eq_true_iff, fusible_eq_true_iff]
  constructor
  · rintro ⟨h1, h2, h3, h4, h5⟩
    have hd : x.dropLast ∈ keptL L := by
      rcases (hkiff x.dropLast).mp h2 with h | h | h
      · exact h
      · exact absurd h hdm
      · exact absurd h hdd
    refine ⟨hx, hd, h3, ?_, ?_⟩
    · intro c' hc' hparc
      exact h4 c' ((hkiff c').mpr (Or.inl hc')) hparc
    · rw [← hmemx, ← hmemd]
      exact h5
  · rintro ⟨h1, h2, h3, h4, h5⟩
    refine ⟨(hkiff x).mpr (Or.inl hx),
      (hkiff x.dropLast).mpr (Or.inl h2), h3, ?_, ?_⟩
    · intro c' hc' hparc
      rcases (hkiff c').mp hc' with hc' | h1 | h1
      · exact h4 c' hc' hparc
      · exfalso
        rw [h1] at hparc
        apply hchildless (x.getLastD 0)
        rw [← child_of_parent_eq (kept_ne_nil hx) hparc.symm]
        exact hx
      · exfalso
        rw [h1, List.dropLast_concat] at hparc
        exact hdm hparc.symm
    · rw [hmemx, hmemd]
      exact h5

include hnil hpar hchildless in
theorem mat_fusible_m : fusible (L ++ [m ++ [d]]) m = false := by
  cases hf : fusible (L ++ [m ++ [d]]) m with
  | false => rfl
  | true =>
      exfalso
      have hlv := fusible_live hf
      exact mat_m_not_live hnil hpar hchildless
        (hlv.mpr (List.mem_append_left _ hpar))

include hnil hpar hchildless in
theorem mat_fusible_new : fusible (L ++ [m ++ [d]]) (m ++ [d]) = false := by
  cases hf : fusible (L ++ [m ++ [d]]) (m ++ [d]) with
  | false => rfl
  | true =>
      exfalso
      have hlv := fusible_live hf
      rw [List.dropLast_concat] at hlv
      exact mat_m_not_live hnil hpar hchildless
        (hlv.mp (List.mem_append_right _ (by simp)))

include hnil hpar hchildless in
theorem mat_isHead_iff (c : List ℕ) :
    isHead (L ++ [m ++ [d]]) c = true
      ↔ (isHead L c = true ∨ c = m ∨ c = m ++ [d]) := by
  constructor
  · intro h
    rcases (mat_kept_iff hnil hpar hchildless c).mp (isHead_kept h)
      with hc | h1 | h1
    · left
      refine isHead_of_kept_not_fusible hc ?_
      rw [← mat_fusible_old hnil hpar hchildless hc]
      exact isHead_not_fusible h
    · exact Or.inr (Or.inl h1)
    · exact Or.inr (Or.inr h1)
  · rintro (h | h1 | h1)
    · exact isHead_of_kept_not_fusible
        ((mat_kept_iff hnil hpar hchildless c).mpr (Or.inl (isHead_kept h)))
        (by rw [mat_fusible_old hnil hpar hchildless (isHead_kept h)]
            exact isHead_not_fusible h)
    · rw [h1]
      exact isHead_of_kept_not_fusible
        ((mat_kept_iff hnil hpar hchildless m).mpr (Or.inr (Or.inl rfl)))
        (mat_fusible_m hnil hpar hchildless)
    · rw [h1]
      exact isHead_of_kept_not_fusible
        ((mat_kept_iff hnil hpar hchildless _).mpr (Or.inr (Or.inr rfl)))
        (mat_fusible_new hnil hpar hchildless)

include hnil hpar hchildless in
theorem mat_headOf_old : ∀ (c : List ℕ), c ∈ keptL L →
    headOf (L ++ [m ++ [d]]) c = headOf L c := by
  intro c
  fun_induction headOf L c with
  | case1 c hf ih =>
      intro hk
      have hf' : fusible (L ++ [m ++ [d]]) c = true := by
        rw [mat_fusible_old hnil hpar hchildless hk]
        exact hf
      rw [headOf_of_fusible hf']
      exact ih (fusible_parent_kept hf)
  | case2 c hf =>
      intro hk
      have hf' : fusible (L ++ [m ++ [d]]) c = false := by
        rw [mat_fusible_old hnil hpar hchildless hk]
        exact Bool.eq_false_iff.mpr hf
      exact headOf_of_not_fusible hf'

include hnil hpar hchildless in
theorem mat_headOf_m : headOf (L ++ [m ++ [d]]) m = m :=
  headOf_of_not_fusible (mat_fusible_m hnil hpar hchildless)

include hnil hpar hchildless in
theorem mat_headOf_new : headOf (L ++ [m ++ [d]]) (m ++ [d]) = m ++ [d] :=
  headOf_of_not_fusible (mat_fusible_new hnil hpar hchildless)

include hnil hpar hchildless in
theorem mat_lenOf_old {h : List ℕ} (hh : isHead L h = true) :
    lenOf (L ++ [m ++ [d]]) h = lenOf L h := by
  rw [lenOf, lenOf, runMembers, runMembers]
  have hiff : ∀ c, (c ∈ keptL (L ++ [m ++ [d]])
        ∧ headOf (L ++ [m ++ [d]]) c = h)
      ↔ (c ∈ keptL L ∧ headOf L c = h) := by
    intro c
    constructor
    · rintro ⟨hk, hhd⟩
      rcases (mat_kept_iff hnil hpar hchildless c).mp hk with hc | h1 | h1
      · exact ⟨hc, by
          rw [← mat_headOf_old hnil hpar hchildless c hc]; exact hhd⟩
      · exfalso
        rw [h1, mat_headOf_m hnil hpar hchildless] at hhd
        apply mat_vanished hnil hpar hchildless
        rw [hhd]
        exact isHead_kept hh
      · exfalso
        rw [h1, mat_headOf_new hnil hpar hchildless] at hhd
        apply mat_new_not_kept hnil hpar hchildless
        rw [hhd]
        exact isHead_kept hh
    · rintro ⟨hk, hhd⟩
      exact ⟨(mat_kept_iff hnil hpar hchildless c).mpr (Or.inl hk), by
        rw [mat_headOf_old hnil hpar hchildless c hk]; exact hhd⟩
  have hperm : ((keptL (L ++ [m ++ [d]])).filter
        (fun c => headOf (L ++ [m ++ [d]]) c == h)).Perm
      ((keptL L).filter (fun c => headOf L c == h)) := by
    refine (List.perm_ext_iff_of_nodup ((nodup_keptL _).filter _)
      ((nodup_keptL _).filter _)).mpr ?_
    intro c
    simp only [List.mem_filter, beq_iff_eq]
    exact hiff c
  exact hperm.length_eq

include hnil hpar hchildless in
theorem mat_lenOf_m : lenOf (L ++ [m ++ [d]]) m = 1 := by
  refine lenOf_eq_of_iff ?_
  intro c
  constructor
  · rintro ⟨hk, hhd⟩
    refine ⟨0, by omega, ?_⟩
    simp only [List.replicate_zero, List.append_nil]
    rcases (mat_kept_iff hnil hpar hchildless c).mp hk with hc | h1 | h1
    · exfalso
      rw [mat_headOf_old hnil hpar hchildless c hc] at hhd
      apply mat_vanished hnil hpar hchildless
      rw [← hhd]
      exact headOf_kept hc
    · exact h1
    · exfalso
      rw [h1, mat_headOf_new hnil hpar hchildless] at hhd
      have := congrArg List.length hhd
      simp at this
  · rintro ⟨k, hk, rfl⟩
    have : k = 0 := by omega
    subst this
    simp only [List.replicate_zero, List.append_nil]
    exact ⟨(mat_kept_iff hnil hpar hchildless m).mpr (Or.inr (Or.inl rfl)),
      mat_headOf_m hnil hpar hchildless⟩

include hnil hpar hchildless in
theorem mat_lenOf_new : lenOf (L ++ [m ++ [d]]) (m ++ [d]) = 1 := by
  refine lenOf_eq_of_iff ?_
  intro c
  constructor
  · rintro ⟨hk, hhd⟩
    refine ⟨0, by omega, ?_⟩
    simp only [List.replicate_zero, List.append_nil]
    rcases (mat_kept_iff hnil hpar hchildless c).mp hk with hc | h1 | h1
    · exfalso
      rw [mat_headOf_old hnil hpar hchildless c hc] at hhd
      apply mat_new_not_kept hnil hpar hchildless
      rw [← hhd]
      exact headOf_kept hc
    · exfalso
      rw [h1, mat_headOf_m hnil hpar hchildless] at hhd
      have := congrArg List.length hhd
      simp at this
    · exact h1
  · rintro ⟨k, hk, rfl⟩
    have : k = 0 := by omega
    subst this
    simp only [List.replicate_zero, List.append_nil]
    exact ⟨(mat_kept_iff hnil hpar hchildless _).mpr (Or.inr (Or.inr rfl)),
      mat_headOf_new hnil hpar hchildless⟩

include hnil hpar hchildless in
theorem mat_headsList :
    headsList (L ++ [m ++ [d]])
      = (headsList L ++ [m, m ++ [d]]).mergeSort hLe := by
  refine headsList_eq_of_iff (mergeSort_hLt_sorted ?_) ?_
  · rw [List.nodup_append]
    refine ⟨nodup_headsList L, ?_, ?_⟩
    · refine List.nodup_cons.mpr ⟨?_, List.nodup_singleton _⟩
      rw [List.mem_singleton]
      intro h
      have := congrArg List.length h
      simp at this
    · intro x hx y hy heq
      have hxk : x ∈ keptL L := isHead_kept (mem_headsList.mp hx)
      rcases List.mem_cons.mp hy with h1 | h1
      · rw [heq, h1] at hxk
        exact mat_vanished hnil hpar hchildless hxk
      · rw [List.mem_singleton] at h1
        rw [heq, h1] at hxk
        exact mat_new_not_kept hnil hpar hchildless hxk
  · intro c
    rw [mat_isHead_iff hnil hpar hchildless c, List.mem_mergeSort,
      List.mem_append, mem_headsList]
    simp only [List.mem_cons, List.not_mem_nil, or_false]

include hnil hpar hchildless in
/-- **D5, closed (directed materialization)**: delivering `m ++ [d]` under
the vanished anchor `m` (live childless parent) re-canonicalizes to the old
table with TWO singleton entries inserted at their sorted head positions,
the DEAD materialized anchor `m` and the live record below it, and parent
references re-indexed. A closed equation: every field on the right is
pre-mutation data. -/
theorem tableOf_materialize :
    tableOf (L ++ [m ++ [d]])
      = ((headsList L ++ [m, m ++ [d]]).mergeSort hLe).map (fun h =>
          if h = m then
            ⟨some (((headsList L ++ [m, m ++ [d]]).mergeSort hLe).idxOf
                     (headOf L m.dropLast),
                   m.dropLast.length - (headOf L m.dropLast).length),
             false, m.getLastD 0, 1⟩
          else if h = m ++ [d] then
            ⟨some (((headsList L ++ [m, m ++ [d]]).mergeSort hLe).idxOf m, 0),
             true, d, 1⟩
          else if h.dropLast ∈ keptL L then
            { entryOfHead L h with
              par := some (((headsList L ++ [m, m ++ [d]]).mergeSort hLe).idxOf
                             (headOf L h.dropLast),
                           h.dropLast.length - (headOf L h.dropLast).length) }
          else entryOfHead L h) := by
  rw [tableOf, mat_headsList hnil hpar hchildless]
  refine List.map_congr_left ?_
  intro h hh
  rw [List.mem_mergeSort, List.mem_append] at hh
  by_cases hm : h = m
  · subst hm
    rw [if_pos rfl]
    have hdk : h.dropLast ∈ keptL L :=
      kept_of_live hpar (mat_pne hnil hpar)
    rw [entryOfHead,
      if_pos ((mat_kept_iff hnil hpar hchildless _).mpr (Or.inl hdk)),
      mat_headsList hnil hpar hchildless,
      mat_headOf_old hnil hpar hchildless _ hdk]
    refine RTEntry.ext' rfl ?_ rfl ?_
    · exact decide_eq_false (mat_m_not_live hnil hpar hchildless)
    · exact mat_lenOf_m hnil hpar hchildless
  · by_cases hmd : h = m ++ [d]
    · subst hmd
      rw [if_neg hm, if_pos rfl]
      have hdk : (m ++ [d]).dropLast ∈ keptL (L ++ [m ++ [d]]) := by
        rw [List.dropLast_concat]
        exact (mat_kept_iff hnil hpar hchildless m).mpr (Or.inr (Or.inl rfl))
      rw [entryOfHead, if_pos hdk, mat_headsList hnil hpar hchildless]
      have hho : headOf (L ++ [m ++ [d]]) (m ++ [d]).dropLast = m := by
        rw [List.dropLast_concat]
        exact mat_headOf_m hnil hpar hchildless
      rw [hho]
      refine RTEntry.ext' ?_ ?_ ?_ ?_
      · show some (_, (m ++ [d]).dropLast.length - m.length) = some (_, 0)
        rw [List.dropLast_concat]
        simp
      · show decide (m ++ [d] ∈ L ++ [m ++ [d]]) = true
        exact decide_eq_true (List.mem_append_right _ (by simp))
      · show (m ++ [d]).getLastD 0 = d
        rw [List.getLastD_concat]
      · exact mat_lenOf_new hnil hpar hchildless
    · rw [if_neg hm, if_neg hmd]
      have hhL : isHead L h = true := by
        rcases hh with hh | hh
        · exact mem_headsList.mp hh
        · exfalso
          rcases List.mem_cons.mp hh with h1 | h1
          · exact hm h1
          · rw [List.mem_singleton] at h1
            exact hmd h1
      have hkh : h ∈ keptL L := isHead_kept hhL
      have hne_d : h ≠ m ++ [d] := hmd
      have hdm : h.dropLast ≠ m := by
        intro heq
        apply mat_vanished hnil hpar hchildless
        rw [← heq]
        exact kept_of_prefix hkh (List.dropLast_prefix h)
          (by rw [heq]; exact mat_mne hnil hpar)
      have hdd : h.dropLast ≠ m ++ [d] := by
        intro heq
        apply mat_new_not_kept hnil hpar hchildless
        rw [← heq]
        exact kept_of_prefix hkh (List.dropLast_prefix h) (by rw [heq]; simp)
      have hlive : decide (h ∈ L ++ [m ++ [d]]) = decide (h ∈ L) := by
        refine decide_eq_decide.mpr ?_
        rw [List.mem_append, List.mem_singleton]
        exact ⟨fun h' => h'.resolve_right (fun h'' => absurd h'' hne_d),
          Or.inl⟩
      have hkd : h.dropLast ∈ keptL (L ++ [m ++ [d]])
          ↔ h.dropLast ∈ keptL L := by
        rw [mat_kept_iff hnil hpar hchildless]
        exact ⟨fun hor => (hor.resolve_right (fun h' =>
          h'.elim (fun h'' => absurd h'' hdm) (fun h'' => absurd h'' hdd))),
          Or.inl⟩
      by_cases hdk : h.dropLast ∈ keptL L
      · rw [if_pos hdk, entryOfHead, if_pos (hkd.mpr hdk),
          mat_headsList hnil hpar hchildless,
          mat_headOf_old hnil hpar hchildless _ hdk]
        refine RTEntry.ext' rfl ?_ ?_ ?_
        · show decide (h ∈ L ++ [m ++ [d]]) = (entryOfHead L h).live
          rw [hlive]
          rfl
        · rfl
        · show lenOf (L ++ [m ++ [d]]) h = (entryOfHead L h).len
          rw [mat_lenOf_old hnil hpar hchildless hhL]
          rfl
      · rw [if_neg hdk, entryOfHead, entryOfHead,
          if_neg (fun h' => hdk (hkd.mp h')), if_neg hdk]
        refine RTEntry.ext' rfl ?_ rfl ?_
        · rw [hlive]
        · exact mat_lenOf_old hnil hpar hchildless hhL

end MaterializeClosed

/-- Padding monotonicity: more `1`s extend fewer. -/
theorem replicate_pad_prefix {g : List ℕ} {i k : ℕ} (h : i ≤ k) :
    g ++ List.replicate i 1 <+: g ++ List.replicate k 1 := by
  refine ⟨List.replicate (k - i) 1, ?_⟩
  rw [List.append_assoc, ← List.replicate_add]
  congr 2
  omega

theorem replicate_pad_prefix_le {g : List ℕ} {i k : ℕ}
    (h : g ++ List.replicate i 1 <+: g ++ List.replicate k 1) : i ≤ k := by
  have := h.length_le
  simp only [List.length_append, List.length_replicate] at this
  omega

/-! ### D1, closed: the mid-run split

The D1 shape (`spot_d1_split`): a fresh chain `a ++ [d]` lands at an anchor
`a` whose run successor `a ++ [1]` is fused (`a` is interior or the pre-tail
of its run). The run carrying `a` splits in three: the `a`-prefix keeps the
old head with `len` cut to `a`'s offset + 1, the suffix re-heads at `a ++ [1]`
(and every entry that attached at the old tail REHOMES to it), and `a ++ [d]`
is a fresh singleton. `d ≠ 1` is forced by freshness, not assumed. -/

section MidRunSplitClosed

variable {L : List (List ℕ)} {a : List ℕ} {d : ℕ}
  (hfs : fusible L (a ++ [1]) = true)
  (hfresh : a ++ [d] ∉ keptL L)

include hfs in
theorem splitc_anchor_kept : a ∈ keptL L := by
  have := fusible_parent_kept hfs
  rwa [List.dropLast_concat] at this

include hfs hfresh in
theorem splitc_d_ne_one : d ≠ 1 := fun h => hfresh (h ▸ fusible_kept hfs)

include hfs in
theorem splitc_succ_headOf : headOf L (a ++ [1]) = headOf L a := by
  rw [headOf_of_fusible hfs, List.dropLast_concat]

include hfs in
theorem splitc_succ_pad :
    a ++ [1] = headOf L a
      ++ List.replicate (a.length - (headOf L a).length + 1) 1 := by
  have hform : a = headOf L a
      ++ List.replicate (a.length - (headOf L a).length) 1 :=
    runMember_form (mem_runMembers.mpr ⟨splitc_anchor_kept hfs, rfl⟩)
  conv_lhs => rw [hform]
  rw [List.append_assoc, ← List.replicate_succ']

include hfs in
theorem splitc_succ_offset_lt :
    a.length - (headOf L a).length + 1 < lenOf L (headOf L a) := by
  have hmem : a ++ [1] ∈ runMembers L (headOf L a) :=
    mem_runMembers.mpr ⟨fusible_kept hfs, splitc_succ_headOf hfs⟩
  rw [splitc_succ_pad hfs] at hmem
  exact runMember_offset_lt hmem

include hfs hfresh in
theorem splitc_kept_iff (x : List ℕ) :
    x ∈ keptL (L ++ [a ++ [d]]) ↔ x ∈ keptL L ∨ x = a ++ [d] := by
  rw [mem_keptL_snoc]
  constructor
  · rintro (hx | ⟨hne, hp⟩)
    · exact Or.inl hx
    · by_cases hxd : x = a ++ [d]
      · exact Or.inr hxd
      · have hxa : x <+: a := by
          have := prefix_dropLast_of_ne hp hxd
          rwa [List.dropLast_concat] at this
        exact Or.inl (kept_of_prefix (splitc_anchor_kept hfs) hxa hne)
  · rintro (hx | h1)
    · exact Or.inl hx
    · rw [h1]
      exact Or.inr ⟨by simp, List.prefix_refl _⟩

include hfs hfresh in
theorem splitc_fusible_old {x : List ℕ} (hx : x ∈ keptL L)
    (hxs : x ≠ a ++ [1]) :
    fusible (L ++ [a ++ [d]]) x = fusible L x := by
  have hxd : x ≠ a ++ [d] := fun h => hfresh (h ▸ hx)
  have hdd : x.dropLast ≠ a ++ [d] := by
    intro h
    apply hfresh
    rw [← h]
    exact kept_of_prefix hx (List.dropLast_prefix x) (by rw [h]; simp)
  have hkiff := splitc_kept_iff (d := d) hfs hfresh
  have hmemx : (x ∈ L ++ [a ++ [d]]) ↔ (x ∈ L) := by
    rw [List.mem_append, List.mem_singleton]
    exact ⟨fun h => h.resolve_right (fun h' => absurd h' hxd), Or.inl⟩
  have hmemd : (x.dropLast ∈ L ++ [a ++ [d]]) ↔ (x.dropLast ∈ L) := by
    rw [List.mem_append, List.mem_singleton]
    exact ⟨fun h => h.resolve_right (fun h' => absurd h' hdd), Or.inl⟩
  rw [Bool.eq_iff_iff, fusible_eq_true_iff, fusible_eq_true_iff]
  constructor
  · rintro ⟨h1, h2, h3, h4, h5⟩
    have hd2 : x.dropLast ∈ keptL L := by
      rcases (hkiff x.dropLast).mp h2 with h | h
      · exact h
      · exact absurd h hdd
    refine ⟨hx, hd2, h3, ?_, ?_⟩
    · intro c' hc' hparc
      exact h4 c' ((hkiff c').mpr (Or.inl hc')) hparc
    · rw [← hmemx, ← hmemd]
      exact h5
  · rintro ⟨h1, h2, h3, h4, h5⟩
    refine ⟨(hkiff x).mpr (Or.inl hx),
      (hkiff x.dropLast).mpr (Or.inl h2), h3, ?_, ?_⟩
    · intro c' hc' hparc
      rcases (hkiff c').mp hc' with hc' | h1'
      · exact h4 c' hc' hparc
      · exfalso
        rw [h1', List.dropLast_concat] at hparc
        -- x is a kept child of `a`, so by `hfs`-uniqueness x = a ++ [1]
        exact hxs (fusible_unique hfs hx
          (by rw [List.dropLast_concat]; exact hparc.symm))
    · rw [hmemx, hmemd]
      exact h5

include hfs hfresh in
theorem splitc_fusible_succ :
    fusible (L ++ [a ++ [d]]) (a ++ [1]) = false :=
  isHead_not_fusible
    (split_succ_isHead (fusible_kept hfs) (splitc_d_ne_one hfs hfresh))

include hfs hfresh in
theorem splitc_fusible_new :
    fusible (L ++ [a ++ [d]]) (a ++ [d]) = false :=
  isHead_not_fusible (split_new_isHead (splitc_d_ne_one hfs hfresh))

include hfs hfresh in
theorem splitc_isHead_iff (c : List ℕ) :
    isHead (L ++ [a ++ [d]]) c = true
      ↔ (isHead L c = true ∨ c = a ++ [1] ∨ c = a ++ [d]) := by
  constructor
  · intro h
    rcases (splitc_kept_iff hfs hfresh c).mp (isHead_kept h) with hc | h1
    · by_cases hcs : c = a ++ [1]
      · exact Or.inr (Or.inl hcs)
      · left
        refine isHead_of_kept_not_fusible hc ?_
        rw [← splitc_fusible_old hfs hfresh hc hcs]
        exact isHead_not_fusible h
    · exact Or.inr (Or.inr h1)
  · rintro (h | h1 | h1)
    · have hcs : c ≠ a ++ [1] := by
        intro heq
        rw [heq] at h
        rw [isHead_eq_false_of_fusible hfs] at h
        exact Bool.noConfusion h
      exact isHead_of_kept_not_fusible
        ((splitc_kept_iff hfs hfresh c).mpr (Or.inl (isHead_kept h)))
        (by rw [splitc_fusible_old hfs hfresh (isHead_kept h) hcs]
            exact isHead_not_fusible h)
    · rw [h1]
      exact split_succ_isHead (fusible_kept hfs) (splitc_d_ne_one hfs hfresh)
    · rw [h1]
      exact split_new_isHead (splitc_d_ne_one hfs hfresh)

include hfs hfresh in
theorem splitc_headOf_old : ∀ (c : List ℕ), c ∈ keptL L →
    ¬(a ++ [1] <+: c ∧ headOf L c = headOf L a) →
    headOf (L ++ [a ++ [d]]) c = headOf L c := by
  intro c
  fun_induction headOf L c with
  | case1 c hf ih =>
      intro hk hinv
      have hcne : c ≠ a ++ [1] := by
        rintro rfl
        exact hinv ⟨List.prefix_refl _, by rw [List.dropLast_concat]⟩
      have hf' : fusible (L ++ [a ++ [d]]) c = true := by
        rw [splitc_fusible_old hfs hfresh hk hcne]
        exact hf
      rw [headOf_of_fusible hf']
      refine ih (fusible_parent_kept hf) ?_
      rintro ⟨hpre, hhd⟩
      exact hinv ⟨hpre.trans (List.dropLast_prefix c), hhd⟩
  | case2 c hf =>
      intro hk hinv
      have hcne : c ≠ a ++ [1] := by
        rintro rfl
        exact hf hfs
      have hf' : fusible (L ++ [a ++ [d]]) c = false := by
        rw [splitc_fusible_old hfs hfresh hk hcne]
        exact Bool.eq_false_iff.mpr hf
      exact headOf_of_not_fusible hf'

include hfs hfresh in
theorem splitc_headOf_new :
    headOf (L ++ [a ++ [d]]) (a ++ [d]) = a ++ [d] :=
  headOf_of_not_fusible (splitc_fusible_new hfs hfresh)

include hfs hfresh in
theorem splitc_headOf_ge : ∀ k,
    a.length - (headOf L a).length + 1 ≤ k → k < lenOf L (headOf L a) →
    headOf (L ++ [a ++ [d]]) (headOf L a ++ List.replicate k 1)
      = a ++ [1] := by
  intro k
  induction k with
  | zero =>
      intro h1 _
      omega
  | succ k ih =>
      intro h1 h2
      by_cases hk : k + 1 = a.length - (headOf L a).length + 1
      · rw [hk, ← splitc_succ_pad hfs]
        exact headOf_of_not_fusible (splitc_fusible_succ hfs hfresh)
      · have hg : isHead L (headOf L a) = true :=
          headOf_isHead (splitc_anchor_kept hfs)
        have hmem : headOf L a ++ List.replicate (k + 1) 1
            ∈ runMembers L (headOf L a) := runMember_of_lt hg h2
        have hfusL := runMember_fusible hmem
        have hne : headOf L a ++ List.replicate (k + 1) 1 ≠ a ++ [1] := by
          rw [splitc_succ_pad hfs]
          intro heq
          exact hk (replicate_offset_inj heq)
        have hfus' : fusible (L ++ [a ++ [d]])
            (headOf L a ++ List.replicate (k + 1) 1) = true := by
          rw [splitc_fusible_old hfs hfresh (mem_runMembers.mp hmem).1 hne]
          exact hfusL
        rw [headOf_of_fusible hfus', dropLast_append_replicate_succ]
        exact ih (by omega) (by omega)

include hfs hfresh in
/-- Classify an old kept chain's new run head by its position relative to the
split: members of the anchor's run at or past the successor re-head at
`a ++ [1]`, everything else keeps its head. -/
theorem splitc_headOf_classify {c : List ℕ} (hc : c ∈ keptL L) :
    (headOf L c = headOf L a ∧ a ++ [1] <+: c
      ∧ headOf (L ++ [a ++ [d]]) c = a ++ [1])
    ∨ (¬(a ++ [1] <+: c ∧ headOf L c = headOf L a)
      ∧ headOf (L ++ [a ++ [d]]) c = headOf L c) := by
  by_cases hcase : a ++ [1] <+: c ∧ headOf L c = headOf L a
  · obtain ⟨hpre, hhd⟩ := hcase
    have hmem : c ∈ runMembers L (headOf L a) := mem_runMembers.mpr ⟨hc, hhd⟩
    have hform := runMember_form hmem
    have hoff : a.length - (headOf L a).length + 1
        ≤ c.length - (headOf L a).length := by
      have := hpre.length_le
      have h1 := congrArg List.length (splitc_succ_pad hfs)
      simp only [List.length_append, List.length_cons, List.length_nil,
        List.length_replicate] at h1 this ⊢
      omega
    have hlt : c.length - (headOf L a).length < lenOf L (headOf L a) :=
      runMember_offset_lt (hform ▸ hmem)
    refine Or.inl ⟨hhd, hpre, ?_⟩
    conv_lhs => rw [hform]
    exact splitc_headOf_ge hfs hfresh _ hoff hlt
  · exact Or.inr ⟨hcase, splitc_headOf_old hfs hfresh c hc hcase⟩

include hfs hfresh in
theorem splitc_lenOf_g :
    lenOf (L ++ [a ++ [d]]) (headOf L a)
      = a.length - (headOf L a).length + 1 := by
  have hg : isHead L (headOf L a) = true :=
    headOf_isHead (splitc_anchor_kept hfs)
  have hglen : headOf L a ≠ a ++ [1] := by
    intro heq
    have h1 := (headOf_prefix L a).length_le
    have h2 := congrArg List.length heq
    simp only [List.length_append, List.length_cons, List.length_nil] at h2
    omega
  refine lenOf_eq_of_iff ?_
  intro c
  constructor
  · rintro ⟨hk, hhd⟩
    rcases (splitc_kept_iff hfs hfresh c).mp hk with hc | h1
    · rcases splitc_headOf_classify hfs hfresh hc with
        ⟨hL, hpre, hnew⟩ | ⟨hninv, hnew⟩
      · exfalso
        rw [hnew] at hhd
        exact hglen hhd.symm
      · rw [hnew] at hhd
        have hmem : c ∈ runMembers L (headOf L a) :=
          mem_runMembers.mpr ⟨hc, hhd⟩
        have hform := runMember_form hmem
        refine ⟨c.length - (headOf L a).length, ?_, hform⟩
        by_contra hge
        apply hninv
        refine ⟨?_, hhd⟩
        rw [hform, splitc_succ_pad hfs]
        exact replicate_pad_prefix (by omega)
    · exfalso
      rw [h1, splitc_headOf_new hfs hfresh] at hhd
      apply hfresh
      rw [hhd]
      exact headOf_kept (splitc_anchor_kept hfs)
  · rintro ⟨k, hk, rfl⟩
    have hklt : k < lenOf L (headOf L a) := by
      have := splitc_succ_offset_lt hfs
      omega
    have hmem : headOf L a ++ List.replicate k 1
        ∈ runMembers L (headOf L a) := runMember_of_lt hg hklt
    have hnpre : ¬(a ++ [1] <+: headOf L a ++ List.replicate k 1
        ∧ headOf L (headOf L a ++ List.replicate k 1) = headOf L a) := by
      rintro ⟨hpre, -⟩
      rw [splitc_succ_pad hfs] at hpre
      have := replicate_pad_prefix_le hpre
      omega
    refine ⟨(splitc_kept_iff hfs hfresh _).mpr
        (Or.inl (mem_runMembers.mp hmem).1), ?_⟩
    rw [splitc_headOf_old hfs hfresh _ (mem_runMembers.mp hmem).1 hnpre]
    exact (mem_runMembers.mp hmem).2

include hfs hfresh in
theorem splitc_lenOf_succ :
    lenOf (L ++ [a ++ [d]]) (a ++ [1])
      = lenOf L (headOf L a) - (a.length - (headOf L a).length) - 1 := by
  have hg : isHead L (headOf L a) = true :=
    headOf_isHead (splitc_anchor_kept hfs)
  refine lenOf_eq_of_iff ?_
  intro c
  constructor
  · rintro ⟨hk, hhd⟩
    rcases (splitc_kept_iff hfs hfresh c).mp hk with hc | h1
    · rcases splitc_headOf_classify hfs hfresh hc with
        ⟨hL, hpre, hnew⟩ | ⟨hninv, hnew⟩
      · have hmem : c ∈ runMembers L (headOf L a) :=
          mem_runMembers.mpr ⟨hc, hL⟩
        have hform := runMember_form hmem
        have hlt : c.length - (headOf L a).length < lenOf L (headOf L a) :=
          runMember_offset_lt (hform ▸ hmem)
        have hge : a.length - (headOf L a).length + 1
            ≤ c.length - (headOf L a).length := by
          rw [hform, splitc_succ_pad hfs] at hpre
          exact replicate_pad_prefix_le hpre
        refine ⟨c.length - (headOf L a).length
            - (a.length - (headOf L a).length) - 1, by omega, ?_⟩
        rw [splitc_succ_pad hfs, List.append_assoc, ← List.replicate_add]
        conv_lhs => rw [hform]
        congr 2
        omega
      · exfalso
        rw [hnew] at hhd
        have := headOf_isHead hc
        rw [hhd, isHead_eq_false_of_fusible hfs] at this
        exact Bool.noConfusion this
    · exfalso
      rw [h1, splitc_headOf_new hfs hfresh] at hhd
      have := List.append_cancel_left hhd
      injection this with h'
      exact splitc_d_ne_one hfs hfresh h'
  · rintro ⟨k, hk, rfl⟩
    have hpad : (a ++ [1]) ++ List.replicate k 1
        = headOf L a ++ List.replicate
            (a.length - (headOf L a).length + 1 + k) 1 := by
      rw [splitc_succ_pad hfs, List.append_assoc, ← List.replicate_add]
    have hklt : a.length - (headOf L a).length + 1 + k
        < lenOf L (headOf L a) := by omega
    have hmem : headOf L a ++ List.replicate
        (a.length - (headOf L a).length + 1 + k) 1
        ∈ runMembers L (headOf L a) := runMember_of_lt hg hklt
    refine ⟨(splitc_kept_iff hfs hfresh _).mpr
        (Or.inl (by rw [hpad]; exact (mem_runMembers.mp hmem).1)), ?_⟩
    rw [hpad]
    exact splitc_headOf_ge hfs hfresh _ (by omega) hklt

include hfs hfresh in
theorem splitc_lenOf_new : lenOf (L ++ [a ++ [d]]) (a ++ [d]) = 1 := by
  refine lenOf_eq_of_iff ?_
  intro c
  constructor
  · rintro ⟨hk, hhd⟩
    refine ⟨0, by omega, ?_⟩
    simp only [List.replicate_zero, List.append_nil]
    rcases (splitc_kept_iff hfs hfresh c).mp hk with hc | h1
    · exfalso
      rcases splitc_headOf_classify hfs hfresh hc with
        ⟨hL, hpre, hnew⟩ | ⟨hninv, hnew⟩
      · rw [hnew] at hhd
        have := List.append_cancel_left hhd
        injection this with h'
        exact splitc_d_ne_one hfs hfresh h'.symm
      · rw [hnew] at hhd
        apply hfresh
        rw [← hhd]
        exact headOf_kept hc
    · exact h1
  · rintro ⟨k, hk, rfl⟩
    have : k = 0 := by omega
    subst this
    simp only [List.replicate_zero, List.append_nil]
    exact ⟨(splitc_kept_iff hfs hfresh _).mpr (Or.inr rfl),
      splitc_headOf_new hfs hfresh⟩

include hfs hfresh in
theorem splitc_lenOf_old {h : List ℕ} (hh : isHead L h = true)
    (hne1 : h ≠ headOf L a) :
    lenOf (L ++ [a ++ [d]]) h = lenOf L h := by
  rw [lenOf, lenOf, runMembers, runMembers]
  have hiff : ∀ c, (c ∈ keptL (L ++ [a ++ [d]])
        ∧ headOf (L ++ [a ++ [d]]) c = h)
      ↔ (c ∈ keptL L ∧ headOf L c = h) := by
    intro c
    constructor
    · rintro ⟨hk, hhd⟩
      rcases (splitc_kept_iff hfs hfresh c).mp hk with hc | h1
      · rcases splitc_headOf_classify hfs hfresh hc with
          ⟨hL, hpre, hnew⟩ | ⟨hninv, hnew⟩
        · exfalso
          rw [hnew] at hhd
          rw [← hhd, isHead_eq_false_of_fusible hfs] at hh
          exact Bool.noConfusion hh
        · rw [hnew] at hhd
          exact ⟨hc, hhd⟩
      · exfalso
        rw [h1, splitc_headOf_new hfs hfresh] at hhd
        apply hfresh
        rw [hhd]
        exact isHead_kept hh
    · rintro ⟨hk, hhd⟩
      have hninv : ¬(a ++ [1] <+: c ∧ headOf L c = headOf L a) := by
        rintro ⟨-, hg⟩
        exact hne1 (hhd ▸ hg ▸ rfl)
      exact ⟨(splitc_kept_iff hfs hfresh c).mpr (Or.inl hk),
        by rw [splitc_headOf_old hfs hfresh c hk hninv]; exact hhd⟩
  have hperm : ((keptL (L ++ [a ++ [d]])).filter
        (fun c => headOf (L ++ [a ++ [d]]) c == h)).Perm
      ((keptL L).filter (fun c => headOf L c == h)) := by
    refine (List.perm_ext_iff_of_nodup ((nodup_keptL _).filter _)
      ((nodup_keptL _).filter _)).mpr ?_
    intro c
    simp only [List.mem_filter, beq_iff_eq]
    exact hiff c
  exact hperm.length_eq

include hfs hfresh in
theorem splitc_headsList :
    headsList (L ++ [a ++ [d]])
      = (headsList L ++ [a ++ [1], a ++ [d]]).mergeSort hLe := by
  refine headsList_eq_of_iff (mergeSort_hLt_sorted ?_) ?_
  · rw [List.nodup_append]
    refine ⟨nodup_headsList L, ?_, ?_⟩
    · refine List.nodup_cons.mpr ⟨?_, List.nodup_singleton _⟩
      rw [List.mem_singleton]
      intro heq
      have := List.append_cancel_left heq
      injection this with h'
      exact splitc_d_ne_one hfs hfresh h'.symm
    · intro x hx y hy heq
      have hxh : isHead L x = true := mem_headsList.mp hx
      rcases List.mem_cons.mp hy with h1 | h1
      · rw [heq, h1, isHead_eq_false_of_fusible hfs] at hxh
        exact Bool.noConfusion hxh
      · rw [List.mem_singleton] at h1
        rw [heq, h1] at hxh
        exact hfresh (isHead_kept hxh)
  · intro c
    rw [splitc_isHead_iff hfs hfresh c, List.mem_mergeSort,
      List.mem_append, mem_headsList]
    simp only [List.mem_cons, List.not_mem_nil, or_false]

include hfs hfresh in
/-- **D1, closed (the mid-run split)**: delivering the fresh `a ++ [d]` at an
anchor whose run successor is fused re-canonicalizes to the old table with
the anchor's run CUT at the anchor (`len` becomes offset + 1), TWO new
entries inserted at their sorted positions, the re-headed suffix `a ++ [1]`
and the `a ++ [d]` singleton, both attached at the anchor, and every entry
that attached at the old tail REHOMED to the suffix entry. All right-hand
data is pre-mutation. -/
theorem tableOf_insert_split :
    tableOf (L ++ [a ++ [d]])
      = ((headsList L ++ [a ++ [1], a ++ [d]]).mergeSort hLe).map (fun h =>
          if h = a ++ [1] then
            ⟨some (((headsList L ++ [a ++ [1], a ++ [d]]).mergeSort hLe).idxOf
                     (headOf L a),
                   a.length - (headOf L a).length),
             decide (a ++ [1] ∈ L), 1,
             lenOf L (headOf L a) - (a.length - (headOf L a).length) - 1⟩
          else if h = a ++ [d] then
            ⟨some (((headsList L ++ [a ++ [1], a ++ [d]]).mergeSort hLe).idxOf
                     (headOf L a),
                   a.length - (headOf L a).length),
             true, d, 1⟩
          else
            { entryOfHead L h with
              par := (entryOfHead L h).par.map (fun pr =>
                if headOf L h.dropLast = headOf L a
                then (((headsList L
                          ++ [a ++ [1], a ++ [d]]).mergeSort hLe).idxOf
                        (a ++ [1]),
                      h.dropLast.length - (a.length + 1))
                else (((headsList L
                          ++ [a ++ [1], a ++ [d]]).mergeSort hLe).idxOf
                        (headOf L h.dropLast), pr.2)),
              len := if h = headOf L a
                     then a.length - (headOf L a).length + 1
                     else (entryOfHead L h).len }) := by
  have hane : a ≠ [] := kept_ne_nil (splitc_anchor_kept hfs)
  have hsd : (a ++ [1] : List ℕ) ≠ a ++ [d] := by
    intro heq
    have := List.append_cancel_left heq
    injection this with h'
    exact splitc_d_ne_one hfs hfresh h'.symm
  rw [tableOf, splitc_headsList hfs hfresh]
  refine List.map_congr_left ?_
  intro h hh
  rw [List.mem_mergeSort, List.mem_append] at hh
  by_cases hs : h = a ++ [1]
  · rw [if_pos hs]
    subst hs
    have hdk : (a ++ [1]).dropLast ∈ keptL (L ++ [a ++ [d]]) := by
      rw [List.dropLast_concat]
      exact (splitc_kept_iff hfs hfresh a).mpr
        (Or.inl (splitc_anchor_kept hfs))
    rw [entryOfHead, if_pos hdk, splitc_headsList hfs hfresh]
    have hnpre : ¬(a ++ [1] <+: a ∧ headOf L a = headOf L a) := by
      rintro ⟨hpre, -⟩
      have := hpre.length_le
      simp at this
    have hho : headOf (L ++ [a ++ [d]]) (a ++ [1]).dropLast = headOf L a := by
      rw [List.dropLast_concat]
      exact splitc_headOf_old hfs hfresh a (splitc_anchor_kept hfs) hnpre
    rw [hho]
    refine RTEntry.ext' ?_ ?_ ?_ ?_
    · show some (_, (a ++ [1]).dropLast.length - (headOf L a).length)
        = some (_, a.length - (headOf L a).length)
      rw [List.dropLast_concat]
    · show decide (a ++ [1] ∈ L ++ [a ++ [d]]) = decide (a ++ [1] ∈ L)
      refine decide_eq_decide.mpr ?_
      rw [List.mem_append, List.mem_singleton]
      exact ⟨fun h' => h'.resolve_right (fun h'' => absurd h'' hsd), Or.inl⟩
    · show (a ++ [1]).getLastD 0 = 1
      rw [List.getLastD_concat]
    · exact splitc_lenOf_succ hfs hfresh
  · rw [if_neg hs]
    by_cases hd' : h = a ++ [d]
    · rw [if_pos hd']
      subst hd'
      have hdk : (a ++ [d]).dropLast ∈ keptL (L ++ [a ++ [d]]) := by
        rw [List.dropLast_concat]
        exact (splitc_kept_iff hfs hfresh a).mpr
          (Or.inl (splitc_anchor_kept hfs))
      rw [entryOfHead, if_pos hdk, splitc_headsList hfs hfresh]
      have hnpre : ¬(a ++ [1] <+: a ∧ headOf L a = headOf L a) := by
        rintro ⟨hpre, -⟩
        have := hpre.length_le
        simp at this
      have hho : headOf (L ++ [a ++ [d]]) (a ++ [d]).dropLast
          = headOf L a := by
        rw [List.dropLast_concat]
        exact splitc_headOf_old hfs hfresh a (splitc_anchor_kept hfs) hnpre
      rw [hho]
      refine RTEntry.ext' ?_ ?_ ?_ ?_
      · show some (_, (a ++ [d]).dropLast.length - (headOf L a).length)
          = some (_, a.length - (headOf L a).length)
        rw [List.dropLast_concat]
      · show decide (a ++ [d] ∈ L ++ [a ++ [d]]) = true
        exact decide_eq_true (List.mem_append_right _ (by simp))
      · show (a ++ [d]).getLastD 0 = d
        rw [List.getLastD_concat]
      · exact splitc_lenOf_new hfs hfresh
    · rw [if_neg hd']
      have hhL : isHead L h = true := by
        rcases hh with hh | hh
        · exact mem_headsList.mp hh
        · exfalso
          rcases List.mem_cons.mp hh with h1 | h1
          · exact hs h1
          · rw [List.mem_singleton] at h1
            exact hd' h1
      have hkh : h ∈ keptL L := isHead_kept hhL
      have hne_d : h ≠ a ++ [d] := hd'
      have hdd : h.dropLast ≠ a ++ [d] := by
        intro heq
        apply hfresh
        rw [← heq]
        exact kept_of_prefix hkh (List.dropLast_prefix h) (by rw [heq]; simp)
      have hlive : decide (h ∈ L ++ [a ++ [d]]) = decide (h ∈ L) := by
        refine decide_eq_decide.mpr ?_
        rw [List.mem_append, List.mem_singleton]
        exact ⟨fun h' => h'.resolve_right (fun h'' => absurd h'' hne_d),
          Or.inl⟩
      have hkd : h.dropLast ∈ keptL (L ++ [a ++ [d]])
          ↔ h.dropLast ∈ keptL L := by
        rw [splitc_kept_iff hfs hfresh]
        exact ⟨fun hor => hor.resolve_right (fun h' => absurd h' hdd),
          Or.inl⟩
      have hlen : lenOf (L ++ [a ++ [d]]) h
          = if h = headOf L a then a.length - (headOf L a).length + 1
            else lenOf L h := by
        by_cases hg : h = headOf L a
        · rw [if_pos hg, hg]
          exact splitc_lenOf_g hfs hfresh
        · rw [if_neg hg]
          exact splitc_lenOf_old hfs hfresh hhL hg
      by_cases hdk : h.dropLast ∈ keptL L
      · rw [entryOfHead, if_pos (hkd.mpr hdk), splitc_headsList hfs hfresh]
        have hph : isHead L (headOf L h.dropLast) = true := headOf_isHead hdk
        have htail := head_parent_is_tail hhL hdk
        by_cases hgg : headOf L h.dropLast = headOf L a
        · -- the parent run is the split run: the parent node is its old
          -- tail, which re-heads at `a ++ [1]`
          have hglen0 : 0 < lenOf L (headOf L a) :=
            lenOf_pos (headOf_isHead (splitc_anchor_kept hfs))
          have hoffl := splitc_succ_offset_lt hfs
          have hho : headOf (L ++ [a ++ [d]]) h.dropLast = a ++ [1] := by
            rw [htail, hgg, tailOf]
            exact splitc_headOf_ge hfs hfresh _ (by omega) (by omega)
          rw [hho]
          refine RTEntry.ext' ?_ ?_ ?_ ?_
          · dsimp only
            rw [entryOfHead, if_pos hdk]
            simp only [Option.map_some]
            rw [if_pos hgg]
            simp
          · show decide (h ∈ L ++ [a ++ [d]]) = (entryOfHead L h).live
            rw [hlive]
            rfl
          · rfl
          · show lenOf (L ++ [a ++ [d]]) h = _
            rw [hlen]
            by_cases hg : h = headOf L a
            · rw [if_pos hg, if_pos hg]
            · rw [if_neg hg, if_neg hg]
              rfl
        · have hninv : ¬(a ++ [1] <+: h.dropLast
              ∧ headOf L h.dropLast = headOf L a) := by
            rintro ⟨-, hgv⟩
            exact hgg hgv
          have hho : headOf (L ++ [a ++ [d]]) h.dropLast
              = headOf L h.dropLast :=
            splitc_headOf_old hfs hfresh h.dropLast hdk hninv
          rw [hho]
          refine RTEntry.ext' ?_ ?_ ?_ ?_
          · dsimp only
            rw [entryOfHead, if_pos hdk]
            simp only [Option.map_some]
            rw [if_neg hgg]
          · show decide (h ∈ L ++ [a ++ [d]]) = (entryOfHead L h).live
            rw [hlive]
            rfl
          · rfl
          · show lenOf (L ++ [a ++ [d]]) h = _
            rw [hlen]
            by_cases hg : h = headOf L a
            · rw [if_pos hg, if_pos hg]
            · rw [if_neg hg, if_neg hg]
              rfl
      · rw [entryOfHead, if_neg (fun h' => hdk (hkd.mp h'))]
        refine RTEntry.ext' ?_ ?_ ?_ ?_
        · rw [entryOfHead, if_neg hdk]
          rfl
        · show decide (h ∈ L ++ [a ++ [d]]) = (entryOfHead L h).live
          rw [hlive]
          rfl
        · rfl
        · show lenOf (L ++ [a ++ [d]]) h = _
          rw [hlen]
          by_cases hg : h = headOf L a
          · rw [if_pos hg, if_pos hg]
          · rw [if_neg hg, if_neg hg]
            rfl

end MidRunSplitClosed

/-! ### D2, closed: the interior delete liveness split

The D2 shape (`spot_d2_liveness_split`): delete a run-interior record `x`
(fused incoming edge, fused outgoing edge, so `x` is neither its run's head
nor its tail). The kept tree is unchanged; the run carrying `x` splits in
three at the liveness break: the live prefix keeps the old head with `len`
cut to `x`'s offset, `x` survives as a DEAD singleton entry, the live suffix
re-heads at `x ++ [1]` (and the entries attached at the old tail rehome to
it). The boundary shapes (`x` a run head, `x` the tail) split in two, not
three, and are the same construction with one empty side. -/

section DeleteLivenessClosed

variable {L L' : List (List ℕ)} {x : List ℕ}
  (hxl : x ∈ L)
  (hfx : fusible L x = true)
  (hfsucc : fusible L (x ++ [1]) = true)
  (hmem' : ∀ c, c ∈ L' ↔ (c ∈ L ∧ c ≠ x))

include hfx in
theorem dlc_x_kept : x ∈ keptL L := fusible_kept hfx

include hfx in
theorem dlc_x_pad :
    x = headOf L x ++ List.replicate (x.length - (headOf L x).length) 1 :=
  runMember_form (mem_runMembers.mpr ⟨dlc_x_kept hfx, rfl⟩)

include hfx in
theorem dlc_j_pos : 1 ≤ x.length - (headOf L x).length := by
  have h1 : headOf L x = headOf L x.dropLast := headOf_of_fusible hfx
  have h2 := (headOf_prefix L x.dropLast).length_le
  rw [← h1] at h2
  have h3 : 0 < x.length :=
    List.length_pos_iff.mpr (kept_ne_nil (dlc_x_kept hfx))
  rw [List.length_dropLast] at h2
  omega

include hfsucc in
theorem dlc_succ_headOf : headOf L (x ++ [1]) = headOf L x := by
  rw [headOf_of_fusible hfsucc, List.dropLast_concat]

include hfx hfsucc in
theorem dlc_succ_pad :
    x ++ [1] = headOf L x
      ++ List.replicate (x.length - (headOf L x).length + 1) 1 := by
  conv_lhs => rw [dlc_x_pad hfx]
  rw [List.append_assoc, ← List.replicate_succ']

include hfx hfsucc in
theorem dlc_succ_offset_lt :
    x.length - (headOf L x).length + 1 < lenOf L (headOf L x) := by
  have hmem : x ++ [1] ∈ runMembers L (headOf L x) :=
    mem_runMembers.mpr ⟨fusible_kept hfsucc, dlc_succ_headOf hfsucc⟩
  rw [dlc_succ_pad hfx hfsucc] at hmem
  exact runMember_offset_lt hmem

include hfx hxl in
theorem dlc_g_live : headOf L x ∈ L :=
  (run_liveness_uniform (mem_runMembers.mpr ⟨dlc_x_kept hfx, rfl⟩)).mp hxl

include hfx hxl hfsucc in
theorem dlc_succ_live : x ++ [1] ∈ L :=
  (run_liveness_uniform (mem_runMembers.mpr
    ⟨fusible_kept hfsucc, dlc_succ_headOf hfsucc⟩)).mpr (dlc_g_live hxl hfx)

include hfx hxl in
theorem dlc_par_live : x.dropLast ∈ L := (fusible_live hfx).mp hxl

include hfsucc hmem' in
theorem dlc_kept_iff (c : List ℕ) : c ∈ keptL L' ↔ c ∈ keptL L :=
  delete_keptL_eq ⟨1, fusible_kept hfsucc⟩ hmem' c

include hfx hxl hmem' in
theorem dlc_fusible_x : fusible L' x = false :=
  delete_fusible_x_false (kept_ne_nil (dlc_x_kept hfx)) hmem'
    (dlc_par_live hxl hfx)

include hfx hxl hfsucc hmem' in
theorem dlc_fusible_succ : fusible L' (x ++ [1]) = false :=
  delete_fusible_succ_false hmem' (dlc_succ_live hxl hfx hfsucc)

include hfsucc hmem' in
theorem dlc_fusible_old {c : List ℕ} (hc : c ∈ keptL L)
    (hc1 : c ≠ x) (hc2 : c ≠ x ++ [1]) :
    fusible L' c = fusible L c := by
  have hkiff := dlc_kept_iff (L := L) (L' := L') hfsucc hmem'
  have hdx : c.dropLast ≠ x := by
    intro heq
    apply hc2
    have := child_of_parent_eq (kept_ne_nil hc) heq
    have huniq := fusible_unique hfsucc hc
      (by rw [List.dropLast_concat]; exact heq)
    exact huniq
  have hmemc : (c ∈ L') ↔ (c ∈ L) := by
    rw [hmem' c]
    exact ⟨fun h => h.1, fun h => ⟨h, hc1⟩⟩
  have hmemd : (c.dropLast ∈ L') ↔ (c.dropLast ∈ L) := by
    rw [hmem' c.dropLast]
    exact ⟨fun h => h.1, fun h => ⟨h, hdx⟩⟩
  rw [Bool.eq_iff_iff, fusible_eq_true_iff, fusible_eq_true_iff]
  constructor
  · rintro ⟨h1, h2, h3, h4, h5⟩
    refine ⟨(hkiff c).mp h1, (hkiff c.dropLast).mp h2, h3, ?_, ?_⟩
    · intro c' hc' hparc
      exact h4 c' ((hkiff c').mpr hc') hparc
    · rw [← hmemc, ← hmemd]
      exact h5
  · rintro ⟨h1, h2, h3, h4, h5⟩
    refine ⟨(hkiff c).mpr h1, (hkiff c.dropLast).mpr h2, h3, ?_, ?_⟩
    · intro c' hc' hparc
      exact h4 c' ((hkiff c').mp hc') hparc
    · rw [hmemc, hmemd]
      exact h5

include hfx hxl hfsucc hmem' in
theorem dlc_isHead_iff (c : List ℕ) :
    isHead L' c = true
      ↔ (isHead L c = true ∨ c = x ∨ c = x ++ [1]) := by
  constructor
  · intro h
    by_cases hc1 : c = x
    · exact Or.inr (Or.inl hc1)
    · by_cases hc2 : c = x ++ [1]
      · exact Or.inr (Or.inr hc2)
      · left
        have hck : c ∈ keptL L :=
          (dlc_kept_iff hfsucc hmem' c).mp (isHead_kept h)
        refine isHead_of_kept_not_fusible hck ?_
        rw [← dlc_fusible_old hfsucc hmem' hck hc1 hc2]
        exact isHead_not_fusible h
  · rintro (h | h1 | h1)
    · have hc1 : c ≠ x := by
        intro heq
        rw [heq, isHead_eq_false_of_fusible hfx] at h
        exact Bool.noConfusion h
      have hc2 : c ≠ x ++ [1] := by
        intro heq
        rw [heq, isHead_eq_false_of_fusible hfsucc] at h
        exact Bool.noConfusion h
      exact isHead_of_kept_not_fusible
        ((dlc_kept_iff hfsucc hmem' c).mpr (isHead_kept h))
        (by rw [dlc_fusible_old hfsucc hmem' (isHead_kept h) hc1 hc2]
            exact isHead_not_fusible h)
    · rw [h1]
      exact isHead_of_kept_not_fusible
        ((dlc_kept_iff hfsucc hmem' x).mpr (dlc_x_kept hfx))
        (dlc_fusible_x hxl hfx hmem')
    · rw [h1]
      exact isHead_of_kept_not_fusible
        ((dlc_kept_iff hfsucc hmem' _).mpr (fusible_kept hfsucc))
        (dlc_fusible_succ hxl hfx hfsucc hmem')

include hfx hfsucc hmem' in
theorem dlc_headOf_old : ∀ (c : List ℕ), c ∈ keptL L →
    ¬(x <+: c ∧ headOf L c = headOf L x) →
    headOf L' c = headOf L c := by
  intro c
  fun_induction headOf L c with
  | case1 c hf ih =>
      intro hk hinv
      have hc1 : c ≠ x := by
        rintro rfl
        exact hinv ⟨List.prefix_refl _, (headOf_of_fusible hf).symm⟩
      have hc2 : c ≠ x ++ [1] := by
        rintro rfl
        exact hinv ⟨List.prefix_append _ _, by rw [List.dropLast_concat]⟩
      have hf' : fusible L' c = true := by
        rw [dlc_fusible_old hfsucc hmem' hk hc1 hc2]
        exact hf
      rw [headOf_of_fusible hf']
      refine ih (fusible_parent_kept hf) ?_
      rintro ⟨hpre, hhd⟩
      exact hinv ⟨hpre.trans (List.dropLast_prefix c), hhd⟩
  | case2 c hf =>
      intro hk hinv
      have hc1 : c ≠ x := by
        rintro rfl
        exact hf hfx
      have hc2 : c ≠ x ++ [1] := by
        rintro rfl
        exact hf hfsucc
      have hf' : fusible L' c = false := by
        rw [dlc_fusible_old hfsucc hmem' hk hc1 hc2]
        exact Bool.eq_false_iff.mpr hf
      exact headOf_of_not_fusible hf'

include hfx hxl hmem' in
theorem dlc_headOf_x : headOf L' x = x :=
  headOf_of_not_fusible (dlc_fusible_x hxl hfx hmem')

include hfx hxl hfsucc hmem' in
theorem dlc_headOf_ge : ∀ k,
    x.length - (headOf L x).length + 1 ≤ k → k < lenOf L (headOf L x) →
    headOf L' (headOf L x ++ List.replicate k 1) = x ++ [1] := by
  intro k
  induction k with
  | zero =>
      intro h1 _
      omega
  | succ k ih =>
      intro h1 h2
      by_cases hk : k + 1 = x.length - (headOf L x).length + 1
      · rw [hk, ← dlc_succ_pad hfx hfsucc]
        exact headOf_of_not_fusible (dlc_fusible_succ hxl hfx hfsucc hmem')
      · have hg : isHead L (headOf L x) = true :=
          headOf_isHead (dlc_x_kept hfx)
        have hmem : headOf L x ++ List.replicate (k + 1) 1
            ∈ runMembers L (headOf L x) := runMember_of_lt hg h2
        have hfusL := runMember_fusible hmem
        have hne1 : headOf L x ++ List.replicate (k + 1) 1 ≠ x := by
          conv_rhs => rw [dlc_x_pad hfx]
          intro heq
          have := replicate_offset_inj heq
          omega
        have hne2 : headOf L x ++ List.replicate (k + 1) 1 ≠ x ++ [1] := by
          rw [dlc_succ_pad hfx hfsucc]
          intro heq
          exact hk (replicate_offset_inj heq)
        have hfus' : fusible L' (headOf L x ++ List.replicate (k + 1) 1)
            = true := by
          rw [dlc_fusible_old hfsucc hmem' (mem_runMembers.mp hmem).1
            hne1 hne2]
          exact hfusL
        rw [headOf_of_fusible hfus', dropLast_append_replicate_succ]
        exact ih (by omega) (by omega)

include hfx hxl hfsucc hmem' in
/-- Classify an old kept chain's new run head by its position relative to
the two liveness breaks. -/
theorem dlc_headOf_classify {c : List ℕ} (hc : c ∈ keptL L) :
    (c = x ∧ headOf L' c = x)
    ∨ (headOf L c = headOf L x ∧ x ++ [1] <+: c
        ∧ headOf L' c = x ++ [1])
    ∨ (¬(x <+: c ∧ headOf L c = headOf L x)
        ∧ headOf L' c = headOf L c) := by
  by_cases hcx : c = x
  · refine Or.inl ⟨hcx, ?_⟩
    rw [hcx]
    exact dlc_headOf_x hxl hfx hmem'
  · by_cases hcase : x ++ [1] <+: c ∧ headOf L c = headOf L x
    · obtain ⟨hpre, hhd⟩ := hcase
      have hmem : c ∈ runMembers L (headOf L x) :=
        mem_runMembers.mpr ⟨hc, hhd⟩
      have hform := runMember_form hmem
      have hlt : c.length - (headOf L x).length < lenOf L (headOf L x) :=
        runMember_offset_lt (hform ▸ hmem)
      have hge : x.length - (headOf L x).length + 1
          ≤ c.length - (headOf L x).length := by
        have h1 := hpre.length_le
        have h2 := congrArg List.length (dlc_x_pad hfx)
        simp only [List.length_append, List.length_cons, List.length_nil,
          List.length_replicate] at h1 h2
        omega
      refine Or.inr (Or.inl ⟨hhd, hpre, ?_⟩)
      conv_lhs => rw [hform]
      exact dlc_headOf_ge hxl hfx hfsucc hmem' _ hge hlt
    · refine Or.inr (Or.inr ⟨?_, ?_⟩)
      · rintro ⟨hpre, hhd⟩
        apply hcase
        refine ⟨?_, hhd⟩
        have hmem : c ∈ runMembers L (headOf L x) :=
          mem_runMembers.mpr ⟨hc, hhd⟩
        have hform := runMember_form hmem
        have hxle : x.length ≤ c.length := hpre.length_le
        have hoffne : c.length - (headOf L x).length
            ≠ x.length - (headOf L x).length := by
          intro heq
          apply hcx
          rw [hform, heq, ← dlc_x_pad hfx]
        have h2 := congrArg List.length (dlc_x_pad hfx)
        simp only [List.length_append, List.length_replicate] at h2
        rw [dlc_succ_pad hfx hfsucc]
        conv_rhs => rw [hform]
        exact replicate_pad_prefix (by omega)
      · refine dlc_headOf_old hfx hfsucc hmem' c hc ?_
        rintro ⟨hpre, hhd⟩
        apply hcase
        refine ⟨?_, hhd⟩
        have hmem : c ∈ runMembers L (headOf L x) :=
          mem_runMembers.mpr ⟨hc, hhd⟩
        have hform := runMember_form hmem
        have hxle : x.length ≤ c.length := hpre.length_le
        have hoffne : c.length - (headOf L x).length
            ≠ x.length - (headOf L x).length := by
          intro heq
          apply hcx
          rw [hform, heq, ← dlc_x_pad hfx]
        have h2 := congrArg List.length (dlc_x_pad hfx)
        simp only [List.length_append, List.length_replicate] at h2
        rw [dlc_succ_pad hfx hfsucc]
        conv_rhs => rw [hform]
        exact replicate_pad_prefix (by omega)

include hfx hxl hfsucc hmem' in
theorem dlc_lenOf_g :
    lenOf L' (headOf L x) = x.length - (headOf L x).length := by
  have hg : isHead L (headOf L x) = true := headOf_isHead (dlc_x_kept hfx)
  have hgx : headOf L x ≠ x := by
    intro heq
    have := dlc_j_pos hfx
    have h2 := congrArg List.length heq
    omega
  have hgs : headOf L x ≠ x ++ [1] := by
    intro heq
    have h1 := (headOf_prefix L x).length_le
    have h2 := congrArg List.length heq
    simp only [List.length_append, List.length_cons, List.length_nil] at h2
    omega
  refine lenOf_eq_of_iff ?_
  intro c
  constructor
  · rintro ⟨hk, hhd⟩
    have hck : c ∈ keptL L := (dlc_kept_iff hfsucc hmem' c).mp hk
    rcases dlc_headOf_classify hxl hfx hfsucc hmem' hck with
      ⟨h1, h2⟩ | ⟨h1, h2, h3⟩ | ⟨h1, h2⟩
    · exfalso
      rw [h2] at hhd
      exact hgx hhd.symm
    · exfalso
      rw [h3] at hhd
      exact hgs hhd.symm
    · rw [h2] at hhd
      have hmem : c ∈ runMembers L (headOf L x) :=
        mem_runMembers.mpr ⟨hck, hhd⟩
      have hform := runMember_form hmem
      refine ⟨c.length - (headOf L x).length, ?_, hform⟩
      by_contra hge
      apply h1
      refine ⟨?_, hhd⟩
      conv_lhs => rw [dlc_x_pad hfx]
      conv_rhs => rw [hform]
      exact replicate_pad_prefix (by omega)
  · rintro ⟨k, hk, rfl⟩
    have hklt : k < lenOf L (headOf L x) := by
      have h1 := dlc_succ_offset_lt hfx hfsucc
      omega
    have hmem : headOf L x ++ List.replicate k 1
        ∈ runMembers L (headOf L x) := runMember_of_lt hg hklt
    have hninv : ¬(x <+: headOf L x ++ List.replicate k 1
        ∧ headOf L (headOf L x ++ List.replicate k 1) = headOf L x) := by
      rintro ⟨hpre, -⟩
      have hpre' : headOf L x
            ++ List.replicate (x.length - (headOf L x).length) 1
          <+: headOf L x ++ List.replicate k 1 := by
        rw [← dlc_x_pad hfx]
        exact hpre
      have := replicate_pad_prefix_le hpre'
      omega
    refine ⟨(dlc_kept_iff hfsucc hmem' _).mpr (mem_runMembers.mp hmem).1, ?_⟩
    rw [dlc_headOf_old hfx hfsucc hmem' _ (mem_runMembers.mp hmem).1 hninv]
    exact (mem_runMembers.mp hmem).2

include hfx hxl hfsucc hmem' in
theorem dlc_lenOf_x : lenOf L' x = 1 := by
  refine lenOf_eq_of_iff ?_
  intro c
  constructor
  · rintro ⟨hk, hhd⟩
    refine ⟨0, by omega, ?_⟩
    simp only [List.replicate_zero, List.append_nil]
    have hck : c ∈ keptL L := (dlc_kept_iff hfsucc hmem' c).mp hk
    rcases dlc_headOf_classify hxl hfx hfsucc hmem' hck with
      ⟨h1, h2⟩ | ⟨h1, h2, h3⟩ | ⟨h1, h2⟩
    · exact h1
    · exfalso
      rw [h3] at hhd
      have := congrArg List.length hhd
      simp at this
    · exfalso
      rw [h2] at hhd
      have := headOf_isHead hck
      rw [hhd, isHead_eq_false_of_fusible hfx] at this
      exact Bool.noConfusion this
  · rintro ⟨k, hk, rfl⟩
    have : k = 0 := by omega
    subst this
    simp only [List.replicate_zero, List.append_nil]
    exact ⟨(dlc_kept_iff hfsucc hmem' x).mpr (dlc_x_kept hfx),
      dlc_headOf_x hxl hfx hmem'⟩

include hfx hxl hfsucc hmem' in
theorem dlc_lenOf_succ :
    lenOf L' (x ++ [1])
      = lenOf L (headOf L x) - (x.length - (headOf L x).length) - 1 := by
  have hg : isHead L (headOf L x) = true := headOf_isHead (dlc_x_kept hfx)
  refine lenOf_eq_of_iff ?_
  intro c
  constructor
  · rintro ⟨hk, hhd⟩
    have hck : c ∈ keptL L := (dlc_kept_iff hfsucc hmem' c).mp hk
    rcases dlc_headOf_classify hxl hfx hfsucc hmem' hck with
      ⟨h1, h2⟩ | ⟨h1, h2, h3⟩ | ⟨h1, h2⟩
    · exfalso
      rw [h2] at hhd
      have := congrArg List.length hhd
      simp at this
    · have hmem : c ∈ runMembers L (headOf L x) :=
        mem_runMembers.mpr ⟨hck, h1⟩
      have hform := runMember_form hmem
      have hlt : c.length - (headOf L x).length < lenOf L (headOf L x) :=
        runMember_offset_lt (hform ▸ hmem)
      have hge : x.length - (headOf L x).length + 1
          ≤ c.length - (headOf L x).length := by
        have h4 := h2.length_le
        have h5 := congrArg List.length (dlc_x_pad hfx)
        simp only [List.length_append, List.length_cons, List.length_nil,
          List.length_replicate] at h4 h5
        omega
      refine ⟨c.length - (headOf L x).length
          - (x.length - (headOf L x).length) - 1, by omega, ?_⟩
      rw [dlc_succ_pad hfx hfsucc, List.append_assoc, ← List.replicate_add]
      conv_lhs => rw [hform]
      congr 2
      omega
    · exfalso
      rw [h2] at hhd
      have := headOf_isHead hck
      rw [hhd, isHead_eq_false_of_fusible hfsucc] at this
      exact Bool.noConfusion this
  · rintro ⟨k, hk, rfl⟩
    have hpad : (x ++ [1]) ++ List.replicate k 1
        = headOf L x ++ List.replicate
            (x.length - (headOf L x).length + 1 + k) 1 := by
      rw [dlc_succ_pad hfx hfsucc, List.append_assoc, ← List.replicate_add]
    have hklt : x.length - (headOf L x).length + 1 + k
        < lenOf L (headOf L x) := by omega
    have hmem : headOf L x ++ List.replicate
        (x.length - (headOf L x).length + 1 + k) 1
        ∈ runMembers L (headOf L x) := runMember_of_lt hg hklt
    refine ⟨(dlc_kept_iff hfsucc hmem' _).mpr
        (by rw [hpad]; exact (mem_runMembers.mp hmem).1), ?_⟩
    rw [hpad]
    exact dlc_headOf_ge hxl hfx hfsucc hmem' _ (by omega) hklt

include hfx hxl hfsucc hmem' in
theorem dlc_lenOf_old {h : List ℕ} (hh : isHead L h = true)
    (hne1 : h ≠ headOf L x) :
    lenOf L' h = lenOf L h := by
  rw [lenOf, lenOf, runMembers, runMembers]
  have hiff : ∀ c, (c ∈ keptL L' ∧ headOf L' c = h)
      ↔ (c ∈ keptL L ∧ headOf L c = h) := by
    intro c
    constructor
    · rintro ⟨hk, hhd⟩
      have hck : c ∈ keptL L := (dlc_kept_iff hfsucc hmem' c).mp hk
      rcases dlc_headOf_classify hxl hfx hfsucc hmem' hck with
        ⟨h1, h2⟩ | ⟨h1, h2, h3⟩ | ⟨h1, h2⟩
      · exfalso
        rw [h2] at hhd
        rw [← hhd, isHead_eq_false_of_fusible hfx] at hh
        exact Bool.noConfusion hh
      · exfalso
        rw [h3] at hhd
        rw [← hhd, isHead_eq_false_of_fusible hfsucc] at hh
        exact Bool.noConfusion hh
      · rw [h2] at hhd
        exact ⟨hck, hhd⟩
    · rintro ⟨hk, hhd⟩
      have hninv : ¬(x <+: c ∧ headOf L c = headOf L x) := by
        rintro ⟨-, hgv⟩
        exact hne1 (hhd ▸ hgv ▸ rfl)
      exact ⟨(dlc_kept_iff hfsucc hmem' c).mpr hk,
        by rw [dlc_headOf_old hfx hfsucc hmem' c hk hninv]; exact hhd⟩
  have hperm : ((keptL L').filter (fun c => headOf L' c == h)).Perm
      ((keptL L).filter (fun c => headOf L c == h)) := by
    refine (List.perm_ext_iff_of_nodup ((nodup_keptL _).filter _)
      ((nodup_keptL _).filter _)).mpr ?_
    intro c
    simp only [List.mem_filter, beq_iff_eq]
    exact hiff c
  exact hperm.length_eq

include hfx hxl hfsucc hmem' in
theorem dlc_headsList :
    headsList L' = (headsList L ++ [x, x ++ [1]]).mergeSort hLe := by
  refine headsList_eq_of_iff (mergeSort_hLt_sorted ?_) ?_
  · rw [List.nodup_append]
    refine ⟨nodup_headsList L, ?_, ?_⟩
    · refine List.nodup_cons.mpr ⟨?_, List.nodup_singleton _⟩
      rw [List.mem_singleton]
      intro heq
      have := congrArg List.length heq
      simp at this
    · intro y hy z hz heq
      have hyh : isHead L y = true := mem_headsList.mp hy
      rcases List.mem_cons.mp hz with h1 | h1
      · rw [heq, h1, isHead_eq_false_of_fusible hfx] at hyh
        exact Bool.noConfusion hyh
      · rw [List.mem_singleton] at h1
        rw [heq, h1, isHead_eq_false_of_fusible hfsucc] at hyh
        exact Bool.noConfusion hyh
  · intro c
    rw [dlc_isHead_iff hxl hfx hfsucc hmem' c, List.mem_mergeSort,
      List.mem_append, mem_headsList]
    simp only [List.mem_cons, List.not_mem_nil, or_false]

include hxl hfx hfsucc hmem' in
/-- **D2, closed (the interior delete liveness split)**: deleting the
run-interior record `x` re-canonicalizes to the old table with the run
carrying `x` CUT at the liveness break, the old head keeps the prefix
(`len` becomes `x`'s offset), `x` becomes a DEAD singleton entry, the suffix
re-heads at `x ++ [1]`, and every entry attached at the old tail REHOMED to
the suffix entry. The kept tree is untouched; only liveness/len bookkeeping
moves. All right-hand data is pre-mutation. -/
theorem tableOf_delete_split :
    tableOf L'
      = ((headsList L ++ [x, x ++ [1]]).mergeSort hLe).map (fun h =>
          if h = x then
            ⟨some (((headsList L ++ [x, x ++ [1]]).mergeSort hLe).idxOf
                     (headOf L x),
                   x.dropLast.length - (headOf L x).length),
             false, 1, 1⟩
          else if h = x ++ [1] then
            ⟨some (((headsList L ++ [x, x ++ [1]]).mergeSort hLe).idxOf x, 0),
             true, 1,
             lenOf L (headOf L x) - (x.length - (headOf L x).length) - 1⟩
          else
            { entryOfHead L h with
              par := (entryOfHead L h).par.map (fun pr =>
                if headOf L h.dropLast = headOf L x
                then (((headsList L ++ [x, x ++ [1]]).mergeSort hLe).idxOf
                        (x ++ [1]),
                      h.dropLast.length - (x.length + 1))
                else (((headsList L ++ [x, x ++ [1]]).mergeSort hLe).idxOf
                        (headOf L h.dropLast), pr.2)),
              len := if h = headOf L x
                     then x.length - (headOf L x).length
                     else (entryOfHead L h).len }) := by
  have hxne : x ≠ [] := kept_ne_nil (dlc_x_kept hfx)
  have hgne : (headOf L x) ≠ [] := kept_ne_nil (headOf_kept (dlc_x_kept hfx))
  have hglen : 1 ≤ (headOf L x).length := List.length_pos_iff.mpr hgne
  have hjpos := dlc_j_pos hfx
  have hxlen : 2 ≤ x.length := by
    have := congrArg List.length (dlc_x_pad hfx)
    simp only [List.length_append, List.length_replicate] at this
    omega
  have hdne : x.dropLast ≠ [] := by
    have : 0 < x.dropLast.length := by
      rw [List.length_dropLast]
      omega
    exact List.length_pos_iff.mp this
  have hdk_x : x.dropLast ∈ keptL L :=
    kept_of_prefix (dlc_x_kept hfx) (List.dropLast_prefix x) hdne
  rw [tableOf, dlc_headsList hxl hfx hfsucc hmem']
  refine List.map_congr_left ?_
  intro h hh
  rw [List.mem_mergeSort, List.mem_append] at hh
  by_cases hhx : h = x
  · rw [if_pos hhx]
    subst hhx
    rw [entryOfHead,
      if_pos ((dlc_kept_iff hfsucc hmem' _).mpr hdk_x),
      dlc_headsList hxl hfx hfsucc hmem']
    have hninv : ¬(h <+: h.dropLast ∧ headOf L h.dropLast = headOf L h) := by
      rintro ⟨hpre, -⟩
      have := hpre.length_le
      rw [List.length_dropLast] at this
      omega
    have hho : headOf L' h.dropLast = headOf L h := by
      rw [dlc_headOf_old hfx hfsucc hmem' _ hdk_x hninv]
      exact (headOf_of_fusible hfx).symm
    rw [hho]
    refine RTEntry.ext' rfl ?_ ?_ ?_
    · exact decide_eq_false (delete_x_dead hmem')
    · show h.getLastD 0 = 1
      conv_lhs => rw [fusible_concat hfx]
      rw [List.getLastD_concat]
    · exact dlc_lenOf_x hxl hfx hfsucc hmem'
  · rw [if_neg hhx]
    by_cases hhs : h = x ++ [1]
    · rw [if_pos hhs]
      subst hhs
      have hdk : (x ++ [1]).dropLast ∈ keptL L' := by
        rw [List.dropLast_concat]
        exact (dlc_kept_iff hfsucc hmem' x).mpr (dlc_x_kept hfx)
      rw [entryOfHead, if_pos hdk, dlc_headsList hxl hfx hfsucc hmem']
      have hho : headOf L' (x ++ [1]).dropLast = x := by
        rw [List.dropLast_concat]
        exact dlc_headOf_x hxl hfx hmem'
      rw [hho]
      refine RTEntry.ext' ?_ ?_ ?_ ?_
      · show some (_, (x ++ [1]).dropLast.length - x.length) = some (_, 0)
        rw [List.dropLast_concat]
        simp
      · show decide (x ++ [1] ∈ L') = true
        refine decide_eq_true ((hmem' _).mpr
          ⟨dlc_succ_live hxl hfx hfsucc, ?_⟩)
        intro heq
        have := congrArg List.length heq
        simp at this
      · show (x ++ [1]).getLastD 0 = 1
        rw [List.getLastD_concat]
      · exact dlc_lenOf_succ hxl hfx hfsucc hmem'
    · rw [if_neg hhs]
      have hhL : isHead L h = true := by
        rcases hh with hh | hh
        · exact mem_headsList.mp hh
        · exfalso
          rcases List.mem_cons.mp hh with h1 | h1
          · exact hhx h1
          · rw [List.mem_singleton] at h1
            exact hhs h1
      have hkh : h ∈ keptL L := isHead_kept hhL
      have hlive : decide (h ∈ L') = decide (h ∈ L) := by
        refine decide_eq_decide.mpr ?_
        rw [hmem' h]
        refine ⟨fun h' => h'.1, fun h' => ⟨h', ?_⟩⟩
        intro heq
        rw [heq, isHead_eq_false_of_fusible hfx] at hhL
        exact Bool.noConfusion hhL
      have hlen : lenOf L' h
          = if h = headOf L x then x.length - (headOf L x).length
            else lenOf L h := by
        by_cases hg : h = headOf L x
        · rw [if_pos hg, hg]
          exact dlc_lenOf_g hxl hfx hfsucc hmem'
        · rw [if_neg hg]
          exact dlc_lenOf_old hxl hfx hfsucc hmem' hhL hg
      by_cases hdk : h.dropLast ∈ keptL L
      · rw [entryOfHead, if_pos ((dlc_kept_iff hfsucc hmem' _).mpr hdk),
          dlc_headsList hxl hfx hfsucc hmem']
        have htail := head_parent_is_tail hhL hdk
        by_cases hgg : headOf L h.dropLast = headOf L x
        · have hglenpos : 0 < lenOf L (headOf L x) :=
            lenOf_pos (headOf_isHead (dlc_x_kept hfx))
          have hoffl := dlc_succ_offset_lt hfx hfsucc
          have hho : headOf L' h.dropLast = x ++ [1] := by
            rw [htail, hgg, tailOf]
            exact dlc_headOf_ge hxl hfx hfsucc hmem' _ (by omega) (by omega)
          rw [hho]
          refine RTEntry.ext' ?_ ?_ ?_ ?_
          · dsimp only
            rw [entryOfHead, if_pos hdk]
            simp only [Option.map_some]
            rw [if_pos hgg]
            simp
          · show decide (h ∈ L') = (entryOfHead L h).live
            rw [hlive]
            rfl
          · rfl
          · show lenOf L' h = _
            rw [hlen]
            by_cases hg : h = headOf L x
            · rw [if_pos hg, if_pos hg]
            · rw [if_neg hg, if_neg hg]
              rfl
        · have hninv : ¬(x <+: h.dropLast
              ∧ headOf L h.dropLast = headOf L x) := by
            rintro ⟨-, hgv⟩
            exact hgg hgv
          have hho : headOf L' h.dropLast = headOf L h.dropLast :=
            dlc_headOf_old hfx hfsucc hmem' h.dropLast hdk hninv
          rw [hho]
          refine RTEntry.ext' ?_ ?_ ?_ ?_
          · dsimp only
            rw [entryOfHead, if_pos hdk]
            simp only [Option.map_some]
            rw [if_neg hgg]
          · show decide (h ∈ L') = (entryOfHead L h).live
            rw [hlive]
            rfl
          · rfl
          · show lenOf L' h = _
            rw [hlen]
            by_cases hg : h = headOf L x
            · rw [if_pos hg, if_pos hg]
            · rw [if_neg hg, if_neg hg]
              rfl
      · rw [entryOfHead,
          if_neg (fun h' => hdk ((dlc_kept_iff hfsucc hmem' _).mp h'))]
        refine RTEntry.ext' ?_ ?_ ?_ ?_
        · rw [entryOfHead, if_neg hdk]
          rfl
        · show decide (h ∈ L') = (entryOfHead L h).live
          rw [hlive]
          rfl
        · rfl
        · show lenOf L' h = _
          rw [hlen]
          by_cases hg : h = headOf L x
          · rw [if_pos hg, if_pos hg]
          · rw [if_neg hg, if_neg hg]
            rfl

end DeleteLivenessClosed

/-! ### D4, closed: the coalesce, as a full table rewrite

The D4 shape (`spot_d4_coalesce_necessity`): delete the childless interloper
`a ++ [d]` whose presence had split the run at `a` (`a` is its run's tail;
its only other kept child is the run successor `a ++ [1]`, same liveness as
`a`). The interloper's entry AND the suffix entry both leave the table: the
suffix re-fuses into the anchor's run (`len` becomes the SUM), and every
entry attached at the suffix's tail rehomes to the merged run. This is the
closed form of the FORCED delete-inverse (`coalesce_restored`). -/

section CoalesceClosed

variable {L L' : List (List ℕ)} {a : List ℕ} {d : ℕ}
  (hane : a ≠ [])
  (hd : d ≠ 1)
  (hint : a ++ [d] ∈ L)
  (hleaf : ∀ e, (a ++ [d]) ++ [e] ∉ keptL L)
  (hsucc : a ++ [1] ∈ keptL L)
  (hlv : (a ++ [1] ∈ L) ↔ (a ∈ L))
  (honly : ∀ c' ∈ keptL L, c'.dropLast = a → c' = a ++ [1] ∨ c' = a ++ [d])
  (hmem' : ∀ c, c ∈ L' ↔ (c ∈ L ∧ c ≠ a ++ [d]))

include hsucc hane in
theorem clc_a_kept : a ∈ keptL L :=
  kept_of_prefix hsucc (List.prefix_append a [1]) hane

include hint in
theorem clc_int_kept : a ++ [d] ∈ keptL L := kept_of_live hint (by simp)

include hd hint in
theorem clc_succ_not_fusible : fusible L (a ++ [1]) = false := by
  cases hf : fusible L (a ++ [1]) with
  | false => rfl
  | true =>
      exfalso
      have heq := fusible_unique hf (clc_int_kept hint)
        (by rw [List.dropLast_concat, List.dropLast_concat])
      have := List.append_cancel_left heq
      injection this with h'
      exact hd h'

include hd in
theorem clc_int_not_fusible : fusible L (a ++ [d]) = false := by
  cases hf : fusible L (a ++ [d]) with
  | false => rfl
  | true =>
      exfalso
      have := (fusible_eq_true_iff.mp hf).2.2.1
      rw [List.getLastD_concat] at this
      exact hd this

include hane hsucc in
theorem clc_a_pad :
    a = headOf L a ++ List.replicate (a.length - (headOf L a).length) 1 :=
  runMember_form (mem_runMembers.mpr ⟨clc_a_kept hane hsucc, rfl⟩)

include hane hsucc in
theorem clc_succ_pad :
    a ++ [1] = headOf L a
      ++ List.replicate (a.length - (headOf L a).length + 1) 1 := by
  conv_lhs => rw [clc_a_pad hane hsucc]
  rw [List.append_assoc, ← List.replicate_succ']

include hane hd hint hsucc in
/-- `a` is the TAIL of its run: its offset is the run length minus one. -/
theorem clc_a_tail :
    a.length - (headOf L a).length = lenOf L (headOf L a) - 1 := by
  have hg : isHead L (headOf L a) = true :=
    headOf_isHead (clc_a_kept hane hsucc)
  have hmem : a ∈ runMembers L (headOf L a) :=
    mem_runMembers.mpr ⟨clc_a_kept hane hsucc, rfl⟩
  have hlt : a.length - (headOf L a).length < lenOf L (headOf L a) := by
    have hmem2 : headOf L a
        ++ List.replicate (a.length - (headOf L a).length) 1
        ∈ runMembers L (headOf L a) := by
      rw [← clc_a_pad hane hsucc]
      exact hmem
    exact runMember_offset_lt hmem2
  by_contra hne
  have hlt' : a.length - (headOf L a).length + 1 < lenOf L (headOf L a) := by
    omega
  have hmem' := runMember_of_lt hg hlt'
  have hfus := runMember_fusible
    (by rw [show a.length - (headOf L a).length + 1
          = (a.length - (headOf L a).length) + 1 from rfl] at hmem'
        exact hmem')
  rw [← clc_succ_pad hane hsucc] at hfus
  rw [clc_succ_not_fusible hd hint] at hfus
  exact Bool.noConfusion hfus

include hane hd hint hsucc in
theorem clc_succ_pad_n :
    a ++ [1] = headOf L a
      ++ List.replicate (lenOf L (headOf L a)) 1 := by
  have h1 : 1 ≤ lenOf L (headOf L a) :=
    lenOf_pos (headOf_isHead (clc_a_kept hane hsucc))
  rw [clc_succ_pad hane hsucc, clc_a_tail hane hd hint hsucc]
  congr 2
  omega

include hd hleaf hsucc hmem' in
theorem clc_kept_iff (c : List ℕ) :
    c ∈ keptL L' ↔ (c ∈ keptL L ∧ c ≠ a ++ [d]) :=
  coalesce_keptL hd hleaf hsucc hmem' c

include hd hint hleaf hsucc honly hmem' in
theorem clc_fusible_old {c : List ℕ} (hc : c ∈ keptL L)
    (hc1 : c ≠ a ++ [1]) (hc2 : c ≠ a ++ [d]) :
    fusible L' c = fusible L c := by
  have hkiff := clc_kept_iff (L := L) (L' := L') hd hleaf hsucc hmem'
  have hdd : c.dropLast ≠ a ++ [d] := by
    intro heq
    apply hleaf (c.getLastD 0)
    rw [← heq, ← child_of_parent_eq (kept_ne_nil hc) rfl]
    exact hc
  have hmemc : (c ∈ L') ↔ (c ∈ L) := by
    rw [hmem' c]
    exact ⟨fun h => h.1, fun h => ⟨h, hc2⟩⟩
  have hmemd : (c.dropLast ∈ L') ↔ (c.dropLast ∈ L) := by
    rw [hmem' c.dropLast]
    exact ⟨fun h => h.1, fun h => ⟨h, hdd⟩⟩
  rw [Bool.eq_iff_iff, fusible_eq_true_iff, fusible_eq_true_iff]
  constructor
  · rintro ⟨h1, h2, h3, h4, h5⟩
    refine ⟨((hkiff c).mp h1).1, ((hkiff c.dropLast).mp h2).1, h3, ?_, ?_⟩
    · intro c' hc' hparc
      by_cases hci : c' = a ++ [d]
      · exfalso
        rw [hci, List.dropLast_concat] at hparc
        rcases honly c hc hparc.symm with h' | h'
        · exact hc1 h'
        · exact hc2 h'
      · exact h4 c' ((hkiff c').mpr ⟨hc', hci⟩) hparc
    · rw [← hmemc, ← hmemd]
      exact h5
  · rintro ⟨h1, h2, h3, h4, h5⟩
    refine ⟨(hkiff c).mpr ⟨hc, hc2⟩, (hkiff c.dropLast).mpr ⟨h2, hdd⟩,
      h3, ?_, ?_⟩
    · intro c' hc' hparc
      exact h4 c' ((hkiff c').mp hc').1 hparc
    · rw [hmemc, hmemd]
      exact h5

include hane hd hint hleaf hsucc hlv honly hmem' in
theorem clc_fusible_succ : fusible L' (a ++ [1]) = true :=
  coalesce_restored hane hd hleaf hsucc hlv honly hmem'

include hane hd hint hleaf hsucc hlv honly hmem' in
theorem clc_isHead_iff (c : List ℕ) :
    isHead L' c = true
      ↔ (isHead L c = true ∧ c ≠ a ++ [1] ∧ c ≠ a ++ [d]) := by
  constructor
  · intro h
    obtain ⟨hck, hci⟩ := (clc_kept_iff hd hleaf hsucc hmem' c).mp
      (isHead_kept h)
    have hc1 : c ≠ a ++ [1] := by
      intro heq
      have := isHead_not_fusible h
      rw [heq, clc_fusible_succ hane hd hint hleaf hsucc hlv honly hmem']
        at this
      exact Bool.noConfusion this
    refine ⟨isHead_of_kept_not_fusible hck ?_, hc1, hci⟩
    rw [← clc_fusible_old hd hint hleaf hsucc honly hmem' hck hc1 hci]
    exact isHead_not_fusible h
  · rintro ⟨h, hc1, hc2⟩
    exact isHead_of_kept_not_fusible
      ((clc_kept_iff hd hleaf hsucc hmem' c).mpr ⟨isHead_kept h, hc2⟩)
      (by rw [clc_fusible_old hd hint hleaf hsucc honly hmem' (isHead_kept h)
            hc1 hc2]
          exact isHead_not_fusible h)

include hd hint hleaf hsucc honly hmem' in
theorem clc_headOf_old : ∀ (c : List ℕ), c ∈ keptL L → c ≠ a ++ [d] →
    headOf L c ≠ a ++ [1] →
    headOf L' c = headOf L c := by
  intro c
  fun_induction headOf L c with
  | case1 c hf ih =>
      intro hk hci hinv
      have hc1 : c ≠ a ++ [1] := by
        rintro rfl
        rw [clc_succ_not_fusible hd hint] at hf
        exact Bool.noConfusion hf
      have hdd : c.dropLast ≠ a ++ [d] := by
        intro heq
        apply hleaf (c.getLastD 0)
        rw [← heq, ← child_of_parent_eq (kept_ne_nil hk) rfl]
        exact hk
      have hf' : fusible L' c = true := by
        rw [clc_fusible_old hd hint hleaf hsucc honly hmem' hk hc1 hci]
        exact hf
      rw [headOf_of_fusible hf']
      exact ih (fusible_parent_kept hf) hdd hinv
  | case2 c hf =>
      intro hk hci hinv
      have hc1 : c ≠ a ++ [1] := fun heq => hinv (heq ▸ rfl)
      have hf' : fusible L' c = false := by
        rw [clc_fusible_old hd hint hleaf hsucc honly hmem' hk hc1 hci]
        exact Bool.eq_false_iff.mpr hf
      exact headOf_of_not_fusible hf'

include hane hd hint hleaf hsucc hlv honly hmem' in
theorem clc_headOf_merge : ∀ i, i < lenOf L (a ++ [1]) →
    headOf L' ((a ++ [1]) ++ List.replicate i 1) = headOf L a := by
  have hsh : isHead L (a ++ [1]) :=
    isHead_of_kept_not_fusible hsucc (clc_succ_not_fusible hd hint)
  intro i
  induction i with
  | zero =>
      intro _
      simp only [List.replicate_zero, List.append_nil]
      rw [headOf_of_fusible
        (clc_fusible_succ hane hd hint hleaf hsucc hlv honly hmem'),
        List.dropLast_concat]
      refine clc_headOf_old hd hint hleaf hsucc honly hmem' a
        (clc_a_kept hane hsucc) ?_ ?_
      · intro heq
        have := congrArg List.length heq
        simp at this
      · intro heq
        have h1 := (headOf_prefix L a).length_le
        have h2 := congrArg List.length heq
        simp only [List.length_append, List.length_cons, List.length_nil]
          at h2
        omega
  | succ i ih =>
      intro hi
      have hmem : (a ++ [1]) ++ List.replicate (i + 1) 1
          ∈ runMembers L (a ++ [1]) := runMember_of_lt hsh hi
      have hfusL := runMember_fusible hmem
      have hc1 : (a ++ [1]) ++ List.replicate (i + 1) 1 ≠ a ++ [1] := by
        intro heq
        have := congrArg List.length heq
        simp at this
      have hc2 : (a ++ [1]) ++ List.replicate (i + 1) 1 ≠ a ++ [d] := by
        intro heq
        have := congrArg List.length heq
        simp at this
      have hfus' : fusible L' ((a ++ [1]) ++ List.replicate (i + 1) 1)
          = true := by
        rw [clc_fusible_old hd hint hleaf hsucc honly hmem'
          (mem_runMembers.mp hmem).1 hc1 hc2]
        exact hfusL
      rw [headOf_of_fusible hfus', dropLast_append_replicate_succ]
      exact ih (by omega)

include hane hd hint hleaf hsucc hlv honly hmem' in
theorem clc_lenOf_g :
    lenOf L' (headOf L a)
      = lenOf L (headOf L a) + lenOf L (a ++ [1]) := by
  have hg : isHead L (headOf L a) = true :=
    headOf_isHead (clc_a_kept hane hsucc)
  have hsh : isHead L (a ++ [1]) :=
    isHead_of_kept_not_fusible hsucc (clc_succ_not_fusible hd hint)
  have hgs : headOf L a ≠ a ++ [1] := by
    intro heq
    have h1 := (headOf_prefix L a).length_le
    have h2 := congrArg List.length heq
    simp only [List.length_append, List.length_cons, List.length_nil] at h2
    omega
  refine lenOf_eq_of_iff ?_
  intro c
  constructor
  · rintro ⟨hk, hhd⟩
    obtain ⟨hck, hci⟩ := (clc_kept_iff hd hleaf hsucc hmem' c).mp hk
    by_cases hcs : headOf L c = a ++ [1]
    · -- a member of the old suffix run: re-indexed past the old length
      have hmem : c ∈ runMembers L (a ++ [1]) := mem_runMembers.mpr ⟨hck, hcs⟩
      have hform := runMember_form hmem
      have hlt : c.length - (a ++ [1]).length < lenOf L (a ++ [1]) :=
        runMember_offset_lt (hform ▸ hmem)
      refine ⟨lenOf L (headOf L a) + (c.length - (a ++ [1]).length),
        by omega, ?_⟩
      conv_lhs => rw [hform]
      rw [clc_succ_pad_n hane hd hint hsucc, List.append_assoc,
        ← List.replicate_add]
    · rw [clc_headOf_old hd hint hleaf hsucc honly hmem' c hck hci hcs] at hhd
      have hmem : c ∈ runMembers L (headOf L a) :=
        mem_runMembers.mpr ⟨hck, hhd⟩
      have hform := runMember_form hmem
      have hlt : c.length - (headOf L a).length < lenOf L (headOf L a) :=
        runMember_offset_lt (hform ▸ hmem)
      exact ⟨c.length - (headOf L a).length, by omega, hform⟩
  · rintro ⟨k, hk, rfl⟩
    by_cases hkn : k < lenOf L (headOf L a)
    · have hmem : headOf L a ++ List.replicate k 1
          ∈ runMembers L (headOf L a) := runMember_of_lt hg hkn
      have hck := (mem_runMembers.mp hmem).1
      have hci : headOf L a ++ List.replicate k 1 ≠ a ++ [d] := by
        intro heq
        have hih : isHead L (a ++ [d]) :=
          isHead_of_kept_not_fusible (clc_int_kept hint)
            (clc_int_not_fusible hd)
        have := (mem_runMembers.mp hmem).2
        rw [heq] at this
        rw [headOf_eq_self_of_isHead hih] at this
        have h2 := congrArg List.length this
        have h3 := (headOf_prefix L a).length_le
        simp only [List.length_append, List.length_cons, List.length_nil]
          at h2
        omega
      have hcs : headOf L (headOf L a ++ List.replicate k 1) ≠ a ++ [1] := by
        rw [(mem_runMembers.mp hmem).2]
        exact hgs
      refine ⟨(clc_kept_iff hd hleaf hsucc hmem' _).mpr ⟨hck, hci⟩, ?_⟩
      rw [clc_headOf_old hd hint hleaf hsucc honly hmem' _ hck hci hcs]
      exact (mem_runMembers.mp hmem).2
    · have hpad : headOf L a ++ List.replicate k 1
          = (a ++ [1]) ++ List.replicate (k - lenOf L (headOf L a)) 1 := by
        rw [clc_succ_pad_n hane hd hint hsucc, List.append_assoc,
          ← List.replicate_add]
        congr 2
        omega
      have hilt : k - lenOf L (headOf L a) < lenOf L (a ++ [1]) := by omega
      have hmem : (a ++ [1]) ++ List.replicate (k - lenOf L (headOf L a)) 1
          ∈ runMembers L (a ++ [1]) := runMember_of_lt hsh hilt
      have hck := (mem_runMembers.mp hmem).1
      have hci : (a ++ [1]) ++ List.replicate (k - lenOf L (headOf L a)) 1
          ≠ a ++ [d] := by
        intro heq
        have := congrArg List.length heq
        simp only [List.length_append, List.length_replicate,
          List.length_cons, List.length_nil] at this
        have h0 : k - lenOf L (headOf L a) = 0 := by omega
        rw [h0, List.replicate_zero, List.append_nil] at heq
        have := List.append_cancel_left heq
        injection this with h'
        exact hd h'.symm
      refine ⟨(clc_kept_iff hd hleaf hsucc hmem' _).mpr
          (by rw [hpad]; exact ⟨hck, hci⟩), ?_⟩
      rw [hpad]
      exact clc_headOf_merge hane hd hint hleaf hsucc hlv honly hmem' _ hilt

include hane hd hint hleaf hsucc hlv honly hmem' in
theorem clc_lenOf_old {h : List ℕ} (hh : isHead L h = true)
    (hne1 : h ≠ headOf L a) (hne2 : h ≠ a ++ [1]) (hne3 : h ≠ a ++ [d]) :
    lenOf L' h = lenOf L h := by
  rw [lenOf, lenOf, runMembers, runMembers]
  have hiff : ∀ c, (c ∈ keptL L' ∧ headOf L' c = h)
      ↔ (c ∈ keptL L ∧ headOf L c = h) := by
    intro c
    constructor
    · rintro ⟨hk, hhd⟩
      obtain ⟨hck, hci⟩ := (clc_kept_iff hd hleaf hsucc hmem' c).mp hk
      by_cases hcs : headOf L c = a ++ [1]
      · exfalso
        have hmem : c ∈ runMembers L (a ++ [1]) :=
          mem_runMembers.mpr ⟨hck, hcs⟩
        have hform := runMember_form hmem
        have hlt : c.length - (a ++ [1]).length < lenOf L (a ++ [1]) :=
          runMember_offset_lt (hform ▸ hmem)
        rw [hform] at hhd
        rw [clc_headOf_merge hane hd hint hleaf hsucc hlv honly hmem' _ hlt]
          at hhd
        exact hne1 hhd.symm
      · rw [clc_headOf_old hd hint hleaf hsucc honly hmem' c hck hci hcs] at hhd
        exact ⟨hck, hhd⟩
    · rintro ⟨hck, hhd⟩
      have hci : c ≠ a ++ [d] := by
        intro heq
        apply hne3
        rw [← hhd, heq]
        exact (headOf_eq_self_of_isHead (isHead_of_kept_not_fusible
          (clc_int_kept hint) (clc_int_not_fusible hd)))
      have hcs : headOf L c ≠ a ++ [1] := fun h' => hne2 (hhd ▸ h' ▸ rfl)
      exact ⟨(clc_kept_iff hd hleaf hsucc hmem' c).mpr ⟨hck, hci⟩,
        by rw [clc_headOf_old hd hint hleaf hsucc honly hmem' c hck hci hcs]
           exact hhd⟩
  have hperm : ((keptL L').filter (fun c => headOf L' c == h)).Perm
      ((keptL L).filter (fun c => headOf L c == h)) := by
    refine (List.perm_ext_iff_of_nodup ((nodup_keptL _).filter _)
      ((nodup_keptL _).filter _)).mpr ?_
    intro c
    simp only [List.mem_filter, beq_iff_eq]
    exact hiff c
  exact hperm.length_eq

include hane hd hint hleaf hsucc hlv honly hmem' in
theorem clc_headsList :
    headsList L' = (headsList L).filter
      (fun h => decide (h ≠ a ++ [1]) && decide (h ≠ a ++ [d])) := by
  refine headsList_eq_of_iff ?_ ?_
  · exact (sorted_headsList L).sublist List.filter_sublist
  · intro c
    rw [clc_isHead_iff hane hd hint hleaf hsucc hlv honly hmem' c,
      List.mem_filter, mem_headsList]
    simp only [Bool.and_eq_true, decide_eq_true_eq, and_assoc]

include hane hd hint hleaf hsucc hlv honly hmem' in
/-- **D4, closed (the coalesce)**: deleting the childless interloper
`a ++ [d]` re-canonicalizes to the old table with BOTH the interloper's
entry and the suffix entry `a ++ [1]` REMOVED, the anchor's run absorbing
the suffix (`len` becomes the sum of the two), and every entry attached at
the suffix's tail rehomed into the merged run. The closed inverse of
`tableOf_insert_split`. All right-hand data is pre-mutation. -/
theorem tableOf_coalesce :
    tableOf L'
      = ((headsList L).filter
          (fun h => decide (h ≠ a ++ [1]) && decide (h ≠ a ++ [d]))).map
        (fun h =>
          { entryOfHead L h with
            par := (entryOfHead L h).par.map (fun pr =>
              if headOf L h.dropLast = a ++ [1]
              then (((headsList L).filter (fun h' => decide (h' ≠ a ++ [1])
                        && decide (h' ≠ a ++ [d]))).idxOf (headOf L a),
                    h.dropLast.length - (headOf L a).length)
              else (((headsList L).filter (fun h' => decide (h' ≠ a ++ [1])
                        && decide (h' ≠ a ++ [d]))).idxOf
                      (headOf L h.dropLast), pr.2)),
            len := if h = headOf L a
                   then lenOf L (headOf L a) + lenOf L (a ++ [1])
                   else (entryOfHead L h).len }) := by
  have hsh : isHead L (a ++ [1]) :=
    isHead_of_kept_not_fusible hsucc (clc_succ_not_fusible hd hint)
  have hm1 : 1 ≤ lenOf L (a ++ [1]) := lenOf_pos hsh
  rw [tableOf, clc_headsList hane hd hint hleaf hsucc hlv honly hmem']
  refine List.map_congr_left ?_
  intro h hh
  rw [List.mem_filter, mem_headsList] at hh
  obtain ⟨hhL, hcond⟩ := hh
  simp only [Bool.and_eq_true, decide_eq_true_eq] at hcond
  obtain ⟨hne2, hne3⟩ := hcond
  have hkh : h ∈ keptL L := isHead_kept hhL
  have hlive : decide (h ∈ L') = decide (h ∈ L) := by
    refine decide_eq_decide.mpr ?_
    rw [hmem' h]
    exact ⟨fun h' => h'.1, fun h' => ⟨h', hne3⟩⟩
  have hlen : lenOf L' h
      = if h = headOf L a
        then lenOf L (headOf L a) + lenOf L (a ++ [1])
        else lenOf L h := by
    by_cases hg : h = headOf L a
    · rw [if_pos hg, hg]
      exact clc_lenOf_g hane hd hint hleaf hsucc hlv honly hmem'
    · rw [if_neg hg]
      exact clc_lenOf_old hane hd hint hleaf hsucc hlv honly hmem'
        hhL hg hne2 hne3
  have hkd_iff : h.dropLast ∈ keptL L' ↔ h.dropLast ∈ keptL L := by
    rw [clc_kept_iff hd hleaf hsucc hmem']
    refine ⟨fun h' => h'.1, fun h' => ⟨h', ?_⟩⟩
    intro heq
    apply hleaf (h.getLastD 0)
    rw [← heq, ← child_of_parent_eq (kept_ne_nil hkh) rfl]
    exact hkh
  by_cases hdk : h.dropLast ∈ keptL L
  · rw [entryOfHead, if_pos (hkd_iff.mpr hdk),
      clc_headsList hane hd hint hleaf hsucc hlv honly hmem']
    have htail := head_parent_is_tail hhL hdk
    by_cases hgg : headOf L h.dropLast = a ++ [1]
    · have hho : headOf L' h.dropLast = headOf L a := by
        rw [htail, hgg, tailOf]
        exact clc_headOf_merge hane hd hint hleaf hsucc hlv honly hmem' _
          (by omega)
      rw [hho]
      refine RTEntry.ext' ?_ ?_ ?_ ?_
      · dsimp only
        rw [entryOfHead, if_pos hdk]
        simp only [Option.map_some]
        rw [if_pos hgg]
      · show decide (h ∈ L') = (entryOfHead L h).live
        rw [hlive]
        rfl
      · rfl
      · show lenOf L' h = _
        rw [hlen]
        by_cases hg : h = headOf L a
        · rw [if_pos hg, if_pos hg]
        · rw [if_neg hg, if_neg hg]
          rfl
    · have hci : h.dropLast ≠ a ++ [d] := by
        intro heq
        apply hleaf (h.getLastD 0)
        rw [← heq, ← child_of_parent_eq (kept_ne_nil hkh) rfl]
        exact hkh
      have hho : headOf L' h.dropLast = headOf L h.dropLast :=
        clc_headOf_old hd hint hleaf hsucc honly hmem' h.dropLast hdk hci hgg
      rw [hho]
      refine RTEntry.ext' ?_ ?_ ?_ ?_
      · dsimp only
        rw [entryOfHead, if_pos hdk]
        simp only [Option.map_some]
        rw [if_neg hgg]
      · show decide (h ∈ L') = (entryOfHead L h).live
        rw [hlive]
        rfl
      · rfl
      · show lenOf L' h = _
        rw [hlen]
        by_cases hg : h = headOf L a
        · rw [if_pos hg, if_pos hg]
        · rw [if_neg hg, if_neg hg]
          rfl
  · rw [entryOfHead, if_neg (fun h' => hdk (hkd_iff.mp h'))]
    refine RTEntry.ext' ?_ ?_ ?_ ?_
    · rw [entryOfHead, if_neg hdk]
      rfl
    · show decide (h ∈ L') = (entryOfHead L h).live
      rw [hlive]
      rfl
    · rfl
    · show lenOf L' h = _
      rw [hlen]
      by_cases hg : h = headOf L a
      · rw [if_pos hg, if_pos hg]
      · rw [if_neg hg, if_neg hg]
        rfl

end CoalesceClosed

/-! ## §7½  T-repr, image side: `tableOf` always lands in `Canonical`

`tableOf_stateOf` (§4) is the retraction on canonical inputs. Here is the
image direction: **every** `tableOf L` is a canonical table. Together with
`stateOf_tableOf` and `tableOf_stateOf` this closes the representation iso to
a genuine bijection between live-chain sets (up to `keptL`) and canonical
tables, the note §10's characterization "canonical = maximal fusible chains,
uniform liveness, tail attachment" is not just *recognized* by `Canonical`,
it is exactly the image of `tableOf`. No stability hypothesis. -/

/-- Indexing `tableOf` at `i`: the head sitting there is a head at index `i`,
compiling to that entry, packaged without a dependent `getElem` in scope. -/
theorem tableOf_entry_head (L : List (List ℕ)) (i : ℕ)
    (hi : i < (tableOf L).length) :
    ∃ h, isHead L h = true ∧ (headsList L).idxOf h = i
      ∧ (tableOf L)[i] = entryOfHead L h := by
  have hi' : i < (headsList L).length := by
    simpa only [tableOf, List.length_map] using hi
  refine ⟨(headsList L)[i], mem_headsList.mp (List.getElem_mem _),
    idxOf_getElem_nodup (nodup_headsList L) hi', ?_⟩
  simp only [tableOf, List.getElem_map]

/-- `getElem` at equal indices, dodging the dependent-proof motive block. -/
theorem getElem_idx_eq {T : Table} {i j : ℕ} (hi : i < T.length)
    (hj : j < T.length) (hij : i = j) : T[i]'hi = T[j]'hj := by
  subst hij; rfl

/-- Indexing `tableOf` at a known head's position: compiles that head. -/
theorem tableOf_getElem_idxOf (L : List (List ℕ)) {h : List ℕ}
    (hh : isHead L h = true)
    (hlt : (headsList L).idxOf h < (tableOf L).length) :
    (tableOf L)[(headsList L).idxOf h] = entryOfHead L h := by
  have hm : h ∈ headsList L := mem_headsList.mpr hh
  simp only [tableOf, List.getElem_map]
  congr 1
  exact List.getElem_idxOf (List.idxOf_lt_length_of_mem hm)

/-- **T-repr, image side**: `tableOf L` is a canonical table, for every `L`. -/
theorem canonical_tableOf (L : List (List ℕ)) : Canonical (tableOf L) := by
  have hlen : (tableOf L).length = (headsList L).length := by simp [tableOf]
  refine ⟨?len_pos, ?par_back, ?par_tail, ?no_fuse, ?leaves_live, ?sorted⟩
  case len_pos =>
    intro e he
    obtain ⟨i, hi, rfl⟩ := List.mem_iff_getElem.mp he
    obtain ⟨h, hh, -, hentry⟩ := tableOf_entry_head L i hi
    rw [hentry]; exact lenOf_pos hh
  case sorted =>
    rw [headsOf_tableOf]; exact sorted_headsList L
  case par_back =>
    intro i hi p hp
    obtain ⟨h, hh, hidxh, hentry⟩ := tableOf_entry_head L i hi
    rw [hentry] at hp; simp only [entryOfHead] at hp
    by_cases hpk : h.dropLast ∈ keptL L
    · rw [if_pos hpk] at hp
      have hpe : p = ((headsList L).idxOf (headOf L h.dropLast),
          h.dropLast.length - (headOf L h.dropLast).length) := by
        injection hp with hp; exact hp.symm
      rw [hpe]; dsimp only
      set g := headOf L h.dropLast with hg_def
      have hgm : g ∈ headsList L := mem_headsList.mpr (headOf_isHead hpk)
      have hne : h ≠ [] := kept_ne_nil (isHead_kept hh)
      have hglt : hLt g h = true := by
        have h1 : g.length ≤ h.dropLast.length := (headOf_prefix L _).length_le
        have h2 : h.dropLast.length < h.length := by
          rw [List.length_dropLast]
          have : 0 < h.length := List.length_pos_iff.mpr hne
          omega
        simp only [hLt, Bool.or_eq_true, decide_eq_true_eq]
        exact Or.inl (by omega)
      have := idxOf_lt_of_hLt (sorted_headsList L) hgm
        (mem_headsList.mpr hh) hglt
      rwa [hidxh] at this
    · rw [if_neg hpk] at hp; exact absurd hp (by simp)
  case par_tail =>
    intro i hi p hp hj
    obtain ⟨h, hh, hidxh, hentry⟩ := tableOf_entry_head L i hi
    rw [hentry] at hp; simp only [entryOfHead] at hp
    by_cases hpk : h.dropLast ∈ keptL L
    · rw [if_pos hpk] at hp
      have hpe : p = ((headsList L).idxOf (headOf L h.dropLast),
          h.dropLast.length - (headOf L h.dropLast).length) := by
        injection hp with hp; exact hp.symm
      set g := headOf L h.dropLast with hg_def
      have hp1 : p.1 = (headsList L).idxOf g := by rw [hpe]
      have hp2 : p.2 = h.dropLast.length - g.length := by rw [hpe]
      have hjg : (headsList L).idxOf g < (tableOf L).length := hp1 ▸ hj
      rw [hp2, getElem_idx_eq hj hjg hp1,
        tableOf_getElem_idxOf L (headOf_isHead hpk) hjg]
      simp only [entryOfHead]
      have htail := head_parent_is_tail hh hpk
      rw [← hg_def] at htail
      have hlenpos := lenOf_pos (headOf_isHead hpk)
      have hdl : h.dropLast.length = g.length + (lenOf L g - 1) := by
        conv_lhs => rw [htail, tailOf]
        simp
      rw [hdl, ← hg_def]; omega
    · rw [if_neg hpk] at hp; exact absurd hp (by simp)
  case no_fuse =>
    intro i hi p hp hj hd1 hlive
    obtain ⟨h, hh, hidxh, hentry⟩ := tableOf_entry_head L i hi
    rw [hentry] at hp hd1 hlive; simp only [entryOfHead] at hp hd1 hlive
    by_cases hpk : h.dropLast ∈ keptL L
    · rw [if_pos hpk] at hp
      have hpe : p = ((headsList L).idxOf (headOf L h.dropLast),
          h.dropLast.length - (headOf L h.dropLast).length) := by
        injection hp with hp; exact hp.symm
      set g := headOf L h.dropLast with hg_def
      have hp1 : p.1 = (headsList L).idxOf g := by rw [hpe]
      have hjg : (headsList L).idxOf g < (tableOf L).length := hp1 ▸ hj
      rw [getElem_idx_eq hj hjg hp1,
        tableOf_getElem_idxOf L (headOf_isHead hpk) hjg] at hlive
      simp only [entryOfHead] at hlive
      rw [← hg_def] at hlive
      have hdm : h.dropLast ∈ runMembers L g :=
        mem_runMembers.mpr ⟨hpk, hg_def.symm⟩
      have hlifted : (h ∈ L) ↔ (h.dropLast ∈ L) := by
        rw [run_liveness_uniform hdm, decide_eq_decide.mp hlive]
      have hnf : fusible L h = false := isHead_not_fusible hh
      have hkh : h ∈ keptL L := isHead_kept hh
      have hnu : ¬ (∀ c' ∈ keptL L, c'.dropLast = h.dropLast → c' = h) := by
        intro huniq
        rw [fusible_eq_true_iff.mpr ⟨hkh, hpk, hd1, huniq, hlifted⟩] at hnf
        exact Bool.noConfusion hnf
      push_neg at hnu
      obtain ⟨c', hc'k, hc'd, hc'ne⟩ := hnu
      have hc'nf : fusible L c' = false := by
        cases hf : fusible L c' with
        | false => rfl
        | true => exact absurd (fusible_unique hf hkh (by rw [hc'd])).symm hc'ne
      have hc'h : isHead L c' = true := isHead_of_kept_not_fusible hc'k hc'nf
      have hc'm : c' ∈ headsList L := mem_headsList.mpr hc'h
      have hc'lt : (headsList L).idxOf c' < (tableOf L).length :=
        (List.idxOf_lt_length_of_mem hc'm).trans_eq hlen.symm
      refine ⟨(headsList L).idxOf c', hc'lt, ?_, ?_⟩
      · intro heq
        exact hc'ne ((List.idxOf_inj hc'm).mp (heq.trans hidxh.symm))
      · rw [hpe, tableOf_getElem_idxOf L hc'h hc'lt]
        simp only [entryOfHead]
        rw [if_pos (by rw [hc'd]; exact hpk), hc'd]
    · rw [if_neg hpk] at hp; exact absurd hp (by simp)
  case leaves_live =>
    intro i hi hlivef
    obtain ⟨h, hh, hidxh, hentry⟩ := tableOf_entry_head L i hi
    rw [hentry] at hlivef; simp only [entryOfHead] at hlivef
    have hhnl : h ∉ L := of_decide_eq_false hlivef
    have hkh : h ∈ keptL L := isHead_kept hh
    obtain ⟨hhne, l, hl, hpre⟩ := mem_keptL.mp hkh
    have hlm : l ∈ keptL L :=
      kept_of_live hl (fun hnil => hhne (List.prefix_nil.mp (hnil ▸ hpre)))
    have hnm : headOf L l ≠ h := by
      intro heq
      exact hhnl ((run_liveness_uniform (mem_runMembers.mpr ⟨hlm, heq⟩)).mp hl)
    obtain ⟨q, hqh, hqd, hqc⟩ := escape_run hh hlm hpre hnm
    have hqm : q ∈ headsList L := mem_headsList.mpr hqh
    have hqlt : (headsList L).idxOf q < (tableOf L).length :=
      (List.idxOf_lt_length_of_mem hqm).trans_eq hlen.symm
    have htk : tailOf L h ∈ keptL L := (mem_runMembers.mp (tailOf_mem hh)).1
    have hth : headOf L (tailOf L h) = h := (mem_runMembers.mp (tailOf_mem hh)).2
    refine ⟨(headsList L).idxOf q, hqlt, q.dropLast.length - h.length, ?_⟩
    rw [tableOf_getElem_idxOf L hqh hqlt]
    simp only [entryOfHead]
    rw [if_pos (by rw [hqd]; exact htk), hqd, hth, hidxh]

/-! ## §7¾  T-walk, representation faithfulness: the walk survives the round trip

`chainBefore` is a strict linear order (irreflexive, antisymmetric, total), so
a `Nodup` list that is pairwise `chainBefore` is the *unique* sorted
enumeration of its element set (`chainBefore_sorted_ext`). Hence the walk is
determined by the live-chain set alone: building the run table, recovering the
state, and walking it reproduces the original walk verbatim
(`walk_stateOf_tableOf`). This is the display-identity gate at the level of
the representation round trip. The fully table-*direct* structural walk,
emitting run by run without ever materializing `stateOf`, is `tableWalk`
(§7⅞ below), with `tableWalk_tableOf` its generic faithfulness theorem; the
D1 instance SPOT pins it concretely. -/

/-- Inversion of `chainBefore` into its two verdict shapes. -/
theorem chainBefore_inv {c1 c2 : List ℕ} (h : chainBefore c1 c2) :
    (∃ ext, ext ≠ [] ∧ c2 = c1 ++ ext) ∨
    (∃ p d e t1 t2, e < d ∧ c1 = p ++ d :: t1 ∧ c2 = p ++ e :: t2) := by
  cases h with
  | ancestor ch ext hne => exact Or.inl ⟨ext, hne, rfl⟩
  | newer p d e t1 t2 hlt => exact Or.inr ⟨p, d, e, t1, t2, hlt, rfl, rfl⟩

theorem chainBefore_ne {c1 c2 : List ℕ} (h : chainBefore c1 c2) : c1 ≠ c2 := by
  cases h with
  | ancestor ch ext hne =>
      intro heq
      have hl := congrArg List.length heq
      simp only [List.length_append] at hl
      exact hne (by rw [← List.length_eq_zero_iff]; omega)
  | newer p d e t1 t2 hlt =>
      intro heq
      have h2 := List.append_cancel_left heq
      injection h2 with h3 _
      omega

theorem chainBefore_irrefl (x : List ℕ) : ¬ chainBefore x x :=
  fun h => chainBefore_ne h rfl

theorem chainBefore_nil_right {z : List ℕ} (h : chainBefore z []) : False := by
  rcases chainBefore_inv h with ⟨ext, hne, heq⟩ | ⟨p, d, e, t1, t2, hlt, h1, h2⟩
  · exact hne (by rw [← List.length_eq_zero_iff]
                  have := congrArg List.length heq
                  simp only [List.length_append, List.length_nil] at this
                  omega)
  · simp at h2

/-- A shared head strips off the chain order. -/
theorem chainBefore_cons_strip {x : ℕ} {a b : List ℕ}
    (h : chainBefore (x :: a) (x :: b)) : chainBefore a b := by
  rcases chainBefore_inv h with ⟨ext, hne, heq⟩ | ⟨p, d, e, t1, t2, hlt, ha, hb⟩
  · rw [List.cons_append] at heq
    injection heq with _ h2
    rw [h2]
    exact chainBefore.ancestor a ext hne
  · cases p with
    | nil =>
        simp only [List.nil_append] at ha hb
        injection ha with h3 _
        injection hb with h5 _
        rw [← h3, ← h5] at hlt
        exact absurd hlt (Nat.lt_irrefl x)
    | cons y p' =>
        rw [List.cons_append] at ha hb
        injection ha with _ h4
        injection hb with _ h6
        rw [h4, h6]
        exact chainBefore.newer p' d e t1 t2 hlt

/-- Distinct heads decide the chain order at position 0: the larger label
displays first. -/
theorem chainBefore_cons_head_lt {x y : ℕ} {xs ys : List ℕ} (hxy : x ≠ y)
    (h : chainBefore (x :: xs) (y :: ys)) : y < x := by
  rcases chainBefore_inv h with ⟨ext, hne, heq⟩ | ⟨p, d, e, t1, t2, hlt, ha, hb⟩
  · rw [List.cons_append] at heq
    injection heq with hyx _
    exact absurd hyx.symm hxy
  · cases p with
    | nil =>
        simp only [List.nil_append] at ha hb
        injection ha with hxd _
        injection hb with hye _
        rw [hxd, hye]; exact hlt
    | cons z p' =>
        rw [List.cons_append] at ha hb
        injection ha with hxz _
        injection hb with hyz _
        exact absurd (hxz.trans hyz.symm) hxy

theorem chainBefore_asymm : ∀ {c1 c2 : List ℕ},
    chainBefore c1 c2 → ¬ chainBefore c2 c1 := by
  intro c1
  induction c1 with
  | nil => intro c2 _ h'; exact chainBefore_nil_right h'
  | cons x xs ih =>
      intro c2 h h'
      cases c2 with
      | nil => exact chainBefore_nil_right h
      | cons y ys =>
          by_cases hxy : x = y
          · subst hxy
            exact ih (chainBefore_cons_strip h) (chainBefore_cons_strip h')
          · have h1 := chainBefore_cons_head_lt hxy h
            have h2 := chainBefore_cons_head_lt (Ne.symm hxy) h'
            omega

/-- **Uniqueness of the sorted enumeration**: a `Nodup`, pairwise-`chainBefore`
list is fixed by its element set (`chainBefore` is a strict linear order). -/
theorem chainBefore_sorted_ext : ∀ {l l' : List (List ℕ)},
    l.Pairwise chainBefore → l'.Pairwise chainBefore →
    (∀ c, c ∈ l ↔ c ∈ l') → l = l'
  | [], [], _, _, _ => rfl
  | [], _ :: _, _, _, hmem =>
      absurd ((hmem _).mpr List.mem_cons_self) (by simp)
  | _ :: _, [], _, _, hmem =>
      absurd ((hmem _).mp List.mem_cons_self) (by simp)
  | x :: xs, y :: ys, hs, hs', hmem => by
      rcases List.pairwise_cons.mp hs with ⟨hx, hxs⟩
      rcases List.pairwise_cons.mp hs' with ⟨hy, hys⟩
      have hxy : x = y := by
        rcases List.mem_cons.mp ((hmem x).mp List.mem_cons_self) with h | h
        · exact h
        · rcases List.mem_cons.mp ((hmem y).mpr List.mem_cons_self) with h' | h'
          · exact h'.symm
          · exact absurd (hy x h) (chainBefore_asymm (hx y h'))
      subst hxy
      have htails : ∀ z, z ∈ xs ↔ z ∈ ys := by
        intro z
        constructor
        · intro hz
          rcases List.mem_cons.mp ((hmem z).mp (List.mem_cons_of_mem _ hz))
            with rfl | h
          · exact absurd (hx z hz) (chainBefore_irrefl _)
          · exact h
        · intro hz
          rcases List.mem_cons.mp ((hmem z).mpr (List.mem_cons_of_mem _ hz))
            with rfl | h
          · exact absurd (hy z hz) (chainBefore_irrefl _)
          · exact h
      rw [chainBefore_sorted_ext hxs hys htails]

/-- **T-walk, representation round trip**: building the run table from `L`,
recovering the state, and walking it reproduces `walk L` exactly, the walk is
a function of the live-chain set, so it survives the representation round trip
losslessly. No stability hypothesis. -/
theorem walk_stateOf_tableOf {L : List (List ℕ)} (hnil : [] ∉ L) :
    walk (stateOf (tableOf L)) = walk L := by
  have hiff := (stateOf_tableOf L hnil).2
  have hnil' : [] ∉ stateOf (tableOf L) := fun h => hnil ((hiff []).mp h)
  refine chainBefore_sorted_ext (walk_pairwise _) (walk_pairwise _) ?_
  intro c
  rw [mem_walk hnil', mem_walk hnil]
  exact hiff c

/-! ## §7⅞  The literal T-walk: emit the display from the TABLE alone

`walk` (§6) consults the state; `tableWalk` below consults nothing but the
table, entry headers, parent references, and the `hsAt` address arithmetic;
`stateOf` is never materialized. This is the formal face of the O(display)
reading claim: one pass over the entries in walk order emits the document.
`tableWalk_tableOf` is the generic faithfulness theorem (the D1 SPOT
`spot_d1_tableWalk` pins it concretely). -/

/-- Entry at an index, total (defaulted out of range). -/
def entryAt (T : Table) (j : ℕ) : RTEntry := T.getD j ⟨none, false, 0, 0⟩

theorem entryAt_eq {T : Table} {j : ℕ} (hj : j < T.length) :
    entryAt T j = T[j] := by
  rw [entryAt, List.getD_eq_getElem?_getD, List.getElem?_eq_getElem hj]
  rfl

/-- The indices of the entries attached at entry `i`, newest label first. -/
def attachedAt (T : Table) (i : ℕ) : List ℕ :=
  ((List.range T.length).filter
    (fun j => (entryAt T j).par.map Prod.fst == some i)).mergeSort
    (fun j k => decide ((entryAt T k).delta ≤ (entryAt T j).delta))

/-- The root entries, newest label first. -/
def rootsAt (T : Table) : List ℕ :=
  ((List.range T.length).filter
    (fun j => (entryAt T j).par == none)).mergeSort
    (fun j k => decide ((entryAt T k).delta ≤ (entryAt T j).delta))

/-- The walk below one entry, consulting the table alone. -/
def walkT (T : Table) : ℕ → ℕ → List (List ℕ)
  | 0, _ => []
  | fuel + 1, i =>
      (if (entryAt T i).live
       then (List.range (entryAt T i).len).map
         (fun k => hsAt T i ++ List.replicate k 1)
       else [])
      ++ (attachedAt T i).flatMap (walkT T fuel)

/-- Table fuel: the `len` total bounds every chain length (`maxLen`). -/
def fuelOf (T : Table) : ℕ := (T.map RTEntry.len).sum + 1

/-- **The literal T-walk**: the display, emitted run by run directly from
the table. -/
def tableWalk (T : Table) : List (List ℕ) :=
  (rootsAt T).flatMap (walkT T (fuelOf T))

theorem mem_attachedAt {T : Table} {i j : ℕ} :
    j ∈ attachedAt T i
      ↔ j < T.length ∧ ∃ off, (entryAt T j).par = some (i, off) := by
  rw [attachedAt, List.mem_mergeSort, List.mem_filter, List.mem_range]
  constructor
  · rintro ⟨h1, h2⟩
    refine ⟨h1, ?_⟩
    rw [beq_iff_eq] at h2
    cases hp : (entryAt T j).par with
    | none =>
        rw [hp] at h2
        simp at h2
    | some pr =>
        obtain ⟨p1, p2⟩ := pr
        rw [hp] at h2
        simp only [Option.map_some] at h2
        injection h2 with h2
        exact ⟨p2, by rw [h2]⟩
  · rintro ⟨h1, off, h2⟩
    exact ⟨h1, by rw [beq_iff_eq, h2]; rfl⟩

theorem mem_rootsAt {T : Table} {j : ℕ} :
    j ∈ rootsAt T ↔ j < T.length ∧ (entryAt T j).par = none := by
  rw [rootsAt, List.mem_mergeSort, List.mem_filter, List.mem_range]
  constructor
  · rintro ⟨h1, h2⟩
    rw [beq_iff_eq] at h2
    exact ⟨h1, h2⟩
  · rintro ⟨h1, h2⟩
    exact ⟨h1, by rw [beq_iff_eq]; exact h2⟩

/-- Strictly delta-descending lists are fixed by their member set. -/
theorem deltaDesc_sorted_ext : ∀ {l l' : List (List ℕ)},
    l.Pairwise (fun a b => b.getLastD 0 < a.getLastD 0) →
    l'.Pairwise (fun a b => b.getLastD 0 < a.getLastD 0) →
    (∀ c, c ∈ l ↔ c ∈ l') → l = l'
  | [], [], _, _, _ => rfl
  | [], y :: ys, _, _, hmem =>
      absurd ((hmem y).mpr List.mem_cons_self) (by simp)
  | x :: xs, [], _, _, hmem =>
      absurd ((hmem x).mp List.mem_cons_self) (by simp)
  | x :: xs, y :: ys, hs, hs', hmem => by
      rcases List.pairwise_cons.mp hs with ⟨hx, hxs⟩
      rcases List.pairwise_cons.mp hs' with ⟨hy, hys⟩
      have hxy : x = y := by
        rcases List.mem_cons.mp ((hmem x).mp List.mem_cons_self) with h | h
        · exact h
        · rcases List.mem_cons.mp ((hmem y).mpr List.mem_cons_self)
            with h' | h'
          · exact h'.symm
          · have h1 := hy x h
            have h2 := hx y h'
            omega
      subst hxy
      have htails : ∀ z, z ∈ xs ↔ z ∈ ys := by
        intro z
        constructor
        · intro hz
          rcases List.mem_cons.mp ((hmem z).mp (List.mem_cons_of_mem _ hz))
            with heq | h
          · rw [heq] at hz
            have := hx x hz
            omega
          · exact h
        · intro hz
          rcases List.mem_cons.mp ((hmem z).mpr (List.mem_cons_of_mem _ hz))
            with heq | h
          · rw [heq] at hz
            have := hy x hz
            omega
          · exact h
      rw [deltaDesc_sorted_ext hxs hys htails]

theorem childHeads_pairwise_strict (L : List (List ℕ)) (m : List ℕ) :
    (childHeads L m).Pairwise (fun a b => b.getLastD 0 < a.getLastD 0) := by
  have hs := (sorted_childHeads L m).and
    (List.nodup_iff_pairwise_ne.mp (nodup_childHeads L m))
  refine hs.imp_of_mem ?_
  intro q q' hqm hqm' hqq
  obtain ⟨hle, hne⟩ := hqq
  rcases Nat.lt_or_ge (q'.getLastD 0) (q.getLastD 0) with h | h
  · exact h
  · exfalso
    apply hne
    have e1 := (mem_childHeads.mp hqm).2
    have e2 := (mem_childHeads.mp hqm').2
    have hd : q.getLastD 0 = q'.getLastD 0 := by omega
    conv_lhs => rw [concat_getLastD
      (kept_ne_nil (isHead_kept (mem_childHeads.mp hqm).1))]
    conv_rhs => rw [concat_getLastD
      (kept_ne_nil (isHead_kept (mem_childHeads.mp hqm').1))]
    rw [e1, e2, hd]

theorem attachedAt_nodup (T : Table) (i : ℕ) : (attachedAt T i).Nodup :=
  (List.mergeSort_perm _ _).nodup_iff.mpr (List.nodup_range.filter _)

theorem rootsAt_nodup (T : Table) : (rootsAt T).Nodup :=
  (List.mergeSort_perm _ _).nodup_iff.mpr (List.nodup_range.filter _)

theorem attachedAt_pairwise_delta (T : Table) (i : ℕ) :
    (attachedAt T i).Pairwise (fun j k =>
      decide ((entryAt T k).delta ≤ (entryAt T j).delta) = true) := by
  apply List.pairwise_mergeSort
  · intro a b c h1 h2
    rw [decide_eq_true_eq] at h1 h2 ⊢
    omega
  · intro a b
    simp only [Bool.or_eq_true, decide_eq_true_eq]
    omega

theorem rootsAt_pairwise_delta (T : Table) :
    (rootsAt T).Pairwise (fun j k =>
      decide ((entryAt T k).delta ≤ (entryAt T j).delta) = true) := by
  apply List.pairwise_mergeSort
  · intro a b c h1 h2
    rw [decide_eq_true_eq] at h1 h2 ⊢
    omega
  · intro a b
    simp only [Bool.or_eq_true, decide_eq_true_eq]
    omega

/-- Attached entries map to the child heads at the parent's tail, order
included (both are strictly delta-descending). -/
theorem attachedAt_map_hsAt {T : Table} (hC : Canonical T) {i : ℕ}
    (hi : i < T.length) :
    (attachedAt T i).map (hsAt T)
      = childHeads (stateOf T) (tailOf (stateOf T) (hsAt T i)) := by
  refine deltaDesc_sorted_ext ?_ (childHeads_pairwise_strict _ _) ?_
  · rw [List.pairwise_map]
    refine ((attachedAt_pairwise_delta T i).and
      (List.nodup_iff_pairwise_ne.mp (attachedAt_nodup T i))).imp_of_mem ?_
    intro j k hj hk hjk
    obtain ⟨hle, hne⟩ := hjk
    rw [decide_eq_true_eq] at hle
    obtain ⟨hjl, offj, hpj⟩ := mem_attachedAt.mp hj
    obtain ⟨hkl, offk, hpk⟩ := mem_attachedAt.mp hk
    rw [entryAt_eq hjl] at hpj
    rw [entryAt_eq hkl] at hpk
    rw [entryAt_eq hjl, entryAt_eq hkl] at hle
    have hjb := hC.par_back j hjl _ hpj
    have hkb := hC.par_back k hkl _ hpk
    have hformj := hsAt_some hjl hpj hjb
    have hformk := hsAt_some hkl hpk hkb
    have hgj : (hsAt T j).getLastD 0 = T[j].delta := by
      rw [hformj, List.getLastD_concat]
    have hgk : (hsAt T k).getLastD 0 = T[k].delta := by
      rw [hformk, List.getLastD_concat]
    rw [hgj, hgk]
    rcases Nat.lt_or_ge T[k].delta T[j].delta with h | h
    · exact h
    · exfalso
      have hdeq : T[j].delta = T[k].delta := by omega
      have hoffj : offj = T[i].len - 1 := hC.par_tail j hjl _ hpj hi
      have hoffk : offk = T[i].len - 1 := hC.par_tail k hkl _ hpk hi
      exact hne (hsAt_inj hC hjl hkl
        (by rw [hformj, hformk, hdeq, hoffj, hoffk]))
  · intro c
    rw [List.mem_map, mem_childHeads]
    constructor
    · rintro ⟨j, hj, rfl⟩
      obtain ⟨hjl, off, hpj⟩ := mem_attachedAt.mp hj
      rw [entryAt_eq hjl] at hpj
      have hjb : i < j := hC.par_back j hjl _ hpj
      have hform := hsAt_some hjl hpj hjb
      have hofftail : off = T[i].len - 1 := hC.par_tail j hjl _ hpj hi
      refine ⟨(isHead_stateOf_iff hC).mpr ⟨j, hjl, rfl⟩, ?_⟩
      rw [hform, List.dropLast_concat, tailOf, lenOf_stateOf hC hi, hofftail]
    · rintro ⟨hqh, hqd⟩
      obtain ⟨j, hjl, rfl⟩ := (isHead_stateOf_iff hC).mp hqh
      refine ⟨j, mem_attachedAt.mpr ⟨hjl, ?_⟩, rfl⟩
      cases hp : T[j].par with
      | none =>
          exfalso
          have hform := hsAt_none hjl hp
          rw [hform] at hqd
          have htne : tailOf (stateOf T) (hsAt T i) ≠ [] := by
            rw [tailOf]
            intro hnil2
            have := congrArg List.length hnil2
            simp only [List.length_append, List.length_replicate,
              List.length_nil] at this
            have h2 := List.length_pos_iff.mpr (hsAt_ne_nil hC hi)
            omega
          exact htne (by rw [← hqd]; rfl)
      | some pr =>
          have hjb := hC.par_back j hjl pr hp
          have hplen : pr.1 < T.length := by omega
          have hform := hsAt_some hjl hp hjb
          have hptail : pr.2 = T[pr.1].len - 1 :=
            hC.par_tail j hjl pr hp hplen
          rw [hform, List.dropLast_concat, tailOf, lenOf_stateOf hC hi]
            at hqd
          have hlp : 1 ≤ T[pr.1].len :=
            hC.len_pos _ (List.getElem_mem hplen)
          have hli : 1 ≤ T[i].len := hC.len_pos _ (List.getElem_mem hi)
          obtain ⟨hpe, hoe⟩ := memChain_inj' hC hplen (by omega) hi
            (by omega) hqd
          refine ⟨pr.2, ?_⟩
          rw [entryAt_eq hjl, hp, ← hpe]

theorem rootsAt_map_hsAt {T : Table} (hC : Canonical T) :
    (rootsAt T).map (hsAt T) = childHeads (stateOf T) [] := by
  refine deltaDesc_sorted_ext ?_ (childHeads_pairwise_strict _ _) ?_
  · rw [List.pairwise_map]
    refine ((rootsAt_pairwise_delta T).and
      (List.nodup_iff_pairwise_ne.mp (rootsAt_nodup T))).imp_of_mem ?_
    intro j k hj hk hjk
    obtain ⟨hle, hne⟩ := hjk
    rw [decide_eq_true_eq] at hle
    obtain ⟨hjl, hpj⟩ := mem_rootsAt.mp hj
    obtain ⟨hkl, hpk⟩ := mem_rootsAt.mp hk
    rw [entryAt_eq hjl] at hpj
    rw [entryAt_eq hkl] at hpk
    rw [entryAt_eq hjl, entryAt_eq hkl] at hle
    have hgj : hsAt T j = [T[j].delta] := hsAt_none hjl hpj
    have hgk : hsAt T k = [T[k].delta] := hsAt_none hkl hpk
    rw [hgj, hgk]
    show T[k].delta < T[j].delta
    rcases Nat.lt_or_ge T[k].delta T[j].delta with h | h
    · exact h
    · exfalso
      have hdeq : T[j].delta = T[k].delta := by omega
      exact hne (hsAt_inj hC hjl hkl (by rw [hgj, hgk, hdeq]))
  · intro c
    rw [List.mem_map, mem_childHeads]
    constructor
    · rintro ⟨j, hj, rfl⟩
      obtain ⟨hjl, hpj⟩ := mem_rootsAt.mp hj
      rw [entryAt_eq hjl] at hpj
      refine ⟨(isHead_stateOf_iff hC).mpr ⟨j, hjl, rfl⟩, ?_⟩
      rw [hsAt_none hjl hpj]
      rfl
    · rintro ⟨hqh, hqd⟩
      obtain ⟨j, hjl, rfl⟩ := (isHead_stateOf_iff hC).mp hqh
      refine ⟨j, mem_rootsAt.mpr ⟨hjl, ?_⟩, rfl⟩
      rw [entryAt_eq hjl]
      cases hp : T[j].par with
      | none => rfl
      | some pr =>
          exfalso
          have hjb := hC.par_back j hjl pr hp
          have hform := hsAt_some hjl hp hjb
          rw [hform, List.dropLast_concat] at hqd
          have := hsAt_ne_nil hC (show pr.1 < T.length by omega)
          cases hs : hsAt T pr.1 with
          | nil => exact this hs
          | cons a as =>
              rw [hs] at hqd
              simp at hqd

theorem flatMap_congr_mem {α β : Type} {l : List α} {f g : α → List β}
    (h : ∀ a ∈ l, f a = g a) : l.flatMap f = l.flatMap g := by
  induction l with
  | nil => rfl
  | cons a l ih =>
      rw [List.flatMap_cons, List.flatMap_cons, h a List.mem_cons_self,
        ih (fun a' ha' => h a' (List.mem_cons_of_mem _ ha'))]

theorem flatMap_map' {α β γ : Type} (l : List α) (f : α → β)
    (g : β → List γ) :
    (l.map f).flatMap g = l.flatMap (fun a => g (f a)) := by
  induction l with
  | nil => rfl
  | cons a l ih =>
      rw [List.map_cons, List.flatMap_cons, List.flatMap_cons, ih]

/-- **The T-walk simulation**: at matched fuel, the table-direct walk below
entry `i` IS the state walk below its head. -/
theorem walkT_eq_walkE {T : Table} (hC : Canonical T) :
    ∀ fuel i, i < T.length →
      walkT T fuel i = walkE (stateOf T) fuel (hsAt T i) := by
  intro fuel
  induction fuel with
  | zero =>
      intro i hi
      rfl
  | succ fuel ih =>
      intro i hi
      rw [walkT, walkE, entryAt_eq hi]
      have hlive : (hsAt T i ∈ stateOf T) ↔ T[i].live = true := by
        have := memChain_live_iff hC hi (hC.len_pos _ (List.getElem_mem hi))
        simpa using this
      have hchild : (attachedAt T i).flatMap (walkT T fuel)
          = (childHeads (stateOf T) (tailOf (stateOf T) (hsAt T i))).flatMap
              (walkE (stateOf T) fuel) := by
        rw [← attachedAt_map_hsAt hC hi, flatMap_map']
        refine flatMap_congr_mem ?_
        intro j hj
        exact ih j (mem_attachedAt.mp hj).1
      rw [hchild, lenOf_stateOf hC hi]
      by_cases hl : T[i].live = true
      · rw [if_pos hl, if_pos (hlive.mpr hl)]
      · rw [if_neg hl, if_neg (fun hm => hl (hlive.mp hm))]

/-- Recovered-head lengths are bounded by the prefix `len` total. -/
theorem hsAt_length_le {T : Table} (hC : Canonical T) :
    ∀ i, i < T.length →
      (hsAt T i).length ≤ ((T.take i).map RTEntry.len).sum + 1 := by
  intro i
  induction i using Nat.strongRecOn with
  | ind i ih =>
      intro hi
      cases hp : T[i].par with
      | none =>
          rw [hsAt_none hi hp]
          simp
      | some p =>
          have hpb := hC.par_back i hi p hp
          have hpl : p.1 < T.length := by omega
          rw [hsAt_some hi hp hpb]
          have h1 := ih p.1 hpb hpl
          have hp2 : p.2 = T[p.1].len - 1 := hC.par_tail i hi p hp hpl
          have hlp : 1 ≤ T[p.1].len := hC.len_pos _ (List.getElem_mem hpl)
          have hmin : min (p.1 + 1) i = p.1 + 1 := by omega
          have h2 : T.take i = T.take (p.1 + 1) ++ (T.take i).drop (p.1 + 1)
              := by
            conv_lhs => rw [← List.take_append_drop (p.1 + 1) (T.take i)]
            rw [List.take_take, hmin]
          have h3 : ((T.take i).map RTEntry.len).sum
              = ((T.take (p.1 + 1)).map RTEntry.len).sum
                + (((T.take i).drop (p.1 + 1)).map RTEntry.len).sum := by
            conv_lhs => rw [h2]
            rw [List.map_append, List.sum_append]
          have h4 : T.take (p.1 + 1) = T.take p.1 ++ [T[p.1]] := by
            rw [List.take_succ, List.getElem?_eq_getElem hpl]
            rfl
          have h5 : ((T.take (p.1 + 1)).map RTEntry.len).sum
              = ((T.take p.1).map RTEntry.len).sum + T[p.1].len := by
            rw [h4, List.map_append, List.sum_append]
            simp [RTEntry.len]
          simp only [List.length_append, List.length_replicate,
            List.length_cons, List.length_nil]
          omega

theorem foldr_max_le {S : ℕ} : ∀ (l : List ℕ), (∀ y ∈ l, y ≤ S) →
    l.foldr max 0 ≤ S
  | [], _ => by simp
  | y :: ys, hall => by
      simp only [List.foldr_cons]
      exact Nat.max_le.mpr ⟨hall y List.mem_cons_self,
        foldr_max_le ys (fun z hz => hall z (List.mem_cons_of_mem _ hz))⟩

/-- The table's `len` total bounds every kept-chain length of its state. -/
theorem maxLen_stateOf_le {T : Table} (hC : Canonical T) :
    maxLen (stateOf T) ≤ (T.map RTEntry.len).sum := by
  rw [maxLen]
  refine foldr_max_le _ ?_
  intro y hy
  obtain ⟨c, hc, rfl⟩ := List.mem_map.mp hy
  obtain ⟨i, hi, k, hk, rfl⟩ := (kept_stateOf_iff hC).mp hc
  have h1 := hsAt_length_le hC i hi
  have h2 : ((T.take i).map RTEntry.len).sum + T[i].len
      ≤ (T.map RTEntry.len).sum := by
    have hdrop : T.drop i = T[i] :: T.drop (i + 1) :=
      List.drop_eq_getElem_cons hi
    have h3 : (T.map RTEntry.len).sum
        = ((T.take i).map RTEntry.len).sum
          + ((T.drop i).map RTEntry.len).sum := by
      conv_lhs => rw [← List.take_append_drop i T]
      rw [List.map_append, List.sum_append]
    rw [h3, hdrop]
    simp only [List.map_cons, List.sum_cons]
    omega
  simp only [List.length_append, List.length_replicate]
  omega

/-- Fuel irrelevance: any two sufficient fuels emit the same walk. -/
theorem walkE_fuel_ext {L : List (List ℕ)} (hnil : [] ∉ L) {h : List ℕ}
    (hh : isHead L h = true) {f1 f2 : ℕ}
    (h1 : maxLen L + 1 - h.length ≤ f1)
    (h2 : maxLen L + 1 - h.length ≤ f2) :
    walkE L f1 h = walkE L f2 h := by
  refine chainBefore_sorted_ext (walkE_pairwise f1 h hh)
    (walkE_pairwise f2 h hh) ?_
  intro c
  have hmemf : ∀ f, maxLen L + 1 - h.length ≤ f →
      (c ∈ walkE L f h ↔ c ∈ L ∧ h <+: c) := by
    intro f hf
    constructor
    · intro hc
      exact walkE_sound f h c hh hc
    · rintro ⟨hcl, hpre⟩
      exact walkE_complete f h c hh hcl
        (kept_of_live hcl (fun hn => hnil (hn ▸ hcl))) hpre hf
  rw [hmemf f1 h1, hmemf f2 h2]

theorem stateOf_nil_not_mem {T : Table} (hC : Canonical T) :
    [] ∉ stateOf T := by
  intro hm
  obtain ⟨i, hi, k, hk, heq⟩ := mem_stateOf.mp hm
  have hne := hsAt_ne_nil hC hi
  cases hs : hsAt T i with
  | nil => exact hne hs
  | cons a as =>
      rw [hs] at heq
      simp at heq

/-- **T-walk, literal (canonical tables)**: the table-direct walk of any
canonical table IS the state walk of its denotation. -/
theorem tableWalk_eq_walk {T : Table} (hC : Canonical T) :
    tableWalk T = walk (stateOf T) := by
  have hnil := stateOf_nil_not_mem hC
  rw [tableWalk, walk, ← rootsAt_map_hsAt hC, flatMap_map']
  refine flatMap_congr_mem ?_
  intro j hj
  obtain ⟨hjl, hpar⟩ := mem_rootsAt.mp hj
  rw [walkT_eq_walkE hC _ j hjl]
  refine walkE_fuel_ext hnil ((isHead_stateOf_iff hC).mpr ⟨j, hjl, rfl⟩)
    ?_ ?_
  · have hb := maxLen_stateOf_le hC
    rw [fuelOf]
    omega
  · omega

/-- **T-walk, literal: the generic faithfulness theorem**: building the run
table and reading it back with the table-direct walk reproduces the display
of the live-chain set, verbatim. The O(display)-time reading claim's formal
face; no stability hypothesis. -/
theorem tableWalk_tableOf {L : List (List ℕ)} (hnil : [] ∉ L) :
    tableWalk (tableOf L) = walk L :=
  (tableWalk_eq_walk (canonical_tableOf L)).trans (walk_stateOf_tableOf hnil)

/-! ## §8  Axiom audit -/

#print axioms tail_attachment
#print axioms head_parent_is_tail
#print axioms stateOf_tableOf
#print axioms tableOf_stateOf
#print axioms cmpTable_iff_chainBefore
#print axioms cmpTable_eq_keyLt
#print axioms walk_display
#print axioms walk_pairwise_keyLt
#print axioms tableOf_congr
#print axioms tableOf_insert_extend
#print axioms canonical_tableOf
#print axioms mem_keptL_snoc
#print axioms delete_keptL_eq
#print axioms delete_fusible_x_false
#print axioms split_succ_isHead
#print axioms materialize_kept
#print axioms coalesce_restored
#print axioms chainBefore_asymm
#print axioms chainBefore_sorted_ext
#print axioms walk_stateOf_tableOf
#print axioms tableOf_materialize
#print axioms tableOf_insert_split
#print axioms tableOf_delete_split
#print axioms tableOf_coalesce
#print axioms tableWalk_eq_walk
#print axioms tableWalk_tableOf

end Sal.EmbedRGA.RunTable
