diff --git a/BusyBeaver.lean b/BusyBeaver.lean index 2b2a62fc..2ecf1bfb 100644 --- a/BusyBeaver.lean +++ b/BusyBeaver.lean @@ -8,6 +8,9 @@ public import BusyBeaver.Defs public import BusyBeaver.Basic public import BusyBeaver.Bridge public import BusyBeaver.Cert +public import BusyBeaver.WordRLE +public import BusyBeaver.AffRLE +public import BusyBeaver.ElabRLE public import BusyBeaver.BB6.M_1RB0LB_1LC0RE_1LA1LD_0LCHHH_0RB0RF_1RE1RB public import BusyBeaver.BB6.M_1RB0LC_0LC0RF_1RD1LC_0RA1LE_HHH0LD_1LF1LA public import BusyBeaver.BB6.M_1RB0LC_0LC1RF_1LE1RD_0RC1RC_0LA1LA_HHH1RA @@ -22,6 +25,7 @@ public import BusyBeaver.BB6.M_1RB0LE_0RC1RC_0RD1LA_1LD0LA_1LF1LC_HHH1LC public import BusyBeaver.BB6.M_1RB0LE_1LC1RA_1RA1LD_0LC0LA_0RE1RF_0RCHHH public import BusyBeaver.BB6.M_1RB0LF_1LC0LD_1RD1LB_HHH1RE_0RA1RE_1LA0LE public import BusyBeaver.BB6.M_1RB0LF_1LC1RA_0RE0RD_HHH1LE_1LF1RC_1LC1LA +public import BusyBeaver.BB6.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH public import BusyBeaver.BB6.M_1RB0LF_1RC1RA_0RD0RB_1LEHHH_0LA1LE_1RD1LA public import BusyBeaver.BB6.M_1RB0RB_1LB0LC_1RD1LC_1RE0RA_0RF1RA_HHH1LB public import BusyBeaver.BB6.M_1RB0RB_1LC1RE_1LF0LD_1RA1LD_1RC1RB_HHH1LC diff --git a/BusyBeaver/AffRLE.lean b/BusyBeaver/AffRLE.lean new file mode 100644 index 00000000..691a83c4 --- /dev/null +++ b/BusyBeaver/AffRLE.lean @@ -0,0 +1,1992 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.WordRLE + +/-! +# Symbolic Affine Run-Length Certificates (`BusyBeaver.AffRLE`) + +Machine-polymorphic reflective verifier for symbolic families of Turing machine configurations +whose word-run exponents and step counts are affine functions `a * k + b` of a parameter `k : ℕ`: + +- `AffNat` (`a * k + b`) & `AffCfg` — Symbolic RLE stacks over composite vocabulary words. +- `CompExit` & `checkExitEntry` — Radix-trie composite word-exit certificates verified against + `WordRLE.runCompositeExit`. +- `stepAffOnce` — Single symbolic RLE step supporting `O(1)` homogeneous affine sweeps (`a * k + b` + copies in `(a * dt) * k + b * dt` steps) and exact target-remainder partial sweeps. +- `Aff2Nat` (`a * k + b + dp * j - dn * j`) & `verifyCycle` — Certified symbolic inner-loop + acceleration discharging `K(k)` multi-step macro-cycles in `O(L)` kernel work. +- `ReturnCert` & `verifyReturnCert_sound` — Complete symbolic family transition verifier and + `IsNotHalt.of_aff_return` non-halting closure principle. +-/ + +@[expose] public section + +namespace BusyBeaver.AffRLE + +open Turing BusyBeaver.WordRLE + +/-! ## Affine Natural Numbers (`a * k + b`) -/ + +/-- Symbolic affine expression `a * k + b` over a non-negative integer parameter `k : ℕ`. -/ +structure AffNat where + /-- Linear coefficient of `k`. -/ + a : ℕ + /-- Constant offset. -/ + b : ℕ + deriving DecidableEq, Inhabited + +namespace AffNat + +/-- Evaluate `x` at parameter value `k : ℕ`. -/ +def eval (k : ℕ) (x : AffNat) : ℕ := + x.a * k + x.b + +/-- Force both coefficients of `x` to weak-head normal form before invoking `f`. -/ +@[inline] +def strict {α : Type*} (x : AffNat) (f : AffNat → α) : α := + withNat x.a fun a ↦ withNat x.b fun b ↦ f ⟨a, b⟩ + +@[simp] +theorem strict_eq {α : Type*} (x : AffNat) (f : AffNat → α) : x.strict f = f x := by + cases x + simp [strict] + +/-- Test whether `x` is identically `0` (`0 * k + 0`). -/ +def isZero (x : AffNat) : Bool := + Nat.beq x.a 0 && Nat.beq x.b 0 + +/-- Test whether `x` is identically `1` (`0 * k + 1`). -/ +def isOne (x : AffNat) : Bool := + Nat.beq x.a 0 && Nat.beq x.b 1 + +/-- Sufficient condition (`m ≤ x.b`) ensuring `m ≤ x.eval k` for all `k : ℕ`. -/ +def geConst (x : AffNat) (m : ℕ) : Bool := + Nat.ble m x.b + +/-- Pointwise sum `(x.a + y.a) * k + (x.b + y.b)` with CBV coefficient normalization. -/ +def add (x y : AffNat) : AffNat := + withNat (x.a + y.a) fun a ↦ withNat (x.b + y.b) fun b ↦ ⟨a, b⟩ + +/-- Coefficient-wise subtraction returning `some (x - y)` when `y.a ≤ x.a` and `y.b ≤ x.b`. -/ +def sub? (x y : AffNat) : Option AffNat := + if Nat.ble y.a x.a && Nat.ble y.b x.b then + withNat (x.a - y.a) fun a ↦ withNat (x.b - y.b) fun b ↦ some ⟨a, b⟩ + else none + +/-- Scalar product `(x.a * c) * k + (x.b * c)` with CBV coefficient normalization. -/ +def scale (x : AffNat) (c : ℕ) : AffNat := + withNat (x.a * c) fun a ↦ withNat (x.b * c) fun b ↦ ⟨a, b⟩ + +/-- Lexicographic order on `(a, b)` for selecting minimal cycle counts at discovery time. -/ +def lexLt (x y : AffNat) : Bool := + if Nat.beq x.a y.a then Nat.ble (x.b + 1) y.b else Nat.ble (x.a + 1) y.a + +theorem eval_eq_zero_of_isZero {x : AffNat} (h : x.isZero = true) (k : ℕ) : x.eval k = 0 := by + unfold isZero at h + simp only [Bool.and_eq_true] at h + have ha := Nat.eq_of_beq_eq_true h.1 + have hb := Nat.eq_of_beq_eq_true h.2 + simp [eval, ha, hb] + +theorem eval_eq_one_of_isOne {x : AffNat} (h : x.isOne = true) (k : ℕ) : x.eval k = 1 := by + unfold isOne at h + simp only [Bool.and_eq_true] at h + have ha := Nat.eq_of_beq_eq_true h.1 + have hb := Nat.eq_of_beq_eq_true h.2 + simp [eval, ha, hb] + +theorem le_eval_of_geConst {x : AffNat} {m : ℕ} (h : x.geConst m = true) (k : ℕ) : + m ≤ x.eval k := by + have hb : m ≤ x.b := Nat.le_of_ble_eq_true h + unfold eval + omega + +@[simp] +theorem eval_add (x y : AffNat) (k : ℕ) : (x.add y).eval k = x.eval k + y.eval k := by + simp only [add, withNat_eq, eval, Nat.add_mul] + omega + +theorem eval_sub? {x y z : AffNat} (h : x.sub? y = some z) (k : ℕ) : + x.eval k = y.eval k + z.eval k := by + unfold sub? at h + by_cases hle : (Nat.ble y.a x.a && Nat.ble y.b x.b) = true + · simp only [hle, ↓reduceIte, withNat_eq, Option.some.injEq] at h + subst h + simp only [Bool.and_eq_true] at hle + have ha : y.a ≤ x.a := Nat.le_of_ble_eq_true hle.1 + have hb : y.b ≤ x.b := Nat.le_of_ble_eq_true hle.2 + simp only [eval] + have hmul : y.a * k + (x.a - y.a) * k = x.a * k := by + rw [← Nat.add_mul, Nat.add_sub_of_le ha] + omega + · have hne : (Nat.ble y.a x.a && Nat.ble y.b x.b) = false := Bool.eq_false_iff.mpr hle + simp [hne] at h + +@[simp] +theorem eval_scale (x : AffNat) (c k : ℕ) : (x.scale c).eval k = c * x.eval k := by + simp only [scale, withNat_eq, eval] + calc + x.a * c * k + x.b * c = c * (x.a * k) + c * x.b := by + rw [Nat.mul_right_comm x.a c k, Nat.mul_comm c (x.a * k), Nat.mul_comm x.b c] + _ = c * (x.a * k + x.b) := by rw [← Nat.mul_add] + +theorem eval_scale_comm (x : AffNat) (c k : ℕ) : (x.scale c).eval k = x.eval k * c := by + rw [eval_scale, Nat.mul_comm] + +end AffNat + +/-! ## Symbolic Affine Stacks (`AffRun`, `AffCfg`) -/ + +/-- A symbolic run of `count(k)` copies of composite vocabulary word `wid`. -/ +structure AffRun where + /-- Composite word index in `vocab`. -/ + wid : ℕ + /-- Symbolic affine repetition count. -/ + count : AffNat + deriving DecidableEq, Inhabited + +/-- Force the top entry of an `AffRun` stack to weak-head normal form. -/ +@[inline] +def strictAffStack {α : Type*} (stk : List AffRun) (f : List AffRun → α) : α := + match stk with + | [] => f [] + | ⟨w, ⟨a, b⟩⟩ :: rest => + withNat w fun w' ↦ withNat a fun a' ↦ withNat b fun b' ↦ f (⟨w', ⟨a', b'⟩⟩ :: rest) + +@[simp] +theorem strictAffStack_eq {α : Type*} (stk : List AffRun) (f : List AffRun → α) : + strictAffStack stk f = f stk := by + rcases stk with _ | ⟨⟨w, ⟨a, b⟩⟩, rest⟩ <;> simp [strictAffStack] + +/-- CPS push of `count` copies of `wid` onto symbolic stack `stk`, suppressing blank `wid = 0` on +an empty stack and merging adjacent runs of the same word. -/ +def pushAffK {α : Type*} (wid : ℕ) (count : AffNat) (stk : List AffRun) + (f : Option (List AffRun) → α) : α := + if count.isZero then f (some stk) + else match stk with + | [] => + if Nat.beq wid 0 then f (some []) + else if count.geConst 1 then + withNat wid fun w' ↦ count.strict fun c' ↦ f (some [⟨w', c'⟩]) + else f none + | ⟨tw, tc⟩ :: rest => + if !count.geConst 1 then f none + else if Nat.beq tw wid then + (tc.add count).strict fun c' ↦ f (some (⟨tw, c'⟩ :: rest)) + else + withNat wid fun w' ↦ count.strict fun c' ↦ f (some (⟨w', c'⟩ :: ⟨tw, tc⟩ :: rest)) + +/-- Direct `Option`-returning push of `count` copies of `wid` onto `stk`. -/ +def pushAff (wid : ℕ) (count : AffNat) (stk : List AffRun) : Option (List AffRun) := + pushAffK wid count stk id + +theorem pushAffK_eq {α : Type*} (wid : ℕ) (count : AffNat) (stk : List AffRun) + (f : Option (List AffRun) → α) : + pushAffK wid count stk f = f (pushAff wid count stk) := by + unfold pushAff pushAffK + by_cases hz : count.isZero = true + · simp [hz] + · have hnz : count.isZero = false := Bool.eq_false_iff.mpr hz + rcases stk with _ | ⟨⟨tw, tc⟩, rest⟩ + · simp only [hnz, Bool.false_eq_true, ↓reduceIte] + by_cases hw : Nat.beq wid 0 = true + · simp [hw] + · have hnw : Nat.beq wid 0 = false := Bool.eq_false_iff.mpr hw + by_cases hg : count.geConst 1 = true + · simp [hnw, hg] + · have hng : count.geConst 1 = false := Bool.eq_false_iff.mpr hg + simp [hnw, hng] + · simp only [hnz, Bool.false_eq_true, ↓reduceIte] + by_cases hg : count.geConst 1 = true + · simp only [hg, Bool.not_true, Bool.false_eq_true, ↓reduceIte] + by_cases hw : Nat.beq tw wid = true + · simp [hw] + · have hnw : Nat.beq tw wid = false := Bool.eq_false_iff.mpr hw + simp [hnw] + · have hng : count.geConst 1 = false := Bool.eq_false_iff.mpr hg + simp [hng] + +/-- CPS pop of `count` copies from symbolic stack `stk`, popping `(0, [])` from `[]` when +`count = 1`. -/ +def popAffK {α : Type*} (count : AffNat) (stk : List AffRun) + (f : Option (ℕ × List AffRun) → α) : α := + match stk with + | [] => if count.isOne then f (some (0, [])) else f none + | ⟨tw, tc⟩ :: rest => + match tc.sub? count with + | none => f none + | some rem => + if rem.isZero then f (some (tw, rest)) + else if rem.geConst 1 then + rem.strict fun rem' ↦ f (some (tw, ⟨tw, rem'⟩ :: rest)) + else f none + +/-- Direct `Option`-returning pop of `count` copies from `stk`. -/ +def popAff (count : AffNat) (stk : List AffRun) : Option (ℕ × List AffRun) := + popAffK count stk id + +theorem popAffK_eq {α : Type*} (count : AffNat) (stk : List AffRun) + (f : Option (ℕ × List AffRun) → α) : + popAffK count stk f = f (popAff count stk) := by + unfold popAff popAffK + rcases stk with _ | ⟨⟨tw, tc⟩, rest⟩ + · by_cases h1 : count.isOne = true + · simp [h1] + · have hn1 : count.isOne = false := Bool.eq_false_iff.mpr h1 + simp [hn1] + · simp only + rcases hs : tc.sub? count with _ | rem + · rfl + · simp only + by_cases hz : rem.isZero = true + · simp [hz] + · have hnz : rem.isZero = false := Bool.eq_false_iff.mpr hz + by_cases hg : rem.geConst 1 = true + · simp [hnz, hg] + · have hng : rem.geConst 1 = false := Bool.eq_false_iff.mpr hg + simp [hnz, hng] + +/-- Push a spatial left-to-right list of constant `(wid, n)` runs onto a symbolic stack. -/ +def pushAffConstRuns : List (ℕ × ℕ) → List AffRun → List AffRun + | [], stk => stk + | (w, n) :: rest, stk => + match pushAff w ⟨0, n⟩ stk with + | some stk' => pushAffConstRuns rest stk' + | none => stk + +/-- Symbolic directed RLE configuration parameterized by `k : ℕ`. -/ +structure AffCfg where + /-- Current control state index. -/ + q : ℕ + /-- Head direction (`true` = right, `false` = left). -/ + dir : Bool + /-- Left symbolic RLE stack (nearest-to-head run first). -/ + left : List AffRun + /-- Right symbolic RLE stack (nearest-to-head run first). -/ + right : List AffRun + deriving DecidableEq, Inhabited + +/-- Construct an `AffCfg` with CBV-normalized state, direction, and stack heads. -/ +@[inline] +def mkStrictAffCfg (q : ℕ) (dir : Bool) (l r : List AffRun) : AffCfg := + withNat q fun q' ↦ + withBool dir fun d' ↦ + strictAffStack l fun l' ↦ + strictAffStack r fun r' ↦ + ⟨q', d', l', r'⟩ + +@[simp] +theorem mkStrictAffCfg_eq (q : ℕ) (dir : Bool) (l r : List AffRun) : + mkStrictAffCfg q dir l r = ⟨q, dir, l, r⟩ := by + simp [mkStrictAffCfg] + +/-! ## Composite Exit Table & Single-Step Affine RLE Transition -/ + +/-- Certified exit record for a composite vocabulary word. -/ +structure CompExit where + /-- Resulting composite vocabulary word index. -/ + wid' : ℕ + /-- Resulting control state index. -/ + q' : ℕ + /-- Resulting exit direction. -/ + dir' : Bool + /-- Exact number of TM steps taken inside the word. -/ + dt : ℕ + deriving DecidableEq, Inhabited + +/-- Pack `(wid, q, dir)` into a single `ℕ` trie key for a machine with `numStates` states. -/ +@[inline] +def compKey (numStates wid q : ℕ) (dir : Bool) : ℕ := + wid * (2 * numStates) + q * 2 + (if dir then 1 else 0) + +/-- Verify a single `(key, ex)` entry in an `exits` trie against `runCompositeExit`. -/ +def checkExitEntry (numStates : ℕ) + (baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)) + (vocab : NatTrie (BTree ℕ)) (key : ℕ) (ex : CompExit) : Bool := + let stride := 2 * numStates + if Nat.beq stride 0 then false + else + let wid := key / stride + let rem := key % stride + let q := rem / 2 + let dir := Nat.beq (rem % 2) 1 + match vocab.find? wid, vocab.find? ex.wid' with + | some uTree, some vTree => + runCompositeExit baseExit uTree.toList q dir == + some (vTree.toList, ex.q', ex.dir', ex.dt) + | _, _ => false + +/-- Check that `wid = 0` in `vocab` consists exclusively of blank base-word `0` indices. -/ +def checkVocabBlank0 (vocab : NatTrie (BTree ℕ)) : Bool := + match vocab.find? 0 with + | none => true + | some t => t.toList.all (Nat.beq · 0) + +/-- Execute one symbolic affine RLE step (either a 1-copy exit or a homogeneous sweep of the top +run, optionally clipped to `targetRem?` when dividing the remaining step budget cleanly). -/ +def stepAffOnce (numStates : ℕ) (exits : NatTrie CompExit) (targetRem? : Option AffNat) + (q : ℕ) (dir : Bool) (l r : List AffRun) : Option (AffNat × AffCfg) := + if !Nat.ble (q + 1) numStates then none + else + let src := if dir then r else l + let wid := match src with | [] => 0 | top :: _ => top.wid + match exits.find? (compKey numStates wid q dir) with + | none => none + | some ex => + let same := Nat.beq ex.q' q && Bool.beq ex.dir' dir + let count? : Option AffNat := + if same then + match src with + | [] => none + | top :: _ => + let full := top.count + match targetRem? with + | none => some full + | some rem => + if Nat.ble 1 ex.dt && Nat.beq (rem.a % ex.dt) 0 && Nat.beq (rem.b % ex.dt) 0 then + let part : AffNat := ⟨rem.a / ex.dt, rem.b / ex.dt⟩ + if part.geConst 1 && (full.sub? part).isSome then some part else some full + else some full + else some ⟨0, 1⟩ + match count? with + | none => none + | some count => + if dir then + popAffK count r fun + | none => none + | some (_, r') => + (count.scale ex.dt).strict fun dt ↦ + if ex.dir' then + pushAffK ex.wid' count l fun + | none => none + | some l₂ => some (dt, mkStrictAffCfg ex.q' true l₂ r') + else + pushAffK ex.wid' count r' fun + | none => none + | some r₂ => some (dt, mkStrictAffCfg ex.q' false l r₂) + else + popAffK count l fun + | none => none + | some (_, l') => + (count.scale ex.dt).strict fun dt ↦ + if ex.dir' then + pushAffK ex.wid' count l' fun + | none => none + | some l₂ => some (dt, mkStrictAffCfg ex.q' true l₂ r) + else + pushAffK ex.wid' count r fun + | none => none + | some r₂ => some (dt, mkStrictAffCfg ex.q' false l' r₂) + +/-! ## Two-Variable Inner-Cycle Verifier (`Aff2Nat`, `verifyCycle`) -/ + +/-- Symbolic expression `a * k + b + dp * j - dn * j` over outer parameter `k : ℕ` and inner loop +index `0 ≤ j ≤ K(k)`. -/ +structure Aff2Nat where + /-- Outer linear coefficient of `k`. -/ + a : ℕ + /-- Outer constant offset. -/ + b : ℕ + /-- Positive inner-loop slope (`+dp * j`). -/ + dp : ℕ + /-- Negative inner-loop slope (`-dn * j`). -/ + dn : ℕ + deriving DecidableEq, Inhabited + +namespace Aff2Nat + +/-- Evaluate `x` at outer parameter `k` and inner loop index `j`. -/ +def eval (k j : ℕ) (x : Aff2Nat) : ℕ := + x.a * k + x.b + x.dp * j - x.dn * j + +/-- Test whether `x` is identically `0`. -/ +def isZero (x : Aff2Nat) : Bool := + Nat.beq x.a 0 && Nat.beq x.b 0 && Nat.beq x.dp 0 && Nat.beq x.dn 0 + +/-- Extract constant `b` when `a = dp = dn = 0`. -/ +def isConst (x : Aff2Nat) : Option ℕ := + if Nat.beq x.a 0 && Nat.beq x.dp 0 && Nat.beq x.dn 0 then some x.b else none + +/-- Check that `x.dn * j + m ≤ x.a * k + x.b + x.dp * j` holds for all `k` and all +`j < K.eval k`. -/ +def geForLoop (x : Aff2Nat) (K : AffNat) (m : ℕ) : Bool := + if Nat.beq x.dn 0 then Nat.ble m x.b + else if Nat.ble x.dn x.dp then Nat.ble m x.b + else + let netN := x.dn - x.dp + Nat.ble (netN * K.a) x.a && Nat.ble (netN * K.b + m) (x.b + netN) + +/-- Add two `Aff2Nat` expressions, normalizing `(dp, dn)`. -/ +def add (x y : Aff2Nat) : Aff2Nat := + let p := x.dp + y.dp + let n := x.dn + y.dn + let (dp', dn') := if Nat.ble n p then (p - n, 0) else (0, n - p) + ⟨x.a + y.a, x.b + y.b, dp', dn'⟩ + +/-- Subtract `y` from `x` when valid throughout `0 ≤ j < K.eval k`. -/ +def sub? (x y : Aff2Nat) (K : AffNat) : Option Aff2Nat := + if Nat.ble y.a x.a && Nat.ble y.b x.b then + let a' := x.a - y.a + let b' := x.b - y.b + let p := x.dp + y.dn + let n := x.dn + y.dp + let (dp', dn') := if Nat.ble n p then (p - n, 0) else (0, n - p) + let res : Aff2Nat := ⟨a', b', dp', dn'⟩ + if res.geForLoop K 0 then some res else none + else none + +/-- Shift `j ↦ j + 1`: `a * k + (b + dp - dn) + dp * j - dn * j`. -/ +def shiftJ? (x : Aff2Nat) : Option Aff2Nat := + if Nat.ble x.dn (x.b + x.dp) then + some ⟨x.a, x.b + x.dp - x.dn, x.dp, x.dn⟩ + else none + +/-- Substitute `j = K.eval k` at loop completion. -/ +def atEnd? (x : Aff2Nat) (K : AffNat) : Option AffNat := + let pa := x.a + x.dp * K.a + let pb := x.b + x.dp * K.b + let na := x.dn * K.a + let nb := x.dn * K.b + if Nat.ble na pa && Nat.ble nb pb then + AffNat.strict ⟨pa - na, pb - nb⟩ some + else none + +theorem noUnderflow_of_geForLoop {x : Aff2Nat} {K : AffNat} {m k j : ℕ} + (hg : x.geForLoop K m = true) (hj : j < K.eval k) : + x.dn * j + m ≤ x.a * k + x.b + x.dp * j := by + unfold geForLoop at hg + by_cases hdn0 : Nat.beq x.dn 0 = true + · have h0 : x.dn = 0 := Nat.eq_of_beq_eq_true hdn0 + simp only [hdn0, ↓reduceIte] at hg + have hb : m ≤ x.b := Nat.le_of_ble_eq_true hg + rw [h0] + omega + · have hndn0 : Nat.beq x.dn 0 = false := Bool.eq_false_iff.mpr hdn0 + rw [hndn0] at hg + simp only [Bool.false_eq_true, ↓reduceIte] at hg + by_cases hle : Nat.ble x.dn x.dp = true + · simp only [hle, ↓reduceIte] at hg + have hdp : x.dn ≤ x.dp := Nat.le_of_ble_eq_true hle + have hb : m ≤ x.b := Nat.le_of_ble_eq_true hg + have hmul : x.dn * j ≤ x.dp * j := Nat.mul_le_mul_right j hdp + omega + · have hnle : Nat.ble x.dn x.dp = false := Bool.eq_false_iff.mpr hle + rw [hnle] at hg + simp only [Bool.false_eq_true, ↓reduceIte, Bool.and_eq_true] at hg + have hgt : x.dp < x.dn := by + have : ¬ x.dn ≤ x.dp := fun h ↦ hle (Nat.ble_eq.mpr h) + omega + have ha : (x.dn - x.dp) * K.a ≤ x.a := Nat.le_of_ble_eq_true hg.1 + have hb : (x.dn - x.dp) * K.b + m ≤ x.b + (x.dn - x.dp) := Nat.le_of_ble_eq_true hg.2 + unfold AffNat.eval at hj + have hj1 : (x.dn - x.dp) * (j + 1) ≤ (x.dn - x.dp) * (K.a * k + K.b) := + Nat.mul_le_mul_left (x.dn - x.dp) hj + have hak : (x.dn - x.dp) * K.a * k ≤ x.a * k := Nat.mul_le_mul_right k ha + have hexp1 : (x.dn - x.dp) * (j + 1) = (x.dn - x.dp) * j + (x.dn - x.dp) := by + rw [Nat.mul_add, Nat.mul_one] + have hexp2 : + (x.dn - x.dp) * (K.a * k + K.b) = (x.dn - x.dp) * K.a * k + (x.dn - x.dp) * K.b := by + rw [Nat.mul_add, Nat.mul_assoc] + have hnet : (x.dn - x.dp) * j + x.dp * j = x.dn * j := by + rw [← Nat.add_mul, Nat.sub_add_cancel (Nat.le_of_lt hgt)] + omega + +theorem eval_eq_zero_of_isZero {x : Aff2Nat} (h : x.isZero = true) (k j : ℕ) : + x.eval k j = 0 := by + unfold isZero at h + simp only [Bool.and_eq_true] at h + have ha := Nat.eq_of_beq_eq_true h.1.1.1 + have hb := Nat.eq_of_beq_eq_true h.1.1.2 + have hdp := Nat.eq_of_beq_eq_true h.1.2 + have hdn := Nat.eq_of_beq_eq_true h.2 + simp [eval, ha, hb, hdp, hdn] + +theorem isConst_eq {x : Aff2Nat} {c : ℕ} (h : x.isConst = some c) : + x = ⟨0, c, 0, 0⟩ := by + unfold isConst at h + by_cases hc : (Nat.beq x.a 0 && Nat.beq x.dp 0 && Nat.beq x.dn 0) = true + · simp only [hc, ↓reduceIte, Option.some.injEq] at h + simp only [Bool.and_eq_true] at hc + rcases x with ⟨a, b, dp, dn⟩ + simp only at hc h + have ha := Nat.eq_of_beq_eq_true hc.1.1 + have hdp := Nat.eq_of_beq_eq_true hc.1.2 + have hdn := Nat.eq_of_beq_eq_true hc.2 + subst ha; subst hdp; subst hdn; subst h + rfl + · have hnc := Bool.eq_false_iff.mpr hc + simp [hnc] at h + +theorem add_const_eval (x : Aff2Nat) (c k j : ℕ) + (hx : x.dn * j ≤ x.a * k + x.b + x.dp * j) : + (x.add ⟨0, c, 0, 0⟩).eval k j = x.eval k j + c := by + unfold add eval + simp only [Nat.add_zero] + by_cases hle : Nat.ble x.dn x.dp = true + · simp only [hle, ↓reduceIte, Nat.zero_mul, Nat.sub_zero] + have hdp : x.dn ≤ x.dp := Nat.le_of_ble_eq_true hle + have hsub : (x.dp - x.dn) * j + x.dn * j = x.dp * j := by + rw [← Nat.add_mul, Nat.sub_add_cancel hdp] + omega + · have hnle : Nat.ble x.dn x.dp = false := Bool.eq_false_iff.mpr hle + simp only [hnle, Bool.false_eq_true, ↓reduceIte, Nat.zero_mul, Nat.add_zero] + have hgt : x.dp ≤ x.dn := by + have : ¬ x.dn ≤ x.dp := fun h ↦ hle (Nat.ble_eq.mpr h) + omega + have hsub : (x.dn - x.dp) * j + x.dp * j = x.dn * j := by + rw [← Nat.add_mul, Nat.sub_add_cancel hgt] + omega + +theorem add_const_geForLoop {x : Aff2Nat} {K : AffNat} {c m : ℕ} + (hx : x.geForLoop K m = true) : + (x.add ⟨0, c, 0, 0⟩).geForLoop K m = true := by + unfold add + simp only [Nat.add_zero] + by_cases hle : Nat.ble x.dn x.dp = true + · simp only [hle, ↓reduceIte] + have hdp : x.dn ≤ x.dp := Nat.le_of_ble_eq_true hle + unfold geForLoop at hx ⊢ + simp only [Nat.beq_refl, ↓reduceIte] + by_cases hdn0 : Nat.beq x.dn 0 = true + · simp only [hdn0, ↓reduceIte] at hx + have hb := Nat.le_of_ble_eq_true hx + exact Nat.ble_eq.mpr (by omega) + · have hndn0 := Bool.eq_false_iff.mpr hdn0 + simp only [hndn0, Bool.false_eq_true, ↓reduceIte, hle] at hx + have hb := Nat.le_of_ble_eq_true hx + exact Nat.ble_eq.mpr (by omega) + · have hnle : Nat.ble x.dn x.dp = false := Bool.eq_false_iff.mpr hle + simp only [hnle, Bool.false_eq_true, ↓reduceIte] + have hgt : x.dp < x.dn := by + have : ¬ x.dn ≤ x.dp := fun h ↦ hle (Nat.ble_eq.mpr h) + omega + have hdn0 : Nat.beq x.dn 0 = false := by + apply Bool.eq_false_iff.mpr + intro h0 + have := Nat.eq_of_beq_eq_true h0 + omega + unfold geForLoop at hx ⊢ + simp only [hdn0, Bool.false_eq_true, ↓reduceIte, hnle, Bool.and_eq_true] at hx + have hsub0 : Nat.beq (x.dn - x.dp) 0 = false := by + apply Bool.eq_false_iff.mpr + intro h0 + have := Nat.eq_of_beq_eq_true h0 + omega + have hsuble : Nat.ble (x.dn - x.dp) 0 = false := by + apply Bool.eq_false_iff.mpr + intro h0 + have := Nat.le_of_ble_eq_true h0 + omega + simp only [hsub0, Bool.false_eq_true, ↓reduceIte, hsuble, Nat.sub_zero, Bool.and_eq_true] + refine ⟨hx.1, ?_⟩ + have hb := Nat.le_of_ble_eq_true hx.2 + exact Nat.ble_eq.mpr (by omega) + +theorem sub_const_eval {x rem : Aff2Nat} {K : AffNat} {c k j : ℕ} + (hsub : x.sub? ⟨0, c, 0, 0⟩ K = some rem) (hj : j < K.eval k) : + x.eval k j = c + rem.eval k j := by + unfold sub? at hsub + have h0a : Nat.ble 0 x.a = true := Nat.ble_eq.mpr (Nat.zero_le x.a) + simp only [h0a, Bool.true_and, Nat.sub_zero, Nat.add_zero] at hsub + by_cases hcb : Nat.ble c x.b = true + · simp only [hcb, ↓reduceIte] at hsub + have hcle : c ≤ x.b := Nat.le_of_ble_eq_true hcb + by_cases hg : + (Aff2Nat.mk x.a (x.b - c) + (if Nat.ble x.dn x.dp then (x.dp - x.dn, 0) else (0, x.dn - x.dp)).1 + (if Nat.ble x.dn x.dp then (x.dp - x.dn, 0) else (0, x.dn - x.dp)).2).geForLoop K 0 = true + · simp only [hg, ↓reduceIte, Option.some.injEq] at hsub + have hno := noUnderflow_of_geForLoop hg hj + subst hsub + by_cases hle : Nat.ble x.dn x.dp = true + · simp only [hle, ↓reduceIte] at hno ⊢ + unfold eval + simp only [Nat.zero_mul, Nat.sub_zero] + have hdp : x.dn ≤ x.dp := Nat.le_of_ble_eq_true hle + have hm : (x.dp - x.dn) * j + x.dn * j = x.dp * j := by + rw [← Nat.add_mul, Nat.sub_add_cancel hdp] + omega + · have hnle : Nat.ble x.dn x.dp = false := Bool.eq_false_iff.mpr hle + simp only [hnle, Bool.false_eq_true, ↓reduceIte] at hno ⊢ + unfold eval + simp only [Nat.zero_mul, Nat.add_zero] + have hgt : x.dp ≤ x.dn := by + have : ¬ x.dn ≤ x.dp := fun h ↦ hle (Nat.ble_eq.mpr h) + omega + have hm : (x.dn - x.dp) * j + x.dp * j = x.dn * j := by + rw [← Nat.add_mul, Nat.sub_add_cancel hgt] + omega + · have hng := Bool.eq_false_iff.mpr hg + rw [hng] at hsub + simp at hsub + · have hncb := Bool.eq_false_iff.mpr hcb + simp [hncb] at hsub + +theorem shiftJ_eval {x x' : Aff2Nat} {K : AffNat} {cEnd : AffNat} {k j : ℕ} + (hsh : x.shiftJ? = some x') (hend : x.atEnd? K = some cEnd) (hj : j < K.eval k) : + x'.eval k j = x.eval k (j + 1) := by + unfold shiftJ? at hsh + by_cases hle1 : Nat.ble x.dn (x.b + x.dp) = true + · simp only [hle1, ↓reduceIte, Option.some.injEq] at hsh + subst hsh + have hdnb : x.dn ≤ x.b + x.dp := Nat.le_of_ble_eq_true hle1 + unfold atEnd? at hend + by_cases hle2 : + (Nat.ble (x.dn * K.a) (x.a + x.dp * K.a) && + Nat.ble (x.dn * K.b) (x.b + x.dp * K.b)) = true + · simp only [Bool.and_eq_true] at hle2 + have ha : x.dn * K.a ≤ x.a + x.dp * K.a := Nat.le_of_ble_eq_true hle2.1 + have hb : x.dn * K.b ≤ x.b + x.dp * K.b := Nat.le_of_ble_eq_true hle2.2 + unfold eval + simp only [Nat.mul_add, Nat.mul_one] + by_cases hdp : x.dn ≤ x.dp + · have hm : x.dn * j ≤ x.dp * j := Nat.mul_le_mul_right j hdp + omega + · have hgt : x.dp ≤ x.dn := by omega + have hna : (x.dn - x.dp) * K.a ≤ x.a := by + have : (x.dn - x.dp) * K.a + x.dp * K.a = x.dn * K.a := by + rw [← Nat.add_mul, Nat.sub_add_cancel hgt] + omega + have hnb : (x.dn - x.dp) * K.b ≤ x.b := by + have : (x.dn - x.dp) * K.b + x.dp * K.b = x.dn * K.b := by + rw [← Nat.add_mul, Nat.sub_add_cancel hgt] + omega + unfold AffNat.eval at hj + have hjK : (x.dn - x.dp) * (j + 1) ≤ (x.dn - x.dp) * (K.a * k + K.b) := + Nat.mul_le_mul_left (x.dn - x.dp) hj + have hak : (x.dn - x.dp) * K.a * k ≤ x.a * k := Nat.mul_le_mul_right k hna + have hexp : + (x.dn - x.dp) * (K.a * k + K.b) = (x.dn - x.dp) * K.a * k + (x.dn - x.dp) * K.b := by + rw [Nat.mul_add, Nat.mul_assoc] + have hm1 : (x.dn - x.dp) * (j + 1) + x.dp * (j + 1) = x.dn * (j + 1) := by + rw [← Nat.add_mul, Nat.sub_add_cancel hgt] + have hexp2 : x.dp * (j + 1) = x.dp * j + x.dp := by rw [Nat.mul_add, Nat.mul_one] + have hexp3 : x.dn * (j + 1) = x.dn * j + x.dn := by rw [Nat.mul_add, Nat.mul_one] + omega + · have hnle2 := Bool.eq_false_iff.mpr hle2 + simp [hnle2] at hend + · have hnle1 := Bool.eq_false_iff.mpr hle1 + simp [hnle1] at hsh + +theorem atEnd_eval {x : Aff2Nat} {K cEnd : AffNat} (hend : x.atEnd? K = some cEnd) (k : ℕ) : + x.eval k (K.eval k) = cEnd.eval k := by + unfold atEnd? at hend + by_cases hle : + (Nat.ble (x.dn * K.a) (x.a + x.dp * K.a) && + Nat.ble (x.dn * K.b) (x.b + x.dp * K.b)) = true + · simp only [hle, ↓reduceIte, AffNat.strict_eq, Option.some.injEq] at hend + subst hend + simp only [Bool.and_eq_true] at hle + have ha : x.dn * K.a ≤ x.a + x.dp * K.a := Nat.le_of_ble_eq_true hle.1 + have hb : x.dn * K.b ≤ x.b + x.dp * K.b := Nat.le_of_ble_eq_true hle.2 + unfold eval AffNat.eval + simp only + have hpa : (x.a + x.dp * K.a - x.dn * K.a) * k + x.dn * K.a * k = + (x.a + x.dp * K.a) * k := by + rw [← Nat.add_mul, Nat.sub_add_cancel ha] + have hexp1 : (x.a + x.dp * K.a) * k = x.a * k + x.dp * (K.a * k) := by + rw [Nat.add_mul, Nat.mul_assoc] + have hexp2 : x.dp * (K.a * k + K.b) = x.dp * (K.a * k) + x.dp * K.b := Nat.mul_add _ _ _ + have hexp3 : x.dn * (K.a * k + K.b) = x.dn * K.a * k + x.dn * K.b := by + rw [Nat.mul_add, Nat.mul_assoc] + omega + · have hnle := Bool.eq_false_iff.mpr hle + simp [hnle] at hend + +end Aff2Nat + +/-- Two-variable symbolic word run inside an inner cycle. -/ +structure Aff2Run where + /-- Composite word index in `vocab`. -/ + wid : ℕ + /-- Symbolic count `a * k + b + dp * j - dn * j`. -/ + count : Aff2Nat + deriving DecidableEq, Inhabited + +/-- Push `count` copies of `wid` onto an `Aff2Run` stack during inner-cycle verification. -/ +def pushAff2 (K : AffNat) (wid : ℕ) (count : Aff2Nat) (stk : List Aff2Run) : + Option (List Aff2Run) := + if count.isZero then some stk + else if !count.geForLoop K 1 then none + else match stk with + | [] => if Nat.beq wid 0 then some [] else some [⟨wid, count⟩] + | top :: rest => + if Nat.beq top.wid wid then some (⟨wid, top.count.add count⟩ :: rest) + else some (⟨wid, count⟩ :: stk) + +/-- Pop `count` copies from an `Aff2Run` stack during inner-cycle verification. -/ +def popAff2 (K : AffNat) (count : Aff2Nat) (stk : List Aff2Run) : + Option (ℕ × List Aff2Run) := + match stk with + | [] => if count == ⟨0, 1, 0, 0⟩ then some (0, []) else none + | top :: rest => + match top.count.sub? count K with + | none => none + | some rem => + if rem.isZero then some (top.wid, rest) + else if rem.geForLoop K 1 then some (top.wid, ⟨top.wid, rem⟩ :: rest) + else none + +/-- Two-variable symbolic configuration inside an inner cycle. -/ +structure Aff2Cfg where + /-- Current control state index. -/ + q : ℕ + /-- Head direction (`true` = right, `false` = left). -/ + dir : Bool + /-- Left two-variable stack. -/ + left : List Aff2Run + /-- Right two-variable stack. -/ + right : List Aff2Run + deriving DecidableEq, Inhabited + +/-- Execute one constant-count symbolic RLE step inside an inner cycle body. -/ +def stepAff2Once (numStates : ℕ) (exits : NatTrie CompExit) (K : AffNat) (c : Aff2Cfg) : + Option (ℕ × Aff2Cfg) := + if !Nat.ble (c.q + 1) numStates then none + else + let src := if c.dir then c.right else c.left + let wid := match src with | [] => 0 | top :: _ => top.wid + match exits.find? (compKey numStates wid c.q c.dir) with + | none => none + | some ex => + let same := Nat.beq ex.q' c.q && Bool.beq ex.dir' c.dir + let count? : Option Aff2Nat := + if same then + match src with + | [] => none + | top :: _ => some top.count + else some ⟨0, 1, 0, 0⟩ + match count? with + | none => none + | some count => + match count.isConst with + | none => none + | some cntVal => + match popAff2 K count src with + | none => none + | some (_, src') => + let l₁ := if c.dir then c.left else src' + let r₁ := if c.dir then src' else c.right + let dst? := + if ex.dir' then (pushAff2 K ex.wid' count l₁).map fun l₂ ↦ (l₂, r₁) + else (pushAff2 K ex.wid' count r₁).map fun r₂ ↦ (l₁, r₂) + match dst? with + | none => none + | some (l₂, r₂) => + withNat (cntVal * ex.dt) fun dt ↦ + some (dt, ⟨ex.q', ex.dir', l₂, r₂⟩) + +/-- Execute `n` steps of `stepAff2Once`, accumulating the constant per-iteration step count. -/ +def runAff2Steps (numStates : ℕ) (exits : NatTrie CompExit) (K : AffNat) : + ℕ → ℕ → Aff2Cfg → Option (ℕ × Aff2Cfg) + | 0, acc, c => some (acc, c) + | n + 1, acc, c => + match stepAff2Once numStates exits K c with + | none => none + | some (dt, c') => + withNat (acc + dt) fun acc' ↦ runAff2Steps numStates exits K n acc' c' + +/-- Attach inner-loop `(dp, dn)` slopes to a symbolic `AffRun` stack. -/ +def attachDeltas : List AffRun → List (ℕ × ℕ) → Option (List Aff2Run × List (ℕ × ℕ)) + | [], ds => some ([], ds) + | r :: rs, (dp, dn) :: ds => + match attachDeltas rs ds with + | none => none + | some (out, ds') => some (⟨r.wid, ⟨r.count.a, r.count.b, dp, dn⟩⟩ :: out, ds') + | _, [] => none + +/-- Shift every entry in an `Aff2Run` stack from `j` to `j + 1`. -/ +def shiftStackJ : List Aff2Run → Option (List Aff2Run) + | [] => some [] + | r :: rs => + match r.count.shiftJ?, shiftStackJ rs with + | some c', some rs' => some (⟨r.wid, c'⟩ :: rs') + | _, _ => none + +/-- Evaluate an `Aff2Run` stack at loop completion `j = K.eval k`. -/ +def evalStackEnd (K : AffNat) : List Aff2Run → Option (List AffRun) + | [] => some [] + | r :: rs => + match r.count.atEnd? K, evalStackEnd K rs with + | some c', some rs' => + if c'.geConst 1 then some (⟨r.wid, c'⟩ :: rs') else none + | _, _ => none + +/-- Verify a `K(k)`-iteration inner cycle of `L` RLE steps from `c`, returning total affine steps +`K.scale dtIter` and the post-cycle `AffCfg`. -/ +def verifyCycle (numStates : ℕ) (exits : NatTrie CompExit) (L : ℕ) (K : AffNat) + (deltas : List (ℕ × ℕ)) (c : AffCfg) : Option (AffNat × AffCfg) := + if !K.geConst 1 then none + else + match attachDeltas c.left deltas with + | none => none + | some (l₂, dsRem) => + match attachDeltas c.right dsRem with + | none => none + | some (r₂, []) => + let initOk := + l₂.all (fun r ↦ r.count.geForLoop K 1) && + r₂.all (fun r ↦ r.count.geForLoop K 1) + if !initOk then none + else + let c₀ : Aff2Cfg := ⟨c.q, c.dir, l₂, r₂⟩ + match runAff2Steps numStates exits K L 0 c₀, shiftStackJ l₂, shiftStackJ r₂ with + | some (dtIter, c₁), some lShift, some rShift => + if c₁ == ⟨c.q, c.dir, lShift, rShift⟩ then + match evalStackEnd K l₂, evalStackEnd K r₂ with + | some lEnd, some rEnd => + (K.scale dtIter).strict fun dtTot ↦ + some (dtTot, mkStrictAffCfg c.q c.dir lEnd rEnd) + | _, _ => none + else none + | _, _, _ => none + | some (_, _ :: _) => none + +/-! ## Certificate Replay (`AffOp`, `ReturnCert`, `replayAffTree`) -/ + +/-- Certificate operation: either `n` affine RLE steps or a `K(k)`-iteration inner cycle. -/ +inductive AffOp where + /-- Execute `n` consecutive `stepAffOnce` steps. -/ + | steps (n : ℕ) : AffOp + /-- Execute a `K`-iteration cycle of `L` steps with stack slopes `deltas`. -/ + | cycle (L : ℕ) (K : AffNat) (deltas : List (ℕ × ℕ)) : AffOp + deriving DecidableEq, Inhabited + +/-- Self-contained direct-trie symbolic return certificate. -/ +structure ReturnCert where + /-- Composite word vocabulary (`wid ↦ BTree` of base-word indices). -/ + vocab : NatTrie (BTree ℕ) + /-- Certified composite word exits keyed by `compKey numStates wid q dir`. -/ + exits : NatTrie CompExit + /-- Balanced binary tree of certificate operations. -/ + ops : BTree AffOp + deriving DecidableEq, Inhabited + +/-- Execute `n` consecutive `stepAffOnce` transitions, accumulating total affine TM steps. -/ +def runStepCount (numStates : ℕ) (exits : NatTrie CompExit) (target : AffNat) : + ℕ → AffNat → AffCfg → Option (AffNat × AffCfg) + | 0, acc, c => some (acc, c) + | n + 1, acc, ⟨q, dir, l, r⟩ => + let rem? := target.sub? acc + match stepAffOnce numStates exits rem? q dir l r with + | none => none + | some (dt, c') => + (acc.add dt).strict fun acc' ↦ runStepCount numStates exits target n acc' c' + +/-- Replay a balanced `BTree AffOp` of symbolic affine transitions. -/ +def replayAffTree (numStates : ℕ) (exits : NatTrie CompExit) (target : AffNat) : + BTree AffOp → AffNat → AffCfg → Option (AffNat × AffCfg) + | .empty, acc, c => some (acc, c) + | .leaf (.steps n), acc, c => runStepCount numStates exits target n acc c + | .leaf (.cycle L K deltas), acc, c => + match verifyCycle numStates exits L K deltas c with + | none => none + | some (dt, c') => (acc.add dt).strict fun acc' ↦ some (acc', c') + | .node l r, acc, c => + match replayAffTree numStates exits target l acc c with + | none => none + | some (acc₁, c₁) => replayAffTree numStates exits target r acc₁ c₁ + +/-- Boolean check that `replayAffTree` on subtree `ops` maps `(acc, c)` to `(expAcc, expC)`. -/ +def checkReplaySlice (numStates : ℕ) (exits : NatTrie CompExit) (target : AffNat) + (ops : BTree AffOp) (acc : AffNat) (c : AffCfg) (expAcc : AffNat) (expC : AffCfg) : Bool := + match replayAffTree numStates exits target ops acc c with + | none => false + | some (acc', c') => (acc' == expAcc) && (c' == expC) + +/-- Compositional subtree-sliced derivation of `replayAffTree ... = some (expAcc, expC)` enabling +bounded-memory `mkAuxTheorem` kernel verification. -/ +inductive AffReplayReaches (numStates : ℕ) (exits : NatTrie CompExit) (target : AffNat) : + BTree AffOp → AffNat → AffCfg → AffNat → AffCfg → Prop where + /-- Leaf slice verified by `checkReplaySlice`. -/ + | slice {ops : BTree AffOp} {acc expAcc : AffNat} {c expC : AffCfg} : + checkReplaySlice numStates exits target ops acc c expAcc expC = true → + AffReplayReaches numStates exits target ops acc c expAcc expC + /-- Binary node combining two verified child subtrees. -/ + | node {l r : BTree AffOp} {a₀ a₁ a₂ : AffNat} {c₀ c₁ c₂ : AffCfg} : + AffReplayReaches numStates exits target l a₀ c₀ a₁ c₁ → + AffReplayReaches numStates exits target r a₁ c₁ a₂ c₂ → + AffReplayReaches numStates exits target (.node l r) a₀ c₀ a₂ c₂ + +theorem AffReplayReaches.to_eq {numStates : ℕ} {exits : NatTrie CompExit} {target : AffNat} + {ops : BTree AffOp} {a₀ a₁ : AffNat} {c₀ c₁ : AffCfg} + (h : AffReplayReaches numStates exits target ops a₀ c₀ a₁ c₁) : + replayAffTree numStates exits target ops a₀ c₀ = some (a₁, c₁) := by + induction h with + | @slice ops acc expAcc c expC hs => + unfold checkReplaySlice at hs + rcases hr : replayAffTree numStates exits target ops acc c with _ | ⟨a', c'⟩ + · simp [hr] at hs + · rw [hr] at hs + simp only [Bool.and_eq_true] at hs + have ha : a' = expAcc := eq_of_beq hs.1 + have hc : c' = expC := eq_of_beq hs.2 + subst ha; subst hc; rfl + | node _ _ ihl ihr => + simp [replayAffTree, ihl, ihr] + +/-! ## Semantic Evaluation and Soundness Theorems -/ + +section Semantics + +variable {Γ : Type*} + +/-- Expand composite word `wid` in `vocab` into `List Γ` via `baseWord`. -/ +def vocabWord (baseWord : ℕ → List Γ) (vocab : NatTrie (BTree ℕ)) (wid : ℕ) : List Γ := + match vocab.find? wid with + | some t => concatSubwords baseWord t.toList + | none => [] + +theorem vocabWord_zero_blank [Inhabited Γ] {baseWord : ℕ → List Γ} + (hb0 : ∀ x ∈ baseWord 0, x = default) {vocab : NatTrie (BTree ℕ)} + (hv0 : checkVocabBlank0 vocab = true) : + ∀ x ∈ vocabWord baseWord vocab 0, x = default := by + unfold checkVocabBlank0 at hv0 + unfold vocabWord + rcases hf : vocab.find? 0 with _ | t + · intro x hx; cases hx + · rw [hf] at hv0 + have hall : ∀ s ∈ t.toList, Nat.beq s 0 = true := List.all_eq_true.mp hv0 + have hrec : ∀ (ss : List ℕ), (∀ s ∈ ss, Nat.beq s 0 = true) → + ∀ x ∈ concatSubwords baseWord ss, x = default := by + intro ss hss + induction ss with + | nil => intro x hx; cases hx + | cons s ss ih => + intro x hx + simp only [concatSubwords, List.mem_append] at hx + rcases hx with hx1 | hx2 + · have hs0 : s = 0 := Nat.eq_of_beq_eq_true (hss s List.mem_cons_self) + subst hs0 + exact hb0 x hx1 + · exact ih (fun y hy ↦ hss y (List.mem_cons_of_mem _ hy)) x hx2 + exact hrec t.toList hall + +end Semantics + +section MachineSoundness + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Evaluate a symbolic `AffRun` stack at parameter `k` on half-tape `side`. -/ +def evalAffSide (side : Bool) (wordOf : ℕ → List Γ) (k : ℕ) : List AffRun → ListBlank Γ + | [] => default + | ⟨w, c⟩ :: rest => + if side then ListBlank.append (wordOf w ^ c.eval k) (evalAffSide true wordOf k rest) + else ListBlank.append ((wordOf w).reverse ^ c.eval k) (evalAffSide false wordOf k rest) + +/-- Evaluate a symbolic `AffCfg` at parameter `k` into `BusyBeaver.Cfg Γ Λ`. -/ +def evalAffCfg (qOf : ℕ → Λ) (wordOf : ℕ → List Γ) (k : ℕ) (c : AffCfg) : Cfg Γ Λ := + dirCfg qOf c.q c.dir (evalAffSide false wordOf k c.left) (evalAffSide true wordOf k c.right) + +/-- Evaluate a two-variable `Aff2Run` stack at `(k, j)` on half-tape `side`. -/ +def evalAff2Side (side : Bool) (wordOf : ℕ → List Γ) (k j : ℕ) : List Aff2Run → ListBlank Γ + | [] => default + | ⟨w, c⟩ :: rest => + if side then ListBlank.append (wordOf w ^ c.eval k j) (evalAff2Side true wordOf k j rest) + else ListBlank.append ((wordOf w).reverse ^ c.eval k j) (evalAff2Side false wordOf k j rest) + +/-- Evaluate a two-variable `Aff2Cfg` at `(k, j)` into `BusyBeaver.Cfg Γ Λ`. -/ +def evalAff2Cfg (qOf : ℕ → Λ) (wordOf : ℕ → List Γ) (k j : ℕ) (c : Aff2Cfg) : Cfg Γ Λ := + dirCfg qOf c.q c.dir (evalAff2Side false wordOf k j c.left) (evalAff2Side true wordOf k j c.right) + +private def topWid : List AffRun → ℕ + | [] => 0 + | top :: _ => top.wid + +private def topWid2 : List Aff2Run → ℕ + | [] => 0 + | top :: _ => top.wid + +private theorem popAff_sound {wordOf : ℕ → List Γ} (hz : ∀ x ∈ wordOf 0, x = default) + {count : AffNat} {stk stk' : List AffRun} {w : ℕ} + (hp : popAff count stk = some (w, stk')) (side : Bool) (k : ℕ) : + w = topWid stk ∧ + evalAffSide side wordOf k stk = + if side then ListBlank.append (wordOf w ^ count.eval k) (evalAffSide true wordOf k stk') + else ListBlank.append ((wordOf w).reverse ^ count.eval k) + (evalAffSide false wordOf k stk') := by + have hzRev : ∀ x ∈ (wordOf 0).reverse, x = default := + fun x hx ↦ hz x (List.mem_reverse.mp hx) + unfold popAff popAffK id at hp + rcases stk with _ | ⟨⟨tw, tc⟩, rest⟩ + · by_cases h1 : count.isOne = true + · simp only [h1, ↓reduceIte, Option.some.injEq, Prod.mk.injEq] at hp + rcases hp with ⟨rfl, rfl⟩ + refine ⟨rfl, ?_⟩ + have hc1 := AffNat.eval_eq_one_of_isOne h1 k + cases side <;> simp [evalAffSide, hc1, lb_blank_word _ hz, lb_blank_word _ hzRev] + · have hn1 := Bool.eq_false_iff.mpr h1 + simp [hn1] at hp + · simp only at hp + rcases hs : tc.sub? count with _ | rem + · simp [hs] at hp + · rw [hs] at hp + simp only at hp + have hsub := AffNat.eval_sub? hs k + by_cases hrz : rem.isZero = true + · simp only [hrz, ↓reduceIte, Option.some.injEq, Prod.mk.injEq] at hp + rcases hp with ⟨rfl, rfl⟩ + have hr0 := AffNat.eval_eq_zero_of_isZero hrz k + have htc : tc.eval k = count.eval k := by omega + refine ⟨rfl, ?_⟩ + cases side <;> simp [evalAffSide, htc] + · have hnrz := Bool.eq_false_iff.mpr hrz + rw [hnrz] at hp + by_cases hrg : rem.geConst 1 = true + · simp only [Bool.false_eq_true, ↓reduceIte, hrg, AffNat.strict_eq, + Option.some.injEq, Prod.mk.injEq] at hp + rcases hp with ⟨rfl, rfl⟩ + refine ⟨rfl, ?_⟩ + cases side <;> + simp [evalAffSide, hsub, list_pow_add, ListBlank.append_assoc] + · have hnrg := Bool.eq_false_iff.mpr hrg + simp [hnrg] at hp + +private theorem pushAff_sound {wordOf : ℕ → List Γ} (hz : ∀ x ∈ wordOf 0, x = default) + {wid : ℕ} {count : AffNat} {stk stk' : List AffRun} + (hp : pushAff wid count stk = some stk') (side : Bool) (k : ℕ) : + evalAffSide side wordOf k stk' = + if side then ListBlank.append (wordOf wid ^ count.eval k) (evalAffSide true wordOf k stk) + else ListBlank.append ((wordOf wid).reverse ^ count.eval k) + (evalAffSide false wordOf k stk) := by + have hzRev : ∀ x ∈ (wordOf 0).reverse, x = default := + fun x hx ↦ hz x (List.mem_reverse.mp hx) + unfold pushAff pushAffK id at hp + by_cases hcz : count.isZero = true + · simp only [hcz, ↓reduceIte, Option.some.injEq] at hp + subst hp + have hc0 := AffNat.eval_eq_zero_of_isZero hcz k + cases side <;> simp [hc0] + · have hncz := Bool.eq_false_iff.mpr hcz + rw [hncz] at hp + rcases stk with _ | ⟨⟨tw, tc⟩, rest⟩ + · simp only [Bool.false_eq_true, ↓reduceIte] at hp + by_cases hw : Nat.beq wid 0 = true + · simp only [hw, ↓reduceIte, Option.some.injEq] at hp + subst hp + have hw0 := Nat.eq_of_beq_eq_true hw + subst hw0 + cases side <;> simp [evalAffSide, lb_blank_pow _ hz, lb_blank_pow _ hzRev] + · have hnw := Bool.eq_false_iff.mpr hw + rw [hnw] at hp + by_cases hg : count.geConst 1 = true + · simp only [Bool.false_eq_true, ↓reduceIte, hg, withNat_eq, AffNat.strict_eq, + Option.some.injEq] at hp + subst hp + cases side <;> rfl + · have hng := Bool.eq_false_iff.mpr hg + simp [hng] at hp + · simp only [Bool.false_eq_true, ↓reduceIte] at hp + by_cases hg : count.geConst 1 = true + · simp only [hg, Bool.not_true, Bool.false_eq_true, ↓reduceIte] at hp + by_cases hw : Nat.beq tw wid = true + · simp only [hw, ↓reduceIte, AffNat.strict_eq, Option.some.injEq] at hp + subst hp + have htw := Nat.eq_of_beq_eq_true hw + subst htw + cases side <;> + simp [evalAffSide, ListBlank.append_append, ← list_pow_add, Nat.add_comm] + · have hnw := Bool.eq_false_iff.mpr hw + simp only [hnw, Bool.false_eq_true, ↓reduceIte, withNat_eq, AffNat.strict_eq, + Option.some.injEq] at hp + subst hp + cases side <;> rfl + · have hng := Bool.eq_false_iff.mpr hg + simp [hng] at hp + +private theorem lookup_exit_sound {M : Machine Γ Λ} {qOf : ℕ → Λ} {baseWord : ℕ → List Γ} + {baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)} + (hbase : BaseExitSound M qOf baseWord baseExit) + {numStates : ℕ} {vocab : NatTrie (BTree ℕ)} {exits : NatTrie CompExit} + (hexits : NatTrie.checkAll (checkExitEntry numStates baseExit vocab) 0 1 exits = true) + {wid q : ℕ} {dir : Bool} {ex : CompExit} + (hq : q < numStates) (hf : exits.find? (compKey numStates wid q dir) = some ex) : + WordExit M qOf (vocabWord baseWord vocab wid) q dir + (vocabWord baseWord vocab ex.wid') ex.q' ex.dir' ex.dt := by + have hchk := NatTrie.checkAll_sound hexits hf + unfold checkExitEntry at hchk + have hstride : Nat.beq (2 * numStates) 0 = false := by + apply Bool.eq_false_iff.mpr + intro h0 + have := Nat.eq_of_beq_eq_true h0 + omega + simp only [hstride, Bool.false_eq_true, ↓reduceIte] at hchk + have hd_lt : q * 2 + (if dir then 1 else 0) < 2 * numStates := by + cases dir <;> simp <;> omega + have hdiv : compKey numStates wid q dir / (2 * numStates) = wid := by + unfold compKey + have hpos : 0 < 2 * numStates := by omega + calc + (wid * (2 * numStates) + q * 2 + if dir then 1 else 0) / (2 * numStates) + = ((q * 2 + if dir then 1 else 0) + wid * (2 * numStates)) / (2 * numStates) := by + congr 1; omega + _ = (q * 2 + if dir then 1 else 0) / (2 * numStates) + wid := + Nat.add_mul_div_right _ _ hpos + _ = wid := by rw [Nat.div_eq_of_lt hd_lt, Nat.zero_add] + have hmod : compKey numStates wid q dir % (2 * numStates) = q * 2 + (if dir then 1 else 0) := by + unfold compKey + calc + (wid * (2 * numStates) + q * 2 + if dir then 1 else 0) % (2 * numStates) + = ((q * 2 + if dir then 1 else 0) + wid * (2 * numStates)) % (2 * numStates) := by + congr 1; omega + _ = (q * 2 + if dir then 1 else 0) % (2 * numStates) := Nat.add_mul_mod_self_right _ _ _ + _ = q * 2 + (if dir then 1 else 0) := Nat.mod_eq_of_lt hd_lt + have hq_eq : (q * 2 + if dir then 1 else 0) / 2 = q := by + cases dir + · simp only [Bool.false_eq_true, ↓reduceIte, add_zero] + omega + · simp only [↓reduceIte] + omega + have hdir_eq : Nat.beq ((q * 2 + if dir then 1 else 0) % 2) 1 = dir := by + cases dir + · simp only [Bool.false_eq_true, ↓reduceIte, add_zero, Nat.mul_mod_left] + rfl + · simp only [↓reduceIte] + exact Nat.beq_eq.mpr (by omega) + rw [hdiv, hmod, hq_eq, hdir_eq] at hchk + rcases hu : vocab.find? wid with _ | uTree + · simp [hu] at hchk + · rcases hv : vocab.find? ex.wid' with _ | vTree + · simp [hu, hv] at hchk + · rw [hu, hv] at hchk + have hrun : runCompositeExit baseExit uTree.toList q dir = + some (vTree.toList, ex.q', ex.dir', ex.dt) := eq_of_beq hchk + have hex := runCompositeExit_sound hbase hrun + simpa [vocabWord, hu, hv] using hex + +private theorem wordExit_apply_aff {M : Machine Γ Λ} {qOf : ℕ → Λ} {wordOf : ℕ → List Γ} + {wid wid' q q' : ℕ} {dir dir' : Bool} {exDt : ℕ} {count : AffNat} + (hz : ∀ x ∈ wordOf 0, x = default) + (hex : WordExit M qOf (wordOf wid) q dir (wordOf wid') q' dir' exDt) + (hsame : (Nat.beq q' q && Bool.beq dir' dir) = true ∨ count = ⟨0, 1⟩) + {l r l₂ r₂ : List AffRun} + (hstep_stacks : + if dir then + ∃ r', popAff count r = some (wid, r') ∧ + if dir' then pushAff wid' count l = some l₂ ∧ r₂ = r' + else l₂ = l ∧ pushAff wid' count r' = some r₂ + else + ∃ l', popAff count l = some (wid, l') ∧ + if dir' then pushAff wid' count l' = some l₂ ∧ r₂ = r + else l₂ = l' ∧ pushAff wid' count r = some r₂) + (k : ℕ) : + ReachesIn M ((count.scale exDt).eval k) + (evalAffCfg qOf wordOf k ⟨q, dir, l, r⟩) + (evalAffCfg qOf wordOf k ⟨q', dir', l₂, r₂⟩) := by + have hexPow : WordExit M qOf (wordOf wid ^ count.eval k) q dir + (wordOf wid' ^ count.eval k) q' dir' ((count.scale exDt).eval k) := by + rcases hsame with hs | rfl + · simp only [Bool.and_eq_true] at hs + have hqq : q' = q := Nat.eq_of_beq_eq_true hs.1 + have hdd : dir' = dir := eq_of_beq hs.2 + subst hqq; subst hdd + rw [AffNat.eval_scale] + exact sweepWord_sound hex (count.eval k) + · have hc1 : (AffNat.mk 0 1).eval k = 1 := by simp [AffNat.eval] + have hsc : ((AffNat.mk 0 1).scale exDt).eval k = exDt := by simp [AffNat.scale, AffNat.eval] + rw [hc1, hsc, list_pow_one, list_pow_one] + exact hex + unfold evalAffCfg + simp only + cases dir + · simp only [Bool.false_eq_true, ↓reduceIte] at hstep_stacks + obtain ⟨l', hpop, hpush⟩ := hstep_stacks + have ⟨_, hpopEq⟩ := popAff_sound hz hpop false k + simp only [Bool.false_eq_true, ↓reduceIte] at hpopEq + have hrun := hexPow (evalAffSide false wordOf k l') (evalAffSide true wordOf k r) + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, reverse_pow] at hrun + rw [hpopEq] + cases dir' + · simp only [Bool.false_eq_true, ↓reduceIte] at hpush + rcases hpush with ⟨rfl, hpushR⟩ + have hpushEq := pushAff_sound hz hpushR true k + simp only [↓reduceIte] at hpushEq + simp only [Bool.not_false, ↓reduceIte] at hrun + rwa [hpushEq] + · simp only [↓reduceIte] at hpush + rcases hpush with ⟨hpushL, rfl⟩ + have hpushEq := pushAff_sound hz hpushL false k + simp only [Bool.false_eq_true, ↓reduceIte] at hpushEq + simp only [Bool.not_true, Bool.false_eq_true, ↓reduceIte] at hrun + rwa [hpushEq] + · simp only [↓reduceIte] at hstep_stacks + obtain ⟨r', hpop, hpush⟩ := hstep_stacks + have ⟨_, hpopEq⟩ := popAff_sound hz hpop true k + simp only [↓reduceIte] at hpopEq + have hrun := hexPow (evalAffSide false wordOf k l) (evalAffSide true wordOf k r') + simp only [placeSide, ↓reduceIte] at hrun + rw [hpopEq] + cases dir' + · simp only [Bool.false_eq_true, ↓reduceIte] at hpush + rcases hpush with ⟨rfl, hpushR⟩ + have hpushEq := pushAff_sound hz hpushR true k + simp only [↓reduceIte] at hpushEq + simp only [Bool.not_false, ↓reduceIte] at hrun + rwa [hpushEq] + · simp only [↓reduceIte] at hpush + rcases hpush with ⟨hpushL, rfl⟩ + have hpushEq := pushAff_sound hz hpushL false k + simp only [Bool.false_eq_true, ↓reduceIte] at hpushEq + simp only [Bool.not_true, Bool.false_eq_true, ↓reduceIte, reverse_pow] at hrun + rwa [hpushEq] + +/-- Soundness of `stepAffOnce`. -/ +theorem stepAffOnce_sound {M : Machine Γ Λ} {qOf : ℕ → Λ} {baseWord : ℕ → List Γ} + {baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)} + (hbase : BaseExitSound M qOf baseWord baseExit) + (hb0 : ∀ x ∈ baseWord 0, x = default) + {numStates : ℕ} {vocab : NatTrie (BTree ℕ)} {exits : NatTrie CompExit} + (hv0 : checkVocabBlank0 vocab = true) + (hexits : NatTrie.checkAll (checkExitEntry numStates baseExit vocab) 0 1 exits = true) + {rem? : Option AffNat} {q : ℕ} {dir : Bool} {l r : List AffRun} + {dt : AffNat} {c' : AffCfg} + (hst : stepAffOnce numStates exits rem? q dir l r = some (dt, c')) (k : ℕ) : + ReachesIn M (dt.eval k) + (evalAffCfg qOf (vocabWord baseWord vocab) k ⟨q, dir, l, r⟩) + (evalAffCfg qOf (vocabWord baseWord vocab) k c') := by + have hz := vocabWord_zero_blank hb0 hv0 + unfold stepAffOnce at hst + by_cases hqb : Nat.ble (q + 1) numStates = true + · simp only [hqb, Bool.not_true, Bool.false_eq_true, ↓reduceIte] at hst + have hq : q < numStates := Nat.le_of_ble_eq_true hqb + set src := if dir then r else l + set wid := match src with | [] => 0 | top :: _ => top.wid + rcases hf : exits.find? (compKey numStates wid q dir) with _ | ex + · simp [hf] at hst + · rw [hf] at hst + have hex := lookup_exit_sound hbase hexits hq hf + have hcnt : ∃ count : AffNat, + ((Nat.beq ex.q' q && Bool.beq ex.dir' dir) = true ∨ count = ⟨0, 1⟩) ∧ + (if dir then + popAffK count r fun + | none => none + | some (_, r') => + (count.scale ex.dt).strict fun dt ↦ + if ex.dir' then + pushAffK ex.wid' count l fun + | none => none + | some l₂ => some (dt, mkStrictAffCfg ex.q' true l₂ r') + else + pushAffK ex.wid' count r' fun + | none => none + | some r₂ => some (dt, mkStrictAffCfg ex.q' false l r₂) + else + popAffK count l fun + | none => none + | some (_, l') => + (count.scale ex.dt).strict fun dt ↦ + if ex.dir' then + pushAffK ex.wid' count l' fun + | none => none + | some l₂ => some (dt, mkStrictAffCfg ex.q' true l₂ r) + else + pushAffK ex.wid' count r fun + | none => none + | some r₂ => some (dt, mkStrictAffCfg ex.q' false l' r₂)) = + some (dt, c') := by + simp only at hst + by_cases hsm : (Nat.beq ex.q' q && Bool.beq ex.dir' dir) = true + · simp only [hsm, ↓reduceIte] at hst + rcases hsrc : src with _ | ⟨top, rest⟩ + · simp [hsrc] at hst + · rw [hsrc] at hst + cases rem? with + | none => exact ⟨top.count, Or.inl hsm, hst⟩ + | some rem => + simp only at hst + by_cases hc1 : + (Nat.ble 1 ex.dt && Nat.beq (rem.a % ex.dt) 0 && Nat.beq (rem.b % ex.dt) 0) = true + · simp only [hc1, ↓reduceIte] at hst + by_cases hc2 : + ((AffNat.mk (rem.a / ex.dt) (rem.b / ex.dt)).geConst 1 && + (top.count.sub? ⟨rem.a / ex.dt, rem.b / ex.dt⟩).isSome) = true + · simp only [hc2, ↓reduceIte] at hst + exact ⟨_, Or.inl hsm, hst⟩ + · have hnc2 := Bool.eq_false_iff.mpr hc2 + simp only [hnc2, Bool.false_eq_true, ↓reduceIte] at hst + exact ⟨top.count, Or.inl hsm, hst⟩ + · have hnc1 := Bool.eq_false_iff.mpr hc1 + simp only [hnc1, Bool.false_eq_true, ↓reduceIte] at hst + exact ⟨top.count, Or.inl hsm, hst⟩ + · have hnsm := Bool.eq_false_iff.mpr hsm + simp only [hnsm, Bool.false_eq_true, ↓reduceIte] at hst + exact ⟨⟨0, 1⟩, Or.inr rfl, hst⟩ + obtain ⟨count, hsame, hbody⟩ := hcnt + cases dir + · simp only [Bool.false_eq_true, ↓reduceIte, popAffK_eq] at hbody + rcases hpop : popAff count l with _ | ⟨pw, l'⟩ + · simp [hpop] at hbody + · rw [hpop] at hbody + simp only [AffNat.strict_eq] at hbody + have ⟨hpw, _⟩ := popAff_sound hz hpop false k + have hpwid : pw = wid := by + simpa [wid, src, topWid] using hpw + subst hpwid + cases hdir' : ex.dir' + · simp only [hdir', Bool.false_eq_true, ↓reduceIte, pushAffK_eq, + mkStrictAffCfg_eq] at hbody + rcases hpush : pushAff ex.wid' count r with _ | r₂ + · simp [hpush] at hbody + · rw [hpush] at hbody + simp only [Option.some.injEq, Prod.mk.injEq] at hbody + rcases hbody with ⟨rfl, rfl⟩ + rw [hdir'] at hex hsame + refine wordExit_apply_aff hz hex hsame ?_ k + exact ⟨l', hpop, rfl, hpush⟩ + · simp only [hdir', ↓reduceIte, pushAffK_eq, mkStrictAffCfg_eq] at hbody + rcases hpush : pushAff ex.wid' count l' with _ | l₂ + · simp [hpush] at hbody + · rw [hpush] at hbody + simp only [Option.some.injEq, Prod.mk.injEq] at hbody + rcases hbody with ⟨rfl, rfl⟩ + rw [hdir'] at hex hsame + refine wordExit_apply_aff hz hex hsame ?_ k + exact ⟨l', hpop, hpush, rfl⟩ + · simp only [↓reduceIte, popAffK_eq] at hbody + rcases hpop : popAff count r with _ | ⟨pw, r'⟩ + · simp [hpop] at hbody + · rw [hpop] at hbody + simp only [AffNat.strict_eq] at hbody + have ⟨hpw, _⟩ := popAff_sound hz hpop true k + have hpwid : pw = wid := by + simpa [wid, src, topWid] using hpw + subst hpwid + cases hdir' : ex.dir' + · simp only [hdir', Bool.false_eq_true, ↓reduceIte, pushAffK_eq, + mkStrictAffCfg_eq] at hbody + rcases hpush : pushAff ex.wid' count r' with _ | r₂ + · simp [hpush] at hbody + · rw [hpush] at hbody + simp only [Option.some.injEq, Prod.mk.injEq] at hbody + rcases hbody with ⟨rfl, rfl⟩ + rw [hdir'] at hex hsame + refine wordExit_apply_aff hz hex hsame ?_ k + exact ⟨r', hpop, rfl, hpush⟩ + · simp only [hdir', ↓reduceIte, pushAffK_eq, mkStrictAffCfg_eq] at hbody + rcases hpush : pushAff ex.wid' count l with _ | l₂ + · simp [hpush] at hbody + · rw [hpush] at hbody + simp only [Option.some.injEq, Prod.mk.injEq] at hbody + rcases hbody with ⟨rfl, rfl⟩ + rw [hdir'] at hex hsame + refine wordExit_apply_aff hz hex hsame ?_ k + exact ⟨r', hpop, hpush, rfl⟩ + · have hnqb := Bool.eq_false_iff.mpr hqb + simp [hnqb] at hst + +/-! ### Soundness of Inner-Cycle Verifier (`verifyCycle_sound`) -/ + +private def stackWF (K : AffNat) (stk : List Aff2Run) : Prop := + ∀ r ∈ stk, r.count.geForLoop K 1 = true + +private theorem popAff2_const_sound {wordOf : ℕ → List Γ} (hz : ∀ x ∈ wordOf 0, x = default) + {K : AffNat} {cntVal : ℕ} {stk stk' : List Aff2Run} {w : ℕ} + (hwf : stackWF K stk) + (hp : popAff2 K ⟨0, cntVal, 0, 0⟩ stk = some (w, stk')) + (side : Bool) {k j : ℕ} (hj : j < K.eval k) : + stackWF K stk' ∧ + w = topWid2 stk ∧ + evalAff2Side side wordOf k j stk = + if side then ListBlank.append (wordOf w ^ cntVal) (evalAff2Side true wordOf k j stk') + else ListBlank.append ((wordOf w).reverse ^ cntVal) + (evalAff2Side false wordOf k j stk') := by + have hzRev : ∀ x ∈ (wordOf 0).reverse, x = default := + fun x hx ↦ hz x (List.mem_reverse.mp hx) + unfold popAff2 at hp + rcases stk with _ | ⟨⟨tw, tc⟩, rest⟩ + · by_cases hc1 : (Aff2Nat.mk 0 cntVal 0 0 == Aff2Nat.mk 0 1 0 0) = true + · simp only [hc1, ↓reduceIte, Option.some.injEq, Prod.mk.injEq] at hp + rcases hp with ⟨rfl, rfl⟩ + have h1 : Aff2Nat.mk 0 cntVal 0 0 = Aff2Nat.mk 0 1 0 0 := eq_of_beq hc1 + injection h1 with _ hcv _ _ + subst hcv + refine ⟨(fun r hr ↦ by cases hr), rfl, ?_⟩ + cases side <;> simp [evalAff2Side, lb_blank_word _ hz, lb_blank_word _ hzRev] + · have hnc1 := Bool.eq_false_iff.mpr hc1 + simp [hnc1] at hp + · simp only at hp + rcases hs : tc.sub? ⟨0, cntVal, 0, 0⟩ K with _ | rem + · simp [hs] at hp + · rw [hs] at hp + simp only at hp + have hsub := Aff2Nat.sub_const_eval hs hj + have hwfRest : stackWF K rest := fun r hr ↦ hwf r (List.mem_cons_of_mem _ hr) + by_cases hrz : rem.isZero = true + · simp only [hrz, ↓reduceIte, Option.some.injEq, Prod.mk.injEq] at hp + rcases hp with ⟨rfl, rfl⟩ + have hr0 := Aff2Nat.eval_eq_zero_of_isZero hrz k j + have htc : tc.eval k j = cntVal := by omega + refine ⟨hwfRest, rfl, ?_⟩ + cases side <;> simp [evalAff2Side, htc] + · have hnrz := Bool.eq_false_iff.mpr hrz + rw [hnrz] at hp + by_cases hrg : rem.geForLoop K 1 = true + · simp only [Bool.false_eq_true, ↓reduceIte, hrg, Option.some.injEq, Prod.mk.injEq] at hp + rcases hp with ⟨rfl, rfl⟩ + have hwfNew : stackWF K (⟨tw, rem⟩ :: rest) := by + intro r hr + rcases List.mem_cons.mp hr with rfl | hmem + · exact hrg + · exact hwfRest r hmem + refine ⟨hwfNew, rfl, ?_⟩ + cases side <;> simp [evalAff2Side, hsub, list_pow_add, ListBlank.append_assoc] + · have hnrg := Bool.eq_false_iff.mpr hrg + simp [hnrg] at hp + +private theorem pushAff2_const_sound {wordOf : ℕ → List Γ} (hz : ∀ x ∈ wordOf 0, x = default) + {K : AffNat} {wid cntVal : ℕ} {stk stk' : List Aff2Run} + (hwf : stackWF K stk) + (hp : pushAff2 K wid ⟨0, cntVal, 0, 0⟩ stk = some stk') + (side : Bool) {k j : ℕ} (hj : j < K.eval k) : + stackWF K stk' ∧ + evalAff2Side side wordOf k j stk' = + if side then ListBlank.append (wordOf wid ^ cntVal) (evalAff2Side true wordOf k j stk) + else ListBlank.append ((wordOf wid).reverse ^ cntVal) + (evalAff2Side false wordOf k j stk) := by + have hzRev : ∀ x ∈ (wordOf 0).reverse, x = default := + fun x hx ↦ hz x (List.mem_reverse.mp hx) + unfold pushAff2 at hp + by_cases hcz : (Aff2Nat.mk 0 cntVal 0 0).isZero = true + · simp only [hcz, ↓reduceIte, Option.some.injEq] at hp + subst hp + have hc0 : cntVal = 0 := by + have := Aff2Nat.eval_eq_zero_of_isZero hcz 0 0 + simpa [Aff2Nat.eval] using this + subst hc0 + refine ⟨hwf, ?_⟩ + cases side <;> simp + · have hncz := Bool.eq_false_iff.mpr hcz + rw [hncz] at hp + by_cases hg : (Aff2Nat.mk 0 cntVal 0 0).geForLoop K 1 = true + · simp only [Bool.false_eq_true, ↓reduceIte, hg, Bool.not_true] at hp + rcases stk with _ | ⟨⟨tw, tc⟩, rest⟩ + · by_cases hw : Nat.beq wid 0 = true + · simp only [hw, ↓reduceIte, Option.some.injEq] at hp + subst hp + have hw0 := Nat.eq_of_beq_eq_true hw + subst hw0 + refine ⟨(fun r hr ↦ by cases hr), ?_⟩ + cases side <;> simp [evalAff2Side, lb_blank_pow _ hz, lb_blank_pow _ hzRev] + · have hnw := Bool.eq_false_iff.mpr hw + simp only [hnw, Bool.false_eq_true, ↓reduceIte, Option.some.injEq] at hp + subst hp + have hwf1 : stackWF K [⟨wid, ⟨0, cntVal, 0, 0⟩⟩] := by + intro r hr + rcases List.mem_singleton.mp hr with rfl + exact hg + have hcv : (Aff2Nat.mk 0 cntVal 0 0).eval k j = cntVal := by simp [Aff2Nat.eval] + refine ⟨hwf1, ?_⟩ + cases side <;> simp [evalAff2Side, hcv] + · simp only at hp + by_cases hw : Nat.beq tw wid = true + · simp only [hw, ↓reduceIte, Option.some.injEq] at hp + subst hp + have htw := Nat.eq_of_beq_eq_true hw + subst htw + have htcwf : tc.geForLoop K 1 = true := hwf _ List.mem_cons_self + have hno : tc.dn * j ≤ tc.a * k + tc.b + tc.dp * j := by + have := Aff2Nat.noUnderflow_of_geForLoop htcwf hj + omega + have haddEq := Aff2Nat.add_const_eval tc cntVal k j hno + have hwfNew : stackWF K (⟨tw, tc.add ⟨0, cntVal, 0, 0⟩⟩ :: rest) := by + intro r hr + rcases List.mem_cons.mp hr with rfl | hmem + · exact Aff2Nat.add_const_geForLoop htcwf + · exact hwf r (List.mem_cons_of_mem _ hmem) + refine ⟨hwfNew, ?_⟩ + cases side <;> + simp [evalAff2Side, haddEq, ListBlank.append_append, ← list_pow_add, Nat.add_comm] + · have hnw := Bool.eq_false_iff.mpr hw + simp only [hnw, Bool.false_eq_true, ↓reduceIte, Option.some.injEq] at hp + subst hp + have hwfNew : stackWF K (⟨wid, ⟨0, cntVal, 0, 0⟩⟩ :: ⟨tw, tc⟩ :: rest) := by + intro r hr + rcases List.mem_cons.mp hr with rfl | hmem + · exact hg + · exact hwf r hmem + have hcv : (Aff2Nat.mk 0 cntVal 0 0).eval k j = cntVal := by simp [Aff2Nat.eval] + refine ⟨hwfNew, ?_⟩ + cases side <;> simp [evalAff2Side, hcv] + · have hng := Bool.eq_false_iff.mpr hg + simp [hng] at hp + +private theorem stepAff2Once_sound {M : Machine Γ Λ} {qOf : ℕ → Λ} {baseWord : ℕ → List Γ} + {baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)} + (hbase : BaseExitSound M qOf baseWord baseExit) + (hb0 : ∀ x ∈ baseWord 0, x = default) + {numStates : ℕ} {vocab : NatTrie (BTree ℕ)} {exits : NatTrie CompExit} + (hv0 : checkVocabBlank0 vocab = true) + (hexits : NatTrie.checkAll (checkExitEntry numStates baseExit vocab) 0 1 exits = true) + {K : AffNat} {c c' : Aff2Cfg} {dt : ℕ} + (hwfL : stackWF K c.left) (hwfR : stackWF K c.right) + (hst : stepAff2Once numStates exits K c = some (dt, c')) + {k j : ℕ} (hj : j < K.eval k) : + stackWF K c'.left ∧ stackWF K c'.right ∧ + ReachesIn M dt + (evalAff2Cfg qOf (vocabWord baseWord vocab) k j c) + (evalAff2Cfg qOf (vocabWord baseWord vocab) k j c') := by + have hz := vocabWord_zero_blank hb0 hv0 + rcases c with ⟨q, dir, l, r⟩ + unfold stepAff2Once at hst + simp only at hst + by_cases hqb : Nat.ble (q + 1) numStates = true + · simp only [hqb, Bool.not_true, Bool.false_eq_true, ↓reduceIte] at hst + have hq : q < numStates := Nat.le_of_ble_eq_true hqb + set src := if dir then r else l + set wid := match src with | [] => 0 | top :: _ => top.wid + rcases hf : exits.find? (compKey numStates wid q dir) with _ | ex + · simp [hf] at hst + · rw [hf] at hst + have hex := lookup_exit_sound hbase hexits hq hf + have hcnt : ∃ count : Aff2Nat, + ((Nat.beq ex.q' q && Bool.beq ex.dir' dir) = true ∨ count = ⟨0, 1, 0, 0⟩) ∧ + (match count.isConst with + | none => none + | some cntVal => + match popAff2 K count src with + | none => none + | some (_, src') => + let l₁ := if dir then l else src' + let r₁ := if dir then src' else r + let dst? := + if ex.dir' then (pushAff2 K ex.wid' count l₁).map fun l₂ ↦ (l₂, r₁) + else (pushAff2 K ex.wid' count r₁).map fun r₂ ↦ (l₁, r₂) + match dst? with + | none => none + | some (l₂, r₂) => + withNat (cntVal * ex.dt) fun dt ↦ + some (dt, ⟨ex.q', ex.dir', l₂, r₂⟩)) = some (dt, c') := by + simp only at hst + by_cases hsm : (Nat.beq ex.q' q && Bool.beq ex.dir' dir) = true + · simp only [hsm, ↓reduceIte] at hst + rcases hsrc : src with _ | ⟨top, rest⟩ + · simp [hsrc] at hst + · rw [hsrc] at hst + exact ⟨top.count, Or.inl hsm, hst⟩ + · have hnsm := Bool.eq_false_iff.mpr hsm + simp only [hnsm, Bool.false_eq_true, ↓reduceIte] at hst + exact ⟨⟨0, 1, 0, 0⟩, Or.inr rfl, hst⟩ + obtain ⟨count, hsame, hbody⟩ := hcnt + rcases hconst : count.isConst with _ | cntVal + · simp [hconst] at hbody + · rw [hconst] at hbody + have hce := Aff2Nat.isConst_eq hconst + subst hce + have hexPow : WordExit M qOf (vocabWord baseWord vocab wid ^ cntVal) q dir + (vocabWord baseWord vocab ex.wid' ^ cntVal) ex.q' ex.dir' (cntVal * ex.dt) := by + rcases hsame with hs | h1 + · simp only [Bool.and_eq_true] at hs + have hqq := Nat.eq_of_beq_eq_true hs.1 + have hdd : ex.dir' = dir := eq_of_beq hs.2 + rw [hqq, hdd] at hex ⊢ + rw [Nat.mul_comm cntVal ex.dt] + exact sweepWord_sound hex cntVal + · injection h1 with _ hcv _ _ + subst hcv + simpa using hex + cases dir + · simp only [src, Bool.false_eq_true, ↓reduceIte] at hbody + rcases hpop : popAff2 K ⟨0, cntVal, 0, 0⟩ l with _ | ⟨pw, l'⟩ + · simp [hpop] at hbody + · rw [hpop] at hbody + have ⟨hwfL', hpw, hpopEq⟩ := popAff2_const_sound hz hwfL hpop false hj + have hpwid : pw = wid := by simpa [wid, src, topWid2] using hpw + subst hpwid + simp only [Bool.false_eq_true, ↓reduceIte] at hpopEq + have hrun := hexPow + (evalAff2Side false (vocabWord baseWord vocab) k j l') + (evalAff2Side true (vocabWord baseWord vocab) k j r) + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, reverse_pow] at hrun + cases hdir' : ex.dir' + · simp only [hdir', Bool.false_eq_true, ↓reduceIte] at hbody + rcases hpush : pushAff2 K ex.wid' ⟨0, cntVal, 0, 0⟩ r with _ | r₂ + · simp [hpush] at hbody + · simp only [hpush, Option.map_some, withNat_eq, Option.some.injEq, + Prod.mk.injEq] at hbody + rcases hbody with ⟨rfl, rfl⟩ + have ⟨hwfR₂, hpushEq⟩ := pushAff2_const_sound hz hwfR hpush true hj + simp only [↓reduceIte] at hpushEq + simp only [hdir', Bool.not_false, ↓reduceIte] at hrun + refine ⟨hwfL', hwfR₂, ?_⟩ + unfold evalAff2Cfg; simp only + rw [hpopEq, hpushEq]; exact hrun + · simp only [hdir', ↓reduceIte] at hbody + rcases hpush : pushAff2 K ex.wid' ⟨0, cntVal, 0, 0⟩ l' with _ | l₂ + · simp [hpush] at hbody + · simp only [hpush, Option.map_some, withNat_eq, Option.some.injEq, + Prod.mk.injEq] at hbody + rcases hbody with ⟨rfl, rfl⟩ + have ⟨hwfL₂, hpushEq⟩ := pushAff2_const_sound hz hwfL' hpush false hj + simp only [Bool.false_eq_true, ↓reduceIte] at hpushEq + simp only [hdir', Bool.not_true, Bool.false_eq_true, ↓reduceIte] at hrun + refine ⟨hwfL₂, hwfR, ?_⟩ + unfold evalAff2Cfg; simp only + rw [hpopEq, hpushEq]; exact hrun + · simp only [src, ↓reduceIte] at hbody + rcases hpop : popAff2 K ⟨0, cntVal, 0, 0⟩ r with _ | ⟨pw, r'⟩ + · simp [hpop] at hbody + · rw [hpop] at hbody + have ⟨hwfR', hpw, hpopEq⟩ := popAff2_const_sound hz hwfR hpop true hj + have hpwid : pw = wid := by simpa [wid, src, topWid2] using hpw + subst hpwid + simp only [↓reduceIte] at hpopEq + have hrun := hexPow + (evalAff2Side false (vocabWord baseWord vocab) k j l) + (evalAff2Side true (vocabWord baseWord vocab) k j r') + simp only [placeSide, ↓reduceIte] at hrun + cases hdir' : ex.dir' + · simp only [hdir', Bool.false_eq_true, ↓reduceIte] at hbody + rcases hpush : pushAff2 K ex.wid' ⟨0, cntVal, 0, 0⟩ r' with _ | r₂ + · simp [hpush] at hbody + · simp only [hpush, Option.map_some, withNat_eq, Option.some.injEq, + Prod.mk.injEq] at hbody + rcases hbody with ⟨rfl, rfl⟩ + have ⟨hwfR₂, hpushEq⟩ := pushAff2_const_sound hz hwfR' hpush true hj + simp only [↓reduceIte] at hpushEq + simp only [hdir', Bool.not_false, ↓reduceIte] at hrun + refine ⟨hwfL, hwfR₂, ?_⟩ + unfold evalAff2Cfg; simp only + rw [hpopEq, hpushEq]; exact hrun + · simp only [hdir', ↓reduceIte] at hbody + rcases hpush : pushAff2 K ex.wid' ⟨0, cntVal, 0, 0⟩ l with _ | l₂ + · simp [hpush] at hbody + · simp only [hpush, Option.map_some, withNat_eq, Option.some.injEq, + Prod.mk.injEq] at hbody + rcases hbody with ⟨rfl, rfl⟩ + have ⟨hwfL₂, hpushEq⟩ := pushAff2_const_sound hz hwfL hpush false hj + simp only [Bool.false_eq_true, ↓reduceIte] at hpushEq + simp only [hdir', Bool.not_true, Bool.false_eq_true, ↓reduceIte, + reverse_pow] at hrun + refine ⟨hwfL₂, hwfR', ?_⟩ + unfold evalAff2Cfg; simp only + rw [hpopEq, hpushEq]; exact hrun + · have hnqb := Bool.eq_false_iff.mpr hqb + simp [hnqb] at hst + +private theorem runAff2Steps_sound {M : Machine Γ Λ} {qOf : ℕ → Λ} {baseWord : ℕ → List Γ} + {baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)} + (hbase : BaseExitSound M qOf baseWord baseExit) + (hb0 : ∀ x ∈ baseWord 0, x = default) + {numStates : ℕ} {vocab : NatTrie (BTree ℕ)} {exits : NatTrie CompExit} + (hv0 : checkVocabBlank0 vocab = true) + (hexits : NatTrie.checkAll (checkExitEntry numStates baseExit vocab) 0 1 exits = true) + {K : AffNat} : + ∀ (n acc : ℕ) (c : Aff2Cfg) (accOut : ℕ) (cOut : Aff2Cfg), + stackWF K c.left → stackWF K c.right → + runAff2Steps numStates exits K n acc c = some (accOut, cOut) → + ∀ {k j : ℕ}, j < K.eval k → + acc ≤ accOut ∧ + ReachesIn M (accOut - acc) + (evalAff2Cfg qOf (vocabWord baseWord vocab) k j c) + (evalAff2Cfg qOf (vocabWord baseWord vocab) k j cOut) + | 0, acc, c, accOut, cOut, _, _, hrun, _, _, _ => by + simp only [runAff2Steps, Option.some.injEq, Prod.mk.injEq] at hrun + rcases hrun with ⟨rfl, rfl⟩ + exact ⟨Nat.le_refl acc, by simp⟩ + | n + 1, acc, c, accOut, cOut, hwfL, hwfR, hrun, k, j, hj => by + simp only [runAff2Steps] at hrun + rcases hst : stepAff2Once numStates exits K c with _ | ⟨dt, c'⟩ + · simp [hst] at hrun + · rw [hst] at hrun + simp only [withNat_eq] at hrun + obtain ⟨hwfL', hwfR', hstep⟩ := + stepAff2Once_sound hbase hb0 hv0 hexits hwfL hwfR hst hj + obtain ⟨hle, hrest⟩ := + runAff2Steps_sound hbase hb0 hv0 hexits n (acc + dt) c' accOut cOut hwfL' hwfR' hrun hj + refine ⟨by omega, ?_⟩ + have hsub : accOut - acc = dt + (accOut - (acc + dt)) := by omega + rw [hsub] + exact hstep.trans hrest + +private theorem attachDeltas_eval0 (wordOf : ℕ → List Γ) (side : Bool) (k : ℕ) : + ∀ (stk : List AffRun) (ds ds' : List (ℕ × ℕ)) (stk₂ : List Aff2Run), + attachDeltas stk ds = some (stk₂, ds') → + evalAff2Side side wordOf k 0 stk₂ = evalAffSide side wordOf k stk + | [], ds, ds', stk₂, h => by + simp only [attachDeltas, Option.some.injEq, Prod.mk.injEq] at h + rcases h with ⟨rfl, rfl⟩ + rfl + | r :: rs, [], _, _, h => by simp [attachDeltas] at h + | r :: rs, (dp, dn) :: ds, ds', stk₂, h => by + simp only [attachDeltas] at h + rcases hat : attachDeltas rs ds with _ | ⟨out, rem⟩ + · simp [hat] at h + · rw [hat] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + rcases h with ⟨rfl, rfl⟩ + have ih1 := attachDeltas_eval0 wordOf true k rs ds rem out hat + have ih0 := attachDeltas_eval0 wordOf false k rs ds rem out hat + have hev : (Aff2Nat.mk r.count.a r.count.b dp dn).eval k 0 = r.count.eval k := by + simp [Aff2Nat.eval, AffNat.eval] + cases side <;> simp [evalAff2Side, evalAffSide, hev, ih1, ih0] + +private theorem shiftStackJ_eval (wordOf : ℕ → List Γ) (K : AffNat) (side : Bool) {k j : ℕ} + (hj : j < K.eval k) : + ∀ (stk stkShift : List Aff2Run) (stkEnd : List AffRun), + shiftStackJ stk = some stkShift → + evalStackEnd K stk = some stkEnd → + evalAff2Side side wordOf k j stkShift = evalAff2Side side wordOf k (j + 1) stk + | [], stkShift, _, hsh, _ => by + simp only [shiftStackJ, Option.some.injEq] at hsh + subst hsh + rfl + | r :: rs, stkShift, stkEnd, hsh, hend => by + simp only [shiftStackJ] at hsh + simp only [evalStackEnd] at hend + rcases h1 : r.count.shiftJ? with _ | c' + · simp [h1] at hsh + · rcases h2 : shiftStackJ rs with _ | rs' + · simp [h1, h2] at hsh + · rw [h1, h2] at hsh + simp only [Option.some.injEq] at hsh + subst hsh + rcases he1 : r.count.atEnd? K with _ | ce + · simp [he1] at hend + · rcases he2 : evalStackEnd K rs with _ | rse + · simp [he1, he2] at hend + · have hcEq := Aff2Nat.shiftJ_eval h1 he1 hj + have ih1 := shiftStackJ_eval wordOf K true hj rs rs' rse h2 he2 + have ih0 := shiftStackJ_eval wordOf K false hj rs rs' rse h2 he2 + cases side <;> simp [evalAff2Side, hcEq, ih1, ih0] + +private theorem evalStackEnd_sound (wordOf : ℕ → List Γ) (K : AffNat) (side : Bool) (k : ℕ) : + ∀ (stk : List Aff2Run) (stkEnd : List AffRun), + evalStackEnd K stk = some stkEnd → + evalAff2Side side wordOf k (K.eval k) stk = evalAffSide side wordOf k stkEnd + | [], stkEnd, hend => by + simp only [evalStackEnd, Option.some.injEq] at hend + subst hend + rfl + | r :: rs, stkEnd, hend => by + simp only [evalStackEnd] at hend + rcases he1 : r.count.atEnd? K with _ | ce + · simp [he1] at hend + · rcases he2 : evalStackEnd K rs with _ | rse + · simp [he1, he2] at hend + · rw [he1, he2] at hend + by_cases hg : ce.geConst 1 = true + · simp only [hg, ↓reduceIte, Option.some.injEq] at hend + subst hend + have hcEq := Aff2Nat.atEnd_eval he1 k + have ih1 := evalStackEnd_sound wordOf K true k rs rse he2 + have ih0 := evalStackEnd_sound wordOf K false k rs rse he2 + cases side <;> simp [evalAff2Side, evalAffSide, hcEq, ih1, ih0] + · have hng := Bool.eq_false_iff.mpr hg + simp [hng] at hend + +/-- Soundness of `verifyCycle`: discharges `K(k)` iterations of an `L`-step inner loop. -/ +theorem verifyCycle_sound {M : Machine Γ Λ} {qOf : ℕ → Λ} {baseWord : ℕ → List Γ} + {baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)} + (hbase : BaseExitSound M qOf baseWord baseExit) + (hb0 : ∀ x ∈ baseWord 0, x = default) + {numStates : ℕ} {vocab : NatTrie (BTree ℕ)} {exits : NatTrie CompExit} + (hv0 : checkVocabBlank0 vocab = true) + (hexits : NatTrie.checkAll (checkExitEntry numStates baseExit vocab) 0 1 exits = true) + {L : ℕ} {K : AffNat} {deltas : List (ℕ × ℕ)} {c : AffCfg} + {dtTot : AffNat} {cEnd : AffCfg} + (hvc : verifyCycle numStates exits L K deltas c = some (dtTot, cEnd)) (k : ℕ) : + ReachesIn M (dtTot.eval k) + (evalAffCfg qOf (vocabWord baseWord vocab) k c) + (evalAffCfg qOf (vocabWord baseWord vocab) k cEnd) := by + unfold verifyCycle at hvc + by_cases hk1 : K.geConst 1 = true + · simp only [hk1, Bool.not_true, Bool.false_eq_true, ↓reduceIte] at hvc + rcases hatL : attachDeltas c.left deltas with _ | ⟨l₂, dsRem⟩ + · simp [hatL] at hvc + · rw [hatL] at hvc + simp only at hvc + rcases hatR : attachDeltas c.right dsRem with _ | ⟨r₂, dsRem2⟩ + · simp [hatR] at hvc + · rw [hatR] at hvc + rcases dsRem2 with _ | ⟨_, _⟩ + · simp only at hvc + by_cases hinit : + (l₂.all (fun r ↦ r.count.geForLoop K 1) && + r₂.all (fun r ↦ r.count.geForLoop K 1)) = true + · simp only [hinit, Bool.not_true, Bool.false_eq_true, ↓reduceIte] at hvc + simp only [Bool.and_eq_true] at hinit + have hwfL : stackWF K l₂ := List.all_eq_true.mp hinit.1 + have hwfR : stackWF K r₂ := List.all_eq_true.mp hinit.2 + rcases hrun : runAff2Steps numStates exits K L 0 ⟨c.q, c.dir, l₂, r₂⟩ with + _ | ⟨dtIter, c₁⟩ + · simp [hrun] at hvc + · rcases hshL : shiftStackJ l₂ with _ | lShift + · simp [hrun, hshL] at hvc + · rcases hshR : shiftStackJ r₂ with _ | rShift + · simp [hrun, hshL, hshR] at hvc + · rw [hrun, hshL, hshR] at hvc + by_cases hc1eq : (c₁ == ⟨c.q, c.dir, lShift, rShift⟩) = true + · simp only [hc1eq, ↓reduceIte] at hvc + have hc1 : c₁ = ⟨c.q, c.dir, lShift, rShift⟩ := eq_of_beq hc1eq + subst hc1 + rcases hendL : evalStackEnd K l₂ with _ | lEnd + · simp [hendL] at hvc + · rcases hendR : evalStackEnd K r₂ with _ | rEnd + · simp [hendL, hendR] at hvc + · rw [hendL, hendR] at hvc + simp only [AffNat.strict_eq, mkStrictAffCfg_eq, Option.some.injEq, + Prod.mk.injEq] at hvc + rcases hvc with ⟨rfl, rfl⟩ + set wOf := vocabWord baseWord vocab + have hloop : ∀ m : ℕ, m ≤ K.eval k → + ReachesIn M (dtIter * m) + (evalAff2Cfg qOf wOf k 0 ⟨c.q, c.dir, l₂, r₂⟩) + (evalAff2Cfg qOf wOf k m ⟨c.q, c.dir, l₂, r₂⟩) := by + intro m hm + induction m with + | zero => simp + | succ m ih => + have hm_lt : m < K.eval k := hm + have hprev := ih (Nat.le_of_lt hm_lt) + have ⟨_, hiter⟩ := + runAff2Steps_sound hbase hb0 hv0 hexits L 0 + ⟨c.q, c.dir, l₂, r₂⟩ dtIter ⟨c.q, c.dir, lShift, rShift⟩ + hwfL hwfR hrun hm_lt + simp only [Nat.sub_zero] at hiter + have hshEqL := shiftStackJ_eval wOf K false hm_lt l₂ lShift lEnd + hshL hendL + have hshEqR := shiftStackJ_eval wOf K true hm_lt r₂ rShift rEnd + hshR hendR + have hcfgEq : + evalAff2Cfg qOf wOf k m ⟨c.q, c.dir, lShift, rShift⟩ = + evalAff2Cfg qOf wOf k (m + 1) ⟨c.q, c.dir, l₂, r₂⟩ := by + simp [evalAff2Cfg, hshEqL, hshEqR] + rw [hcfgEq] at hiter + have htr := hprev.trans hiter + rwa [← Nat.mul_succ] at htr + have htot := hloop (K.eval k) (Nat.le_refl _) + have h0L := attachDeltas_eval0 wOf false k c.left deltas dsRem l₂ hatL + have h0R := attachDeltas_eval0 wOf true k c.right dsRem [] r₂ hatR + have hstartEq : + evalAff2Cfg qOf wOf k 0 ⟨c.q, c.dir, l₂, r₂⟩ = + evalAffCfg qOf wOf k c := by + simp [evalAff2Cfg, evalAffCfg, h0L, h0R] + have hendEqL := evalStackEnd_sound wOf K false k l₂ lEnd hendL + have hendEqR := evalStackEnd_sound wOf K true k r₂ rEnd hendR + have hendEq : + evalAff2Cfg qOf wOf k (K.eval k) ⟨c.q, c.dir, l₂, r₂⟩ = + evalAffCfg qOf wOf k ⟨c.q, c.dir, lEnd, rEnd⟩ := by + simp [evalAff2Cfg, evalAffCfg, hendEqL, hendEqR] + rw [hstartEq, hendEq, ← AffNat.eval_scale] at htot + exact htot + · have hnc1eq := Bool.eq_false_iff.mpr hc1eq + simp [hnc1eq] at hvc + · have hninit := Bool.eq_false_iff.mpr hinit + simp [hninit] at hvc + · simp at hvc + · have hnk1 := Bool.eq_false_iff.mpr hk1 + simp [hnk1] at hvc + +/-! ### Soundness of Certificate Tree Replay & Non-Halting Closure -/ + +private theorem runStepCount_sound {M : Machine Γ Λ} {qOf : ℕ → Λ} {baseWord : ℕ → List Γ} + {baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)} + (hbase : BaseExitSound M qOf baseWord baseExit) + (hb0 : ∀ x ∈ baseWord 0, x = default) + {numStates : ℕ} {vocab : NatTrie (BTree ℕ)} {exits : NatTrie CompExit} + (hv0 : checkVocabBlank0 vocab = true) + (hexits : NatTrie.checkAll (checkExitEntry numStates baseExit vocab) 0 1 exits = true) + {target : AffNat} : + ∀ (n : ℕ) (acc : AffNat) (c : AffCfg) (accOut : AffNat) (cOut : AffCfg), + runStepCount numStates exits target n acc c = some (accOut, cOut) → + ∀ k : ℕ, ∃ d : ℕ, accOut.eval k = acc.eval k + d ∧ + ReachesIn M d + (evalAffCfg qOf (vocabWord baseWord vocab) k c) + (evalAffCfg qOf (vocabWord baseWord vocab) k cOut) + | 0, acc, c, accOut, cOut, h, k => by + simp only [runStepCount, Option.some.injEq, Prod.mk.injEq] at h + rcases h with ⟨rfl, rfl⟩ + exact ⟨0, by omega, ReachesIn.zero M _⟩ + | n + 1, acc, ⟨q, dir, l, r⟩, accOut, cOut, h, k => by + simp only [runStepCount] at h + rcases hst : stepAffOnce numStates exits (target.sub? acc) q dir l r with _ | ⟨dt, c'⟩ + · simp [hst] at h + · rw [hst] at h + simp only [AffNat.strict_eq] at h + have h1 := stepAffOnce_sound hbase hb0 hv0 hexits hst k + obtain ⟨d₂, hd₂, h2⟩ := + runStepCount_sound hbase hb0 hv0 hexits n (acc.add dt) c' accOut cOut h k + refine ⟨dt.eval k + d₂, ?_, h1.trans h2⟩ + rw [hd₂, AffNat.eval_add, Nat.add_assoc] + +private theorem replayAffTree_sound_aux {M : Machine Γ Λ} {qOf : ℕ → Λ} {baseWord : ℕ → List Γ} + {baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)} + (hbase : BaseExitSound M qOf baseWord baseExit) + (hb0 : ∀ x ∈ baseWord 0, x = default) + {numStates : ℕ} {vocab : NatTrie (BTree ℕ)} {exits : NatTrie CompExit} + (hv0 : checkVocabBlank0 vocab = true) + (hexits : NatTrie.checkAll (checkExitEntry numStates baseExit vocab) 0 1 exits = true) + {target : AffNat} : + ∀ (ops : BTree AffOp) (acc : AffNat) (c : AffCfg) (accOut : AffNat) (cOut : AffCfg), + replayAffTree numStates exits target ops acc c = some (accOut, cOut) → + ∀ k : ℕ, ∃ d : ℕ, accOut.eval k = acc.eval k + d ∧ + ReachesIn M d + (evalAffCfg qOf (vocabWord baseWord vocab) k c) + (evalAffCfg qOf (vocabWord baseWord vocab) k cOut) + | .empty, acc, c, accOut, cOut, h, k => by + simp only [replayAffTree, Option.some.injEq, Prod.mk.injEq] at h + rcases h with ⟨rfl, rfl⟩ + exact ⟨0, by omega, ReachesIn.zero M _⟩ + | .leaf (.steps n), acc, c, accOut, cOut, h, k => + runStepCount_sound hbase hb0 hv0 hexits n acc c accOut cOut h k + | .leaf (.cycle L K deltas), acc, c, accOut, cOut, h, k => by + simp only [replayAffTree] at h + rcases hvc : verifyCycle numStates exits L K deltas c with _ | ⟨dt, c'⟩ + · simp [hvc] at h + · rw [hvc] at h + simp only [AffNat.strict_eq, Option.some.injEq, Prod.mk.injEq] at h + rcases h with ⟨rfl, rfl⟩ + exact ⟨dt.eval k, AffNat.eval_add acc dt k, + verifyCycle_sound hbase hb0 hv0 hexits hvc k⟩ + | .node l r, acc, c, accOut, cOut, h, k => by + simp only [replayAffTree] at h + rcases hl : replayAffTree numStates exits target l acc c with _ | ⟨a₁, c₁⟩ + · simp [hl] at h + · rw [hl] at h + obtain ⟨d₁, hd₁, h1⟩ := replayAffTree_sound_aux hbase hb0 hv0 hexits l acc c a₁ c₁ hl k + obtain ⟨d₂, hd₂, h2⟩ := replayAffTree_sound_aux hbase hb0 hv0 hexits r a₁ c₁ accOut cOut h k + refine ⟨d₁ + d₂, ?_, h1.trans h2⟩ + omega + +/-- Soundness of a verified `ReturnCert`: establishes `ReachesIn M (target.eval k)` for every +`k : ℕ`. -/ +theorem verifyReturnCert_sound {M : Machine Γ Λ} {qOf : ℕ → Λ} {baseWord : ℕ → List Γ} + {baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)} + (hbase : BaseExitSound M qOf baseWord baseExit) + (hb0 : ∀ x ∈ baseWord 0, x = default) + {numStates : ℕ} {cert : ReturnCert} {target : AffNat} {initCfg finalCfg : AffCfg} + (hv0 : checkVocabBlank0 cert.vocab = true) + (hexits : NatTrie.checkAll (checkExitEntry numStates baseExit cert.vocab) 0 1 cert.exits = true) + (hrep : AffReplayReaches numStates cert.exits target cert.ops ⟨0, 0⟩ initCfg target finalCfg) + (k : ℕ) : + ReachesIn M (target.eval k) + (evalAffCfg qOf (vocabWord baseWord cert.vocab) k initCfg) + (evalAffCfg qOf (vocabWord baseWord cert.vocab) k finalCfg) := by + obtain ⟨d, hd, hr⟩ := + replayAffTree_sound_aux hbase hb0 hv0 hexits cert.ops ⟨0, 0⟩ initCfg target finalCfg + hrep.to_eq k + have h0 : (AffNat.mk 0 0).eval k = 0 := by simp [AffNat.eval] + have hdeq : d = target.eval k := by omega + rwa [hdeq] at hr + +/-- Non-halting closure principle for affine-exponent symbolic configuration families `C : ℕ → Cfg`: +if `M` reaches `C 0` from the blank tape `init []` and `C k` reaches `C (k + 1)` in positive steps +for every `k : ℕ`, then `IsNotHalt M`. -/ +theorem isNotHalt_of_family {M : Machine Γ Λ} (C : ℕ → Cfg Γ Λ) + (hinit : ReachesStar M (init []) (C 0)) + (hstep : ∀ k : ℕ, ReachesPlus M (C k) (C (k + 1))) : + IsNotHalt M := by + refine IsNotHalt.of_reachesPlus_invariant (P := fun c ↦ ∃ k : ℕ, c = C k) hinit ⟨0, rfl⟩ ?_ + rintro _ ⟨k, rfl⟩ + exact ⟨C (k + 1), hstep k, ⟨k + 1, rfl⟩⟩ + +end MachineSoundness + +end BusyBeaver.AffRLE + +end diff --git a/BusyBeaver/BB6/A6/Cert.lean b/BusyBeaver/BB6/A6/Cert.lean new file mode 100644 index 00000000..c449059a --- /dev/null +++ b/BusyBeaver/BB6/A6/Cert.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.BB6.A6.Defs +meta import BusyBeaver.WordRLE +meta import BusyBeaver.AffRLE +meta import BusyBeaver.ElabRLE +meta import BusyBeaver.BB6.A6.Defs + +/-! +# Elaboration-Time Symbolic Return Certificate Synthesis for BB6 `A6` + +Invokes `BusyBeaver.ElabRLE.discoverReturnCert` during elaboration to synthesize `A6`'s +414-word composite vocabulary, 462-entry composite exit trie, 202-operation `BTree AffOp` +(9,844 affine sweeps + 67 countdown cycles), and post-return symbolic configuration `a6FinalCfg`. +-/ + +@[expose] public section + +namespace BusyBeaver.BB6.A6 + +open BusyBeaver.WordRLE BusyBeaver.AffRLE + +/-- Synthesize `(a6Cert, a6FinalCfg)` at elaboration time using the pure-Lean cycle-discovering +symbolic simulator. -/ +local elab "synthesize_a6_return_cert%" : term => do + match ElabRLE.discoverReturnCert 6 fastExit2 [[1], [2], [3], pWord, qWord] + initReturnCfg returnTarget with + | some pair => return Lean.toExpr pair + | none => Lean.throwError "Failed to synthesize A6 symbolic return certificate" + +/-- Synthesized symbolic return certificate and final `AffCfg` for `A6`. -/ +def a6CertPair : ReturnCert × AffCfg := + synthesize_a6_return_cert% + +/-- Synthesized `ReturnCert` for `A6`. -/ +def a6Cert : ReturnCert := a6CertPair.1 + +/-- Synthesized 414-word composite vocabulary trie for `A6`. -/ +def a6Vocab : NatTrie (BTree ℕ) := a6Cert.vocab + +/-- Synthesized 462-entry composite word-exit trie for `A6`. -/ +def a6Exits : NatTrie CompExit := a6Cert.exits + +/-- Synthesized balanced `BTree AffOp` for `A6`. -/ +def a6Ops : BTree AffOp := a6Cert.ops + +/-- Post-return symbolic configuration reached after `returnTarget` steps from `initReturnCfg`. -/ +def a6FinalCfg : AffCfg := a6CertPair.2 + +end BusyBeaver.BB6.A6 + +end diff --git a/BusyBeaver/BB6/A6/Defs.lean b/BusyBeaver/BB6/A6/Defs.lean new file mode 100644 index 00000000..bb568dfb --- /dev/null +++ b/BusyBeaver/BB6/A6/Defs.lean @@ -0,0 +1,758 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.ElabRLE + +/-! +# Machine Specification, Verified Transfers, and Family Definitions for BB6 `A6` + +Core definitions and local soundness theorems for the 6-state, 2-symbol Turing machine +`1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LB---` (`A6`): + +- `a6Target` & `a6StepCode_agrees` — Lightweight `BusyBeaver.Machine` specification (free of heavy + `Cryptids.Machines` imports) and agreement with `a6StepCode`. +- `fastExit2` & `fastExit2_sound` — Verified 2-bit base-word (`Z, Y, X, W`) exit table. +- `transferB_batch` & `transferD_batch` — Certified quadratic-step (`4*k*b + 6*k^2 + 12*k`) + counter transfers directly over `ListBlank (Fin 2)`. +- `stepEntry` & `stepEntry_sound` — Soundness of the accelerated Entry RLE simulator. +- `entryMilestone`, `initReturnCfg`, & `returnTarget` — Closed-form milestone and symbolic family + specifications. +-/ + +@[expose] public section + +namespace BusyBeaver.BB6.A6 + +open Turing +open BusyBeaver.WordRLE BusyBeaver.AffRLE + +/-! ## Transition Table and 2-Bit Base Vocabulary -/ + +/-- Map `ℕ` state indices `0..5` into `Fin 6`. -/ +def qOf (n : ℕ) : Fin 6 := + ⟨n % 6, Nat.mod_lt _ (by decide)⟩ + +/-- Pure `ℕ`-indexed symbol transition function for `A6`. -/ +def a6StepCode (q : ℕ) (a : Fin 2) : Option (Fin 2 × Bool × ℕ) := + match q, a.val with + | 0, 0 => some (1, true, 1) | 0, 1 => some (0, false, 5) + | 1, 0 => some (1, true, 2) | 1, 1 => some (0, true, 0) + | 2, 0 => some (1, false, 3) | 2, 1 => some (0, true, 1) + | 3, 0 => some (0, false, 4) | 3, 1 => some (0, false, 2) + | 4, 0 => some (0, false, 0) | 4, 1 => some (0, false, 2) + | 5, 0 => some (0, false, 1) | _, _ => none + +/-- Lightweight `BusyBeaver.Machine` representation of `A6` +(`1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LB---`). -/ +def a6Target : Machine (Fin 2) (Fin 6) := fun q a ↦ + match a6StepCode q.val a with + | some (b, dir', q') => + some (some (qOf q'), Stmt.write b (if dir' then Dir.right else Dir.left)) + | none => none + +/-- `a6StepCode` agrees everywhere with `a6Target`. -/ +theorem a6StepCode_agrees : StepCodeAgrees a6Target qOf a6StepCode := by + intro q a b dir' q' h + match q with + | 0 => simp [a6Target, qOf, h] + | 1 => simp [a6Target, qOf, h] + | 2 => simp [a6Target, qOf, h] + | 3 => simp [a6Target, qOf, h] + | 4 => simp [a6Target, qOf, h] + | 5 => simp [a6Target, qOf, h] + | q + 6 => simp [a6StepCode] at h + +/-- Two-bit spatial base words: `0 ↦ [0, 0]` (`Z`), `1 ↦ [0, 1]` (`Y`), `2 ↦ [1, 0]` (`X`), +`3 ↦ [1, 1]` (`W`). -/ +def baseWord : ℕ → List (Fin 2) + | 0 => [0, 0] + | 1 => [0, 1] + | 2 => [1, 0] + | 3 => [1, 1] + | _ => [] + +/-- Base word `0` (`[0, 0]`) consists solely of blank symbols. -/ +theorem baseWord_zero_blank : ∀ x ∈ baseWord 0, x = default := by + decide + +/-- Fast 2-bit base-word exit table `(q, dir, sym) ↦ (sym', q', dir', dt)`. -/ +@[inline] +def fastExit2 (q : ℕ) (dir : Bool) (sym : ℕ) : Option (ℕ × ℕ × Bool × ℕ) := + if dir then + match q, sym with + | 0, 0 => some (3, 2, true, 2) | 0, 1 => some (2, 0, true, 2) + | 0, 2 => some (0, 5, false, 1) | 0, 3 => some (1, 5, false, 1) + | 1, 0 => some (1, 2, false, 3) | 1, 1 => some (2, 1, true, 2) + | 1, 2 => some (1, 1, true, 2) | 1, 3 => some (0, 1, false, 3) + | 2, 0 => some (2, 3, false, 1) | 2, 1 => some (3, 3, false, 1) + | 2, 2 => some (1, 2, true, 2) | 2, 3 => some (0, 0, true, 2) + | 3, 0 => some (0, 4, false, 1) | 3, 1 => some (1, 4, false, 1) + | 3, 2 => some (0, 2, false, 1) | 3, 3 => some (1, 2, false, 1) + | 4, 0 => some (0, 0, false, 1) | 4, 1 => some (1, 0, false, 1) + | 4, 2 => some (0, 2, false, 1) | 4, 3 => some (1, 2, false, 1) + | 5, 0 => some (0, 1, false, 1) | 5, 1 => some (1, 1, false, 1) + | _, _ => none + else + match q, sym with + | 0, 0 => some (1, 1, true, 1) | 0, 1 => some (0, 1, false, 2) + | 0, 2 => some (3, 1, true, 1) | 0, 3 => none + | 1, 0 => some (1, 2, true, 1) | 1, 1 => some (0, 0, true, 1) + | 1, 2 => some (3, 2, true, 1) | 1, 3 => some (2, 0, true, 1) + | 2, 0 => some (1, 4, false, 2) | 2, 1 => some (0, 1, true, 1) + | 2, 2 => some (1, 2, false, 2) | 2, 3 => some (2, 1, true, 1) + | 3, 0 => some (0, 0, false, 2) | 3, 1 => some (2, 3, false, 2) + | 3, 2 => some (0, 2, false, 2) | 3, 3 => some (1, 2, true, 3) + | 4, 0 => some (3, 2, true, 3) | 4, 1 => some (2, 3, false, 2) + | 4, 2 => some (0, 5, false, 2) | 4, 3 => some (1, 2, true, 3) + | 5, 0 => some (1, 2, false, 4) | 5, 1 => none + | 5, 2 => some (1, 1, true, 3) | _, _ => none + +private def checkFastExit2One (q : ℕ) (dir : Bool) (s : ℕ) : Bool := + match fastExit2 q dir s with + | none => true + | some (s', q', dir', dt) => + runWordExit a6StepCode 10 (baseWord s) q dir == some (baseWord s', q', dir', dt) + +private theorem checkFastExit2_all : + ((List.range 6).all fun q ↦ + [false, true].all fun dir ↦ + (List.range 4).all fun s ↦ checkFastExit2One q dir s) = true := by + decide + +/-- Soundness of `fastExit2` for every `(q, dir, s)` entry. -/ +theorem fastExit2_sound : BaseExitSound a6Target qOf baseWord fastExit2 := by + intro q dir s s' q' dir' dt hfe + have hq : q < 6 := by + match q with + | 0 | 1 | 2 | 3 | 4 | 5 => omega + | d + 6 => + unfold fastExit2 at hfe + cases dir <;> contradiction + have hs : s < 4 := by + match s with + | 0 | 1 | 2 | 3 => omega + | d + 4 => + unfold fastExit2 at hfe + match q with + | 0 | 1 | 2 | 3 | 4 | 5 => cases dir <;> contradiction + | q' + 6 => cases dir <;> contradiction + have h1 := (List.all_eq_true.mp checkFastExit2_all) q (List.mem_range.mpr hq) + have h2 := (List.all_eq_true.mp h1) dir (by cases dir <;> simp) + have h3 := (List.all_eq_true.mp h2) s (List.mem_range.mpr hs) + simp only [checkFastExit2One, hfe] at h3 + exact runWordExit_sound a6StepCode_agrees (eq_of_beq h3) + +/-! ## Quadratic Counter Transfers (`transferD_batch` and `transferB_batch`) -/ + +private theorem batch_cost_succ (k b : ℕ) : + (4 * b + 18) + (4 * k * (b + 3) + 6 * k * k + 12 * k) = + 4 * (k + 1) * b + 6 * (k + 1) * (k + 1) + 12 * (k + 1) := by + have h1 : 4 * k * (b + 3) = 4 * k * b + 12 * k := by + rw [Nat.mul_add] + omega + have h2 : 4 * (k + 1) * b = 4 * k * b + 4 * b := by + rw [Nat.mul_add 4 k 1, Nat.mul_one, Nat.add_mul] + have h3 : 6 * (k + 1) * (k + 1) = 6 * k * k + 12 * k + 6 := by + rw [Nat.mul_add 6 k 1, Nat.mul_one, Nat.mul_add, Nat.mul_one, Nat.add_mul] + omega + omega + +private theorem transferD_one (b : ℕ) (lTail : ListBlank (Fin 2)) : + ReachesIn a6Target (4 * b + 18) + (Cfg.headLeft 3 + (ListBlank.append [0, 0] (ListBlank.append (([1, 0] : List (Fin 2)) ^ 2) lTail)) + (ListBlank.append (([1, 0] : List (Fin 2)) ^ b) default)) + (Cfg.headLeft 3 + (ListBlank.append [0, 0] lTail) + (ListBlank.append (([1, 0] : List (Fin 2)) ^ (b + 3)) default)) := by + have hOpen : WordExit a6Target qOf [0, 1, 0, 1, 0, 0] 3 false [0, 0, 0, 1, 0, 1] 2 true 13 := + runWordExit_sound a6StepCode_agrees (fuel := 20) (by decide) + have h1 := hOpen lTail (ListBlank.append (([1, 0] : List (Fin 2)) ^ b) default) + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_true, dirCfg, qOf] at h1 + have h1' : ReachesIn a6Target 13 + (Cfg.headLeft 3 + (ListBlank.append [0, 0] (ListBlank.append (([1, 0] : List (Fin 2)) ^ 2) lTail)) + (ListBlank.append (([1, 0] : List (Fin 2)) ^ b) default)) + (Cfg.headRight 2 + (ListBlank.append (([1, 0] : List (Fin 2)) ^ 2) (ListBlank.append [0, 0] lTail)) + (ListBlank.append (([1, 0] : List (Fin 2)) ^ b) default)) := by + simpa [list_pow_succ, list_pow_zero, ListBlank.append_assoc] using h1 + have hexC : WordExit a6Target qOf [1, 0] 2 true [0, 1] 2 true 2 := + runWordExit_sound a6StepCode_agrees (fuel := 10) (by decide) + have h2 := sweepWord_sound hexC b + (ListBlank.append (([1, 0] : List (Fin 2)) ^ 2) (ListBlank.append [0, 0] lTail)) default + simp only [placeSide, ↓reduceIte, Bool.not_true, Bool.false_eq_true, reverse_pow, + dirCfg, qOf] at h2 + have h2' : ReachesIn a6Target (2 * b) + (Cfg.headRight 2 + (ListBlank.append (([1, 0] : List (Fin 2)) ^ 2) (ListBlank.append [0, 0] lTail)) + (ListBlank.append (([1, 0] : List (Fin 2)) ^ b) default)) + (Cfg.headRight 2 + (ListBlank.append (([1, 0] : List (Fin 2)) ^ (b + 2)) (ListBlank.append [0, 0] lTail)) + default) := by + simpa [list_pow_add, ListBlank.append_assoc] using h2 + have h3 : ReachesIn a6Target 1 + (Cfg.headRight 2 + (ListBlank.append (([1, 0] : List (Fin 2)) ^ (b + 2)) (ListBlank.append [0, 0] lTail)) + default) + (Cfg.headLeft 3 + (ListBlank.append (([1, 0] : List (Fin 2)) ^ (b + 2)) (ListBlank.append [0, 0] lTail)) + (ListBlank.append [1, 0] default)) := by + have hs := step_headRight_default_left (M := a6Target) (q := (2 : Fin 6)) (q' := 3) (b := 1) + rfl (ListBlank.append (([1, 0] : List (Fin 2)) ^ (b + 2)) (ListBlank.append [0, 0] lTail)) + have hr10 : ListBlank.cons (1 : Fin 2) default = ListBlank.append [1, 0] default := by + simp + rw [hr10] at hs + exact ReachesIn.single hs + have hexD : WordExit a6Target qOf [0, 1] 3 false [1, 0] 3 false 2 := + runWordExit_sound a6StepCode_agrees (fuel := 10) (by decide) + have h4 := sweepWord_sound hexD (b + 2) + (ListBlank.append [0, 0] lTail) (ListBlank.append [1, 0] default) + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_false, reverse_pow, + dirCfg, qOf] at h4 + have h4' : ReachesIn a6Target (2 * (b + 2)) + (Cfg.headLeft 3 + (ListBlank.append (([1, 0] : List (Fin 2)) ^ (b + 2)) (ListBlank.append [0, 0] lTail)) + (ListBlank.append [1, 0] default)) + (Cfg.headLeft 3 + (ListBlank.append [0, 0] lTail) + (ListBlank.append (([1, 0] : List (Fin 2)) ^ (b + 3)) default)) := by + simpa [list_pow_succ', ListBlank.append_assoc] using h4 + have htot := ((h1'.trans h2').trans h3).trans h4' + have hdt : 13 + 2 * b + 1 + 2 * (b + 2) = 4 * b + 18 := by omega + rwa [hdt] at htot + +/-- `k`-batch state-`D` quadratic transfer over arbitrary left tail `lTail`. -/ +theorem transferD_batch (k b : ℕ) (lTail : ListBlank (Fin 2)) : + ReachesIn a6Target (4 * k * b + 6 * k * k + 12 * k) + (Cfg.headLeft 3 + (ListBlank.append [0, 0] (ListBlank.append (([1, 0] : List (Fin 2)) ^ (2 * k)) lTail)) + (ListBlank.append (([1, 0] : List (Fin 2)) ^ b) default)) + (Cfg.headLeft 3 + (ListBlank.append [0, 0] lTail) + (ListBlank.append (([1, 0] : List (Fin 2)) ^ (b + 3 * k)) default)) := by + induction k generalizing b with + | zero => simp + | succ k ih => + have hpow : 2 * (k + 1) = 2 + 2 * k := by omega + rw [hpow, list_pow_add, ListBlank.append_assoc] + have h1 := transferD_one b (ListBlank.append (([1, 0] : List (Fin 2)) ^ (2 * k)) lTail) + have h2 := ih (b + 3) + have htr := h1.trans h2 + have hcnt : b + 3 + 3 * k = b + 3 * (k + 1) := by omega + rw [batch_cost_succ, hcnt] at htr + exact htr + +private theorem transferB_one (b : ℕ) (lTail : ListBlank (Fin 2)) : + ReachesIn a6Target (4 * b + 18) + (Cfg.headRight 1 + (ListBlank.append [0, 1, 0, 0] (ListBlank.append (([0, 1] : List (Fin 2)) ^ 2) lTail)) + (ListBlank.append (([0, 1] : List (Fin 2)) ^ b) default)) + (Cfg.headRight 1 + (ListBlank.append [0, 1, 0, 0] lTail) + (ListBlank.append (([0, 1] : List (Fin 2)) ^ (b + 3)) default)) := by + set midL := ListBlank.append [0, 0] (ListBlank.append (([0, 1] : List (Fin 2)) ^ 2) lTail) + have hexB : WordExit a6Target qOf [0, 1] 1 true [1, 0] 1 true 2 := + runWordExit_sound a6StepCode_agrees (fuel := 10) (by decide) + have h1 := sweepWord_sound hexB b (ListBlank.append [0, 1] midL) default + simp only [placeSide, ↓reduceIte, Bool.not_true, Bool.false_eq_true, reverse_pow, + dirCfg, qOf] at h1 + have h1' : ReachesIn a6Target (2 * b) + (Cfg.headRight 1 + (ListBlank.append [0, 1, 0, 0] (ListBlank.append (([0, 1] : List (Fin 2)) ^ 2) lTail)) + (ListBlank.append (([0, 1] : List (Fin 2)) ^ b) default)) + (Cfg.headRight 1 + (ListBlank.append (([0, 1] : List (Fin 2)) ^ (b + 1)) midL) + default) := by + simpa [midL, list_pow_succ', ListBlank.append_assoc] using h1 + have hexTurn : WordExit a6Target qOf [0, 0] 1 true [0, 1] 2 false 3 := + runWordExit_sound a6StepCode_agrees (fuel := 10) (by decide) + have h2 := hexTurn (ListBlank.append (([0, 1] : List (Fin 2)) ^ (b + 1)) midL) default + simp only [placeSide, ↓reduceIte, Bool.not_false, dirCfg, qOf] at h2 + have hdef00 : ListBlank.append ([0, 0] : List (Fin 2)) default = default := + lb_blank_word [0, 0] baseWord_zero_blank + rw [hdef00] at h2 + have hexCL : WordExit a6Target qOf [1, 0] 2 false [0, 1] 2 false 2 := + runWordExit_sound a6StepCode_agrees (fuel := 10) (by decide) + have h3 := sweepWord_sound hexCL (b + 1) midL (ListBlank.append [0, 1] default) + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_false, reverse_pow, + dirCfg, qOf] at h3 + have h3' : ReachesIn a6Target (2 * (b + 1)) + (Cfg.headLeft 2 + (ListBlank.append (([0, 1] : List (Fin 2)) ^ (b + 1)) midL) + (ListBlank.append [0, 1] default)) + (Cfg.headLeft 2 midL + (ListBlank.append (([0, 1] : List (Fin 2)) ^ (b + 2)) default)) := by + simpa [list_pow_succ', ListBlank.append_assoc] using h3 + set r₂ := ListBlank.append (([0, 1] : List (Fin 2)) ^ (b + 2)) default + have hexL5 : WordExit a6Target qOf [0, 1, 0, 0, 0] 2 false [0, 0, 0, 0, 1] 1 false 5 := + runWordExit_sound a6StepCode_agrees (fuel := 15) (by decide) + have h4 := hexL5 (ListBlank.cons 1 lTail) r₂ + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_false, dirCfg, qOf] at h4 + have h4' : ReachesIn a6Target 5 + (Cfg.headLeft 2 midL r₂) + (Cfg.headLeft 1 (ListBlank.cons 1 lTail) (ListBlank.append [0, 0, 0, 0, 1] r₂)) := by + simpa [midL, list_pow_succ, list_pow_zero, ListBlank.append_assoc] using h4 + have h5 : ReachesIn a6Target 1 + (Cfg.headLeft 1 (ListBlank.cons 1 lTail) (ListBlank.append [0, 0, 0, 0, 1] r₂)) + (Cfg.headRight 0 (ListBlank.cons 0 lTail) + (ListBlank.append [0, 0, 0] (ListBlank.append [0, 1] r₂))) := by + have hs := step_headLeft_right (M := a6Target) (q := (1 : Fin 6)) (q' := 0) (a := 1) (b := 0) + rfl lTail (ListBlank.append [0, 0, 0, 0, 1] r₂) + simpa [ListBlank.append_assoc] using ReachesIn.single hs + have hexR7 : WordExit a6Target qOf [0, 0, 0] 0 true [0, 1, 0] 1 true 7 := + runWordExit_sound a6StepCode_agrees (fuel := 15) (by decide) + have h6 := hexR7 (ListBlank.cons 0 lTail) (ListBlank.append [0, 1] r₂) + simp only [placeSide, ↓reduceIte, Bool.not_true, Bool.false_eq_true, dirCfg, qOf] at h6 + have h6' : ReachesIn a6Target 7 + (Cfg.headRight 0 (ListBlank.cons 0 lTail) + (ListBlank.append [0, 0, 0] (ListBlank.append [0, 1] r₂))) + (Cfg.headRight 1 (ListBlank.append [0, 1, 0, 0] lTail) + (ListBlank.append (([0, 1] : List (Fin 2)) ^ (b + 3)) default)) := by + simpa [r₂, list_pow_succ, ListBlank.append_assoc] using h6 + have htot := ((((h1'.trans h2).trans h3').trans h4').trans h5).trans h6' + have hdt : 2 * b + 3 + 2 * (b + 1) + 5 + 1 + 7 = 4 * b + 18 := by omega + rwa [hdt] at htot + +/-- `k`-batch state-`B` quadratic transfer over arbitrary left tail `lTail`. -/ +theorem transferB_batch (k b : ℕ) (lTail : ListBlank (Fin 2)) : + ReachesIn a6Target (4 * k * b + 6 * k * k + 12 * k) + (Cfg.headRight 1 + (ListBlank.append [0, 1, 0, 0] (ListBlank.append (([0, 1] : List (Fin 2)) ^ (2 * k)) lTail)) + (ListBlank.append (([0, 1] : List (Fin 2)) ^ b) default)) + (Cfg.headRight 1 + (ListBlank.append [0, 1, 0, 0] lTail) + (ListBlank.append (([0, 1] : List (Fin 2)) ^ (b + 3 * k)) default)) := by + induction k generalizing b with + | zero => simp + | succ k ih => + have hpow : 2 * (k + 1) = 2 + 2 * k := by omega + rw [hpow, list_pow_add, ListBlank.append_assoc] + have h1 := transferB_one b (ListBlank.append (([0, 1] : List (Fin 2)) ^ (2 * k)) lTail) + have h2 := ih (b + 3) + have htr := h1.trans h2 + have hcnt : b + 3 + 3 * k = b + 3 * (k + 1) := by omega + rw [batch_cost_succ, hcnt] at htr + exact htr + +/-! ## Accelerated Entry RLE Simulator (`stepNormal`, `stepEntry`) and Soundness -/ + +/-- Pop a single word copy from `stk`, popping `(0, [])` from `[]` and failing if `tc = 0`. -/ +@[inline] +def popOne : List Run → Option (ℕ × List Run) + | [] => some (0, []) + | ⟨ts, tc⟩ :: rest => + if Nat.beq tc 0 then none + else if Nat.beq tc 1 then some (ts, rest) + else withNat (tc - 1) fun rem ↦ some (ts, Run.mk ts rem :: rest) + +/-- Return the top symbol index of `stk` (`0` for an empty stack). -/ +@[inline] +def topRunSym : List Run → ℕ + | [] => 0 + | top :: _ => top.sym + +private theorem popOne_sound {stk stk' : List Run} {s : ℕ} + (hp : popOne stk = some (s, stk')) (side : Bool) : + s = topRunSym stk ∧ + evalSide side baseWord stk = + if side then ListBlank.append (baseWord s) (evalSide true baseWord stk') + else ListBlank.append (baseWord s).reverse (evalSide false baseWord stk') := by + have hzRev : ∀ x ∈ (baseWord 0).reverse, x = default := + fun x hx ↦ baseWord_zero_blank x (List.mem_reverse.mp hx) + rcases stk with _ | ⟨⟨ts, tc⟩, rest⟩ + · simp only [popOne, Option.some.injEq, Prod.mk.injEq] at hp + rcases hp with ⟨rfl, rfl⟩ + refine ⟨rfl, ?_⟩ + cases side <;> + simp [evalSide, lb_blank_word _ baseWord_zero_blank, lb_blank_word _ hzRev] + · simp only [popOne] at hp + by_cases h0 : Nat.beq tc 0 = true + · simp [h0] at hp + · have hn0 := Bool.eq_false_iff.mpr h0 + rw [hn0] at hp + have hpos : 1 ≤ tc := by + have hne : tc ≠ 0 := fun h ↦ h0 (by rw [h]; rfl) + omega + by_cases h1 : Nat.beq tc 1 = true + · simp only [Bool.false_eq_true, ↓reduceIte, h1, Option.some.injEq, Prod.mk.injEq] at hp + rcases hp with ⟨rfl, rfl⟩ + have htc1 : tc = 1 := Nat.eq_of_beq_eq_true h1 + subst htc1 + refine ⟨rfl, ?_⟩ + cases side <;> simp [evalSide] + · have hn1 := Bool.eq_false_iff.mpr h1 + simp only [Bool.false_eq_true, ↓reduceIte, hn1, withNat_eq, Option.some.injEq, + Prod.mk.injEq] at hp + rcases hp with ⟨rfl, rfl⟩ + have htc : tc = 1 + (tc - 1) := by omega + refine ⟨rfl, ?_⟩ + cases side + · simp only [Bool.false_eq_true, ↓reduceIte, evalSide] + conv_lhs => rw [htc, list_pow_add, list_pow_one, ListBlank.append_assoc] + · simp only [↓reduceIte, evalSide] + conv_lhs => rw [htc, list_pow_add, list_pow_one, ListBlank.append_assoc] + +/-- Early-stop guard when sweeping `Y^b` rightwards in state `B` at a transfer boundary. -/ +@[inline] +def isStopEarly (q q' : ℕ) (dir' : Bool) (l r : List Run) : Bool := + if Nat.beq q' q && dir' && Nat.beq q 1 && Nat.beq (topRunSym r) 1 then + match r, l with + | [_], ⟨0, 1⟩ :: ⟨2, aCnt⟩ :: _ => Nat.ble 2 aCnt + | _, _ => false + else false + +/-- Non-transfer RLE step (homogeneous sweep or single-word exit). -/ +def stepNormal (q : ℕ) (dir : Bool) (l r : List Run) : Option (ℕ × EntryCfg) := + if dir then + let sym := topRunSym r + match fastExit2 q true sym with + | none => none + | some (sym', q', dir', exDt) => + if Nat.beq q' q && dir' && !isStopEarly q q' dir' l r then + match r with + | [] => none + | ⟨_, tc⟩ :: rest => + withNat (exDt * tc) fun dt ↦ some (dt, EntryCfg.mk q' true (pushLit sym' tc l) rest) + else + match popOne r with + | none => none + | some (_, r') => + if dir' then some (exDt, EntryCfg.mk q' true (pushLit sym' 1 l) r') + else some (exDt, EntryCfg.mk q' false l (pushLit sym' 1 r')) + else + let sym := topRunSym l + match fastExit2 q false sym with + | none => none + | some (sym', q', dir', exDt) => + if Nat.beq q' q && !dir' then + match l with + | [] => none + | ⟨_, tc⟩ :: rest => + withNat (exDt * tc) fun dt ↦ some (dt, EntryCfg.mk q' false rest (pushLit sym' tc r)) + else + match popOne l with + | none => none + | some (_, l') => + if dir' then some (exDt, EntryCfg.mk q' true (pushLit sym' 1 l') r) + else some (exDt, EntryCfg.mk q' false l' (pushLit sym' 1 r)) + +/-- Soundness of `stepNormal`. -/ +theorem stepNormal_sound : StepFnSound a6Target qOf baseWord stepNormal := by + intro q dir l r dt c' hst + unfold stepNormal at hst + cases dir + · simp only [Bool.false_eq_true, ↓reduceIte] at hst + rcases hfe : fastExit2 q false (topRunSym l) with _ | ⟨sym', q', dir', exDt⟩ + · rw [hfe] at hst + simp at hst + · rw [hfe] at hst + have hex := fastExit2_sound q false (topRunSym l) sym' q' dir' exDt hfe + by_cases hsw : (Nat.beq q' q && !dir') = true + · simp only [hsw, ↓reduceIte] at hst + rcases l with _ | ⟨⟨ts, tc⟩, rest⟩ + · simp at hst + · simp only [withNat_eq, Option.some.injEq, Prod.mk.injEq] at hst + rcases hst with ⟨rfl, rfl⟩ + simp only [Bool.and_eq_true, Bool.not_eq_true'] at hsw + have hqq : q' = q := Nat.eq_of_beq_eq_true hsw.1 + have hdd : dir' = false := hsw.2 + subst hqq; subst hdd + have hrun := sweepWord_sound hex tc (evalSide false baseWord rest) + (evalSide true baseWord r) + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_false, reverse_pow] at hrun + simpa [evalEntryCfg, evalSide, topRunSym, + evalSide_pushLit baseWord_zero_blank] using hrun + · have hnsw := Bool.eq_false_iff.mpr hsw + simp only [hnsw, Bool.false_eq_true, ↓reduceIte] at hst + rcases hpop : popOne l with _ | ⟨ps, l'⟩ + · simp [hpop] at hst + · rw [hpop] at hst + have ⟨hps, hlEq⟩ := popOne_sound hpop false + simp only [Bool.false_eq_true, ↓reduceIte] at hlEq + have hrun := hex (evalSide false baseWord l') (evalSide true baseWord r) + cases dir' + · simp only [Bool.false_eq_true, ↓reduceIte, Option.some.injEq, Prod.mk.injEq] at hst + rcases hst with ⟨rfl, rfl⟩ + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_false] at hrun + simpa [evalEntryCfg, hlEq, hps, + evalSide_pushLit baseWord_zero_blank] using hrun + · simp only [↓reduceIte, Option.some.injEq, Prod.mk.injEq] at hst + rcases hst with ⟨rfl, rfl⟩ + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_true] at hrun + simpa [evalEntryCfg, hlEq, hps, + evalSide_pushLit baseWord_zero_blank] using hrun + · simp only [↓reduceIte] at hst + rcases hfe : fastExit2 q true (topRunSym r) with _ | ⟨sym', q', dir', exDt⟩ + · rw [hfe] at hst + simp at hst + · rw [hfe] at hst + have hex := fastExit2_sound q true (topRunSym r) sym' q' dir' exDt hfe + by_cases hsw : (Nat.beq q' q && dir' && !isStopEarly q q' dir' l r) = true + · simp only [hsw, ↓reduceIte] at hst + rcases r with _ | ⟨⟨ts, tc⟩, rest⟩ + · simp at hst + · simp only [withNat_eq, Option.some.injEq, Prod.mk.injEq] at hst + rcases hst with ⟨rfl, rfl⟩ + simp only [Bool.and_eq_true] at hsw + have hqq : q' = q := Nat.eq_of_beq_eq_true hsw.1.1 + have hdd : dir' = true := hsw.1.2 + subst hqq; subst hdd + have hrun := sweepWord_sound hex tc (evalSide false baseWord l) + (evalSide true baseWord rest) + simp only [placeSide, ↓reduceIte, Bool.not_true, Bool.false_eq_true, reverse_pow] at hrun + simpa [evalEntryCfg, evalSide, topRunSym, + evalSide_pushLit baseWord_zero_blank] using hrun + · have hnsw := Bool.eq_false_iff.mpr hsw + simp only [hnsw, Bool.false_eq_true, ↓reduceIte] at hst + rcases hpop : popOne r with _ | ⟨ps, r'⟩ + · simp [hpop] at hst + · rw [hpop] at hst + have ⟨hps, hrEq⟩ := popOne_sound hpop true + simp only [↓reduceIte] at hrEq + have hrun := hex (evalSide false baseWord l) (evalSide true baseWord r') + cases dir' + · simp only [Bool.false_eq_true, ↓reduceIte, Option.some.injEq, Prod.mk.injEq] at hst + rcases hst with ⟨rfl, rfl⟩ + simp only [placeSide, ↓reduceIte, Bool.not_false] at hrun + simpa [evalEntryCfg, hrEq, hps, + evalSide_pushLit baseWord_zero_blank] using hrun + · simp only [↓reduceIte, Option.some.injEq, Prod.mk.injEq] at hst + rcases hst with ⟨rfl, rfl⟩ + simp only [placeSide, ↓reduceIte, Bool.not_true, Bool.false_eq_true] at hrun + simpa [evalEntryCfg, hrEq, hps, + evalSide_pushLit baseWord_zero_blank] using hrun + +/-- Extract optional right-side count `b` for a transfer (`[] ↦ 0`, `[⟨w, b⟩] ↦ b`). -/ +@[inline] +def transferRightCount (expSym : ℕ) : List Run → Option ℕ + | [] => some 0 + | [⟨s, b⟩] => if Nat.beq s expSym then some b else none + | _ => none + +private theorem transferRightCount_eval {expSym : ℕ} {r : List Run} {b : ℕ} + (h : transferRightCount expSym r = some b) : + evalSide true baseWord r = ListBlank.append (baseWord expSym ^ b) default := by + rcases r with _ | ⟨⟨s, c⟩, _ | _⟩ + · simp only [transferRightCount, Option.some.injEq] at h + subst h + rfl + · simp only [transferRightCount] at h + by_cases hs : Nat.beq s expSym = true + · simp only [hs, ↓reduceIte, Option.some.injEq] at h + have heq := Nat.eq_of_beq_eq_true hs + subst heq; subst h + rfl + · have hns := Bool.eq_false_iff.mpr hs + simp [hns] at h + · simp [transferRightCount] at h + +/-- Full accelerated Entry transition function combining `transferD`, `transferB`, and +`stepNormal`. -/ +def stepEntry (q : ℕ) (dir : Bool) (l r : List Run) : Option (ℕ × EntryCfg) := + if !dir && Nat.beq q 3 then + match l with + | ⟨s0, c0⟩ :: ⟨s1, a⟩ :: tail => + let zOk := match tail with | [] => true | ⟨zSym, _⟩ :: _ => Nat.beq zSym 0 || Nat.beq zSym 2 + if Nat.beq s0 0 && Nat.beq c0 1 && Nat.beq s1 1 && Nat.ble 2 a && zOk then + match transferRightCount 2 r with + | some b => + let k := a / 2 + let rem := a - 2 * k + let lBase := if Nat.beq rem 0 then tail else withNat rem fun rm ↦ Run.mk 1 rm :: tail + withNat (b + 3 * k) fun rb ↦ + withNat (4 * k * b + 6 * k * k + 12 * k) fun dt ↦ + some (dt, EntryCfg.mk 3 false (pushLit 0 1 lBase) [Run.mk 2 rb]) + | none => stepNormal 3 false (Run.mk s0 c0 :: Run.mk s1 a :: tail) r + else stepNormal 3 false (Run.mk s0 c0 :: Run.mk s1 a :: tail) r + | l' => stepNormal 3 false l' r + else if dir && Nat.beq q 1 then + match l with + | ⟨s0, c0⟩ :: ⟨s1, c1⟩ :: ⟨s2, a⟩ :: tail => + let zOk := match tail with | [] => true | ⟨zSym, _⟩ :: _ => Nat.beq zSym 0 + if Nat.beq s0 2 && Nat.beq c0 1 && Nat.beq s1 0 && Nat.beq c1 1 && Nat.beq s2 2 && + Nat.ble 2 a && zOk then + match transferRightCount 1 r with + | some b => + let k := a / 2 + let rem := a - 2 * k + let lBase := if Nat.beq rem 0 then tail else withNat rem fun rm ↦ Run.mk 2 rm :: tail + withNat (b + 3 * k) fun rb ↦ + withNat (4 * k * b + 6 * k * k + 12 * k) fun dt ↦ + some (dt, EntryCfg.mk 1 true (pushLit 2 1 (pushLit 0 1 lBase)) [Run.mk 1 rb]) + | none => stepNormal 1 true (Run.mk s0 c0 :: Run.mk s1 c1 :: Run.mk s2 a :: tail) r + else stepNormal 1 true (Run.mk s0 c0 :: Run.mk s1 c1 :: Run.mk s2 a :: tail) r + | l' => stepNormal 1 true l' r + else stepNormal q dir l r + +/-- Soundness of `stepEntry`. -/ +theorem stepEntry_sound : StepFnSound a6Target qOf baseWord stepEntry := by + intro q dir l r dt c' hst + unfold stepEntry at hst + by_cases hcD : (!dir && Nat.beq q 3) = true + · simp only [hcD, ↓reduceIte] at hst + simp only [Bool.and_eq_true, Bool.not_eq_true'] at hcD + have hd0 : dir = false := hcD.1 + have hq3 : q = 3 := Nat.eq_of_beq_eq_true hcD.2 + subst hd0; subst hq3 + rcases l with _ | ⟨⟨s0, c0⟩, _ | ⟨⟨s1, a⟩, tail⟩⟩ + · exact stepNormal_sound 3 false [] r dt c' hst + · exact stepNormal_sound 3 false [⟨s0, c0⟩] r dt c' hst + · simp only at hst + set zOk := match tail with | [] => true | ⟨zSym, _⟩ :: _ => Nat.beq zSym 0 || Nat.beq zSym 2 + by_cases hcond : (Nat.beq s0 0 && Nat.beq c0 1 && Nat.beq s1 1 && Nat.ble 2 a && zOk) = true + · simp only [hcond, ↓reduceIte] at hst + simp only [Bool.and_eq_true] at hcond + have hs0 : s0 = 0 := Nat.eq_of_beq_eq_true hcond.1.1.1.1 + have hc0 : c0 = 1 := Nat.eq_of_beq_eq_true hcond.1.1.1.2 + have hs1 : s1 = 1 := Nat.eq_of_beq_eq_true hcond.1.1.2 + have ha2 : 2 ≤ a := Nat.le_of_ble_eq_true hcond.1.2 + subst hs0; subst hc0; subst hs1 + rcases htr : transferRightCount 2 r with _ | b + · rw [htr] at hst + exact stepNormal_sound 3 false _ r dt c' hst + · rw [htr] at hst + simp only [withNat_eq, Option.some.injEq, Prod.mk.injEq] at hst + rcases hst with ⟨rfl, rfl⟩ + set k := a / 2 + set rem := a - 2 * k + set lBase := if Nat.beq rem 0 then tail else Run.mk 1 rem :: tail + have hlBase : evalSide false baseWord lBase = + ListBlank.append (([1, 0] : List (Fin 2)) ^ rem) + (evalSide false baseWord tail) := by + dsimp only [lBase] + by_cases hr0 : Nat.beq rem 0 = true + · have h0 := Nat.eq_of_beq_eq_true hr0 + simp [h0] + · have hnr0 := Bool.eq_false_iff.mpr hr0 + simp [hnr0, evalSide, baseWord] + have haSplit : a = 2 * k + rem := by omega + have hrun := transferD_batch k b (evalSide false baseWord lBase) + have hrEq := transferRightCount_eval htr + simpa [evalEntryCfg, dirCfg, qOf, evalSide, baseWord, hrEq, + evalSide_pushLit baseWord_zero_blank, hlBase, haSplit, list_pow_add, + ListBlank.append_assoc] using hrun + · have hncond := Bool.eq_false_iff.mpr hcond + rw [hncond] at hst + exact stepNormal_sound 3 false _ r dt c' hst + · have hncD := Bool.eq_false_iff.mpr hcD + simp only [hncD, Bool.false_eq_true, ↓reduceIte] at hst + by_cases hcB : (dir && Nat.beq q 1) = true + · simp only [hcB, ↓reduceIte] at hst + simp only [Bool.and_eq_true] at hcB + have hd1 : dir = true := hcB.1 + have hq1 : q = 1 := Nat.eq_of_beq_eq_true hcB.2 + subst hd1; subst hq1 + rcases l with _ | ⟨⟨s0, c0⟩, _ | ⟨⟨s1, c1⟩, _ | ⟨⟨s2, a⟩, tail⟩⟩⟩ + · exact stepNormal_sound 1 true [] r dt c' hst + · exact stepNormal_sound 1 true [⟨s0, c0⟩] r dt c' hst + · exact stepNormal_sound 1 true [⟨s0, c0⟩, ⟨s1, c1⟩] r dt c' hst + · simp only at hst + set zOk := match tail with | [] => true | ⟨zSym, _⟩ :: _ => Nat.beq zSym 0 + by_cases hcond : (Nat.beq s0 2 && Nat.beq c0 1 && Nat.beq s1 0 && Nat.beq c1 1 && + Nat.beq s2 2 && Nat.ble 2 a && zOk) = true + · simp only [hcond, ↓reduceIte] at hst + simp only [Bool.and_eq_true] at hcond + have hs0 : s0 = 2 := Nat.eq_of_beq_eq_true hcond.1.1.1.1.1.1 + have hc0 : c0 = 1 := Nat.eq_of_beq_eq_true hcond.1.1.1.1.1.2 + have hs1 : s1 = 0 := Nat.eq_of_beq_eq_true hcond.1.1.1.1.2 + have hc1 : c1 = 1 := Nat.eq_of_beq_eq_true hcond.1.1.1.2 + have hs2 : s2 = 2 := Nat.eq_of_beq_eq_true hcond.1.1.2 + have ha2 : 2 ≤ a := Nat.le_of_ble_eq_true hcond.1.2 + subst hs0; subst hc0; subst hs1; subst hc1; subst hs2 + rcases htr : transferRightCount 1 r with _ | b + · rw [htr] at hst + exact stepNormal_sound 1 true _ r dt c' hst + · rw [htr] at hst + simp only [withNat_eq, Option.some.injEq, Prod.mk.injEq] at hst + rcases hst with ⟨rfl, rfl⟩ + set k := a / 2 + set rem := a - 2 * k + set lBase := if Nat.beq rem 0 then tail else Run.mk 2 rem :: tail + have hlBase : evalSide false baseWord lBase = + ListBlank.append (([0, 1] : List (Fin 2)) ^ rem) + (evalSide false baseWord tail) := by + dsimp only [lBase] + by_cases hr0 : Nat.beq rem 0 = true + · have h0 := Nat.eq_of_beq_eq_true hr0 + simp [h0] + · have hnr0 := Bool.eq_false_iff.mpr hr0 + simp [hnr0, evalSide, baseWord] + have haSplit : a = 2 * k + rem := by omega + have hrun := transferB_batch k b (evalSide false baseWord lBase) + have hrEq := transferRightCount_eval htr + simpa [evalEntryCfg, dirCfg, qOf, evalSide, baseWord, hrEq, + evalSide_pushLit baseWord_zero_blank, hlBase, haSplit, list_pow_add, + ListBlank.append_assoc] using hrun + · have hncond := Bool.eq_false_iff.mpr hcond + rw [hncond] at hst + exact stepNormal_sound 1 true _ r dt c' hst + · have hncB := Bool.eq_false_iff.mpr hcB + simp only [hncB, Bool.false_eq_true, ↓reduceIte] at hst + exact stepNormal_sound q dir l r dt c' hst + +/-! ## Closed-Form Milestone Configurations `C(m)` and Symbolic Family Specification -/ + +/-- Fixed outer prefix `U` of the `C(m)` family. -/ +def uRuns : List (ℕ × ℕ) := + [(2, 1), (1, 1), (0, 1), (2, 8), (0, 1), (2, 5), (1, 11), (0, 1)] + +/-- Growing outer block `P = X^8 Y^10 Z`. -/ +def pRuns : List (ℕ × ℕ) := + [(2, 8), (1, 10), (0, 1)] + +/-- Fixed middle separator `V(N)` with `N = 791761176`. -/ +def vRuns : List (ℕ × ℕ) := + [(2, 791761176), (1, 9), (0, 1), (2, 21), (1, 41), (0, 1), (2, 15), (1, 93), (0, 1)] + +/-- Growing inner block `Q = X^36 Y^17 Z X^91 Y^38 Z X^15 Y^93 Z`. -/ +def qRuns : List (ℕ × ℕ) := + [(2, 36), (1, 17), (0, 1), (2, 91), (1, 38), (0, 1), (2, 15), (1, 93), (0, 1)] + +/-- Fixed head-adjacent suffix `W = X^14 Z X^5 Z X`. -/ +def wRuns : List (ℕ × ℕ) := + [(2, 14), (0, 1), (2, 5), (0, 1), (2, 1)] + +/-- Repeat a run list `n` times. -/ +def repRuns : ℕ → List (ℕ × ℕ) → List (ℕ × ℕ) + | 0, _ => [] + | n + 1, xs => xs ++ repRuns n xs + +/-- Expand a `(sym, count)` run list into a flat list of 2-bit base-word indices. -/ +def expandRunWords : List (ℕ × ℕ) → List ℕ + | [] => [] + | (s, n) :: rest => List.replicate n s ++ expandRunWords rest + +/-- Base-word sequence of block `P` (`19` two-bit words). -/ +def pWord : List ℕ := expandRunWords pRuns + +/-- Base-word sequence of block `Q` (`293` two-bit words). -/ +def qWord : List ℕ := expandRunWords qRuns + +/-- Closed-form Entry milestone configuration `C(m)` for concrete `m : ℕ`. -/ +def entryMilestone (m : ℕ) : EntryCfg := + ⟨1, true, + pushRunsLeft (uRuns ++ repRuns m pRuns ++ vRuns ++ repRuns m qRuns ++ wRuns) [], + [⟨1, 6⟩]⟩ + +/-- Symbolic initial configuration `C(k + 8)` (`wid = 4` is `P`, `wid = 5` is `Q`). -/ +def initReturnCfg : AffCfg := + let s₀ : List AffRun := [] + let s₁ := pushAffConstRuns uRuns s₀ + let s₂ := match pushAff 4 ⟨1, 8⟩ s₁ with | some s => s | none => s₁ + let s₃ := pushAffConstRuns vRuns s₂ + let s₄ := match pushAff 5 ⟨1, 8⟩ s₃ with | some s => s | none => s₃ + let s₅ := pushAffConstRuns wRuns s₄ + ⟨1, true, s₅, [⟨1, ⟨0, 6⟩⟩]⟩ + +/-- Exact affine return step count `119808 * k + 304037417082` +(`= 304036458618 + 119808 * (k + 8)`). -/ +def returnTarget : AffNat := + ⟨119808, 304037417082⟩ + +end BusyBeaver.BB6.A6 + +end diff --git a/BusyBeaver/BB6/A6/Entry0.lean b/BusyBeaver/BB6/A6/Entry0.lean new file mode 100644 index 00000000..0ea40875 --- /dev/null +++ b/BusyBeaver/BB6/A6/Entry0.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.BB6.A6.Defs +meta import BusyBeaver.WordRLE +meta import BusyBeaver.ElabRLE +meta import BusyBeaver.BB6.A6.Defs + +/-! +# Entry Phase 0 for BB6 `A6`: Blank Tape to `C(0)` +-/ + +@[expose] public section + +namespace BusyBeaver.BB6.A6 + +open BusyBeaver.WordRLE + +local elab "prove_entry0%" : term => + ElabRLE.proveEntryPhase stepEntry (Lean.mkConst ``stepEntry) + 26923 1500 752263008230408399 ⟨0, false, [], []⟩ (entryMilestone 0) + none (some (Lean.mkApp (Lean.mkConst ``entryMilestone) (Lean.toExpr (0 : ℕ)))) + +/-- Kernel-verified RLE derivation from the blank tape to `C(0)` in `752,263,008,230,408,399` +steps (`26,923` accelerated RLE steps). -/ +theorem entry_phase0 : + EntryReaches stepEntry 752263008230408399 ⟨0, false, [], []⟩ (entryMilestone 0) := + prove_entry0% + +end BusyBeaver.BB6.A6 + +end diff --git a/BusyBeaver/BB6/A6/Entry1.lean b/BusyBeaver/BB6/A6/Entry1.lean new file mode 100644 index 00000000..83845c92 --- /dev/null +++ b/BusyBeaver/BB6/A6/Entry1.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.BB6.A6.Defs +meta import BusyBeaver.WordRLE +meta import BusyBeaver.ElabRLE +meta import BusyBeaver.BB6.A6.Defs + +/-! +# Entry Phase 1 for BB6 `A6`: `C(0)` to `C(3)` +-/ + +@[expose] public section + +namespace BusyBeaver.BB6.A6 + +open BusyBeaver.WordRLE + +local elab "prove_entry1%" : term => + ElabRLE.proveEntryPhase stepEntry (Lean.mkConst ``stepEntry) + 29298 1500 912109735278 (entryMilestone 0) (entryMilestone 3) + (some (Lean.mkApp (Lean.mkConst ``entryMilestone) (Lean.toExpr (0 : ℕ)))) + (some (Lean.mkApp (Lean.mkConst ``entryMilestone) (Lean.toExpr (3 : ℕ)))) + +/-- Kernel-verified RLE derivation from `C(0)` to `C(3)` in `912,109,735,278` steps +(`29,298` accelerated RLE steps). -/ +theorem entry_phase1 : + EntryReaches stepEntry 912109735278 (entryMilestone 0) (entryMilestone 3) := + prove_entry1% + +end BusyBeaver.BB6.A6 + +end diff --git a/BusyBeaver/BB6/A6/Entry2.lean b/BusyBeaver/BB6/A6/Entry2.lean new file mode 100644 index 00000000..ad55c299 --- /dev/null +++ b/BusyBeaver/BB6/A6/Entry2.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.BB6.A6.Defs +meta import BusyBeaver.WordRLE +meta import BusyBeaver.ElabRLE +meta import BusyBeaver.BB6.A6.Defs + +/-! +# Entry Phase 2 for BB6 `A6`: `C(3)` to `C(5)` +-/ + +@[expose] public section + +namespace BusyBeaver.BB6.A6 + +open BusyBeaver.WordRLE + +local elab "prove_entry2%" : term => + ElabRLE.proveEntryPhase stepEntry (Lean.mkConst ``stepEntry) + 34892 1500 608073755892 (entryMilestone 3) (entryMilestone 5) + (some (Lean.mkApp (Lean.mkConst ``entryMilestone) (Lean.toExpr (3 : ℕ)))) + (some (Lean.mkApp (Lean.mkConst ``entryMilestone) (Lean.toExpr (5 : ℕ)))) + +/-- Kernel-verified RLE derivation from `C(3)` to `C(5)` in `608,073,755,892` steps +(`34,892` accelerated RLE steps). -/ +theorem entry_phase2 : + EntryReaches stepEntry 608073755892 (entryMilestone 3) (entryMilestone 5) := + prove_entry2% + +end BusyBeaver.BB6.A6 + +end diff --git a/BusyBeaver/BB6/A6/Entry3.lean b/BusyBeaver/BB6/A6/Entry3.lean new file mode 100644 index 00000000..af47672f --- /dev/null +++ b/BusyBeaver/BB6/A6/Entry3.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.BB6.A6.Defs +meta import BusyBeaver.WordRLE +meta import BusyBeaver.ElabRLE +meta import BusyBeaver.BB6.A6.Defs + +/-! +# Entry Phase 3 for BB6 `A6`: `C(5)` to `C(6)` +-/ + +@[expose] public section + +namespace BusyBeaver.BB6.A6 + +open BusyBeaver.WordRLE + +local elab "prove_entry3%" : term => + ElabRLE.proveEntryPhase stepEntry (Lean.mkConst ``stepEntry) + 22054 1500 304037057658 (entryMilestone 5) (entryMilestone 6) + (some (Lean.mkApp (Lean.mkConst ``entryMilestone) (Lean.toExpr (5 : ℕ)))) + (some (Lean.mkApp (Lean.mkConst ``entryMilestone) (Lean.toExpr (6 : ℕ)))) + +/-- Kernel-verified RLE derivation from `C(5)` to `C(6)` in `304,037,057,658` steps +(`22,054` accelerated RLE steps). -/ +theorem entry_phase3 : + EntryReaches stepEntry 304037057658 (entryMilestone 5) (entryMilestone 6) := + prove_entry3% + +end BusyBeaver.BB6.A6 + +end diff --git a/BusyBeaver/BB6/A6/Entry4.lean b/BusyBeaver/BB6/A6/Entry4.lean new file mode 100644 index 00000000..7029058f --- /dev/null +++ b/BusyBeaver/BB6/A6/Entry4.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.BB6.A6.Defs +meta import BusyBeaver.WordRLE +meta import BusyBeaver.ElabRLE +meta import BusyBeaver.BB6.A6.Defs + +/-! +# Entry Phase 4 for BB6 `A6`: `C(6)` to `C(7)` +-/ + +@[expose] public section + +namespace BusyBeaver.BB6.A6 + +open BusyBeaver.WordRLE + +local elab "prove_entry4%" : term => + ElabRLE.proveEntryPhase stepEntry (Lean.mkConst ``stepEntry) + 25126 1500 304037177466 (entryMilestone 6) (entryMilestone 7) + (some (Lean.mkApp (Lean.mkConst ``entryMilestone) (Lean.toExpr (6 : ℕ)))) + (some (Lean.mkApp (Lean.mkConst ``entryMilestone) (Lean.toExpr (7 : ℕ)))) + +/-- Kernel-verified RLE derivation from `C(6)` to `C(7)` in `304,037,177,466` steps +(`25,126` accelerated RLE steps). -/ +theorem entry_phase4 : + EntryReaches stepEntry 304037177466 (entryMilestone 6) (entryMilestone 7) := + prove_entry4% + +end BusyBeaver.BB6.A6 + +end diff --git a/BusyBeaver/BB6/A6/Entry5.lean b/BusyBeaver/BB6/A6/Entry5.lean new file mode 100644 index 00000000..22ccdf11 --- /dev/null +++ b/BusyBeaver/BB6/A6/Entry5.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.BB6.A6.Defs +meta import BusyBeaver.WordRLE +meta import BusyBeaver.ElabRLE +meta import BusyBeaver.BB6.A6.Defs + +/-! +# Entry Phase 5 for BB6 `A6`: `C(7)` to `C(8)` +-/ + +@[expose] public section + +namespace BusyBeaver.BB6.A6 + +open BusyBeaver.WordRLE + +local elab "prove_entry5%" : term => + ElabRLE.proveEntryPhase stepEntry (Lean.mkConst ``stepEntry) + 28198 1500 304037297274 (entryMilestone 7) (entryMilestone 8) + (some (Lean.mkApp (Lean.mkConst ``entryMilestone) (Lean.toExpr (7 : ℕ)))) + (some (Lean.mkApp (Lean.mkConst ``entryMilestone) (Lean.toExpr (8 : ℕ)))) + +/-- Kernel-verified RLE derivation from `C(7)` to `C(8)` in `304,037,297,274` steps +(`28,198` accelerated RLE steps). -/ +theorem entry_phase5 : + EntryReaches stepEntry 304037297274 (entryMilestone 7) (entryMilestone 8) := + prove_entry5% + +end BusyBeaver.BB6.A6 + +end diff --git a/BusyBeaver/BB6/A6/ReturnExits.lean b/BusyBeaver/BB6/A6/ReturnExits.lean new file mode 100644 index 00000000..0d6a4531 --- /dev/null +++ b/BusyBeaver/BB6/A6/ReturnExits.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.BB6.A6.Cert +meta import BusyBeaver.WordRLE +meta import BusyBeaver.AffRLE +meta import BusyBeaver.ElabRLE +meta import BusyBeaver.BB6.A6.Defs +meta import BusyBeaver.BB6.A6.Cert + +/-! +# Composite Word-Exit Verification for BB6 `A6` + +Verifies all 462 composite word exits in `a6Exits` against `WordRLE.runCompositeExit` via +depth-sliced `mkAuxTheorem` kernel evaluation. +-/ + +@[expose] public section + +namespace BusyBeaver.BB6.A6 + +open BusyBeaver.WordRLE BusyBeaver.AffRLE + +/-- Composite word `0` in `a6Vocab` consists exclusively of blank base words. -/ +theorem a6_vocab_blank0 : checkVocabBlank0 a6Vocab = true := by + decide + +local elab "prove_a6_exits%" : term => do + let pE := Lean.mkApp3 (Lean.mkConst ``checkExitEntry) + (Lean.toExpr (6 : ℕ)) (Lean.mkConst ``fastExit2) (Lean.mkConst ``a6Vocab) + ElabRLE.proveCheckAll pE a6Exits 5 + +/-- Kernel-verified composite exit certificate for all 462 entries of `a6Exits`. -/ +theorem a6_exits_ok : + NatTrie.checkAll (checkExitEntry 6 fastExit2 a6Vocab) 0 1 a6Exits = true := + prove_a6_exits% + +end BusyBeaver.BB6.A6 + +end diff --git a/BusyBeaver/BB6/A6/ReturnReplay.lean b/BusyBeaver/BB6/A6/ReturnReplay.lean new file mode 100644 index 00000000..ff725afd --- /dev/null +++ b/BusyBeaver/BB6/A6/ReturnReplay.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.BB6.A6.Cert +meta import BusyBeaver.WordRLE +meta import BusyBeaver.AffRLE +meta import BusyBeaver.ElabRLE +meta import BusyBeaver.BB6.A6.Defs +meta import BusyBeaver.BB6.A6.Cert + +/-! +# Symbolic Affine Certificate Replay for BB6 `A6` + +Verifies the 202-operation `BTree AffOp` symbolic trace (`9,844` affine sweeps and `67` inner +countdown cycles) from `initReturnCfg` to `a6FinalCfg` via depth-sliced `mkAuxTheorem` kernel +evaluation. +-/ + +@[expose] public section + +namespace BusyBeaver.BB6.A6 + +open BusyBeaver.AffRLE + +local elab "prove_a6_replay%" : term => + ElabRLE.proveAffReplay 6 a6Exits (Lean.mkConst ``a6Exits) + returnTarget (Lean.mkConst ``returnTarget) a6Ops initReturnCfg a6FinalCfg 4 + +/-- Kernel-verified symbolic affine derivation of `a6Ops` from `initReturnCfg` to `a6FinalCfg`. -/ +theorem a6_replay_ok : + AffReplayReaches 6 a6Exits returnTarget a6Ops ⟨0, 0⟩ initReturnCfg returnTarget a6FinalCfg := + prove_a6_replay% + +end BusyBeaver.BB6.A6 + +end diff --git a/BusyBeaver/BB6/M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean b/BusyBeaver/BB6/M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean new file mode 100644 index 00000000..ac2171f7 --- /dev/null +++ b/BusyBeaver/BB6/M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean @@ -0,0 +1,396 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Bridge +public import BusyBeaver.BB6.A6.Entry0 +public import BusyBeaver.BB6.A6.Entry1 +public import BusyBeaver.BB6.A6.Entry2 +public import BusyBeaver.BB6.A6.Entry3 +public import BusyBeaver.BB6.A6.Entry4 +public import BusyBeaver.BB6.A6.Entry5 +public import BusyBeaver.BB6.A6.ReturnExits +public import BusyBeaver.BB6.A6.ReturnReplay + +/-! +# Non-Halting of `1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LB---` (`A6`) + +Combines the six kernel-verified Entry milestone phases (`init [] ⊢* C(8)` in +`752,265,440,525,431,967` steps) with the symbolic affine Return certificate (`C(k + 8) ⊢⁺ C(k + 9)` +in `304,037,417,082 + 119,808 * k` steps for every `k : ℕ`) to establish `IsNotHalt target` and +`¬ ConjectureMachines.Halts machine`. +-/ + +@[expose] public section + +namespace BusyBeaver.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH + +/-- The six-state `A6` machine loaded via Cryptids' shared RLE parser. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LB---" + +/-- Canonical `BusyBeaver.Machine` representation of `A6`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := machine.toBB + +end BusyBeaver.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH + +namespace BusyBeaver.BB6.A6 + +open Turing +open BusyBeaver.WordRLE BusyBeaver.AffRLE + +/-! ## Canonical Configuration Family and Stack Flattening Helpers -/ + +/-- Composite word lookup for `A6`'s synthesized 414-word vocabulary. -/ +def wOf : ℕ → List (Fin 2) := + vocabWord baseWord a6Vocab + +/-- Canonical symbolic configuration family `familyCfg k = C(k + 8)`. -/ +def familyCfg (k : ℕ) : Cfg (Fin 2) (Fin 6) := + evalAffCfg qOf wOf k initReturnCfg + +private def repList (n : ℕ) (xs : List α) : List α := + match n with + | 0 => [] + | n + 1 => xs ++ repList n xs + +private def flatLeftRuns (wordOf : ℕ → List (Fin 2)) : List Run → List (Fin 2) + | [] => [] + | ⟨w, c⟩ :: rest => (wordOf w).reverse ^ c ++ flatLeftRuns wordOf rest + +private theorem evalSide_false_eq_flat (wordOf : ℕ → List (Fin 2)) (xs : List Run) : + evalSide false wordOf xs = ListBlank.append (flatLeftRuns wordOf xs) default := by + induction xs with + | nil => rfl + | cons r xs ih => + rcases r with ⟨w, c⟩ + simp [evalSide, flatLeftRuns, ih, ListBlank.append_assoc] + +private theorem flatLeftRuns_append (wordOf : ℕ → List (Fin 2)) (xs ys : List Run) : + flatLeftRuns wordOf (xs ++ ys) = flatLeftRuns wordOf xs ++ flatLeftRuns wordOf ys := by + induction xs with + | nil => rfl + | cons r xs ih => simp [flatLeftRuns, ih, List.append_assoc] + +private theorem flatLeftRuns_repList (wordOf : ℕ → List (Fin 2)) (n : ℕ) (xs : List Run) : + flatLeftRuns wordOf (repList n xs) = (flatLeftRuns wordOf xs) ^ n := by + induction n with + | zero => rfl + | succ n ih => rw [repList, flatLeftRuns_append, ih, ← list_pow_succ] + +private def flatAffLeft (wordOf : ℕ → List (Fin 2)) (k : ℕ) : List AffRun → List (Fin 2) + | [] => [] + | ⟨w, c⟩ :: rest => (wordOf w).reverse ^ c.eval k ++ flatAffLeft wordOf k rest + +private theorem evalAffSide_false_eq_flat (wordOf : ℕ → List (Fin 2)) (k : ℕ) (xs : List AffRun) : + evalAffSide false wordOf k xs = ListBlank.append (flatAffLeft wordOf k xs) default := by + induction xs with + | nil => rfl + | cons r xs ih => + rcases r with ⟨w, c⟩ + simp [evalAffSide, flatAffLeft, ih, ListBlank.append_assoc] + +private theorem flatAffLeft_append (wordOf : ℕ → List (Fin 2)) (k : ℕ) (xs ys : List AffRun) : + flatAffLeft wordOf k (xs ++ ys) = + flatAffLeft wordOf k xs ++ flatAffLeft wordOf k ys := by + induction xs with + | nil => rfl + | cons r xs ih => simp [flatAffLeft, ih, List.append_assoc] + +private theorem flatAffLeft_const (wordOf : ℕ → List (Fin 2)) (k : ℕ) : + ∀ {xs : List AffRun}, xs.all (fun r ↦ Nat.beq r.count.a 0) = true → + flatAffLeft wordOf k xs = flatAffLeft wordOf 0 xs + | [], _ => rfl + | ⟨w, ⟨a, b⟩⟩ :: xs, h => by + simp only [List.all_cons, Bool.and_eq_true] at h + have ha : a = 0 := Nat.eq_of_beq_eq_true h.1 + subst ha + simp [flatAffLeft, AffNat.eval, flatAffLeft_const wordOf k h.2] + +/-! ## Part 1: Entry Derivation from Blank Tape to `C(8)` -/ + +private theorem evalEntryCfg_start : + evalEntryCfg qOf baseWord ⟨0, false, [], []⟩ = init [] := by + simpa [evalEntryCfg, dirCfg, evalSide, qOf] using + (init_nil_eq_headLeft (Γ := Fin 2) (Λ := Fin 6)).symm + +/-- Exact Entry derivation from the blank tape `init []` to `C(8)` in +`752,265,440,525,431,967` steps. -/ +theorem entry_to_c8 : + ReachesStar a6Target (init []) (evalEntryCfg qOf baseWord (entryMilestone 8)) := by + have hchain : EntryReaches stepEntry 752265440525431967 ⟨0, false, [], []⟩ (entryMilestone 8) := + EntryReaches.cast_dt + (entry_phase0.trans (entry_phase1.trans (entry_phase2.trans + (entry_phase3.trans (entry_phase4.trans entry_phase5))))) + (by decide +kernel) + have hsound := hchain.sound stepEntry_sound + rw [evalEntryCfg_start] at hsound + exact hsound.to_star + +/-! ## Part 2: Bridge Equality `evalEntryCfg ... (entryMilestone 8) = familyCfg 0` -/ + +private def wRunsRev : List Run := pushRunsLeft wRuns [] +private def qRunsRev : List Run := pushRunsLeft qRuns [] +private def vTailRunsRev : List Run := (pushRunsLeft vRuns []).take 8 +private def pRunsRev : List Run := pushRunsLeft pRuns [] +private def uRunsRev : List Run := pushRunsLeft uRuns [] + +private theorem entry8_left_decomp : + (entryMilestone 8).left = + wRunsRev ++ repList 8 qRunsRev ++ vTailRunsRev ++ + [Run.mk 2 791761176] ++ repList 8 pRunsRev ++ uRunsRev := by + exact eq_of_beq (by decide +kernel) + +private theorem init_left_decomp : + initReturnCfg.left = + initReturnCfg.left.take 5 ++ + [AffRun.mk 5 ⟨1, 8⟩] ++ + (initReturnCfg.left.drop 6).take 8 ++ + [AffRun.mk 2 ⟨0, 791761176⟩] ++ + [AffRun.mk 4 ⟨1, 8⟩] ++ + initReturnCfg.left.drop 16 := by + exact eq_of_beq (by decide +kernel) + +private theorem bridge1_w : + flatLeftRuns baseWord wRunsRev = flatAffLeft wOf 0 (initReturnCfg.left.take 5) := by + exact eq_of_beq (by decide +kernel) + +private theorem bridge1_q : + flatLeftRuns baseWord qRunsRev = (wOf 5).reverse := by + exact eq_of_beq (by decide +kernel) + +private theorem bridge1_v : + flatLeftRuns baseWord vTailRunsRev = + flatAffLeft wOf 0 ((initReturnCfg.left.drop 6).take 8) := by + exact eq_of_beq (by decide +kernel) + +private theorem bridge1_x : wOf 2 = baseWord 2 := by + exact eq_of_beq (by decide +kernel) + +private theorem bridge1_p : + flatLeftRuns baseWord pRunsRev = (wOf 4).reverse := by + exact eq_of_beq (by decide +kernel) + +private theorem bridge1_u : + flatLeftRuns baseWord uRunsRev = flatAffLeft wOf 0 (initReturnCfg.left.drop 16) := by + exact eq_of_beq (by decide +kernel) + +private theorem bridge1_y : wOf 1 = baseWord 1 := by + exact eq_of_beq (by decide +kernel) + +/-- The Entry milestone configuration `C(8)` is identical to `familyCfg 0`. -/ +theorem entryMilestone_eight_eq : + evalEntryCfg qOf baseWord (entryMilestone 8) = familyCfg 0 := by + have heq : (entryMilestone 8).q = 1 := rfl + have hed : (entryMilestone 8).dir = true := rfl + have her : (entryMilestone 8).right = [⟨1, 6⟩] := rfl + have hiq : initReturnCfg.q = 1 := eq_of_beq (by decide +kernel) + have hid : initReturnCfg.dir = true := eq_of_beq (by decide +kernel) + have hir : initReturnCfg.right = [⟨1, ⟨0, 6⟩⟩] := eq_of_beq (by decide +kernel) + unfold evalEntryCfg familyCfg evalAffCfg + rw [heq, hed, her, hiq, hid, hir] + refine congr (congrArg (dirCfg qOf 1 true) ?_) ?_ + · rw [evalSide_false_eq_flat, evalAffSide_false_eq_flat] + refine congrArg (ListBlank.append · default) ?_ + rw [entry8_left_decomp, init_left_decomp] + simp only [flatLeftRuns_append, flatAffLeft_append, flatLeftRuns_repList] + have hq0 : flatAffLeft wOf 0 [AffRun.mk 5 ⟨1, 8⟩] = (wOf 5).reverse ^ 8 := by + simp [flatAffLeft, AffNat.eval] + have hx0 : flatLeftRuns baseWord [Run.mk 2 791761176] = + flatAffLeft wOf 0 [AffRun.mk 2 ⟨0, 791761176⟩] := by + simp [flatLeftRuns, flatAffLeft, AffNat.eval, bridge1_x] + have hp0 : flatAffLeft wOf 0 [AffRun.mk 4 ⟨1, 8⟩] = (wOf 4).reverse ^ 8 := by + simp [flatAffLeft, AffNat.eval] + rw [bridge1_w, bridge1_q, hq0, bridge1_v, hx0, bridge1_p, hp0, bridge1_u] + · simp [evalSide, evalAffSide, AffNat.eval, bridge1_y] + +/-! ## Part 3: Bridge Equality `evalAffCfg ... k a6FinalCfg = familyCfg (k + 1)` -/ + +private def finalPre : List AffRun := a6FinalCfg.left.take 5 +private def finalQBRuns : List AffRun := (a6FinalCfg.left.drop 5).take 9 +private def finalQChunk : List AffRun := + finalQBRuns ++ [AffRun.mk 413 ⟨1, 8⟩, AffRun.mk 2 ⟨0, 32⟩] +private def finalMid : List AffRun := (a6FinalCfg.left.drop 16).take 8 +private def finalPTail : List AffRun := (a6FinalCfg.left.drop 28).take 8 +private def finalXPChunk : List AffRun := + [AffRun.mk 2 ⟨0, 791761144⟩, AffRun.mk 241 ⟨0, 1⟩, + AffRun.mk 410 ⟨0, 1⟩, AffRun.mk 294 ⟨1, 6⟩] ++ finalPTail +private def finalSuf : List AffRun := a6FinalCfg.left.drop 36 + +private theorem final_left_decomp : + a6FinalCfg.left = + finalPre ++ finalQChunk ++ finalMid ++ finalXPChunk ++ finalSuf := by + exact eq_of_beq (by decide +kernel) + +private theorem const_pre_eq : finalPre = initReturnCfg.left.take 5 := + eq_of_beq (by decide +kernel) +private theorem const_pre_ok : finalPre.all (fun r ↦ Nat.beq r.count.a 0) = true := by + decide +kernel +private theorem const_mid_eq : finalMid = (initReturnCfg.left.drop 6).take 8 := + eq_of_beq (by decide +kernel) +private theorem const_mid_ok : finalMid.all (fun r ↦ Nat.beq r.count.a 0) = true := by + decide +kernel +private theorem const_suf_eq : finalSuf = initReturnCfg.left.drop 16 := + eq_of_beq (by decide +kernel) +private theorem const_suf_ok : finalSuf.all (fun r ↦ Nat.beq r.count.a 0) = true := by + decide +kernel +private theorem const_qb_ok : finalQBRuns.all (fun r ↦ Nat.beq r.count.a 0) = true := by + decide +kernel +private theorem const_pt_ok : finalPTail.all (fun r ↦ Nat.beq r.count.a 0) = true := by + decide +kernel + +private def qARev : List (Fin 2) := (wOf 2).reverse ^ 32 +private def qBRev : List (Fin 2) := flatAffLeft wOf 0 finalQBRuns + +private theorem q_word_413 : (wOf 413).reverse = qARev ++ qBRev := by + exact eq_of_beq (by decide +kernel) + +private theorem q_word_5 : (wOf 5).reverse = qBRev ++ qARev := by + exact eq_of_beq (by decide +kernel) + +private theorem final_q_chunk_eq (k : ℕ) : + flatAffLeft wOf k finalQChunk = + flatAffLeft wOf (k + 1) [AffRun.mk 5 ⟨1, 8⟩] := by + unfold finalQChunk + rw [flatAffLeft_append, flatAffLeft_const wOf k const_qb_ok] + change qBRev ++ ((wOf 413).reverse ^ (AffNat.mk 1 8).eval k ++ + ((wOf 2).reverse ^ (AffNat.mk 0 32).eval k ++ [])) = + (wOf 5).reverse ^ (AffNat.mk 1 8).eval (k + 1) ++ [] + have hk1 : (AffNat.mk 1 8).eval k = k + 8 := by simp [AffNat.eval] + have hk2 : (AffNat.mk 0 32).eval k = 32 := by simp [AffNat.eval] + have hk3 : (AffNat.mk 1 8).eval (k + 1) = (k + 8) + 1 := by dsimp [AffNat.eval]; omega + rw [hk1, hk2, hk3, List.append_nil, List.append_nil] + change qBRev ++ ((wOf 413).reverse ^ (k + 8) ++ qARev) = (wOf 5).reverse ^ ((k + 8) + 1) + rw [q_word_413, q_word_5, lpow_rot qARev qBRev (k + 8), ← List.append_assoc, ← list_pow_succ] + +private def pBRev : List (Fin 2) := (wOf 0).reverse ++ (wOf 1).reverse ^ 5 +private def pARev : List (Fin 2) := (wOf 1).reverse ^ 5 ++ (wOf 2).reverse ^ 8 + +private theorem p_word_241 : (wOf 241).reverse = (wOf 2).reverse ^ 19 := by + exact eq_of_beq (by decide +kernel) + +private theorem p_word_410 : (wOf 410).reverse = (wOf 2).reverse ^ 13 ++ pBRev := by + exact eq_of_beq (by decide +kernel) + +private theorem p_word_294 : (wOf 294).reverse = pARev ++ pBRev := by + exact eq_of_beq (by decide +kernel) + +private theorem p_word_4 : (wOf 4).reverse = pBRev ++ pARev := by + exact eq_of_beq (by decide +kernel) + +private theorem p_tail_eq : + flatAffLeft wOf 0 finalPTail = pARev ++ (wOf 4).reverse ^ 2 := by + exact eq_of_beq (by decide +kernel) + +private theorem final_xp_chunk_eq (k : ℕ) : + flatAffLeft wOf k finalXPChunk = + flatAffLeft wOf (k + 1) [AffRun.mk 2 ⟨0, 791761176⟩] ++ + flatAffLeft wOf (k + 1) [AffRun.mk 4 ⟨1, 8⟩] := by + unfold finalXPChunk + rw [flatAffLeft_append, flatAffLeft_const wOf k const_pt_ok, p_tail_eq] + have he1 : (AffNat.mk 0 791761144).eval k = 791761144 := by simp [AffNat.eval] + have he2 : (AffNat.mk 0 1).eval k = 1 := by simp [AffNat.eval] + have he3 : (AffNat.mk 1 6).eval k = k + 6 := by simp [AffNat.eval] + have he4 : (AffNat.mk 0 791761176).eval (k + 1) = 791761176 := by simp [AffNat.eval] + have he5 : (AffNat.mk 1 8).eval (k + 1) = (k + 6) + 1 + 2 := by dsimp [AffNat.eval]; omega + simp only [flatAffLeft, he1, he2, he3, he4, he5, list_pow_one, List.append_nil] + rw [p_word_241, p_word_410, p_word_294] + simp only [List.append_assoc] + have hx1 : ∀ tail : List (Fin 2), + (wOf 2).reverse ^ 19 ++ ((wOf 2).reverse ^ 13 ++ tail) = + (wOf 2).reverse ^ 32 ++ tail := by + intro tail; rw [← List.append_assoc, ← list_pow_add] + have hx2 : ∀ tail : List (Fin 2), + (wOf 2).reverse ^ 791761144 ++ ((wOf 2).reverse ^ 32 ++ tail) = + (wOf 2).reverse ^ 791761176 ++ tail := by + intro tail + have hnum : 791761144 + 32 = 791761176 := eq_of_beq (by decide +kernel) + rw [← List.append_assoc, ← list_pow_add, hnum] + rw [hx1, hx2] + refine congrArg ((wOf 2).reverse ^ 791761176 ++ ·) ?_ + have hrot : pBRev ++ ((pARev ++ pBRev) ^ (k + 6) ++ (pARev ++ (wOf 4).reverse ^ 2)) = + (pBRev ++ ((pARev ++ pBRev) ^ (k + 6) ++ pARev)) ++ (wOf 4).reverse ^ 2 := by + simp only [List.append_assoc] + rw [hrot, lpow_rot pARev pBRev (k + 6), ← List.append_assoc, ← p_word_4, + ← list_pow_succ, ← list_pow_add] + +/-- The post-return symbolic configuration `a6FinalCfg` at `k` equals `familyCfg (k + 1)`. -/ +theorem a6_final_eq_next (k : ℕ) : + evalAffCfg qOf wOf k a6FinalCfg = familyCfg (k + 1) := by + have hfq : a6FinalCfg.q = 1 := eq_of_beq (by decide +kernel) + have hfd : a6FinalCfg.dir = true := eq_of_beq (by decide +kernel) + have hfr : a6FinalCfg.right = [⟨1, ⟨0, 6⟩⟩] := eq_of_beq (by decide +kernel) + have hiq : initReturnCfg.q = 1 := eq_of_beq (by decide +kernel) + have hid : initReturnCfg.dir = true := eq_of_beq (by decide +kernel) + have hir : initReturnCfg.right = [⟨1, ⟨0, 6⟩⟩] := eq_of_beq (by decide +kernel) + unfold familyCfg evalAffCfg + rw [hfq, hfd, hfr, hiq, hid, hir] + refine congr (congrArg (dirCfg qOf 1 true) ?_) ?_ + · rw [evalAffSide_false_eq_flat, evalAffSide_false_eq_flat] + refine congrArg (ListBlank.append · default) ?_ + rw [final_left_decomp, init_left_decomp] + simp only [flatAffLeft_append] + have h1 : flatAffLeft wOf k finalPre = + flatAffLeft wOf (k + 1) (initReturnCfg.left.take 5) := by + rw [flatAffLeft_const wOf k const_pre_ok, ← const_pre_eq, + ← flatAffLeft_const wOf (k + 1) const_pre_ok] + have h3 : flatAffLeft wOf k finalMid = + flatAffLeft wOf (k + 1) ((initReturnCfg.left.drop 6).take 8) := by + rw [flatAffLeft_const wOf k const_mid_ok, ← const_mid_eq, + ← flatAffLeft_const wOf (k + 1) const_mid_ok] + have h5 : flatAffLeft wOf k finalSuf = + flatAffLeft wOf (k + 1) (initReturnCfg.left.drop 16) := by + rw [flatAffLeft_const wOf k const_suf_ok, ← const_suf_eq, + ← flatAffLeft_const wOf (k + 1) const_suf_ok] + rw [h1, final_q_chunk_eq k, h3, final_xp_chunk_eq k, h5] + simp only [List.append_assoc] + · simp [evalAffSide, AffNat.eval] + +/-! ## Part 4: Symbolic Family Step and Non-Halting Closure -/ + +private theorem reachesPlus_of_reachesIn_eq {n : ℕ} {c₁ c₂ c₂' : Cfg (Fin 2) (Fin 6)} + (hpos : 0 < n) (hr : ReachesIn a6Target n c₁ c₂) (heq : c₂ = c₂') : + ReachesPlus a6Target c₁ c₂' := + ⟨n, hpos, heq ▸ hr⟩ + +/-- For every `k : ℕ`, `familyCfg k` reaches `familyCfg (k + 1)` in +`304,037,417,082 + 119,808 * k > 0` steps. -/ +theorem family_step (k : ℕ) : + ReachesPlus a6Target (familyCfg k) (familyCfg (k + 1)) := by + have hcert : ReachesIn a6Target (returnTarget.eval k) + (familyCfg k) (evalAffCfg qOf wOf k a6FinalCfg) := + verifyReturnCert_sound (cert := a6Cert) fastExit2_sound baseWord_zero_blank + a6_vocab_blank0 a6_exits_ok a6_replay_ok k + have hpos : 0 < returnTarget.eval k := + Nat.add_pos_right (119808 * k) (by decide) + exact reachesPlus_of_reachesIn_eq hpos hcert (a6_final_eq_next k) + +end BusyBeaver.BB6.A6 + +namespace BusyBeaver.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH + +private theorem a6Target_eq_target : BB6.A6.a6Target = target := by + funext ⟨q, hq⟩ ⟨a, ha⟩ + have hq6 : q = 0 ∨ q = 1 ∨ q = 2 ∨ q = 3 ∨ q = 4 ∨ q = 5 := by omega + have ha2 : a = 0 ∨ a = 1 := by omega + rcases hq6 with rfl | rfl | rfl | rfl | rfl | rfl <;> + rcases ha2 with rfl | rfl <;> + rfl + +/-- Machine `1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LB---` (`A6`) does not halt from the blank tape. -/ +theorem is_not_halt : IsNotHalt target := by + rw [← a6Target_eq_target] + have hinit : ReachesStar BB6.A6.a6Target (init []) (BB6.A6.familyCfg 0) := by + rw [← BB6.A6.entryMilestone_eight_eq] + exact BB6.A6.entry_to_c8 + exact AffRLE.isNotHalt_of_family BB6.A6.familyCfg hinit BB6.A6.family_step + +/-- `ConjectureMachines.Halts` reformulation of `is_not_halt`. -/ +theorem not_halts : ¬ ConjectureMachines.Halts machine := + (ConjectureMachines.isNotHalt_toBB_iff_not_halts machine).mp is_not_halt + +end BusyBeaver.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH + +end diff --git a/BusyBeaver/BB6/README.md b/BusyBeaver/BB6/README.md index 287ad2f4..bab47002 100644 --- a/BusyBeaver/BB6/README.md +++ b/BusyBeaver/BB6/README.md @@ -1,11 +1,16 @@ # Busy Beaver 6 Holdouts (`BusyBeaver/BB6/`) -This directory contains formal Lean 4 specifications and kernel-verified Collatz-like reductions for 53 Busy Beaver 6 (`BB(6)`, 6-state 2-symbol) holdout Turing machines, together with 29 stacked, odometer, and transducer holdouts (9 `bbchallenge` Wiki machines formalized under `HasStackReduction`, `HasOdometerReduction`, and `HasTransducerReduction`, plus 20 open acceleration problems under `IsValidAcceleration`, 13 with higher-level accelerations) in **[`BusyBeaver/BB6/Accelerations/`](./Accelerations/README.md)** (82 `BB(6)` holdouts total). Each machine module in `BusyBeaver/BB6/` below exposes both **Level A** (`ps`, `is_closed_pattern_set`, `has_collatz_reduction`) and **Level B** (`State`, `start`, `encode`, `next`, `is_valid_acceleration`, `isHalt_iff_acceleration`), and 33 modules (all 20 novel discovery modules together with 13 multi-family or multi-counter wiki/busycoq holdouts) additionally expose a higher-level Collatz-like acceleration (`HighLevelState`, `highLevelStart`, `highLevelEncode`, `highLevelNext`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`); see [`BusyBeaver/README.md`](../README.md) for definitions of the behavioral predicates and [`BusyBeaver/BB6/Accelerations/README.md`](./Accelerations/README.md) for the stacked, odometer, and transducer formalizations and open problem statements. +This directory contains formal Lean 4 specifications and kernel-verified Collatz-like reductions for 53 Busy Beaver 6 (`BB(6)`, 6-state 2-symbol) holdout Turing machines, together with 29 stacked, odometer, and transducer holdouts (9 `bbchallenge` Wiki machines formalized under `HasStackReduction`, `HasOdometerReduction`, and `HasTransducerReduction`, plus 20 open acceleration problems under `IsValidAcceleration`, 13 with higher-level accelerations) in **[`BusyBeaver/BB6/Accelerations/`](./Accelerations/README.md)** (83 `BB(6)` machines total, including the nonhalting A6 certificate below). Each reduction module in `BusyBeaver/BB6/` below exposes both **Level A** (`ps`, `is_closed_pattern_set`, `has_collatz_reduction`) and **Level B** (`State`, `start`, `encode`, `next`, `is_valid_acceleration`, `isHalt_iff_acceleration`), and 33 modules (all 20 novel discovery modules together with 13 multi-family or multi-counter wiki/busycoq holdouts) additionally expose a higher-level Collatz-like acceleration (`HighLevelState`, `highLevelStart`, `highLevelEncode`, `highLevelNext`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`); see [`BusyBeaver/README.md`](../README.md) for definitions of the behavioral predicates and [`BusyBeaver/BB6/Accelerations/README.md`](./Accelerations/README.md) for the stacked, odometer, and transducer formalizations and open problem statements. + +The A6 module exports a closed blank-tape `IsNotHalt` proof using a checked +entry certificate and a universal return family; it has a separate +[proof guide](../../artifacts/a6/README.md). ## Formalized `BB(6)` Machines | Machine (`bbchallenge` RLE) | States | Symbols | Proved Properties | Wiki / Notes | Lean 4 Proof | | :--- | :--- | :--- | :--- | :--- | :--- | +| `1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LB---` | `6` | `2` | `IsNotHalt` | [A6 proof and reproduction](../../artifacts/a6/README.md) | [`M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean`](./M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean) | | `1RB0LB_1LC0RE_1LA1LD_0LC---_0RB0RF_1RE1RB` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | [Wiki](https://wiki.bbchallenge.org/wiki/1RB0LB_1LC0RE_1LA1LD_0LC---_0RB0RF_1RE1RB) | [`M_1RB0LB_1LC0RE_1LA1LD_0LCHHH_0RB0RF_1RE1RB.lean`](./M_1RB0LB_1LC0RE_1LA1LD_0LCHHH_0RB0RF_1RE1RB.lean) | | `1RB0LC_0LC0RF_1RD1LC_0RA1LE_---0LD_1LF1LA` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | [Wiki](https://wiki.bbchallenge.org/wiki/1RB0LC_0LC0RF_1RD1LC_0RA1LE_---0LD_1LF1LA) | [`M_1RB0LC_0LC0RF_1RD1LC_0RA1LE_HHH0LD_1LF1LA.lean`](./M_1RB0LC_0LC0RF_1RD1LC_0RA1LE_HHH0LD_1LF1LA.lean) | | `1RB0LC_0LC1RF_1LE1RD_0RC1RC_0LA1LA_---1RA` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | [Wiki](https://wiki.bbchallenge.org/wiki/1RB0LC_0LC1RF_1LE1RD_0RC1RC_0LA1LA_---1RA) | [`M_1RB0LC_0LC1RF_1LE1RD_0RC1RC_0LA1LA_HHH1RA.lean`](./M_1RB0LC_0LC1RF_1LE1RD_0RC1RC_0LA1LA_HHH1RA.lean) | diff --git a/BusyBeaver/ElabRLE.lean b/BusyBeaver/ElabRLE.lean new file mode 100644 index 00000000..3f274f92 --- /dev/null +++ b/BusyBeaver/ElabRLE.lean @@ -0,0 +1,529 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.AffRLE +meta import BusyBeaver.WordRLE +meta import BusyBeaver.AffRLE +public meta import Lean.Elab.Term + +/-! +# Elaboration-Time RLE Certificate Synthesis & Kernel Proof Drivers (`BusyBeaver.ElabRLE`) + +Pure-Lean elaboration-time infrastructure pairing with `BusyBeaver.WordRLE` and +`BusyBeaver.AffRLE`: + +- `ToExpr` instances for `Run`, `EntryCfg`, `BTree`, `NatTrie`, `AffNat`, `AffRun`, `AffCfg`, + `CompExit`, `AffOp`, and `ReturnCert`. +- `discoverReturnCert` — Machine-polymorphic symbolic affine simulator with automatic composite + word interning and inner countdown-cycle synthesis (`SymExpr` probe + `verifyCycle` validation). +- `proveEntryPhase`, `proveCheckAll`, and `proveAffReplay` — Sliced `mkAuxTheorem` kernel proof + drivers that reset Lean's WHNF cache between bounded slices so peak memory stays flat. +-/ + +@[expose] public section + +namespace BusyBeaver.ElabRLE + +open BusyBeaver.WordRLE BusyBeaver.AffRLE + +/-- Construct a `NatTrie.checkAll` proof on an internal `.node` from proofs of its local value and +even/odd child subtries. -/ +theorem checkAll_node {α : Type} {p : ℕ → α → Bool} {keyPrefix bitMul : ℕ} + {val? : Option α} {l r : NatTrie α} + (hv : (match val? with | none => true | some v => p keyPrefix v) = true) + (hl : NatTrie.checkAll p keyPrefix (bitMul * 2) l = true) + (hr : NatTrie.checkAll p (keyPrefix + bitMul) (bitMul * 2) r = true) : + NatTrie.checkAll p keyPrefix bitMul (.node val? l r) = true := + (NatTrie.checkAll_node_iff p keyPrefix bitMul val? l r).mpr ⟨hv, hl, hr⟩ + +end BusyBeaver.ElabRLE + +end + +public meta section + +namespace BusyBeaver.ElabRLE + +open Lean Meta Elab Term +open BusyBeaver.WordRLE BusyBeaver.AffRLE + +/-! ## `ToExpr` Instances for Certificate Data Structures -/ + +instance : ToExpr Run where + toExpr r := mkApp2 (mkConst ``Run.mk) (toExpr r.sym) (toExpr r.count) + toTypeExpr := mkConst ``Run + +instance : ToExpr EntryCfg where + toExpr c := mkApp4 (mkConst ``EntryCfg.mk) + (toExpr c.q) (toExpr c.dir) (toExpr c.left) (toExpr c.right) + toTypeExpr := mkConst ``EntryCfg + +/-- Serialize a `BTree α` to a Lean kernel `Expr`. -/ +def btreeToExpr {α : Type} [ToExpr α] (ty : Expr) : BTree α → Expr + | .empty => mkApp (mkConst ``BTree.empty) ty + | .leaf x => mkApp2 (mkConst ``BTree.leaf) ty (toExpr x) + | .node l r => mkApp3 (mkConst ``BTree.node) ty (btreeToExpr ty l) (btreeToExpr ty r) + +instance {α : Type} [ToExpr α] : ToExpr (BTree α) where + toExpr t := btreeToExpr (toTypeExpr α) t + toTypeExpr := mkApp (mkConst ``BTree) (toTypeExpr α) + +/-- Serialize a `NatTrie α` to a Lean kernel `Expr`. -/ +def natTrieToExpr {α : Type} [ToExpr α] (ty : Expr) : NatTrie α → Expr + | .leaf => mkApp (mkConst ``NatTrie.leaf) ty + | .node v l r => + mkApp4 (mkConst ``NatTrie.node) ty (toExpr v) (natTrieToExpr ty l) (natTrieToExpr ty r) + +instance {α : Type} [ToExpr α] : ToExpr (NatTrie α) where + toExpr t := natTrieToExpr (toTypeExpr α) t + toTypeExpr := mkApp (mkConst ``NatTrie) (toTypeExpr α) + +instance : ToExpr AffNat where + toExpr x := mkApp2 (mkConst ``AffNat.mk) (toExpr x.a) (toExpr x.b) + toTypeExpr := mkConst ``AffNat + +instance : ToExpr AffRun where + toExpr r := mkApp2 (mkConst ``AffRun.mk) (toExpr r.wid) (toExpr r.count) + toTypeExpr := mkConst ``AffRun + +instance : ToExpr AffCfg where + toExpr c := mkApp4 (mkConst ``AffCfg.mk) + (toExpr c.q) (toExpr c.dir) (toExpr c.left) (toExpr c.right) + toTypeExpr := mkConst ``AffCfg + +instance : ToExpr CompExit where + toExpr e := mkApp4 (mkConst ``CompExit.mk) + (toExpr e.wid') (toExpr e.q') (toExpr e.dir') (toExpr e.dt) + toTypeExpr := mkConst ``CompExit + +instance : ToExpr AffOp where + toExpr + | .steps n => mkApp (mkConst ``AffOp.steps) (toExpr n) + | .cycle L K ds => mkApp3 (mkConst ``AffOp.cycle) (toExpr L) (toExpr K) (toExpr ds) + toTypeExpr := mkConst ``AffOp + +instance : ToExpr ReturnCert where + toExpr c := mkApp3 (mkConst ``ReturnCert.mk) + (toExpr c.vocab) (toExpr c.exits) (toExpr c.ops) + toTypeExpr := mkConst ``ReturnCert + +/-! ## Balanced `BTree` Construction -/ + +private def buildBTree {α : Type} : ℕ → List α → BTree α × List α + | 0, xs => (.empty, xs) + | 1, [] => (.empty, []) + | 1, x :: xs => (.leaf x, xs) + | n + 2, xs => + let half := (n + 2) / 2 + let (l, xs₁) := buildBTree half xs + let (r, xs₂) := buildBTree (n + 2 - half) xs₁ + (.node l r, xs₂) + +/-- Construct a balanced `BTree α` from `xs` in `O(N)` time. -/ +def btreeOfList {α : Type} (xs : List α) : BTree α := + (buildBTree xs.length xs).1 + +/-! ## Pure-Lean Symbolic Return Certificate Discovery Oracle -/ + +private structure OracleEnv where + nextWid : ℕ + vocabList : NatTrie (List ℕ) + vocabTree : NatTrie (BTree ℕ) + wordMap : Std.HashMap (List ℕ) ℕ + exits : NatTrie CompExit + +private def internWord (w : List ℕ) (env : OracleEnv) : ℕ × OracleEnv := + match env.wordMap[w]? with + | some id => (id, env) + | none => + let id := env.nextWid + (id, { + env with + nextWid := id + 1 + vocabList := env.vocabList.insert id w + vocabTree := env.vocabTree.insert id (btreeOfList w) + wordMap := env.wordMap.insert w id + }) + +private def getOrComputeExit (numStates : ℕ) + (baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)) + (wid q : ℕ) (dir : Bool) (env : OracleEnv) : Option (CompExit × OracleEnv) := + let key := compKey numStates wid q dir + match env.exits.find? key with + | some ex => some (ex, env) + | none => + match env.vocabList.find? wid with + | none => none + | some u => + match runCompositeExit baseExit u q dir with + | none => none + | some (v, q', dir', dt) => + let (wid', env₁) := internWord v env + let ex : CompExit := ⟨wid', q', dir', dt⟩ + some (ex, { env₁ with exits := env₁.exits.insert key ex }) + +private structure SymExpr where + vid : Option ℕ + offP : ℕ + offN : ℕ + deriving DecidableEq + +private def symNorm (vid : Option ℕ) (p n : ℕ) : SymExpr := + if n ≤ p then ⟨vid, p - n, 0⟩ else ⟨vid, 0, n - p⟩ + +private def symConst? (e : SymExpr) : Option ℕ := + if e.vid.isNone && e.offN == 0 then some e.offP else none + +private def symAdd? (e₁ e₂ : SymExpr) : Option SymExpr := + match e₁.vid, e₂.vid with + | none, none => some (symNorm none (e₁.offP + e₂.offP) (e₁.offN + e₂.offN)) + | some v, none => some (symNorm (some v) (e₁.offP + e₂.offP) (e₁.offN + e₂.offN)) + | none, some v => some (symNorm (some v) (e₁.offP + e₂.offP) (e₁.offN + e₂.offN)) + | some _, some _ => none + +private def symSub? (e₁ e₂ : SymExpr) : Option SymExpr := + if e₁.vid == e₂.vid then + some (symNorm none (e₁.offP + e₂.offN) (e₁.offN + e₂.offP)) + else if e₂.vid.isNone then + some (symNorm e₁.vid (e₁.offP + e₂.offN) (e₁.offN + e₂.offP)) + else none + +private def symReqGe (e : SymExpr) (k : ℕ) (mins : NatTrie ℕ) : Option (NatTrie ℕ) := + match e.vid with + | none => if k + e.offN ≤ e.offP then some mins else none + | some idx => + let req := if e.offP ≤ k + e.offN then (k + e.offN) - e.offP else 0 + let cur := match mins.find? idx with | some m => m | none => 2 + if req ≤ cur then some mins else some (mins.insert idx req) + +private def buildSymStack : + List AffRun → ℕ → NatTrie ℕ → List (ℕ × SymExpr) × ℕ × NatTrie ℕ + | [], nxt, mins => ([], nxt, mins) + | r :: rs, nxt, mins => + if r.count.isOne then + let (out, nxt', mins') := buildSymStack rs nxt mins + ((r.wid, ⟨none, 1, 0⟩) :: out, nxt', mins') + else + let vid := nxt + let mins₁ := mins.insert vid 2 + let (out, nxt', mins') := buildSymStack rs (nxt + 1) mins₁ + ((r.wid, ⟨some vid, 0, 0⟩) :: out, nxt', mins') + +private def simCycleProbe (numStates : ℕ) + (baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)) : + ℕ → ℕ → Bool → List (ℕ × SymExpr) → List (ℕ × SymExpr) → NatTrie ℕ → OracleEnv → + Option (ℕ × Bool × List (ℕ × SymExpr) × List (ℕ × SymExpr) × NatTrie ℕ × OracleEnv) + | 0, q, dir, l, r, mins, env => some (q, dir, l, r, mins, env) + | n + 1, q, dir, l, r, mins, env => + let src := if dir then r else l + let (wid, cExpr) : ℕ × SymExpr := match src with | [] => (0, ⟨none, 1, 0⟩) | top :: _ => top + match getOrComputeExit numStates baseExit wid q dir env with + | none => none + | some (ex, env₁) => + let same := ex.q' == q && ex.dir' == dir + if src.isEmpty && same then none + else + let count : SymExpr := if same then cExpr else ⟨none, 1, 0⟩ + match symConst? count with + | none => none + | some cntVal => + let popRes? : Option (List (ℕ × SymExpr) × NatTrie ℕ) := + match src with + | [] => some ([], mins) + | (tw, tc) :: rest => + match symSub? tc count with + | none => none + | some rem => + if rem == (⟨none, 0, 0⟩ : SymExpr) then some (rest, mins) + else (symReqGe rem 1 mins).map fun m' ↦ ((tw, rem) :: rest, m') + match popRes? with + | none => none + | some (src', mins₁) => + let l₁ := if dir then l else src' + let r₁ := if dir then src' else r + let pushSide (dst : List (ℕ × SymExpr)) (m : NatTrie ℕ) : + Option (List (ℕ × SymExpr) × NatTrie ℕ) := + if cntVal == 0 then some (dst, m) + else if dst.isEmpty && ex.wid' == 0 then some ([], m) + else + match symReqGe count 1 m with + | none => none + | some m₁ => + match dst with + | [] => some ([(ex.wid', count)], m₁) + | (dw, dc) :: drest => + if dw == ex.wid' then + (symAdd? dc count).map fun merged ↦ ((dw, merged) :: drest, m₁) + else some ((ex.wid', count) :: dst, m₁) + let dstRes? := + if ex.dir' then (pushSide l₁ mins₁).map fun (l₂, m₂) ↦ (l₂, r₁, m₂) + else (pushSide r₁ mins₁).map fun (r₂, m₂) ↦ (l₁, r₂, m₂) + match dstRes? with + | none => none + | some (l₂, r₂, mins₂) => + simCycleProbe numStates baseExit n ex.q' ex.dir' l₂ r₂ mins₂ env₁ + +private def extractCycleDeltas (mins : NatTrie ℕ) : + List AffRun → List (ℕ × SymExpr) → List (ℕ × SymExpr) → + Option (List (ℕ × ℕ) × List AffNat) + | [], [], [] => some ([], []) + | r :: rs, (ow, oe) :: os, (nw, ne) :: ns => + if ow != nw || oe.vid != ne.vid then none + else + let p := ne.offP + oe.offN + let n := ne.offN + oe.offP + let (dp, dn) := if n ≤ p then (p - n, 0) else (0, n - p) + if oe.vid.isNone && (dp != 0 || dn != 0) then none + else if 2 ≤ dn then none + else + let minBound := match oe.vid with + | none => 1 + | some vid => match mins.find? vid with | some m => m | none => 2 + if !r.count.geConst minBound then none + else + match extractCycleDeltas mins rs os ns with + | none => none + | some (ds, choices) => + let choices' := + if dn == 1 then + match r.count.sub? ⟨0, minBound - 1⟩ with + | some ch => ch :: choices + | none => choices + else choices + some ((dp, dn) :: ds, choices') + | _, _, _ => none + +private def minChoiceAux (cur : AffNat) : List AffNat → AffNat + | [] => cur + | y :: rest => minChoiceAux (if AffNat.lexLt cur y then cur else y) rest + +private def minChoice : List AffNat → Option AffNat + | [] => none + | x :: rest => some (minChoiceAux x rest) + +private def tryDiscoverCycle (numStates : ℕ) + (baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)) + (oldCfg : AffCfg) (L : ℕ) (env : OracleEnv) : + Option (AffNat × List (ℕ × ℕ) × OracleEnv) := + let (lOrig, nxt₁, mins₁) := buildSymStack oldCfg.left 0 .leaf + let (rOrig, _, mins₂) := buildSymStack oldCfg.right nxt₁ mins₁ + match simCycleProbe numStates baseExit L oldCfg.q oldCfg.dir lOrig rOrig mins₂ env with + | none => none + | some (q', dir', lNew, rNew, minsFinal, env₁) => + if q' != oldCfg.q || dir' != oldCfg.dir then none + else + match extractCycleDeltas minsFinal (oldCfg.left ++ oldCfg.right) + (lOrig ++ rOrig) (lNew ++ rNew) with + | none => none + | some (deltas, choices) => + match minChoice choices with + | none => none + | some K => + let allGe := choices.all fun ch ↦ (ch.sub? K).isSome + if K.geConst 1 && allGe then some (K, deltas, env₁) + else none + +private def shapeKey (c : AffCfg) : List ℕ := + let encSide (s : List AffRun) : List ℕ := + s.foldr (fun r acc ↦ (r.wid * 2 + (if r.count.isOne then 1 else 0) + 1) :: acc) [] + (c.q * 2 + (if c.dir then 1 else 0)) :: (encSide c.left ++ (0 :: encSide c.right)) + +private def addStepOp (ops : List AffOp) : List AffOp := + match ops with + | .steps n :: rest => .steps (n + 1) :: rest + | _ => .steps 1 :: ops + +/-- Discover a verified symbolic `ReturnCert` (and final `AffCfg`) driving `initCfg` for exactly +`target` symbolic steps over a machine with `numStates` states and base-word exit function +`baseExit`. Automatically interns `[0]` at `wid = 0` followed by `seedWords`. -/ +partial def discoverReturnCert + (numStates : ℕ) + (baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)) + (seedWords : List (List ℕ)) + (initCfg : AffCfg) + (target : AffNat) + (maxLoops : ℕ := 200000) : Option (ReturnCert × AffCfg) := Id.run do + let mut env : OracleEnv := { + nextWid := 0 + vocabList := .leaf + vocabTree := .leaf + wordMap := {} + exits := .leaf + } + for w in ([0] :: seedWords) do + let (_, env') := internWord w env + env := env' + let mut loops : ℕ := 0 + let mut curSteps : AffNat := ⟨0, 0⟩ + let mut c : AffCfg := initCfg + let mut past : Std.HashMap (List ℕ) (AffCfg × AffNat × ℕ × List AffOp) := {} + let mut failed : Std.HashSet (List ℕ) := {} + let mut revOps : List AffOp := [] + while curSteps != target && loops < maxLoops do + let sk := shapeKey c + if !failed.contains sk then + if let some (oldCfg, oldSteps, oldLoops, oldRevOps) := past[sk]? then + let L := loops - oldLoops + match tryDiscoverCycle numStates baseExit oldCfg L env with + | some (K, deltas, env₁) => + env := env₁ + if let some (dtCyc, afterCfg) := verifyCycle numStates env.exits L K deltas oldCfg then + curSteps := oldSteps.add dtCyc + c := afterCfg + loops := oldLoops + 1 + revOps := .cycle L K deltas :: oldRevOps + past := {} + continue + else + failed := failed.insert sk + | none => + failed := failed.insert sk + past := past.insert sk (c, curSteps, loops, revOps) + let src := if c.dir then c.right else c.left + let wid := match src with | [] => 0 | top :: _ => top.wid + let some (_, env₁) := getOrComputeExit numStates baseExit wid c.q c.dir env | return none + env := env₁ + let rem? := target.sub? curSteps + let some (dt, c') := stepAffOnce numStates env.exits rem? c.q c.dir c.left c.right + | return none + curSteps := curSteps.add dt + c := c' + loops := loops + 1 + revOps := addStepOp revOps + if curSteps == target then + return some (⟨env.vocabTree, env.exits, btreeOfList revOps.reverse⟩, c) + else + return none + +/-! ## Sliced Kernel Proof Drivers (`mkAuxTheorem`) -/ + +private def mkBoolEqTrue (lhs : Expr) : Expr := + mkApp3 (mkConst ``Eq [Level.one]) (mkConst ``Bool) lhs (mkConst ``Bool.true) + +private def boolReflTrue : Expr := + mkApp2 (mkConst ``Eq.refl [Level.one]) (mkConst ``Bool) (mkConst ``Bool.true) + +/-- Elaborate a chunked kernel proof of `EntryReaches stepFn expDt startCfg expCfg`, running at +most `chunkSize` RLE steps per `mkAuxTheorem` slice so kernel memory stays bounded, and casting +endpoint expressions in the kernel via `EntryReaches.cast_ends`. -/ +def proveEntryPhase + (stepFn : ℕ → Bool → List Run → List Run → Option (ℕ × EntryCfg)) + (stepFnE : Expr) + (totalLoops chunkSize expDt : ℕ) + (startCfg expCfg : EntryCfg) + (startCfgE? : Option Expr := none) + (expCfgE? : Option Expr := none) : MetaM Expr := do + let mut remLoops := totalLoops + let mut cur := startCfg + let startE := toExpr startCfg + let mut proofExpr := mkApp2 (mkConst ``EntryReaches.refl) stepFnE startE + let mut sumExpr := toExpr (0 : ℕ) + let mut curExpr := startE + let mut totDt : ℕ := 0 + while remLoops > 0 do + let fuel := Nat.min remLoops chunkSize + let some (dt, nxt) := runExact stepFn fuel 0 cur + | throwError "proveEntryPhase: simulation failed with remaining loops {remLoops}" + let fuelE := toExpr fuel + let dtE := toExpr dt + let nxtE := toExpr nxt + let lhs := mkApp5 (mkConst ``checkRunExact) stepFnE fuelE dtE curExpr nxtE + let auxThm ← mkAuxTheorem (mkBoolEqTrue lhs) boolReflTrue + let stepPrf := mkApp6 (mkConst ``EntryReaches.chunk) stepFnE fuelE dtE curExpr nxtE auxThm + proofExpr := mkApp8 (mkConst ``EntryReaches.trans) + stepFnE sumExpr dtE startE curExpr nxtE proofExpr stepPrf + sumExpr := mkApp2 (mkConst ``Nat.add) sumExpr dtE + curExpr := nxtE + cur := nxt + totDt := totDt + dt + remLoops := remLoops - fuel + if totDt != expDt then + throwError "proveEntryPhase: step count mismatch: got {totDt}, expected {expDt}" + if cur != expCfg then + throwError "proveEntryPhase: final configuration mismatch" + let expDtE := toExpr expDt + let tgtStartE := startCfgE?.getD startE + let tgtExpE := expCfgE?.getD curExpr + let endsLhs := mkApp6 (mkConst ``checkEntryEnds) + sumExpr expDtE startE tgtStartE curExpr tgtExpE + let endsPrf ← mkAuxTheorem (mkBoolEqTrue endsLhs) boolReflTrue + return mkAppN (mkConst ``EntryReaches.cast_ends) + #[stepFnE, sumExpr, expDtE, startE, tgtStartE, curExpr, tgtExpE, proofExpr, endsPrf] + +/-- Elaborate a depth-split `mkAuxTheorem` proof of `NatTrie.checkAll p 0 1 t = true`. -/ +def proveCheckAll {α : Type} [ToExpr α] + (pE : Expr) (t : NatTrie α) (splitDepth : ℕ := 3) : MetaM Expr := do + let αTy := toTypeExpr α + let optTy := mkApp (mkConst ``Option [Level.zero]) αTy + let rec go (depth kp bm : ℕ) (sub : NatTrie α) : MetaM Expr := do + match depth, sub with + | d + 1, .node val? l r => + let valE : Expr := toExpr val? + let lE := toExpr l + let rE := toExpr r + let kpE := toExpr kp + let bmE := toExpr bm + let selfPrf ← match val? with + | none => pure boolReflTrue + | some v => + let selfLhs := mkApp2 pE kpE (toExpr v) + mkAuxTheorem (mkBoolEqTrue selfLhs) boolReflTrue + let lPrf ← go d kp (bm * 2) l + let rPrf ← go d (kp + bm) (bm * 2) r + return mkAppN (mkConst ``checkAll_node) + #[αTy, pE, kpE, bmE, valE, lE, rE, selfPrf, lPrf, rPrf] + | _, _ => + let subE := toExpr sub + let lhs := mkApp5 (mkConst ``NatTrie.checkAll) αTy pE (toExpr kp) (toExpr bm) subE + let _ := optTy + mkAuxTheorem (mkBoolEqTrue lhs) boolReflTrue + go splitDepth 0 1 t + +/-- Elaborate a depth-split `mkAuxTheorem` proof of +`AffReplayReaches numStates exits target ops ⟨0, 0⟩ initCfg target finalCfg`. -/ +def proveAffReplay + (numStates : ℕ) + (exits : NatTrie CompExit) (exitsE : Expr) + (target : AffNat) (targetE : Expr) + (ops : BTree AffOp) + (initCfg expFinalCfg : AffCfg) + (splitDepth : ℕ := 3) : MetaM Expr := do + let numStatesE := toExpr numStates + let rec go (depth : ℕ) (sub : BTree AffOp) (acc : AffNat) (accE : Expr) + (c : AffCfg) (cE : Expr) : MetaM (AffNat × AffCfg × Expr × Expr × Expr) := do + match depth, sub with + | d + 1, .node l r => + let (a₁, c₁, a₁E, c₁E, prfL) ← go d l acc accE c cE + let (a₂, c₂, a₂E, c₂E, prfR) ← go d r a₁ a₁E c₁ c₁E + let lE := toExpr l + let rE := toExpr r + let prf := mkAppN (mkConst ``AffReplayReaches.node) + #[numStatesE, exitsE, targetE, lE, rE, accE, a₁E, a₂E, cE, c₁E, c₂E, prfL, prfR] + return (a₂, c₂, a₂E, c₂E, prf) + | _, _ => + let some (acc', c') := replayAffTree numStates exits target sub acc c + | throwError "proveAffReplay: slice replay failed" + let subE := toExpr sub + let acc'E := toExpr acc' + let c'E := toExpr c' + let lhs := mkApp8 (mkConst ``checkReplaySlice) + numStatesE exitsE targetE subE accE cE acc'E c'E + let auxThm ← mkAuxTheorem (mkBoolEqTrue lhs) boolReflTrue + let prf := mkApp9 (mkConst ``AffReplayReaches.slice) + numStatesE exitsE targetE subE accE acc'E cE c'E auxThm + return (acc', c', acc'E, c'E, prf) + let zeroAff : AffNat := ⟨0, 0⟩ + let (tot, finCfg, _, _, prf) ← + go splitDepth ops zeroAff (toExpr zeroAff) initCfg (toExpr initCfg) + if tot != target then + throwError "proveAffReplay: total affine step mismatch" + if finCfg != expFinalCfg then + throwError "proveAffReplay: final symbolic configuration mismatch" + return prf + +end BusyBeaver.ElabRLE + +end diff --git a/BusyBeaver/README.md b/BusyBeaver/README.md index d2efe4ae..5043852c 100644 --- a/BusyBeaver/README.md +++ b/BusyBeaver/README.md @@ -2,7 +2,7 @@ This library contains formal Lean 4 specifications and kernel-verified behavioral proofs for Busy Beaver 6 (`BB(6)`) and Busy Beaver (3, 3) (`BB(3, 3)`) holdouts, connected to `ConjectureMachines.Machine` via [`BusyBeaver/Bridge.lean`](./Bridge.lean): -- **[`BusyBeaver/BB6/`](./BB6/README.md)** — 82 `BB(6)` (6-state, 2-symbol) holdout Turing machines: 53 holdouts with certified closed `TapePatternSet` invariants (`IsClosedPatternSet`, `HasCollatzReduction`) and Collatz-like accelerations (`IsValidAcceleration`), plus 29 stacked, odometer, and transducer holdouts (9 `bbchallenge` Wiki machines formalized under `HasStackReduction`, `HasOdometerReduction`, and `HasTransducerReduction`, and 20 open acceleration problems under `IsValidAcceleration`, 13 of which additionally carry higher-level Poincaré/contraction accelerations `highLevelNext`) in **[`BusyBeaver/BB6/Accelerations/`](./BB6/Accelerations/README.md)**. +- **[`BusyBeaver/BB6/`](./BB6/README.md)** — 83 `BB(6)` (6-state, 2-symbol) holdout Turing machines: the [A6 nonhalting certificate](../artifacts/a6/README.md), 53 holdouts with certified closed `TapePatternSet` invariants (`IsClosedPatternSet`, `HasCollatzReduction`) and Collatz-like accelerations (`IsValidAcceleration`), plus 29 stacked, odometer, and transducer holdouts (9 `bbchallenge` Wiki machines formalized under `HasStackReduction`, `HasOdometerReduction`, and `HasTransducerReduction`, and 20 open acceleration problems under `IsValidAcceleration`, 13 of which additionally carry higher-level Poincaré/contraction accelerations `highLevelNext`) in **[`BusyBeaver/BB6/Accelerations/`](./BB6/Accelerations/README.md)**. - **[`BusyBeaver/BB33/`](./BB33/README.md)** — All 6 remaining unsolved `BB(3, 3)` (3-state, 3-symbol) holdout Turing machines (4 equivalence classes: *Bigfoot*, the See-Saw pair, the *Wily Coyote* pair, and `1RB1LB2LC_1LA2RB1RB_---0LA2LA`), with certified Collatz-like (`HasCollatzReduction`) or stacked Collatz-like (`HasStackedCollatzReduction`) reductions and exact halting equivalences (`IsValidAcceleration`). ## Cryptids, Collatz-like, and Stacked Collatz Reductions @@ -11,7 +11,12 @@ Broadly speaking, [cryptids](https://wiki.bbchallenge.org/wiki/Cryptids) are Tur Accordingly, for these machines we look for and formalize **Collatz-like reductions** (`HasCollatzReduction` and `IsValidAcceleration`) and **stacked Collatz reductions** (`HasStackedCollatzReduction` and `IsValidAcceleration`). Some well-known holdouts, such as [`BB(6)` Antihydra](https://wiki.bbchallenge.org/wiki/Antihydra) and [`BB(3, 3)` Bigfoot](https://wiki.bbchallenge.org/wiki/Bigfoot), are widely considered genuinely hard and have attracted dedicated mathematical research. At the same time, other machines with Collatz-like reductions have subsequently been resolved—either through automated deciders or via number-theoretic methods such as Baker's theorem on linear forms in logarithms (e.g., [`1RB1LA_1RC1RE_1LD0RB_1LA0LC_0RF0RD_0RB---`](https://wiki.bbchallenge.org/wiki/1RB1LA_1RC1RE_1LD0RB_1LA0LC_0RF0RD_0RB---)). It is therefore reasonable to expect that some of the machines in this directory will eventually be resolved as halting (`IsHalt`) or non-halting (`IsNotHalt`) over time, with or without the reductions provided here. -The reductions and formal Lean 4 proofs in this library were produced by the Gemini-based agentic discovery pipeline introduced in [*At the Limits of Computability: Steps Towards Autonomous AI Discovery on the Busy Beaver Frontier*](https://arxiv.org/abs/2610.22603) (Dos Santos, Veeriah, Havrilla, Bolt, Zuzic, Singh, and Zahavy, 2026). Starting from raw blank-tape execution traces of unresolved holdouts, the system integrates automated pattern recognition, symbolic conjecturing of recurrent tape configurations (`TapePatternSet` and `StackPatternSet`) and accelerated transition rules, informal mathematical reasoning, and formal theorem proving in Lean 4 to synthesize and verify closed-set invariants (`IsClosedPatternSet`, `IsClosedStackPatternSet`) and multi-step accelerations (`IsValidAcceleration`). +The original reductions and formal Lean 4 proofs in this library were produced by the Gemini-based agentic discovery pipeline introduced in [*At the Limits of Computability: Steps Towards Autonomous AI Discovery on the Busy Beaver Frontier*](https://arxiv.org/abs/2610.22603) (Dos Santos, Veeriah, Havrilla, Bolt, Zuzic, Singh, and Zahavy, 2026). Starting from raw blank-tape execution traces of unresolved holdouts, the system integrates automated pattern recognition, symbolic conjecturing of recurrent tape configurations (`TapePatternSet` and `StackPatternSet`) and accelerated transition rules, informal mathematical reasoning, and formal theorem proving in Lean 4 to synthesize and verify closed-set invariants (`IsClosedPatternSet`, `IsClosedStackPatternSet`) and multi-step accelerations (`IsValidAcceleration`). + +The A6 nonhalting proof uses the reusable reflective RLE and affine-return engine in +[`WordRLE.lean`](./WordRLE.lean), [`AffRLE.lean`](./AffRLE.lean), and +[`ElabRLE.lean`](./ElabRLE.lean); its [proof guide](../artifacts/a6/README.md) records the +reflective architecture and verification procedure. ## Behavioral Predicates ([`Defs.lean`](./Defs.lean)) @@ -34,9 +39,10 @@ All proofs in `BusyBeaver/` target machine-checked behavioral predicates over th [`BusyBeaver/Basic.lean`](./Basic.lean) provides clean-room multi-step and reachability lemmas (`multiStep`, `ReachesIn`, `ReachesStar`, `ReachesPlus` with `Trans` instances), closed-invariant non-halting theorems (`NeverHaltsFrom.of_reachesPlus_invariant`, `IsNotHalt.of_reachesPlus_invariant`), certified acceleration halting equivalence, higher-level Collatz composition, and pattern-set closure bridges (`IsValidAcceleration.isHalt_iff`, `IsValidAcceleration.collatzHalts_iff`, `IsValidAcceleration.of_step`, `IsValidAcceleration.of_collatz`, `IsValidAcceleration.isClosedPatternSet`, `IsValidAcceleration.isClosedStackPatternSet`), finite block repetition (`l ^ n`) and `ListBlank` identities, standard 6-state (`BusyBeaver.SixState.A..F`) and 3-state (`BusyBeaver.ThreeState.A..C`) labels, directed-head (`Cfg.headRight` / `Cfg.headLeft`) step transitions, scoped directed-head and reachability notations (`l {{q}}> r`, `l <{{q}} r`, `s <+ l`, `l +> s`, `c₁ [M]⊢⁺ c₂`, ...), and concrete execution/halting tactics (`bb_steps`, `bb_halt`). -## Certificate Checker ([`Cert.lean`](./Cert.lean)) +## Certificate Checkers ([`Cert.lean`](./Cert.lean), [`WordRLE.lean`](./WordRLE.lean), [`AffRLE.lean`](./AffRLE.lean), [`ElabRLE.lean`](./ElabRLE.lean)) -[`BusyBeaver/Cert.lean`](./Cert.lean) provides a small verified certificate checker (symbolic configurations over block-repetition variables, validated rewrite rules, and a `Bool`-valued proof-script interpreter whose success is sound for `ReachesStar` / `ReachesPlus` and hub-pattern membership). It is used by the machines whose closure proofs are produced as certificates (e.g. `1RB1RF_1LC---_1LE1RD_1RA0RC_0LF0LA_0LD0RB` and `1RB---_1RC1LE_0RD0RF_0RE0LA_1LF0LB_1LA1LD`). +- [`BusyBeaver/Cert.lean`](./Cert.lean) provides a small verified certificate checker (symbolic configurations over block-repetition variables, validated rewrite rules, and a `Bool`-valued proof-script interpreter whose success is sound for `ReachesStar` / `ReachesPlus` and hub-pattern membership). It is used by the machines whose closure proofs are produced as certificates (e.g. `1RB1RF_1LC---_1LE1RD_1RA0RC_0LF0LA_0LD0RB` and `1RB---_1RC1LE_0RD0RF_0RE0LA_1LF0LB_1LA1LD`). +- [`BusyBeaver/WordRLE.lean`](./WordRLE.lean), [`BusyBeaver/AffRLE.lean`](./AffRLE.lean), and [`BusyBeaver/ElabRLE.lean`](./ElabRLE.lean) provide a machine-polymorphic **proof-by-reflection and elaboration-time certificate synthesis** framework directly over `BusyBeaver.Cfg Γ Λ` (`ListBlank` half-tapes): strict call-by-value `withNat` accumulators, binary `NatTrie` exit tables, concrete RLE replay (`EntryReaches`), affine-exponent symbolic RLE + countdown-cycle replay (`AffReplayReaches`, `verifyReturnCert_sound`), and pure-Lean elaboration-time certificate discovery (`discoverReturnCert`) and sliced `mkAuxTheorem` kernel drivers (`proveEntryPhase`, `proveCheckAll`, `proveAffReplay`). ## Machine Loader and Bridge ([`Bridge.lean`](./Bridge.lean)) @@ -62,7 +68,7 @@ theorem isNotHalt_toBB_iff_not_halts (M : ConjectureMachines.Machine states symb ## Formalized Machine Catalogs -- **[`BB(6)` Holdouts (`BusyBeaver/BB6/`)](./BB6/README.md)** — 53 closed-pattern 6-state 2-symbol holdouts (311 theorems) and **[`BB(6)` Accelerations (`BusyBeaver/BB6/Accelerations/`)](./BB6/Accelerations/README.md)** — 29 stacked, odometer, and transducer holdouts (89 theorems: 9 `bbchallenge` Wiki reductions and 20 open acceleration problems, including 13 higher-level accelerations). +- **[`BB(6)` Holdouts (`BusyBeaver/BB6/`)](./BB6/README.md)** — the [A6 nonhalting certificate](../artifacts/a6/README.md) and 53 closed-pattern 6-state 2-symbol holdouts (311 reduction theorems) and **[`BB(6)` Accelerations (`BusyBeaver/BB6/Accelerations/`)](./BB6/Accelerations/README.md)** — 29 stacked, odometer, and transducer holdouts (89 theorems: 9 `bbchallenge` Wiki reductions and 20 open acceleration problems, including 13 higher-level accelerations). - **[`BB(3, 3)` Holdouts (`BusyBeaver/BB33/`)](./BB33/README.md)** — 6 3-state 3-symbol holdouts (24 theorems). ## Building and Verifying diff --git a/BusyBeaver/WordRLE.lean b/BusyBeaver/WordRLE.lean new file mode 100644 index 00000000..bac80fbb --- /dev/null +++ b/BusyBeaver/WordRLE.lean @@ -0,0 +1,801 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic + +/-! +# Spatial Word-Vocabulary Run-Length Simulation (`BusyBeaver.WordRLE`) + +Reusable, machine-polymorphic infrastructure for kernel-verified Turing machine simulation over +run-length-encoded (RLE) stacks of finite spatial words: + +- `withNat` — Call-by-value `ℕ` normalizer (`withNat n k = k n`) forcing intermediate arithmetic + results to weak-head normal form in Lean's C++ kernel. +- `BTree` & `NatTrie` — Logarithmic-depth tree and radix-trie containers for compact certificates. +- `dirCfg` & `WordExit` — Translation-invariant directed configurations (`Cfg.headRight` / + `Cfg.headLeft` over `ListBlank Γ`) and verified local word-exit transitions. +- `simWord` & `sweepWord_sound` — Certified single-word zipper execution and `k`-copy homogeneous + sweeps (`ReachesIn M (dt * k) ...`). +- `simSubwords` — Certified composite-word exit computation from a verified base-word exit table. +- `EntryCfg` & `EntryReaches` — Concrete RLE stack simulator with pluggable macro-transition + hooks and `O(1)` chunked certificate composition. +-/ + +@[expose] public section + +namespace BusyBeaver.WordRLE + +open Turing + +/-! ## Call-by-Value Kernel Normalizer (`withNat`) -/ + +/-- Force `n : ℕ` to weak-head normal form (`0` or `Nat.succ m`) before passing it to `k`, +preventing call-by-name thunk accumulation during `decide +kernel` reduction while remaining +definitionally equal to `k n` on numerals and provably `k n` for all `n`. -/ +@[inline] +def withNat {α : Type*} (n : ℕ) (k : ℕ → α) : α := + match n with + | 0 => k 0 + | m + 1 => k (Nat.succ m) + +@[simp] +theorem withNat_eq {α : Type*} (n : ℕ) (k : ℕ → α) : withNat n k = k n := by + cases n <;> rfl + +/-- Force `b : Bool` to weak-head normal form (`true` or `false`) before passing it to `k`. -/ +@[inline] +def withBool {α : Type*} (b : Bool) (k : Bool → α) : α := + if b then k true else k false + +@[simp] +theorem withBool_eq {α : Type*} (b : Bool) (k : Bool → α) : withBool b k = k b := by + cases b <;> rfl + +/-! ## Balanced Binary Trees (`BTree`) and `ℕ`-Keyed Radix Tries (`NatTrie`) -/ + +/-- Balanced binary tree keeping certificate expression depth logarithmic (`O(log N)`). -/ +inductive BTree (α : Type) where + /-- Empty tree. -/ + | empty : BTree α + /-- Single element leaf. -/ + | leaf (val : α) : BTree α + /-- Internal binary node. -/ + | node (left right : BTree α) : BTree α + deriving DecidableEq, Inhabited + +/-- Convert a `BTree α` to a `List α` in left-to-right order with accumulator `acc`. -/ +def BTree.toListAcc {α : Type} : BTree α → List α → List α + | .empty, acc => acc + | .leaf x, acc => x :: acc + | .node l r, acc => l.toListAcc (r.toListAcc acc) + +/-- Convert a `BTree α` to a `List α` in left-to-right order. -/ +def BTree.toList {α : Type} (t : BTree α) : List α := + t.toListAcc [] + +/-- Little-endian binary radix trie keyed by `ℕ`, enabling `O(log N)` constructor-match lookups +inside the Lean kernel with zero rebuild overhead when emitted directly as a certificate tree. -/ +inductive NatTrie (α : Type) where + /-- Empty subtrie. -/ + | leaf : NatTrie α + /-- Binary trie node with optional value at key `0` and even/odd child subtries. -/ + | node (val : Option α) (even odd : NatTrie α) : NatTrie α + deriving DecidableEq, Inhabited + +namespace NatTrie + +/-- Look up key `n` in radix trie `t`. -/ +def find? {α : Type} : NatTrie α → ℕ → Option α + | .leaf, _ => none + | .node v _ _, 0 => v + | .node _ l r, n + 1 => + let m := n + 1 + if Nat.beq (m % 2) 0 then find? l (m / 2) else find? r (m / 2) + +/-- Fuel-bounded radix-trie insertion helper. -/ +def insFuel {α : Type} : ℕ → NatTrie α → ℕ → α → NatTrie α + | 0, t, _, _ => t + | _ + 1, .leaf, 0, val => .node (some val) .leaf .leaf + | fuel + 1, .leaf, n + 1, val => + let m := n + 1 + if Nat.beq (m % 2) 0 then .node none (insFuel fuel .leaf (m / 2) val) .leaf + else .node none .leaf (insFuel fuel .leaf (m / 2) val) + | _ + 1, .node _ l r, 0, val => .node (some val) l r + | fuel + 1, .node v l r, n + 1, val => + let m := n + 1 + if Nat.beq (m % 2) 0 then .node v (insFuel fuel l (m / 2) val) r + else .node v l (insFuel fuel r (m / 2) val) + +/-- Insert `(k, val)` into radix trie `t` (supports keys up to `2^32 - 1`). -/ +def insert {α : Type} (t : NatTrie α) (k : ℕ) (val : α) : NatTrie α := + insFuel 32 t k val + +/-- Check predicate `p key val` on every stored entry in `t`, reconstructing keys as +`keyPrefix + localKey * bitMul`. -/ +def checkAll {α : Type} (p : ℕ → α → Bool) (keyPrefix bitMul : ℕ) : NatTrie α → Bool + | .leaf => true + | .node val? l r => + let selfOk := match val? with | none => true | some v => p keyPrefix v + selfOk && + checkAll p keyPrefix (bitMul * 2) l && + checkAll p (keyPrefix + bitMul) (bitMul * 2) r + +theorem checkAll_node_iff {α : Type} (p : ℕ → α → Bool) (keyPrefix bitMul : ℕ) + (val? : Option α) (l r : NatTrie α) : + checkAll p keyPrefix bitMul (.node val? l r) = true ↔ + (match val? with | none => true | some v => p keyPrefix v) = true ∧ + checkAll p keyPrefix (bitMul * 2) l = true ∧ + checkAll p (keyPrefix + bitMul) (bitMul * 2) r = true := by + simp only [checkAll, Bool.and_eq_true, and_assoc] + +/-- Any value found via `NatTrie.find?` in a `checkAll`-verified subtrie satisfies `p`. -/ +theorem checkAll_find? {α : Type} {p : ℕ → α → Bool} : + ∀ (t : NatTrie α) (keyPrefix bitMul n : ℕ) (val : α), + checkAll p keyPrefix bitMul t = true → + t.find? n = some val → + p (keyPrefix + n * bitMul) val = true + | .leaf, _, _, _, _, _, hf => by simp [find?] at hf + | .node val? l r, keyPrefix, bitMul, 0, val, hc, hf => by + rw [checkAll_node_iff] at hc + simp only [find?] at hf + subst hf + simpa using hc.1 + | .node val? l r, keyPrefix, bitMul, n + 1, val, hc, hf => by + rw [checkAll_node_iff] at hc + simp only [find?] at hf + by_cases hev : Nat.beq ((n + 1) % 2) 0 = true + · simp only [hev, ↓reduceIte] at hf + have hmod : (n + 1) % 2 = 0 := Nat.eq_of_beq_eq_true hev + have ih := checkAll_find? l keyPrefix (bitMul * 2) ((n + 1) / 2) val hc.2.1 hf + have hkey : keyPrefix + (n + 1) / 2 * (bitMul * 2) = keyPrefix + (n + 1) * bitMul := by + have hdiv : (n + 1) / 2 * 2 = n + 1 := by omega + rw [Nat.mul_comm bitMul 2, ← Nat.mul_assoc, Nat.mul_comm ((n + 1) / 2) 2] + have h2 : 2 * ((n + 1) / 2) = n + 1 := by omega + rw [h2] + rwa [hkey] at ih + · have hne : Nat.beq ((n + 1) % 2) 0 = false := Bool.eq_false_iff.mpr hev + simp only [hne, Bool.false_eq_true, ↓reduceIte] at hf + have hmod : (n + 1) % 2 = 1 := by + have hnz : (n + 1) % 2 ≠ 0 := fun h0 ↦ hev (by rw [h0]; rfl) + omega + have ih := checkAll_find? r (keyPrefix + bitMul) (bitMul * 2) ((n + 1) / 2) val hc.2.2 hf + have hkey : + keyPrefix + bitMul + (n + 1) / 2 * (bitMul * 2) = keyPrefix + (n + 1) * bitMul := by + have hdiv : 2 * ((n + 1) / 2) + 1 = n + 1 := by omega + calc + keyPrefix + bitMul + (n + 1) / 2 * (bitMul * 2) + = keyPrefix + (bitMul + (n + 1) / 2 * (2 * bitMul)) := by + rw [Nat.mul_comm bitMul 2, Nat.add_assoc] + _ = keyPrefix + (1 * bitMul + (n + 1) / 2 * 2 * bitMul) := by + rw [Nat.one_mul, Nat.mul_assoc] + _ = keyPrefix + (2 * ((n + 1) / 2) + 1) * bitMul := by + rw [Nat.add_comm (1 * bitMul), ← Nat.add_mul, Nat.mul_comm ((n + 1) / 2) 2] + _ = keyPrefix + (n + 1) * bitMul := by rw [hdiv] + rwa [hkey] at ih + +/-- Root-level specialization of `checkAll_find?`: if `checkAll p 0 1 t = true` and +`t.find? n = some val`, then `p n val = true`. -/ +theorem checkAll_sound {α : Type} {p : ℕ → α → Bool} {t : NatTrie α} + (hc : checkAll p 0 1 t = true) {n : ℕ} {val : α} (hf : t.find? n = some val) : + p n val = true := by + simpa using checkAll_find? t 0 1 n val hc hf + +end NatTrie + +/-! ## Word Repetition, Rotation, Concatenation, and Blank-Tape Identities -/ + +section ListIdentities + +variable {Γ : Type*} + +/-- Reversing `u ^ n` reverses the base word `u`. -/ +theorem reverse_pow (u : List Γ) (n : ℕ) : (u ^ n).reverse = u.reverse ^ n := by + induction n with + | zero => rfl + | succ n ih => + rw [list_pow_succ, List.reverse_append, ih, ← list_pow_succ'] + +/-- Word-power rotation identity: `(u ++ w) ^ n ++ u = u ++ (w ++ u) ^ n`. -/ +theorem lpow_rot (u w : List Γ) (n : ℕ) : (u ++ w) ^ n ++ u = u ++ (w ++ u) ^ n := by + induction n with + | zero => simp + | succ n ih => + rw [list_pow_succ, list_pow_succ, List.append_assoc, ih] + simp [List.append_assoc] + +/-- Concatenate a list of subword indices left-to-right using `baseWord : ℕ → List Γ`. -/ +def concatSubwords (baseWord : ℕ → List Γ) : List ℕ → List Γ + | [] => [] + | s :: ss => baseWord s ++ concatSubwords baseWord ss + +@[simp] +theorem concatSubwords_append (baseWord : ℕ → List Γ) (xs ys : List ℕ) : + concatSubwords baseWord (xs ++ ys) = + concatSubwords baseWord xs ++ concatSubwords baseWord ys := by + induction xs with + | nil => rfl + | cons x xs ih => simp [concatSubwords, ih, List.append_assoc] + +theorem lb_blank_word [Inhabited Γ] (z : List Γ) (hz : ∀ x ∈ z, x = default) : + ListBlank.append z default = default := by + induction z with + | nil => rfl + | cons x z ih => + rw [ListBlank.append_cons, ih (fun y hy ↦ hz y (List.mem_cons_of_mem _ hy)), + hz x List.mem_cons_self, ListBlank.cons_default_default] + +theorem lb_blank_pow [Inhabited Γ] (z : List Γ) (hz : ∀ x ∈ z, x = default) (n : ℕ) : + ListBlank.append (z ^ n) default = default := by + induction n with + | zero => rfl + | succ n ih => + rw [list_pow_succ, ListBlank.append_assoc, ih, lb_blank_word z hz] + +end ListIdentities + +/-! ## Directed Configurations and Local Word-Exit Semantics -/ + +section WordSemantics + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Directed machine configuration: `Cfg.headRight` when `dir = true` and `Cfg.headLeft` when +`dir = false`, indexing control states via `qOf : ℕ → Λ`. -/ +def dirCfg (qOf : ℕ → Λ) (q : ℕ) (dir : Bool) (l r : ListBlank Γ) : Cfg Γ Λ := + if dir then Cfg.headRight (qOf q) l r else Cfg.headLeft (qOf q) l r + +/-- Agreement between a pure `ℕ`-indexed transition function `stepCode` and `M : Machine Γ Λ`. -/ +def StepCodeAgrees (M : Machine Γ Λ) (qOf : ℕ → Λ) + (stepCode : ℕ → Γ → Option (Γ × Bool × ℕ)) : Prop := + ∀ q a b dir' q', stepCode q a = some (b, dir', q') → + M (qOf q) a = some (some (qOf q'), Stmt.write b (if dir' then Dir.right else Dir.left)) + +/-- Place spatial word `w` (written left-to-right) adjacent to the head on side `side` (`true` for +right half-tape, `false` for left half-tape where nearest-to-head comes first via `w.reverse`). -/ +def placeSide (side : Bool) (w : List Γ) (l r : ListBlank Γ) : ListBlank Γ × ListBlank Γ := + if side then (l, ListBlank.append w r) else (ListBlank.append w.reverse l, r) + +/-- Semantic specification of a local finite-word exit: entering spatial word `u` in state `q` +moving in direction `dir` exits in `dt` steps leaving spatial word `v` behind the head in state `q'` +moving in direction `dir'`, for arbitrary surrounding half-tapes `l` and `r`. -/ +def WordExit (M : Machine Γ Λ) (qOf : ℕ → Λ) + (u : List Γ) (q : ℕ) (dir : Bool) (v : List Γ) (q' : ℕ) (dir' : Bool) (dt : ℕ) : Prop := + ∀ l r : ListBlank Γ, + let (l₁, r₁) := placeSide dir u l r + let (l₂, r₂) := placeSide (!dir') v l r + ReachesIn M dt (dirCfg qOf q dir l₁ r₁) (dirCfg qOf q' dir' l₂ r₂) + +/-- Local symbol-level finite-word zipper simulator. -/ +def simWord (stepCode : ℕ → Γ → Option (Γ × Bool × ℕ)) : + ℕ → ℕ → Bool → List Γ → List Γ → ℕ → Option (List Γ × ℕ × Bool × ℕ) + | 0, _, _, _, _, _ => none + | _ + 1, q, true, lw, [], dt => + withNat q fun q' ↦ withNat dt fun d ↦ some (lw.reverse, q', true, d) + | fuel + 1, q, true, lw, a :: rw, dt => + match stepCode q a with + | none => none + | some (b, true, q') => + withNat (dt + 1) fun dt' ↦ simWord stepCode fuel q' true (b :: lw) rw dt' + | some (b, false, q') => + withNat (dt + 1) fun dt' ↦ simWord stepCode fuel q' false lw (b :: rw) dt' + | _ + 1, q, false, [], rw, dt => + withNat q fun q' ↦ withNat dt fun d ↦ some (rw, q', false, d) + | fuel + 1, q, false, a :: lw, rw, dt => + match stepCode q a with + | none => none + | some (b, true, q') => + withNat (dt + 1) fun dt' ↦ simWord stepCode fuel q' true (b :: lw) rw dt' + | some (b, false, q') => + withNat (dt + 1) fun dt' ↦ simWord stepCode fuel q' false lw (b :: rw) dt' + +/-- Run `simWord` on spatial word `u` from state `q` and entry direction `dir`. -/ +def runWordExit (stepCode : ℕ → Γ → Option (Γ × Bool × ℕ)) (fuel : ℕ) + (u : List Γ) (q : ℕ) (dir : Bool) : Option (List Γ × ℕ × Bool × ℕ) := + if dir then simWord stepCode fuel q true [] u 0 + else simWord stepCode fuel q false u.reverse [] 0 + +private theorem simWord_sound_aux {M : Machine Γ Λ} {qOf : ℕ → Λ} + {stepCode : ℕ → Γ → Option (Γ × Bool × ℕ)} (hag : StepCodeAgrees M qOf stepCode) : + ∀ (fuel q : ℕ) (dir : Bool) (lw rw : List Γ) (dt : ℕ) + (v : List Γ) (q' : ℕ) (dir' : Bool) (dtOut : ℕ) (l r : ListBlank Γ), + simWord stepCode fuel q dir lw rw dt = some (v, q', dir', dtOut) → + dt ≤ dtOut ∧ + let (l₂, r₂) := placeSide (!dir') v l r + ReachesIn M (dtOut - dt) + (dirCfg qOf q dir (ListBlank.append lw l) (ListBlank.append rw r)) + (dirCfg qOf q' dir' l₂ r₂) + | 0, _, _, _, _, _, _, _, _, _, _, _, h => by simp [simWord] at h + | _ + 1, q, true, lw, [], dt, v, q', dir', dtOut, l, r, h => by + simp only [simWord, withNat_eq, Option.some.injEq, Prod.mk.injEq] at h + rcases h with ⟨rfl, rfl, rfl, rfl⟩ + refine ⟨Nat.le_refl dt, ?_⟩ + simp [placeSide, List.reverse_reverse] + | fuel + 1, q, true, lw, a :: rw, dt, v, q', dir', dtOut, l, r, h => by + simp only [simWord, withNat_eq] at h + rcases hsc : stepCode q a with _ | ⟨b, dNext, qNext⟩ + · simp [hsc] at h + · rw [hsc] at h + cases dNext + · simp only at h + obtain ⟨hle, hreach⟩ := + simWord_sound_aux hag fuel qNext false lw (b :: rw) (dt + 1) v q' dir' dtOut l r h + have hstep := step_headRight_left (hag q a b false qNext hsc) + (ListBlank.append lw l) (ListBlank.append rw r) + refine ⟨by omega, ?_⟩ + have hsub : dtOut - dt = (dtOut - (dt + 1)) + 1 := by omega + rw [hsub] + exact ReachesIn.step_left hstep hreach + · simp only at h + obtain ⟨hle, hreach⟩ := + simWord_sound_aux hag fuel qNext true (b :: lw) rw (dt + 1) v q' dir' dtOut l r h + have hstep := step_headRight_right (hag q a b true qNext hsc) + (ListBlank.append lw l) (ListBlank.append rw r) + refine ⟨by omega, ?_⟩ + have hsub : dtOut - dt = (dtOut - (dt + 1)) + 1 := by omega + rw [hsub] + exact ReachesIn.step_left hstep hreach + | _ + 1, q, false, [], rw, dt, v, q', dir', dtOut, l, r, h => by + simp only [simWord, withNat_eq, Option.some.injEq, Prod.mk.injEq] at h + rcases h with ⟨rfl, rfl, rfl, rfl⟩ + refine ⟨Nat.le_refl dt, ?_⟩ + simp [placeSide] + | fuel + 1, q, false, a :: lw, rw, dt, v, q', dir', dtOut, l, r, h => by + simp only [simWord, withNat_eq] at h + rcases hsc : stepCode q a with _ | ⟨b, dNext, qNext⟩ + · simp [hsc] at h + · rw [hsc] at h + cases dNext + · simp only at h + obtain ⟨hle, hreach⟩ := + simWord_sound_aux hag fuel qNext false lw (b :: rw) (dt + 1) v q' dir' dtOut l r h + have hstep := step_headLeft_left (hag q a b false qNext hsc) + (ListBlank.append lw l) (ListBlank.append rw r) + refine ⟨by omega, ?_⟩ + have hsub : dtOut - dt = (dtOut - (dt + 1)) + 1 := by omega + rw [hsub] + exact ReachesIn.step_left hstep hreach + · simp only at h + obtain ⟨hle, hreach⟩ := + simWord_sound_aux hag fuel qNext true (b :: lw) rw (dt + 1) v q' dir' dtOut l r h + have hstep := step_headLeft_right (hag q a b true qNext hsc) + (ListBlank.append lw l) (ListBlank.append rw r) + refine ⟨by omega, ?_⟩ + have hsub : dtOut - dt = (dtOut - (dt + 1)) + 1 := by omega + rw [hsub] + exact ReachesIn.step_left hstep hreach + +/-- Soundness of `runWordExit`: a successful finite-word zipper run establishes `WordExit`. -/ +theorem runWordExit_sound {M : Machine Γ Λ} {qOf : ℕ → Λ} + {stepCode : ℕ → Γ → Option (Γ × Bool × ℕ)} (hag : StepCodeAgrees M qOf stepCode) + {fuel : ℕ} {u : List Γ} {q : ℕ} {dir : Bool} + {v : List Γ} {q' : ℕ} {dir' : Bool} {dt : ℕ} + (h : runWordExit stepCode fuel u q dir = some (v, q', dir', dt)) : + WordExit M qOf u q dir v q' dir' dt := by + intro l r + unfold runWordExit at h + cases dir + · simp only [Bool.false_eq_true, ↓reduceIte] at h + simpa [placeSide] using (simWord_sound_aux hag fuel q false u.reverse [] 0 v q' dir' dt l r h).2 + · simp only [↓reduceIte] at h + simpa [placeSide] using (simWord_sound_aux hag fuel q true [] u 0 v q' dir' dt l r h).2 + +/-- Homogeneous `k`-copy sweep: if `(u, q, dir)` exits in the same state and direction `(q, dir)` +leaving `v` in `dt` steps, then `u ^ k` exits in `(q, dir)` leaving `v ^ k` in `dt * k` steps. -/ +theorem sweepWord_sound {M : Machine Γ Λ} {qOf : ℕ → Λ} + {u v : List Γ} {q : ℕ} {dir : Bool} {dt : ℕ} + (hex : WordExit M qOf u q dir v q dir dt) (k : ℕ) : + WordExit M qOf (u ^ k) q dir (v ^ k) q dir (dt * k) := by + induction k with + | zero => + intro l r + simp [placeSide] + | succ k ih => + intro l r + cases dir + · simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_false] + rw [list_pow_succ' u k, List.reverse_append, ListBlank.append_assoc, + list_pow_succ' v k, ListBlank.append_assoc] + have h1 := hex (ListBlank.append (u ^ k).reverse l) r + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_false] at h1 + have h2 := ih l (ListBlank.append v r) + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_false] at h2 + have htr := h1.trans h2 + have hdt : dt + dt * k = dt * (k + 1) := by rw [Nat.mul_succ, Nat.add_comm] + rwa [hdt] at htr + · simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_true] + rw [list_pow_succ u k, ListBlank.append_assoc, + list_pow_succ v k, List.reverse_append, ListBlank.append_assoc] + have h1 := hex l (ListBlank.append (u ^ k) r) + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_true] at h1 + have h2 := ih (ListBlank.append v.reverse l) r + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_true] at h2 + have htr := h1.trans h2 + have hdt : dt + dt * k = dt * (k + 1) := by rw [Nat.mul_succ, Nat.add_comm] + rwa [hdt] at htr + +/-! ## Composite Subword Zipper (`simSubwords`) -/ + +/-- Soundness predicate for a base-word exit function `(q, dir, s) ↦ (s', q', dir', dt)`. -/ +def BaseExitSound (M : Machine Γ Λ) (qOf : ℕ → Λ) (baseWord : ℕ → List Γ) + (baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)) : Prop := + ∀ q dir s s' q' dir' dt, + baseExit q dir s = some (s', q', dir', dt) → + WordExit M qOf (baseWord s) q dir (baseWord s') q' dir' dt + +/-- Subword-level local zipper simulator over a verified `baseExit` table. -/ +def simSubwords (baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)) : + ℕ → ℕ → Bool → List ℕ → List ℕ → ℕ → Option (List ℕ × ℕ × Bool × ℕ) + | 0, _, _, _, _, _ => none + | _ + 1, q, true, lw, [], dt => + withNat q fun q' ↦ withNat dt fun d ↦ some (lw.reverse, q', true, d) + | fuel + 1, q, true, lw, a :: rw, dt => + match baseExit q true a with + | none => none + | some (s', q', dir', exDt) => + withNat (dt + exDt) fun dt' ↦ + if dir' then simSubwords baseExit fuel q' true (s' :: lw) rw dt' + else simSubwords baseExit fuel q' false lw (s' :: rw) dt' + | _ + 1, q, false, [], rw, dt => + withNat q fun q' ↦ withNat dt fun d ↦ some (rw, q', false, d) + | fuel + 1, q, false, a :: lw, rw, dt => + match baseExit q false a with + | none => none + | some (s', q', dir', exDt) => + withNat (dt + exDt) fun dt' ↦ + if dir' then simSubwords baseExit fuel q' true (s' :: lw) rw dt' + else simSubwords baseExit fuel q' false lw (s' :: rw) dt' + +/-- Compute the composite exit of subword list `u` from `(q, dir)` using `baseExit`. -/ +def runCompositeExit (baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)) + (u : List ℕ) (q : ℕ) (dir : Bool) : Option (List ℕ × ℕ × Bool × ℕ) := + withNat (u.length * 16 + 16) fun fuel ↦ + if dir then simSubwords baseExit fuel q true [] u 0 + else simSubwords baseExit fuel q false u.reverse [] 0 + +private def leftSubTape (baseWord : ℕ → List Γ) : List ℕ → ListBlank Γ → ListBlank Γ + | [], l => l + | s :: lw, l => ListBlank.append (baseWord s).reverse (leftSubTape baseWord lw l) + +private def rightSubTape (baseWord : ℕ → List Γ) : List ℕ → ListBlank Γ → ListBlank Γ + | [], r => r + | s :: rw, r => ListBlank.append (baseWord s) (rightSubTape baseWord rw r) + +private theorem rightSubTape_eq (baseWord : ℕ → List Γ) (rw : List ℕ) (r : ListBlank Γ) : + rightSubTape baseWord rw r = ListBlank.append (concatSubwords baseWord rw) r := by + induction rw with + | nil => rfl + | cons s rw ih => + simp [rightSubTape, concatSubwords, ih, ListBlank.append_assoc] + +private theorem leftSubTape_append (baseWord : ℕ → List Γ) (xs ys : List ℕ) (l : ListBlank Γ) : + leftSubTape baseWord (xs ++ ys) l = leftSubTape baseWord xs (leftSubTape baseWord ys l) := by + induction xs with + | nil => rfl + | cons x xs ih => simp [leftSubTape, ih] + +private theorem leftSubTape_reverse_eq (baseWord : ℕ → List Γ) (u : List ℕ) (l : ListBlank Γ) : + leftSubTape baseWord u.reverse l = + ListBlank.append (concatSubwords baseWord u).reverse l := by + induction u generalizing l with + | nil => rfl + | cons s u ih => + simp only [List.reverse_cons, leftSubTape_append, leftSubTape, concatSubwords, + List.reverse_append, ListBlank.append_assoc] + rw [ih] + +private theorem leftSubTape_eq (baseWord : ℕ → List Γ) (lw : List ℕ) (l : ListBlank Γ) : + leftSubTape baseWord lw l = + ListBlank.append (concatSubwords baseWord lw.reverse).reverse l := by + simpa using leftSubTape_reverse_eq baseWord lw.reverse l + +private theorem simSubwords_sound_aux {M : Machine Γ Λ} {qOf : ℕ → Λ} {baseWord : ℕ → List Γ} + {baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)} + (hbase : BaseExitSound M qOf baseWord baseExit) : + ∀ (fuel q : ℕ) (dir : Bool) (lw rw : List ℕ) (dt : ℕ) + (v : List ℕ) (q' : ℕ) (dir' : Bool) (dtOut : ℕ) (l r : ListBlank Γ), + simSubwords baseExit fuel q dir lw rw dt = some (v, q', dir', dtOut) → + dt ≤ dtOut ∧ + let (l₂, r₂) := placeSide (!dir') (concatSubwords baseWord v) l r + ReachesIn M (dtOut - dt) + (dirCfg qOf q dir (leftSubTape baseWord lw l) (rightSubTape baseWord rw r)) + (dirCfg qOf q' dir' l₂ r₂) + | 0, _, _, _, _, _, _, _, _, _, _, _, h => by simp [simSubwords] at h + | _ + 1, q, true, lw, [], dt, v, q', dir', dtOut, l, r, h => by + simp only [simSubwords, withNat_eq, Option.some.injEq, Prod.mk.injEq] at h + rcases h with ⟨rfl, rfl, rfl, rfl⟩ + refine ⟨Nat.le_refl dt, ?_⟩ + simp [placeSide, leftSubTape_eq, rightSubTape] + | fuel + 1, q, true, lw, a :: rw, dt, v, q', dir', dtOut, l, r, h => by + simp only [simSubwords, withNat_eq] at h + rcases hb : baseExit q true a with _ | ⟨s', qNext, dNext, exDt⟩ + · simp [hb] at h + · rw [hb] at h + have hex := hbase q true a s' qNext dNext exDt hb + (leftSubTape baseWord lw l) (rightSubTape baseWord rw r) + cases dNext + · simp only [Bool.false_eq_true, ↓reduceIte] at h + simp only [placeSide, ↓reduceIte, Bool.not_false] at hex + obtain ⟨hle, hreach⟩ := + simSubwords_sound_aux hbase fuel qNext false lw (s' :: rw) (dt + exDt) v q' dir' dtOut + l r h + refine ⟨by omega, ?_⟩ + have hsub : dtOut - dt = exDt + (dtOut - (dt + exDt)) := by omega + rw [hsub] + exact hex.trans hreach + · simp only [↓reduceIte] at h + simp only [placeSide, ↓reduceIte, Bool.not_true] at hex + obtain ⟨hle, hreach⟩ := + simSubwords_sound_aux hbase fuel qNext true (s' :: lw) rw (dt + exDt) v q' dir' dtOut + l r h + refine ⟨by omega, ?_⟩ + have hsub : dtOut - dt = exDt + (dtOut - (dt + exDt)) := by omega + rw [hsub] + exact hex.trans hreach + | _ + 1, q, false, [], rw, dt, v, q', dir', dtOut, l, r, h => by + simp only [simSubwords, withNat_eq, Option.some.injEq, Prod.mk.injEq] at h + rcases h with ⟨rfl, rfl, rfl, rfl⟩ + refine ⟨Nat.le_refl dt, ?_⟩ + simp [placeSide, leftSubTape, rightSubTape_eq] + | fuel + 1, q, false, a :: lw, rw, dt, v, q', dir', dtOut, l, r, h => by + simp only [simSubwords, withNat_eq] at h + rcases hb : baseExit q false a with _ | ⟨s', qNext, dNext, exDt⟩ + · simp [hb] at h + · rw [hb] at h + have hex := hbase q false a s' qNext dNext exDt hb + (leftSubTape baseWord lw l) (rightSubTape baseWord rw r) + cases dNext + · simp only [Bool.false_eq_true, ↓reduceIte] at h + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_false] at hex + obtain ⟨hle, hreach⟩ := + simSubwords_sound_aux hbase fuel qNext false lw (s' :: rw) (dt + exDt) v q' dir' dtOut + l r h + refine ⟨by omega, ?_⟩ + have hsub : dtOut - dt = exDt + (dtOut - (dt + exDt)) := by omega + rw [hsub] + exact hex.trans hreach + · simp only [↓reduceIte] at h + simp only [placeSide, Bool.false_eq_true, ↓reduceIte, Bool.not_true] at hex + obtain ⟨hle, hreach⟩ := + simSubwords_sound_aux hbase fuel qNext true (s' :: lw) rw (dt + exDt) v q' dir' dtOut + l r h + refine ⟨by omega, ?_⟩ + have hsub : dtOut - dt = exDt + (dtOut - (dt + exDt)) := by omega + rw [hsub] + exact hex.trans hreach + +/-- Soundness of `runCompositeExit`: lifts base-word exits to composite subword exits. -/ +theorem runCompositeExit_sound {M : Machine Γ Λ} {qOf : ℕ → Λ} {baseWord : ℕ → List Γ} + {baseExit : ℕ → Bool → ℕ → Option (ℕ × ℕ × Bool × ℕ)} + (hbase : BaseExitSound M qOf baseWord baseExit) + {u : List ℕ} {q : ℕ} {dir : Bool} {v : List ℕ} {q' : ℕ} {dir' : Bool} {dt : ℕ} + (h : runCompositeExit baseExit u q dir = some (v, q', dir', dt)) : + WordExit M qOf (concatSubwords baseWord u) q dir (concatSubwords baseWord v) q' dir' dt := by + intro l r + unfold runCompositeExit at h + rw [withNat_eq] at h + cases dir + · simp only [Bool.false_eq_true, ↓reduceIte] at h + have ⟨_, hr⟩ := simSubwords_sound_aux hbase (u.length * 16 + 16) q false u.reverse [] 0 + v q' dir' dt l r h + simpa [placeSide, leftSubTape_reverse_eq, rightSubTape] using hr + · simp only [↓reduceIte] at h + have ⟨_, hr⟩ := simSubwords_sound_aux hbase (u.length * 16 + 16) q true [] u 0 + v q' dir' dt l r h + simpa [placeSide, leftSubTape, rightSubTape_eq] using hr + +/-! ## Concrete RLE Stack Configurations and Multi-Step Reachability -/ + +/-- A concrete run of `count` copies of vocabulary word `sym` (`sym = 0` denotes the blank word). -/ +structure Run where + /-- Vocabulary index of the repeated spatial word. -/ + sym : ℕ + /-- Repetition count (`count ≥ 1` in normalized stacks). -/ + count : ℕ + deriving DecidableEq, Inhabited + +/-- Concrete RLE configuration with head state `q`, direction `dir`, and RLE half-tape stacks. -/ +structure EntryCfg where + /-- Current state index. -/ + q : ℕ + /-- Head direction (`true` = right, `false` = left). -/ + dir : Bool + /-- Left half-tape stack (nearest-to-head run first). -/ + left : List Run + /-- Right half-tape stack (nearest-to-head run first). -/ + right : List Run + deriving DecidableEq, Inhabited + +/-- Push `count ≥ 1` copies of `sym` onto `stk`, suppressing leading blank runs (`sym = 0` on `[]`) +and merging adjacent runs of the same word. -/ +@[inline] +def pushLit (sym count : ℕ) : List Run → List Run + | [] => if Nat.beq sym 0 then [] else [⟨sym, count⟩] + | ⟨ts, tc⟩ :: rest => + if Nat.beq ts sym then withNat (tc + count) fun c ↦ ⟨ts, c⟩ :: rest + else ⟨sym, count⟩ :: ⟨ts, tc⟩ :: rest + +/-- Safe push handling `count = 0` as a no-op. -/ +def pushRun (sym count : ℕ) (stk : List Run) : List Run := + if Nat.beq count 0 then stk else pushLit sym count stk + +/-- Push a spatial left-to-right list of `(sym, count)` runs onto a left RLE stack so the last pair +in the list sits closest to the head. -/ +def pushRunsLeft : List (ℕ × ℕ) → List Run → List Run + | [], stk => stk + | (s, n) :: rest, stk => pushRunsLeft rest (pushRun s n stk) + +/-- Evaluate an RLE stack on side `side` (`true` = right stack using `wordOf w ^ c`, `false` = left +stack using `(wordOf w).reverse ^ c`). -/ +def evalSide (side : Bool) (wordOf : ℕ → List Γ) : List Run → ListBlank Γ + | [] => default + | ⟨w, c⟩ :: rest => + if side then ListBlank.append (wordOf w ^ c) (evalSide true wordOf rest) + else ListBlank.append ((wordOf w).reverse ^ c) (evalSide false wordOf rest) + +/-- Evaluate a concrete `EntryCfg` into a `BusyBeaver.Cfg Γ Λ`. -/ +def evalEntryCfg (qOf : ℕ → Λ) (wordOf : ℕ → List Γ) (c : EntryCfg) : Cfg Γ Λ := + dirCfg qOf c.q c.dir (evalSide false wordOf c.left) (evalSide true wordOf c.right) + +/-- Soundness of `pushLit` when `wordOf 0` consists solely of blank symbols (`default`). -/ +theorem evalSide_pushLit {wordOf : ℕ → List Γ} (hz : ∀ x ∈ wordOf 0, x = default) + (side : Bool) (sym count : ℕ) (stk : List Run) : + evalSide side wordOf (pushLit sym count stk) = + if side then ListBlank.append (wordOf sym ^ count) (evalSide true wordOf stk) + else ListBlank.append ((wordOf sym).reverse ^ count) (evalSide false wordOf stk) := by + have hzRev : ∀ x ∈ (wordOf 0).reverse, x = default := by + intro x hx; exact hz x (List.mem_reverse.mp hx) + cases stk with + | nil => + simp only [pushLit] + by_cases hs : Nat.beq sym 0 = true + · have h0 : sym = 0 := Nat.eq_of_beq_eq_true hs + subst h0 + cases side <;> simp [evalSide, lb_blank_pow _ hz, lb_blank_pow _ hzRev] + · have hne : Nat.beq sym 0 = false := Bool.eq_false_iff.mpr hs + rw [hne] + cases side <;> rfl + | cons top rest => + rcases top with ⟨ts, tc⟩ + simp only [pushLit] + by_cases hs : Nat.beq ts sym = true + · have heq : ts = sym := Nat.eq_of_beq_eq_true hs + subst heq + simp only [hs, ↓reduceIte, withNat_eq] + cases side <;> + simp [evalSide, ListBlank.append_append, ← list_pow_add, Nat.add_comm] + · have hne : Nat.beq ts sym = false := Bool.eq_false_iff.mpr hs + rw [hne] + cases side <;> rfl + +theorem evalSide_pushRun {wordOf : ℕ → List Γ} (hz : ∀ x ∈ wordOf 0, x = default) + (side : Bool) (sym count : ℕ) (stk : List Run) : + evalSide side wordOf (pushRun sym count stk) = + if side then ListBlank.append (wordOf sym ^ count) (evalSide true wordOf stk) + else ListBlank.append ((wordOf sym).reverse ^ count) (evalSide false wordOf stk) := by + unfold pushRun + by_cases hc : Nat.beq count 0 = true + · have h0 : count = 0 := Nat.eq_of_beq_eq_true hc + subst h0 + cases side <;> simp + · have hne : Nat.beq count 0 = false := Bool.eq_false_iff.mpr hc + rw [hne] + exact evalSide_pushLit hz side sym count stk + +/-- Soundness predicate for a single-step concrete RLE transition function `stepFn`. -/ +def StepFnSound (M : Machine Γ Λ) (qOf : ℕ → Λ) (wordOf : ℕ → List Γ) + (stepFn : ℕ → Bool → List Run → List Run → Option (ℕ × EntryCfg)) : Prop := + ∀ q dir l r dt c', + stepFn q dir l r = some (dt, c') → + ReachesIn M dt (evalEntryCfg qOf wordOf ⟨q, dir, l, r⟩) (evalEntryCfg qOf wordOf c') + +/-- Execute exactly `fuel` accelerated RLE steps using `stepFn`, accumulating exact TM steps. -/ +def runExact (stepFn : ℕ → Bool → List Run → List Run → Option (ℕ × EntryCfg)) : + ℕ → ℕ → EntryCfg → Option (ℕ × EntryCfg) + | 0, acc, c => some (acc, c) + | fuel + 1, acc, ⟨q, dir, l, r⟩ => + match stepFn q dir l r with + | none => none + | some (dt, c') => withNat (acc + dt) fun acc' ↦ runExact stepFn fuel acc' c' + +/-- Boolean check that `runExact stepFn fuel 0 c` yields `(expDt, expC)`. -/ +def checkRunExact (stepFn : ℕ → Bool → List Run → List Run → Option (ℕ × EntryCfg)) + (fuel expDt : ℕ) (c expC : EntryCfg) : Bool := + match runExact stepFn fuel 0 c with + | none => false + | some (dt, c') => Nat.beq dt expDt && (c' == expC) + +private theorem runExact_sound_aux {M : Machine Γ Λ} {qOf : ℕ → Λ} {wordOf : ℕ → List Γ} + {stepFn : ℕ → Bool → List Run → List Run → Option (ℕ × EntryCfg)} + (hs : StepFnSound M qOf wordOf stepFn) : + ∀ (fuel acc : ℕ) (c : EntryCfg) (accOut : ℕ) (cOut : EntryCfg), + runExact stepFn fuel acc c = some (accOut, cOut) → + acc ≤ accOut ∧ + ReachesIn M (accOut - acc) (evalEntryCfg qOf wordOf c) (evalEntryCfg qOf wordOf cOut) + | 0, acc, c, accOut, cOut, h => by + simp only [runExact, Option.some.injEq, Prod.mk.injEq] at h + rcases h with ⟨rfl, rfl⟩ + exact ⟨Nat.le_refl acc, by simp⟩ + | fuel + 1, acc, ⟨q, dir, l, r⟩, accOut, cOut, h => by + simp only [runExact] at h + rcases hst : stepFn q dir l r with _ | ⟨dt, c'⟩ + · simp [hst] at h + · rw [hst] at h + simp only [withNat_eq] at h + obtain ⟨hle, hrest⟩ := runExact_sound_aux hs fuel (acc + dt) c' accOut cOut h + have h1 := hs q dir l r dt c' hst + refine ⟨by omega, ?_⟩ + have hsub : accOut - acc = dt + (accOut - (acc + dt)) := by omega + rw [hsub] + exact h1.trans hrest + +/-- Inductive certificate tree chaining kernel-checked `checkRunExact` chunks with `O(1)` proof +composition. -/ +inductive EntryReaches (stepFn : ℕ → Bool → List Run → List Run → Option (ℕ × EntryCfg)) : + ℕ → EntryCfg → EntryCfg → Prop where + /-- Zero-step reflexive reachability. -/ + | refl (c : EntryCfg) : EntryReaches stepFn 0 c c + /-- Single kernel-checked `fuel`-loop chunk. -/ + | chunk {fuel dt : ℕ} {c c' : EntryCfg} : + checkRunExact stepFn fuel dt c c' = true → + EntryReaches stepFn dt c c' + /-- Transitive composition of two chunks. -/ + | trans {d₁ d₂ : ℕ} {c₁ c₂ c₃ : EntryCfg} : + EntryReaches stepFn d₁ c₁ c₂ → EntryReaches stepFn d₂ c₂ c₃ → + EntryReaches stepFn (d₁ + d₂) c₁ c₃ + +/-- Cast the accumulated step sum `d₁` to a normalized `ℕ` literal `d₂` via `Nat.beq`. -/ +theorem EntryReaches.cast_dt {stepFn : ℕ → Bool → List Run → List Run → Option (ℕ × EntryCfg)} + {d₁ d₂ : ℕ} {c₁ c₂ : EntryCfg} + (h : EntryReaches stepFn d₁ c₁ c₂) (heq : Nat.beq d₁ d₂ = true) : + EntryReaches stepFn d₂ c₁ c₂ := by + have hd : d₁ = d₂ := Nat.eq_of_beq_eq_true heq + exact hd ▸ h + +/-- Boolean check that `(d₁, c₁, c₂)` matches target `(d₂, c₁', c₂')`. -/ +def checkEntryEnds (d₁ d₂ : ℕ) (c₁ c₁' c₂ c₂' : EntryCfg) : Bool := + Nat.beq d₁ d₂ && (c₁ == c₁') && (c₂ == c₂') + +/-- Cast `(d₁, c₁, c₂)` to target expressions `(d₂, c₁', c₂')` via a kernel-checked `Bool` +certificate, avoiding elaborator `isDefEq` unfolding on large closed-form milestones. -/ +theorem EntryReaches.cast_ends {stepFn : ℕ → Bool → List Run → List Run → Option (ℕ × EntryCfg)} + {d₁ d₂ : ℕ} {c₁ c₁' c₂ c₂' : EntryCfg} + (h : EntryReaches stepFn d₁ c₁ c₂) + (heq : checkEntryEnds d₁ d₂ c₁ c₁' c₂ c₂' = true) : + EntryReaches stepFn d₂ c₁' c₂' := by + unfold checkEntryEnds at heq + simp only [Bool.and_eq_true] at heq + have hd : d₁ = d₂ := Nat.eq_of_beq_eq_true heq.1.1 + have hc1 : c₁ = c₁' := eq_of_beq heq.1.2 + have hc2 : c₂ = c₂' := eq_of_beq heq.2 + subst hd; subst hc1; subst hc2 + exact h + +/-- Soundness of `EntryReaches`: translates any `EntryReaches` derivation into `ReachesIn M`. -/ +theorem EntryReaches.sound {M : Machine Γ Λ} {qOf : ℕ → Λ} {wordOf : ℕ → List Γ} + {stepFn : ℕ → Bool → List Run → List Run → Option (ℕ × EntryCfg)} + (hs : StepFnSound M qOf wordOf stepFn) {dt : ℕ} {c₁ c₂ : EntryCfg} + (h : EntryReaches stepFn dt c₁ c₂) : + ReachesIn M dt (evalEntryCfg qOf wordOf c₁) (evalEntryCfg qOf wordOf c₂) := by + induction h with + | refl c => exact ReachesIn.zero M _ + | @chunk fuel d c c' hc => + unfold checkRunExact at hc + rcases hr : runExact stepFn fuel 0 c with _ | ⟨dOut, cOut⟩ + · simp [hr] at hc + · rw [hr] at hc + simp only [Bool.and_eq_true] at hc + have hd : dOut = d := Nat.eq_of_beq_eq_true hc.1 + have hcEq : cOut = c' := eq_of_beq hc.2 + subst hd + subst hcEq + simpa using (runExact_sound_aux hs fuel 0 c dOut cOut hr).2 + | trans _ _ ih₁ ih₂ => exact ih₁.trans ih₂ + +end WordSemantics + +end BusyBeaver.WordRLE + +end diff --git a/BusyBeaverChallenge.lean b/BusyBeaverChallenge.lean index 28649b8b..ecece41c 100644 --- a/BusyBeaverChallenge.lean +++ b/BusyBeaverChallenge.lean @@ -9185,3 +9185,14 @@ theorem isHalt_iff_acceleration : IsHalt target ↔ CollatzHalts next start := b end M_1RBHHH_1LC0RF_0RA0LD_1LE1LA_1RF0LF_0LC0RA end BusyBeaver + +namespace BusyBeaver.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH + +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LB---" + +abbrev target : Machine (Fin 2) (Fin 6) := machine.toBB + +theorem is_not_halt : IsNotHalt target := by sorry + +end BusyBeaver.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH diff --git a/README.md b/README.md index 54839741..49b77c5c 100644 --- a/README.md +++ b/README.md @@ -10,7 +10,7 @@ This repository contains two Lean 4 (`v4.35.0-rc4`) formalization libraries for | Library | Scope | Key Results | Documentation | | :--- | :--- | :--- | :--- | | [`Cryptids/`](Cryptids/) | `(Q, 2)` Turing machines for Goldbach, ZF consistency, and the Riemann Hypothesis | Certified state reductions (`25 → 21`, `393 → 380`, `120 → 104 → 95`) and end-to-end halting equivalences (`Halts M ↔ ¬ GoldbachConjecture`, `ZFInconsistent`, `¬ RiemannHypothesis`) | [`Cryptids/README.md`](Cryptids/README.md), [`Cryptids/Semantics/README.md`](Cryptids/Semantics/README.md) | -| [`BusyBeaver/`](BusyBeaver/) | `BB(6)` `(6, 2)` and `BB(3, 3)` `(3, 3)` holdout Turing machines (some are potential Cryptids, subject to community acceptance) | Shared execution semantics (`BusyBeaver/Defs.lean`), foundational lemmas (`BusyBeaver/Basic.lean`), RLE loader and `ConjectureMachines` bridge (`BusyBeaver/Bridge.lean`), and certified behavioral proofs in [`BusyBeaver/BB6/`](BusyBeaver/BB6/README.md) (53 closed-pattern holdouts + 29 [`Accelerations/`](BusyBeaver/BB6/Accelerations/README.md)) and [`BusyBeaver/BB33/`](BusyBeaver/BB33/README.md) (6 machines) | [`BusyBeaver/README.md`](BusyBeaver/README.md), [`BusyBeaver/BB6/README.md`](BusyBeaver/BB6/README.md), [`BusyBeaver/BB6/Accelerations/README.md`](BusyBeaver/BB6/Accelerations/README.md), [`BusyBeaver/BB33/README.md`](BusyBeaver/BB33/README.md) | +| [`BusyBeaver/`](BusyBeaver/) | `BB(6)` `(6, 2)` and `BB(3, 3)` `(3, 3)` holdout Turing machines (some are potential Cryptids, subject to community acceptance) | Shared execution semantics (`BusyBeaver/Defs.lean`), foundational lemmas (`BusyBeaver/Basic.lean`), RLE loader and `ConjectureMachines` bridge (`BusyBeaver/Bridge.lean`), and certified behavioral proofs in [`BusyBeaver/BB6/`](BusyBeaver/BB6/README.md) (the [A6 nonhalting certificate](artifacts/a6/README.md) + 53 closed-pattern holdouts + 29 [`Accelerations/`](BusyBeaver/BB6/Accelerations/README.md)) and [`BusyBeaver/BB33/`](BusyBeaver/BB33/README.md) (6 machines) | [`BusyBeaver/README.md`](BusyBeaver/README.md), [`BusyBeaver/BB6/README.md`](BusyBeaver/BB6/README.md), [`BusyBeaver/BB6/Accelerations/README.md`](BusyBeaver/BB6/Accelerations/README.md), [`BusyBeaver/BB33/README.md`](BusyBeaver/BB33/README.md) | All Lean 4 proofs are checked by the kernel without `sorry` and depend only on standard Lean axioms: - **Constructive (`["propext", "Quot.sound"]`, no `Classical.choice`):** All ZF machine-to-proof-search equivalences (`halts_zf393_iff_zfInconsistent`, `Zf380.Semantics.halts_candidate_iff_zfInconsistent`, `halts_zf432_iff_wadeZFInconsistent`), first-order Peano Arithmetic (`PAProvable`) consistency and $\Sigma_1^0$ standard-model adequacy (`not_paProvable_false`, `paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent` in [`Cryptids/Semantics/PA/`](Cryptids/Semantics/PA/)), the direct simulation state reductions ([`Goldbach21.lean`](Cryptids/Goldbach21.lean), [`Zf380.lean`](Cryptids/Zf380.lean), [`Riemann104.lean`](Cryptids/Riemann104.lean)), and all four `candidate_fewer_states` theorems, audited in CI via [`comparator/constructive.json`](comparator/constructive.json). Because classical Lean (`ZFSet.{0}` in [`Soundness.lean`](Cryptids/Semantics/Zf/Soundness.lean)) proves `¬ ZFInconsistent`—so any non-halting machine would vacuously satisfy `Halts M ↔ ZFInconsistent` under `Classical.choice`—excluding `Classical.choice` blocks classical `Con(ZF)` shortcuts, while deeply embedded `PAProvable` provides a weak first-order metatheory strictly below `ZF` (see [Foundational Note on `Con(ZF)` and Constructive Equivalence](Cryptids/Semantics/README.md#foundational-note-conzf-in-lean-and-constructive-equivalence)). diff --git a/artifacts/a6/Audit.lean b/artifacts/a6/Audit.lean new file mode 100644 index 00000000..52be3596 --- /dev/null +++ b/artifacts/a6/Audit.lean @@ -0,0 +1,7 @@ +import BusyBeaver.BB6.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH + +#check BusyBeaver.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.is_not_halt +#print axioms BusyBeaver.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.is_not_halt +#print axioms BusyBeaver.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.not_halts +#print axioms BusyBeaver.BB6.A6.stepEntry_sound +#print axioms BusyBeaver.AffRLE.verifyReturnCert_sound diff --git a/artifacts/a6/PROOF.md b/artifacts/a6/PROOF.md new file mode 100644 index 00000000..cd686bed --- /dev/null +++ b/artifacts/a6/PROOF.md @@ -0,0 +1,350 @@ +# Nonhalting of the six state A6 machine + +## The machine and the theorem + +Consider a tape indexed by the integers, with symbols 0 and 1. A configuration +consists of a control state, a head position, and a tape. One step reads the +scanned symbol, writes a symbol, moves the head one cell, and changes state +according to the following table. + +| State | Read 0 | Read 1 | +| --- | --- | --- | +| A | Write 1, move right, enter B | Write 0, move left, enter F | +| B | Write 1, move right, enter C | Write 0, move right, enter A | +| C | Write 1, move left, enter D | Write 0, move right, enter B | +| D | Write 0, move left, enter E | Write 0, move left, enter C | +| E | Write 0, move left, enter A | Write 0, move left, enter C | +| F | Write 0, move left, enter B | Halt | + +In standard machine notation this is + +```text +1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LB--- +``` + +The initial state is A, the initial head position is 0, and every tape cell +initially contains 0. Halting means reaching the undefined F/1 instruction. +The name **A6** is a local label for this exact machine. + +**Theorem.** The execution from the initial configuration never halts. + +The proof has two parts. A finite, compressed execution reaches a particular +configuration in an infinite family. Every member of that family then runs +for a positive number of steps to the next member. All compressed execution +rules are proved sound for the literal machine above. The complete finite +certificates and their checks are included as Lean source. + +## An exact family of configurations + +Use the two-bit words + +```text +X = 10 Y = 01 Z = 00 +``` + +and write juxtaposition for concatenation and `w^r` for `r` copies of a word +`w`. A zero exponent denotes the empty word. Fix, throughout this proof, + +```text +N = 791761176. +``` + +Define the finite words + +```text +U = X Y Z X^8 Z X^5 Y^11 Z +P = X^8 Y^10 Z +V = X^N Y^9 Z X^21 Y^41 Z X^15 Y^93 Z +Q = X^36 Y^17 Z X^91 Y^38 Z X^15 Y^93 Z +W = X^14 Z X^5 Z X. +``` + +For each natural number `n`, define `C(n)` by + +```text +C(n) = 0^infinity U P^n V Q^n W B> Y^6 0^infinity. +``` + +The marker `B>` says that the control state is B and the head scans the first +bit of the displayed `Y^6`. To specify absolute positions as well as the +word, put the head at + +$$h(n)=2N+103+522n.$$ + +The finite word to its left has `2N+466+624n` bits, so its first bit is at +`-363-102n`. Every cell outside the displayed finite word is zero. Thus +`C(n)` denotes one exact configuration, rather than a configuration only up +to translation. It contains `N+231+308n` ones. + +The formal proof establishes the following two claims. + +**Entry.** From blank tape the machine reaches `C(8)` after exactly + +```text +T8 = 752265440525431967 +``` + +literal steps. A prefix of the same certificate establishes that it reaches +`C(0)` after exactly + +```text +T0 = 752263008230408399 +``` + +steps. + +**Return.** For every natural number `n >= 8`, + +$$C(n)\ \xrightarrow{\;D(n)\;}\ C(n+1),\qquad +D(n)=304036458618+119808n.$$ + +The arrow means that every literal transition is defined and the final +configuration is exactly the one on its right. For reference, +`304036458618 = 384*N+167034`. The theorem fixes the displayed value of `N`. + +## Why entry and return imply nonhalting + +Set `F(k)=C(k+8)`. The return time for `F(k)` is + +$$R(k)=304037417082+119808k>0.$$ + +By induction on `k`, concatenate the entry path and the first `k` returns. +This gives a defined execution ending at `F(k)` at time + +$$S(k)=T8+304037417082k+59904k(k-1).$$ + +In particular, `S(k) >= T8+k`, so these execution lengths are unbounded. +For any requested finite time `t`, choose `k` with `S(k) >= t`. The prefix +of a defined execution of length `S(k)` is a defined execution of length +`t`. Therefore no finite time can be a halting time. + +This argument is formalized for arbitrary machines in +`BusyBeaver.AffRLE.isNotHalt_of_family` ([`AffRLE.lean`](../../BusyBeaver/AffRLE.lean)) +using `IsNotHalt.of_reachesPlus_invariant`, and instantiated for `A6` in +[`M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean`](../../BusyBeaver/BB6/M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean). In particular, +nonhalting follows from positive, universally proved return paths; it does +not require a finite simulation to continue indefinitely. + +It remains to justify the entry and return claims. The following sections +give the rules used in their certificates and explain how every rule +application is checked. + +## Finite word exits and their soundness + +Suppose a finite nonempty word `w` is entered from the left, with the head on +its first bit, or from the right, with the head on its last bit. Run the +literal transition table until the head leaves that word. A word-exit +certificate records: + +1. The input word, state, and entry side. +2. The replacement word, exit state, and exit side. +3. The exact number of literal steps. + +The certificate is valid precisely when a finite local interpreter computes +the stated replacement and exit. Every intermediate read stays within the +word; a local halt or a premature exit makes the claimed local run fail. +The finite interpreter preserves the word length. + +Because no exterior cell is read before exit, the same finite run is valid +inside any surrounding tape. The context lemma `runWordExit_sound` in +[`WordRLE.lean`](../../BusyBeaver/WordRLE.lean) proves this by induction on literal steps, +and `runCompositeExit_sound` lifts 2-bit base-word exits to arbitrary composite +words. + +If the exit has the same state and orientation as the entry, the rule can +be repeated over any number `r` of consecutive copies of `w`. Induction on +`r` gives the repeated exit, with time `r` times the one-word time +(`sweepWord_sound` in [`WordRLE.lean`](../../BusyBeaver/WordRLE.lean)). + +The compressed tape is stored directly as two `ListBlank`-backed stacks of +word/count pairs (`EntryCfg` for concrete runs and `AffCfg` for affine-exponent +runs), ordered nearest to the head first. Empty exterior stacks denote the +infinite blank half-tape `default : ListBlank (Fin 2)`. Merging equal adjacent +blocks or omitting exterior zero blocks leaves this denotation unchanged +(`evalSide_pushLit` in [`WordRLE.lean`](../../BusyBeaver/WordRLE.lean) and `pushAff_sound` +in [`AffRLE.lean`](../../BusyBeaver/AffRLE.lean)). + +The step-level soundness theorems (`EntryReaches.sound` in +[`WordRLE.lean`](../../BusyBeaver/WordRLE.lean) and `stepAffOnce_sound` in +[`AffRLE.lean`](../../BusyBeaver/AffRLE.lean)) establish exact `ReachesIn` derivations on +`BusyBeaver.Cfg (Fin 2) (Fin 6)` directly. + +## Transfer rules for reaching the family + +The finite entry path uses two additional rules to avoid expanding very +large counters. In the notation below, `q> w` scans the first bit of `w`, +and `q< w` scans its last bit. Define + +```text +MB(a,b) = H X^a Z X B> Y^b 0^infinity +MD(a,b) = H Y^a D< Z X^b 0^infinity. +``` + +For `MB`, the untouched prefix `H` ends in a nonempty run of `Z`. For `MD`, +it ends in a nonempty run of `X` or `Z`. These are exactly the forms needed +by the entry certificate. They also let the compressed representation merge +blocks correctly when the source counter becomes zero. + +For either form, whenever `a >= 2` and `b >= 0`, one transfer gives + +$$M(a,b)\ \xrightarrow{\;4b+18\;}\ M(a-2,b+3).$$ + +The following paths derive the rule directly from two-bit exits. A row +marked as a sweep repeats the indicated word exit the displayed number of +times; a zero-length sweep takes zero steps. + +| B transfer operation | Number of copies | Steps per copy | +| --- | ---: | ---: | +| B enters `Y` from the left, exits right in B with `X` | `b` | 2 | +| B enters `Z` from the left, exits left in C with `Y` | 1 | 3 | +| C enters `X` from the right, exits left in C with `Y` | `b+1` | 2 | +| C enters `Z` from the right, exits left in E with `Y` | 1 | 2 | +| E enters `X` from the right, exits left in F with `Z` | 1 | 2 | +| F enters `X` from the right, exits right in B with `Y` | 1 | 3 | +| B enters `Z` from the left, exits left in C with `Y` | 1 | 3 | +| C enters `Y` from the right, exits right in B with `Z` | 1 | 1 | +| B enters `Y` from the left, exits right in B with `X` | 1 | 2 | + +The two sweeps cost `2b` and `2(b+1)`; the other rows cost 16 in total. +The output is the same B frontier with two fewer source copies and three +additional destination copies. + +| D transfer operation | Number of copies | Steps per copy | +| --- | ---: | ---: | +| D enters `Z` from the right, exits left in A with `Z` | 1 | 2 | +| A enters `Y` from the right, exits left in B with `Z` | 1 | 2 | +| B enters `Y` from the right, exits right in A with `Z` | 1 | 1 | +| A enters `Z` from the left, exits right in C with `11` | 1 | 2 | +| C enters `Z` from the left, exits left in D with `X` | 1 | 1 | +| D enters `11` from the right, exits right in C with `Y` | 1 | 3 | +| C enters `X` from the left, exits right in C with `Y` | `b+1` | 2 | +| C enters `Z` from the left, exits left in D with `X` | 1 | 1 | +| D enters `Y` from the right, exits left in D with `X` | `b+2` | 2 | + +Here the sweeps cost `2(b+1)` and `2(b+2)` and the other rows cost 12. +The output is the corresponding D frontier. Both single-step transfers and +their `q`-fold quadratic batch iterations (`transferB_batch` and +`transferD_batch`, costing `4qb + 6q^2 + 12q` steps) are proved directly over +`ListBlank (Fin 2)` in [`Defs.lean`](../../BusyBeaver/BB6/A6/Defs.lean), where +`stepEntry_sound` validates the full input frontier before applying each batch. + +## The complete blank tape entry certificate + +The entry certificate starts with state A, left-facing orientation, and two +empty stacks, whose `evalEntryCfg` denotation equals `init []` via +`init_nil_eq_headLeft` ([`M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean`](../../BusyBeaver/BB6/M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean)). + +Each step of `stepEntry` executes either a 2-bit word exit, a homogeneous +sweep, or a certified B or D transfer batch. Strict `withNat` evaluation in +`WordRLE.runExact` sums exact step counts in binary without WHNF thunk +accumulation, and `ElabRLE.proveEntryPhase` slices the 166,491 compressed +steps across six milestone modules ([`Entry0.lean`](../../BusyBeaver/BB6/A6/Entry0.lean) +through [`Entry5.lean`](../../BusyBeaver/BB6/A6/Entry5.lean)): +`init [] → C(0) → C(3) → C(5) → C(6) → C(7) → C(8)`. + +Combining `entry_phase0` through `entry_phase5` in `entry_to_c8` yields the +exact time `T8` above, and `entryMilestone_eight_eq` connects `C(8)` to the +symbolic family start `familyCfg 0` without expanding `X^N`. + +## The universal return certificate + +For the return proof, write `n=k+8` with `k` an arbitrary natural number. +Counts in each compressed configuration are affine expressions in `k`. +The initial state is `C(k+8)`. The complete trace contains 9,844 ordinary +word operations and 67 repeated cycles, with 462 distinct finite word-exit +rules. Every finite rule is checked against the literal local machine. + +An ordinary operation is a universally quantified equality + +```lean +macro_i (k : Nat) : + applyExit (before_i k) exit_e (count_i k) = some (after_i k) +``` + +Its state, words, orientation, and bounds are checked for every `k` by +simplification and natural-number arithmetic. Combining it with +`applyExit_sound` proves the corresponding literal machine run. + +Each repeated cycle has an explicit configuration expression `S(k,j)`, +an iteration count `K(k)`, and a fixed literal cost `d`. It consists of +three word operations. The certificate proves + +$$0\le jY^6` is unchanged. The full state and tape equality is +`a6_final_eq_next` in +[`M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean`](../../BusyBeaver/BB6/M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean). +Combining it with `verifyReturnCert_sound` proves `family_step` for every +`n >= 8`, and `isNotHalt_of_family` closes +[`BusyBeaver.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.is_not_halt`](../../BusyBeaver/BB6/M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean). + +## Scope of the result + +The Lean result fixes `N=791761176`, proves the return for all `n>=8`, and +checks the blank-tape entry into that tail. It also checks the earlier +`C(0)` checkpoint. It does not require separate universal return lemmas for +`n=0,...,7`, or a return theorem with a second free parameter `N`. + +The complete source, machine definition, certificate checks, and infinite +argument are included here. The native Cryptids theorem, axiom audit, and reproduction procedure are +described in [README.md](README.md). diff --git a/artifacts/a6/README.md b/artifacts/a6/README.md new file mode 100644 index 00000000..4c7937b9 --- /dev/null +++ b/artifacts/a6/README.md @@ -0,0 +1,103 @@ +# A6 nonhalting proof (reflective certificate) + +The machine + +```text +1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LB--- +``` + +is proved nonhalting from blank tape in Cryptids' shared execution model: + +```lean +BusyBeaver.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.is_not_halt : + BusyBeaver.IsNotHalt + BusyBeaver.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.target +``` + +The public machine module is +[`M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean`](../../BusyBeaver/BB6/M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean). +The [self-contained proof](PROOF.md) gives the exact tape family and the +entry, transfer, return, and infinite-run arguments. A6 is a local label; +the complete transition string identifies the machine. + +## Proof structure and reflective infrastructure + +Fix `N = 791761176`. A compressed RLE execution reaches `C(8)` from `init []` +at the exact literal step `752265440525431967` (passing `C(0)` at step +`752263008230408399`). For every `k : ℕ`, the machine then reaches `C(k+9)` +from `C(k+8)` in `304037417082 + 119808 * k > 0` steps. Positive return times +establish `IsNotHalt target` directly via `IsNotHalt.of_reachesPlus_invariant`. + +Instead of relying on external code generation or an intermediate integer-tape +model, the proof uses Cryptids' reusable machine-polymorphic reflective RLE +framework directly over `BusyBeaver.Cfg Γ Λ` (`ListBlank` half-tapes): + +- **[`BusyBeaver/WordRLE.lean`](../../BusyBeaver/WordRLE.lean)** — Strict CBV + accumulators (`withNat`, `withBool`), binary `NatTrie` lookup and bulk + verification (`NatTrie.checkAll_sound`), finite and composite word-exit + zippers (`runWordExit_sound`, `sweepWord_sound`, `runCompositeExit_sound`), + and concrete RLE replay (`EntryReaches.sound`). +- **[`BusyBeaver/AffRLE.lean`](../../BusyBeaver/AffRLE.lean)** — Symbolic + affine exponents `a * k + b` (`AffNat`), bivariate loop exponents + `a * k + b + c * j` (`Aff2Nat`), verified countdown-cycle soundness + (`verifyCycle_sound`), balanced `BTree AffOp` symbolic replay + (`verifyReturnCert_sound`), and non-halting closure (`isNotHalt_of_family`). +- **[`BusyBeaver/ElabRLE.lean`](../../BusyBeaver/ElabRLE.lean)** — Pure-Lean + elaboration-time cycle-discovering certificate synthesis + (`discoverReturnCert`) and sliced `mkAuxTheorem` kernel proof drivers + (`proveEntryPhase`, `proveCheckAll`, `proveAffReplay`). + +The A6 specialization in [`BusyBeaver/BB6/A6/`](../../BusyBeaver/BB6/A6/) +contains no generated files and no external Python scripts: + +- **[`Defs.lean`](../../BusyBeaver/BB6/A6/Defs.lean)** — Machine definition, + 2-bit base-word exit table (`fastExit2_sound`), quadratic counter transfers + (`transferB_batch`, `transferD_batch`), Entry step soundness + (`stepEntry_sound`), and milestone specifications (`entryMilestone`, + `initReturnCfg`, `returnTarget`). +- **[`Cert.lean`](../../BusyBeaver/BB6/A6/Cert.lean)** — Elaboration-time + synthesis of A6's 414-word composite vocabulary, 462-entry composite exit + trie, 202-operation `BTree AffOp` (9,844 affine sweeps + 67 countdown + cycles), and post-return configuration `a6FinalCfg`. +- **[`Entry0.lean`](../../BusyBeaver/BB6/A6/Entry0.lean) .. + [`Entry5.lean`](../../BusyBeaver/BB6/A6/Entry5.lean)** — Six parallel + kernel-checked Entry milestone derivations (`init [] → C(0) → C(3) → C(5) + → C(6) → C(7) → C(8)`, 166,491 RLE steps total). +- **[`ReturnExits.lean`](../../BusyBeaver/BB6/A6/ReturnExits.lean) & + [`ReturnReplay.lean`](../../BusyBeaver/BB6/A6/ReturnReplay.lean)** — Parallel + kernel verification of all 462 composite exits (`a6_exits_ok`) and the + symbolic affine return tree (`a6_replay_ok`). + +All evaluations run inside the trusted Lean 4 kernel (`Eq.refl true` via +`mkAuxTheorem` and `decide`), with zero `native_decide` and only standard +axioms (`propext`, `Classical.choice`, `Quot.sound`). + +## Build and verify + +Use this repository's pinned Lean toolchain and fetch its Mathlib cache: + +```sh +lake exe cache get +lake build BusyBeaver.BB6.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH +lake env lean artifacts/a6/Audit.lean +``` + +On Linux with Bubblewrap installed, the focused independent specification +check is: + +```sh +lake comparator --config comparator/a6.json +``` + +The result is also registered in `comparator/busy_beaver.json`, and the +library root imports its machine module. + +## Provenance and AI assistance + +The machine was investigated from the community's BB6 holdout snapshots. +The mathematical invariant and initial certificate were developed with AI +assistance (including GPT-6.1 Sol and GPT-6.1 Terra), and subsequently +refactored into Cryptids' pure-Lean reflective RLE and affine-return engine. +No priority or community-status update is implied by the formal statement alone. + +Software is Apache-2.0 and prose is CC-BY-4.0 under the repository's licenses. diff --git a/comparator/README.md b/comparator/README.md index f6a58351..994c436b 100644 --- a/comparator/README.md +++ b/comparator/README.md @@ -19,12 +19,13 @@ using [`leanprover/comparator`](https://github.com/leanprover/comparator). acceleration semantics (`IsClosedPatternSet`, `HasCollatzReduction`, `IsClosedStackPatternSet`, `HasStackedCollatzReduction`, `HasStackReduction`, `HasOdometerReduction`, `HasTransducerReduction`, `IsValidAcceleration`, `CollatzHalts`, `IsHalt`, `IsNotHalt`), and - `load_rle_machine%` once, and states all 424 `BB(6)` and `BB(3, 3)` holdout theorems + `load_rle_machine%` once, and states all 425 `BB(6)` and `BB(3, 3)` holdout theorems (`is_closed_pattern_set` / `is_closed_stack_pattern_set`, `has_collatz_reduction` / `has_stacked_collatz_reduction`, `has_stack_reduction`, `has_odometer_reduction`, `has_transducer_reduction`, `is_valid_acceleration`, `isHalt_iff_acceleration`, - `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, and - `acceleration_iff_highLevel_acceleration` across the 88 machines) with `sorry`. + `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, + `acceleration_iff_highLevel_acceleration`, and A6 `is_not_halt` across + the 89 machines) with `sorry`. Comparator exports both the challenge module (`Challenge` or `BusyBeaverChallenge`) and the solution module (`Cryptids` or `BusyBeaver`) via `leanexport`, verifying in a Bubblewrap sandbox @@ -58,7 +59,8 @@ that: | [`constructive.json`](./constructive.json) | `Challenge` | `Cryptids` | `propext`, `Quot.sound` | All 13 constructive theorems: all 3 ZF proof-search equivalences (`zf_393`, `zf_380`, `zf_432`), first-order `PA` consistency & $\Sigma_1^0$ adequacy (`not_paProvable_false`, `paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`), direct state reductions (`Goldbach21`, `Zf380`, `Riemann104`), and `Riemann95.candidate_fewer_states` | | [`all.json`](./all.json) | `Challenge` | `Cryptids` | `propext`, `Quot.sound`, `Classical.choice` | All 26 conjecture-checking state-reduction, equivalence, `PA` metatheory, and semantics theorems | | [`pa_semantics.json`](./pa_semantics.json) | `Challenge` | `Cryptids.Semantics.PA` | `propext`, `Quot.sound`, `Classical.choice` | `not_paProvable_false`, `paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`, `paProvable_sound_nat` | -| [`busy_beaver.json`](./busy_beaver.json) | `BusyBeaverChallenge` | `BusyBeaver` | `propext`, `Quot.sound`, `Classical.choice` | All 424 `BB(6)` and `BB(3, 3)` holdout Level A and Level B theorems (`is_closed_pattern_set`, `has_collatz_reduction`, `is_closed_stack_pattern_set`, `has_stacked_collatz_reduction`, `has_stack_reduction`, `has_odometer_reduction`, `has_transducer_reduction`, `is_valid_acceleration`, `isHalt_iff_acceleration`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`) | +| [`busy_beaver.json`](./busy_beaver.json) | `BusyBeaverChallenge` | `BusyBeaver` | `propext`, `Quot.sound`, `Classical.choice` | All 425 `BB(6)` and `BB(3, 3)` holdout theorems: Level A and Level B reductions (`is_closed_pattern_set`, `has_collatz_reduction`, `is_closed_stack_pattern_set`, `has_stacked_collatz_reduction`, `has_stack_reduction`, `has_odometer_reduction`, `has_transducer_reduction`, `is_valid_acceleration`, `isHalt_iff_acceleration`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`) and A6 `is_not_halt` | +| [`a6.json`](./a6.json) | `BusyBeaverChallenge` | `BusyBeaver.BB6.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH` | `propext`, `Quot.sound`, `Classical.choice` | A6 `is_not_halt` | | [`goldbach_21.json`](./goldbach_21.json) | `Challenge` | `Cryptids.Goldbach21` | `propext`, `Quot.sound` | `candidate_fewer_states`, `candidate_equivalent` | | [`goldbach_semantics.json`](./goldbach_semantics.json) | `Challenge` | `Cryptids.Semantics.Goldbach` | `propext`, `Quot.sound`, `Classical.choice` | `halts_reference_iff_not_goldbach`, `halts_candidate_iff_not_goldbach` | | [`zf_380.json`](./zf_380.json) | `Challenge` | `Cryptids.Zf380` | `propext`, `Quot.sound` | `candidate_fewer_states`, `candidate_equivalent` | @@ -69,6 +71,11 @@ that: | [`riemann_120.json`](./riemann_120.json) | `Challenge` | `Cryptids.Semantics.Riemann120` | `propext`, `Quot.sound`, `Classical.choice` | `halts_riemann120_iff_not_riemannHypothesis`, `halts_candidate_iff_not_riemannHypothesis` | | [`riemann_semantics.json`](./riemann_semantics.json) | `Challenge` | `Cryptids.Semantics.Riemann` | `propext`, `Quot.sound`, `Classical.choice` | `halts_riemann744_iff_exists_counterexample`, `halts_riemann744_iff_not_riemannHypothesis` | +The focused [`a6.json`](a6.json) configuration checks the A6 `IsNotHalt` +theorem against `BusyBeaverChallenge`, using only its machine module as the +solution import. It uses the same three-axiom policy as the full Busy Beaver +configuration. + ## Usage From the repository root (with `bwrap` installed): diff --git a/comparator/a6.json b/comparator/a6.json new file mode 100644 index 00000000..429ef91a --- /dev/null +++ b/comparator/a6.json @@ -0,0 +1,12 @@ +{ + "challenge_module": "BusyBeaverChallenge", + "solution_module": "BusyBeaver.BB6.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH", + "theorem_names": [ + "BusyBeaver.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.is_not_halt" + ], + "permitted_axioms": [ + "propext", + "Quot.sound", + "Classical.choice" + ] +} diff --git a/comparator/busy_beaver.json b/comparator/busy_beaver.json index 90807396..46f4c2fe 100644 --- a/comparator/busy_beaver.json +++ b/comparator/busy_beaver.json @@ -425,7 +425,8 @@ "BusyBeaver.M_1RBHHH_0RC0RE_1RD1RF_1LE0LB_1RC0LD_1RC1RA.has_stack_reduction", "BusyBeaver.M_1RBHHH_0RC1RD_1LA0LA_1LE0RB_1LF1LE_1LC0LD.has_stack_reduction", "BusyBeaver.M_1RBHHH_1LC0RF_0RA0LD_1LE1LA_1RF0LF_0LC0RA.is_valid_acceleration", - "BusyBeaver.M_1RBHHH_1LC0RF_0RA0LD_1LE1LA_1RF0LF_0LC0RA.isHalt_iff_acceleration" + "BusyBeaver.M_1RBHHH_1LC0RF_0RA0LD_1LE1LA_1RF0LF_0LC0RA.isHalt_iff_acceleration", + "BusyBeaver.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.is_not_halt" ], "permitted_axioms": [ "propext",